pipes 2.4.0 → 2.5.0

raw patch · 13 files changed

+317/−241 lines, 13 filesdep −freedep ~transformersPVP ok

version bump matches the API change (PVP)

Dependencies removed: free

Dependency ranges changed: transformers

API changes (from Hackage documentation)

Files

• Control/Frame.hs +1/−2
• Control/Pipe/Core.hs +63/−42
• Control/Pipe/Tutorial.hs +0/−1
• Control/Proxy/Core.hs +73/−89
• Control/Proxy/Pipe.hs +12/−14
• Control/Proxy/Prelude/Base.hs +136/−61
• Control/Proxy/Prelude/IO.hs +15/−15
• Control/Proxy/Prelude/Kleisli.hs +1/−1
• Control/Proxy/Trans/Either.hs +3/−3
• Control/Proxy/Trans/Tutorial.hs +1/−1
• Control/Proxy/Trans/Writer.hs +1/−1
• Data/Closed.hs +3/−2
• pipes.cabal +8/−9

@@ -84,7 +84,7 @@ -}  -- | Index representing an open input end, receiving values of type @a@-data O a+data O a = O -- Not exported  -- | Index representing an open input end, receiving values of type @Maybe a@ type M a = O (Maybe a)@@ -344,7 +344,6 @@         Wrap (Yield c p1') -> wrap $ Yield c (p1' <~| p2)         Wrap (Await   f1 ) -> IFreeT $ U $ do             x2 <- unU $ runIFreeT p2-            let p1' = IFreeT $ returnI x1             unU $ runIFreeT $ case x2 of                 Return r           -> returnI r                 Wrap (Yield b p2') -> f1 b <~| p2' 

@@ -4,8 +4,7 @@ module Control.Pipe.Core (     -- * Types     -- $types-    PipeF(..),-    Pipe,+    Pipe(..),     C,     Producer,     Consumer,@@ -29,28 +28,15 @@ import Control.Applicative (Applicative(pure, (<*>))) import Control.Category (Category((.), id), (<<<), (>>>)) import Control.Monad (forever)-import Control.Monad.Trans.Class (lift)-import Control.Monad.Trans.Free (-    FreeF(Free, Pure), FreeT(FreeT, runFreeT), wrap)+import Control.Monad.Trans.Class (MonadTrans(lift)) import Data.Closed (C) import Prelude hiding ((.), id)  {- $types     The 'Pipe' type is strongly inspired by Mario Blazevic's @Coroutine@ type in-    his concurrency article from Issue 19 of The Monad Reader and is formulated-    in the exact same way.--    His @Coroutine@ type is actually a free monad transformer (i.e. 'FreeT')-    and his @InOrOut@ functor corresponds to 'PipeF'.+    his concurrency article from Issue 19 of The Monad Reader. -} --- | The base functor for the 'Pipe' type-data PipeF a b x = Await (a -> x) | Yield b x--instance Functor (PipeF a b) where-    fmap f (Await   g) = Await (f . g)-    fmap f (Yield b x) = Yield b (f x)- {-|     The base type for pipes @@ -62,8 +48,46 @@      * @r@ - The type of the return value -}+data Pipe a b m r+  = Await (a -> Pipe a b m r)+  | Yield b    (Pipe a b m r)+  | M       (m (Pipe a b m r))+  | Pure r+{-+type PipeF a b x = Await (a -> x) | Yield b x deriving (Functor)+ type Pipe a b = FreeT (PipeF a b)+-} +instance (Monad m) => Functor (Pipe a b m) where+    fmap f pr = go pr where+        go p = case p of+            Await   k  -> Await (\a -> go (k a))+            Yield b p' -> Yield b (go p')+            M       m  -> M (m >>= \p' -> return (go p'))+            Pure    r  -> Pure (f r)++instance (Monad m) => Applicative (Pipe a b m) where+    pure = Pure+    pf <*> px = go pf where+        go p = case p of+            Await   k  -> Await (\a -> go (k a))+            Yield b p' -> Yield b (go p')+            M       m  -> M (m >>= \p' -> return (go p'))+            Pure    f  -> fmap f px++instance (Monad m) => Monad (Pipe a b m) where+    return  = Pure+    pm >>= f = go pm where+        go p = case p of+            Await   k  -> Await (\a -> go (k a))+            Yield b p' -> Yield b (go p')+            M       m  -> M (m >>= \p' -> return (go p'))+            Pure    r  -> f r++instance MonadTrans (Pipe a b) where+    lift m = M (m >>= \r -> return (Pure r))+ -- | A pipe that produces values type Producer b = Pipe () b @@ -94,16 +118,16 @@      'await' blocks until input is available from upstream. -}-await :: (Monad m) => Pipe a b m a-await = wrap $ Await return+await :: Pipe a b m a+await = Await Pure  {-|     Deliver output downstream.      'yield' restores control back upstream and binds the result to 'await'. -}-yield :: (Monad m) => b -> Pipe a b m ()-yield b = wrap $ Yield b (return ())+yield :: b -> Pipe a b m ()+yield b = Yield b (Pure ())  {-|     Convert a pure function into a pipe@@ -113,7 +137,8 @@ >     yield (f x) -} pipe :: (Monad m) => (a -> b) -> Pipe a b m r-pipe f = forever $ await >>= yield . f+pipe f = go where+    go = Await (\a -> Yield (f a) go)  {- $category     'Pipe's form a 'Category', meaning that you can compose 'Pipe's using@@ -142,22 +167,17 @@  -- | Corresponds to ('<<<')/('.') from @Control.Category@ (<+<) :: (Monad m) => Pipe b c m r -> Pipe a b m r -> Pipe a c m r-p1 <+< p2 = FreeT $ do-    x1 <- runFreeT p1-    let p1' = FreeT $ return x1-    runFreeT $ case x1 of-        Pure r          -> return r-        Free (Yield b p1') -> wrap $ Yield b $ p1' <+< p2-        Free (Await f1) -> FreeT $ do-            x2 <- runFreeT p2-            runFreeT $ case x2 of-                Pure r             -> return r-                Free (Yield b p2') -> f1 b <+< p2'-                Free (Await   f2 ) -> wrap $ Await $ \a -> p1' <+< f2 a+(Yield b p1) <+< p2 = Yield b (p1 <+< p2)+(M       m ) <+< p2 = M (m >>= \p1 -> return (p1 <+< p2))+(Pure    r ) <+< _  = Pure r+(Await   k ) <+< (Yield b p2) = k b <+< p2+p1 <+< (Await k) = Await (\a -> p1 <+< k a)+p1 <+< (M     m) = M (m >>= \p2 -> return (p1 <+< p2))+_  <+< (Pure  r) = Pure r  -- | Corresponds to ('>>>') from @Control.Category@ (>+>) :: (Monad m) => Pipe a b m r -> Pipe b c m r -> Pipe a c m r-(>+>) = flip (<+<)+p2 >+> p1 = p1 <+< p2  {- These associativities might help performance since pipe evaluation is    downstream-biased.  I set them to the same priority as (.). -}@@ -166,7 +186,8 @@  -- | Corresponds to 'id' from @Control.Category@ idP :: (Monad m) => Pipe a a m r-idP = pipe id+idP = go where+    go = Await (\a -> Yield a go)  {- $runpipe     Note that you can also unwrap a 'Pipe' a single step at a time using@@ -201,9 +222,9 @@ > runPipe $ forever await <+< p -} runPipe :: (Monad m) => Pipeline m r -> m r-runPipe p = do-    e <- runFreeT p-    case e of-        Pure r         -> return r-        Free (Await   f) -> runPipe $ f ()-        Free (Yield _ p) -> runPipe p+runPipe pl = go pl where+    go p = case p of+       Yield _ p' -> go p' +       Await   k  -> go (k ())+       M       m  -> m >>= go+       Pure    r  -> return r

@@ -35,7 +35,6 @@ import Control.Category import Control.Frame hiding (await, yield) import Control.Monad.Trans.Class-import Control.Monad.Trans.Free import Control.Pipe  {- $type

@@ -5,8 +5,6 @@  module Control.Proxy.Core (     -- * Types-    -- $types-    ProxyF(..),     Proxy(..),     C,     Server,@@ -28,15 +26,12 @@ import Control.Monad (ap, forever, liftM, (>=>)) import Control.Monad.IO.Class (MonadIO(liftIO)) import Control.Monad.Trans.Class (MonadTrans(lift))-import Control.Monad.Trans.Free (-    FreeF(Free, Pure), FreeT(FreeT, runFreeT), liftF, hoistFreeT, wrap ) import Control.MFunctor (MFunctor(mapT)) import Control.Proxy.Class (-    Channel(idT, (<-<)), Interact(request, (/</), respond, (/>/)) )+    Channel(idT, (<-<)), Interact(request, (/</), respond, (\<\)) ) import Data.Closed (C) -{- $types-    A 'Proxy' communicates with an upstream interface and a downstream+{-| A 'Proxy' communicates with an upstream interface and a downstream     interface.      The type variables of @Proxy req_a resp_a req_b resp_b m r@ signify:@@ -52,91 +47,81 @@     * @m     @ - The base monad      * @r     @ - The final return value -}---- | The base functor for the 'Proxy' type-data ProxyF a' a b' b x = Request a' (a -> x) | Respond b (b' -> x)--instance Functor (ProxyF a' a b' b) where-    fmap f (Respond b  fb') = Respond b  (f . fb')-    fmap f (Request a' fa ) = Request a' (f . fa )---- | A 'Proxy' converts one interface to another-newtype Proxy a' a b' b m r = Proxy { unProxy :: FreeT (ProxyF a' a b' b) m r }+data Proxy a' a b' b m r+  = Request a' (a  -> Proxy a' a b' b m r )+  | Respond b  (b' -> Proxy a' a b' b m r )+  | M          (m    (Proxy a' a b' b m r))+  | Pure r  instance (Monad m) => Functor (Proxy a' a b' b m) where-    fmap = liftM+    fmap f p0 = go p0 where+        go p = case p of+            Request a' fa  -> Request a' (\a  -> go (fa  a ))+            Respond b  fb' -> Respond b  (\b' -> go (fb' b'))+            M          m   -> M (m >>= \p' -> return (go p'))+            Pure       r   -> Pure (f r)  instance (Monad m) => Applicative (Proxy a' a b' b m) where-    pure  = return-    (<*>) = ap+    pure  = Pure+    pf <*> px = go pf where+        go p = case p of+            Request a' fa  -> Request a' (\a  -> go (fa  a ))+            Respond b  fb' -> Respond b  (\b' -> go (fb' b'))+            M          m   -> M (m >>= \p' -> return (go p'))+            Pure       f   -> fmap f px  instance (Monad m) => Monad (Proxy a' a b' b m) where-    return  = Proxy . return-    m >>= f = Proxy $ unProxy m >>= unProxy . f+    return = Pure+    p0 >>= f = go p0 where+        go p = case p of+            Request a' fa  -> Request a' (\a  -> go (fa  a))+            Respond b  fb' -> Respond b  (\b' -> go (fb' b'))+            M m            -> M (m >>= \p' -> return (go p'))+            Pure r         -> f r  instance MonadTrans (Proxy a' a b' b) where-    lift = Proxy . lift+    lift = M . liftM Pure  instance (MonadIO m) => MonadIO (Proxy a' a b' b m) where-    liftIO = Proxy . liftIO+    liftIO = M . liftIO . liftM Pure  instance Channel Proxy where-    idT       = Proxy . idT'-    p1 <-< p2 = Proxy . ((unProxy . p1) <-<? (unProxy . p2))--idT' :: (Monad m) => a' -> FreeT (ProxyF a' a a' a) m r-idT' a' = wrap $ Request a' $ \a -> wrap $ Respond a idT'--(<-<?) :: (Monad m)- => (c' -> FreeT (ProxyF b' b c' c) m r)- -> (b' -> FreeT (ProxyF a' a b' b) m r)- -> (c' -> FreeT (ProxyF a' a c' c) m r)-p1 <-<? p2 = \c' -> FreeT $ do-    x1 <- runFreeT $ p1 c'-    runFreeT $ case x1 of-        Pure             r    -> return r-        Free (Respond c  fc') -> wrap $ Respond c (fc' <-<? p2)-        Free (Request b' fb ) -> FreeT $ do-            x2 <- runFreeT $ p2 b'-            runFreeT $ case x2 of-                Pure             r    -> return r-                Free (Respond b  fb') -> ((\_ -> fb b) <-<? fb') c'-                Free (Request a' fa ) -> do-                    let p1' = \_ -> FreeT $ return x1-                    wrap $ Request a' $ \a -> (p1' <-<? (\_ -> fa a)) c'+    idT = \a' -> Request a' $ \a -> Respond a idT+    k1 <-< k2_0 = \c' -> k1 c' |-< k2_0 where+        p1 |-< k2 = case p1 of+            Request b' fb  -> fb <-| k2 b'+            Respond c  fc' -> Respond c (\c' -> fc' c' |-< k2)+            M          m   -> M (m >>= \p1' -> return (p1' |-< k2))+            Pure       r   -> Pure r+        fb <-| p2 = case p2 of+            Request a' fa  -> Request a' (\a -> fb <-| fa a) +            Respond b  fb' -> fb b |-< fb'+            M          m   -> M (m >>= \p2' -> return (fb <-| p2'))+            Pure       r   -> Pure r  instance Interact Proxy where-    request a' = Proxy $ liftF $ Request a' id-    p1 /</ p2 = (Proxy .) $ (unProxy . p1) /</? (unProxy . p2)-    respond a = Proxy $ liftF $ Respond a id-    p1 />/ p2 = (Proxy .) $ (unProxy . p1) />/? (unProxy . p2)--(/</?)- :: (Monad m)- => (c' -> FreeT (ProxyF b' b x' x) m c)- -> (b' -> FreeT (ProxyF a' a x' x) m b)- -> (c' -> FreeT (ProxyF a' a x' x) m c)-f1 /</? f2 = \a' -> FreeT $ do-    x1 <- runFreeT $ f1 a'-    runFreeT $ case x1 of-        Pure a                -> return a-        Free (Respond x  fx') -> wrap $ Respond x $ fx' /</? f2-        Free (Request b' fb ) -> (f2 >=> (fb /</? f2)) b'--(/>/?)- :: (Monad m)- => (a -> FreeT (ProxyF x' x b' b) m a')- -> (b -> FreeT (ProxyF x' x c' c) m b')- -> (a -> FreeT (ProxyF x' x c' c) m a')-f1 />/? f2 = \a' -> FreeT $ do-    x1 <- runFreeT $ f1 a'-    runFreeT $ case x1 of-        Pure a'               -> return a'-        Free (Respond b  fb') -> (f2 >=> (fb' />/? f2)) b-        Free (Request x' fx ) -> wrap $ Request x' $ fx />/? f2+    request a' = Request a' Pure+    k1 /</ k2 = \a' -> go (k1 a') where+        go p = case p of+            Request b' fb  -> k2 b' >>= \b -> go (fb b)+            Respond x  fx' -> Respond x (\x' -> go (fx' x'))+            M          m   -> M (m >>= \p' -> return (go p'))+            Pure       a   -> Pure a+    respond a = Respond a Pure+    k1 \<\ k2 = \a' -> go (k2 a') where+        go p = case p of+            Request x' fx  -> Request x' (\x -> go (fx x))+            Respond b  fb' -> k1 b >>= \b' -> go (fb' b')+            M          m   -> M (m >>= \p' -> return (go p'))+            Pure       a   -> Pure a  instance MFunctor (Proxy a' a b' b) where-    mapT nat = Proxy . hoistFreeT nat . unProxy+    mapT nat p0 = go p0 where+        go p = case p of+            Request a' fa  -> Request a' (\a  -> go (fa  a ))+            Respond b  fb' -> Respond b  (\b' -> go (fb' b'))+            M          m   -> M (nat (m >>= \p' -> return (go p')))+            Pure       r   -> Pure r  {-| @Server req resp@ receives requests of type @req@ and sends responses of     type @resp@.@@ -190,21 +175,18 @@  {-| Run a self-sufficient 'Proxy' Kleisli arrow, converting it back to the base     monad -}-runProxy :: (Monad m) => (() -> Proxy a () () b m r) -> m r-runProxy p = runProxyK p ()+runProxy :: (Monad m) => (() -> Proxy a' () () b m r) -> m r+runProxy k = go (k ()) where+    go p = case p of+        Request _ fa  -> go (fa  ())+        Respond _ fb' -> go (fb' ())+        M         m   -> m >>= go+        Pure      r   -> return r  {-| Run a self-sufficient 'Proxy' Kleisli arrow, converting it back to a Kleisli     arrow in the base monad -} runProxyK :: (Monad m) => (() -> Proxy a () () b m r) -> (() -> m r)-runProxyK p = runProxy' . unProxy . p--runProxy' :: (Monad m) => FreeT (ProxyF a () () b) m r -> m r-runProxy' p = do-    x <- runFreeT p-    case x of-        Pure            r    -> return r-        Free (Respond _ fb ) -> runProxy' $ fb  ()-        Free (Request _ fa') -> runProxy' $ fa' ()+runProxyK p = \() -> runProxy p  {-| Run a self-contained 'Session' Kleisli arrow, converting it back to the base     monad -}@@ -226,8 +208,10 @@  -- | Discard all responses discard :: (Monad m) => () -> Proxy () a () C m r-discard () = forever $ request ()+discard _ = go where+    go = Request () (\_ -> go)  -- | Ignore all requests ignore  :: (Monad m) => a -> Proxy C () a () m r-ignore  _  = forever $ respond ()+ignore _ = go where+    go = Respond () (\_ -> go)

@@ -21,8 +21,6 @@     runPipe     ) where -import Control.Monad (forever)-import Control.Monad.Trans.Free import Control.Proxy.Core import Control.Proxy.Class import Data.Closed (C)@@ -52,18 +50,19 @@     'await' blocks until input is available -} await :: (Monad m) => Pipe a b m a await = request ()+{-# INLINE await #-}  -- | Convert a pure function into a pipe pipe :: (Monad m) => (a -> b) -> Pipe a b m r-pipe f = forever $ do-    x <- await-    yield (f x)+pipe f = go where+    go = Request () (\a -> Respond (f a) (\() -> go))  {-| Deliver output downstream      'yield' restores control back downstream and binds the result to 'await'. -} yield :: (Monad m) => b -> Pipe a b m () yield = respond+{-# INLINE yield #-}  infixr 9 <+< infixl 9 >+>@@ -78,15 +77,14 @@  -- | Corresponds to 'id' from @Control.Category@ idP :: (Monad m) => Pipe a a m r-idP = idT ()+idP = go where+    go = Request () (\a -> Respond a (\() -> go))  -- | Run the 'Pipe' monad transformer, converting it back to the base monad runPipe :: (Monad m) => Pipeline m r -> m r-runPipe = runPipe' . unProxy--runPipe' p = do-    x <- runFreeT p-    case x of-        Pure r -> return r-        Free (Request _ f) -> runPipe' (f ())-        Free (Respond _ f) -> runPipe' (f ())+runPipe p' = go p' where+    go p = case p of+        Request _ fa  -> go (fa  ())+        Respond _ fb' -> go (fb' ())+        M         m   -> m >>= go+        Pure      r   -> return r

@@ -35,7 +35,7 @@ import Control.Monad (replicateM_, void, when, (>=>)) import Control.Monad.Trans.Class (lift) import Control.Proxy.Class (request, respond, idT)-import Control.Proxy.Core (Proxy, Server, Client)+import Control.Proxy.Core (Proxy(..), Server, Client) import Control.Proxy.Prelude.Kleisli (foreverK, replicateK)  {-| @(mapB f g)@ applies @f@ to all values going downstream and @g@ to all@@ -48,7 +48,9 @@ > mapB id id = idT -} mapB :: (Monad m) => (a -> b) -> (b' -> a') -> b' -> Proxy a' a b' b m r-mapB f g = foreverK $ (request . g) >=> (respond . f)+mapB f g = go where+    go b' = Request (g b') (\a -> Respond (f a) go)+-- mapB f g = foreverK $ request . g >=> respond . f  {-| @(mapD f)@ applies @f@ to all values going \'@D@\'ownstream. @@ -57,7 +59,9 @@ > mapD id = idT -} mapD :: (Monad m) => (a -> b) -> x -> Proxy x a x b m r-mapD f = foreverK $ request >=> (respond . f)+mapD f = go where+    go x = Request x (\a -> Respond (f a) go)+-- mapD f = foreverK $ request >=> respond . f  {-| @(mapU g)@ applies @g@ to all values going \'@U@\'pstream. @@ -66,7 +70,9 @@ > mapU id = idT -} mapU :: (Monad m) => (b' -> a') -> b' -> Proxy a' x b' x m r-mapU g = foreverK $ (request . g) >=> respond+mapU g = go where+    go b' = Request (g b') (\x -> Respond x go)+-- mapU g = foreverK $ (request . g) >=> respond  {-| @(mapMB f g)@ applies the monadic function @f@ to all values going     downstream and the monadic function @g@ to all values going upstream.@@ -76,7 +82,13 @@ > mapMB return return = idT -} mapMB :: (Monad m) => (a -> m b) -> (b' -> m a') -> b' -> Proxy a' a b' b m r-mapMB f g = foreverK $ lift . g >=> request >=> lift . f >=> respond+mapMB f g = go where+    go b' =+        M (g b' >>= \a' -> return (+        Request a' (\a ->+        M (f a >>= \b -> return (+        Respond b go )))))+-- mapMB f g = foreverK $ lift . g >=> request >=> lift . f >=> respond  {-| @(mapMD f)@ applies the monadic function @f@ to all values going downstream @@ -85,7 +97,12 @@ > mapMD return = idT -} mapMD :: (Monad m) => (a -> m b) -> x -> Proxy x a x b m r-mapMD f = foreverK $ request >=> lift . f >=> respond+mapMD f = go where+    go x =+        Request x (\a ->+        M (f a >>= \b -> return (+        Respond b go )))+-- mapMDf = foreverK $ request >=> lift . f >=> respond  {-| @(mapMU g)@ applies the monadic function @g@ to all values going upstream @@ -94,7 +111,12 @@ > mapMU return = idT -} mapMU :: (Monad m) => (b' -> m a') -> b' -> Proxy a' x b' x m r-mapMU g = foreverK $ lift . g >=> request >=> respond+mapMU g = go where+    go b' =+        M (g b' >>= \a' -> return (+        Request a' (\x ->+        Respond x go )))+-- mapMU g = foreverK $ lift . g >=> request >=> respond  {-| @(execB md mu)@ executes @mu@ every time values flow upstream through it,     and executes @md@ every time values flow downstream through it.@@ -104,11 +126,17 @@ > execB (return ()) = idT -} execB :: (Monad m) => m () -> m () -> a' -> Proxy a' a a' a m r-execB md mu = foreverK $ \a' -> do+execB md mu = go where+    go a' =+        M (mu >>= \_ -> return (+        Request a' (\a ->+        M (md >>= \_ -> return (+        Respond a go )))))+{- execB md mu = foreverK $ \a' -> do     lift mu     a <- request a'     lift md-    respond a+    respond a -}  {-| @execD md)@ executes @md@ every time values flow downstream through it. @@ -117,10 +145,15 @@ > execD (return ()) = idT -} execD :: (Monad m) => m () -> a' -> Proxy a' a a' a m r-execD md = foreverK $ \a' -> do+execD md = go where+    go a' =+        Request a' (\a ->+        M (md >>= \_ -> return (+        Respond a go )))+{- execD md = foreverK $ \a' -> do     a <- request a'     lift md-    respond a+    respond a -}  {-| @execU mu)@ executes @mu@ every time values flow upstream through it. @@ -129,10 +162,15 @@ > execU (return ()) = idT -} execU :: (Monad m) => m () -> a' -> Proxy a' a a' a m r-execU mu = foreverK $ \a' -> do+execU mu = go where+    go a' =+        M (mu >>= \_ -> return (+        Request a' (\a ->+        Respond a go )))+{- execU mu = foreverK $ \a' -> do     lift mu     a <- request a'-    respond a+    respond a -}  {-| @(takeB n)@ allows @n@ upstream/downstream roundtrips to pass through @@ -141,11 +179,20 @@ > takeB 0 = return -} takeB :: (Monad m) => Int -> a' -> Proxy a' a a' a m a'-takeB n = replicateK n $ request >=> respond+takeB n0 = go n0 where+    go n+        | n <= 0    = Pure+        | otherwise = \a' -> Request a' (\a -> Respond a (go (n - 1)))+-- takeB n = replicateK n $ request >=> respond --- | 'takeB_' is 'takeB' with a @()@  return value, convenient for composing+-- | 'takeB_' is 'takeB' with a @()@ return value, convenient for composing takeB_ :: (Monad m) => Int -> a' -> Proxy a' a a' a m ()-takeB_ n = fmap void (takeB n)+takeB_ n0 = go n0 where+    go n+        | n <= 0    = \_ -> Pure ()+        | otherwise = \a' -> Request a' (\a -> Respond a (go (n - 1)))+    +-- takeB_ n = fmap void (takeB n)  {-| @takeWhileD p@ allows values to pass downstream so long as they satisfy the      predicate @p@.@@ -160,13 +207,18 @@ -} takeWhileD :: (Monad m) => (a -> Bool) -> a' -> Proxy a' a a' a m () takeWhileD p = go where-    go a' = do+    go a' =+        Request a' (\a ->+        if (p a)+        then Respond a go+        else Pure () )+{-  go a' = do         a <- request a'         if (p a)         then do             a'2 <- respond a             go a'2-        else return ()+        else return () -}  {-| @takeWhileU p@ allows values to pass upstream so long as they satisfy the     predicate @p@.@@ -179,11 +231,15 @@ takeWhileU p = go where     go a' =         if (p a')+        then Request a' (\a -> Respond a go)+        else Pure ()+{-  go a' =+        if (p a')         then do             a <- request a'             a'2 <- respond a             go a'2-        else return ()+        else return () -}  {-| @(dropD n)@ discards @n@ values going downstream @@ -192,9 +248,13 @@ > dropD 0 = idT -} dropD :: (Monad m) => Int -> () -> Proxy () a () a m r-dropD n () = do+dropD n0 = \() -> go n0 where+    go n+        | n <= 0    = idT ()+        | otherwise = Request () (\_ -> go (n - 1))+{- dropD n () = do     replicateM_ n $ request ()-    idT ()+    idT () -}  {-| @(dropU n)@ discards @n@ values going upstream @@ -203,12 +263,18 @@ > dropU 0 = idT -} dropU :: (Monad m) => Int -> a' -> Proxy a' () a' () m r-dropU n a'+dropU n0+    | n0 <= 0    = idT+    | otherwise = go (n0 - 1) where+        go n+            | n <= 0    = \_ -> Respond () idT+            | otherwise = \_ -> Respond () (go (n - 1))+{- dropU n a'     | n <= 0    = idT a'     | otherwise = do         replicateM_ (n - 1) $ respond ()         a'2 <- respond ()-        idT a'2+        idT a'2 -}  {-| @(dropWhileD p)@ discards values going upstream until one violates the     predicate @p@.@@ -223,13 +289,14 @@ -} dropWhileD :: (Monad m) => (a -> Bool) -> () -> Proxy () a () a m r dropWhileD p () = go where-    go = do+    go = Request () (\a -> if (p a) then go else Respond a idT)+{-  go = do         a <- request ()         if (p a)         then go         else do             respond a-            idT ()+            idT () -}  {-| @(dropWhileU p)@ discards values going downstream until one violates the     predicate @p@.@@ -240,12 +307,13 @@ -} dropWhileU :: (Monad m) => (a' -> Bool) -> a' -> Proxy a' () a' () m r dropWhileU p = go where-    go a' =+    go a' = if (p a') then Respond () go else idT a'+{-  go a' =         if (p a')         then do-            a' <- respond ()-            go a'-        else idT a'+            a'2 <- respond ()+            go a'2+        else idT a' -}  {-| @(filterD p)@ discards values going downstream if they fail the predicate     @p@@@ -259,11 +327,12 @@ > filterD mempty = idT -} filterD :: (Monad m) => (a -> Bool) -> () -> Proxy () a () a m r-filterD p () = go where-    go = do+filterD p = \() ->  go where+    go = Request () (\a -> if (p a) then Respond a (\_ -> go) else go)+{-  go = do         a <- request ()         when (p a) $ respond a-        go+        go -}  {-| @(filterU p)@ discards values going upstream if they fail the predicate @p@ @@ -272,11 +341,15 @@ > filterU mempty = idT -} filterU :: (Monad m) => (a' -> Bool) -> a' -> Proxy a' () a' () m r-filterU p a' = go a' where-    go a' = do+filterU p a'0 = go a'0 where+    go a' =+        if (p a')+        then Request a' (\_ -> Respond () go)+        else Respond () go+{-  go a' = do         when (p a') $ request a'         a'2 <- respond ()-        go a'2+        go a'2 -}  {-| Convert a list into a 'Server' @@ -284,8 +357,10 @@ > > fromListS [] = return -}-fromListS :: (Monad m) => [a] -> () -> Server () a m ()-fromListS xs () = mapM_ respond xs+fromListS :: (Monad m) => [a] -> () -> Proxy x' x () a m ()+fromListS xs = \_ -> foldr (\e a -> Respond e (\_ -> a)) (Pure ()) xs+{-# INLINE fromListS #-}+-- fromListS xs _ = mapM_ respond xs  {-| Convert a list into a 'Client' @@ -293,37 +368,37 @@ > > fromListC [] = return -}-fromListC :: (Monad m) => [a] -> () -> Client a () m ()-fromListC xs () = mapM_ request xs+fromListC :: (Monad m) => [a] -> () -> Proxy a x () y m ()+fromListC xs = \_ -> foldr (\e a -> Request e (\_ -> a)) (Pure ()) xs+{-# INLINE fromListC #-}+-- fromListC xs _ = mapM_ request xs  -- | 'Server' version of 'enumFrom'-enumFromS :: (Enum a, Monad m) => a -> () -> Server () a m r-enumFromS a () = go a where-    go a = do-        respond a-        go (succ a)+enumFromS :: (Enum a, Monad m) => a -> y' -> Proxy x' x y' a m r+enumFromS a0 = \_ -> go a0 where+    go a = Respond a (\_ -> go (succ a))+{-  go a = do+        _ <- respond a+        go (succ a) -}  -- | 'Client' version of 'enumFrom'-enumFromC :: (Enum a, Monad m) => a -> () -> Client a () m r-enumFromC a () = go a where-    go a = do-        request a-        go (succ a)+enumFromC :: (Enum a, Monad m) => a -> y' -> Proxy a x y' y m r+enumFromC a0 = \_ -> go a0 where+    go a = Request a (\_ -> go (succ a))+{-  go a = do+        _ <- request a+        go (succ a) -}  -- | 'Server' version of 'enumFromTo'-enumFromToS :: (Enum a, Ord a, Monad m) => a -> a -> () -> Server () a m ()-enumFromToS a1 a2 () = go a1 where+enumFromToS :: (Enum a, Ord a, Monad m) => a -> a -> y' -> Proxy x' x y' a m ()+enumFromToS a1 a2 _ = go a1 where     go n-        | n > a2   = return ()-        | otherwise = do-            respond n-            go (succ n)+        | n > a2    = Pure ()+        | otherwise = Respond n (\_ -> go (succ n))  -- | 'Client' version of 'enumFromTo'-enumFromToC :: (Enum a, Ord a, Monad m) => a -> a -> () -> Client a () m ()-enumFromToC a1 a2 () = go a1 where+enumFromToC :: (Enum a, Ord a, Monad m) => a -> a -> y' -> Proxy a x y' y m ()+enumFromToC a1 a2 _ = go a1 where     go n-        | n > a2 = return ()-        | otherwise = do-            request n-            go (succ n)+        | n > a2 = Pure ()+        | otherwise = Request n (\_ -> go (succ n))

@@ -44,26 +44,26 @@ import System.IO (Handle, hGetLine, hPutStr, hPutStrLn, hPrint, stdin, stdout)  -- | Get input from 'stdin' one line at a time and send \'@D@\'ownstream-getLineS :: () -> Server () String IO r-getLineS () = forever $ do+getLineS :: y' -> Proxy x' x y' String IO r+getLineS _ = forever $ do     str <- lift getLine     respond str  -- | Get input from 'stdin' one line at a time and send \'@U@\'pstream-getLineC :: () -> Client String () IO r-getLineC () = forever $ do+getLineC :: y' -> Proxy String x y' y IO r+getLineC _ = forever $ do     str <- lift getLine     request str  -- | 'read' input from 'stdin' one line at a time and send \'@D@\'ownstream-readLnS :: (Read a) => () -> Server () a IO r-readLnS () = forever $ do+readLnS :: (Read a) => y' -> Proxy x' x y' a IO r+readLnS _ = forever $ do     a <- lift readLn     respond a  -- | 'read' input from 'stdin' one line at a time and send \'@U@\'pstream-readLnC :: (Read a) => () -> Client a () IO r-readLnC () = forever $ do+readLnC :: (Read a) => y' -> Proxy a x y' y IO r+readLnC _ = forever $ do     a <- lift readLn     request a @@ -126,7 +126,7 @@     respond x  -- | Convert 'stdin'/'stdout' into a line-based 'Server'-promptS :: String -> Server String String IO r+promptS :: String -> Proxy x' x String String IO r promptS = foreverK $ \send -> do     recv <- lift $ do         putStrLn send@@ -134,21 +134,21 @@     respond recv  -- | Convert 'stdin'/'stdout' into a line-based 'Client'-promptC :: () -> Client String String IO r-promptC () = forever $ do+promptC :: y' -> Proxy String String y' y IO r+promptC _ = forever $ do     send <- lift getLine     recv <- request send     lift $ putStrLn recv  -- | Get input from a handle one line at a time and send \'@D@\'ownstream-hGetLineD :: Handle -> () -> Server () String IO r-hGetLineD h () = forever $ do+hGetLineD :: Handle -> y' -> Proxy x' x y' String IO r+hGetLineD h _ = forever $ do     str <- lift $ hGetLine h     respond str  -- | Get input from a handle one line at a time and send \'@U@\'pstream-hGetLineU :: Handle -> () -> Client String () IO r-hGetLineU h () = forever $ do+hGetLineU :: Handle -> y' -> Proxy String x y' y IO r+hGetLineU h _ = forever $ do     str <- lift $ hGetLine h     request str 

@@ -36,7 +36,7 @@  -- | Repeat a \'@K@\'leisli arrow multiple times replicateK :: (Monad m) => Int -> (a -> m a) -> (a -> m a)-replicateK n k = go n where+replicateK n0 k = go n0 where     go n         | n < 1     = return         | n == 1    = k

@@ -41,7 +41,7 @@     m >>= f = EitherP $ do         e <- runEitherP m         runEitherP $ case e of-            Left  e -> left e+            Left  l -> left l             Right r -> f    r  instance (MonadPlus (p a' a b' b m))@@ -112,7 +112,7 @@ catch m f = EitherP $ do     e <- runEitherP m     runEitherP $ case e of-        Left  e -> f     e+        Left  l -> f     l         Right r -> right r  -- | 'catch' with the arguments flipped@@ -124,5 +124,5 @@ handle f m = EitherP $ do     e <- runEitherP m     runEitherP $ case e of-        Left  e -> f     e+        Left  l -> f     l         Right r -> right r

@@ -38,7 +38,7 @@ >     lift $ put (s + 1) >     respond () ->>> execWriterT $ runProxy $ client1 <-< server1+>>> (`evalStateT` 0) $ runProxy $ client1 <-< server1 Client: 0 Server: 1 Client: 2

@@ -56,7 +56,7 @@  instance (MonadPlus (p a' a b' b m))  => MonadPlus (WriterP w p a' a b' b m) where-    mzero = WriterP $ \w -> mzero+    mzero = WriterP $ \_ -> mzero     mplus m1 m2 = WriterP $ \w -> mplus (unWriterP m1 w) (unWriterP m2 w)  instance (MonadTrans (p a' a b' b))

@@ -2,7 +2,8 @@  module Data.Closed (     -- * Closed-    C ) where+    C+    ) where  -- | The empty type, denoting a \'@C@\'losed end-data C+data C = C -- Not exported, but I write it to keep the library Haskell98

@@ -1,5 +1,5 @@ Name: pipes-Version: 2.4.0+Version: 2.5.0 Cabal-Version: >=1.14.0 Build-Type: Simple License: BSD3@@ -20,19 +20,20 @@   * /Concise API/: This library uses a few simple abstractions with a very high     power-to-weight ratio to reduce adoption time.   .+  * /Bidirectionality/: The library offers bidirectional communication+  .+  * /Blazing fast/: Currently the fastest iteratee implementation+  .   * /Clear semantics/: All abstractions are grounded in category theory, which     leads to intuitive behavior (and fewer bugs, if any!).   .-  * /Bidirectionality/: The library provides a bidirectional type, called a-    'Proxy'.-  .   * /Extension Framework/: You can elegantly mix and match extensions to the     base type and easily create your own!   .   * /Extensive Documentation/: Second to none!   .   I recommend you begin by reading "Control.Pipe.Tutorial" which introduces the-  basic concepts using the simpler 'Pipe' API.  Then move on to+  basic concepts using the simpler unidirectional 'Pipe' API.  Then move on to   "Control.Proxy.Tutorial", which introduces the 'Proxy' type which forms the   core abstraction of this library.  To use extensions or define your own, check   out "Control.Proxy.Trans.Tutorial".@@ -48,9 +49,8 @@ Library     Build-Depends:         base >= 4 && < 5,-        free >= 3.2,         index-core,-        transformers+        transformers >= 0.2.0.0     Exposed-Modules:         Control.Frame,         Control.Frame.Tutorial,@@ -77,5 +77,4 @@         Control.Pipe.Core,         Control.Pipe.Tutorial,         Data.Closed-    GHC-Options: -O2-    Default-Language: Haskell2010+    Default-Language: Haskell98