{-# LANGUAGE CPP, ForeignFunctionInterface #-}-- Low-level IO operations-- These operations are either missing from the GHC run-time library,-- or implemented suboptimally or heavy-handedlymoduleData.Iteratee.IO.Posix(#if defined(USE_POSIX)FileOffset,myfdRead,myfdSeek,Errno(..),select'read'pending#endif)where#if defined(USE_POSIX)importForeign.CimportForeign.PtrimportSystem.PosiximportSystem.IO(SeekMode(..))importControl.MonadimportData.Bits-- for selectimportForeign.Marshal.Array-- for select-- |Alas, GHC provides no function to read from Fd to an allocated buffer.-- The library function fdRead is not appropriate as it returns a string-- already. I'd rather get data from a buffer.-- Furthermore, fdRead (at least in GHC) allocates a new buffer each-- time it is called. This is a waste. Yet another problem with fdRead-- is in raising an exception on any IOError or even EOF. I'd rather-- avoid exceptions altogether.myfdRead::Fd->PtrCChar->ByteCount->IO(EitherErrnoByteCount)myfdRead(Fdfd)ptrn=don'<-cReadfdptrnifn'==-1thenliftMLeftgetErrnoelsereturn.Right.fromIntegral$n'foreignimportccallunsafe"unistd.h read"cRead::CInt->PtrCChar->CSize->IOCInt-- |The following fseek procedure throws no exceptions.myfdSeek::Fd->SeekMode->FileOffset->IO(EitherErrnoFileOffset)myfdSeek(Fdfd)modeoff=don'<-cLSeekfdoff(mode2Intmode)ifn'==-1thenliftMLeftgetErrnoelsereturn.Right$n'wheremode2Int::SeekMode->CInt-- From GHC sourcemode2IntAbsoluteSeek=0mode2IntRelativeSeek=1mode2IntSeekFromEnd=2foreignimportccallunsafe"unistd.h lseek"cLSeek::CInt->FileOffset->CInt->IOFileOffset-- Darn! GHC doesn't provide the real select over several descriptors!-- We have to implement it ourselvestypeFDSET=CUInttypeTIMEVAL=CLong-- Two longsforeignimportccall"unistd.h select"c_select::CInt->PtrFDSET->PtrFDSET->PtrFDSET->PtrTIMEVAL->IOCInt-- Convert a file descriptor to an FDSet (for use with select)-- essentially encode a file descriptor in a big-endian notationfd2fds::CInt->[FDSET]fd2fdsfd=replicatenb0++[setBit0off]where(nb,off)=quotRem(fromIntegralfd)(bitSize(undefined::FDSET))fds2mfd::[FDSET]->[CInt]fds2mfdfds=[fromIntegral(j+i*bitsize)|(afds,i)<-zipfds[0..],j<-[0..bitsize],testBitafdsj]wherebitsize=bitSize(undefined::FDSET)unFd::Fd->CIntunFd(Fdx)=x-- |poll if file descriptors have something to read-- Return the list of read-pending descriptorsselect'read'pending::[Fd]->IO(EitherErrno[Fd])select'read'pendingmfd=withArray([0,1]::[TIMEVAL])$\_timeout->withArrayfds$\readfs->dorc<-c_select(fdmax+1)readfsnullPtrnullPtrnullPtrifrc==-1thenliftMLeftgetErrno-- because the wait was indefinite, rc must be positive!elseliftM(Right.mapFd.fds2mfd)(peekArray(lengthfds)readfs)wherefds::[FDSET]fds=foldrormax[](map(fd2fds.unFd)mfd)fdmax=maximum$mapfromIntegralmfdormax[]x=xormaxx[]=xormax(a:ar)(b:br)=(a.|.b):ormaxarbr#endif