{-# LANGUAGE ForeignFunctionInterface #-}{-# LANGUAGE FlexibleInstances #-}-- | This module contains miscellaneous functions plus a few pieces of-- functionality that are missing from the standard Haskell libraries.moduleData.IterIO.Extra(-- * MiscellaneousiterLoop,inumSplit-- , fixIterPure-- * Functionality missing from system libraries,SendRecvString(..),hShutdown-- * Debugging functions,traceInput,traceI)whereimportControl.Concurrent(myThreadId)importControl.Concurrent.MVarimportControl.MonadimportControl.Monad.TransimportData.ByteString.Internal(inlinePerformIO)importData.MonoidimportDebug.TraceimportForeign.CimportqualifiedData.ByteStringasSimportqualifiedData.ByteString.Char8asS8importqualifiedData.ByteString.LazyasLimportNetwork.SocketimportNetwork.Socket.ByteStringasSimportNetwork.Socket.ByteString.LazyasLimportSystem.IOimportData.IterIO.IterimportData.IterIO.InumimportData.TypeableimportSystem.IO.ErrorimportGHC.IO.FD(FD(..))importGHC.IO.Handle.Types(Handle__(..))importGHC.IO.Handle.Internals(wantWritableHandle)foreignimportccallunsafe"sys/socket.h shutdown"c_shutdown::CInt->CInt->IOCInt-- | Create a loopback @('Iter', 'Onum')@ pair. The iteratee and-- enumerator can be used in different threads. Any data fed into the-- 'Iter' will in turn be fed by the 'Onum' into whatever 'Iter' it-- is given. This is useful for testing a protocol implementation-- against itself.iterLoop::(MonadIOm,ChunkDatat,Showt)=>m(Itertm(),Onumtma)iterLoop=do-- The loopback is implemented with an MVar (MVar Chunk). The-- enumerator waits on the inner MVar, while the iteratee uses the outer -- MVar to avoid races when appending to the stored chunk.mv<-liftIO$newEmptyMVar>>=newMVarreturn(itermv,enummv)whereitermv=doc@(Chunk_eof)<-chunkIliftIO$withMVarmv$\p->domp<-tryTakeMVarpputMVarp$casempofNothing->cJustc'->mappendc'cifeofthenreturn()elseitermv-- Note the ifeed mempty, which is there in case the enum feeds-- an iter that starts with a liftIO or something, and the other-- half of the loopback interface waits for the result of that-- liftIO to start producing data.enummv=mkInumM(ifeedmempty>>loop)whereloop=dop<-liftIO$readMVarmvChunkteof<-liftIO$takeMVarpdone<-ifeedtwhen(not$eof||done)loop-- | Returns an 'Iter' that always returns itself until a result is-- produced. You can fuse @inumSplit@ to an 'Iter' to produce an-- 'Iter' that can safely be fed (e.g., with 'enumPure') from multiple-- threads.inumSplit::(MonadIOm,ChunkDatat)=>InumttmainumSplititer1=domv<-liftIO$newMVar$IterFiter1itermvwhereitermv=do(Chunkteof)<-chunkIrold<-liftIO$takeMVarmvrnew<-runIterMC(passCtlpullupResid)(reRunIterrold)$chunktliftIO$putMVarmvrnewcasernewofIterF_|noteof->itermv_->returnrnew{- fixIterPure allows MonadFix instances, which support
out-of-order name bindings in a "rec" block, provided your file
has {-# LANGUAGE RecursiveDo #-} at the top. A contrived example
would be:
fixtest :: IO Int
fixtest = enumPure [10] `cat` enumPure [1] |$ fixee
where
fixee :: Iter [Int] IO Int
fixee = rec
liftIO $ putStrLn "test #1"
c <- return $ a + b
liftIO $ putStrLn "test #2"
a <- headI
liftIO $ putStrLn "test #3"
b <- headI
liftIO $ putStrLn "test #4"
return c
-- A very convoluted way of computing factorial
fixtest2 :: Int -> IO Int
fixtest2 i = do
f <- enumPure [2] `cat` enumPure [1] |$ mfix fact
run $ f i
where
fact :: (Int -> Iter [Int] IO Int)
-> Iter [Int] IO (Int -> Iter [Int] IO Int)
fact f = do
ignore <- headI
liftIO $ putStrLn $ "ignoring " ++ show ignore
base <- headI
liftIO $ putStrLn $ "base is " ++ show base
return $ \n -> if n <= 0
then return base
else liftM (n *) (f $ n - 1)
-- | This is a fixed point combinator for iteratees over monads that
-- have no side effects. If you wish to use @rec@ with such a monad,
-- you can define an instance of 'MonadFix' in which
-- @'mfix' = fixIterPure@. However, be warned that this /only/ works
-- when computations in the monad have no side effects, as
-- @fixIterPure@ will repeatedly re-invoke the function passsed in
-- when more input is required (thereby also repeating side-effects).
-- For cases in which the monad may have side effects, if the monad is
-- in the 'MonadIO' class then there is already an 'mfix' instance
-- defined using 'fixMonadIO'.
fixIterPure :: (ChunkData t, MonadFix m) =>
(a -> Iter t m a) -> Iter t m a
fixIterPure f = Iter $ \c ->
let ff ~(Done a _) = check $ runIter (f a) c
-- Warning: IterF case re-runs function, repeating side effects
check (IterF _) = return $ IterF $ Iter $ \c' ->
runIter (fixIterPure f) (mappend c c')
check (IterM m) = m >>= check
check r = return r
in IterM $ mfix ff
-}---- Some utility functions for things that are made hard by the Haskell-- libraries---- | @SendRecvString@ is the class of string-like objects that can be-- used with datagram sockets.class(Showt)=>SendRecvStringtwheregenRecv::Socket->Int->IOtgenSend::Socket->t->IO()genRecvFrom::Socket->Int->IO(t,SockAddr)genSendTo::Socket->t->SockAddr->IO()instanceSendRecvString[Char]wheregenRecvslen=liftMS8.unpack$S.recvslengenSendsstr=S.sendAlls(S8.packstr)genRecvFromslen=do(str,a)<-S.recvFromslenreturn(S8.unpackstr,a)genSendTosstrdest=S.sendAllTos(S8.packstr)destinstanceSendRecvStringS.ByteStringwheregenRecvslen=S.recvslengenSendsstr=S.sendAllsstrgenRecvFromslen=S.recvFromslengenSendTosstrdest=S.sendAllTosstrdestinstanceSendRecvStringL.ByteStringwheregenRecvslen=dostr<-S.recvslenreturn$L.fromChunks[str]genSendsstr=L.sendAllsstrgenRecvFromslen=do(str,a)<-S.recvFromslenreturn(L.fromChunks[str],a)genSendTosstrdest=S.sendManyTos(L.toChunksstr)dest-- | Flushes a file handle and calls the /shutdown/ system call so as-- to write an EOF to a socket while still being able to read from it.-- This is very important when the same file handle is being used to-- to read data in an 'Onum' and to write data in an 'Iter'. Proper-- protocol functioning may require the 'Iter' to send an EOF (e.g., a-- TCP FIN segment), but the 'Onum' may still be reading from the-- socket in a different thread.hShutdown::Handle->CInt->IOInthShutdownhhow=dohFlushhwantWritableHandle"hShutdown"h$\Handle__{haDevice=dev}->casecastdevofJust(FD{fdFD=fd})->liftMfromEnum$c_shutdownfdhowNothing->ioError(ioeSetErrorString(mkIOErrorillegalOperationErrorType"hShutdown"(Justh)Nothing)"handle is not a file descriptor")---- Debugging---- | For debugging, print a tag along with the current residual input.-- Not referentially transparent.traceInput::(ChunkDatat,Monadm)=>String->Itertm()traceInputtag=Iter$\c->trace(tag++": "++showc)$Done()c-- | For debugging. Print the current thread ID and a message. Not-- referentially transparent.traceI::(ChunkDatat,Monadm)=>String->Itertm()traceImsg=Iter$\c->inlinePerformIO$dotid<-myThreadIdputTraceMsg$showtid++": "++msgreturn$Done()c