packages feed

pipes-core 0.0.1 → 0.1.0

raw patch · 7 files changed

+170/−213 lines, 7 filesdep +transformersdep −mtldep ~categoriesdep ~lifted-basedep ~monad-controlPVP ok

version bump matches the API change (PVP)

Dependencies added: transformers

Dependencies removed: mtl

Dependency ranges changed: categories, lifted-base, monad-control, void

API changes (from Hackage documentation)

- Control.Pipe.Category: instance Monad m => Comonoidal (PipeC m r) Either
- Control.Pipe.Category: instance Monad m => Disassociative (PipeC m r) Either
- Control.Pipe.Common: Ensure :: MaskState
- Control.Pipe.Common: Finalizer :: SomeException -> MaskState
- Control.Pipe.Common: Free :: (PipeF a b m (Pipe a b m r)) -> (SomeException -> Pipe a b m r) -> Pipe a b m r
- Control.Pipe.Common: data BrokenDownstreamPipe
- Control.Pipe.Common: data BrokenUpstreamPipe
- Control.Pipe.Common: data PipeF a b m x
- Control.Pipe.Common: ensure :: Monad m => m r -> Pipe a b m r
- Control.Pipe.Common: instance Exception BrokenDownstreamPipe
- Control.Pipe.Common: instance Exception BrokenUpstreamPipe
- Control.Pipe.Common: instance Monad m => Functor (PipeF a b m)
- Control.Pipe.Common: instance Show BrokenDownstreamPipe
- Control.Pipe.Common: instance Show BrokenUpstreamPipe
- Control.Pipe.Common: instance Typeable BrokenDownstreamPipe
- Control.Pipe.Common: instance Typeable BrokenUpstreamPipe
+ Control.Pipe.Common: data BrokenPipe
+ Control.Pipe.Common: instance Exception BrokenPipe
+ Control.Pipe.Common: instance MonadIO m => MonadIO (Pipe a b m)
+ Control.Pipe.Common: instance Show BrokenPipe
+ Control.Pipe.Common: instance Typeable BrokenPipe
- Control.Pipe.Common: Await :: (a -> x) -> PipeF a b m x
+ Control.Pipe.Common: Await :: (a -> Pipe a b m r) -> (SomeException -> Pipe a b m r) -> Pipe a b m r
- Control.Pipe.Common: M :: (m x) -> MaskState -> PipeF a b m x
+ Control.Pipe.Common: M :: MaskState -> (m (Pipe a b m r)) -> (SomeException -> Pipe a b m r) -> Pipe a b m r
- Control.Pipe.Common: Pure :: r -> Pipe a b m r
+ Control.Pipe.Common: Pure :: r -> (Finalizer m) -> Pipe a b m r
- Control.Pipe.Common: Throw :: SomeException -> Pipe a b m r
+ Control.Pipe.Common: Throw :: SomeException -> (Finalizer m) -> Pipe a b m r
- Control.Pipe.Common: Yield :: b -> x -> PipeF a b m x
+ Control.Pipe.Common: Yield :: b -> (Pipe a b m r) -> (Finalizer m) -> Pipe a b m r

Files

Control/Pipe.hs view
@@ -119,7 +119,7 @@   -- any monad, but don't have any exception-safety guarantees, so they should   -- only be used for 'Pipe's that don't allocate any scarce resources.   ---  -- > runPipePipe :: (Monad m) => Pipeline m r -> m (Either SomeException r)+  -- > runPurePipe :: (Monad m) => Pipeline m r -> m (Either SomeException r)   -- > runPurePipe_ :: (Monad m) => Pipeline m r -> m r   --   -- 'runPipe', 'runPurePipe' and 'runPurePipe_' only work on self-contained
Control/Pipe/Category.hs view
@@ -48,17 +48,13 @@  instance Monad m => Associative (PipeC m r) Either where   associate = PipeC associateP--instance Monad m => Disassociative (PipeC m r) Either where   disassociate = PipeC disassociateP -type instance Id (PipeC m r) Either = Void- instance Monad m => Monoidal (PipeC m r) Either where+  type Id (PipeC m r) Either = Void+   idl = arr idl   idr = arr idr--instance Monad m => Comonoidal (PipeC m r) Either where   coidl = arr coidl   coidr = arr coidr 
Control/Pipe/Combinators.hs view
@@ -53,7 +53,7 @@ -- 'Nothing', whereas calling 'await' will terminate the current pipe -- immediately. tryAwait :: Monad m => Pipe a b m (Maybe a)-tryAwait = catch (Just <$> await) $ \(_ :: BrokenUpstreamPipe) -> return Nothing+tryAwait = catch (Just <$> await) $ \(_ :: BrokenPipe) -> return Nothing  -- | Execute the specified pipe for each value in the input stream. --@@ -115,7 +115,7 @@  -- | Variation of 'takeWhile' returning @()@. takeWhile_ :: Monad m => (a -> Bool) -> Pipe a a m ()-takeWhile_ p = takeWhile p >> return ()+takeWhile_ = void . takeWhile  -- | Remove inputs as long as they satisfy the given predicate, then act as an -- identity.@@ -154,12 +154,8 @@ -- this could be implemented as -- feed x p = (yield x >> idP) >+> p -- but this version is more efficient-feed _ (Pure r) = return r-feed _ (Throw e) = throw e-feed a (Free c h) = case go a c of-  (False, p) -> p >>= feed a-  (True, p)  -> join p-  where-    go a (Await k) = (True, return $ k a)-    go _ (Yield y c) = (False, yield y >> return c)-    go _ (M m s) = (False, liftP s m)+feed _ (Pure r w) = Pure r w+feed _ (Throw e w) = Throw e w+feed a (Yield x b w) = Yield x (feed a b) w+feed a (M s m h) = M s (liftM (feed a) m) (feed a . h)+feed a (Await k _) = k a
Control/Pipe/Common.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE DeriveDataTypeable, FlexibleContexts #-}+{-# LANGUAGE DeriveDataTypeable, FlexibleContexts, Rank2Types, ScopedTypeVariables #-} module Control.Pipe.Common (   -- ** Types   Pipe(..),@@ -37,9 +37,7 @@   runPurePipe_,    -- ** Low level types-  BrokenDownstreamPipe,-  BrokenUpstreamPipe,-  PipeF(..),+  BrokenPipe,   MaskState(..),    -- ** Low level primitives@@ -49,7 +47,6 @@   throwP,   catchP,   liftP,-  ensure,   ) where  import Control.Applicative@@ -57,50 +54,34 @@ import Control.Exception (SomeException, Exception) import qualified Control.Exception.Lifted as E import Control.Monad-import Control.Monad.Trans (MonadTrans, lift)+import Control.Monad.IO.Class+import Control.Monad.Trans.Class import Control.Monad.Trans.Control import Data.Maybe import Data.Typeable import Data.Void import Prelude hiding (id, (.), catch) --- | The 'BrokenDownstreamPipe' exception is used to signal termination of the--- downstream portion of a 'Pipeline' after the current pipe.------ There is usually no need to catch this exception explicitly, a pipe will--- terminate automatically when the downstream pipe terminates.-data BrokenDownstreamPipe = BrokenDownstreamPipe-  deriving (Show, Typeable)--instance Exception BrokenDownstreamPipe---- | The 'BrokenUpstreamPipe' exception is used to signal termination of the+-- | The 'BrokenPipe' exception is used to signal termination of the -- upstream portion of a 'Pipeline' before the current pipe ----- A 'BrokenUpstreamPipe' exception can be caught to perform cleanup actions+-- A 'BrokenPipe' exception can be caught to perform cleanup actions -- immediately before termination, like returning a result or yielding -- additional values.-data BrokenUpstreamPipe = BrokenUpstreamPipe+data BrokenPipe = BrokenPipe   deriving (Show, Typeable) -instance Exception BrokenUpstreamPipe+instance Exception BrokenPipe  -- | Type of action in the base monad. data MaskState-  = Masked                    -- ^ Action to be run with asynchronous exceptions masked.-  | Unmasked                  -- ^ Action to be run with asynchronous exceptions unmasked.-  | Ensure                    -- ^ Action to be run regardless of downstream failure.-  | Finalizer SomeException   -- ^ Finalizer action.+  = Masked     -- ^ Action to be run with asynchronous exceptions masked.+  | Unmasked   -- ^ Action to be run with asynchronous exceptions unmasked. -data PipeF a b m x-  = M (m x) MaskState-  | Await (a -> x)-  | Yield b x+type Finalizer m = [m ()] -instance Monad m => Functor (PipeF a b m) where-  fmap f (M m s) = M (liftM f m) s-  fmap f (Await k) = Await (f . k)-  fmap f (Yield b c) = Yield b (f c)+addFinalizer :: m () -> Finalizer m -> Finalizer m+addFinalizer m w = w ++ [m]  -- | The base type for pipes. --@@ -108,21 +89,17 @@ -- --  [@b@] The type of output delivered to downstream pipes. -----  [@c@] The base monad.+--  [@m@] The base monad. -----  [@d@] The type of the monad's final result.+--  [@r@] The type of the monad's final result. data Pipe a b m r-  -- Pipe is a free monad over the functor-  ---  -- data PipeF' a b m r-  --   = Catch (PipeF a b m r) (SomeException -> r)-  --   | Throw e-  -- -  -- but is implemented inline because it makes the code simpler.-  = Pure r-  | Free (PipeF a b m (Pipe a b m r))-         (SomeException -> Pipe a b m r)-  | Throw SomeException+  = Pure r (Finalizer m)+  | Throw SomeException (Finalizer m)+  | Await (a -> Pipe a b m r)+          (SomeException -> Pipe a b m r)+  | M MaskState (m (Pipe a b m r))+                (SomeException -> Pipe a b m r)+  | Yield b (Pipe a b m r) (Finalizer m)  -- | A pipe that can only produce values. type Producer b m = Pipe () b m@@ -134,11 +111,17 @@ type Pipeline m = Pipe () Void m  instance Monad m => Monad (Pipe a b m) where-  return = Pure-  Pure r >>= f = f r-  Free c h >>= f = Free (fmap (>>= f) c)-                        (h >=> f)-  Throw e >>= _ = Throw e+  return r = Pure r []+  Pure r w >>= f = case f r of+    Pure r' w' -> Pure r' (w ++ w')+    Throw e w' -> Throw e (w ++ w')+    p'         -> foldr run p' w+      where+        run m p = M Masked (m >> return p) throwP+  Throw e w >>= _ = Throw e w+  Await k h >>= f = Await (k >=> f) (h >=> f)+  M s m h >>= f = M s (m >>= \p -> return $ p >>= f) (h >=> f)+  Yield x p w >>= f = Yield x (p >>= f) w  instance Monad m => Functor (Pipe a b m) where   fmap = liftM@@ -147,43 +130,52 @@   pure = return   (<*>) = ap -liftF :: Monad m => PipeF a b m r -> Pipe a b m r-liftF c = Free (fmap return c) throwP- -- | Throw an exception within the 'Pipe' monad. throwP :: Monad m => SomeException -> Pipe a b m r-throwP = Throw+throwP e = Throw e []  -- | Catch an exception within the pipe monad. catchP :: Monad m        => Pipe a b m r        -> (SomeException -> Pipe a b m r)        -> Pipe a b m r-catchP (Pure r) _ = return r-catchP (Free c h1) h2 = Free-  (fmap (`catchP` h2) c)-  (\e -> catchP (h1 e) h2)-catchP (Throw e) h = h e+catchP (Pure r w) _ = Pure r w+catchP (Throw e w) h = case h e of+  Pure r w'   -> Pure r (w ++ w')+  Throw e' w' -> Throw e' (w ++ w')+  p'          -> mapM_ masked w >> p'+catchP (Await k h) h' = Await (\a -> catchP (k a) h')+                              (\e -> catchP (h e) h')+catchP (M s m h) h' = M s (m >>= \p' -> return $ catchP p' h')+                          (\e -> catchP (h e) h')+catchP (Yield x p w) h' = Yield x (catchP p h') w'+  where+    w' = addFinalizer (fin $ h' bp) w+    fin (M _ m _) = m >>= fin+    fin _ = return ()  -- | Wait for input from upstream within the 'Pipe' monad. -- -- 'await' blocks until input is ready. await :: Monad m => Pipe a b m a-await = liftF $ Await id+await = Await return throwP  -- | Pass output downstream within the 'Pipe' monad. -- -- 'yield' blocks until the downstream pipe calls 'await' again. yield :: Monad m => b -> Pipe a b m ()-yield x = liftF $ Yield x ()+yield x = Yield x (return ()) []  -- | Execute an action in the base monad with the given 'MaskState'. liftP :: Monad m => MaskState -> m r -> Pipe a b m r-liftP s m = liftF (M m s)+liftP s m = M s (liftM return m) throwP  instance MonadTrans (Pipe a b) where   lift = liftP Unmasked +instance MonadIO m => MonadIO (Pipe a b m) where+  liftIO = lift . liftIO+ -- | Execute an action in the base monad with asynchronous exceptions masked. -- -- This function is effective only if the 'Pipeline' is run with 'runPipe',@@ -191,13 +183,6 @@ masked :: Monad m => m r -> Pipe a b m r masked = liftP Masked --- | Ensure an action is executed regardless of downstream termination.-ensure :: Monad m => m r -> Pipe a b m r-ensure = liftP Ensure--finalizer :: Monad m => SomeException -> m r -> Pipe a b m r-finalizer e = liftP (Finalizer e)- -- | Convert a pure function into a pipe. -- -- > pipe = forever $ do@@ -214,67 +199,54 @@ discard :: Monad m => Pipe a b m r discard = forever await -data Composition a b c m x y-  = AdvanceFirst (Pipe a c m x)-  | AdvanceSecond (Pipe a c m y)-  | AdvanceBoth x y+protect :: Monad m => Finalizer m -> Pipe a b m r -> Pipe a b m r+protect w = go+  where+    go (Pure r w') = Pure r (w ++ w')+    go (Throw e w') = Throw e (w ++ w')+    go (Await k h) = Await k h+    go (M s m h) = M s (liftM go m) (go . h)+    go (Yield x p' w') = Yield x (go p') (w ++ w') -compose :: Monad m-   => PipeF a b m x-   -> PipeF b c m y-   -> Maybe (Composition a b c m x y)-compose (Yield b x) (Await k) = Just $ AdvanceBoth x (k b)-compose _ (Yield c y) = Just $ AdvanceSecond (yield c >> return y)-compose _ (M m s) = Just $ AdvanceSecond (liftP s m)-compose (M _ (Finalizer _)) _ = Nothing-compose (M m s) _ = Just $ AdvanceFirst (liftP s m)-compose (Await k) _ = Just $ AdvanceFirst (liftM k await)+handleBP :: Monad m => r -> Pipe a b m r -> Pipe a b m r+handleBP r = go+  where+    go (Pure r' w) = Pure r' w+    go (Await k h) = Await k h+    go (M s m h) = M s (liftM go m) (go . h)+    go (Yield x p' w) = Yield x (go p') w+    go (Throw e w)+      | isBrokenPipe e = Pure r w+      | otherwise      = Throw e w -finalize2 :: Monad m-          => PipeF b c m r-          -> Maybe (Pipe a c m r)-finalize2 (Await _) = Nothing-finalize2 (M m s) = Just $ liftP s m-finalize2 (Yield c r) = Just $ yield c >> return r+bp :: SomeException+bp = E.toException BrokenPipe -finalize1 :: Monad m-          => Maybe SomeException-          -> PipeF a b m r-          -> Maybe (Pipe a c m r)-finalize1 e c = case c of-  M m Ensure -> go m-  M m (Finalizer _) -> go m-  _ -> Nothing-  where-    go m = Just $-      finalizer (fromMaybe (E.toException BrokenUpstreamPipe) e) m+isBrokenPipe :: SomeException -> Bool+isBrokenPipe e = isJust (E.fromException e :: Maybe BrokenPipe)  infixl 9 >+> -- | Left to right pipe composition. (>+>) :: Monad m => Pipe a b m r -> Pipe b c m r -> Pipe a c m r p1 >+> p2 = case (p1, p2) of-  (Free c1 h1, Free c2 h2) -> case compose c1 c2 of-    Nothing -> p1 >+> h2 (E.toException BrokenUpstreamPipe)-    Just (AdvanceFirst comp) -> catchP comp (return . h1) >>= \p1' -> p1' >+> p2-    Just (AdvanceSecond comp) -> catchP comp (return . h2) >>= \p2' -> p1 >+> p2'-    Just (AdvanceBoth p1' p2') -> p1' >+> p2'-  (Throw e, Free c h) -> terminate2 c h (Just e)-  (Pure r, Free c h) -> terminate2 c h Nothing-  (Free c h, Throw e) -> terminate1 c h (Just e)-  (Free c h, Pure r) -> terminate1 c h Nothing-  (Pure r, Throw e) -> case (E.fromException e :: Maybe BrokenUpstreamPipe) of-    Nothing -> throwP e-    Just _  -> return r-  (_, Throw e) -> throwP e-  (_, Pure r) -> return r-  where-    terminate1 c h e = case finalize1 e c of-      Nothing   -> h (fromMaybe (E.toException BrokenDownstreamPipe) e) >+> p2-      Just comp -> catchP comp (return . h) >>= \p1' -> p1' >+> p2-    terminate2 c h e = case finalize2 c of-      Nothing   -> p1 >+> h (fromMaybe (E.toException BrokenUpstreamPipe) e)-      Just comp -> catchP comp (return . h) >>= \p2' -> p1 >+> p2'+  -- downstream step+  (_, Yield x p2' w) -> Yield x (p1 >+> p2') w+  (_, M s m h2) -> M s (m >>= \p2' -> return $ p1 >+> p2')+                       (\e -> p1 >+> h2 e)+  (_, Pure r w) -> Pure r w+  (_, Throw e w) -> Throw e w +  -- upstream step+  (M s m h1, Await _ _) -> M s (m >>= \p1' -> return $ p1' >+> p2)+                               (\e -> h1 e >+> p2)+  (Await k h1, Await _ _) -> Await (\a -> k a >+> p2)+                                   (\e -> h1 e >+> p2)+  (Pure r w, Await _ h2) -> p1 >+> handleBP r (protect w (h2 bp))+  (Throw e w, Await _ h2) -> p1 >+> protect w (h2 e)++  -- flow data+  (Yield x p1' w, Await k _) -> p1' >+> protect w (k x)+ infixr 9 <+< -- | Right to left pipe composition. (<+<) :: Monad m => Pipe b c m r -> Pipe a b m r -> Pipe a c m r@@ -289,18 +261,22 @@ runPipe :: MonadBaseControl IO m => Pipeline m r -> m r runPipe p = E.mask $ \restore -> run restore p   where+    fin = mapM_ $ \m -> E.catch m (\(_ :: SomeException) -> return ())     run restore = go       where-        go (Pure r) = return r-        go (Free c h) = stepPipe try c >>= \x -> case x of+        go (Pure r w) = fin w >> return r+        go (Throw e w) = fin w >> E.throwIO e+        go (Await k _) = go (k ())+        go (Yield x _ _) = absurd x+        go (M s m h) = try s m >>= \r -> case r of           Left e   -> go $ h e           Right p' -> go p'-        go (Throw e) = E.throwIO e -        try m s = E.try $ case s of+        try s m = E.try $ case s of           Unmasked -> restore m           _ -> m + -- | Run a self-contained pipeline over an arbitrary monad, with fewer -- exception-safety guarantees than 'runPipe'. --@@ -311,20 +287,13 @@ -- -- Any captured exception will be returned in the left component of the result. runPurePipe :: Monad m => Pipeline m r -> m (Either SomeException r)-runPurePipe (Pure r) = return $ Right r-runPurePipe (Throw e) = return $ Left e-runPurePipe (Free c h) = stepPipe try c >>= runPurePipe . either h id-  where try m _ = liftM Right m+runPurePipe (Pure r w) = sequence_ w >> return (Right r)+runPurePipe (Throw e w) = sequence_ w >> return (Left e)+runPurePipe (Await k _) = runPurePipe $ k ()+runPurePipe (Yield x _ _) = absurd x+runPurePipe (M _ m _) = m >>= runPurePipe  -- | A version of 'runPurePipe' which rethrows any captured exception instead -- of returning it. runPurePipe_ :: Monad m => Pipeline m r -> m r runPurePipe_ = runPurePipe >=> either E.throw return--stepPipe :: Monad m-         => (m r -> MaskState -> m (Either SomeException r))-         -> PipeF () Void m r-         -> m (Either SomeException r)-stepPipe _ (Await k) = return . Right $ k ()-stepPipe _ (Yield x _) = absurd x-stepPipe try (M m s) = try m s
Control/Pipe/Exception.hs view
@@ -28,13 +28,10 @@ -- > safeReader = catch (reader >+> 'Pipe' Right) $ \e -> do -- >   yield $ Left e ----- Note that there is no guarantee that the handler will actually be executed,--- as any action in a 'Pipe': 'Pipe's at either side can terminate before the--- handler has a chance to be executed.------ It is therefore common to use 'ensure' within an exception handler to--- perform cleanup or finalization of resources.  However, we recommend using--- 'finally' or 'bracket' for such use cases.+-- Note that only the initial monadic actions contained in a handler are+-- guaranteed to be executed.  Anything else is subject to the usual+-- termination rule of 'Pipe's: if a 'Pipe' at either side terminates, the+-- whole pipeline terminates. catch :: (Monad m, E.Exception e)       => Pipe a b m r               -- ^ 'Pipe' to run       -> (e -> Pipe a b m r)        -- ^ handler function@@ -69,8 +66,8 @@         -> m s                    -- ^ finalizer action         -> Pipe a b m r finally p w = do-  r <- onException p (ensure w)-  ensure w+  r <- onException p (masked w)+  masked w   return r  -- | Allocate a resource within the base monad, run a 'Pipe', then ensure the@@ -91,7 +88,7 @@         -> (r -> Pipe a b m x)  -- ^ 'Pipe' to run in between         -> Pipe a b m x bracket open close run = do-  r <- liftP Masked open+  r <- masked open   finally (run r) (close r)  -- | A variant of 'bracket' where the return value from the allocation action@@ -112,5 +109,5 @@                -> (r -> Pipe a b m x)     -- ^ 'Pipe' to run in between                -> Pipe a b m x bracketOnError open close run = do-  r <- liftP Masked open-  onException (run r) (ensure $ close r)+  r <- masked open+  onException (run r) (masked $ close r)
Control/Pipe/Monoidal.hs view
@@ -22,8 +22,6 @@ import Control.Category.Braided import Control.Category.Monoidal import Control.Monad-import qualified Control.Monad.Trans as T-import Control.Monad.State import Control.Pipe.Common  -- | Create a 'Pipe' that behaves like the given 'Pipe' of the left component@@ -31,31 +29,29 @@ firstP :: Monad m        => Pipe a b m r        -> Pipe (Either a c) (Either b c) m r-firstP (Pure r) = return r-firstP (Throw e) = Throw e-firstP (Free c h) = catchP (step c) (return . h) >>= firstP+firstP (Pure r w) = Pure r w+firstP (Throw e w) = Throw e w+firstP (Yield x p w) = Yield (Left x) (firstP p) w+firstP (M s m h) = M s (liftM firstP m) (firstP . h)+firstP (Await k h) = go   where-    step (M m s) = liftP s m-    step (Yield b x) = yield (Left b) >> return x-    step (Await k) = go-      where-        go = await >>= either (return . k)-                              (yield . Right >=> const go)+    go = Await (either (firstP . k)+                       (yield . Right >=> const go))+               (firstP . h)  -- | This function is the equivalent of 'firstP' for the right component. secondP :: Monad m         => Pipe a b m r         -> Pipe (Either c a) (Either c b) m r-secondP (Pure r) = return r-secondP (Throw e) = Throw e-secondP (Free c h) = catchP (step c) (return . h) >>= secondP+secondP (Pure r w) = Pure r w+secondP (Throw e w) = Throw e w+secondP (Yield x p w) = Yield (Right x) (secondP p) w+secondP (M s m h) = M s (liftM secondP m) (secondP . h)+secondP (Await k h) = go   where-    step (M m s) = liftP s m-    step (Yield b x) = yield (Right b) >> return x-    step (Await k) = go-      where-        go = await >>= either (yield . Left >=> const go)-                              (return . k)+    go = Await (either (yield . Left >=> const go)+                       (secondP . k))+               (secondP . h)  -- | Combine two pipes into a single pipe that behaves like the first on the -- left component, and the second on the right component.@@ -116,13 +112,12 @@ loopP :: Monad m => Pipe (Either a c) (Either b c) m r -> Pipe a b m r loopP = go emptyQueue   where-    go _ (Pure r) = return r-    go _ (Throw e) = throwP e-    go q (Free c h) = case step q c of-      (q', p') -> catchP p' (return . h) >>= go q'--    step q (Await k) = case dequeue q of-      (q', x) -> (q', maybe (liftM (k . Left) await) (return . k . Right) x)-    step q (Yield (Right x) c) = (enqueue x q, return c)-    step q (Yield (Left x) c) = (q, yield x >> return c)-    step q (M m s) = (q, liftP s m)+    go :: Monad m => Queue c -> Pipe (Either a c) (Either b c) m r -> Pipe a b m r+    go _ (Pure r w) = Pure r w+    go _ (Throw e w) = Throw e w+    go q (Yield (Right x) p _) = go (enqueue x q) p+    go q (Yield (Left x) p w) = Yield x (go q p) w+    go q (M s m h) = M s (liftM (go q) m) (go q . h)+    go q (Await k h) = case dequeue q of+      (q', Nothing) -> Await (go q' . k . Left) (go q' . h)+      (q', Just x) -> go q' $ k (Right x)
pipes-core.cabal view
@@ -1,5 +1,5 @@ Name: pipes-core-Version: 0.0.1+Version: 0.1.0 Cabal-Version: >=1.10.1 Build-Type: Simple License: BSD3@@ -16,14 +16,18 @@   iteratees\/enumerators\/enumeratees, but with different characteristics and   naming conventions.   .-  Difference with traditional iteratees:+  This package is a fork of the original pipes package by Gabriel Gonzalez.+  See <https://github.com/pcapriotti/pipes-core/wiki/pipes-core-vs-pipes> for a+  comparison between the two packages.   .-  * /Simpler semantics/: There is only one data type ('Pipe'), two primitives-    ('await' and 'yield'), and only one way to compose 'Pipe's ('>+>').  In-    fact, ('>+>') is just convenient syntax for the composition operator in-    'Category'. Most pipes can be implemented just using the 'Monad' instance-    and composition.+  Differences with traditional iteratees:   .+  * /Simpler semantics/: There is only one data type ('Pipe'), two basic+    primitives ('await' and 'yield'), and only one way to compose 'Pipe's+    ('>+>').  In fact, ('>+>') is just convenient syntax for the composition+    operator in 'Category'. Most pipes can be implemented just using the+    'Monad' instance and composition.+  .   * /Different naming conventions/: Enumeratees are called 'Pipe's, Enumerators     are 'Producer's, and Iteratees are 'Consumer's.  'Producer's and 'Consumer's     are just type synonyms for 'Pipe's with either the input or output end@@ -32,10 +36,10 @@   * /Pipes form a Category/: that means that composition is associative, and     that there is an identity 'Pipe'.   .-  * /"Vertical" concatenation works on every 'Pipe'/: ('>>'),-    concatenates 'Pipe's. Since everything is a 'Pipe', you can use it to-    concatenate 'Producer's, 'Consumer's, and even intermediate 'Pipe' stages.-    Vertical concatenation can be combined with composition to create elaborate+  * /"Vertical" concatenation works on every 'Pipe'/: ('>>'), concatenates+    'Pipe's. Since everything is a 'Pipe', you can use it to concatenate+    'Producer's, 'Consumer's, and even intermediate 'Pipe' stages.  Vertical+    concatenation can be combined with composition to create elaborate     combinators, without the need of executing pipes in \"passes\" or resuming     partially executed pipes.   .@@ -50,11 +54,11 @@  Library     Build-Depends: base >= 4 && < 5-                 , mtl-                 , categories-                 , void-                 , lifted-base-                 , monad-control+                 , transformers (>= 0.2 && < 0.4)+                 , categories (== 1.0.*)+                 , void (== 0.5.*)+                 , lifted-base (== 0.1.*)+                 , monad-control (== 0.3.*)     Exposed-Modules: Control.Pipe                    , Control.Pipe.Category                    , Control.Pipe.Combinators