Permalink
Browse files

Add Coroutine interface.

  • Loading branch information...
pcapriotti committed Mar 3, 2012
1 parent d829586 commit 44f41c302c658649e5b1266a5f46001571da9411
Showing with 51 additions and 2 deletions.
  1. +46 −0 pipes-extra/Control/Pipe/Coroutine.hs
  2. +2 −1 pipes-extra/Tests/tests.hs
  3. +3 −1 pipes-extra/pipes-extra.cabal
@@ -0,0 +1,46 @@
+module Control.Pipe.Coroutine (
+ Coroutine,
+ coroutine,
+ suspend,
+ suspendE,
+ resume,
+ step,
+ terminate
+ ) where
+
+import Control.Monad
+import Control.Pipe
+import qualified Control.Exception as E
+
+data Coroutine a b m r = Coroutine
+ { suspend :: Pipe a b m r
+ , suspendE :: E.SomeException -> Pipe a b m r }
+
+resume :: Monad m
+ => Pipe a b m r
+ -> Pipe a x m (Either r (b, Coroutine a b m r))
+resume (Pure r) = return $ Left r
+resume (Throw e) = throwP e
+resume (Free c h) = go c >>= \x -> case x of
+ Left p -> resume p
+ Right (b, p) -> return $ Right (b, Coroutine p h)
+ where
+ go (Await k) = liftM (Left . k) await
+ go (Yield b p) = return $ Right (b, p)
+ go (M m s) = liftM Left $ liftP s m
+
+coroutine :: Monad m
+ => Pipe a b m r
+ -> Coroutine a b m r
+coroutine p = Coroutine p throwP
+
+step :: Monad m
+ => Coroutine a b m r
+ -> Pipe a x m (Either r (b, Coroutine a b m r))
+step = resume . suspend
+
+terminate :: Monad m
+ => Coroutine a b m r
+ -> Pipe a x m ()
+terminate (Coroutine _ h) =
+ void (catchP discard h) >+> return ()
@@ -1,8 +1,9 @@
import Control.Monad
import Control.Monad.Identity
import Control.Monad.Writer (tell, runWriter)
+import Control.Monad.Trans
import Control.Pipe
-import Control.Pipe.Combinators (($$))
+import Control.Pipe.Combinators (($$), tryAwait)
import qualified Control.Pipe.Combinators as P
import Data.Char
import Data.List
@@ -21,4 +21,6 @@ Library
bytestring (== 0.9.*)
Exposed-Modules:
Control.Pipe.Binary,
- Control.Pipe.ChunkPipe
+ Control.Pipe.Coroutine,
+ Control.Pipe.ChunkPipe,
+ Control.Pipe.Zip

0 comments on commit 44f41c3

Please sign in to comment.