packages feed

pipes 4.1.6 → 4.1.7

raw patch · 12 files changed

+5236/−5069 lines, 12 filesdep ~deepseqsetup-changed

Dependency ranges changed: deepseq

Files

LICENSE view
@@ -1,24 +1,24 @@-Copyright (c) 2012-2014 Gabriel Gonzalez-All rights reserved.--Redistribution and use in source and binary forms, with or without modification,-are permitted provided that the following conditions are met:-    * Redistributions of source code must retain the above copyright notice,-      this list of conditions and the following disclaimer.-    * Redistributions in binary form must reproduce the above copyright notice,-      this list of conditions and the following disclaimer in the documentation-      and/or other materials provided with the distribution.-    * Neither the name of Gabriel Gonzalez nor the names of other contributors-      may be used to endorse or promote products derived from this software-      without specific prior written permission.--THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND-ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED-WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE-DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR-ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES-(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;-LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON-ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT-(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS-SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.+Copyright (c) 2012-2014 Gabriel Gonzalez
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without modification,
+are permitted provided that the following conditions are met:
+    * Redistributions of source code must retain the above copyright notice,
+      this list of conditions and the following disclaimer.
+    * Redistributions in binary form must reproduce the above copyright notice,
+      this list of conditions and the following disclaimer in the documentation
+      and/or other materials provided with the distribution.
+    * Neither the name of Gabriel Gonzalez nor the names of other contributors
+      may be used to endorse or promote products derived from this software
+      without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR
+ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
+(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
+LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON
+ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
Setup.hs view
@@ -1,2 +1,2 @@-import Distribution.Simple-main = defaultMain+import Distribution.Simple
+main = defaultMain
benchmarks/LiftBench.hs view
@@ -1,68 +1,66 @@-{-# LANGUAGE RankNTypes #-}-module Main (main) where--import Common (commonMain)-import Control.DeepSeq-import Control.Monad.Identity-import qualified Control.Monad.Trans.Reader as R-import qualified Control.Monad.Trans.State.Strict as S-import Criterion.Main-import Data.Monoid-import Pipes-import Pipes.Lift--defaultMax :: Int-defaultMax = 10000--instance NFData a => NFData (Sum a)--main :: IO ()-main = commonMain defaultMax liftBenchmarks--iter :: forall m a . (Monad m , Ord a, Num a) => (a -> m a) -> a -> Effect m a-iter a vmax = loop 0-    where-        loop n-            | n > vmax  = return vmax-            | otherwise = do-                x <- lift $ a n-                loop $! x--s_bench :: Int -> Effect (S.StateT Int Identity) Int-s_bench = iter (\n -> S.get >>= (\a -> S.put $! a + n) >> return (n + 1))--r_bench :: Int -> Effect (R.ReaderT Int Identity) Int-r_bench = iter (\n -> R.ask >>= (\a -> return $ n + a))---- Run before Proxy-runB :: (a -> Effect Identity r) -> a -> r-runB f a = runIdentity $ runEffect $ f a---- Run after Proxy-runA :: (Monad m) => (m r -> Identity a) -> Effect m r -> a-runA f a = runIdentity $ f (runEffect a)--liftBenchmarks :: Int -> [Benchmark]-liftBenchmarks vmax =-    let applyBench = map ($ vmax)-    in-    [-      bgroup "ReaderT" $-        let defT f = (\d -> f d 1)-        in applyBench-        [-          bench "runReaderP_B" . whnf (runB (runReaderP 1) . r_bench)-        , bench "runReaderP_A" . whnf (runA (defT R.runReaderT) . r_bench)-        ]-    , bgroup "StateT" $-        let defT f = (\s -> f s 0)-        in applyBench-        [-          bench "runStateP_B"  . nf (runB (runStateP 0) . s_bench)-        , bench "runStateP_A"  . nf (runA (defT S.runStateT) . s_bench)-        , bench "evalStateP_B" . whnf (runB (evalStateP 0) . s_bench)-        , bench "evalStateP_A" . whnf (runA (defT S.evalStateT) . s_bench)-        , bench "execStateP_B" . whnf (runB (execStateP 0) . s_bench)-        , bench "execStateP_A" . whnf (runA (defT S.execStateT) . s_bench)-        ]-    ]+{-# LANGUAGE RankNTypes #-}
+module Main (main) where
+
+import Common (commonMain)
+import Control.DeepSeq
+import Control.Monad.Identity
+import qualified Control.Monad.Trans.Reader as R
+import qualified Control.Monad.Trans.State.Strict as S
+import Criterion.Main
+import Data.Monoid
+import Pipes
+import Pipes.Lift
+
+defaultMax :: Int
+defaultMax = 10000
+
+main :: IO ()
+main = commonMain defaultMax liftBenchmarks
+
+iter :: forall m a . (Monad m , Ord a, Num a) => (a -> m a) -> a -> Effect m a
+iter a vmax = loop 0
+    where
+        loop n
+            | n > vmax  = return vmax
+            | otherwise = do
+                x <- lift $ a n
+                loop $! x
+
+s_bench :: Int -> Effect (S.StateT Int Identity) Int
+s_bench = iter (\n -> S.get >>= (\a -> S.put $! a + n) >> return (n + 1))
+
+r_bench :: Int -> Effect (R.ReaderT Int Identity) Int
+r_bench = iter (\n -> R.ask >>= (\a -> return $ n + a))
+
+-- Run before Proxy
+runB :: (a -> Effect Identity r) -> a -> r
+runB f a = runIdentity $ runEffect $ f a
+
+-- Run after Proxy
+runA :: (Monad m) => (m r -> Identity a) -> Effect m r -> a
+runA f a = runIdentity $ f (runEffect a)
+
+liftBenchmarks :: Int -> [Benchmark]
+liftBenchmarks vmax =
+    let applyBench = map ($ vmax)
+    in
+    [
+      bgroup "ReaderT" $
+        let defT f = (\d -> f d 1)
+        in applyBench
+        [
+          bench "runReaderP_B" . whnf (runB (runReaderP 1) . r_bench)
+        , bench "runReaderP_A" . whnf (runA (defT R.runReaderT) . r_bench)
+        ]
+    , bgroup "StateT" $
+        let defT f = (\s -> f s 0)
+        in applyBench
+        [
+          bench "runStateP_B"  . nf (runB (runStateP 0) . s_bench)
+        , bench "runStateP_A"  . nf (runA (defT S.runStateT) . s_bench)
+        , bench "evalStateP_B" . whnf (runB (evalStateP 0) . s_bench)
+        , bench "evalStateP_A" . whnf (runA (defT S.evalStateT) . s_bench)
+        , bench "execStateP_B" . whnf (runB (execStateP 0) . s_bench)
+        , bench "execStateP_A" . whnf (runA (defT S.execStateT) . s_bench)
+        ]
+    ]
benchmarks/PreludeBench.hs view
@@ -1,85 +1,85 @@-{-# LANGUAGE RankNTypes #-}-module Main (main) where--import Criterion.Main-import Common (commonMain)-import Control.Monad.Identity (Identity, runIdentity)-import Pipes-import qualified Pipes.Prelude as P-import Prelude hiding (enumFromTo)--defaultMax :: Int-defaultMax = 10000--main :: IO ()-main = commonMain defaultMax preludeBenchmarks--enumFromTo :: (Int -> a) -> Int -> Int -> Producer a Identity ()-enumFromTo f n1 n2 = loop n1-    where-        loop n =-            if n <= n2-            then do-                yield $! f n-                loop $! n + 1-            else return ()-{-# INLINABLE enumFromTo #-}--drain :: Producer b Identity r -> r-drain p = runIdentity $ runEffect $ for p discard--msum :: (Monad m) => Producer Int m () -> m Int-msum = P.foldM (\a b -> return $ a + b) (return 0) return--scanMSum :: (Monad m) => Pipe Int Int m r-scanMSum = P.scanM (\x y -> return (x + y)) (return 0) return---- Using runIdentity seems to reduce outlier counts.-preludeBenchmarks :: Int -> [Benchmark]-preludeBenchmarks vmax =-    let applyBench b = b benchEnum_p-        benchEnum_p  = enumFromTo id 1 vmax-    in-    [-      bgroup "Folds" $ map applyBench-        [-          bench "all"       . whnf (runIdentity . P.all (<= vmax))-        , bench "any"       . whnf (runIdentity . P.any (> vmax))-        , bench "find"      . whnf (runIdentity . P.find (== vmax))-        , bench "findIndex" . whnf (runIdentity . P.findIndex (== vmax))-        , bench "fold"      . whnf (runIdentity . P.fold (+) 0 id)-        , bench "foldM"     . whnf (runIdentity . msum)-        , bench "head"      . nf (runIdentity . P.head)-        , bench "index"     . nf (runIdentity . P.index (vmax-1))-        , bench "last"      . nf (runIdentity . P.last)-        , bench "length"    . whnf (runIdentity . P.length)-        , bench "null"      . whnf (runIdentity  . P.null)-        , bench "toList"    . nf P.toList-        ]-    , bgroup "Pipes" $ map applyBench-        [-          bench "chain"       . whnf (drain . (>-> P.chain (\_ -> return ())))-        , bench "drop"        . whnf (drain . (>-> P.drop vmax))-        , bench "dropWhile"   . whnf (drain . (>-> P.dropWhile (<= vmax)))-        , bench "filter"      . whnf (drain . (>-> P.filter even))-        , bench "findIndices" . whnf (drain . (>-> P.findIndices (<= vmax)))-        , bench "map"         . whnf (drain . (>-> P.map id))-        , bench "mapM"        . whnf (drain . (>-> P.mapM return))-        , bench "take"        . whnf (drain . (>-> P.take vmax))-        , bench "takeWhile"   . whnf (drain . (>-> P.takeWhile (<= vmax)))-        , bench "scan"        . whnf (drain . (>-> P.scan (+) 0 id))-        , bench "scanM"       . whnf (drain . (>-> scanMSum))-        ] ++ [-          bench "concat" $ whnf (drain . (>-> P.concat)) $ enumFromTo Just 1 vmax-        ]-    , bgroup "Zips" $ map applyBench-        [-          bench "zip"     . whnf (drain . P.zip benchEnum_p)-        , bench "zipWith" . whnf (drain . P.zipWith (+) benchEnum_p)-        ]-    , bgroup "enumFromTo.vs.each"-        [-          bench "enumFromTo" $ whnf (drain . enumFromTo id 1) vmax-        , bench "each"       $ whnf (drain . each) [1..vmax]-        ]-    ]+{-# LANGUAGE RankNTypes #-}
+module Main (main) where
+
+import Criterion.Main
+import Common (commonMain)
+import Control.Monad.Identity (Identity, runIdentity)
+import Pipes
+import qualified Pipes.Prelude as P
+import Prelude hiding (enumFromTo)
+
+defaultMax :: Int
+defaultMax = 10000
+
+main :: IO ()
+main = commonMain defaultMax preludeBenchmarks
+
+enumFromTo :: (Int -> a) -> Int -> Int -> Producer a Identity ()
+enumFromTo f n1 n2 = loop n1
+    where
+        loop n =
+            if n <= n2
+            then do
+                yield $! f n
+                loop $! n + 1
+            else return ()
+{-# INLINABLE enumFromTo #-}
+
+drain :: Producer b Identity r -> r
+drain p = runIdentity $ runEffect $ for p discard
+
+msum :: (Monad m) => Producer Int m () -> m Int
+msum = P.foldM (\a b -> return $ a + b) (return 0) return
+
+scanMSum :: (Monad m) => Pipe Int Int m r
+scanMSum = P.scanM (\x y -> return (x + y)) (return 0) return
+
+-- Using runIdentity seems to reduce outlier counts.
+preludeBenchmarks :: Int -> [Benchmark]
+preludeBenchmarks vmax =
+    let applyBench b = b benchEnum_p
+        benchEnum_p  = enumFromTo id 1 vmax
+    in
+    [
+      bgroup "Folds" $ map applyBench
+        [
+          bench "all"       . whnf (runIdentity . P.all (<= vmax))
+        , bench "any"       . whnf (runIdentity . P.any (> vmax))
+        , bench "find"      . whnf (runIdentity . P.find (== vmax))
+        , bench "findIndex" . whnf (runIdentity . P.findIndex (== vmax))
+        , bench "fold"      . whnf (runIdentity . P.fold (+) 0 id)
+        , bench "foldM"     . whnf (runIdentity . msum)
+        , bench "head"      . nf (runIdentity . P.head)
+        , bench "index"     . nf (runIdentity . P.index (vmax-1))
+        , bench "last"      . nf (runIdentity . P.last)
+        , bench "length"    . whnf (runIdentity . P.length)
+        , bench "null"      . whnf (runIdentity  . P.null)
+        , bench "toList"    . nf P.toList
+        ]
+    , bgroup "Pipes" $ map applyBench
+        [
+          bench "chain"       . whnf (drain . (>-> P.chain (\_ -> return ())))
+        , bench "drop"        . whnf (drain . (>-> P.drop vmax))
+        , bench "dropWhile"   . whnf (drain . (>-> P.dropWhile (<= vmax)))
+        , bench "filter"      . whnf (drain . (>-> P.filter even))
+        , bench "findIndices" . whnf (drain . (>-> P.findIndices (<= vmax)))
+        , bench "map"         . whnf (drain . (>-> P.map id))
+        , bench "mapM"        . whnf (drain . (>-> P.mapM return))
+        , bench "take"        . whnf (drain . (>-> P.take vmax))
+        , bench "takeWhile"   . whnf (drain . (>-> P.takeWhile (<= vmax)))
+        , bench "scan"        . whnf (drain . (>-> P.scan (+) 0 id))
+        , bench "scanM"       . whnf (drain . (>-> scanMSum))
+        ] ++ [
+          bench "concat" $ whnf (drain . (>-> P.concat)) $ enumFromTo Just 1 vmax
+        ]
+    , bgroup "Zips" $ map applyBench
+        [
+          bench "zip"     . whnf (drain . P.zip benchEnum_p)
+        , bench "zipWith" . whnf (drain . P.zipWith (+) benchEnum_p)
+        ]
+    , bgroup "enumFromTo.vs.each"
+        [
+          bench "enumFromTo" $ whnf (drain . enumFromTo id 1) vmax
+        , bench "each"       $ whnf (drain . each) [1..vmax]
+        ]
+    ]
pipes.cabal view
@@ -1,102 +1,102 @@-Name: pipes-Version: 4.1.6-Cabal-Version: >= 1.10-Build-Type: Simple-License: BSD3-License-File: LICENSE-Copyright: 2012-2014 Gabriel Gonzalez-Author: Gabriel Gonzalez-Maintainer: Gabriel439@gmail.com-Bug-Reports: https://github.com/Gabriel439/Haskell-Pipes-Library/issues-Synopsis: Compositional pipelines-Description:-  `pipes` is a clean and powerful stream processing library that lets you build-  and connect reusable streaming components-  .-  Advantages over traditional streaming libraries:-  .-  * /Concise API/: Use simple commands like 'for', ('>->'), 'await', and 'yield'-  .-  * /Blazing fast/: Implementation tuned for speed, including shortcut fusion-  .-  * /Lightweight Dependency/: @pipes@ is small and compiles very rapidly,-    including dependencies-  .-  * /Elegant semantics/: Use practical category theory-  .-  * /ListT/: Correct implementation of 'ListT' that interconverts with pipes-  .-  * /Bidirectionality/: Implement duplex channels-  .-  * /Extensive Documentation/: Second to none!-  .-  Import "Pipes" to use the library.-  .-  Read "Pipes.Tutorial" for an extensive tutorial.-Category: Control, Pipes-Source-Repository head-    Type: git-    Location: https://github.com/Gabriel439/Haskell-Pipes-Library--Library-    Default-Language: Haskell2010--    HS-Source-Dirs: src-    Build-Depends:-        base         >= 4.4     && < 5  ,-        transformers >= 0.2.0.0 && < 0.5,-        mmorph       >= 1.0.0   && < 1.1,-        mtl          >= 2.1     && < 2.3--    Exposed-Modules:-        Pipes,-        Pipes.Core,-        Pipes.Internal,-        Pipes.Lift,-        Pipes.Prelude,-        Pipes.Tutorial-    GHC-Options: -O2 -Wall--Benchmark prelude-benchmarks-    Default-Language: Haskell2010-    Type:             exitcode-stdio-1.0-    HS-Source-Dirs:   benchmarks-    Main-Is:          PreludeBench.hs-    GHC-Options:     -O2 -Wall -rtsopts -fno-warn-unused-do-bind--    Build-Depends:-        base      >= 4.4     && < 5  ,-        criterion >= 0.6.2.1 && < 1.2,-        mtl       >= 2.1     && < 2.3,-        pipes     >= 4.0.0   && < 4.2--test-suite tests-    Default-Language: Haskell2010-    Type:             exitcode-stdio-1.0-    HS-Source-Dirs:   tests-    Main-Is:          Main.hs-    GHC-Options:      -Wall -rtsopts -fno-warn-missing-signatures -fno-enable-rewrite-rules--    Build-Depends:-        base                       >= 4.4     && < 5   ,-        pipes                      >= 4.0.0   && < 4.2 ,-        QuickCheck                 >= 2.4     && < 3   ,-        mtl                        >= 2.1     && < 2.3 ,-        test-framework             >= 0.4     && < 1   ,-        test-framework-quickcheck2 >= 0.2.0   && < 0.4 ,-        transformers               >= 0.2.0.0 && < 0.5--Benchmark lift-benchmarks-    Default-Language: Haskell2010-    Type:             exitcode-stdio-1.0-    HS-Source-Dirs:   benchmarks-    Main-Is:          LiftBench.hs-    GHC-Options:     -O2 -Wall -rtsopts -fno-warn-unused-do-bind--    Build-Depends:-        base         >= 4.4     && < 5  ,-        criterion    >= 0.6.2.1 && < 1.2,-        deepseq                         ,-        mtl          >= 2.1     && < 2.3,-        pipes        >= 4.0.0   && < 4.2,-        transformers >= 0.2.0.0 && < 0.5+Name: pipes
+Version: 4.1.7
+Cabal-Version: >= 1.10
+Build-Type: Simple
+License: BSD3
+License-File: LICENSE
+Copyright: 2012-2014 Gabriel Gonzalez
+Author: Gabriel Gonzalez
+Maintainer: Gabriel439@gmail.com
+Bug-Reports: https://github.com/Gabriel439/Haskell-Pipes-Library/issues
+Synopsis: Compositional pipelines
+Description:
+  `pipes` is a clean and powerful stream processing library that lets you build
+  and connect reusable streaming components
+  .
+  Advantages over traditional streaming libraries:
+  .
+  * /Concise API/: Use simple commands like 'for', ('>->'), 'await', and 'yield'
+  .
+  * /Blazing fast/: Implementation tuned for speed, including shortcut fusion
+  .
+  * /Lightweight Dependency/: @pipes@ is small and compiles very rapidly,
+    including dependencies
+  .
+  * /Elegant semantics/: Use practical category theory
+  .
+  * /ListT/: Correct implementation of 'ListT' that interconverts with pipes
+  .
+  * /Bidirectionality/: Implement duplex channels
+  .
+  * /Extensive Documentation/: Second to none!
+  .
+  Import "Pipes" to use the library.
+  .
+  Read "Pipes.Tutorial" for an extensive tutorial.
+Category: Control, Pipes
+Source-Repository head
+    Type: git
+    Location: https://github.com/Gabriel439/Haskell-Pipes-Library
+
+Library
+    Default-Language: Haskell2010
+
+    HS-Source-Dirs: src
+    Build-Depends:
+        base         >= 4.4     && < 5  ,
+        transformers >= 0.2.0.0 && < 0.5,
+        mmorph       >= 1.0.0   && < 1.1,
+        mtl          >= 2.1     && < 2.3
+
+    Exposed-Modules:
+        Pipes,
+        Pipes.Core,
+        Pipes.Internal,
+        Pipes.Lift,
+        Pipes.Prelude,
+        Pipes.Tutorial
+    GHC-Options: -O2 -Wall
+
+Benchmark prelude-benchmarks
+    Default-Language: Haskell2010
+    Type:             exitcode-stdio-1.0
+    HS-Source-Dirs:   benchmarks
+    Main-Is:          PreludeBench.hs
+    GHC-Options:     -O2 -Wall -rtsopts -fno-warn-unused-do-bind
+
+    Build-Depends:
+        base      >= 4.4     && < 5  ,
+        criterion >= 0.6.2.1 && < 1.2,
+        mtl       >= 2.1     && < 2.3,
+        pipes     >= 4.0.0   && < 4.2
+
+test-suite tests
+    Default-Language: Haskell2010
+    Type:             exitcode-stdio-1.0
+    HS-Source-Dirs:   tests
+    Main-Is:          Main.hs
+    GHC-Options:      -Wall -rtsopts -fno-warn-missing-signatures -fno-enable-rewrite-rules
+
+    Build-Depends:
+        base                       >= 4.4     && < 5   ,
+        pipes                      >= 4.0.0   && < 4.2 ,
+        QuickCheck                 >= 2.4     && < 3   ,
+        mtl                        >= 2.1     && < 2.3 ,
+        test-framework             >= 0.4     && < 1   ,
+        test-framework-quickcheck2 >= 0.2.0   && < 0.4 ,
+        transformers               >= 0.2.0.0 && < 0.5
+
+Benchmark lift-benchmarks
+    Default-Language: Haskell2010
+    Type:             exitcode-stdio-1.0
+    HS-Source-Dirs:   benchmarks
+    Main-Is:          LiftBench.hs
+    GHC-Options:     -O2 -Wall -rtsopts -fno-warn-unused-do-bind
+
+    Build-Depends:
+        base         >= 4.4     && < 5  ,
+        criterion    >= 0.6.2.1 && < 1.2,
+        deepseq      >= 1.4.0.0         ,
+        mtl          >= 2.1     && < 2.3,
+        pipes        >= 4.0.0   && < 4.2,
+        transformers >= 0.2.0.0 && < 0.5
src/Pipes.hs view
@@ -1,589 +1,585 @@-{-# LANGUAGE-    RankNTypes-  , FlexibleInstances-  , MultiParamTypeClasses-  , UndecidableInstances-  , Trustworthy-  #-}--{-| This module is the recommended entry point to the @pipes@ library.--    Read "Pipes.Tutorial" if you want a tutorial explaining how to use this-    library.--}--module Pipes (-    -- * The Proxy Monad Transformer-      Proxy-    , X-    , Effect-    , Effect'-    , runEffect--    -- ** Producers-    -- $producers-    , Producer-    , Producer'-    , yield-    , for-    , (~>)-    , (<~)--    -- ** Consumers-    -- $consumers-    , Consumer-    , Consumer'-    , await-    , (>~)-    , (~<)--    -- ** Pipes-    -- $pipes-    , Pipe-    , cat-    , (>->)-    , (<-<)--    -- * ListT-    , ListT(..)-    , runListT-    , Enumerable(..)--    -- * Utilities-    , next-    , each-    , every-    , discard--    -- * Re-exports-    -- $reexports-    , module Control.Monad-    , module Control.Monad.IO.Class-    , module Control.Monad.Trans.Class-    , module Control.Monad.Morph-    , module Data.Foldable-    ) where--import Control.Applicative (Applicative(pure, (<*>)), Alternative(empty, (<|>)))-import Control.Monad (void)-import Control.Monad.Error (MonadError(..))-import Control.Monad.IO.Class (MonadIO(liftIO))-import Control.Monad (MonadPlus(mzero, mplus))-import Control.Monad.Reader (MonadReader(..))-import Control.Monad.State (MonadState(..))-import Control.Monad.Trans.Class (MonadTrans(lift))-import Control.Monad.Trans.Error (ErrorT(runErrorT))-import Control.Monad.Trans.Identity (IdentityT(runIdentityT))-import Control.Monad.Trans.Maybe (MaybeT(runMaybeT))-import Control.Monad.Writer (MonadWriter(..))-import Data.Foldable (Foldable)-import Data.Monoid (Monoid(..))-import Pipes.Core-import Pipes.Internal (Proxy(..))-import qualified Data.Foldable as F---- Re-exports-import Control.Monad.Morph (MFunctor(hoist))--infixl 4 <~-infixr 4 ~>-infixl 5 ~<-infixr 5 >~-infixl 7 >->-infixr 7 <-<--{- $producers-    Use 'yield' to produce output and ('~>') \/ 'for' to substitute 'yield's.--    'yield' and ('~>') obey the 'Control.Category.Category' laws:--@-\-\- Substituting \'yield\' with \'f\' gives \'f\'-'yield' '~>' f = f--\-\- Substituting every \'yield\' with another \'yield\' does nothing-f '~>' 'yield' = f--\-\- \'yield\' substitution is associative-(f '~>' g) '~>' h = f '~>' (g '~>' h)-@--    These are equivalent to the following \"for loop laws\":--@-\-\- Looping over a single yield simplifies to function application-'for' ('yield' x) f = f x--\-\- Re-yielding every element of a stream returns the original stream-'for' s 'yield' = s--\-\- Nested for loops can become a sequential 'for' loops if the inner loop-\-\- body ignores the outer loop variable-'for' s (\\a -\> 'for' (f a) g) = 'for' ('for' s f) g = 'for' s (f '~>' g)-@---}--{-| Produce a value--@-'yield' :: 'Monad' m => a -> 'Pipe' x a m ()-@--}-yield :: Monad m => a -> Producer' a m ()-yield = respond-{-# INLINABLE yield #-}--{-| @(for p body)@ loops over @p@ replacing each 'yield' with @body@.--@-'for' :: 'Monad' m => 'Producer' b m r -> (b -> 'Effect'       m ()) -> 'Effect'       m r-'for' :: 'Monad' m => 'Producer' b m r -> (b -> 'Producer'   c m ()) -> 'Producer'   c m r-'for' :: 'Monad' m => 'Pipe'   x b m r -> (b -> 'Consumer' x   m ()) -> 'Consumer' x   m r-'for' :: 'Monad' m => 'Pipe'   x b m r -> (b -> 'Pipe'     x c m ()) -> 'Pipe'     x c m r-@--    The following diagrams show the flow of information:--@-                              .--->   b-                             /        |-   +-----------+            /   +-----|-----+                 +---------------+-   |           |           /    |     v     |                 |               |-   |           |          /     |           |                 |               |-x ==>    p    ==> b   ---'   x ==>   body  ==> c     =     x ==> 'for' p body  ==> c-   |           |                |           |                 |               |-   |     |     |                |     |     |                 |       |       |-   +-----|-----+                +-----|-----+                 +-------|-------+-         v                            v                               v-         r                            ()                              r-@--    For a more complete diagram including bidirectional flow, see "Pipes.Core#respond-diagram".--}-for :: Monad m-    =>       Proxy x' x b' b m a'-    -- ^-    -> (b -> Proxy x' x c' c m b')-    -- ^-    ->       Proxy x' x c' c m a'-for = (//>)-{-# INLINABLE for #-}--{-# RULES-    "for (for p f) g" forall p f g . for (for p f) g = for p (\a -> for (f a) g)--  ; "for p yield" forall p . for p yield = p--  ; "for (yield x) f" forall x f . for (yield x) f = f x--  ; "for cat f" forall f .-        for cat f =-            let go = do-                    x <- await-                    f x-                    go-            in  go--  ; "f >~ (g >~ p)" forall f g p . f >~ (g >~ p) = (f >~ g) >~ p--  ; "await >~ p" forall p . await >~ p = p--  ; "p >~ await" forall p . p >~ await = p--  ; "m >~ cat" forall m .-        m >~ cat =-            let go = do-                    x <- m-                    yield x-                    go-            in  go--  ; "p1 >-> (p2 >-> p3)" forall p1 p2 p3 .-        p1 >-> (p2 >-> p3) = (p1 >-> p2) >-> p3--  ; "p >-> cat" forall p . p >-> cat = p--  ; "cat >-> p" forall p . cat >-> p = p--  #-}--{-| Compose loop bodies--@-('~>') :: 'Monad' m => (a -> 'Producer' b m r) -> (b -> 'Effect'       m ()) -> (a -> 'Effect'       m r)-('~>') :: 'Monad' m => (a -> 'Producer' b m r) -> (b -> 'Producer'   c m ()) -> (a -> 'Producer'   c m r)-('~>') :: 'Monad' m => (a -> 'Pipe'   x b m r) -> (b -> 'Consumer' x   m ()) -> (a -> 'Consumer' x   m r)-('~>') :: 'Monad' m => (a -> 'Pipe'   x b m r) -> (b -> 'Pipe'     x c m ()) -> (a -> 'Pipe'     x c m r)-@--    The following diagrams show the flow of information:--@-         a                    .--->   b                              a-         |                   /        |                              |-   +-----|-----+            /   +-----|-----+                 +------|------+-   |     v     |           /    |     v     |                 |      v      |-   |           |          /     |           |                 |             |-x ==>    f    ==> b   ---'   x ==>    g    ==> c     =     x ==>   f '~>' g  ==> c-   |           |                |           |                 |             |-   |     |     |                |     |     |                 |      |      |-   +-----|-----+                +-----|-----+                 +------|------+-         v                            v                              v-         r                            ()                             r-@--    For a more complete diagram including bidirectional flow, see "Pipes.Core#respond-diagram".--}-(~>)-    :: Monad m-    => (a -> Proxy x' x b' b m a')-    -- ^-    -> (b -> Proxy x' x c' c m b')-    -- ^-    -> (a -> Proxy x' x c' c m a')-(~>) = (/>/)-{-# INLINABLE (~>) #-}---- | ('~>') with the arguments flipped-(<~)-    :: Monad m-    => (b -> Proxy x' x c' c m b')-    -- ^-    -> (a -> Proxy x' x b' b m a')-    -- ^-    -> (a -> Proxy x' x c' c m a')-g <~ f = f ~> g-{-# INLINABLE (<~) #-}--{- $consumers-    Use 'await' to request input and ('>~') to substitute 'await's.--    'await' and ('>~') obey the 'Control.Category.Category' laws:--@-\-\- Substituting every \'await\' with another \'await\' does nothing-'await' '>~' f = f--\-\- Substituting \'await\' with \'f\' gives \'f\'-f '>~' 'await' = f--\-\- \'await\' substitution is associative-(f '>~' g) '>~' h = f '>~' (g '>~' h)-@---}--{-| Consume a value--@-'await' :: 'Monad' m => 'Pipe' a y m a-@--}-await :: Monad m => Consumer' a m a-await = request ()-{-# INLINABLE await #-}--{-| @(draw >~ p)@ loops over @p@ replacing each 'await' with @draw@--@-('>~') :: 'Monad' m => 'Effect'       m b -> 'Consumer' b   m c -> 'Effect'       m c-('>~') :: 'Monad' m => 'Consumer' a   m b -> 'Consumer' b   m c -> 'Consumer' a   m c-('>~') :: 'Monad' m => 'Producer'   y m b -> 'Pipe'     b y m c -> 'Producer'   y m c-('>~') :: 'Monad' m => 'Pipe'     a y m b -> 'Pipe'     b y m c -> 'Pipe'     a y m c-@--    The following diagrams show the flow of information:--@---   +-----------+                 +-----------+                 +-------------+-   |           |                 |           |                 |             |-   |           |                 |           |                 |             |-a ==>    f    ==> y   .--->   b ==>    g    ==> y     =     a ==>   f '>~' g  ==> y-   |           |     /           |           |                 |             |-   |     |     |    /            |     |     |                 |      |      |-   +-----|-----+   /             +-----|-----+                 +------|------+-         v        /                    v                              v-         b   ----'                     c                              c-@--    For a more complete diagram including bidirectional flow, see "Pipes.Core#request-diagram".--}-(>~)-    :: Monad m-    => Proxy a' a y' y m b-    -- ^-    -> Proxy () b y' y m c-    -- ^-    -> Proxy a' a y' y m c-p1 >~ p2 = (\() -> p1) >\\ p2-{-# INLINABLE (>~) #-}---- | ('>~') with the arguments flipped-(~<)-    :: Monad m-    => Proxy () b y' y m c-    -- ^-    -> Proxy a' a y' y m b-    -- ^-    -> Proxy a' a y' y m c-p2 ~< p1 = p1 >~ p2-{-# INLINABLE (~<) #-}--{- $pipes-    Use 'await' and 'yield' to build 'Pipe's and ('>->') to connect 'Pipe's.--    'cat' and ('>->') obey the 'Control.Category.Category' laws:--@-\-\- Useless use of cat-'cat' '>->' f = f--\-\- Redirecting output to cat does nothing-f '>->' 'cat' = f--\-\- The pipe operator is associative-(f '>->' g) '>->' h = f '>->' (g '>->' h)-@---}---- | The identity 'Pipe', analogous to the Unix @cat@ program-cat :: Monad m => Pipe a a m r-cat = pull ()-{-# INLINABLE cat #-}--{-| 'Pipe' composition, analogous to the Unix pipe operator--@-('>->') :: 'Monad' m => 'Producer' b m r -> 'Consumer' b   m r -> 'Effect'       m r-('>->') :: 'Monad' m => 'Producer' b m r -> 'Pipe'     b c m r -> 'Producer'   c m r-('>->') :: 'Monad' m => 'Pipe'   a b m r -> 'Consumer' b   m r -> 'Consumer' a   m r-('>->') :: 'Monad' m => 'Pipe'   a b m r -> 'Pipe'     b c m r -> 'Pipe'     a c m r-@--    The following diagrams show the flow of information:--@---   +-----------+     +-----------+                 +-------------+-   |           |     |           |                 |             |-   |           |     |           |                 |             |-a ==>    f    ==> b ==>    g    ==> c     =     a ==>  f '>->' g  ==> c-   |           |     |           |                 |             |-   |     |     |     |     |     |                 |      |      |-   +-----|-----+     +-----|-----+                 +------|------+-         v                 v                              v-         r                 r                              r-@--    For a more complete diagram including bidirectional flow, see "Pipes.Core#pull-diagram".--}-(>->)-    :: Monad m-    => Proxy a' a () b m r-    -- ^-    -> Proxy () b c' c m r-    -- ^-    -> Proxy a' a c' c m r-p1 >-> p2 = (\() -> p1) +>> p2-{-# INLINABLE (>->) #-}--{-| The list monad transformer, which extends a monad with non-determinism--    'return' corresponds to 'yield', yielding a single value--    ('>>=') corresponds to 'for', calling the second computation once for each-    time the first computation 'yield's.--}-newtype ListT m a = Select { enumerate :: Producer a m () }--instance (Monad m) => Functor (ListT m) where-    fmap f p = Select (for (enumerate p) (\a -> yield (f a)))--instance (Monad m) => Applicative (ListT m) where-    pure a = Select (yield a)-    mf <*> mx = Select (-        for (enumerate mf) (\f ->-        for (enumerate mx) (\x ->-        yield (f x) ) ) )--instance (Monad m) => Monad (ListT m) where-    return a = Select (yield a)-    m >>= f  = Select (for (enumerate m) (\a -> enumerate (f a)))-    fail _   = mzero--instance MonadTrans ListT where-    lift m = Select (do-        a <- lift m-        yield a )--instance (MonadIO m) => MonadIO (ListT m) where-    liftIO m = lift (liftIO m)--instance (Monad m) => Alternative (ListT m) where-    empty = Select (return ())-    p1 <|> p2 = Select (do-        enumerate p1-        enumerate p2 )--instance (Monad m) => MonadPlus (ListT m) where-    mzero = empty-    mplus = (<|>)--instance MFunctor ListT where-    hoist morph = Select . hoist morph . enumerate--instance (Monad m) => Monoid (ListT m a) where-    mempty = empty-    mappend = (<|>)--instance (MonadState s m) => MonadState s (ListT m) where-    get     = lift  get--    put   s = lift (put   s)--    state f = lift (state f)--instance (MonadWriter w m) => MonadWriter w (ListT m) where-    writer = lift . writer--    tell w = lift (tell w)--    listen l = Select (go (enumerate l) mempty)-      where-        go p w = case p of-            Request a' fa  -> Request a' (\a  -> go (fa  a ) w)-            Respond b  fb' -> Respond (b, w)  (\b' -> go (fb' b') w)-            M          m   -> M (do-                (p', w') <- listen m-                return (go p' $! mappend w w') )-            Pure    r      -> Pure r--    pass l = Select (go (enumerate l) mempty)-      where-        go p w = case p of-            Request  a'     fa  -> Request a' (\a  -> go (fa  a ) w)-            Respond (b, f)  fb' -> M (pass (return-                (Respond b (\b' -> go (fb' b') (f w)), \_ -> f w) ))-            M               m   -> M (do-                (p', w') <- listen m-                return (go p' $! mappend w w') )-            Pure     r          -> Pure r--instance (MonadReader i m) => MonadReader i (ListT m) where-    ask = lift ask--    local f l = Select (local f (enumerate l))--    reader f = lift (reader f)--instance (MonadError e m) => MonadError e (ListT m) where-    throwError e = lift (throwError e)--    catchError l k = Select (catchError (enumerate l) (\e -> enumerate (k e)))---- | Run a self-contained `ListT` computation-runListT :: Monad m => ListT m a -> m ()-runListT l = runEffect (enumerate (l >> mzero))-{-# INLINABLE runListT #-}--{-| 'Enumerable' generalizes 'Data.Foldable.Foldable', converting effectful-    containers to 'ListT's.--    Instances of 'Enumerable' must satisfy these two laws:--> toListT (return r) = return r->-> toListT $ do x <- m  =  do x <- toListT m->              f x           toListT (f x)--    In other words, 'toListT' is monad morphism.--}-class Enumerable t where-    toListT :: Monad m => t m a -> ListT m a--instance Enumerable ListT where-    toListT = id--instance Enumerable IdentityT where-    toListT m = Select $ do-        a <- lift $ runIdentityT m-        yield a--instance Enumerable MaybeT where-    toListT m = Select $ do-        x <- lift $ runMaybeT m-        case x of-            Nothing -> return ()-            Just a  -> yield a--instance Enumerable (ErrorT e) where-    toListT m = Select $ do-        x <- lift $ runErrorT m-        case x of-            Left  _ -> return ()-            Right a -> yield a--{-| Consume the first value from a 'Producer'--    'next' either fails with a 'Left' if the 'Producer' terminates or succeeds-    with a 'Right' providing the next value and the remainder of the 'Producer'.--}-next :: Monad m => Producer a m r -> m (Either r (a, Producer a m r))-next = go-  where-    go p = case p of-        Request v _  -> closed v-        Respond a fu -> return (Right (a, fu ()))-        M         m  -> m >>= go-        Pure    r    -> return (Left r)-{-# INLINABLE next #-}---- | Convert a 'F.Foldable' to a 'Producer'-each :: (Monad m, Foldable f) => f a -> Producer' a m ()-each = F.foldr (\a p -> yield a >> p) (return ())-{-# INLINABLE each #-}-{-  The above code is the same as:--> each = Data.Foldable.mapM_ yield--    ... except writing it directly in terms of `Data.Foldable.foldr` improves-    build/foldr fusion--}---- | Convert an 'Enumerable' to a 'Producer'-every :: (Monad m, Enumerable t) => t m a -> Producer' a m ()-every it = discard >\\ enumerate (toListT it)-{-# INLINABLE every #-}---- | Discards a value-discard :: Monad m => a -> m ()-discard _ = return ()-{-# INLINABLE discard #-}---- | ('>->') with the arguments flipped-(<-<)-    :: Monad m-    => Proxy () b c' c m r-    -- ^-    -> Proxy a' a () b m r-    -- ^-    -> Proxy a' a c' c m r-p2 <-< p1 = p1 >-> p2-{-# INLINABLE (<-<) #-}--{- $reexports-    "Control.Monad" re-exports 'void'--    "Control.Monad.IO.Class" re-exports 'MonadIO'.--    "Control.Monad.Trans.Class" re-exports 'MonadTrans'.--    "Control.Monad.Morph" re-exports 'MFunctor'.--    "Data.Foldable" re-exports 'Foldable' (the class name only)--}+{-# LANGUAGE
+    RankNTypes
+  , FlexibleInstances
+  , MultiParamTypeClasses
+  , UndecidableInstances
+  , Trustworthy
+  #-}
+
+{-| This module is the recommended entry point to the @pipes@ library.
+
+    Read "Pipes.Tutorial" if you want a tutorial explaining how to use this
+    library.
+-}
+
+module Pipes (
+    -- * The Proxy Monad Transformer
+      Proxy
+    , X
+    , Effect
+    , Effect'
+    , runEffect
+
+    -- ** Producers
+    -- $producers
+    , Producer
+    , Producer'
+    , yield
+    , for
+    , (~>)
+    , (<~)
+
+    -- ** Consumers
+    -- $consumers
+    , Consumer
+    , Consumer'
+    , await
+    , (>~)
+    , (~<)
+
+    -- ** Pipes
+    -- $pipes
+    , Pipe
+    , cat
+    , (>->)
+    , (<-<)
+
+    -- * ListT
+    , ListT(..)
+    , runListT
+    , Enumerable(..)
+
+    -- * Utilities
+    , next
+    , each
+    , every
+    , discard
+
+    -- * Re-exports
+    -- $reexports
+    , module Control.Monad
+    , module Control.Monad.IO.Class
+    , module Control.Monad.Trans.Class
+    , module Control.Monad.Morph
+    , module Data.Foldable
+    ) where
+
+import Control.Applicative (Applicative(pure, (<*>)), Alternative(empty, (<|>)))
+import Control.Monad (void)
+import Control.Monad.Error (MonadError(..))
+import Control.Monad.IO.Class (MonadIO(liftIO))
+import Control.Monad (MonadPlus(mzero, mplus))
+import Control.Monad.Reader (MonadReader(..))
+import Control.Monad.State (MonadState(..))
+import Control.Monad.Trans.Class (MonadTrans(lift))
+import Control.Monad.Trans.Error (ErrorT(runErrorT))
+import Control.Monad.Trans.Identity (IdentityT(runIdentityT))
+import Control.Monad.Trans.Maybe (MaybeT(runMaybeT))
+import Control.Monad.Writer (MonadWriter(..))
+import Data.Foldable (Foldable)
+import Data.Monoid (Monoid(..))
+import Pipes.Core
+import Pipes.Internal (Proxy(..))
+import qualified Data.Foldable as F
+
+-- Re-exports
+import Control.Monad.Morph (MFunctor(hoist))
+
+infixl 4 <~
+infixr 4 ~>
+infixl 5 ~<
+infixr 5 >~
+infixl 7 >->
+infixr 7 <-<
+
+{- $producers
+    Use 'yield' to produce output and ('~>') \/ 'for' to substitute 'yield's.
+
+    'yield' and ('~>') obey the 'Control.Category.Category' laws:
+
+@
+\-\- Substituting \'yield\' with \'f\' gives \'f\'
+'yield' '~>' f = f
+
+\-\- Substituting every \'yield\' with another \'yield\' does nothing
+f '~>' 'yield' = f
+
+\-\- \'yield\' substitution is associative
+(f '~>' g) '~>' h = f '~>' (g '~>' h)
+@
+
+    These are equivalent to the following \"for loop laws\":
+
+@
+\-\- Looping over a single yield simplifies to function application
+'for' ('yield' x) f = f x
+
+\-\- Re-yielding every element of a stream returns the original stream
+'for' s 'yield' = s
+
+\-\- Nested for loops can become a sequential 'for' loops if the inner loop
+\-\- body ignores the outer loop variable
+'for' s (\\a -\> 'for' (f a) g) = 'for' ('for' s f) g = 'for' s (f '~>' g)
+@
+
+-}
+
+{-| Produce a value
+
+@
+'yield' :: 'Monad' m => a -> 'Pipe' x a m ()
+@
+-}
+yield :: Monad m => a -> Producer' a m ()
+yield = respond
+{-# INLINABLE yield #-}
+
+{-| @(for p body)@ loops over @p@ replacing each 'yield' with @body@.
+
+@
+'for' :: 'Monad' m => 'Producer' b m r -> (b -> 'Effect'       m ()) -> 'Effect'       m r
+'for' :: 'Monad' m => 'Producer' b m r -> (b -> 'Producer'   c m ()) -> 'Producer'   c m r
+'for' :: 'Monad' m => 'Pipe'   x b m r -> (b -> 'Consumer' x   m ()) -> 'Consumer' x   m r
+'for' :: 'Monad' m => 'Pipe'   x b m r -> (b -> 'Pipe'     x c m ()) -> 'Pipe'     x c m r
+@
+
+    The following diagrams show the flow of information:
+
+@
+                              .--->   b
+                             /        |
+   +-----------+            /   +-----|-----+                 +---------------+
+   |           |           /    |     v     |                 |               |
+   |           |          /     |           |                 |               |
+x ==>    p    ==> b   ---'   x ==>   body  ==> c     =     x ==> 'for' p body  ==> c
+   |           |                |           |                 |               |
+   |     |     |                |     |     |                 |       |       |
+   +-----|-----+                +-----|-----+                 +-------|-------+
+         v                            v                               v
+         r                            ()                              r
+@
+
+    For a more complete diagram including bidirectional flow, see "Pipes.Core#respond-diagram".
+-}
+for :: Monad m
+    =>       Proxy x' x b' b m a'
+    -- ^
+    -> (b -> Proxy x' x c' c m b')
+    -- ^
+    ->       Proxy x' x c' c m a'
+for = (//>)
+{-# INLINABLE for #-}
+
+{-# RULES
+    "for (for p f) g" forall p f g . for (for p f) g = for p (\a -> for (f a) g)
+
+  ; "for p yield" forall p . for p yield = p
+
+  ; "for (yield x) f" forall x f . for (yield x) f = f x
+
+  ; "for cat f" forall f .
+        for cat f =
+            let go = do
+                    x <- await
+                    f x
+                    go
+            in  go
+
+  ; "f >~ (g >~ p)" forall f g p . f >~ (g >~ p) = (f >~ g) >~ p
+
+  ; "await >~ p" forall p . await >~ p = p
+
+  ; "p >~ await" forall p . p >~ await = p
+
+  ; "m >~ cat" forall m .
+        m >~ cat =
+            let go = do
+                    x <- m
+                    yield x
+                    go
+            in  go
+
+  ; "p1 >-> (p2 >-> p3)" forall p1 p2 p3 .
+        p1 >-> (p2 >-> p3) = (p1 >-> p2) >-> p3
+
+  ; "p >-> cat" forall p . p >-> cat = p
+
+  ; "cat >-> p" forall p . cat >-> p = p
+
+  #-}
+
+{-| Compose loop bodies
+
+@
+('~>') :: 'Monad' m => (a -> 'Producer' b m r) -> (b -> 'Effect'       m ()) -> (a -> 'Effect'       m r)
+('~>') :: 'Monad' m => (a -> 'Producer' b m r) -> (b -> 'Producer'   c m ()) -> (a -> 'Producer'   c m r)
+('~>') :: 'Monad' m => (a -> 'Pipe'   x b m r) -> (b -> 'Consumer' x   m ()) -> (a -> 'Consumer' x   m r)
+('~>') :: 'Monad' m => (a -> 'Pipe'   x b m r) -> (b -> 'Pipe'     x c m ()) -> (a -> 'Pipe'     x c m r)
+@
+
+    The following diagrams show the flow of information:
+
+@
+         a                    .--->   b                              a
+         |                   /        |                              |
+   +-----|-----+            /   +-----|-----+                 +------|------+
+   |     v     |           /    |     v     |                 |      v      |
+   |           |          /     |           |                 |             |
+x ==>    f    ==> b   ---'   x ==>    g    ==> c     =     x ==>   f '~>' g  ==> c
+   |           |                |           |                 |             |
+   |     |     |                |     |     |                 |      |      |
+   +-----|-----+                +-----|-----+                 +------|------+
+         v                            v                              v
+         r                            ()                             r
+@
+
+    For a more complete diagram including bidirectional flow, see "Pipes.Core#respond-diagram".
+-}
+(~>)
+    :: Monad m
+    => (a -> Proxy x' x b' b m a')
+    -- ^
+    -> (b -> Proxy x' x c' c m b')
+    -- ^
+    -> (a -> Proxy x' x c' c m a')
+(~>) = (/>/)
+{-# INLINABLE (~>) #-}
+
+-- | ('~>') with the arguments flipped
+(<~)
+    :: Monad m
+    => (b -> Proxy x' x c' c m b')
+    -- ^
+    -> (a -> Proxy x' x b' b m a')
+    -- ^
+    -> (a -> Proxy x' x c' c m a')
+g <~ f = f ~> g
+{-# INLINABLE (<~) #-}
+
+{- $consumers
+    Use 'await' to request input and ('>~') to substitute 'await's.
+
+    'await' and ('>~') obey the 'Control.Category.Category' laws:
+
+@
+\-\- Substituting every \'await\' with another \'await\' does nothing
+'await' '>~' f = f
+
+\-\- Substituting \'await\' with \'f\' gives \'f\'
+f '>~' 'await' = f
+
+\-\- \'await\' substitution is associative
+(f '>~' g) '>~' h = f '>~' (g '>~' h)
+@
+
+-}
+
+{-| Consume a value
+
+@
+'await' :: 'Monad' m => 'Pipe' a y m a
+@
+-}
+await :: Monad m => Consumer' a m a
+await = request ()
+{-# INLINABLE await #-}
+
+{-| @(draw >~ p)@ loops over @p@ replacing each 'await' with @draw@
+
+@
+('>~') :: 'Monad' m => 'Effect'       m b -> 'Consumer' b   m c -> 'Effect'       m c
+('>~') :: 'Monad' m => 'Consumer' a   m b -> 'Consumer' b   m c -> 'Consumer' a   m c
+('>~') :: 'Monad' m => 'Producer'   y m b -> 'Pipe'     b y m c -> 'Producer'   y m c
+('>~') :: 'Monad' m => 'Pipe'     a y m b -> 'Pipe'     b y m c -> 'Pipe'     a y m c
+@
+
+    The following diagrams show the flow of information:
+
+@
+   +-----------+                 +-----------+                 +-------------+
+   |           |                 |           |                 |             |
+   |           |                 |           |                 |             |
+a ==>    f    ==> y   .--->   b ==>    g    ==> y     =     a ==>   f '>~' g  ==> y
+   |           |     /           |           |                 |             |
+   |     |     |    /            |     |     |                 |      |      |
+   +-----|-----+   /             +-----|-----+                 +------|------+
+         v        /                    v                              v
+         b   ----'                     c                              c
+@
+
+    For a more complete diagram including bidirectional flow, see "Pipes.Core#request-diagram".
+-}
+(>~)
+    :: Monad m
+    => Proxy a' a y' y m b
+    -- ^
+    -> Proxy () b y' y m c
+    -- ^
+    -> Proxy a' a y' y m c
+p1 >~ p2 = (\() -> p1) >\\ p2
+{-# INLINABLE (>~) #-}
+
+-- | ('>~') with the arguments flipped
+(~<)
+    :: Monad m
+    => Proxy () b y' y m c
+    -- ^
+    -> Proxy a' a y' y m b
+    -- ^
+    -> Proxy a' a y' y m c
+p2 ~< p1 = p1 >~ p2
+{-# INLINABLE (~<) #-}
+
+{- $pipes
+    Use 'await' and 'yield' to build 'Pipe's and ('>->') to connect 'Pipe's.
+
+    'cat' and ('>->') obey the 'Control.Category.Category' laws:
+
+@
+\-\- Useless use of cat
+'cat' '>->' f = f
+
+\-\- Redirecting output to cat does nothing
+f '>->' 'cat' = f
+
+\-\- The pipe operator is associative
+(f '>->' g) '>->' h = f '>->' (g '>->' h)
+@
+
+-}
+
+-- | The identity 'Pipe', analogous to the Unix @cat@ program
+cat :: Monad m => Pipe a a m r
+cat = pull ()
+{-# INLINABLE cat #-}
+
+{-| 'Pipe' composition, analogous to the Unix pipe operator
+
+@
+('>->') :: 'Monad' m => 'Producer' b m r -> 'Consumer' b   m r -> 'Effect'       m r
+('>->') :: 'Monad' m => 'Producer' b m r -> 'Pipe'     b c m r -> 'Producer'   c m r
+('>->') :: 'Monad' m => 'Pipe'   a b m r -> 'Consumer' b   m r -> 'Consumer' a   m r
+('>->') :: 'Monad' m => 'Pipe'   a b m r -> 'Pipe'     b c m r -> 'Pipe'     a c m r
+@
+
+    The following diagrams show the flow of information:
+
+@
+   +-----------+     +-----------+                 +-------------+
+   |           |     |           |                 |             |
+   |           |     |           |                 |             |
+a ==>    f    ==> b ==>    g    ==> c     =     a ==>  f '>->' g  ==> c
+   |           |     |           |                 |             |
+   |     |     |     |     |     |                 |      |      |
+   +-----|-----+     +-----|-----+                 +------|------+
+         v                 v                              v
+         r                 r                              r
+@
+
+    For a more complete diagram including bidirectional flow, see "Pipes.Core#pull-diagram".
+-}
+(>->)
+    :: Monad m
+    => Proxy a' a () b m r
+    -- ^
+    -> Proxy () b c' c m r
+    -- ^
+    -> Proxy a' a c' c m r
+p1 >-> p2 = (\() -> p1) +>> p2
+{-# INLINABLE (>->) #-}
+
+{-| The list monad transformer, which extends a monad with non-determinism
+
+    'return' corresponds to 'yield', yielding a single value
+
+    ('>>=') corresponds to 'for', calling the second computation once for each
+    time the first computation 'yield's.
+-}
+newtype ListT m a = Select { enumerate :: Producer a m () }
+
+instance (Monad m) => Functor (ListT m) where
+    fmap f p = Select (for (enumerate p) (\a -> yield (f a)))
+
+instance (Monad m) => Applicative (ListT m) where
+    pure a = Select (yield a)
+    mf <*> mx = Select (
+        for (enumerate mf) (\f ->
+        for (enumerate mx) (\x ->
+        yield (f x) ) ) )
+
+instance (Monad m) => Monad (ListT m) where
+    return a = Select (yield a)
+    m >>= f  = Select (for (enumerate m) (\a -> enumerate (f a)))
+    fail _   = mzero
+
+instance MonadTrans ListT where
+    lift m = Select (do
+        a <- lift m
+        yield a )
+
+instance (MonadIO m) => MonadIO (ListT m) where
+    liftIO m = lift (liftIO m)
+
+instance (Monad m) => Alternative (ListT m) where
+    empty = Select (return ())
+    p1 <|> p2 = Select (do
+        enumerate p1
+        enumerate p2 )
+
+instance (Monad m) => MonadPlus (ListT m) where
+    mzero = empty
+    mplus = (<|>)
+
+instance MFunctor ListT where
+    hoist morph = Select . hoist morph . enumerate
+
+instance (Monad m) => Monoid (ListT m a) where
+    mempty = empty
+    mappend = (<|>)
+
+instance (MonadState s m) => MonadState s (ListT m) where
+    get     = lift  get
+
+    put   s = lift (put   s)
+
+    state f = lift (state f)
+
+instance (MonadWriter w m) => MonadWriter w (ListT m) where
+    writer = lift . writer
+
+    tell w = lift (tell w)
+
+    listen l = Select (go (enumerate l) mempty)
+      where
+        go p w = case p of
+            Request a' fa  -> Request a' (\a  -> go (fa  a ) w)
+            Respond b  fb' -> Respond (b, w)  (\b' -> go (fb' b') w)
+            M          m   -> M (do
+                (p', w') <- listen m
+                return (go p' $! mappend w w') )
+            Pure    r      -> Pure r
+
+    pass l = Select (go (enumerate l) mempty)
+      where
+        go p w = case p of
+            Request  a'     fa  -> Request a' (\a  -> go (fa  a ) w)
+            Respond (b, f)  fb' -> M (pass (return
+                (Respond b (\b' -> go (fb' b') (f w)), \_ -> f w) ))
+            M               m   -> M (do
+                (p', w') <- listen m
+                return (go p' $! mappend w w') )
+            Pure     r          -> Pure r
+
+instance (MonadReader i m) => MonadReader i (ListT m) where
+    ask = lift ask
+
+    local f l = Select (local f (enumerate l))
+
+    reader f = lift (reader f)
+
+instance (MonadError e m) => MonadError e (ListT m) where
+    throwError e = lift (throwError e)
+
+    catchError l k = Select (catchError (enumerate l) (\e -> enumerate (k e)))
+
+-- | Run a self-contained `ListT` computation
+runListT :: Monad m => ListT m a -> m ()
+runListT l = runEffect (enumerate (l >> mzero))
+{-# INLINABLE runListT #-}
+
+{-| 'Enumerable' generalizes 'Data.Foldable.Foldable', converting effectful
+    containers to 'ListT's.
+
+    Instances of 'Enumerable' must satisfy these two laws:
+
+> toListT (return r) = return r
+>
+> toListT $ do x <- m  =  do x <- toListT m
+>              f x           toListT (f x)
+
+    In other words, 'toListT' is monad morphism.
+-}
+class Enumerable t where
+    toListT :: Monad m => t m a -> ListT m a
+
+instance Enumerable ListT where
+    toListT = id
+
+instance Enumerable IdentityT where
+    toListT m = Select $ do
+        a <- lift $ runIdentityT m
+        yield a
+
+instance Enumerable MaybeT where
+    toListT m = Select $ do
+        x <- lift $ runMaybeT m
+        case x of
+            Nothing -> return ()
+            Just a  -> yield a
+
+instance Enumerable (ErrorT e) where
+    toListT m = Select $ do
+        x <- lift $ runErrorT m
+        case x of
+            Left  _ -> return ()
+            Right a -> yield a
+
+{-| Consume the first value from a 'Producer'
+
+    'next' either fails with a 'Left' if the 'Producer' terminates or succeeds
+    with a 'Right' providing the next value and the remainder of the 'Producer'.
+-}
+next :: Monad m => Producer a m r -> m (Either r (a, Producer a m r))
+next = go
+  where
+    go p = case p of
+        Request v _  -> closed v
+        Respond a fu -> return (Right (a, fu ()))
+        M         m  -> m >>= go
+        Pure    r    -> return (Left r)
+{-# INLINABLE next #-}
+
+-- | Convert a 'F.Foldable' to a 'Producer'
+each :: (Monad m, Foldable f) => f a -> Producer' a m ()
+each = F.foldr (\a p -> yield a >> p) (return ())
+{-# INLINABLE each #-}
+{-  The above code is the same as:
+
+> each = Data.Foldable.mapM_ yield
+
+    ... except writing it directly in terms of `Data.Foldable.foldr` improves
+    build/foldr fusion
+-}
+
+-- | Convert an 'Enumerable' to a 'Producer'
+every :: (Monad m, Enumerable t) => t m a -> Producer' a m ()
+every it = discard >\\ enumerate (toListT it)
+{-# INLINABLE every #-}
+
+-- | Discards a value
+discard :: Monad m => a -> m ()
+discard _ = return ()
+{-# INLINABLE discard #-}
+
+-- | ('>->') with the arguments flipped
+(<-<)
+    :: Monad m
+    => Proxy () b c' c m r
+    -- ^
+    -> Proxy a' a () b m r
+    -- ^
+    -> Proxy a' a c' c m r
+p2 <-< p1 = p1 >-> p2
+{-# INLINABLE (<-<) #-}
+
+{- $reexports
+    "Control.Monad" re-exports 'void'
+
+    "Control.Monad.IO.Class" re-exports 'MonadIO'.
+
+    "Control.Monad.Trans.Class" re-exports 'MonadTrans'.
+
+    "Control.Monad.Morph" re-exports 'MFunctor'.
+
+    "Data.Foldable" re-exports 'Foldable' (the class name only).
+-}
src/Pipes/Core.hs view
@@ -1,894 +1,894 @@-{-| The core functionality for the 'Proxy' monad transformer--    Read "Pipes.Tutorial" if you want a beginners tutorial explaining how to use-    this library.  The documentation in this module targets more advanced users-    who want to understand the theory behind this library.--    This module is not exported by default, and I recommend you use the-    unidirectional operations exported by the "Pipes" module if you can.  You-    should only use this module if you require advanced features like:--    * bidirectional communication, or:--    * push-based 'Pipe's.--}--{-# LANGUAGE RankNTypes, Trustworthy #-}--module Pipes.Core (-    -- * Proxy Monad Transformer-    -- $proxy-      Proxy-    , runEffect--    -- * Categories-    -- $categories--    -- ** Respond-    -- $respond-    , respond-    , (/>/)-    , (//>)--    -- ** Request-    -- $request-    , request-    , (\>\)-    , (>\\)--    -- ** Push-    -- $push-    , push-    , (>~>)-    , (>>~)--    -- ** Pull-    -- $pull-    , pull-    , (>+>)-    , (+>>)--    -- ** Reflect-    -- $reflect-    , reflect--    -- * Concrete Type Synonyms-    , X-    , Effect-    , Producer-    , Pipe-    , Consumer-    , Client-    , Server--    -- * Polymorphic Type Synonyms-    , Effect'-    , Producer'-    , Consumer'-    , Client'-    , Server'--    -- * Flipped operators-    , (\<\)-    , (/</)-    , (<~<)-    , (~<<)-    , (<+<)-    , (<\\)-    , (//<)-    , (<<+)--    -- * Re-exports-    , closed-    ) where--import Pipes.Internal (Proxy(..), X, closed)--{- $proxy-    Diagrammatically, you can think of a 'Proxy' as having the following shape:--@- Upstream | Downstream-     +---------+-     |         |- a' <==       <== b'-     |         |- a  ==>       ==> b-     |    |    |-     +----|----+-          v-          r-@--    You can connect proxies together in five different ways:--    * ('Pipes.>+>'): connect pull-based streams--    * ('Pipes.>~>'): connect push-based streams--    * ('Pipes.\>\'): chain folds--    * ('Pipes./>/'): chain unfolds--    * ('Control.Monad.>=>'): sequence proxies---}---- | Run a self-contained 'Effect', converting it back to the base monad-runEffect :: Monad m => Effect m r -> m r-runEffect = go-  where-    go p = case p of-        Request v _ -> closed v-        Respond v _ -> closed v-        M       m   -> m >>= go-        Pure    r   -> return r-{-# INLINABLE runEffect #-}--{- * Keep proxy composition lower in precedence than function composition, which-     is 9 at the time of of this comment, so that users can write things like:---> lift . k >+> p->-> hoist f . k >+> p--   * Keep the priorities different so that users can mix composition operators-     like:--> up \>\ p />/ dn->-> up >~> p >+> dn--   * Keep 'request' and 'respond' composition lower in precedence than 'pull'-     and 'push' composition, so that users can do:--> read \>\ pull >+> writer--   * I arbitrarily choose a lower priority for downstream operators so that lazy-     pull-based computations need not evaluate upstream stages unless absolutely-     necessary.--}-infixl 3 //>-infixr 3 <\\      -- GHC will raise a parse error if either of these lines ends-infixr 4 />/, >\\ -- with '\', which is why this comment is here-infixl 4 \<\, //<-infixl 5 \>\      -- Same thing here-infixr 5 /</-infixl 6 <<+-infixr 6 +>>-infixl 7 >+>, >>~-infixr 7 <+<, ~<<-infixl 8 <~<-infixr 8 >~>--{- $categories-    A 'Control.Category.Category' is a set of components that you can connect-    with a composition operator, ('Control.Category..'), that has an identity,-    'Control.Category.id'.  The ('Control.Category..') and 'Control.Category.id'-    must satisfy the following three 'Control.Category.Category' laws:--@-\-\- Left identity-'Control.Category.id' 'Control.Category..' f = f--\-\- Right identity-f 'Control.Category..' 'Control.Category.id' = f--\-\- Associativity-(f 'Control.Category..' g) 'Control.Category..' h = f 'Control.Category..' (g 'Control.Category..' h)-@--    The 'Proxy' type sits at the intersection of five separate categories, four-    of which are named after their identity:--@-                     Identity   | Composition |  Point-ful-                  +-------------+-------------+-------------+- respond category |   'respond'   |     '/>/'     |     '//>'     |- request category |   'request'   |     '\>\'     |     '>\\'     |-    push category |   'push'      |     '>~>'     |     '>>~'     |-    pull category |   'pull'      |     '>+>'     |     '+>>'     |- Kleisli category |   'return'    |     'Control.Monad.>=>'     |     '>>='     |-                  +-------------+-------------+-------------+-@--    Each composition operator has a \"point-ful\" version, analogous to how-    ('>>=') is the point-ful version of ('Control.Monad.>=>').  For example,-    ('//>') is the point-ful version of ('/>/').  The convention is that the-    odd character out faces the argument that is a function.--}--{- $respond-    The 'respond' category closely corresponds to the generator design pattern.--    The 'respond' category obeys the category laws, where 'respond' is the-    identity and ('/>/') is composition:--@-\-\- Left identity-'respond' '/>/' f = f--\-\- Right identity-f '/>/' 'respond' = f--\-\- Associativity-(f '/>/' g) '/>/' h = f '/>/' (g '/>/' h)-@--#respond-diagram#--    The following diagrams show the flow of information:--@-'respond' :: 'Monad' m-       =>  a -> 'Proxy' x' x a' a m a'--\          a-          |-     +----|----+-     |    |    |- x' <==   \\ /==== a'-     |     X   |- x  ==>   / \\===> a-     |    |    |-     +----|----+-          v-          a'--('/>/') :: 'Monad' m-      => (a -> 'Proxy' x' x b' b m a')-      -> (b -> 'Proxy' x' x c' c m b')-      -> (a -> 'Proxy' x' x c' c m a')--\          a                   /===> b                      a-          |                  /      |                      |-     +----|----+            /  +----|----+            +----|----+-     |    v    |           /   |    v    |            |    v    |- x' <==       <== b' <==\\ / x'<==       <== c'    x' <==       <== c'-     |    f    |         X     |    g    |     =      | f '/>/' g |- x  ==>       ==> b  ===/ \\ x ==>       ==> c     x  ==>       ==> c'-     |    |    |           \\   |    |    |            |    |    |-     +----|----+            \\  +----|----+            +----|----+-          v                  \\      v                      v-          a'                  \\==== b'                     a'--('//>') :: 'Monad' m-      => 'Proxy' x' x b' b m a'-      -> (b -> 'Proxy' x' x c' c m b')-      -> 'Proxy' x' x c' c m a'--\                              /===> b-                             /      |-     +---------+            /  +----|----+            +---------+-     |         |           /   |    v    |            |         |- x' <==       <== b' <==\\ / x'<==       <== c'    x' <==       <== c'-     |    f    |         X     |    g    |     =      | f '//>' g |- x  ==>       ==> b  ===/ \\ x ==>       ==> c     x  ==>       ==> c'-     |    |    |           \\   |    |    |            |    |    |-     +----|----+            \\  +----|----+            +----|----+-          v                  \\      v                      v-          a'                  \\==== b'                     a'-@---}--{-| Send a value of type @a@ downstream and block waiting for a reply of type-    @a'@--    'respond' is the identity of the respond category.--}-respond :: Monad m => a -> Proxy x' x a' a m a'-respond a = Respond a Pure-{-# INLINABLE respond #-}--{-| Compose two unfolds, creating a new unfold--@-(f '/>/' g) x = f x '//>' g-@--    ('/>/') is the composition operator of the respond category.--}-(/>/)-    :: Monad m-    => (a -> Proxy x' x b' b m a')-    -- ^-    -> (b -> Proxy x' x c' c m b')-    -- ^-    -> (a -> Proxy x' x c' c m a')-    -- ^-(fa />/ fb) a = fa a //> fb-{-# INLINABLE (/>/) #-}--{-| @(p \/\/> f)@ replaces each 'respond' in @p@ with @f@.--    Point-ful version of ('/>/')--}-(//>)-    :: Monad m-    =>       Proxy x' x b' b m a'-    -- ^-    -> (b -> Proxy x' x c' c m b')-    -- ^-    ->       Proxy x' x c' c m a'-    -- ^-p0 //> fb = go p0-  where-    go p = case p of-        Request x' fx  -> Request x' (\x -> go (fx x))-        Respond b  fb' -> fb b >>= \b' -> go (fb' b')-        M          m   -> M (m >>= \p' -> return (go p'))-        Pure       a   -> Pure a-{-# INLINABLE (//>) #-}--{-# RULES-    "(Request x' fx ) //> fb" forall x' fx  fb .-        (Request x' fx ) //> fb = Request x' (\x -> fx x //> fb);-    "(Respond b  fb') //> fb" forall b  fb' fb .-        (Respond b  fb') //> fb = fb b >>= \b' -> fb' b' //> fb;-    "(M          m  ) //> fb" forall    m   fb .-        (M          m  ) //> fb = M (m >>= \p' -> return (p' //> fb));-    "(Pure      a   ) //> fb" forall a      fb .-        (Pure    a     ) //> fb = Pure a;-  #-}--{- $request-    The 'request' category closely corresponds to the iteratee design pattern.--    The 'request' category obeys the category laws, where 'request' is the-    identity and ('\>\') is composition:--@--- Left identity-'request' '\>\' f = f--\-\- Right identity-f '\>\' 'request' = f--\-\- Associativity-(f '\>\' g) '\>\' h = f '\>\' (g '\>\' h)-@--#request-diagram#--    The following diagrams show the flow of information:--@-'request' :: 'Monad' m-        =>  a' -> 'Proxy' a' a y' y m a--\          a'-          |-     +----|----+-     |    |    |- a' <=====/   <== y'-     |         |- a  ======\\   ==> y-     |    |    |-     +----|----+-          v-          a--('\>\') :: 'Monad' m-      => (b' -> 'Proxy' a' a y' y m b)-      -> (c' -> 'Proxy' b' b y' y m c)-      -> (c' -> 'Proxy' a' a y' y m c)--\          b'<=====\\                c'                     c'-          |        \\               |                      |-     +----|----+    \\         +----|----+            +----|----+-     |    v    |     \\        |    v    |            |    v    |- a' <==       <== y'  \\== b' <==       <== y'    a' <==       <== y'-     |    f    |              |    g    |     =      | f '\>\' g |- a  ==>       ==> y   /=> b  ==>       ==> y     a  ==>       ==> y-     |    |    |     /        |    |    |            |    |    |-     +----|----+    /         +----|----+            +----|----+-          v        /               v                      v-          b ======/                c                      c--('>\\') :: Monad m-      => (b' -> Proxy a' a y' y m b)-      -> Proxy b' b y' y m c-      -> Proxy a' a y' y m c--\          b'<=====\\-          |        \\-     +----|----+    \\         +---------+            +---------+-     |    v    |     \\        |         |            |         |- a' <==       <== y'  \\== b' <==       <== y'    a' <==       <== y'-     |    f    |              |    g    |     =      | f '>\\' g |- a  ==>       ==> y   /=> b  ==>       ==> y     a  ==>       ==> y-     |    |    |     /        |    |    |            |    |    |-     +----|----+    /         +----|----+            +----|----+-          v        /               v                      v-          b ======/                c                      c-@--}--{-| Send a value of type @a'@ upstream and block waiting for a reply of type @a@--    'request' is the identity of the request category.--}-request :: Monad m => a' -> Proxy a' a y' y m a-request a' = Request a' Pure-{-# INLINABLE request #-}--{-| Compose two folds, creating a new fold--@-(f '\>\' g) x = f '>\\' g x-@--    ('\>\') is the composition operator of the request category.--}-(\>\)-    :: Monad m-    => (b' -> Proxy a' a y' y m b)-    -- ^-    -> (c' -> Proxy b' b y' y m c)-    -- ^-    -> (c' -> Proxy a' a y' y m c)-    -- ^-(fb' \>\ fc') c' = fb' >\\ fc' c'-{-# INLINABLE (\>\) #-}--{-| @(f >\\\\ p)@ replaces each 'request' in @p@ with @f@.--    Point-ful version of ('\>\')--}-(>\\)-    :: Monad m-    => (b' -> Proxy a' a y' y m b)-    -- ^-    ->        Proxy b' b y' y m c-    -- ^-    ->        Proxy a' a y' y m c-    -- ^-fb' >\\ p0 = go p0-  where-    go p = case p of-        Request b' fb  -> fb' 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-{-# INLINABLE (>\\) #-}--{-# RULES-    "fb' >\\ (Request b' fb )" forall fb' b' fb  .-        fb' >\\ (Request b' fb ) = fb' b' >>= \b -> fb' >\\ fb  b;-    "fb' >\\ (Respond x  fx')" forall fb' x  fx' .-        fb' >\\ (Respond x  fx') = Respond x (\x' -> fb' >\\ fx' x');-    "fb' >\\ (M          m  )" forall fb'    m   .-        fb' >\\ (M          m  ) = M (m >>= \p' -> return (fb' >\\ p'));-    "fb' >\\ (Pure    a    )" forall fb' a      .-        fb' >\\ (Pure    a     ) = Pure a;-  #-}--{- $push-    The 'push' category closely corresponds to push-based Unix pipes.--    The 'push' category obeys the category laws, where 'push' is the identity-    and ('>~>') is composition:--@-\-\- Left identity-'push' '>~>' f = f--\-\- Right identity-f '>~>' 'push' = f--\-\- Associativity-(f '>~>' g) '>~>' h = f '>~>' (g '>~>' h)-@--    The following diagram shows the flow of information:--@-'push'  :: 'Monad' m-      =>  a -> 'Proxy' a' a a' a m r--\          a-          |-     +----|----+-     |    v    |- a' <============ a'-     |         |- a  ============> a-     |    |    |-     +----|----+-          v-          r--('>~>') :: 'Monad' m-      => (a -> 'Proxy' a' a b' b m r)-      -> (b -> 'Proxy' b' b c' c m r)-      -> (a -> 'Proxy' a' a c' c m r)--\          a                b                      a-          |                |                      |-     +----|----+      +----|----+            +----|----+-     |    v    |      |    v    |            |    v    |- a' <==       <== b' <==       <== c'    a' <==       <== c'-     |    f    |      |    g    |     =      | f '>~>' g |- a  ==>       ==> b  ==>       ==> c     a  ==>       ==> c-     |    |    |      |    |    |            |    |    |-     +----|----+      +----|----+            +----|----+-          v                v                      v-          r                r                      r-@---}--{-| Forward responses followed by requests--@-'push' = 'respond' 'Control.Monad.>=>' 'request' 'Control.Monad.>=>' 'push'-@--    'push' is the identity of the push category.--}-push :: Monad m => a -> Proxy a' a a' a m r-push = go-  where-    go a = Respond a (\a' -> Request a' go)-{-# INLINABLE push #-}--{-| Compose two proxies blocked while 'request'ing data, creating a new proxy-    blocked while 'request'ing data--@-(f '>~>' g) x = f x '>>~' g-@--    ('>~>') is the composition operator of the push category.--}-(>~>)-    :: Monad m-    => (_a -> Proxy a' a b' b m r)-    -- ^-    -> ( b -> Proxy b' b c' c m r)-    -- ^-    -> (_a -> Proxy a' a c' c m r)-    -- ^-(fa >~> fb) a = fa a >>~ fb-{-# INLINABLE (>~>) #-}--{-| @(p >>~ f)@ pairs each 'respond' in @p@ with an 'request' in @f@.--    Point-ful version of ('>~>')--}-(>>~)-    :: Monad m-    =>       Proxy a' a b' b m r-    -- ^-    -> (b -> Proxy b' b c' c m r)-    -- ^-    ->       Proxy a' a c' c m r-    -- ^-p >>~ fb = case p of-    Request a' fa  -> Request a' (\a -> fa a >>~ fb)-    Respond b  fb' -> fb' +>> fb b-    M          m   -> M (m >>= \p' -> return (p' >>~ fb))-    Pure       r   -> Pure r-{-# INLINABLE (>>~) #-}--{- $pull-    The 'pull' category closely corresponds to pull-based Unix pipes.--    The 'pull' category obeys the category laws, where 'pull' is the identity-    and ('>+>') is composition:--@-\-\- Left identity-'pull' '>+>' f = f--\-\- Right identity-f '>+>' 'pull' = f--\-\- Associativity-(f '>+>' g) '>+>' h = f '>+>' (g '>+>' h)-@--#pull-diagram#--    The following diagrams show the flow of information:--@-'pull'  :: 'Monad' m-      =>  a' -> 'Proxy' a' a a' a m r--\          a'-          |-     +----|----+-     |    v    |- a' <============ a'-     |         |- a  ============> a-     |    |    |-     +----|----+-          v-          r--('>+>') :: 'Monad' m-      -> (b' -> 'Proxy' a' a b' b m r)-      -> (c' -> 'Proxy' b' b c' c m r)-      -> (c' -> 'Proxy' a' a c' c m r)--\          b'               c'                     c'-          |                |                      |-     +----|----+      +----|----+            +----|----+-     |    v    |      |    v    |            |    v    |- a' <==       <== b' <==       <== c'    a' <==       <== c'-     |    f    |      |    g    |     =      | f >+> g |- a  ==>       ==> b  ==>       ==> c     a  ==>       ==> c-     |    |    |      |    |    |            |    |    |-     +----|----+      +----|----+            +----|----+-          v                v                      v-          r                r                      r-@---}--{-| Forward requests followed by responses:--@-'pull' = 'request' 'Control.Monad.>=>' 'respond' 'Control.Monad.>=>' 'pull'-@--    'pull' is the identity of the pull category.--}-pull :: Monad m => a' -> Proxy a' a a' a m r-pull = go-  where-    go a' = Request a' (\a -> Respond a go)-{-# INLINABLE pull #-}--{-| Compose two proxies blocked in the middle of 'respond'ing, creating a new-    proxy blocked in the middle of 'respond'ing--@-(f '>+>' g) x = f '+>>' g x-@--    ('>+>') is the composition operator of the pull category.--}-(>+>)-    :: Monad m-    => ( b' -> Proxy a' a b' b m r)-    -- ^-    -> (_c' -> Proxy b' b c' c m r)-    -- ^-    -> (_c' -> Proxy a' a c' c m r)-    -- ^-(fb' >+> fc') c' = fb' +>> fc' c'-{-# INLINABLE (>+>) #-}--{-| @(f +>> p)@ pairs each 'request' in @p@ with a 'respond' in @f@.--    Point-ful version of ('>+>')--}-(+>>)-    :: Monad m-    => (b' -> Proxy a' a b' b m r)-    -- ^-    ->        Proxy b' b c' c m r-    -- ^-    ->        Proxy a' a c' c m r-    -- ^-fb' +>> p = case p of-    Request b' fb  -> fb' b' >>~ fb-    Respond c  fc' -> Respond c (\c' -> fb' +>> fc' c')-    M          m   -> M (m >>= \p' -> return (fb' +>> p'))-    Pure       r   -> Pure r-{-# INLINABLE (+>>) #-}--{- $reflect-    @(reflect .)@ transforms each streaming category into its dual:--    * The request category is the dual of the respond category--@-'reflect' '.' 'respond' = 'request'--'reflect' '.' (f '/>/' g) = 'reflect' '.' f '/</' 'reflect' '.' g-@--@-'reflect' '.' 'request' = 'respond'--'reflect' '.' (f '\>\' g) = 'reflect' '.' f '\<\' 'reflect' '.' g-@--    * The pull category is the dual of the push category--@-'reflect' '.' 'push' = 'pull'--'reflect' '.' (f '>~>' g) = 'reflect' '.' f '<+<' 'reflect' '.' g-@--@-'reflect' '.' 'pull' = 'push'--'reflect' '.' (f '>+>' g) = 'reflect' '.' f '<~<' 'reflect' '.' g-@--}---- | Switch the upstream and downstream ends-reflect :: Monad m => Proxy a' a b' b m r -> Proxy b b' a a' m r-reflect = go-  where-    go p = case p of-        Request a' fa  -> Respond a' (\a  -> go (fa  a ))-        Respond b  fb' -> Request b  (\b' -> go (fb' b'))-        M          m   -> M (m >>= \p' -> return (go p'))-        Pure    r      -> Pure r-{-# INLINABLE reflect #-}--{-| An effect in the base monad--    'Effect's neither 'Pipes.await' nor 'Pipes.yield'--}-type Effect = Proxy X () () X---- | 'Producer's can only 'Pipes.yield'-type Producer b = Proxy X () () b---- | 'Pipe's can both 'Pipes.await' and 'Pipes.yield'-type Pipe a b = Proxy () a () b---- | 'Consumer's can only 'Pipes.await'-type Consumer a = Proxy () a () X--{-| @Client a' a@ sends requests of type @a'@ and receives responses of-    type @a@.--    'Client's only 'request' and never 'respond'.--}-type Client a' a = Proxy a' a () X--{-| @Server b' b@ receives requests of type @b'@ and sends responses of type-    @b@.--    'Server's only 'respond' and never 'request'.--}-type Server b' b = Proxy X () b' b---- | Like 'Effect', but with a polymorphic type-type Effect' m r = forall x' x y' y . Proxy x' x y' y m r---- | Like 'Producer', but with a polymorphic type-type Producer' b m r = forall x' x . Proxy x' x () b m r---- | Like 'Consumer', but with a polymorphic type-type Consumer' a m r = forall y' y . Proxy () a y' y m r---- | Like 'Server', but with a polymorphic type-type Server' b' b m r = forall x' x . Proxy x' x b' b m r---- | Like 'Client', but with a polymorphic type-type Client' a' a m r = forall y' y . Proxy a' a y' y m r---- | Equivalent to ('/>/') with the arguments flipped-(\<\)-    :: Monad m-    => (b -> Proxy x' x c' c m b')-    -- ^-    -> (a -> Proxy x' x b' b m a')-    -- ^-    -> (a -> Proxy x' x c' c m a')-    -- ^-p1 \<\ p2 = p2 />/ p1-{-# INLINABLE (\<\) #-}---- | Equivalent to ('\>\') with the arguments flipped-(/</)-    :: Monad m-    => (c' -> Proxy b' b x' x m c)-    -- ^-    -> (b' -> Proxy a' a x' x m b)-    -- ^-    -> (c' -> Proxy a' a x' x m c)-    -- ^-p1 /</ p2 = p2 \>\ p1-{-# INLINABLE (/</) #-}---- | Equivalent to ('>~>') with the arguments flipped-(<~<)-    :: Monad m-    => (b -> Proxy b' b c' c m r)-    -- ^-    -> (a -> Proxy a' a b' b m r)-    -- ^-    -> (a -> Proxy a' a c' c m r)-    -- ^-p1 <~< p2 = p2 >~> p1-{-# INLINABLE (<~<) #-}---- | Equivalent to ('>+>') with the arguments flipped-(<+<)-    :: Monad m-    => (c' -> Proxy b' b c' c m r)-    -- ^-    -> (b' -> Proxy a' a b' b m r)-    -- ^-    -> (c' -> Proxy a' a c' c m r)-    -- ^-p1 <+< p2 = p2 >+> p1-{-# INLINABLE (<+<) #-}---- | Equivalent to ('//>') with the arguments flipped-(<\\)-    :: Monad m-    => (b -> Proxy x' x c' c m b')-    -- ^-    ->       Proxy x' x b' b m a'-    -- ^-    ->       Proxy x' x c' c m a'-    -- ^-f <\\ p = p //> f-{-# INLINABLE (<\\) #-}---- | Equivalent to ('>\\') with the arguments flipped-(//<)-    :: Monad m-    =>        Proxy b' b y' y m c-    -- ^-    -> (b' -> Proxy a' a y' y m b)-    -- ^-    ->        Proxy a' a y' y m c-    -- ^-p //< f = f >\\ p-{-# INLINABLE (//<) #-}---- | Equivalent to ('>>~') with the arguments flipped-(~<<)-    :: Monad m-    => (b  -> Proxy b' b c' c m r)-    -- ^-    ->        Proxy a' a b' b m r-    -- ^-    ->        Proxy a' a c' c m r-    -- ^-k ~<< p = p >>~ k-{-# INLINABLE (~<<) #-}---- | Equivalent to ('+>>') with the arguments flipped-(<<+)-    :: Monad m-    =>         Proxy b' b c' c m r-    -- ^-    -> (b'  -> Proxy a' a b' b m r)-    -- ^-    ->         Proxy a' a c' c m r-    -- ^-k <<+ p = p +>> k-{-# INLINABLE (<<+) #-}--{-# RULES-    "(p //> f) //> g" forall p f g . (p //> f) //> g = p //> (\x -> f x //> g)--  ; "p //> respond" forall p . p //> respond = p--  ; "respond x //> f" forall x f . respond x //>  f = f x--  ; "f >\\ (g >\\ p)" forall f g p . f >\\ (g >\\ p) = (\x -> f >\\ g x) >\\ p--  ; "request >\\ p" forall p . request >\\ p = p--  ; "f >\\ request x" forall f x . f >\\ request x = f x--  ; "(p >>~ f) >>~ g" forall p f g . (p >>~ f) >>~ g = p >>~ (\x -> f x >>~ g)--  ; "p >>~ push" forall p . p >>~ push = p--  ; "push x >>~ f" forall x f . push x >>~ f = f x--  ; "f +>> (g +>> p)" forall f g p . f +>> (g +>> p) = (\x -> f +>> g x) +>> p--  ; "pull +>> p" forall p . pull +>> p = p--  ; "f +>> pull x" forall f x . f +>> pull x = f x--  #-}+{-| The core functionality for the 'Proxy' monad transformer
+
+    Read "Pipes.Tutorial" if you want a beginners tutorial explaining how to use
+    this library.  The documentation in this module targets more advanced users
+    who want to understand the theory behind this library.
+
+    This module is not exported by default, and I recommend you use the
+    unidirectional operations exported by the "Pipes" module if you can.  You
+    should only use this module if you require advanced features like:
+
+    * bidirectional communication, or:
+
+    * push-based 'Pipe's.
+-}
+
+{-# LANGUAGE RankNTypes, Trustworthy #-}
+
+module Pipes.Core (
+    -- * Proxy Monad Transformer
+    -- $proxy
+      Proxy
+    , runEffect
+
+    -- * Categories
+    -- $categories
+
+    -- ** Respond
+    -- $respond
+    , respond
+    , (/>/)
+    , (//>)
+
+    -- ** Request
+    -- $request
+    , request
+    , (\>\)
+    , (>\\)
+
+    -- ** Push
+    -- $push
+    , push
+    , (>~>)
+    , (>>~)
+
+    -- ** Pull
+    -- $pull
+    , pull
+    , (>+>)
+    , (+>>)
+
+    -- ** Reflect
+    -- $reflect
+    , reflect
+
+    -- * Concrete Type Synonyms
+    , X
+    , Effect
+    , Producer
+    , Pipe
+    , Consumer
+    , Client
+    , Server
+
+    -- * Polymorphic Type Synonyms
+    , Effect'
+    , Producer'
+    , Consumer'
+    , Client'
+    , Server'
+
+    -- * Flipped operators
+    , (\<\)
+    , (/</)
+    , (<~<)
+    , (~<<)
+    , (<+<)
+    , (<\\)
+    , (//<)
+    , (<<+)
+
+    -- * Re-exports
+    , closed
+    ) where
+
+import Pipes.Internal (Proxy(..), X, closed)
+
+{- $proxy
+    Diagrammatically, you can think of a 'Proxy' as having the following shape:
+
+@
+ Upstream | Downstream
+     +---------+
+     |         |
+ a' <==       <== b'
+     |         |
+ a  ==>       ==> b
+     |    |    |
+     +----|----+
+          v
+          r
+@
+
+    You can connect proxies together in five different ways:
+
+    * ('Pipes.>+>'): connect pull-based streams
+
+    * ('Pipes.>~>'): connect push-based streams
+
+    * ('Pipes.\>\'): chain folds
+
+    * ('Pipes./>/'): chain unfolds
+
+    * ('Control.Monad.>=>'): sequence proxies
+
+-}
+
+-- | Run a self-contained 'Effect', converting it back to the base monad
+runEffect :: Monad m => Effect m r -> m r
+runEffect = go
+  where
+    go p = case p of
+        Request v _ -> closed v
+        Respond v _ -> closed v
+        M       m   -> m >>= go
+        Pure    r   -> return r
+{-# INLINABLE runEffect #-}
+
+{- * Keep proxy composition lower in precedence than function composition, which
+     is 9 at the time of of this comment, so that users can write things like:
+
+
+> lift . k >+> p
+>
+> hoist f . k >+> p
+
+   * Keep the priorities different so that users can mix composition operators
+     like:
+
+> up \>\ p />/ dn
+>
+> up >~> p >+> dn
+
+   * Keep 'request' and 'respond' composition lower in precedence than 'pull'
+     and 'push' composition, so that users can do:
+
+> read \>\ pull >+> writer
+
+   * I arbitrarily choose a lower priority for downstream operators so that lazy
+     pull-based computations need not evaluate upstream stages unless absolutely
+     necessary.
+-}
+infixl 3 //>
+infixr 3 <\\      -- GHC will raise a parse error if either of these lines ends
+infixr 4 />/, >\\ -- with '\', which is why this comment is here
+infixl 4 \<\, //<
+infixl 5 \>\      -- Same thing here
+infixr 5 /</
+infixl 6 <<+
+infixr 6 +>>
+infixl 7 >+>, >>~
+infixr 7 <+<, ~<<
+infixl 8 <~<
+infixr 8 >~>
+
+{- $categories
+    A 'Control.Category.Category' is a set of components that you can connect
+    with a composition operator, ('Control.Category..'), that has an identity,
+    'Control.Category.id'.  The ('Control.Category..') and 'Control.Category.id'
+    must satisfy the following three 'Control.Category.Category' laws:
+
+@
+\-\- Left identity
+'Control.Category.id' 'Control.Category..' f = f
+
+\-\- Right identity
+f 'Control.Category..' 'Control.Category.id' = f
+
+\-\- Associativity
+(f 'Control.Category..' g) 'Control.Category..' h = f 'Control.Category..' (g 'Control.Category..' h)
+@
+
+    The 'Proxy' type sits at the intersection of five separate categories, four
+    of which are named after their identity:
+
+@
+                     Identity   | Composition |  Point-ful
+                  +-------------+-------------+-------------+
+ respond category |   'respond'   |     '/>/'     |     '//>'     |
+ request category |   'request'   |     '\>\'     |     '>\\'     |
+    push category |   'push'      |     '>~>'     |     '>>~'     |
+    pull category |   'pull'      |     '>+>'     |     '+>>'     |
+ Kleisli category |   'return'    |     'Control.Monad.>=>'     |     '>>='     |
+                  +-------------+-------------+-------------+
+@
+
+    Each composition operator has a \"point-ful\" version, analogous to how
+    ('>>=') is the point-ful version of ('Control.Monad.>=>').  For example,
+    ('//>') is the point-ful version of ('/>/').  The convention is that the
+    odd character out faces the argument that is a function.
+-}
+
+{- $respond
+    The 'respond' category closely corresponds to the generator design pattern.
+
+    The 'respond' category obeys the category laws, where 'respond' is the
+    identity and ('/>/') is composition:
+
+@
+\-\- Left identity
+'respond' '/>/' f = f
+
+\-\- Right identity
+f '/>/' 'respond' = f
+
+\-\- Associativity
+(f '/>/' g) '/>/' h = f '/>/' (g '/>/' h)
+@
+
+#respond-diagram#
+
+    The following diagrams show the flow of information:
+
+@
+'respond' :: 'Monad' m
+       =>  a -> 'Proxy' x' x a' a m a'
+
+\          a
+          |
+     +----|----+
+     |    |    |
+ x' <==   \\ /==== a'
+     |     X   |
+ x  ==>   / \\===> a
+     |    |    |
+     +----|----+
+          v
+          a'
+
+('/>/') :: 'Monad' m
+      => (a -> 'Proxy' x' x b' b m a')
+      -> (b -> 'Proxy' x' x c' c m b')
+      -> (a -> 'Proxy' x' x c' c m a')
+
+\          a                   /===> b                      a
+          |                  /      |                      |
+     +----|----+            /  +----|----+            +----|----+
+     |    v    |           /   |    v    |            |    v    |
+ x' <==       <== b' <==\\ / x'<==       <== c'    x' <==       <== c'
+     |    f    |         X     |    g    |     =      | f '/>/' g |
+ x  ==>       ==> b  ===/ \\ x ==>       ==> c     x  ==>       ==> c'
+     |    |    |           \\   |    |    |            |    |    |
+     +----|----+            \\  +----|----+            +----|----+
+          v                  \\      v                      v
+          a'                  \\==== b'                     a'
+
+('//>') :: 'Monad' m
+      => 'Proxy' x' x b' b m a'
+      -> (b -> 'Proxy' x' x c' c m b')
+      -> 'Proxy' x' x c' c m a'
+
+\                              /===> b
+                             /      |
+     +---------+            /  +----|----+            +---------+
+     |         |           /   |    v    |            |         |
+ x' <==       <== b' <==\\ / x'<==       <== c'    x' <==       <== c'
+     |    f    |         X     |    g    |     =      | f '//>' g |
+ x  ==>       ==> b  ===/ \\ x ==>       ==> c     x  ==>       ==> c'
+     |    |    |           \\   |    |    |            |    |    |
+     +----|----+            \\  +----|----+            +----|----+
+          v                  \\      v                      v
+          a'                  \\==== b'                     a'
+@
+
+-}
+
+{-| Send a value of type @a@ downstream and block waiting for a reply of type
+    @a'@
+
+    'respond' is the identity of the respond category.
+-}
+respond :: Monad m => a -> Proxy x' x a' a m a'
+respond a = Respond a Pure
+{-# INLINABLE respond #-}
+
+{-| Compose two unfolds, creating a new unfold
+
+@
+(f '/>/' g) x = f x '//>' g
+@
+
+    ('/>/') is the composition operator of the respond category.
+-}
+(/>/)
+    :: Monad m
+    => (a -> Proxy x' x b' b m a')
+    -- ^
+    -> (b -> Proxy x' x c' c m b')
+    -- ^
+    -> (a -> Proxy x' x c' c m a')
+    -- ^
+(fa />/ fb) a = fa a //> fb
+{-# INLINABLE (/>/) #-}
+
+{-| @(p \/\/> f)@ replaces each 'respond' in @p@ with @f@.
+
+    Point-ful version of ('/>/')
+-}
+(//>)
+    :: Monad m
+    =>       Proxy x' x b' b m a'
+    -- ^
+    -> (b -> Proxy x' x c' c m b')
+    -- ^
+    ->       Proxy x' x c' c m a'
+    -- ^
+p0 //> fb = go p0
+  where
+    go p = case p of
+        Request x' fx  -> Request x' (\x -> go (fx x))
+        Respond b  fb' -> fb b >>= \b' -> go (fb' b')
+        M          m   -> M (m >>= \p' -> return (go p'))
+        Pure       a   -> Pure a
+{-# INLINABLE (//>) #-}
+
+{-# RULES
+    "(Request x' fx ) //> fb" forall x' fx  fb .
+        (Request x' fx ) //> fb = Request x' (\x -> fx x //> fb);
+    "(Respond b  fb') //> fb" forall b  fb' fb .
+        (Respond b  fb') //> fb = fb b >>= \b' -> fb' b' //> fb;
+    "(M          m  ) //> fb" forall    m   fb .
+        (M          m  ) //> fb = M (m >>= \p' -> return (p' //> fb));
+    "(Pure      a   ) //> fb" forall a      fb .
+        (Pure    a     ) //> fb = Pure a;
+  #-}
+
+{- $request
+    The 'request' category closely corresponds to the iteratee design pattern.
+
+    The 'request' category obeys the category laws, where 'request' is the
+    identity and ('\>\') is composition:
+
+@
+-- Left identity
+'request' '\>\' f = f
+
+\-\- Right identity
+f '\>\' 'request' = f
+
+\-\- Associativity
+(f '\>\' g) '\>\' h = f '\>\' (g '\>\' h)
+@
+
+#request-diagram#
+
+    The following diagrams show the flow of information:
+
+@
+'request' :: 'Monad' m
+        =>  a' -> 'Proxy' a' a y' y m a
+
+\          a'
+          |
+     +----|----+
+     |    |    |
+ a' <=====/   <== y'
+     |         |
+ a  ======\\   ==> y
+     |    |    |
+     +----|----+
+          v
+          a
+
+('\>\') :: 'Monad' m
+      => (b' -> 'Proxy' a' a y' y m b)
+      -> (c' -> 'Proxy' b' b y' y m c)
+      -> (c' -> 'Proxy' a' a y' y m c)
+
+\          b'<=====\\                c'                     c'
+          |        \\               |                      |
+     +----|----+    \\         +----|----+            +----|----+
+     |    v    |     \\        |    v    |            |    v    |
+ a' <==       <== y'  \\== b' <==       <== y'    a' <==       <== y'
+     |    f    |              |    g    |     =      | f '\>\' g |
+ a  ==>       ==> y   /=> b  ==>       ==> y     a  ==>       ==> y
+     |    |    |     /        |    |    |            |    |    |
+     +----|----+    /         +----|----+            +----|----+
+          v        /               v                      v
+          b ======/                c                      c
+
+('>\\') :: Monad m
+      => (b' -> Proxy a' a y' y m b)
+      -> Proxy b' b y' y m c
+      -> Proxy a' a y' y m c
+
+\          b'<=====\\
+          |        \\
+     +----|----+    \\         +---------+            +---------+
+     |    v    |     \\        |         |            |         |
+ a' <==       <== y'  \\== b' <==       <== y'    a' <==       <== y'
+     |    f    |              |    g    |     =      | f '>\\' g |
+ a  ==>       ==> y   /=> b  ==>       ==> y     a  ==>       ==> y
+     |    |    |     /        |    |    |            |    |    |
+     +----|----+    /         +----|----+            +----|----+
+          v        /               v                      v
+          b ======/                c                      c
+@
+-}
+
+{-| Send a value of type @a'@ upstream and block waiting for a reply of type @a@
+
+    'request' is the identity of the request category.
+-}
+request :: Monad m => a' -> Proxy a' a y' y m a
+request a' = Request a' Pure
+{-# INLINABLE request #-}
+
+{-| Compose two folds, creating a new fold
+
+@
+(f '\>\' g) x = f '>\\' g x
+@
+
+    ('\>\') is the composition operator of the request category.
+-}
+(\>\)
+    :: Monad m
+    => (b' -> Proxy a' a y' y m b)
+    -- ^
+    -> (c' -> Proxy b' b y' y m c)
+    -- ^
+    -> (c' -> Proxy a' a y' y m c)
+    -- ^
+(fb' \>\ fc') c' = fb' >\\ fc' c'
+{-# INLINABLE (\>\) #-}
+
+{-| @(f >\\\\ p)@ replaces each 'request' in @p@ with @f@.
+
+    Point-ful version of ('\>\')
+-}
+(>\\)
+    :: Monad m
+    => (b' -> Proxy a' a y' y m b)
+    -- ^
+    ->        Proxy b' b y' y m c
+    -- ^
+    ->        Proxy a' a y' y m c
+    -- ^
+fb' >\\ p0 = go p0
+  where
+    go p = case p of
+        Request b' fb  -> fb' 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
+{-# INLINABLE (>\\) #-}
+
+{-# RULES
+    "fb' >\\ (Request b' fb )" forall fb' b' fb  .
+        fb' >\\ (Request b' fb ) = fb' b' >>= \b -> fb' >\\ fb  b;
+    "fb' >\\ (Respond x  fx')" forall fb' x  fx' .
+        fb' >\\ (Respond x  fx') = Respond x (\x' -> fb' >\\ fx' x');
+    "fb' >\\ (M          m  )" forall fb'    m   .
+        fb' >\\ (M          m  ) = M (m >>= \p' -> return (fb' >\\ p'));
+    "fb' >\\ (Pure    a    )" forall fb' a      .
+        fb' >\\ (Pure    a     ) = Pure a;
+  #-}
+
+{- $push
+    The 'push' category closely corresponds to push-based Unix pipes.
+
+    The 'push' category obeys the category laws, where 'push' is the identity
+    and ('>~>') is composition:
+
+@
+\-\- Left identity
+'push' '>~>' f = f
+
+\-\- Right identity
+f '>~>' 'push' = f
+
+\-\- Associativity
+(f '>~>' g) '>~>' h = f '>~>' (g '>~>' h)
+@
+
+    The following diagram shows the flow of information:
+
+@
+'push'  :: 'Monad' m
+      =>  a -> 'Proxy' a' a a' a m r
+
+\          a
+          |
+     +----|----+
+     |    v    |
+ a' <============ a'
+     |         |
+ a  ============> a
+     |    |    |
+     +----|----+
+          v
+          r
+
+('>~>') :: 'Monad' m
+      => (a -> 'Proxy' a' a b' b m r)
+      -> (b -> 'Proxy' b' b c' c m r)
+      -> (a -> 'Proxy' a' a c' c m r)
+
+\          a                b                      a
+          |                |                      |
+     +----|----+      +----|----+            +----|----+
+     |    v    |      |    v    |            |    v    |
+ a' <==       <== b' <==       <== c'    a' <==       <== c'
+     |    f    |      |    g    |     =      | f '>~>' g |
+ a  ==>       ==> b  ==>       ==> c     a  ==>       ==> c
+     |    |    |      |    |    |            |    |    |
+     +----|----+      +----|----+            +----|----+
+          v                v                      v
+          r                r                      r
+@
+
+-}
+
+{-| Forward responses followed by requests
+
+@
+'push' = 'respond' 'Control.Monad.>=>' 'request' 'Control.Monad.>=>' 'push'
+@
+
+    'push' is the identity of the push category.
+-}
+push :: Monad m => a -> Proxy a' a a' a m r
+push = go
+  where
+    go a = Respond a (\a' -> Request a' go)
+{-# INLINABLE push #-}
+
+{-| Compose two proxies blocked while 'request'ing data, creating a new proxy
+    blocked while 'request'ing data
+
+@
+(f '>~>' g) x = f x '>>~' g
+@
+
+    ('>~>') is the composition operator of the push category.
+-}
+(>~>)
+    :: Monad m
+    => (_a -> Proxy a' a b' b m r)
+    -- ^
+    -> ( b -> Proxy b' b c' c m r)
+    -- ^
+    -> (_a -> Proxy a' a c' c m r)
+    -- ^
+(fa >~> fb) a = fa a >>~ fb
+{-# INLINABLE (>~>) #-}
+
+{-| @(p >>~ f)@ pairs each 'respond' in @p@ with an 'request' in @f@.
+
+    Point-ful version of ('>~>')
+-}
+(>>~)
+    :: Monad m
+    =>       Proxy a' a b' b m r
+    -- ^
+    -> (b -> Proxy b' b c' c m r)
+    -- ^
+    ->       Proxy a' a c' c m r
+    -- ^
+p >>~ fb = case p of
+    Request a' fa  -> Request a' (\a -> fa a >>~ fb)
+    Respond b  fb' -> fb' +>> fb b
+    M          m   -> M (m >>= \p' -> return (p' >>~ fb))
+    Pure       r   -> Pure r
+{-# INLINABLE (>>~) #-}
+
+{- $pull
+    The 'pull' category closely corresponds to pull-based Unix pipes.
+
+    The 'pull' category obeys the category laws, where 'pull' is the identity
+    and ('>+>') is composition:
+
+@
+\-\- Left identity
+'pull' '>+>' f = f
+
+\-\- Right identity
+f '>+>' 'pull' = f
+
+\-\- Associativity
+(f '>+>' g) '>+>' h = f '>+>' (g '>+>' h)
+@
+
+#pull-diagram#
+
+    The following diagrams show the flow of information:
+
+@
+'pull'  :: 'Monad' m
+      =>  a' -> 'Proxy' a' a a' a m r
+
+\          a'
+          |
+     +----|----+
+     |    v    |
+ a' <============ a'
+     |         |
+ a  ============> a
+     |    |    |
+     +----|----+
+          v
+          r
+
+('>+>') :: 'Monad' m
+      -> (b' -> 'Proxy' a' a b' b m r)
+      -> (c' -> 'Proxy' b' b c' c m r)
+      -> (c' -> 'Proxy' a' a c' c m r)
+
+\          b'               c'                     c'
+          |                |                      |
+     +----|----+      +----|----+            +----|----+
+     |    v    |      |    v    |            |    v    |
+ a' <==       <== b' <==       <== c'    a' <==       <== c'
+     |    f    |      |    g    |     =      | f >+> g |
+ a  ==>       ==> b  ==>       ==> c     a  ==>       ==> c
+     |    |    |      |    |    |            |    |    |
+     +----|----+      +----|----+            +----|----+
+          v                v                      v
+          r                r                      r
+@
+
+-}
+
+{-| Forward requests followed by responses:
+
+@
+'pull' = 'request' 'Control.Monad.>=>' 'respond' 'Control.Monad.>=>' 'pull'
+@
+
+    'pull' is the identity of the pull category.
+-}
+pull :: Monad m => a' -> Proxy a' a a' a m r
+pull = go
+  where
+    go a' = Request a' (\a -> Respond a go)
+{-# INLINABLE pull #-}
+
+{-| Compose two proxies blocked in the middle of 'respond'ing, creating a new
+    proxy blocked in the middle of 'respond'ing
+
+@
+(f '>+>' g) x = f '+>>' g x
+@
+
+    ('>+>') is the composition operator of the pull category.
+-}
+(>+>)
+    :: Monad m
+    => ( b' -> Proxy a' a b' b m r)
+    -- ^
+    -> (_c' -> Proxy b' b c' c m r)
+    -- ^
+    -> (_c' -> Proxy a' a c' c m r)
+    -- ^
+(fb' >+> fc') c' = fb' +>> fc' c'
+{-# INLINABLE (>+>) #-}
+
+{-| @(f +>> p)@ pairs each 'request' in @p@ with a 'respond' in @f@.
+
+    Point-ful version of ('>+>')
+-}
+(+>>)
+    :: Monad m
+    => (b' -> Proxy a' a b' b m r)
+    -- ^
+    ->        Proxy b' b c' c m r
+    -- ^
+    ->        Proxy a' a c' c m r
+    -- ^
+fb' +>> p = case p of
+    Request b' fb  -> fb' b' >>~ fb
+    Respond c  fc' -> Respond c (\c' -> fb' +>> fc' c')
+    M          m   -> M (m >>= \p' -> return (fb' +>> p'))
+    Pure       r   -> Pure r
+{-# INLINABLE (+>>) #-}
+
+{- $reflect
+    @(reflect .)@ transforms each streaming category into its dual:
+
+    * The request category is the dual of the respond category
+
+@
+'reflect' '.' 'respond' = 'request'
+
+'reflect' '.' (f '/>/' g) = 'reflect' '.' f '/</' 'reflect' '.' g
+@
+
+@
+'reflect' '.' 'request' = 'respond'
+
+'reflect' '.' (f '\>\' g) = 'reflect' '.' f '\<\' 'reflect' '.' g
+@
+
+    * The pull category is the dual of the push category
+
+@
+'reflect' '.' 'push' = 'pull'
+
+'reflect' '.' (f '>~>' g) = 'reflect' '.' f '<+<' 'reflect' '.' g
+@
+
+@
+'reflect' '.' 'pull' = 'push'
+
+'reflect' '.' (f '>+>' g) = 'reflect' '.' f '<~<' 'reflect' '.' g
+@
+-}
+
+-- | Switch the upstream and downstream ends
+reflect :: Monad m => Proxy a' a b' b m r -> Proxy b b' a a' m r
+reflect = go
+  where
+    go p = case p of
+        Request a' fa  -> Respond a' (\a  -> go (fa  a ))
+        Respond b  fb' -> Request b  (\b' -> go (fb' b'))
+        M          m   -> M (m >>= \p' -> return (go p'))
+        Pure    r      -> Pure r
+{-# INLINABLE reflect #-}
+
+{-| An effect in the base monad
+
+    'Effect's neither 'Pipes.await' nor 'Pipes.yield'
+-}
+type Effect = Proxy X () () X
+
+-- | 'Producer's can only 'Pipes.yield'
+type Producer b = Proxy X () () b
+
+-- | 'Pipe's can both 'Pipes.await' and 'Pipes.yield'
+type Pipe a b = Proxy () a () b
+
+-- | 'Consumer's can only 'Pipes.await'
+type Consumer a = Proxy () a () X
+
+{-| @Client a' a@ sends requests of type @a'@ and receives responses of
+    type @a@.
+
+    'Client's only 'request' and never 'respond'.
+-}
+type Client a' a = Proxy a' a () X
+
+{-| @Server b' b@ receives requests of type @b'@ and sends responses of type
+    @b@.
+
+    'Server's only 'respond' and never 'request'.
+-}
+type Server b' b = Proxy X () b' b
+
+-- | Like 'Effect', but with a polymorphic type
+type Effect' m r = forall x' x y' y . Proxy x' x y' y m r
+
+-- | Like 'Producer', but with a polymorphic type
+type Producer' b m r = forall x' x . Proxy x' x () b m r
+
+-- | Like 'Consumer', but with a polymorphic type
+type Consumer' a m r = forall y' y . Proxy () a y' y m r
+
+-- | Like 'Server', but with a polymorphic type
+type Server' b' b m r = forall x' x . Proxy x' x b' b m r
+
+-- | Like 'Client', but with a polymorphic type
+type Client' a' a m r = forall y' y . Proxy a' a y' y m r
+
+-- | Equivalent to ('/>/') with the arguments flipped
+(\<\)
+    :: Monad m
+    => (b -> Proxy x' x c' c m b')
+    -- ^
+    -> (a -> Proxy x' x b' b m a')
+    -- ^
+    -> (a -> Proxy x' x c' c m a')
+    -- ^
+p1 \<\ p2 = p2 />/ p1
+{-# INLINABLE (\<\) #-}
+
+-- | Equivalent to ('\>\') with the arguments flipped
+(/</)
+    :: Monad m
+    => (c' -> Proxy b' b x' x m c)
+    -- ^
+    -> (b' -> Proxy a' a x' x m b)
+    -- ^
+    -> (c' -> Proxy a' a x' x m c)
+    -- ^
+p1 /</ p2 = p2 \>\ p1
+{-# INLINABLE (/</) #-}
+
+-- | Equivalent to ('>~>') with the arguments flipped
+(<~<)
+    :: Monad m
+    => (b -> Proxy b' b c' c m r)
+    -- ^
+    -> (a -> Proxy a' a b' b m r)
+    -- ^
+    -> (a -> Proxy a' a c' c m r)
+    -- ^
+p1 <~< p2 = p2 >~> p1
+{-# INLINABLE (<~<) #-}
+
+-- | Equivalent to ('>+>') with the arguments flipped
+(<+<)
+    :: Monad m
+    => (c' -> Proxy b' b c' c m r)
+    -- ^
+    -> (b' -> Proxy a' a b' b m r)
+    -- ^
+    -> (c' -> Proxy a' a c' c m r)
+    -- ^
+p1 <+< p2 = p2 >+> p1
+{-# INLINABLE (<+<) #-}
+
+-- | Equivalent to ('//>') with the arguments flipped
+(<\\)
+    :: Monad m
+    => (b -> Proxy x' x c' c m b')
+    -- ^
+    ->       Proxy x' x b' b m a'
+    -- ^
+    ->       Proxy x' x c' c m a'
+    -- ^
+f <\\ p = p //> f
+{-# INLINABLE (<\\) #-}
+
+-- | Equivalent to ('>\\') with the arguments flipped
+(//<)
+    :: Monad m
+    =>        Proxy b' b y' y m c
+    -- ^
+    -> (b' -> Proxy a' a y' y m b)
+    -- ^
+    ->        Proxy a' a y' y m c
+    -- ^
+p //< f = f >\\ p
+{-# INLINABLE (//<) #-}
+
+-- | Equivalent to ('>>~') with the arguments flipped
+(~<<)
+    :: Monad m
+    => (b  -> Proxy b' b c' c m r)
+    -- ^
+    ->        Proxy a' a b' b m r
+    -- ^
+    ->        Proxy a' a c' c m r
+    -- ^
+k ~<< p = p >>~ k
+{-# INLINABLE (~<<) #-}
+
+-- | Equivalent to ('+>>') with the arguments flipped
+(<<+)
+    :: Monad m
+    =>         Proxy b' b c' c m r
+    -- ^
+    -> (b'  -> Proxy a' a b' b m r)
+    -- ^
+    ->         Proxy a' a c' c m r
+    -- ^
+k <<+ p = p +>> k
+{-# INLINABLE (<<+) #-}
+
+{-# RULES
+    "(p //> f) //> g" forall p f g . (p //> f) //> g = p //> (\x -> f x //> g)
+
+  ; "p //> respond" forall p . p //> respond = p
+
+  ; "respond x //> f" forall x f . respond x //>  f = f x
+
+  ; "f >\\ (g >\\ p)" forall f g p . f >\\ (g >\\ p) = (\x -> f >\\ g x) >\\ p
+
+  ; "request >\\ p" forall p . request >\\ p = p
+
+  ; "f >\\ request x" forall f x . f >\\ request x = f x
+
+  ; "(p >>~ f) >>~ g" forall p f g . (p >>~ f) >>~ g = p >>~ (\x -> f x >>~ g)
+
+  ; "p >>~ push" forall p . p >>~ push = p
+
+  ; "push x >>~ f" forall x f . push x >>~ f = f x
+
+  ; "f +>> (g +>> p)" forall f g p . f +>> (g +>> p) = (\x -> f +>> g x) +>> p
+
+  ; "pull +>> p" forall p . pull +>> p = p
+
+  ; "f +>> pull x" forall f x . f +>> pull x = f x
+
+  #-}
src/Pipes/Internal.hs view
@@ -1,269 +1,269 @@-{-| This is an internal module, meaning that it is unsafe to import unless you-    understand the risks.--    This module provides a fast implementation by weakening the monad-    transformer laws.  These laws do not hold if you can pattern match on the-    constructors, as the following counter-example illustrates:--@-'lift' '.' 'return' = 'M' '.' 'return' '.' 'Pure'--'return' = 'Pure'--'lift' '.' 'return' /= 'return'-@--    You do not need to worry about this if you do not import this module, since-    the other modules in this library do not export the constructors or export-    any functions which can violate the monad transformer laws.--}--{-# LANGUAGE-    FlexibleInstances-  , MultiParamTypeClasses-  , RankNTypes-  , UndecidableInstances-  , Trustworthy-  #-}--module Pipes.Internal (-    -- * Internal-      Proxy(..)-    , unsafeHoist-    , observe-    , X-    , closed-    ) where--import Control.Applicative (-    Applicative(pure, (<*>), (*>)), Alternative(empty, (<|>)) )-import Control.Monad (MonadPlus(..))-import Control.Monad.IO.Class (MonadIO(liftIO))-import Control.Monad.Trans.Class (MonadTrans(lift))-import Control.Monad.Morph (MFunctor(hoist), MMonad(embed))-import Control.Monad.Error (MonadError(..))-import Control.Monad.Reader (MonadReader(..))-import Control.Monad.State (MonadState(..))-import Control.Monad.Writer (MonadWriter(..))-import Data.Monoid (Monoid(mempty,mappend))--{-| A 'Proxy' is a monad transformer that receives and sends information on both-    an upstream and downstream interface.--    The type variables signify:--    * @a'@ and @a@ - The upstream interface, where @(a')@s go out and @(a)@s-      come in--    * @b'@ and @b@ - The downstream interface, where @(b)@s go out and @(b')@s-      come in--    * @m @ - The base monad--    * @r @ - The return value--}-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 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      = 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 = Pure-    (>>=)  = _bind--_bind-    :: Monad m-    => Proxy a' a b' b m r-    -> (r -> Proxy a' a b' b m r')-    -> Proxy a' a b' b m r'-p0 `_bind` 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--{-# RULES-    "_bind (Request a' k) f" forall a' k f .-        _bind (Request a' k) f = Request a' (\a  -> _bind (k a)  f);-    "_bind (Respond b  k) f" forall b  k f .-        _bind (Respond b  k) f = Respond b  (\b' -> _bind (k b') f);-    "_bind (M          m) f" forall m    f .-        _bind (M          m) f = M (m >>= \p -> return (_bind p f));-    "_bind (Pure    r   ) f" forall r    f .-        _bind (Pure    r   ) f = f r;-  #-}--instance (Monad m, Monoid r) => Monoid (Proxy a' a b' b m r) where-    mempty        = Pure mempty-    mappend p1 p2 = go p1 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    r1     -> fmap (mappend r1) p2--instance MonadTrans (Proxy a' a b' b) where-    lift m = M (m >>= \r -> return (Pure r))--{-| 'unsafeHoist' is like 'hoist', but faster.--    This is labeled as unsafe because you will break the monad transformer laws-    if you do not pass a monad morphism as the first argument.  This function is-    safe if you pass a monad morphism as the first argument.--}-unsafeHoist-    :: Monad m-    => (forall x . m x -> n x) -> Proxy a' a b' b m r -> Proxy a' a b' b n r-unsafeHoist nat = go-  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-{-# INLINABLE unsafeHoist #-}--instance MFunctor (Proxy a' a b' b) where-    hoist nat p0 = go (observe 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--instance MMonad (Proxy a' a b' b) where-    embed f = go-      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   -> f m >>= go-            Pure    r      -> Pure r--instance MonadIO m => MonadIO (Proxy a' a b' b m) where-    liftIO m = M (liftIO (m >>= \r -> return (Pure r)))--instance MonadReader r m => MonadReader r (Proxy a' a b' b m) where-    ask = lift ask-    local f = go-        where-          go p = case p of-              Request a' fa  -> Request a' (\a  -> go (fa  a ))-              Respond b  fb' -> Respond b  (\b' -> go (fb' b'))-              Pure    r      -> Pure r-              M       m      -> M (local f m >>= \r -> return (go r))-    reader = lift . reader--instance MonadState s m => MonadState s (Proxy a' a b' b m) where-    get = lift get-    put = lift . put-    state = lift . state--instance MonadWriter w m => MonadWriter w (Proxy a' a b' b m) where-    writer = lift . writer-    tell = lift . tell-    listen p0 = go p0 mempty-      where-        go p w = case p of-            Request a' fa  -> Request a' (\a  -> go (fa  a ) w)-            Respond b  fb' -> Respond b  (\b' -> go (fb' b') w)-            M       m      -> M (do-                (p', w') <- listen m-                return (go p' $! mappend w w') )-            Pure    r      -> Pure (r, w)--    pass p0 = go p0 mempty-      where-        go p w = case p of-            Request a' fa  -> Request a' (\a  -> go (fa  a ) w)-            Respond b  fb' -> Respond b  (\b' -> go (fb' b') w)-            M       m      -> M (do-                (p', w') <- listen m-                return (go p' $! mappend w w') )-            Pure   (r, f)  -> M (pass (return (Pure r, \_ -> f w)))--instance MonadError e m => MonadError e (Proxy a' a b' b m) where-    throwError = lift . throwError-    catchError 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'))-            Pure    r      -> Pure r-            M          m   -> M ((do-                p' <- m-                return (go p') ) `catchError` (\e -> return (f e)) )--instance MonadPlus m => Alternative (Proxy a' a b' b m) where-    empty = mzero-    (<|>) = mplus--instance MonadPlus m => MonadPlus (Proxy a' a b' b m) where-    mzero = lift mzero-    mplus p0 p1 = 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'))-            Pure    r      -> Pure r-            M          m   -> M ((do-                p' <- m-                return (go p') ) `mplus` return p1 )--{-| The monad transformer laws are correct when viewed through the 'observe'-    function:--@-'observe' ('lift' ('return' r)) = 'observe' ('return' r)--'observe' ('lift' (m '>>=' f)) = 'observe' ('lift' m '>>=' 'lift' '.' f)-@--    This correctness comes at a small cost to performance, so use this function-    sparingly.--    This function is a convenience for low-level @pipes@ implementers.  You do-    not need to use 'observe' if you stick to the safe API.--}-observe :: Monad m => Proxy a' a b' b m r -> Proxy a' a b' b m r-observe p0 = M (go p0) where-    go p = case p of-        Request a' fa  -> return (Request a' (\a  -> observe (fa  a )))-        Respond b  fb' -> return (Respond b  (\b' -> observe (fb' b')))-        M          m'  -> m' >>= go-        Pure    r      -> return (Pure r)-{-# INLINABLE observe #-}--{-| The empty type, used to close output ends--    When @Data.Void@ is merged into @base@, this will change to:--> type X = Void--}-newtype X = X X---- | Use 'closed' to \"handle\" impossible outputs-closed :: X -> a-closed (X x) = closed x-{-# INLINABLE closed #-}+{-| This is an internal module, meaning that it is unsafe to import unless you
+    understand the risks.
+
+    This module provides a fast implementation by weakening the monad
+    transformer laws.  These laws do not hold if you can pattern match on the
+    constructors, as the following counter-example illustrates:
+
+@
+'lift' '.' 'return' = 'M' '.' 'return' '.' 'Pure'
+
+'return' = 'Pure'
+
+'lift' '.' 'return' /= 'return'
+@
+
+    You do not need to worry about this if you do not import this module, since
+    the other modules in this library do not export the constructors or export
+    any functions which can violate the monad transformer laws.
+-}
+
+{-# LANGUAGE
+    FlexibleInstances
+  , MultiParamTypeClasses
+  , RankNTypes
+  , UndecidableInstances
+  , Trustworthy
+  #-}
+
+module Pipes.Internal (
+    -- * Internal
+      Proxy(..)
+    , unsafeHoist
+    , observe
+    , X
+    , closed
+    ) where
+
+import Control.Applicative (
+    Applicative(pure, (<*>), (*>)), Alternative(empty, (<|>)) )
+import Control.Monad (MonadPlus(..))
+import Control.Monad.IO.Class (MonadIO(liftIO))
+import Control.Monad.Trans.Class (MonadTrans(lift))
+import Control.Monad.Morph (MFunctor(hoist), MMonad(embed))
+import Control.Monad.Error (MonadError(..))
+import Control.Monad.Reader (MonadReader(..))
+import Control.Monad.State (MonadState(..))
+import Control.Monad.Writer (MonadWriter(..))
+import Data.Monoid (Monoid(mempty,mappend))
+
+{-| A 'Proxy' is a monad transformer that receives and sends information on both
+    an upstream and downstream interface.
+
+    The type variables signify:
+
+    * @a'@ and @a@ - The upstream interface, where @(a')@s go out and @(a)@s
+      come in
+
+    * @b'@ and @b@ - The downstream interface, where @(b)@s go out and @(b')@s
+      come in
+
+    * @m @ - The base monad
+
+    * @r @ - The return value
+-}
+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 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      = 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 = Pure
+    (>>=)  = _bind
+
+_bind
+    :: Monad m
+    => Proxy a' a b' b m r
+    -> (r -> Proxy a' a b' b m r')
+    -> Proxy a' a b' b m r'
+p0 `_bind` 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
+
+{-# RULES
+    "_bind (Request a' k) f" forall a' k f .
+        _bind (Request a' k) f = Request a' (\a  -> _bind (k a)  f);
+    "_bind (Respond b  k) f" forall b  k f .
+        _bind (Respond b  k) f = Respond b  (\b' -> _bind (k b') f);
+    "_bind (M          m) f" forall m    f .
+        _bind (M          m) f = M (m >>= \p -> return (_bind p f));
+    "_bind (Pure    r   ) f" forall r    f .
+        _bind (Pure    r   ) f = f r;
+  #-}
+
+instance (Monad m, Monoid r) => Monoid (Proxy a' a b' b m r) where
+    mempty        = Pure mempty
+    mappend p1 p2 = go p1 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    r1     -> fmap (mappend r1) p2
+
+instance MonadTrans (Proxy a' a b' b) where
+    lift m = M (m >>= \r -> return (Pure r))
+
+{-| 'unsafeHoist' is like 'hoist', but faster.
+
+    This is labeled as unsafe because you will break the monad transformer laws
+    if you do not pass a monad morphism as the first argument.  This function is
+    safe if you pass a monad morphism as the first argument.
+-}
+unsafeHoist
+    :: Monad m
+    => (forall x . m x -> n x) -> Proxy a' a b' b m r -> Proxy a' a b' b n r
+unsafeHoist nat = go
+  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
+{-# INLINABLE unsafeHoist #-}
+
+instance MFunctor (Proxy a' a b' b) where
+    hoist nat p0 = go (observe 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
+
+instance MMonad (Proxy a' a b' b) where
+    embed f = go
+      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   -> f m >>= go
+            Pure    r      -> Pure r
+
+instance MonadIO m => MonadIO (Proxy a' a b' b m) where
+    liftIO m = M (liftIO (m >>= \r -> return (Pure r)))
+
+instance MonadReader r m => MonadReader r (Proxy a' a b' b m) where
+    ask = lift ask
+    local f = go
+        where
+          go p = case p of
+              Request a' fa  -> Request a' (\a  -> go (fa  a ))
+              Respond b  fb' -> Respond b  (\b' -> go (fb' b'))
+              Pure    r      -> Pure r
+              M       m      -> M (local f m >>= \r -> return (go r))
+    reader = lift . reader
+
+instance MonadState s m => MonadState s (Proxy a' a b' b m) where
+    get = lift get
+    put = lift . put
+    state = lift . state
+
+instance MonadWriter w m => MonadWriter w (Proxy a' a b' b m) where
+    writer = lift . writer
+    tell = lift . tell
+    listen p0 = go p0 mempty
+      where
+        go p w = case p of
+            Request a' fa  -> Request a' (\a  -> go (fa  a ) w)
+            Respond b  fb' -> Respond b  (\b' -> go (fb' b') w)
+            M       m      -> M (do
+                (p', w') <- listen m
+                return (go p' $! mappend w w') )
+            Pure    r      -> Pure (r, w)
+
+    pass p0 = go p0 mempty
+      where
+        go p w = case p of
+            Request a' fa  -> Request a' (\a  -> go (fa  a ) w)
+            Respond b  fb' -> Respond b  (\b' -> go (fb' b') w)
+            M       m      -> M (do
+                (p', w') <- listen m
+                return (go p' $! mappend w w') )
+            Pure   (r, f)  -> M (pass (return (Pure r, \_ -> f w)))
+
+instance MonadError e m => MonadError e (Proxy a' a b' b m) where
+    throwError = lift . throwError
+    catchError 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'))
+            Pure    r      -> Pure r
+            M          m   -> M ((do
+                p' <- m
+                return (go p') ) `catchError` (\e -> return (f e)) )
+
+instance MonadPlus m => Alternative (Proxy a' a b' b m) where
+    empty = mzero
+    (<|>) = mplus
+
+instance MonadPlus m => MonadPlus (Proxy a' a b' b m) where
+    mzero = lift mzero
+    mplus p0 p1 = 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'))
+            Pure    r      -> Pure r
+            M          m   -> M ((do
+                p' <- m
+                return (go p') ) `mplus` return p1 )
+
+{-| The monad transformer laws are correct when viewed through the 'observe'
+    function:
+
+@
+'observe' ('lift' ('return' r)) = 'observe' ('return' r)
+
+'observe' ('lift' (m '>>=' f)) = 'observe' ('lift' m '>>=' 'lift' '.' f)
+@
+
+    This correctness comes at a small cost to performance, so use this function
+    sparingly.
+
+    This function is a convenience for low-level @pipes@ implementers.  You do
+    not need to use 'observe' if you stick to the safe API.
+-}
+observe :: Monad m => Proxy a' a b' b m r -> Proxy a' a b' b m r
+observe p0 = M (go p0) where
+    go p = case p of
+        Request a' fa  -> return (Request a' (\a  -> observe (fa  a )))
+        Respond b  fb' -> return (Respond b  (\b' -> observe (fb' b')))
+        M          m'  -> m' >>= go
+        Pure    r      -> return (Pure r)
+{-# INLINABLE observe #-}
+
+{-| The empty type, used to close output ends
+
+    When @Data.Void@ is merged into @base@, this will change to:
+
+> type X = Void
+-}
+newtype X = X X
+
+-- | Use 'closed' to \"handle\" impossible outputs
+closed :: X -> a
+closed (X x) = closed x
+{-# INLINABLE closed #-}
src/Pipes/Lift.hs view
@@ -1,380 +1,380 @@-{-| Many actions in base monad transformers cannot be automatically-    'Control.Monad.Trans.Class.lift'ed.  These functions lift these remaining-    actions so that they work in the 'Proxy' monad transformer.--    See the mini-tutorial at the bottom of this module for example code and-    typical use cases where this module will come in handy.--}--module Pipes.Lift (-    -- * Utilities-      distribute--    -- * ErrorT-    , errorP-    , runErrorP-    , catchError-    , liftCatchError--    -- * MaybeT-    , maybeP-    , runMaybeP--    -- * ReaderT-    , readerP-    , runReaderP--    -- * StateT-    , stateP-    , runStateP-    , evalStateP-    , execStateP--    -- * WriterT-    -- $writert-    , writerP-    , runWriterP-    , execWriterP--    -- * RWST-    , rwsP-    , runRWSP-    , evalRWSP-    , execRWSP--    -- * Tutorial-    -- $tutorial-    ) where--import Control.Monad.Trans.Class (lift, MonadTrans(..))-import qualified Control.Monad.Trans.Error as E-import qualified Control.Monad.Trans.Maybe as M-import qualified Control.Monad.Trans.Reader as R-import qualified Control.Monad.Trans.State.Strict as S-import qualified Control.Monad.Trans.Writer.Strict as W-import qualified Control.Monad.Trans.RWS.Strict as RWS-import Data.Monoid (Monoid)-import Pipes.Internal (Proxy(..), unsafeHoist)-import Control.Monad.Morph (hoist, MFunctor(..))-import Pipes.Core (runEffect, request, respond, (//>), (>\\))---- | Distribute 'Proxy' over a monad transformer-distribute-    ::  ( Monad m-        , MonadTrans t-        , MFunctor t-        , Monad (t m)-        , Monad (t (Proxy a' a b' b m))-        )-    => Proxy a' a b' b (t m) r-    -- ^ -    -> t (Proxy a' a b' b m) r-    -- ^ -distribute p =  runEffect $ request' >\\ unsafeHoist (hoist lift) p //> respond'-  where-    request' = lift . lift . request-    respond' = lift . lift . respond-{-# INLINABLE distribute #-}---- | Wrap the base monad in 'E.ErrorT'-errorP-    :: (Monad m, E.Error e)-    => Proxy a' a b' b m (Either e r)-    -> Proxy a' a b' b (E.ErrorT e m) r-errorP p = do-    x <- unsafeHoist lift p-    lift $ E.ErrorT (return x)-{-# INLINABLE errorP #-}---- | Run 'E.ErrorT' in the base monad-runErrorP-    :: (Monad m, E.Error e)-    => Proxy a' a b' b (E.ErrorT e m) r-    -> Proxy a' a b' b m (Either e r)-runErrorP    = E.runErrorT . distribute -{-# INLINABLE runErrorP #-}---- | Catch an error in the base monad-catchError-    :: (Monad m, E.Error e) -    => Proxy a' a b' b (E.ErrorT e m) r-    -- ^-    -> (e -> Proxy a' a b' b (E.ErrorT e m) r)-    -- ^-    -> Proxy a' a b' b (E.ErrorT e m) r-catchError e h = errorP . E.runErrorT $ -    E.catchError (distribute e) (distribute . h)-{-# INLINABLE catchError #-}---- | Catch an error using a catch function for the base monad-liftCatchError-    :: Monad m-    => (   m (Proxy a' a b' b m r)-        -> (e -> m (Proxy a' a b' b m r))-        -> m (Proxy a' a b' b m r) )-    -- ^-    ->    (Proxy a' a b' b m r-        -> (e -> Proxy a' a b' b m r)-        -> Proxy a' a b' b m r)-    -- ^-liftCatchError c 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'))-        Pure    r      -> Pure r-        M          m   -> M ((do-            p' <- m-            return (go p') ) `c` (\e -> return (f e)) )-{-# INLINABLE liftCatchError #-}---- | Wrap the base monad in 'M.MaybeT'-maybeP-    :: Monad m-    => Proxy a' a b' b m (Maybe r) -> Proxy a' a b' b (M.MaybeT m) r-maybeP p = do-    x <- unsafeHoist lift p-    lift $ M.MaybeT (return x)-{-# INLINABLE maybeP #-}---- | Run 'M.MaybeT' in the base monad-runMaybeP-    :: Monad m-    => Proxy a' a b' b (M.MaybeT m) r-    -> Proxy a' a b' b m (Maybe r)-runMaybeP p = M.runMaybeT $ distribute p-{-# INLINABLE runMaybeP #-}---- | Wrap the base monad in 'R.ReaderT'-readerP-    :: Monad m-    => (i -> Proxy a' a b' b m r) -> Proxy a' a b' b (R.ReaderT i m) r-readerP k = do-    i <- lift R.ask-    unsafeHoist lift (k i)-{-# INLINABLE readerP #-}---- | Run 'R.ReaderT' in the base monad-runReaderP-    :: Monad m-    => i-    -> Proxy a' a b' b (R.ReaderT i m) r-    -> Proxy a' a b' b m r-runReaderP r p = (`R.runReaderT` r) $ distribute p-{-# INLINABLE runReaderP #-}---- | Wrap the base monad in 'S.StateT'-stateP-    :: Monad m-    => (s -> Proxy a' a b' b m (r, s)) -> Proxy a' a b' b (S.StateT s m) r-stateP k = do-    s <- lift S.get-    (r, s') <- unsafeHoist lift (k s)-    lift (S.put s')-    return r-{-# INLINABLE stateP #-}---- | Run 'S.StateT' in the base monad-runStateP-    :: Monad m-    => s-    -> Proxy a' a b' b (S.StateT s m) r-    -> Proxy a' a b' b m (r, s)-runStateP s p = (`S.runStateT` s) $ distribute p-{-# INLINABLE runStateP #-}---- | Evaluate 'S.StateT' in the base monad-evalStateP-    :: Monad m-    => s-    -> Proxy a' a b' b (S.StateT s m) r-    -> Proxy a' a b' b m r-evalStateP s p = fmap fst $ runStateP s p-{-# INLINABLE evalStateP #-}---- | Execute 'S.StateT' in the base monad-execStateP-    :: Monad m-    => s-    -> Proxy a' a b' b (S.StateT s m) r-    -> Proxy a' a b' b m s-execStateP s p = fmap snd $ runStateP s p-{-# INLINABLE execStateP #-}--{- $writert-    Note that 'runWriterP' and 'execWriterP' will keep the accumulator in-    weak-head-normal form so that folds run in constant space when possible.--    This means that until @transformers@ adds a truly strict 'W.WriterT', you-    should consider unwrapping 'W.WriterT' first using 'runWriterP' or-    'execWriterP' before running your 'Proxy'.  You will get better performance-    this way and eliminate space leaks if your accumulator doesn't have any lazy-    fields.--}---- | Wrap the base monad in 'W.WriterT'-writerP-    :: (Monad m, Monoid w)-    => Proxy a' a b' b m (r, w) -> Proxy a' a b' b (W.WriterT w m) r-writerP p = do-    (r, w) <- unsafeHoist lift p-    lift $ W.tell w-    return r-{-# INLINABLE writerP #-}---- | Run 'W.WriterT' in the base monad-runWriterP-    :: (Monad m, Monoid w)-    => Proxy a' a b' b (W.WriterT w m) r-    -> Proxy a' a b' b m (r, w)-runWriterP p = W.runWriterT $ distribute p-{-# INLINABLE runWriterP #-}---- | Execute 'W.WriterT' in the base monad-execWriterP-    :: (Monad m, Monoid w)-    => Proxy a' a b' b (W.WriterT w m) r-    -> Proxy a' a b' b m w-execWriterP p = fmap snd $ runWriterP p-{-# INLINABLE execWriterP #-}---- | Wrap the base monad in 'RWS.RWST'-rwsP-    :: (Monad m, Monoid w)-    => (i -> s -> Proxy a' a b' b m (r, s, w))-    -> Proxy a' a b' b (RWS.RWST i w s m) r-rwsP k = do-    i <- lift RWS.ask-    s <- lift RWS.get-    (r, s', w) <- unsafeHoist lift (k i s)-    lift $ do-        RWS.put s'-        RWS.tell w-    return r-{-# INLINABLE rwsP #-}---- | Run 'RWS.RWST' in the base monad-runRWSP-    :: (Monad m, Monoid w)-    => r-    -> s-    -> Proxy a' a b' b (RWS.RWST r w s m) d-    -> Proxy a' a b' b m (d, s, w)-runRWSP  i s p = (\b -> RWS.runRWST b i s) $ distribute p-{-# INLINABLE runRWSP #-}---- | Evaluate 'RWS.RWST' in the base monad-evalRWSP-    :: (Monad m, Monoid w)-    => r-    -> s-    -> Proxy a' a b' b (RWS.RWST r w s m) d-    -> Proxy a' a b' b m (d, w)-evalRWSP i s p = fmap f $ runRWSP i s p-  where-    f x = let (r, _, w) = x in (r, w)-{-# INLINABLE evalRWSP #-}---- | Execute 'RWS.RWST' in the base monad-execRWSP-    :: (Monad m, Monoid w)-    => r-    -> s-    -> Proxy a' a b' b (RWS.RWST r w s m) d-    -> Proxy a' a b' b m (s, w)-execRWSP i s p = fmap f $ runRWSP i s p-  where-    f x = let (_, s', w) = x in (s', w)-{-# INLINABLE execRWSP #-}--{- $tutorial-    Probably the most useful functionality in this module is lifted error-    handling.  Suppose that you have a 'Pipes.Pipe' whose base monad can fail-    using 'E.ErrorT':--> import Control.Monad.Trans.Error-> import Pipes->-> example :: Monad m => Pipe Int Int (ErrorT String m) r-> example = for cat $ \n ->->     if n == 0->     then lift $ throwError "Zero is forbidden"->     else yield n--    Without the tools in this module you cannot recover from any potential error-    until after you compose and run the pipeline:-->>> import qualified Pipes.Prelude as P->>> runErrorT $ runEffect $ P.readLn >-> example >-> P.print-42<Enter>-42-1<Enter>-1-0<Enter>-Zero is forbidden->>>--    This module provides `catchError`, which lets you catch and recover from-    errors inside the 'Pipe':-->  import qualified Pipes.Lift as Lift-> ->  caught :: Pipe Int Int (ErrorT String IO) r->  caught = example `Lift.catchError` \str -> do->      liftIO (putStrLn str)->      caught--    This lets you resume streaming in the face of errors raised within the base-    monad:-->>> runErrorT $ runEffect $ P.readLn >-> caught >-> P.print-0<Enter>-Zero is forbidden-42<Enter>-42-0<Enter>-Zero is forbidden-1<Enter>-1-...--    Another common use case is running a base monad before running the pipeline.-    For example, the following contrived 'Producer' uses 'S.StateT' gratuitously-    to increment numbers:--> import Control.Monad (forever)-> import Control.Monad.Trans.State.Strict-> import Pipes-> -> numbers :: Monad m => Producer Int (StateT Int m) r-> numbers = forever $ do->     n <- lift get->     yield n->     lift $ put $! n + 1--    You can run the 'StateT' monad by supplying an initial state, before you-    ever compose the 'Producer':--> import Pipes.Lift->-> naturals :: Monad m => Producer Int m r-> naturals = evalStateP 0 numbers--    This deletes 'StateT' from the base monad entirely, give you a completely-    pure 'Pipes.Producer':-->>> Pipes.Prelude.toList naturals-[0,1,2,3,4,5,6...]--    Note that the convention for the 'S.StateT' run functions is backwards from-    @transformers@ for convenience: the initial state is the first argument.--    All of these functions internally use 'distribute', which can pull out most-    monad transformers from the base monad.  For example, 'evalStateP' is-    defined in terms of 'distribute':--> evalStateP s p = evalStateT (distribute p) s--    Therefore you can use 'distribute' to run other monad transformers, too, as-    long as they implement the 'MFunctor' type class from the @mmorph@ library.--}+{-| Many actions in base monad transformers cannot be automatically
+    'Control.Monad.Trans.Class.lift'ed.  These functions lift these remaining
+    actions so that they work in the 'Proxy' monad transformer.
+
+    See the mini-tutorial at the bottom of this module for example code and
+    typical use cases where this module will come in handy.
+-}
+
+module Pipes.Lift (
+    -- * Utilities
+      distribute
+
+    -- * ErrorT
+    , errorP
+    , runErrorP
+    , catchError
+    , liftCatchError
+
+    -- * MaybeT
+    , maybeP
+    , runMaybeP
+
+    -- * ReaderT
+    , readerP
+    , runReaderP
+
+    -- * StateT
+    , stateP
+    , runStateP
+    , evalStateP
+    , execStateP
+
+    -- * WriterT
+    -- $writert
+    , writerP
+    , runWriterP
+    , execWriterP
+
+    -- * RWST
+    , rwsP
+    , runRWSP
+    , evalRWSP
+    , execRWSP
+
+    -- * Tutorial
+    -- $tutorial
+    ) where
+
+import Control.Monad.Trans.Class (lift, MonadTrans(..))
+import qualified Control.Monad.Trans.Error as E
+import qualified Control.Monad.Trans.Maybe as M
+import qualified Control.Monad.Trans.Reader as R
+import qualified Control.Monad.Trans.State.Strict as S
+import qualified Control.Monad.Trans.Writer.Strict as W
+import qualified Control.Monad.Trans.RWS.Strict as RWS
+import Data.Monoid (Monoid)
+import Pipes.Internal (Proxy(..), unsafeHoist)
+import Control.Monad.Morph (hoist, MFunctor(..))
+import Pipes.Core (runEffect, request, respond, (//>), (>\\))
+
+-- | Distribute 'Proxy' over a monad transformer
+distribute
+    ::  ( Monad m
+        , MonadTrans t
+        , MFunctor t
+        , Monad (t m)
+        , Monad (t (Proxy a' a b' b m))
+        )
+    => Proxy a' a b' b (t m) r
+    -- ^ 
+    -> t (Proxy a' a b' b m) r
+    -- ^ 
+distribute p =  runEffect $ request' >\\ unsafeHoist (hoist lift) p //> respond'
+  where
+    request' = lift . lift . request
+    respond' = lift . lift . respond
+{-# INLINABLE distribute #-}
+
+-- | Wrap the base monad in 'E.ErrorT'
+errorP
+    :: (Monad m, E.Error e)
+    => Proxy a' a b' b m (Either e r)
+    -> Proxy a' a b' b (E.ErrorT e m) r
+errorP p = do
+    x <- unsafeHoist lift p
+    lift $ E.ErrorT (return x)
+{-# INLINABLE errorP #-}
+
+-- | Run 'E.ErrorT' in the base monad
+runErrorP
+    :: (Monad m, E.Error e)
+    => Proxy a' a b' b (E.ErrorT e m) r
+    -> Proxy a' a b' b m (Either e r)
+runErrorP    = E.runErrorT . distribute 
+{-# INLINABLE runErrorP #-}
+
+-- | Catch an error in the base monad
+catchError
+    :: (Monad m, E.Error e) 
+    => Proxy a' a b' b (E.ErrorT e m) r
+    -- ^
+    -> (e -> Proxy a' a b' b (E.ErrorT e m) r)
+    -- ^
+    -> Proxy a' a b' b (E.ErrorT e m) r
+catchError e h = errorP . E.runErrorT $ 
+    E.catchError (distribute e) (distribute . h)
+{-# INLINABLE catchError #-}
+
+-- | Catch an error using a catch function for the base monad
+liftCatchError
+    :: Monad m
+    => (   m (Proxy a' a b' b m r)
+        -> (e -> m (Proxy a' a b' b m r))
+        -> m (Proxy a' a b' b m r) )
+    -- ^
+    ->    (Proxy a' a b' b m r
+        -> (e -> Proxy a' a b' b m r)
+        -> Proxy a' a b' b m r)
+    -- ^
+liftCatchError c 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'))
+        Pure    r      -> Pure r
+        M          m   -> M ((do
+            p' <- m
+            return (go p') ) `c` (\e -> return (f e)) )
+{-# INLINABLE liftCatchError #-}
+
+-- | Wrap the base monad in 'M.MaybeT'
+maybeP
+    :: Monad m
+    => Proxy a' a b' b m (Maybe r) -> Proxy a' a b' b (M.MaybeT m) r
+maybeP p = do
+    x <- unsafeHoist lift p
+    lift $ M.MaybeT (return x)
+{-# INLINABLE maybeP #-}
+
+-- | Run 'M.MaybeT' in the base monad
+runMaybeP
+    :: Monad m
+    => Proxy a' a b' b (M.MaybeT m) r
+    -> Proxy a' a b' b m (Maybe r)
+runMaybeP p = M.runMaybeT $ distribute p
+{-# INLINABLE runMaybeP #-}
+
+-- | Wrap the base monad in 'R.ReaderT'
+readerP
+    :: Monad m
+    => (i -> Proxy a' a b' b m r) -> Proxy a' a b' b (R.ReaderT i m) r
+readerP k = do
+    i <- lift R.ask
+    unsafeHoist lift (k i)
+{-# INLINABLE readerP #-}
+
+-- | Run 'R.ReaderT' in the base monad
+runReaderP
+    :: Monad m
+    => i
+    -> Proxy a' a b' b (R.ReaderT i m) r
+    -> Proxy a' a b' b m r
+runReaderP r p = (`R.runReaderT` r) $ distribute p
+{-# INLINABLE runReaderP #-}
+
+-- | Wrap the base monad in 'S.StateT'
+stateP
+    :: Monad m
+    => (s -> Proxy a' a b' b m (r, s)) -> Proxy a' a b' b (S.StateT s m) r
+stateP k = do
+    s <- lift S.get
+    (r, s') <- unsafeHoist lift (k s)
+    lift (S.put s')
+    return r
+{-# INLINABLE stateP #-}
+
+-- | Run 'S.StateT' in the base monad
+runStateP
+    :: Monad m
+    => s
+    -> Proxy a' a b' b (S.StateT s m) r
+    -> Proxy a' a b' b m (r, s)
+runStateP s p = (`S.runStateT` s) $ distribute p
+{-# INLINABLE runStateP #-}
+
+-- | Evaluate 'S.StateT' in the base monad
+evalStateP
+    :: Monad m
+    => s
+    -> Proxy a' a b' b (S.StateT s m) r
+    -> Proxy a' a b' b m r
+evalStateP s p = fmap fst $ runStateP s p
+{-# INLINABLE evalStateP #-}
+
+-- | Execute 'S.StateT' in the base monad
+execStateP
+    :: Monad m
+    => s
+    -> Proxy a' a b' b (S.StateT s m) r
+    -> Proxy a' a b' b m s
+execStateP s p = fmap snd $ runStateP s p
+{-# INLINABLE execStateP #-}
+
+{- $writert
+    Note that 'runWriterP' and 'execWriterP' will keep the accumulator in
+    weak-head-normal form so that folds run in constant space when possible.
+
+    This means that until @transformers@ adds a truly strict 'W.WriterT', you
+    should consider unwrapping 'W.WriterT' first using 'runWriterP' or
+    'execWriterP' before running your 'Proxy'.  You will get better performance
+    this way and eliminate space leaks if your accumulator doesn't have any lazy
+    fields.
+-}
+
+-- | Wrap the base monad in 'W.WriterT'
+writerP
+    :: (Monad m, Monoid w)
+    => Proxy a' a b' b m (r, w) -> Proxy a' a b' b (W.WriterT w m) r
+writerP p = do
+    (r, w) <- unsafeHoist lift p
+    lift $ W.tell w
+    return r
+{-# INLINABLE writerP #-}
+
+-- | Run 'W.WriterT' in the base monad
+runWriterP
+    :: (Monad m, Monoid w)
+    => Proxy a' a b' b (W.WriterT w m) r
+    -> Proxy a' a b' b m (r, w)
+runWriterP p = W.runWriterT $ distribute p
+{-# INLINABLE runWriterP #-}
+
+-- | Execute 'W.WriterT' in the base monad
+execWriterP
+    :: (Monad m, Monoid w)
+    => Proxy a' a b' b (W.WriterT w m) r
+    -> Proxy a' a b' b m w
+execWriterP p = fmap snd $ runWriterP p
+{-# INLINABLE execWriterP #-}
+
+-- | Wrap the base monad in 'RWS.RWST'
+rwsP
+    :: (Monad m, Monoid w)
+    => (i -> s -> Proxy a' a b' b m (r, s, w))
+    -> Proxy a' a b' b (RWS.RWST i w s m) r
+rwsP k = do
+    i <- lift RWS.ask
+    s <- lift RWS.get
+    (r, s', w) <- unsafeHoist lift (k i s)
+    lift $ do
+        RWS.put s'
+        RWS.tell w
+    return r
+{-# INLINABLE rwsP #-}
+
+-- | Run 'RWS.RWST' in the base monad
+runRWSP
+    :: (Monad m, Monoid w)
+    => r
+    -> s
+    -> Proxy a' a b' b (RWS.RWST r w s m) d
+    -> Proxy a' a b' b m (d, s, w)
+runRWSP  i s p = (\b -> RWS.runRWST b i s) $ distribute p
+{-# INLINABLE runRWSP #-}
+
+-- | Evaluate 'RWS.RWST' in the base monad
+evalRWSP
+    :: (Monad m, Monoid w)
+    => r
+    -> s
+    -> Proxy a' a b' b (RWS.RWST r w s m) d
+    -> Proxy a' a b' b m (d, w)
+evalRWSP i s p = fmap f $ runRWSP i s p
+  where
+    f x = let (r, _, w) = x in (r, w)
+{-# INLINABLE evalRWSP #-}
+
+-- | Execute 'RWS.RWST' in the base monad
+execRWSP
+    :: (Monad m, Monoid w)
+    => r
+    -> s
+    -> Proxy a' a b' b (RWS.RWST r w s m) d
+    -> Proxy a' a b' b m (s, w)
+execRWSP i s p = fmap f $ runRWSP i s p
+  where
+    f x = let (_, s', w) = x in (s', w)
+{-# INLINABLE execRWSP #-}
+
+{- $tutorial
+    Probably the most useful functionality in this module is lifted error
+    handling.  Suppose that you have a 'Pipes.Pipe' whose base monad can fail
+    using 'E.ErrorT':
+
+> import Control.Monad.Trans.Error
+> import Pipes
+>
+> example :: Monad m => Pipe Int Int (ErrorT String m) r
+> example = for cat $ \n ->
+>     if n == 0
+>     then lift $ throwError "Zero is forbidden"
+>     else yield n
+
+    Without the tools in this module you cannot recover from any potential error
+    until after you compose and run the pipeline:
+
+>>> import qualified Pipes.Prelude as P
+>>> runErrorT $ runEffect $ P.readLn >-> example >-> P.print
+42<Enter>
+42
+1<Enter>
+1
+0<Enter>
+Zero is forbidden
+>>>
+
+    This module provides `catchError`, which lets you catch and recover from
+    errors inside the 'Pipe':
+
+>  import qualified Pipes.Lift as Lift
+> 
+>  caught :: Pipe Int Int (ErrorT String IO) r
+>  caught = example `Lift.catchError` \str -> do
+>      liftIO (putStrLn str)
+>      caught
+
+    This lets you resume streaming in the face of errors raised within the base
+    monad:
+
+>>> runErrorT $ runEffect $ P.readLn >-> caught >-> P.print
+0<Enter>
+Zero is forbidden
+42<Enter>
+42
+0<Enter>
+Zero is forbidden
+1<Enter>
+1
+...
+
+    Another common use case is running a base monad before running the pipeline.
+    For example, the following contrived 'Producer' uses 'S.StateT' gratuitously
+    to increment numbers:
+
+> import Control.Monad (forever)
+> import Control.Monad.Trans.State.Strict
+> import Pipes
+> 
+> numbers :: Monad m => Producer Int (StateT Int m) r
+> numbers = forever $ do
+>     n <- lift get
+>     yield n
+>     lift $ put $! n + 1
+
+    You can run the 'StateT' monad by supplying an initial state, before you
+    ever compose the 'Producer':
+
+> import Pipes.Lift
+>
+> naturals :: Monad m => Producer Int m r
+> naturals = evalStateP 0 numbers
+
+    This deletes 'StateT' from the base monad entirely, give you a completely
+    pure 'Pipes.Producer':
+
+>>> Pipes.Prelude.toList naturals
+[0,1,2,3,4,5,6...]
+
+    Note that the convention for the 'S.StateT' run functions is backwards from
+    @transformers@ for convenience: the initial state is the first argument.
+
+    All of these functions internally use 'distribute', which can pull out most
+    monad transformers from the base monad.  For example, 'evalStateP' is
+    defined in terms of 'distribute':
+
+> evalStateP s p = evalStateT (distribute p) s
+
+    Therefore you can use 'distribute' to run other monad transformers, too, as
+    long as they implement the 'MFunctor' type class from the @mmorph@ library.
+-}
src/Pipes/Prelude.hs view
@@ -1,871 +1,938 @@-{-| General purpose utilities--    The names in this module clash heavily with the Haskell Prelude, so I-    recommend the following import scheme:--> import Pipes-> import qualified Pipes.Prelude as P  -- or use any other qualifier you prefer--    Note that 'String'-based 'IO' is inefficient.  The 'String'-based utilities-    in this module exist only for simple demonstrations without incurring a-    dependency on the @text@ package.--    Also, 'stdinLn' and 'stdoutLn' remove and add newlines, respectively.  This-    behavior is intended to simplify examples.  The corresponding @stdin@ and-    @stdout@ utilities from @pipes-bytestring@ and @pipes-text@ preserve-    newlines.--}--{-# LANGUAGE RankNTypes, Trustworthy #-}-{-# OPTIONS_GHC -fno-warn-unused-do-bind #-}--module Pipes.Prelude (-    -- * Producers-    -- $producers-      stdinLn-    , readLn-    , fromHandle-    , repeatM-    , replicateM--    -- * Consumers-    -- $consumers-    , stdoutLn-    , mapM_-    , print-    , toHandle-    , drain--    -- * Pipes-    -- $pipes-    , map-    , mapM-    , sequence-    , mapFoldable-    , filter-    , filterM-    , take-    , takeWhile-    , takeWhile'-    , drop-    , dropWhile-    , concat-    , elemIndices-    , findIndices-    , scan-    , scanM-    , chain-    , read-    , show-    , seq--    -- * Folds-    -- $folds-    , fold-    , fold'-    , foldM-    , foldM'-    , all-    , any-    , and-    , or-    , elem-    , notElem-    , find-    , findIndex-    , head-    , index-    , last-    , length-    , maximum-    , minimum-    , null-    , sum-    , product-    , toList-    , toListM--    -- * Zips-    , zip-    , zipWith--    -- * Utilities-    , tee-    , generalize-    ) where--import Control.Exception (throwIO, try)-import Control.Monad (liftM, replicateM_, when, unless)-import Control.Monad.Trans.State.Strict (get, put)-import Data.Functor.Identity (Identity, runIdentity)-import Foreign.C.Error (Errno(Errno), ePIPE)-import Pipes-import Pipes.Core-import Pipes.Internal-import Pipes.Lift (evalStateP)-import qualified GHC.IO.Exception as G-import qualified System.IO as IO-import qualified Prelude-import Prelude hiding (-      all-    , and-    , any-    , concat-    , drop-    , dropWhile-    , elem-    , filter-    , head-    , last-    , length-    , map-    , mapM-    , mapM_-    , maximum-    , minimum-    , notElem-    , null-    , or-    , print-    , product-    , read-    , readLn-    , sequence-    , show-    , seq-    , sum-    , take-    , takeWhile-    , zip-    , zipWith-    )--{- $producers-    Use 'for' loops to iterate over 'Producer's whenever you want to perform the-    same action for every element:--> -- Echo all lines from standard input to standard output-> runEffect $ for P.stdinLn $ \str -> do->     lift $ putStrLn str--    ... or more concisely:-->>> runEffect $ for P.stdinLn (lift . putStrLn)-Test<Enter>-Test-ABC<Enter>-ABC-...---}--{-| Read 'String's from 'IO.stdin' using 'getLine'--    Terminates on end of input--}-stdinLn :: MonadIO m => Producer' String m ()-stdinLn = fromHandle IO.stdin-{-# INLINABLE stdinLn #-}---- | 'read' values from 'IO.stdin', ignoring failed parses-readLn :: (MonadIO m, Read a) => Producer' a m ()-readLn = stdinLn >-> read-{-# INLINABLE readLn #-}--{-| Read 'String's from a 'IO.Handle' using 'IO.hGetLine'--    Terminates on end of input--}-fromHandle :: MonadIO m => IO.Handle -> Producer' String m ()-fromHandle h = go-  where-    go = do-        eof <- liftIO $ IO.hIsEOF h-        unless eof $ do-            str <- liftIO $ IO.hGetLine h-            yield str-            go-{-# INLINABLE fromHandle #-}---- | Repeat a monadic action indefinitely, 'yield'ing each result-repeatM :: Monad m => m a -> Producer' a m r-repeatM m = lift m >~ cat-{-# INLINABLE repeatM #-}--{-# RULES-  "repeatM m >-> p" forall m p . repeatM m >-> p = lift m >~ p-  #-}--{-| Repeat a monadic action a fixed number of times, 'yield'ing each result--> replicateM  0      x = return ()->-> replicateM (m + n) x = replicateM m x >> replicateM n x  -- 0 <= {m,n}--}-replicateM :: Monad m => Int -> m a -> Producer' a m ()-replicateM n m = lift m >~ take n-{-# INLINABLE replicateM #-}--{- $consumers-    Feed a 'Consumer' the same value repeatedly using ('>~'):-->>> runEffect $ lift getLine >~ P.stdoutLn-Test<Enter>-Test-ABC<Enter>-ABC-...---}--{-| Write 'String's to 'IO.stdout' using 'putStrLn'--    Unlike 'toHandle', 'stdoutLn' gracefully terminates on a broken output pipe--}-stdoutLn :: MonadIO m => Consumer' String m ()-stdoutLn = go-  where-    go = do-        str <- await-        x   <- liftIO $ try (putStrLn str)-        case x of-           Left (G.IOError { G.ioe_type  = G.ResourceVanished-                           , G.ioe_errno = Just ioe })-                | Errno ioe == ePIPE-                    -> return ()-           Left  e  -> liftIO (throwIO e)-           Right () -> go-{-# INLINABLE stdoutLn #-}---- | Consume all values using a monadic function-mapM_ :: Monad m => (a -> m ()) -> Consumer' a m r-mapM_ f = for cat (\a -> lift (f a))-{-# INLINABLE mapM_ #-}--{-# RULES-    "p >-> mapM_ f" forall p f .-        p >-> mapM_ f = for p (\a -> lift (f a))-  #-}---- | 'print' values to 'IO.stdout'-print :: (MonadIO m, Show a) => Consumer' a m r-print = for cat (\a -> liftIO (Prelude.print a))-{-# INLINABLE print #-}--{-# RULES-    "p >-> print" forall p .-        p >-> print = for p (\a -> liftIO (Prelude.print a))-  #-}---- | Write 'String's to a 'IO.Handle' using 'IO.hPutStrLn'-toHandle :: MonadIO m => IO.Handle -> Consumer' String m r-toHandle handle = for cat (\str -> liftIO (IO.hPutStrLn handle str))-{-# INLINABLE toHandle #-}--{-# RULES-    "p >-> toHandle handle" forall p handle .-        p >-> toHandle handle = for p (\str -> liftIO (IO.hPutStrLn handle str))-  #-}---- | 'discard' all incoming values-drain :: Monad m => Consumer' a m r-drain = for cat discard-{-# INLINABLE drain #-}--{-# RULES-    "p >-> drain" forall p .-        p >-> drain = for p discard-  #-}--{- $pipes-    Use ('>->') to connect 'Producer's, 'Pipe's, and 'Consumer's:-->>> runEffect $ P.stdinLn >-> P.takeWhile (/= "quit") >-> P.stdoutLn-Test<Enter>-Test-ABC<Enter>-ABC-quit<Enter>->>>---}--{-| Apply a function to all values flowing downstream--> map id = cat->-> map (g . f) = map f >-> map g--}-map :: Monad m => (a -> b) -> Pipe a b m r-map f = for cat (\a -> yield (f a))-{-# INLINABLE map #-}--{-# RULES-    "p >-> map f" forall p f . p >-> map f = for p (\a -> yield (f a))--  ; "map f >-> p" forall p f . map f >-> p = (do-        a <- await-        return (f a) ) >~ p-  #-}--{-| Apply a monadic function to all values flowing downstream--> mapM return = cat->-> mapM (f >=> g) = mapM f >-> mapM g--}-mapM :: Monad m => (a -> m b) -> Pipe a b m r-mapM f = for cat $ \a -> do-    b <- lift (f a)-    yield b-{-# INLINABLE mapM #-}--{-# RULES-    "p >-> mapM f" forall p f . p >-> mapM f = for p (\a -> do-        b <- lift (f a)-        yield b )--  ; "mapM f >-> p" forall p f . mapM f >-> p = (do-        a <- await-        b <- lift (f a)-        return b ) >~ p-  #-}---- | Convert a stream of actions to a stream of values-sequence :: Monad m => Pipe (m a) a m r-sequence = mapM id-{-# INLINABLE sequence #-}--{- | Apply a function to all values flowing downstream, and-     forward each element of the result.--}-mapFoldable :: (Monad m, Foldable t) => (a -> t b) -> Pipe a b m r-mapFoldable f = for cat (\a -> each (f a))-{-# INLINABLE mapFoldable #-}--{-# RULES-    "p >-> mapFoldable f" forall p f .-        p >-> mapFoldable f = for p (\a -> each (f a))-  #-}--{-| @(filter predicate)@ only forwards values that satisfy the predicate.--> filter (pure True) = cat->-> filter (liftA2 (&&) p1 p2) = filter p1 >-> filter p2--}-filter :: Monad m => (a -> Bool) -> Pipe a a m r-filter predicate = for cat $ \a -> when (predicate a) (yield a)-{-# INLINABLE filter #-}--{-# RULES-    "p >-> filter predicate" forall p predicate.-        p >-> filter predicate = for p (\a -> when (predicate a) (yield a))-  #-}--{-| @(filterM predicate)@ only forwards values that satisfy the monadic-    predicate--> filterM (pure (pure True)) = cat->-> filterM (liftA2 (liftA2 (&&)) p1 p2) = filterM p1 >-> filterM p2--}-filterM :: Monad m => (a -> m Bool) -> Pipe a a m r-filterM predicate = for cat $ \a -> do-    b <- lift (predicate a)-    when b (yield a)-{-# INLINABLE filterM #-}--{-# RULES-    "p >-> filterM predicate" forall p predicate .-        p >-> filterM predicate = for p (\a -> do-            b <- lift (predicate a)-            when b (yield a) )-  #-}--{-| @(take n)@ only allows @n@ values to pass through--> take 0 = return ()->-> take (m + n) = take m >> take n--> take <infinity> = cat->-> take (min m n) = take m >-> take n--}-take :: Monad m => Int -> Pipe a a m ()-take n = replicateM_ n $ do-    a <- await-    yield a-{-# INLINABLE take #-}--{-| @(takeWhile p)@ allows values to pass downstream so long as they satisfy-    the predicate @p@.--> takeWhile (pure True) = cat->-> takeWhile (liftA2 (&&) p1 p2) = takeWhile p1 >-> takeWhile p2--}-takeWhile :: Monad m => (a -> Bool) -> Pipe a a m ()-takeWhile predicate = go-  where-    go = do-        a <- await-        if (predicate a)-            then do-                yield a-                go-            else return ()-{-# INLINABLE takeWhile #-}--{-| @(takeWhile' p)@ is a version of takeWhile that returns the value failing-    the predicate.--> takeWhile' (pure True) = cat->-> takeWhile' (liftA2 (&&) p1 p2) = takeWhile' p1 >-> takeWhile' p2--}-takeWhile' :: Monad m => (a -> Bool) -> Pipe a a m a-takeWhile' predicate = go-  where-    go = do-        a <- await-        if (predicate a)-            then do-                yield a-                go-            else return a-{-# INLINABLE takeWhile' #-}--{-| @(drop n)@ discards @n@ values going downstream--> drop 0 = cat->-> drop (m + n) = drop m >-> drop n--}-drop :: Monad m => Int -> Pipe a a m r-drop n = do-    replicateM_ n await-    cat-{-# INLINABLE drop #-}--{-| @(dropWhile p)@ discards values going downstream until one violates the-    predicate @p@.--> dropWhile (pure False) = cat->-> dropWhile (liftA2 (||) p1 p2) = dropWhile p1 >-> dropWhile p2--}-dropWhile :: Monad m => (a -> Bool) -> Pipe a a m r-dropWhile predicate = go-  where-    go = do-        a <- await-        if (predicate a)-            then go-            else do-                yield a-                cat-{-# INLINABLE dropWhile #-}---- | Flatten all 'Foldable' elements flowing downstream-concat :: (Monad m, Foldable f) => Pipe (f a) a m r-concat = for cat each-{-# INLINABLE concat #-}--{-# RULES-    "p >-> concat" forall p . p >-> concat = for p each-  #-}---- | Outputs the indices of all elements that match the given element-elemIndices :: (Monad m, Eq a) => a -> Pipe a Int m r-elemIndices a = findIndices (a ==)-{-# INLINABLE elemIndices #-}---- | Outputs the indices of all elements that satisfied the predicate-findIndices :: Monad m => (a -> Bool) -> Pipe a Int m r-findIndices predicate = loop 0-  where-    loop n = do-        a <- await-        when (predicate a) (yield n)-        loop $! n + 1-{-# INLINABLE findIndices #-}--{-| Strict left scan--> Control.Foldl.purely scan :: Monad m => Fold a b -> Pipe a b m r--}-scan :: Monad m => (x -> a -> x) -> x -> (x -> b) -> Pipe a b m r-scan step begin done = loop begin-  where-    loop x = do-        yield (done x)-        a <- await-        let x' = step x a-        loop $! x'-{-# INLINABLE scan #-}--{-| Strict, monadic left scan--> Control.Foldl.impurely scan :: Monad m => FoldM a m b -> Pipe a b m r--}-scanM :: Monad m => (x -> a -> m x) -> m x -> (x -> m b) -> Pipe a b m r-scanM step begin done = do-    x <- lift begin-    loop x-  where-    loop x = do-        b <- lift (done x)-        yield b-        a  <- await-        x' <- lift (step x a)-        loop $! x'-{-# INLINABLE scanM #-}--{-| Apply an action to all values flowing downstream--> chain (pure (return ())) = cat->-> chain (liftA2 (>>) m1 m2) = chain m1 >-> chain m2--}-chain :: Monad m => (a -> m ()) -> Pipe a a m r-chain f = for cat $ \a -> do-    lift (f a)-    yield a-{-# INLINABLE chain #-}--{-# RULES-    "p >-> chain f" forall p f .-        p >-> chain f = for p (\a -> do-            lift (f a)-            yield a )-  ; "chain f >-> p" forall p f .-        chain f >-> p = (do-            a <- await-            lift (f a)-            return a ) >~ p-  #-}---- | Parse 'Read'able values, only forwarding the value if the parse succeeds-read :: (Monad m, Read a) => Pipe String a m r-read = for cat $ \str -> case (reads str) of-    [(a, "")] -> yield a-    _         -> return ()-{-# INLINABLE read #-}--{-# RULES-    "p >-> read" forall p .-        p >-> read = for p (\str -> case (reads str) of-            [(a, "")] -> yield a-            _         -> return () )-  #-}---- | Convert 'Show'able values to 'String's-show :: (Monad m, Show a) => Pipe a String m r-show = map Prelude.show-{-# INLINABLE show #-}---- | Evaluate all values flowing downstream to WHNF-seq :: Monad m => Pipe a a m r-seq = for cat $ \a -> yield $! a-{-# INLINABLE seq #-}--{- $folds-    Use these to fold the output of a 'Producer'.  Many of these folds will stop-    drawing elements if they can compute their result early, like 'any':-->>> P.any null P.stdinLn-Test<Enter>-ABC<Enter>-<Enter>-True->>>---}--{-| Strict fold of the elements of a 'Producer'--> Control.Foldl.purely fold :: Monad m => Fold a b -> Producer a m () -> m b--}-fold :: Monad m => (x -> a -> x) -> x -> (x -> b) -> Producer a m () -> m b-fold step begin done p0 = loop p0 begin-  where-    loop p x = case p of-        Request v  _  -> closed v-        Respond a  fu -> loop (fu ()) $! step x a-        M          m  -> m >>= \p' -> loop p' x-        Pure    _     -> return (done x)-{-# INLINABLE fold #-}--{-| Strict fold of the elements of a 'Producer' that preserves the return value--> Control.Foldl.purely fold' :: Monad m => Fold a b -> Producer a m r -> m (b, r)--}-fold' :: Monad m => (x -> a -> x) -> x -> (x -> b) -> Producer a m r -> m (b, r)-fold' step begin done p0 = loop p0 begin-  where-    loop p x = case p of-        Request v  _  -> closed v-        Respond a  fu -> loop (fu ()) $! step x a-        M          m  -> m >>= \p' -> loop p' x-        Pure    r     -> return (done x, r)-{-# INLINABLE fold' #-}--{-| Strict, monadic fold of the elements of a 'Producer'--> Control.Foldl.impurely foldM :: Monad m => FoldM a b -> Producer a m () -> m b--}-foldM-    :: Monad m-    => (x -> a -> m x) -> m x -> (x -> m b) -> Producer a m () -> m b-foldM step begin done p0 = do-    x0 <- begin-    loop p0 x0-  where-    loop p x = case p of-        Request v  _  -> closed v-        Respond a  fu -> do-            x' <- step x a-            loop (fu ()) $! x'-        M          m  -> m >>= \p' -> loop p' x-        Pure    _     -> done x-{-# INLINABLE foldM #-}--{-| Strict, monadic fold of the elements of a 'Producer'--> Control.Foldl.impurely foldM' :: Monad m => FoldM a b -> Producer a m r -> m (b, r)--}-foldM'-    :: Monad m-    => (x -> a -> m x) -> m x -> (x -> m b) -> Producer a m r -> m (b, r)-foldM' step begin done p0 = do-    x0 <- begin-    loop p0 x0-  where-    loop p x = case p of-        Request v  _  -> closed v-        Respond a  fu -> do-            x' <- step x a-            loop (fu ()) $! x'-        M          m  -> m >>= \p' -> loop p' x-        Pure    r     -> do-            b <- done x-            return (b, r)-{-# INLINABLE foldM' #-}--{-| @(all predicate p)@ determines whether all the elements of @p@ satisfy the-    predicate.--}-all :: Monad m => (a -> Bool) -> Producer a m () -> m Bool-all predicate p = null $ p >-> filter (\a -> not (predicate a))-{-# INLINABLE all #-}--{-| @(any predicate p)@ determines whether any element of @p@ satisfies the-    predicate.--}-any :: Monad m => (a -> Bool) -> Producer a m () -> m Bool-any predicate p = liftM not $ null (p >-> filter predicate)-{-# INLINABLE any #-}---- | Determines whether all elements are 'True'-and :: Monad m => Producer Bool m () -> m Bool-and = all id-{-# INLINABLE and #-}---- | Determines whether any element is 'True'-or :: Monad m => Producer Bool m () -> m Bool-or = any id-{-# INLINABLE or #-}--{-| @(elem a p)@ returns 'True' if @p@ has an element equal to @a@, 'False'-    otherwise--}-elem :: (Monad m, Eq a) => a -> Producer a m () -> m Bool-elem a = any (a ==)-{-# INLINABLE elem #-}--{-| @(notElem a)@ returns 'False' if @p@ has an element equal to @a@, 'True'-    otherwise--}-notElem :: (Monad m, Eq a) => a -> Producer a m () -> m Bool-notElem a = all (a /=)-{-# INLINABLE notElem #-}---- | Find the first element of a 'Producer' that satisfies the predicate-find :: Monad m => (a -> Bool) -> Producer a m () -> m (Maybe a)-find predicate p = head (p >-> filter predicate)-{-# INLINABLE find #-}--{-| Find the index of the first element of a 'Producer' that satisfies the-    predicate--}-findIndex :: Monad m => (a -> Bool) -> Producer a m () -> m (Maybe Int)-findIndex predicate p = head (p >-> findIndices predicate)-{-# INLINABLE findIndex #-}---- | Retrieve the first element from a 'Producer'-head :: Monad m => Producer a m () -> m (Maybe a)-head p = do-    x <- next p-    return $ case x of-        Left   _     -> Nothing-        Right (a, _) -> Just a-{-# INLINABLE head #-}---- | Index into a 'Producer'-index :: Monad m => Int -> Producer a m () -> m (Maybe a)-index n p = head (p >-> drop n)-{-# INLINABLE index #-}---- | Retrieve the last element from a 'Producer'-last :: Monad m => Producer a m () -> m (Maybe a)-last p0 = do-    x <- next p0-    case x of-        Left   _      -> return Nothing-        Right (a, p') -> loop a p'-  where-    loop a p = do-        x <- next p-        case x of-            Left   _       -> return (Just a)-            Right (a', p') -> loop a' p'-{-# INLINABLE last #-}---- | Count the number of elements in a 'Producer'-length :: Monad m => Producer a m () -> m Int-length = fold (\n _ -> n + 1) 0 id-{-# INLINABLE length #-}---- | Find the maximum element of a 'Producer'-maximum :: (Monad m, Ord a) => Producer a m () -> m (Maybe a)-maximum = fold step Nothing id-  where-    step x a = Just $ case x of-        Nothing -> a-        Just a' -> max a a'-{-# INLINABLE maximum #-}---- | Find the minimum element of a 'Producer'-minimum :: (Monad m, Ord a) => Producer a m () -> m (Maybe a)-minimum = fold step Nothing id-  where-    step x a = Just $ case x of-        Nothing -> a-        Just a' -> min a a'-{-# INLINABLE minimum #-}---- | Determine if a 'Producer' is empty-null :: Monad m => Producer a m () -> m Bool-null p = do-    x <- next p-    return $ case x of-        Left  _ -> True-        Right _ -> False-{-# INLINABLE null #-}---- | Compute the sum of the elements of a 'Producer'-sum :: (Monad m, Num a) => Producer a m () -> m a-sum = fold (+) 0 id-{-# INLINABLE sum #-}---- | Compute the product of the elements of a 'Producer'-product :: (Monad m, Num a) => Producer a m () -> m a-product = fold (*) 1 id-{-# INLINABLE product #-}---- | Convert a pure 'Producer' into a list-toList :: Producer a Identity () -> [a]-toList = loop-  where-    loop p = case p of-        Request v _  -> closed v-        Respond a fu -> a:loop (fu ())-        M         m  -> loop (runIdentity m)-        Pure    _    -> []-{-# INLINABLE toList #-}--{-| Convert an effectful 'Producer' into a list--    Note: 'toListM' is not an idiomatic use of @pipes@, but I provide it for-    simple testing purposes.  Idiomatic @pipes@ style consumes the elements-    immediately as they are generated instead of loading all elements into-    memory.--}-toListM :: Monad m => Producer a m () -> m [a]-toListM = fold step begin done-  where-    step x a = x . (a:)-    begin = id-    done x = x []-{-# INLINABLE toListM #-}---- | Zip two 'Producer's-zip :: Monad m-    => (Producer   a     m r)-    -> (Producer      b  m r)-    -> (Producer' (a, b) m r)-zip = zipWith (,)-{-# INLINABLE zip #-}---- | Zip two 'Producer's using the provided combining function-zipWith :: Monad m-    => (a -> b -> c)-    -> (Producer  a m r)-    -> (Producer  b m r)-    -> (Producer' c m r)-zipWith f = go-  where-    go p1 p2 = do-        e1 <- lift $ next p1-        case e1 of-            Left r         -> return r-            Right (a, p1') -> do-                e2 <- lift $ next p2-                case e2 of-                    Left r         -> return r-                    Right (b, p2') -> do-                        yield (f a b)-                        go p1' p2'-{-# INLINABLE zipWith #-}--{-| Transform a 'Consumer' to a 'Pipe' that reforwards all values further-    downstream--}-tee :: Monad m => Consumer a m r -> Pipe a a m r-tee p = evalStateP Nothing $ do-    r <- up >\\ (hoist lift p //> dn)-    ma <- lift get-    case ma of-        Nothing -> return ()-        Just a  -> yield a-    return r-  where-    up () = do-        ma <- lift get-        case ma of-            Nothing -> return ()-            Just a  -> yield a-        a <- await-        lift $ put (Just a)-        return a-    dn v = closed v-{-# INLINABLE tee #-}--{-| Transform a unidirectional 'Pipe' to a bidirectional 'Proxy'--> generalize (f >-> g) = generalize f >+> generalize g->-> generalize cat = pull--}-generalize :: Monad m => Pipe a b m r -> x -> Proxy x a x b m r-generalize p x0 = evalStateP x0 $ up >\\ hoist lift p //> dn-  where-    up () = do-        x <- lift get-        request x-    dn a = do-        x <- respond a-        lift $ put x-{-# INLINABLE generalize #-}+{-| General purpose utilities
+
+    The names in this module clash heavily with the Haskell Prelude, so I
+    recommend the following import scheme:
+
+> import Pipes
+> import qualified Pipes.Prelude as P  -- or use any other qualifier you prefer
+
+    Note that 'String'-based 'IO' is inefficient.  The 'String'-based utilities
+    in this module exist only for simple demonstrations without incurring a
+    dependency on the @text@ package.
+
+    Also, 'stdinLn' and 'stdoutLn' remove and add newlines, respectively.  This
+    behavior is intended to simplify examples.  The corresponding @stdin@ and
+    @stdout@ utilities from @pipes-bytestring@ and @pipes-text@ preserve
+    newlines.
+-}
+
+{-# LANGUAGE RankNTypes, Trustworthy #-}
+{-# OPTIONS_GHC -fno-warn-unused-do-bind #-}
+
+module Pipes.Prelude (
+    -- * Producers
+    -- $producers
+      stdinLn
+    , readLn
+    , fromHandle
+    , repeatM
+    , replicateM
+    , unfoldr
+
+    -- * Consumers
+    -- $consumers
+    , stdoutLn
+    , stdoutLn'
+    , mapM_
+    , print
+    , toHandle
+    , drain
+
+    -- * Pipes
+    -- $pipes
+    , map
+    , mapM
+    , sequence
+    , mapFoldable
+    , filter
+    , filterM
+    , take
+    , takeWhile
+    , takeWhile'
+    , drop
+    , dropWhile
+    , concat
+    , elemIndices
+    , findIndices
+    , scan
+    , scanM
+    , chain
+    , read
+    , show
+    , seq
+
+    -- *ListT
+    , loop
+
+    -- * Folds
+    -- $folds
+    , fold
+    , fold'
+    , foldM
+    , foldM'
+    , all
+    , any
+    , and
+    , or
+    , elem
+    , notElem
+    , find
+    , findIndex
+    , head
+    , index
+    , last
+    , length
+    , maximum
+    , minimum
+    , null
+    , sum
+    , product
+    , toList
+    , toListM
+    , toListM'
+
+    -- * Zips
+    , zip
+    , zipWith
+
+    -- * Utilities
+    , tee
+    , generalize
+    ) where
+
+import Control.Exception (throwIO, try)
+import Control.Monad (liftM, replicateM_, when, unless)
+import Control.Monad.Trans.State.Strict (get, put)
+import Data.Functor.Identity (Identity, runIdentity)
+import Foreign.C.Error (Errno(Errno), ePIPE)
+import Pipes
+import Pipes.Core
+import Pipes.Internal
+import Pipes.Lift (evalStateP)
+import qualified GHC.IO.Exception as G
+import qualified System.IO as IO
+import qualified Prelude
+import Prelude hiding (
+      all
+    , and
+    , any
+    , concat
+    , drop
+    , dropWhile
+    , elem
+    , filter
+    , head
+    , last
+    , length
+    , map
+    , mapM
+    , mapM_
+    , maximum
+    , minimum
+    , notElem
+    , null
+    , or
+    , print
+    , product
+    , read
+    , readLn
+    , sequence
+    , show
+    , seq
+    , sum
+    , take
+    , takeWhile
+    , zip
+    , zipWith
+    )
+
+{- $producers
+    Use 'for' loops to iterate over 'Producer's whenever you want to perform the
+    same action for every element:
+
+> -- Echo all lines from standard input to standard output
+> runEffect $ for P.stdinLn $ \str -> do
+>     lift $ putStrLn str
+
+    ... or more concisely:
+
+>>> runEffect $ for P.stdinLn (lift . putStrLn)
+Test<Enter>
+Test
+ABC<Enter>
+ABC
+...
+
+-}
+
+{-| Read 'String's from 'IO.stdin' using 'getLine'
+
+    Terminates on end of input
+-}
+stdinLn :: MonadIO m => Producer' String m ()
+stdinLn = fromHandle IO.stdin
+{-# INLINABLE stdinLn #-}
+
+-- | 'read' values from 'IO.stdin', ignoring failed parses
+readLn :: (MonadIO m, Read a) => Producer' a m ()
+readLn = stdinLn >-> read
+{-# INLINABLE readLn #-}
+
+{-| Read 'String's from a 'IO.Handle' using 'IO.hGetLine'
+
+    Terminates on end of input
+-}
+fromHandle :: MonadIO m => IO.Handle -> Producer' String m ()
+fromHandle h = go
+  where
+    go = do
+        eof <- liftIO $ IO.hIsEOF h
+        unless eof $ do
+            str <- liftIO $ IO.hGetLine h
+            yield str
+            go
+{-# INLINABLE fromHandle #-}
+
+-- | Repeat a monadic action indefinitely, 'yield'ing each result
+repeatM :: Monad m => m a -> Producer' a m r
+repeatM m = lift m >~ cat
+{-# INLINABLE repeatM #-}
+
+{-# RULES
+  "repeatM m >-> p" forall m p . repeatM m >-> p = lift m >~ p
+  #-}
+
+{-| Repeat a monadic action a fixed number of times, 'yield'ing each result
+
+> replicateM  0      x = return ()
+>
+> replicateM (m + n) x = replicateM m x >> replicateM n x  -- 0 <= {m,n}
+-}
+replicateM :: Monad m => Int -> m a -> Producer' a m ()
+replicateM n m = lift m >~ take n
+{-# INLINABLE replicateM #-}
+
+{- $consumers
+    Feed a 'Consumer' the same value repeatedly using ('>~'):
+
+>>> runEffect $ lift getLine >~ P.stdoutLn
+Test<Enter>
+Test
+ABC<Enter>
+ABC
+...
+
+-}
+
+{-| Write 'String's to 'IO.stdout' using 'putStrLn'
+
+    Unlike 'toHandle', 'stdoutLn' gracefully terminates on a broken output pipe
+-}
+stdoutLn :: MonadIO m => Consumer' String m ()
+stdoutLn = go
+  where
+    go = do
+        str <- await
+        x   <- liftIO $ try (putStrLn str)
+        case x of
+           Left (G.IOError { G.ioe_type  = G.ResourceVanished
+                           , G.ioe_errno = Just ioe })
+                | Errno ioe == ePIPE
+                    -> return ()
+           Left  e  -> liftIO (throwIO e)
+           Right () -> go
+{-# INLINABLE stdoutLn #-}
+
+{-| Write 'String's to 'IO.stdout' using 'putStrLn'
+
+    This does not handle a broken output pipe, but has a polymorphic return
+    value
+-}
+stdoutLn' :: MonadIO m => Consumer' String m r
+stdoutLn' = for cat (\str -> liftIO (putStrLn str))
+{-# INLINABLE stdoutLn' #-}
+
+{-# RULES
+    "p >-> stdoutLn'" forall p .
+        p >-> stdoutLn' = for p (\str -> liftIO (putStrLn str))
+  #-}
+
+-- | Consume all values using a monadic function
+mapM_ :: Monad m => (a -> m ()) -> Consumer' a m r
+mapM_ f = for cat (\a -> lift (f a))
+{-# INLINABLE mapM_ #-}
+
+{-# RULES
+    "p >-> mapM_ f" forall p f .
+        p >-> mapM_ f = for p (\a -> lift (f a))
+  #-}
+
+-- | 'print' values to 'IO.stdout'
+print :: (MonadIO m, Show a) => Consumer' a m r
+print = for cat (\a -> liftIO (Prelude.print a))
+{-# INLINABLE print #-}
+
+{-# RULES
+    "p >-> print" forall p .
+        p >-> print = for p (\a -> liftIO (Prelude.print a))
+  #-}
+
+-- | Write 'String's to a 'IO.Handle' using 'IO.hPutStrLn'
+toHandle :: MonadIO m => IO.Handle -> Consumer' String m r
+toHandle handle = for cat (\str -> liftIO (IO.hPutStrLn handle str))
+{-# INLINABLE toHandle #-}
+
+{-# RULES
+    "p >-> toHandle handle" forall p handle .
+        p >-> toHandle handle = for p (\str -> liftIO (IO.hPutStrLn handle str))
+  #-}
+
+-- | 'discard' all incoming values
+drain :: Monad m => Consumer' a m r
+drain = for cat discard
+{-# INLINABLE drain #-}
+
+{-# RULES
+    "p >-> drain" forall p .
+        p >-> drain = for p discard
+  #-}
+
+{- $pipes
+    Use ('>->') to connect 'Producer's, 'Pipe's, and 'Consumer's:
+
+>>> runEffect $ P.stdinLn >-> P.takeWhile (/= "quit") >-> P.stdoutLn
+Test<Enter>
+Test
+ABC<Enter>
+ABC
+quit<Enter>
+>>>
+
+-}
+
+{-| Apply a function to all values flowing downstream
+
+> map id = cat
+>
+> map (g . f) = map f >-> map g
+-}
+map :: Monad m => (a -> b) -> Pipe a b m r
+map f = for cat (\a -> yield (f a))
+{-# INLINABLE map #-}
+
+{-# RULES
+    "p >-> map f" forall p f . p >-> map f = for p (\a -> yield (f a))
+
+  ; "map f >-> p" forall p f . map f >-> p = (do
+        a <- await
+        return (f a) ) >~ p
+  #-}
+
+{-| Apply a monadic function to all values flowing downstream
+
+> mapM return = cat
+>
+> mapM (f >=> g) = mapM f >-> mapM g
+-}
+mapM :: Monad m => (a -> m b) -> Pipe a b m r
+mapM f = for cat $ \a -> do
+    b <- lift (f a)
+    yield b
+{-# INLINABLE mapM #-}
+
+{-# RULES
+    "p >-> mapM f" forall p f . p >-> mapM f = for p (\a -> do
+        b <- lift (f a)
+        yield b )
+
+  ; "mapM f >-> p" forall p f . mapM f >-> p = (do
+        a <- await
+        b <- lift (f a)
+        return b ) >~ p
+  #-}
+
+-- | Convert a stream of actions to a stream of values
+sequence :: Monad m => Pipe (m a) a m r
+sequence = mapM id
+{-# INLINABLE sequence #-}
+
+{- | Apply a function to all values flowing downstream, and
+     forward each element of the result.
+-}
+mapFoldable :: (Monad m, Foldable t) => (a -> t b) -> Pipe a b m r
+mapFoldable f = for cat (\a -> each (f a))
+{-# INLINABLE mapFoldable #-}
+
+{-# RULES
+    "p >-> mapFoldable f" forall p f .
+        p >-> mapFoldable f = for p (\a -> each (f a))
+  #-}
+
+{-| @(filter predicate)@ only forwards values that satisfy the predicate.
+
+> filter (pure True) = cat
+>
+> filter (liftA2 (&&) p1 p2) = filter p1 >-> filter p2
+-}
+filter :: Monad m => (a -> Bool) -> Pipe a a m r
+filter predicate = for cat $ \a -> when (predicate a) (yield a)
+{-# INLINABLE filter #-}
+
+{-# RULES
+    "p >-> filter predicate" forall p predicate.
+        p >-> filter predicate = for p (\a -> when (predicate a) (yield a))
+  #-}
+
+{-| @(filterM predicate)@ only forwards values that satisfy the monadic
+    predicate
+
+> filterM (pure (pure True)) = cat
+>
+> filterM (liftA2 (liftA2 (&&)) p1 p2) = filterM p1 >-> filterM p2
+-}
+filterM :: Monad m => (a -> m Bool) -> Pipe a a m r
+filterM predicate = for cat $ \a -> do
+    b <- lift (predicate a)
+    when b (yield a)
+{-# INLINABLE filterM #-}
+
+{-# RULES
+    "p >-> filterM predicate" forall p predicate .
+        p >-> filterM predicate = for p (\a -> do
+            b <- lift (predicate a)
+            when b (yield a) )
+  #-}
+
+{-| @(take n)@ only allows @n@ values to pass through
+
+> take 0 = return ()
+>
+> take (m + n) = take m >> take n
+
+> take <infinity> = cat
+>
+> take (min m n) = take m >-> take n
+-}
+take :: Monad m => Int -> Pipe a a m ()
+take = loop where
+  loop 0 = return () 
+  loop n = do 
+    a <- await
+    yield a
+    loop (n-1)
+{-# INLINABLE take #-}
+
+{-| @(takeWhile p)@ allows values to pass downstream so long as they satisfy
+    the predicate @p@.
+
+> takeWhile (pure True) = cat
+>
+> takeWhile (liftA2 (&&) p1 p2) = takeWhile p1 >-> takeWhile p2
+-}
+takeWhile :: Monad m => (a -> Bool) -> Pipe a a m ()
+takeWhile predicate = go
+  where
+    go = do
+        a <- await
+        if (predicate a)
+            then do
+                yield a
+                go
+            else return ()
+{-# INLINABLE takeWhile #-}
+
+{-| @(takeWhile' p)@ is a version of takeWhile that returns the value failing
+    the predicate.
+
+> takeWhile' (pure True) = cat
+>
+> takeWhile' (liftA2 (&&) p1 p2) = takeWhile' p1 >-> takeWhile' p2
+-}
+takeWhile' :: Monad m => (a -> Bool) -> Pipe a a m a
+takeWhile' predicate = go
+  where
+    go = do
+        a <- await
+        if (predicate a)
+            then do
+                yield a
+                go
+            else return a
+{-# INLINABLE takeWhile' #-}
+
+{-| @(drop n)@ discards @n@ values going downstream
+
+> drop 0 = cat
+>
+> drop (m + n) = drop m >-> drop n
+-}
+drop :: Monad m => Int -> Pipe a a m r
+drop = loop
+  where
+    loop 0 = cat
+    loop n =  do
+      await
+      loop (n-1)
+{-# INLINABLE drop #-}
+
+{-| @(dropWhile p)@ discards values going downstream until one violates the
+    predicate @p@.
+
+> dropWhile (pure False) = cat
+>
+> dropWhile (liftA2 (||) p1 p2) = dropWhile p1 >-> dropWhile p2
+-}
+dropWhile :: Monad m => (a -> Bool) -> Pipe a a m r
+dropWhile predicate = go
+  where
+    go = do
+        a <- await
+        if (predicate a)
+            then go
+            else do
+                yield a
+                cat
+{-# INLINABLE dropWhile #-}
+
+-- | Flatten all 'Foldable' elements flowing downstream
+concat :: (Monad m, Foldable f) => Pipe (f a) a m r
+concat = for cat each
+{-# INLINABLE concat #-}
+
+{-# RULES
+    "p >-> concat" forall p . p >-> concat = for p each
+  #-}
+
+-- | Outputs the indices of all elements that match the given element
+elemIndices :: (Monad m, Eq a) => a -> Pipe a Int m r
+elemIndices a = findIndices (a ==)
+{-# INLINABLE elemIndices #-}
+
+-- | Outputs the indices of all elements that satisfied the predicate
+findIndices :: Monad m => (a -> Bool) -> Pipe a Int m r
+findIndices predicate = go 0
+  where
+    go n = do
+        a <- await
+        when (predicate a) (yield n)
+        go $! n + 1
+{-# INLINABLE findIndices #-}
+
+{-| Strict left scan
+
+> Control.Foldl.purely scan :: Monad m => Fold a b -> Pipe a b m r
+-}
+scan :: Monad m => (x -> a -> x) -> x -> (x -> b) -> Pipe a b m r
+scan step begin done = go begin
+  where
+    go x = do
+        yield (done x)
+        a <- await
+        let x' = step x a
+        go $! x'
+{-# INLINABLE scan #-}
+
+{-| Strict, monadic left scan
+
+> Control.Foldl.impurely scan :: Monad m => FoldM a m b -> Pipe a b m r
+-}
+scanM :: Monad m => (x -> a -> m x) -> m x -> (x -> m b) -> Pipe a b m r
+scanM step begin done = do
+    x <- lift begin
+    go x
+  where
+    go x = do
+        b <- lift (done x)
+        yield b
+        a  <- await
+        x' <- lift (step x a)
+        go $! x'
+{-# INLINABLE scanM #-}
+
+{-| Apply an action to all values flowing downstream
+
+> chain (pure (return ())) = cat
+>
+> chain (liftA2 (>>) m1 m2) = chain m1 >-> chain m2
+-}
+chain :: Monad m => (a -> m ()) -> Pipe a a m r
+chain f = for cat $ \a -> do
+    lift (f a)
+    yield a
+{-# INLINABLE chain #-}
+
+{-# RULES
+    "p >-> chain f" forall p f .
+        p >-> chain f = for p (\a -> do
+            lift (f a)
+            yield a )
+  ; "chain f >-> p" forall p f .
+        chain f >-> p = (do
+            a <- await
+            lift (f a)
+            return a ) >~ p
+  #-}
+
+-- | Parse 'Read'able values, only forwarding the value if the parse succeeds
+read :: (Monad m, Read a) => Pipe String a m r
+read = for cat $ \str -> case (reads str) of
+    [(a, "")] -> yield a
+    _         -> return ()
+{-# INLINABLE read #-}
+
+{-# RULES
+    "p >-> read" forall p .
+        p >-> read = for p (\str -> case (reads str) of
+            [(a, "")] -> yield a
+            _         -> return () )
+  #-}
+
+-- | Convert 'Show'able values to 'String's
+show :: (Monad m, Show a) => Pipe a String m r
+show = map Prelude.show
+{-# INLINABLE show #-}
+
+-- | Evaluate all values flowing downstream to WHNF
+seq :: Monad m => Pipe a a m r
+seq = for cat $ \a -> yield $! a
+{-# INLINABLE seq #-}
+
+{-| Create a `Pipe` from a `ListT` transformation
+
+> loop (k1 >=> k2) = loop k1 >-> loop k2
+>
+> loop return = cat
+-}
+loop :: Monad m => (a -> ListT m b) -> Pipe a b m r
+loop k = for cat (every . k)
+{-# INLINABLE loop #-}
+
+{- $folds
+    Use these to fold the output of a 'Producer'.  Many of these folds will stop
+    drawing elements if they can compute their result early, like 'any':
+
+>>> P.any null P.stdinLn
+Test<Enter>
+ABC<Enter>
+<Enter>
+True
+>>>
+
+-}
+
+{-| Strict fold of the elements of a 'Producer'
+
+> Control.Foldl.purely fold :: Monad m => Fold a b -> Producer a m () -> m b
+-}
+fold :: Monad m => (x -> a -> x) -> x -> (x -> b) -> Producer a m () -> m b
+fold step begin done p0 = go p0 begin
+  where
+    go p x = case p of
+        Request v  _  -> closed v
+        Respond a  fu -> go (fu ()) $! step x a
+        M          m  -> m >>= \p' -> go p' x
+        Pure    _     -> return (done x)
+{-# INLINABLE fold #-}
+
+{-| Strict fold of the elements of a 'Producer' that preserves the return value
+
+> Control.Foldl.purely fold' :: Monad m => Fold a b -> Producer a m r -> m (b, r)
+-}
+fold' :: Monad m => (x -> a -> x) -> x -> (x -> b) -> Producer a m r -> m (b, r)
+fold' step begin done p0 = go p0 begin
+  where
+    go p x = case p of
+        Request v  _  -> closed v
+        Respond a  fu -> go (fu ()) $! step x a
+        M          m  -> m >>= \p' -> go p' x
+        Pure    r     -> return (done x, r)
+{-# INLINABLE fold' #-}
+
+{-| Strict, monadic fold of the elements of a 'Producer'
+
+> Control.Foldl.impurely foldM :: Monad m => FoldM a b -> Producer a m () -> m b
+-}
+foldM
+    :: Monad m
+    => (x -> a -> m x) -> m x -> (x -> m b) -> Producer a m () -> m b
+foldM step begin done p0 = do
+    x0 <- begin
+    go p0 x0
+  where
+    go p x = case p of
+        Request v  _  -> closed v
+        Respond a  fu -> do
+            x' <- step x a
+            go (fu ()) $! x'
+        M          m  -> m >>= \p' -> go p' x
+        Pure    _     -> done x
+{-# INLINABLE foldM #-}
+
+{-| Strict, monadic fold of the elements of a 'Producer'
+
+> Control.Foldl.impurely foldM' :: Monad m => FoldM a b -> Producer a m r -> m (b, r)
+-}
+foldM'
+    :: Monad m
+    => (x -> a -> m x) -> m x -> (x -> m b) -> Producer a m r -> m (b, r)
+foldM' step begin done p0 = do
+    x0 <- begin
+    go p0 x0
+  where
+    go p x = case p of
+        Request v  _  -> closed v
+        Respond a  fu -> do
+            x' <- step x a
+            go (fu ()) $! x'
+        M          m  -> m >>= \p' -> go p' x
+        Pure    r     -> do
+            b <- done x
+            return (b, r)
+{-# INLINABLE foldM' #-}
+
+{-| @(all predicate p)@ determines whether all the elements of @p@ satisfy the
+    predicate.
+-}
+all :: Monad m => (a -> Bool) -> Producer a m () -> m Bool
+all predicate p = null $ p >-> filter (\a -> not (predicate a))
+{-# INLINABLE all #-}
+
+{-| @(any predicate p)@ determines whether any element of @p@ satisfies the
+    predicate.
+-}
+any :: Monad m => (a -> Bool) -> Producer a m () -> m Bool
+any predicate p = liftM not $ null (p >-> filter predicate)
+{-# INLINABLE any #-}
+
+-- | Determines whether all elements are 'True'
+and :: Monad m => Producer Bool m () -> m Bool
+and = all id
+{-# INLINABLE and #-}
+
+-- | Determines whether any element is 'True'
+or :: Monad m => Producer Bool m () -> m Bool
+or = any id
+{-# INLINABLE or #-}
+
+{-| @(elem a p)@ returns 'True' if @p@ has an element equal to @a@, 'False'
+    otherwise
+-}
+elem :: (Monad m, Eq a) => a -> Producer a m () -> m Bool
+elem a = any (a ==)
+{-# INLINABLE elem #-}
+
+{-| @(notElem a)@ returns 'False' if @p@ has an element equal to @a@, 'True'
+    otherwise
+-}
+notElem :: (Monad m, Eq a) => a -> Producer a m () -> m Bool
+notElem a = all (a /=)
+{-# INLINABLE notElem #-}
+
+-- | Find the first element of a 'Producer' that satisfies the predicate
+find :: Monad m => (a -> Bool) -> Producer a m () -> m (Maybe a)
+find predicate p = head (p >-> filter predicate)
+{-# INLINABLE find #-}
+
+{-| Find the index of the first element of a 'Producer' that satisfies the
+    predicate
+-}
+findIndex :: Monad m => (a -> Bool) -> Producer a m () -> m (Maybe Int)
+findIndex predicate p = head (p >-> findIndices predicate)
+{-# INLINABLE findIndex #-}
+
+-- | Retrieve the first element from a 'Producer'
+head :: Monad m => Producer a m () -> m (Maybe a)
+head p = do
+    x <- next p
+    return $ case x of
+        Left   _     -> Nothing
+        Right (a, _) -> Just a
+{-# INLINABLE head #-}
+
+-- | Index into a 'Producer'
+index :: Monad m => Int -> Producer a m () -> m (Maybe a)
+index n p = head (p >-> drop n)
+{-# INLINABLE index #-}
+
+-- | Retrieve the last element from a 'Producer'
+last :: Monad m => Producer a m () -> m (Maybe a)
+last p0 = do
+    x <- next p0
+    case x of
+        Left   _      -> return Nothing
+        Right (a, p') -> go a p'
+  where
+    go a p = do
+        x <- next p
+        case x of
+            Left   _       -> return (Just a)
+            Right (a', p') -> go a' p'
+{-# INLINABLE last #-}
+
+-- | Count the number of elements in a 'Producer'
+length :: Monad m => Producer a m () -> m Int
+length = fold (\n _ -> n + 1) 0 id
+{-# INLINABLE length #-}
+
+-- | Find the maximum element of a 'Producer'
+maximum :: (Monad m, Ord a) => Producer a m () -> m (Maybe a)
+maximum = fold step Nothing id
+  where
+    step x a = Just $ case x of
+        Nothing -> a
+        Just a' -> max a a'
+{-# INLINABLE maximum #-}
+
+-- | Find the minimum element of a 'Producer'
+minimum :: (Monad m, Ord a) => Producer a m () -> m (Maybe a)
+minimum = fold step Nothing id
+  where
+    step x a = Just $ case x of
+        Nothing -> a
+        Just a' -> min a a'
+{-# INLINABLE minimum #-}
+
+-- | Determine if a 'Producer' is empty
+null :: Monad m => Producer a m () -> m Bool
+null p = do
+    x <- next p
+    return $ case x of
+        Left  _ -> True
+        Right _ -> False
+{-# INLINABLE null #-}
+
+-- | Compute the sum of the elements of a 'Producer'
+sum :: (Monad m, Num a) => Producer a m () -> m a
+sum = fold (+) 0 id
+{-# INLINABLE sum #-}
+
+-- | Compute the product of the elements of a 'Producer'
+product :: (Monad m, Num a) => Producer a m () -> m a
+product = fold (*) 1 id
+{-# INLINABLE product #-}
+
+-- | Convert a pure 'Producer' into a list
+toList :: Producer a Identity () -> [a]
+toList = go
+  where
+    go p = case p of
+        Request v _  -> closed v
+        Respond a fu -> a:go (fu ())
+        M         m  -> go (runIdentity m)
+        Pure    _    -> []
+{-# INLINABLE toList #-}
+
+{-| Convert an effectful 'Producer' into a list
+
+    Note: 'toListM' is not an idiomatic use of @pipes@, but I provide it for
+    simple testing purposes.  Idiomatic @pipes@ style consumes the elements
+    immediately as they are generated instead of loading all elements into
+    memory.
+-}
+toListM :: Monad m => Producer a m () -> m [a]
+toListM = fold step begin done
+  where
+    step x a = x . (a:)
+    begin = id
+    done x = x []
+{-# INLINABLE toListM #-}
+
+{-| Convert an effectful 'Producer' into a list alongside the return value
+
+    Note: 'toListM'' is not an idiomatic use of @pipes@, but I provide it for
+    simple testing purposes.  Idiomatic @pipes@ style consumes the elements
+    immediately as they are generated instead of loading all elements into
+    memory.
+-}
+toListM' :: Monad m => Producer a m r -> m ([a], r)
+toListM' = fold' step begin done
+  where
+    step x a = x . (a:)
+    begin = id
+    done x = x []
+{-# INLINABLE toListM' #-}
+
+-- | Zip two 'Producer's
+zip :: Monad m
+    => (Producer   a     m r)
+    -> (Producer      b  m r)
+    -> (Producer' (a, b) m r)
+zip = zipWith (,)
+{-# INLINABLE zip #-}
+
+-- | Zip two 'Producer's using the provided combining function
+zipWith :: Monad m
+    => (a -> b -> c)
+    -> (Producer  a m r)
+    -> (Producer  b m r)
+    -> (Producer' c m r)
+zipWith f = go
+  where
+    go p1 p2 = do
+        e1 <- lift $ next p1
+        case e1 of
+            Left r         -> return r
+            Right (a, p1') -> do
+                e2 <- lift $ next p2
+                case e2 of
+                    Left r         -> return r
+                    Right (b, p2') -> do
+                        yield (f a b)
+                        go p1' p2'
+{-# INLINABLE zipWith #-}
+
+{-| Transform a 'Consumer' to a 'Pipe' that reforwards all values further
+    downstream
+-}
+tee :: Monad m => Consumer a m r -> Pipe a a m r
+tee p = evalStateP Nothing $ do
+    r <- up >\\ (hoist lift p //> dn)
+    ma <- lift get
+    case ma of
+        Nothing -> return ()
+        Just a  -> yield a
+    return r
+  where
+    up () = do
+        ma <- lift get
+        case ma of
+            Nothing -> return ()
+            Just a  -> yield a
+        a <- await
+        lift $ put (Just a)
+        return a
+    dn v = closed v
+{-# INLINABLE tee #-}
+
+{-| Transform a unidirectional 'Pipe' to a bidirectional 'Proxy'
+
+> generalize (f >-> g) = generalize f >+> generalize g
+>
+> generalize cat = pull
+-}
+generalize :: Monad m => Pipe a b m r -> x -> Proxy x a x b m r
+generalize p x0 = evalStateP x0 $ up >\\ hoist lift p //> dn
+  where
+    up () = do
+        x <- lift get
+        request x
+    dn a = do
+        x <- respond a
+        lift $ put x
+{-# INLINABLE generalize #-}
+
+{-| The natural unfold into a 'Producer' with a step function and a seed 
+
+> unfoldr next = id
+-}
+unfoldr :: Monad m 
+        => (s -> m (Either r (a, s))) -> s -> Producer a m r
+unfoldr step = go where
+  go s0 = do
+    e <- lift (step s0)
+    case e of
+      Left r -> return r
+      Right (a,s) -> do 
+        yield a
+        go s
+{-# INLINABLE unfoldr #-}
src/Pipes/Tutorial.hs view
@@ -1,1513 +1,1619 @@-{-# OPTIONS_GHC -fno-warn-unused-imports #-}--{-| Conventional Haskell stream programming forces you to choose only two of the-    following three features:--    * Effects--    * Streaming--    * Composability--    If you sacrifice /Effects/ you get Haskell's pure and lazy lists, which you-    can transform using composable functions in constant space, but without-    interleaving effects.--    If you sacrifice /Streaming/ you get 'mapM', 'forM' and-    \"ListT done wrong\", which are composable and effectful, but do not return-    a single result until the whole list has first been processed and loaded-    into memory.--    If you sacrifice /Composability/ you write a tightly coupled read,-    transform, and write loop in 'IO', which is streaming and effectful, but is-    not modular or separable.--    @pipes@ gives you all three features: effectful, streaming, and composable-    programming.  @pipes@ also provides a wide variety of stream programming-    abstractions which are all subsets of a single unified machinery:--    * effectful 'Producer's (like generators),--    * effectful 'Consumer's (like iteratees),--    * effectful 'Pipe's (like Unix pipes), and:--    * 'ListT' done right.--    All of these are connectable and you can combine them together in clever and-    unexpected ways because they all share the same underlying type.--    @pipes@ requires a basic understanding of monad transformers, which you can-    learn about by reading either:--    * the paper \"Monad Transformers - Step by Step\",--    * chapter 18 of \"Real World Haskell\" on monad transformers, or:--    * the documentation of the @transformers@ library.--    If you want a Quick Start guide to @pipes@, read the documentation in-    "Pipes.Prelude" from top to bottom.--    This tutorial is more extensive and explains the @pipes@ API in greater-    detail and illustrates several idioms.--}--module Pipes.Tutorial (-    -- * Introduction-    -- $introduction--    -- * Producers-    -- $producers--    -- * Composability-    -- $composability--    -- * Consumers-    -- $consumers--    -- * Pipes-    -- $pipes--    -- * ListT-    -- $listT--    -- * Tricks-    -- $tricks--    -- * Conclusion-    -- $conclusion--    -- * Appendix: Types-    -- $types--    -- * Appendix: Time Complexity-    -- $timecomplexity-    ) where--import Control.Category-import Control.Monad-import Control.Monad.Trans.Error-import Control.Monad.Trans.Writer.Strict-import Pipes-import Pipes.Lift-import qualified Pipes.Prelude as P-import Prelude hiding ((.), id)--{- $introduction-    The @pipes@ library decouples stream processing stages from each other so-    that you can mix and match diverse stages to produce useful streaming-    programs.  If you are a library writer, @pipes@ lets you package up-    streaming components into a reusable interface.  If you are an application-    writer, @pipes@ lets you connect pre-made streaming components with minimal-    effort to produce a highly-efficient program that streams data in constant-    memory.--    To enforce loose coupling, components can only communicate using two-    commands:--    * 'yield': Send output data--    * 'await': Receive input data--    @pipes@ has four types of components built around these two commands:--    * 'Producer's can only 'yield' values and they model streaming sources--    * 'Consumer's can only 'await' values and they model streaming sinks--    * 'Pipe's can both 'yield' and 'await' values and they model stream-      transformations--    * 'Effect's can neither 'yield' nor 'await' and they model non-streaming-      components--    You can connect these components together in four separate ways which-    parallel the four above types:--    * 'for' handles 'yield's--    * ('>~') handles 'await's--    * ('>->') handles both 'yield's and 'await's--    * ('>>=') handles return values--    As you connect components their types will change to reflect inputs and-    outputs that you've fused away.  You know that you're done connecting things-    when you get an 'Effect', meaning that you have handled all inputs and-    outputs.  You run this final 'Effect' to begin streaming.--}--{- $producers-    'Producer's are effectful streams of input.  Specifically, a 'Producer' is a-    monad transformer that extends any base monad with a new 'yield' command.-    This 'yield' command lets you send output downstream to an anonymous-    handler, decoupling how you generate values from how you consume them.--    The following @stdinLn@ 'Producer' shows how to incrementally read in-    'String's from standard input and 'yield' them downstream, terminating-    gracefully when reaching the end of the input:--> -- echo.hs->-> import Control.Monad (unless)-> import Pipes-> import System.IO (isEOF)->-> --         +--------+-- A 'Producer' that yields 'String's-> --         |        |-> --         |        |      +-- Every monad transformer has a base monad.-> --         |        |      |   This time the base monad is 'IO'.-> --         |        |      |  -> --         |        |      |  +-- Every monadic action has a return value.-> --         |        |      |  |   This action returns '()' when finished-> --         v        v      v  v-> stdinLn :: Producer String IO ()-> stdinLn = do->     eof <- lift isEOF        -- 'lift' an 'IO' action from the base monad->     unless eof $ do->         str <- lift getLine->         yield str            -- 'yield' the 'String'->         stdinLn              -- Loop--    'yield' emits a value, suspending the current 'Producer' until the value is-    consumed.  If nobody consumes the value (which is possible) then 'yield'-    never returns.  You can think of 'yield' as having the following type:--@- 'yield' :: 'Monad' m => a -> 'Producer' a m ()-@--    The true type of 'yield' is actually more general and powerful.  Throughout-    the tutorial I will present type signatures like this that are simplified at-    first and then later reveal more general versions.  So read the above type-    signature as simply saying: \"You can use 'yield' within a 'Producer', but-    you may be able to use 'yield' in other contexts, too.\"--    Click the link to 'yield' to navigate to its documentation.  There you will-    see that 'yield' actually uses the 'Producer'' (with an apostrophe) type-    synonym which hides a lot of polymorphism behind a simple veneer.  The-    documentation for 'yield' says that you can also use 'yield' within a-    'Pipe', too, because of this polymorphism:--@- 'yield' :: 'Monad' m => a -> 'Pipe' x a m ()-@--    Use simpler types like these to guide you until you understand the fully-    general type.--    'for' loops are the simplest way to consume a 'Producer' like @stdinLn@.-    'for' has the following type:--@- \-\-                +-- Producer      +-- The body of the   +-- Result- \-\-                |   to loop       |   loop              |- \-\-                v   over          v                     v- \-\-                --------------    ------------------    ----------- 'for' :: 'Monad' m => 'Producer' a m r -> (a -> 'Effect' m ()) -> 'Effect' m r-@--    @(for producer body)@ loops over @(producer)@, substituting each 'yield' in-    @(producer)@ with @(body)@.--    You can also deduce that behavior purely from the type signature:--    * The body of the loop takes exactly one argument of type @(a)@, which is-      the same as the output type of the 'Producer'.  Therefore, the body of the-      loop must get its input from that 'Producer' and nowhere else.--    * The return value of the input 'Producer' matches the return value of the-      result, therefore 'for' must loop over the entire 'Producer' and not skip-      anything.--    The above type signature is not the true type of 'for', which is actually-    more general.  Think of the above type signature as saying: \"If the first-    argument of 'for' is a 'Producer' and the second argument returns an-    'Effect', then the final result must be an 'Effect'.\"--    Click the link to 'for' to navigate to its documentation.  There you will-    see the fully general type and underneath you will see equivalent simpler-    types.  One of these says that if the body of the loop is a 'Producer', then-    the result is a 'Producer', too:--@- 'for' :: 'Monad' m => 'Producer' a m r -> (a -> 'Producer' b m ()) -> 'Producer' b m r-@--    The first type signature I showed for 'for' was a special case of this-    slightly more general signature because a 'Producer' that never 'yield's is-    also an 'Effect':--@- data 'X'  -- The uninhabited type--\ type 'Effect' m r = 'Producer' 'X' m r-@--    This is why 'for' permits two different type signatures.  The first type-    signature is just a special case of the second one:--@- 'for' :: 'Monad' m => 'Producer' a m r -> (a -> 'Producer' b m ()) -> 'Producer' b m r--\ -- Specialize \'b\' to \'X\'- 'for' :: 'Monad' m => 'Producer' a m r -> (a -> 'Producer' 'X' m ()) -> 'Producer' 'X' m r--\ -- Producer X = Effect- 'for' :: 'Monad' m => 'Producer' a m r -> (a -> 'Effect'     m ()) -> 'Effect'     m r-@--    This is the same trick that all @pipes@ functions use to work with various-    combinations of 'Producer's, 'Consumer's, 'Pipe's, and 'Effect's.  Each-    function really has just one general type, which you can then simplify down-    to multiple useful alternative types.--    Here's an example use of a 'for' @loop@, where the second argument (the-    loop body) is an 'Effect':--> -- echo.hs->-> loop :: Effect IO ()-> loop = for stdinLn $ \str -> do  -- Read this like: "for str in stdinLn"->     lift $ putStrLn str          -- The body of the 'for' loop->-> -- more concise: loop = for stdinLn (lift . putStrLn)--    In this example, 'for' loops over @stdinLn@ and replaces every 'yield' in-    @stdinLn@ with the body of the loop, printing each line.  This is exactly-    equivalent to the following code, which I've placed side-by-side with the-    original definition of @stdinLn@ for comparison:--> loop = do                      |  stdinLn = do->     eof <- lift isEOF          |      eof <- lift isEOF->     unless eof $ do            |      unless eof $ do->         str <- lift getLine    |          str <- lift getLine->         (lift . putStrLn) str  |          yield str->         loop                   |          stdinLn--    You can think of 'yield' as creating a hole and a 'for' loop is one way to-    fill that hole.--    Notice how the final @loop@ only 'lift's actions from the base monad and-    does nothing else.  This property is true for all 'Effect's, which are just-    glorified wrappers around actions in the base monad.  This means we can run-    these 'Effect's to remove their 'lift's and lower them back to the-    equivalent computation in the base monad:--@- 'runEffect' :: 'Monad' m => 'Effect' m r -> m r-@--    This is the real type signature of 'runEffect', which refuses to accept-    anything other than an 'Effect'.  This ensures that we handle all inputs and-    outputs before streaming data:--> -- echo.hs->-> main :: IO ()-> main = runEffect loop--    ... or you could inline the entire @loop@ into the following one-liner:--> main = runEffect $ for stdinLn (lift . putStrLn)--    Our final program loops over standard input and echoes every line to-    standard output until we hit @Ctrl-D@ to end the input stream:--> $ ghc -O2 echo.hs-> $ ./echo-> Test<Enter>-> Test-> ABC<Enter>-> ABC-> <Ctrl-D>-> $--    The final behavior is indistinguishable from just removing all the 'lift's-    from @loop@:--> main = do               |  loop = do->     eof <- isEof        |      eof <- lift isEof->     unless eof $ do     |      unless eof $ do->         str <- getLine  |          str <- lift getLine->         putStrLn str    |          (lift . putStrLn) str->         main            |          loop--    This @main@ is what we might have written by hand if we were not using-    @pipes@, but with @pipes@ we can decouple the input and output logic from-    each other.  When we connect them back together, we still produce streaming-    code equivalent to what a sufficiently careful Haskell programmer would-    have written.--    You can also use 'for' to loop over lists, too.  To do so, convert the list-    to a 'Producer' using 'each', which is exported by default from "Pipes":--> each :: Monad m => [a] -> Producer a m ()-> each as = mapM_ yield as--    Combine 'for' and 'each' to iterate over lists using a \"foreach\" loop:-->>> runEffect $ for (each [1..4]) (lift . print)-1-2-3-4--    'each' is actually more general and works for any 'Foldable':--@- 'each' :: ('Monad' m, 'Foldable' f) => f a -> 'Producer' a m ()-@--     So you can loop over any 'Foldable' container or even a 'Maybe':-->>> runEffect $ for (each (Just 1)) (lift . print)-1---}--{- $composability-    You might wonder why the body of a 'for' loop can be a 'Producer'.  Let's-    test out this feature by defining a new loop body that @duplicate@s every-    value:--> -- nested.hs->-> import Pipes-> import qualified Pipes.Prelude as P  -- Pipes.Prelude already has 'stdinLn'-> -> duplicate :: Monad m => a -> Producer a m ()-> duplicate x = do->     yield x->     yield x->-> loop :: Producer String IO ()-> loop = for P.stdinLn duplicate->-> -- This is the exact same as:-> ---> -- loop = for P.stdinLn $ \x -> do-> --     yield x-> --     yield x--    This time our @loop@ is a 'Producer' that outputs 'String's, specifically-    two copies of each line that we read from standard input.  Since @loop@ is a-    'Producer' we cannot run it because there is still unhandled output.-    However, we can use yet another 'for' to handle this new duplicated stream:--> -- nested.hs->-> main = runEffect $ for loop (lift . putStrLn)--    This creates a program which echoes every line from standard input to-    standard output twice:--> $ ./nested-> Test<Enter>-> Test-> Test-> ABC<Enter>-> ABC-> ABC-> <Ctrl-D>-> $--    But is this really necessary?  Couldn't we have instead written this using a-    nested for loop?--> main = runEffect $->     for P.stdinLn $ \str1 ->->         for (duplicate str1) $ \str2 ->->             lift $ putStrLn str2--    Yes, we could have!  In fact, this is a special case of the following-    equality, which always holds no matter what:--@- \-\- s :: Monad m =>      'Producer' a m ()  -- i.e. \'P.stdinLn\'- \-\- f :: Monad m => a -> 'Producer' b m ()  -- i.e. \'duplicate\'- \-\- g :: Monad m => b -> 'Producer' c m ()  -- i.e. \'(lift . putStrLn)\'--\ for (for s f) g = for s (\\x -> for (f x) g)-@--    We can understand the rationale behind this equality if we first define the-    following operator that is the point-free counterpart to 'for':--@- (~>) :: Monad m-      => (a -> 'Producer' b m ())-      -> (b -> 'Producer' c m ())-      -> (a -> 'Producer' c m ())- (f ~> g) x = for (f x) g-@--    Using ('~>') (pronounced \"into\"), we can transform our original equality-    into the following more symmetric equation:--@- f :: Monad m => a -> 'Producer' b m ()- g :: Monad m => b -> 'Producer' c m ()- h :: Monad m => c -> 'Producer' d m ()--\ \-\- Associativity- (f ~> g) ~> h = f ~> (g ~> h)-@--    This looks just like an associativity law.  In fact, ('~>') has another nice-    property, which is that 'yield' is its left and right identity:--> -- Left Identity-> yield ~> f = f--> -- Right Identity-> f ~> yield = f--    In other words, 'yield' and ('~>') form a 'Category', specifically the-    generator category, where ('~>') plays the role of the composition operator-    and 'yield' is the identity.  If you don't know what a 'Category' is, that's-    okay, and category theory is not a prerequisite for using @pipes@.  All you-    really need to know is that @pipes@ uses some simple category theory to keep-    the API intuitive and easy to use.--    Notice that if we translate the left identity law to use 'for' instead of-    ('~>') we get:--> for (yield x) f = f x--    This just says that if you iterate over a pure single-element 'Producer',-    then you could instead cut out the middle man and directly apply the body of-    the loop to that single element.--    If we translate the right identity law to use 'for' instead of ('~>') we-    get:--> for s yield = s--    This just says that if the only thing you do is re-'yield' every element of-    a stream, you get back your original stream.--    These three \"for loop\" laws summarize our intuition for how 'for' loops-    should behave and because these are 'Category' laws in disguise that means-    that 'Producer's are composable in a rigorous sense of the word.--    In fact, we get more out of this than just a bunch of equations.  We also-    get a useful operator: ('~>').  We can use this operator to condense-    our original code into the following more succinct form that composes two-    transformations:--> main = runEffect $ for P.stdinLn (duplicate ~> lift . putStrLn)--    This means that we can also choose to program in a more functional style and-    think of stream processing in terms of composing transformations using-    ('~>') instead of nesting a bunch of 'for' loops.--    The above example is a microcosm of the design philosophy behind the @pipes@-    library:--    * Define the API in terms of categories--    * Specify expected behavior in terms of category laws--    * Think compositionally instead of sequentially--}--{- $consumers-    Sometimes you don't want to use a 'for' loop because you don't want to consume-    every element of a 'Producer' or because you don't want to process every-    value of a 'Producer' the exact same way.--    The most general solution is to externally iterate over the 'Producer' using-    the 'next' command:--@- 'next' :: 'Monad' m => 'Producer' a m r -> m ('Either' r (a, 'Producer' a m r))-@--    Think of 'next' as pattern matching on the head of the 'Producer'.  This-    'Either' returns a 'Left' if the 'Producer' is done or it returns a 'Right'-    containing the next value, @a@, along with the remainder of the 'Producer'.--    However, sometimes we can get away with something a little more simple and-    elegant, like a 'Consumer', which represents an effectful sink of values.  A-    'Consumer' is a monad transformer that extends the base monad with a new-    'await' command. This 'await' command lets you receive input from an-    anonymous upstream source.--    The following @stdoutLn@ 'Consumer' shows how to incrementally 'await'-    'String's and print them to standard output, terminating gracefully when-    receiving a broken pipe error:--> import Control.Monad (unless)-> import Control.Exception (try, throwIO)-> import qualified GHC.IO.Exception as G-> import Pipes->-> --          +--------+-- A 'Consumer' that awaits 'String's-> --          |        |-> --          v        v-> stdoutLn :: Consumer String IO ()-> stdoutLn = do->     str <- await  -- 'await' a 'String'->     x   <- lift $ try $ putStrLn str->     case x of->         -- Gracefully terminate if we got a broken pipe error->         Left e@(G.IOError { G.ioe_type = t}) ->->             lift $ unless (t == G.ResourceVanished) $ throwIO e->         -- Otherwise loop->         Right () -> stdoutLn--    'await' is the dual of 'yield': we suspend our 'Consumer' until we receive a-    new value.  If nobody provides a value (which is possible) then 'await'-    never returns.  You can think of 'await' as having the following type:--@- 'await' :: 'Monad' m => 'Consumer' a m a-@--    One way to feed a 'Consumer' is to repeatedly feed the same input using-    ('>~') (pronounced \"feed\"):--@- \-\-                 +- Feed       +- Consumer to    +- Returns new- \-\-                 |  action     |  feed           |  Effect- \-\-                 v             v                 v  - \-\-                 ----------    --------------    ----------- ('>~') :: 'Monad' m => 'Effect' m b -> 'Consumer' b m c -> 'Effect' m c-@--    @(draw >~ consumer)@ loops over @(consumer)@, substituting each 'await' in-    @(consumer)@ with @(draw)@.--    So the following code replaces every 'await' in 'P.stdoutLn' with-    @(lift getLine)@ and then removes all the 'lift's:-->>> runEffect $ lift getLine >~ stdoutLn-Test<Enter>-Test-ABC<Enter>-ABC-42<Enter>-42-...--    You might wonder why ('>~') uses an 'Effect' instead of a raw action in the-    base monad.  The reason why is that ('>~') actually permits the following-    more general type:--@- ('>~') :: 'Monad' m => 'Consumer' a m b -> 'Consumer' b m c -> 'Consumer' a m c-@--    ('>~') is the dual of ('~>'), composing 'Consumer's instead of 'Producer's.--    This means that you can feed a 'Consumer' with yet another 'Consumer' so-    that you can 'await' while you 'await'.  For example, we could define the-    following intermediate 'Consumer' that requests two 'String's and returns-    them concatenated:--> doubleUp :: Monad m => Consumer String m String-> doubleUp = do->     str1 <- await->     str2 <- await->     return (str1 ++ str2)->-> -- more concise: doubleUp = (++) <$> await <*> await--    We can now insert this in between @(lift getLine)@ and @stdoutLn@ and see-    what happens:-->>> runEffect $ lift getLine >~ doubleUp >~ stdoutLn-Test<Enter>-ing<Enter>-Testing-ABC<Enter>-DEF<Enter>-ABCDEF-42<Enter>-000<Enter>-42000-...--    'doubleUp' splits every request from 'stdoutLn' into two separate requests-    and-    returns back the concatenated result.--    We didn't need to parenthesize the above chain of ('>~') operators, because-    ('>~') is associative:--> -- Associativity-> (f >~ g) >~ h = f >~ (g >~ h)--    ... so we can always omit the parentheses since the meaning is unambiguous:--> f >~ g >~ h--    Also, ('>~') has an identity, which is 'await'!--> -- Left identity-> await >~ f = f->-> -- Right Identity-> f >~ await = f--    In other words, ('>~') and 'await' form a 'Category', too, specifically the-    iteratee category, and 'Consumer's are also composable.--}--{- $pipes-    Our previous programs were unsatisfactory because they were biased either-    towards the 'Producer' end or the 'Consumer' end.  As a result, we had to-    choose between gracefully handling end of input (using 'P.stdinLn') or-    gracefully handling end of output (using 'P.stdoutLn'), but not both at the-    same time.--    However, we don't need to restrict ourselves to using 'Producer's-    exclusively or 'Consumer's exclusively.  We can connect 'Producer's and-    'Consumer's directly together using ('>->') (pronounced \"pipe\"):--@- ('>->') :: 'Monad' m => 'Producer' a m r -> 'Consumer' a m r -> 'Effect' m r-@--    This returns an 'Effect' which we can run:--> -- echo2.hs->-> import Pipes-> import qualified Pipes.Prelude as P  -- Pipes.Prelude also provides 'stdoutLn'->-> main = runEffect $ P.stdinLn >-> P.stdoutLn--    This program is more declarative of our intent: we want to stream values-    from 'P.stdinLn' to 'P.stdoutLn'.  The above \"pipeline\" not only echoes-    standard input to standard output, but also handles both end of input and-    broken pipe errors:--> $ ./echo2-> Test<Enter>-> Test-> ABC<Enter>-> ABC-> 42<Enter>-> 42-> <Ctrl-D>-> $--    ('>->') is \"pull-based\" meaning that control flow begins at the most-    downstream component (i.e. 'P.stdoutLn' in the above example).  Any time a-    component 'await's a value it blocks and transfers control upstream and-    every time a component 'yield's a value it blocks and restores control back-    downstream, satisfying the 'await'.  So in the above example, ('>->')-    matches every 'await' from 'P.stdoutLn' with a 'yield' from 'P.stdinLn'.--    Streaming stops when either 'P.stdinLn' terminates (i.e. end of input) or-    'P.stdoutLn' terminates (i.e. broken pipe).  This is why ('>->') requires-    that both the 'Producer' and 'Consumer' share the same type of return value:-    whichever one terminates first provides the return value for the entire-    'Effect'.--    Let's test this by modifying our 'Producer' and 'Consumer' to each return a-    diagnostic 'String':--> -- echo3.hs->-> import Control.Applicative ((<$))  -- (<$) modifies return values-> import Pipes-> import qualified Pipes.Prelude as P-> import System.IO->-> main = do->     hSetBuffering stdout NoBuffering->     str <- runEffect $->         ("End of input!" <$ P.stdinLn) >-> ("Broken pipe!" <$ P.stdoutLn)->     hPutStrLn stderr str--    This lets us diagnose whether the 'Producer' or 'Consumer' terminated first:--> $ ./echo3-> Test<Enter>-> Test-> <Ctrl-D>-> End of input!-> $ ./echo3 | perl -e 'close STDIN'-> Test<Enter>-> Broken pipe!-> $--    You might wonder why ('>->') returns an 'Effect' that we have to run instead-    of directly returning an action in the base monad.  This is because you can-    connect things other than 'Producer's and 'Consumer's, like 'Pipe's, which-    are effectful stream transformations.--    A 'Pipe' is a monad transformer that is a mix between a 'Producer' and-    'Consumer', because a 'Pipe' can both 'await' and 'yield'.  The following-    example 'Pipe' is analagous to the Prelude's 'take', only allowing a fixed-    number of values to flow through:--> -- take.hs->-> import Control.Monad (replicateM_)-> import Pipes-> import Prelude hiding (take)->-> --              +--------- A 'Pipe' that-> --              |    +---- 'await's 'a's and-> --              |    | +-- 'yield's 'a's-> --              |    | |-> --              v    v v-> take ::  Int -> Pipe a a IO ()-> take n = do->     replicateM_ n $ do                     -- Repeat this block 'n' times->         x <- await                         -- 'await' a value of type 'a'->         yield x                            -- 'yield' a value of type 'a'->     lift $ putStrLn "You shall not pass!"  -- Fly, you fools!--    You can use 'Pipe's to transform 'Producer's, 'Consumer's, or even other-    'Pipe's using the same ('>->') operator:--@- ('>->') :: 'Monad' m => 'Producer' a m r -> 'Pipe'   a b m r -> 'Producer' b m r- ('>->') :: 'Monad' m => 'Pipe'   a b m r -> 'Consumer' b m r -> 'Consumer' a m r- ('>->') :: 'Monad' m => 'Pipe'   a b m r -> 'Pipe'   b c m r -> 'Pipe'   a c m r-@--    For example, you can compose 'P.take' after 'P.stdinLn' to limit the number-    of lines drawn from standard input:--> maxInput :: Int -> Producer String IO ()-> maxInput n = P.stdinLn >-> take n-->>> runEffect $ maxInput 3 >-> P.stdoutLn-Test<Enter>-Test-ABC<Enter>-ABC-42<Enter>-42-You shall not pass!->>>--    ... or you can pre-compose 'P.take' before 'P.stdoutLn' to limit the number-    of lines written to standard output:--> maxOutput :: Int -> Consumer String IO ()-> maxOutput n = take n >-> P.stdoutLn-->>> runEffect $ P.stdinLn >-> maxOutput 3-<Exact same behavior>--    Those both gave the same behavior because ('>->') is associative:--> (p1 >-> p2) >-> p3 = p1 >-> (p2 >-> p3)--    Therefore we can just leave out the parentheses:-->>> runEffect $ P.stdinLn >-> take 3 >-> P.stdoutLn-<Exact same behavior>--    ('>->') is designed to behave like the Unix pipe operator, except with less-    quirks.  In fact, we can continue the analogy to Unix by defining 'cat'-    (named after the Unix @cat@ utility), which reforwards elements endlessly:--> cat :: Monad m => Pipe a a m r-> cat = forever $ do->     x <- await->     yield x--     'cat' is the identity of ('>->'), meaning that 'cat' satisfies the-     following two laws:--> -- Useless use of 'cat'-> cat >-> p = p->-> -- Forwarding output to 'cat' does nothing-> p >-> cat = p--    Therefore, ('>->') and 'cat' form a 'Category', specifically the category of-    Unix pipes, and 'Pipe's are also composable.--    A lot of Unix tools have very simple definitions when written using @pipes@:--> -- unix.hs->-> import Control.Monad (forever)-> import Pipes-> import qualified Pipes.Prelude as P  -- Pipes.Prelude provides 'take', too-> import Prelude hiding (head)->-> head :: Monad m => Int -> Pipe a a m ()-> head = P.take->-> yes :: Monad m => Producer String m r-> yes = forever $ yield "y"->-> main = runEffect $ yes >-> head 3 >-> P.stdoutLn--    This prints out 3 \'@y@\'s, just like the equivalent Unix pipeline:--> $ ./unix-> y-> y-> y-> $ yes | head -3-> y-> y-> y-> $--    This lets us write \"Haskell pipes\" instead of Unix pipes.  These are much-    easier to build than Unix pipes and we can connect them directly within-    Haskell for interoperability with the Haskell language and ecosystem.--}--{- $listT-    @pipes@ also provides a \"ListT done right\" implementation.  This differs-    from the implementation in @transformers@ because this 'ListT':--    * obeys the monad laws, and--    * streams data immediately instead of collecting all results into memory.--    The latter property is actually an elegant consequence of obeying the monad-    laws.--    To bind a list within a 'ListT' computation, combine 'Select' and 'each':--> import Pipes-> -> pair :: ListT IO (Int, Int)-> pair = do->     x <- Select $ each [1, 2]->     lift $ putStrLn $ "x = " ++ show x->     y <- Select $ each [3, 4]->     lift $ putStrLn $ "y = " ++ show y->     return (x, y)--    You can then loop over a 'ListT' by using 'every':--@- 'every' :: 'Monad' m => 'ListT' m a -> 'Producer' a m ()-@--    So you can use your 'ListT' within a 'for' loop:-->>> runEffect $ for (every pair) (lift . print)-x = 1-y = 3-(1,3)-y = 4-(1,4)-x = 2-y = 3-(2,3)-y = 4-(2,4)--    ... or a pipeline:-->>> import qualified Pipes.Prelude as P->>> runEffect $ every pair >-> P.print-<Exact same behavior>--    Note that 'ListT' is lazy and only produces as many elements as we request:-->>> runEffect $ for (every pair >-> P.take 2) (lift . print)-x = 1-y = 3-(1,3)-y = 4-(1,4)--    You can also go the other way, binding 'Producer's directly within a-    'ListT'.  In fact, this is actually what 'Select' was already doing:--@- 'Select' :: 'Producer' a m () -> 'ListT' m a-@--    This lets you write crazy code like:--> import Pipes-> import qualified Pipes.Prelude as P-> -> input :: Producer String IO ()-> input = P.stdinLn >-> P.takeWhile (/= "quit")-> -> name :: ListT IO String-> name = do->     firstName <- Select input->     lastName  <- Select input->     return (firstName ++ " " ++ lastName)--    Here we're binding standard input non-deterministically (twice) as if it-    were an effectful list:-->>> runEffect $ every name >-> P.stdoutLn-Daniel<Enter>-Fischer<Enter>-Daniel Fischer-Wagner<Enter>-Daniel Wagner-quit<Enter>-Donald<Enter>-Stewart<Enter>-Donald Stewart-Duck<Enter>-Donald Duck-quit<Enter>-quit<Enter>->>>--    Notice how this streams out values immediately as they are generated, rather-    than building up a large intermediate result and then printing all the-    values in one batch at the end.--}--{- $tricks-    @pipes@ is more powerful than meets the eye so this section presents some-    non-obvious tricks you may find useful.--    Many pipe combinators will work on unusual pipe types and the next few-    examples will use the 'cat' pipe to demonstrate this.--    For example, you can loop over the output of a 'Pipe' using 'for', which is-    how 'P.map' is defined:--> map :: Monad m => (a -> b) -> Pipe a b m r-> map f = for cat $ \x -> yield (f x)->-> -- Read this as: For all values flowing downstream, apply 'f'--    This is equivalent to:--> map f = forever $ do->     x <- await->     yield (f x)--    You can also feed a 'Pipe' input using ('>~').  This means we could have-    instead defined the @yes@ pipe like this:--> yes :: Monad m => Producer String m r-> yes = return "y" >~ cat->-> -- Read this as: Keep feeding "y" downstream--    This is equivalent to:--> yes = forever $ yield "y"--    You can also sequence two 'Pipe's together.  This is how 'P.drop' is-    defined:--> drop :: Monad m => Int -> Pipe a a m r-> drop n = do->     replicateM_ n await->     cat--    This is equivalent to:--> drop n = do->     replicateM_ n await->     forever $ do->         x <- await->         yield x--    You can even compose pipes inside of another pipe:--> customerService :: Producer String IO ()-> customerService = do->     each [ "Hello, how can I help you?"        -- Begin with a script->          , "Hold for one second."->          ]->     P.stdinLn >-> P.takeWhile (/= "Goodbye!")  -- Now continue with a human--    Also, you can often use 'each' in conjunction with ('~>') to traverse nested-    data structures.  For example, you can print all non-'Nothing' elements-    from a doubly-nested list:-->>> runEffect $ (each ~> each ~> each ~> lift . print) [[Just 1, Nothing], [Just 2, Just 3]]-1-2-3--    Another neat thing to know is that 'every' has a more general type:--@- 'every' :: ('Monad' m, 'Enumerable' t) => t m a -> 'Producer' a m ()-@--    'Enumerable' generalizes 'Foldable' and if you have an effectful container-    of your own that you want others to traverse using @pipes@, just have your-    container implement the 'toListT' method of the 'Enumerable' class:--> class Enumerable t where->     toListT :: Monad m => t m a -> ListT m a--    You can even use 'Enumerable' to traverse effectful types that are not even-    proper containers, like 'Control.Monad.Trans.Maybe.MaybeT':--> input :: MaybeT IO String-> input = do->     str <- lift getLine->     guard (str /= "Fail")->     return str-->>> runEffect $ every input >-> P.stdoutLn-Test<Enter>-Test->>> runEffect $ every input >-> P.stdoutLn-Fail<Enter>->>>---}--{- $conclusion-    This tutorial covers the concepts of connecting, building, and reading-    @pipes@ code.  However, this library is only the core component in an-    ecosystem of streaming components.  Derived libraries that build immediately-    upon @pipes@ include:--    * @pipes-concurrency@: Concurrent reactive programming and message passing--    * @pipes-parse@: Minimal utilities for stream parsing--    * @pipes-safe@: Resource management and exception safety for @pipes@--    * @pipes-group@: Grouping streams in constant space--    These libraries provide functionality specialized to common streaming-    domains.  Additionally, there are several libraries on Hackage that provide-    even higher-level functionality, which you can find by searching under the-    \"Pipes\" category or by looking for packages with a @pipes-@ prefix in-    their name.  Current examples include:--    * @pipes-extras@: Miscellaneous utilities--    * @pipes-network@/@pipes-network-tls@: Networking--    * @pipes-zlib@: Compression and decompression--    * @pipes-binary@: Binary serialization--    * @pipes-attoparsec@: High-performance parsing--    * @pipes-aeson@: JSON serialization and deserialization--    Even these derived packages still do not explore the full potential of-    @pipes@ functionality, which actually permits bidirectional communication.-    Advanced @pipes@ users can explore this library in greater detail by-    studying the documentation in the "Pipes.Core" module to learn about the-    symmetry of the underlying 'Proxy' type and operators.--    To learn more about @pipes@, ask questions, or follow @pipes@ development,-    you can subscribe to the @haskell-pipes@ mailing list at:--    <https://groups.google.com/forum/#!forum/haskell-pipes>--    ... or you can mail the list directly at:--    <mailto:haskell-pipes@googlegroups.com>--    Additionally, for questions regarding types or type errors, you might find-    the following appendix on types very useful.--}--{- $types-    @pipes@ uses parametric polymorphism (i.e. generics) to overload all-    operations.  You've probably noticed this overloading already::--    * 'yield' works within both 'Producer's and 'Pipe's--    * 'await' works within both 'Consumer's and 'Pipe's--    * ('>->') connects 'Producer's, 'Consumer's, and 'Pipe's in varying ways--    This overloading is great when it works, but when connections fail they-    produce type errors that appear intimidating at first.  This section-    explains the underlying types so that you can work through type errors-    intelligently.--    'Producer's, 'Consumer's, 'Pipe's, and 'Effect's are all special cases of a-    single underlying type: a 'Proxy'.  This overarching type permits fully-    bidirectional communication on both an upstream and downstream interface.-    You can think of it as having the following shape:--> Proxy a' a b' b m r->-> Upstream | Downstream->     +---------+->     |         |-> a' <==       <== b'  -- Information flowing upstream->     |         |-> a  ==>       ==> b   -- Information flowing downstream->     |    |    |->     +----|----+->          v->          r--    The four core types do not use the upstream flow of information.  This means-    that the @a'@ and @b'@ in the above diagram go unused unless you use the-    more advanced features provided in "Pipes.Core".--    @pipes@ uses type synonyms to hide unused inputs or outputs and clean up-    type signatures.  These type synonyms come in two flavors:--    * Concrete type synonyms that explicitly close unused inputs and outputs of-      the 'Proxy' type--    * Polymorphic type synonyms that don't explicitly close unused inputs or-      outputs--    The concrete type synonyms use @()@ to close unused inputs and 'X' (the-    uninhabited type) to close unused outputs:--    * 'Effect': explicitly closes both ends, forbidding 'await's and 'yield's--> type Effect = Proxy X () () X->->  Upstream | Downstream->     +---------+->     |         |-> X  <==       <== ()->     |         |-> () ==>       ==> X->     |    |    |->     +----|----+->          v->          r--    * 'Producer': explicitly closes the upstream end, forbidding 'await's--> type Producer b = Proxy X () () b->-> Upstream | Downstream->     +---------+->     |         |-> X  <==       <== ()->     |         |-> () ==>       ==> b->     |    |    |->     +----|----+->          v->          r--    * 'Consumer': explicitly closes the downstream end, forbidding 'yield's--> type Consumer a = Proxy () a () X->-> Upstream | Downstream->     +---------+->     |         |-> () <==       <== ()->     |         |-> a  ==>       ==> X->     |    |    |->     +----|----+->          v->          r--    * 'Pipe': marks both ends open, allowing both 'await's and 'yield's--> type Pipe a b = Proxy () a () b->-> Upstream | Downstream->     +---------+->     |         |-> () <==       <== ()->     |         |-> a  ==>       ==> b->     |    |    |->     +----|----+->          v->          r--    When you compose 'Proxy's using ('>->') all you are doing is placing them-    side by side and fusing them laterally.  For example, when you compose a-    'Producer', 'Pipe', and a 'Consumer', you can think of information flowing-    like this:-->        Producer                Pipe                 Consumer->     +-----------+          +----------+          +------------+->     |           |          |          |          |            |-> X  <==         <==   ()   <==        <==   ()   <==          <== ()->     |  stdinLn  |          |  take 3  |          |  stdoutLn  |-> () ==>         ==> String ==>        ==> String ==>          ==> X->     |     |     |          |    |     |          |      |     |->     +-----|-----+          +----|-----+          +------|-----+->           v                     v                       v->           ()                    ()                      ()--     Composition fuses away the intermediate interfaces, leaving behind an-     'Effect':-->                    Effect->     +-----------------------------------+->     |                                   |-> X  <==                                 <== ()->     |  stdinLn >-> take 3 >-> stdoutLn  |-> () ==>                                 ==> X->     |                                   |->     +----------------|------------------+->                      v->                      ()--    @pipes@ also provides polymorphic type synonyms with apostrophes at the end-    of their names.  These use universal quantification to leave open any unused-    input or output ends (which I mark using @*@):--    * 'Producer'': marks the upstream end unused but still open--> type Producer' b m r = forall x' x . Proxy x' x () b m r->-> Upstream | Downstream->     +---------+->     |         |->  * <==       <== ()->     |         |->  * ==>       ==> b->     |    |    |->     +----|----+->          v->          r--    * 'Consumer'': marks the downstream end unused but still open--> type Consumer' a m r = forall y' y . Proxy () a y' y m r->-> Upstream | Downstream->     +---------+->     |         |-> () <==       <== * ->     |         |-> a  ==>       ==> *->     |    |    |->     +----|----+->          v->          r--    * 'Effect'': marks both ends unused but still open--> type Effect' m r = forall x' x y' y . Proxy x' x y' y m r->-> Upstream | Downstream->     +---------+->     |         |->  * <==       <== * ->     |         |->  * ==>       ==> *->     |    |    |->     +----|----+->          v->          r--    Note that there is no polymorphic generalization of a 'Pipe'.--    Like before, if you compose a 'Producer'', a 'Pipe', and a 'Consumer'':-->        Producer'               Pipe                 Consumer'->     +-----------+          +----------+          +------------+->     |           |          |          |          |            |->  * <==         <==   ()   <==        <==   ()   <==          <== *->     |  stdinLn  |          |  take 3  |          |  stdoutLn  |->  * ==>         ==> String ==>        ==> String ==>          ==> *->     |     |     |          |     |    |          |      |     |->     +-----|-----+          +-----|----+          +------|-----+->           v                      v                      v->           ()                     ()                     ()--    ... they fuse into an 'Effect'':-->                    Effect'->     +-----------------------------------+->     |                                   |->  * <==                                 <== *->     |  stdinLn >-> take 3 >-> stdoutLn  |->  * ==>                                 ==> *->     |                                   |->     +----------------|------------------+->                      v->                      ()--    Polymorphic type synonyms come in handy when you want to keep the type as-    general as possible.  For example, the type signature for 'yield' uses-    'Producer'' to keep the type signature simple while still leaving the-    upstream input end open:--@- 'yield' :: 'Monad' m => a -> 'Producer'' a m ()-@--    This type signature lets us use 'yield' within a 'Pipe', too, because the-    'Pipe' type synonym is a special case of the polymorphic 'Producer'' type -    synonym:--@- type 'Producer'' b m r = forall x' x . 'Proxy' x' x () b m r- type 'Pipe'    a b m r =               'Proxy' () a () b m r-@--    The same is true for 'await', which uses the polymorphic 'Consumer'' type-    synonym:--@- 'await' :: 'Monad' m => 'Consumer'' a m a-@--    We can use 'await' within a 'Pipe' because a 'Pipe' is a special case of the-    polymorphic 'Consumer'' type synonym:--@- type 'Consumer'' a   m r = forall y' y . 'Proxy' () a y' y m r- type 'Pipe'      a b m r =               'Proxy' () a () b m r-@--    However, polymorphic type synonyms cause problems in many other cases:--    * They usually give the wrong behavior when used as the argument of a-      function (known as the \"negative\" or \"contravariant\" position) like-      this:--> f :: Producer' a m r -> ...  -- Wrong->-> f :: Producer  a m r -> ...  -- Right--      The former function only accepts polymorphic 'Producer's as arguments.-      The latter function accepts both polymorphic and concrete 'Producer's,-      which is probably what you want.--    * Even when you desire a polymorphic argument, this induces a higher-ranked-      type, because it translates to a @forall@ which you cannot factor out to-      the top-level to simplify the type signature:--> f :: (forall x' x y' . Proxy x' x y' m r) -> ...--      These kinds of type signatures require the @RankNTypes@ extension.--    * Even when you have polymorphic type synonyms as the result of a function-      (i.e.  the \"positive\" or \"covariant\" position), recent versions of-      @ghc@ such still require the @RankNTypes@ extension.  For example, the-      'Pipes.Prelude.fromHandle' function from "Pipes.Prelude" requires-      @RankNTypes@ to compile correctly on @ghc-7.6.3@:--> fromHandle :: MonadIO m => Handle -> Producer' String m ()--    * You can't use polymorphic type synonyms inside other type constructors-      without the @ImpredicativeTypes@ extension:--> io :: IO (Producer' a m r)  -- Type error without ImpredicativeTypes--    * You can't partially apply polymorphic type synonyms:--> stack :: MaybeT (Producer' a m) r  -- Type error--    In these scenarios you should fall back on the concrete type synonyms, which-    are better behaved.  If concrete type synonyms are unsatisfactory, then ask-    @ghc@ to infer the most general type signature and use that.--    For the purposes of debugging type errors you can just remember that:-->  Input --+    +-- Output->          |    |->          v    v-> Proxy a' a b' b m r->       ^    ^->       |    |->       +----+-- Ignore these--    For example, let's say that you try to run the 'P.stdinLn' 'Producer'.  This-    produces the following type error:-->>> runEffect P.stdinLn-<interactive>:4:5:-    Couldn't match expected type `X' with actual type `String'-    Expected type: Effect m0 r0-      Actual type: Proxy X () () String IO ()-    In the first argument of `runEffect', namely `P.stdinLn'-    In the expression: runEffect P.stdinLn--    'runEffect' expects an 'Effect', which is equivalent to the following type:--> Effect          IO () = Proxy X () () X      IO ()--    ... but 'P.stdinLn' type-checks as a 'Producer', which has the following-    type:--> Producer String IO () = Proxy X () () String IO ()--    The fourth type variable (the output) does not match.  For an 'Effect' this-    type variable should be closed (i.e. 'X'), but 'P.stdinLn' has a 'String'-    output, thus the type error:-->    Couldn't match expected type `X' with actual type `String'--    Any time you get type errors like these you can work through them by-    expanding out the type synonyms and seeing which type variables do not-    match.--    You may also consult this table of type synonyms to more easily compare-    them:--> type Effect             = Proxy X  () () X-> type Producer         b = Proxy X  () () b-> type Consumer    a      = Proxy () a  () X-> type Pipe        a    b = Proxy () a  () b->-> type Server        b' b = Proxy X  () b' b -> type Client   a' a      = Proxy a' a  () X->-> type Effect'            m r = forall x' x y' y . Proxy x' x y' y m r-> type Producer'        b m r = forall x' x      . Proxy x' x () b m r-> type Consumer'   a      m r = forall      y' y . Proxy () a y' y m r->-> type Server'       b' b m r = forall x' x      . Proxy x' x b' b m r-> type Client'  a' a      m r = forall      y' y . Proxy a' a y' y m r---}--{- $timecomplexity-    There are three functions that give quadratic time complexity when used in-    within @pipes@:--    * 'sequence'--    * 'replicateM'--    * 'mapM'--    For example, the time complexity of this code segment scales quadratically-    with `n`:--> import Control.Monad (replicateM)-> import Pipes->-> quadratic :: Int -> Consumer a m [a]-> quadratic n = replicateM n await--    These three functions are generally bad practice to use, because all three-    of them correspond to \"ListT done wrong\", building a list in memory-    instead of streaming results.--    However, sometimes situations arise where one deliberately intends to build-    a list in memory.  The solution is to use the \"codensity transformation\"-    to transform the code to run with linear time complexity.  This involves:--    * wrapping the code in the @Codensity@ monad transformer (from-      @Control.Monad.Codensity@ module of the @kan-extensions@ package) using-      'lift'--    * applying 'sequence' \/ 'replicateM' \/ 'mapM'--    * unwrapping the code using @lowerCodensity@--    To illustrate this, we'd transform the above example to:--> import Control.Monad.Codensity (lowerCodensity)-> -> linear :: Monad m => Int -> Consumer a m [a]-> linear n = lowerCodensity $ replicateM n $ lift await--    This will produce the exact same result, but in linear time.--}+{-# OPTIONS_GHC -fno-warn-unused-imports #-}
+
+{-| Conventional Haskell stream programming forces you to choose only two of the
+    following three features:
+
+    * Effects
+
+    * Streaming
+
+    * Composability
+
+    If you sacrifice /Effects/ you get Haskell's pure and lazy lists, which you
+    can transform using composable functions in constant space, but without
+    interleaving effects.
+
+    If you sacrifice /Streaming/ you get 'mapM', 'forM' and
+    \"ListT done wrong\", which are composable and effectful, but do not return
+    a single result until the whole list has first been processed and loaded
+    into memory.
+
+    If you sacrifice /Composability/ you write a tightly coupled read,
+    transform, and write loop in 'IO', which is streaming and effectful, but is
+    not modular or separable.
+
+    @pipes@ gives you all three features: effectful, streaming, and composable
+    programming.  @pipes@ also provides a wide variety of stream programming
+    abstractions which are all subsets of a single unified machinery:
+
+    * effectful 'Producer's (like generators),
+
+    * effectful 'Consumer's (like iteratees),
+
+    * effectful 'Pipe's (like Unix pipes), and:
+
+    * 'ListT' done right.
+
+    All of these are connectable and you can combine them together in clever and
+    unexpected ways because they all share the same underlying type.
+
+    @pipes@ requires a basic understanding of monad transformers, which you can
+    learn about by reading either:
+
+    * the paper \"Monad Transformers - Step by Step\",
+
+    * chapter 18 of \"Real World Haskell\" on monad transformers, or:
+
+    * the documentation of the @transformers@ library.
+
+    If you want a Quick Start guide to @pipes@, read the documentation in
+    "Pipes.Prelude" from top to bottom.
+
+    This tutorial is more extensive and explains the @pipes@ API in greater
+    detail and illustrates several idioms.
+-}
+
+module Pipes.Tutorial (
+    -- * Introduction
+    -- $introduction
+
+    -- * Producers
+    -- $producers
+
+    -- * Composability
+    -- $composability
+
+    -- * Consumers
+    -- $consumers
+
+    -- * Pipes
+    -- $pipes
+
+    -- * ListT
+    -- $listT
+
+    -- * Tricks
+    -- $tricks
+
+    -- * Conclusion
+    -- $conclusion
+
+    -- * Appendix: Types
+    -- $types
+
+    -- * Appendix: Time Complexity
+    -- $timecomplexity
+
+    -- * Copyright
+    -- $copyright
+    ) where
+
+import Control.Category
+import Control.Monad
+import Control.Monad.Trans.Error
+import Control.Monad.Trans.Writer.Strict
+import Pipes
+import Pipes.Lift
+import qualified Pipes.Prelude as P
+import Prelude hiding ((.), id)
+
+{- $introduction
+    The @pipes@ library decouples stream processing stages from each other so
+    that you can mix and match diverse stages to produce useful streaming
+    programs.  If you are a library writer, @pipes@ lets you package up
+    streaming components into a reusable interface.  If you are an application
+    writer, @pipes@ lets you connect pre-made streaming components with minimal
+    effort to produce a highly-efficient program that streams data in constant
+    memory.
+
+    To enforce loose coupling, components can only communicate using two
+    commands:
+
+    * 'yield': Send output data
+
+    * 'await': Receive input data
+
+    @pipes@ has four types of components built around these two commands:
+
+    * 'Producer's can only 'yield' values and they model streaming sources
+
+    * 'Consumer's can only 'await' values and they model streaming sinks
+
+    * 'Pipe's can both 'yield' and 'await' values and they model stream
+      transformations
+
+    * 'Effect's can neither 'yield' nor 'await' and they model non-streaming
+      components
+
+    You can connect these components together in four separate ways which
+    parallel the four above types:
+
+    * 'for' handles 'yield's
+
+    * ('>~') handles 'await's
+
+    * ('>->') handles both 'yield's and 'await's
+
+    * ('>>=') handles return values
+
+    As you connect components their types will change to reflect inputs and
+    outputs that you've fused away.  You know that you're done connecting things
+    when you get an 'Effect', meaning that you have handled all inputs and
+    outputs.  You run this final 'Effect' to begin streaming.
+-}
+
+{- $producers
+    'Producer's are effectful streams of input.  Specifically, a 'Producer' is a
+    monad transformer that extends any base monad with a new 'yield' command.
+    This 'yield' command lets you send output downstream to an anonymous
+    handler, decoupling how you generate values from how you consume them.
+
+    The following @stdinLn@ 'Producer' shows how to incrementally read in
+    'String's from standard input and 'yield' them downstream, terminating
+    gracefully when reaching the end of the input:
+
+> -- echo.hs
+>
+> import Control.Monad (unless)
+> import Pipes
+> import System.IO (isEOF)
+>
+> --         +--------+-- A 'Producer' that yields 'String's
+> --         |        |
+> --         |        |      +-- Every monad transformer has a base monad.
+> --         |        |      |   This time the base monad is 'IO'.
+> --         |        |      |  
+> --         |        |      |  +-- Every monadic action has a return value.
+> --         |        |      |  |   This action returns '()' when finished
+> --         v        v      v  v
+> stdinLn :: Producer String IO ()
+> stdinLn = do
+>     eof <- lift isEOF        -- 'lift' an 'IO' action from the base monad
+>     unless eof $ do
+>         str <- lift getLine
+>         yield str            -- 'yield' the 'String'
+>         stdinLn              -- Loop
+
+    'yield' emits a value, suspending the current 'Producer' until the value is
+    consumed.  If nobody consumes the value (which is possible) then 'yield'
+    never returns.  You can think of 'yield' as having the following type:
+
+@
+ 'yield' :: 'Monad' m => a -> 'Producer' a m ()
+@
+
+    The true type of 'yield' is actually more general and powerful.  Throughout
+    the tutorial I will present type signatures like this that are simplified at
+    first and then later reveal more general versions.  So read the above type
+    signature as simply saying: \"You can use 'yield' within a 'Producer', but
+    you may be able to use 'yield' in other contexts, too.\"
+
+    Click the link to 'yield' to navigate to its documentation.  There you will
+    see that 'yield' actually uses the 'Producer'' (with an apostrophe) type
+    synonym which hides a lot of polymorphism behind a simple veneer.  The
+    documentation for 'yield' says that you can also use 'yield' within a
+    'Pipe', too, because of this polymorphism:
+
+@
+ 'yield' :: 'Monad' m => a -> 'Pipe' x a m ()
+@
+
+    Use simpler types like these to guide you until you understand the fully
+    general type.
+
+    'for' loops are the simplest way to consume a 'Producer' like @stdinLn@.
+    'for' has the following type:
+
+@
+ \-\-                +-- Producer      +-- The body of the   +-- Result
+ \-\-                |   to loop       |   loop              |
+ \-\-                v   over          v                     v
+ \-\-                --------------    ------------------    ----------
+ 'for' :: 'Monad' m => 'Producer' a m r -> (a -> 'Effect' m ()) -> 'Effect' m r
+@
+
+    @(for producer body)@ loops over @(producer)@, substituting each 'yield' in
+    @(producer)@ with @(body)@.
+
+    You can also deduce that behavior purely from the type signature:
+
+    * The body of the loop takes exactly one argument of type @(a)@, which is
+      the same as the output type of the 'Producer'.  Therefore, the body of the
+      loop must get its input from that 'Producer' and nowhere else.
+
+    * The return value of the input 'Producer' matches the return value of the
+      result, therefore 'for' must loop over the entire 'Producer' and not skip
+      anything.
+
+    The above type signature is not the true type of 'for', which is actually
+    more general.  Think of the above type signature as saying: \"If the first
+    argument of 'for' is a 'Producer' and the second argument returns an
+    'Effect', then the final result must be an 'Effect'.\"
+
+    Click the link to 'for' to navigate to its documentation.  There you will
+    see the fully general type and underneath you will see equivalent simpler
+    types.  One of these says that if the body of the loop is a 'Producer', then
+    the result is a 'Producer', too:
+
+@
+ 'for' :: 'Monad' m => 'Producer' a m r -> (a -> 'Producer' b m ()) -> 'Producer' b m r
+@
+
+    The first type signature I showed for 'for' was a special case of this
+    slightly more general signature because a 'Producer' that never 'yield's is
+    also an 'Effect':
+
+@
+ data 'X'  -- The uninhabited type
+
+\ type 'Effect' m r = 'Producer' 'X' m r
+@
+
+    This is why 'for' permits two different type signatures.  The first type
+    signature is just a special case of the second one:
+
+@
+ 'for' :: 'Monad' m => 'Producer' a m r -> (a -> 'Producer' b m ()) -> 'Producer' b m r
+
+\ -- Specialize \'b\' to \'X\'
+ 'for' :: 'Monad' m => 'Producer' a m r -> (a -> 'Producer' 'X' m ()) -> 'Producer' 'X' m r
+
+\ -- Producer X = Effect
+ 'for' :: 'Monad' m => 'Producer' a m r -> (a -> 'Effect'     m ()) -> 'Effect'     m r
+@
+
+    This is the same trick that all @pipes@ functions use to work with various
+    combinations of 'Producer's, 'Consumer's, 'Pipe's, and 'Effect's.  Each
+    function really has just one general type, which you can then simplify down
+    to multiple useful alternative types.
+
+    Here's an example use of a 'for' @loop@, where the second argument (the
+    loop body) is an 'Effect':
+
+> -- echo.hs
+>
+> loop :: Effect IO ()
+> loop = for stdinLn $ \str -> do  -- Read this like: "for str in stdinLn"
+>     lift $ putStrLn str          -- The body of the 'for' loop
+>
+> -- more concise: loop = for stdinLn (lift . putStrLn)
+
+    In this example, 'for' loops over @stdinLn@ and replaces every 'yield' in
+    @stdinLn@ with the body of the loop, printing each line.  This is exactly
+    equivalent to the following code, which I've placed side-by-side with the
+    original definition of @stdinLn@ for comparison:
+
+> loop = do                      |  stdinLn = do
+>     eof <- lift isEOF          |      eof <- lift isEOF
+>     unless eof $ do            |      unless eof $ do
+>         str <- lift getLine    |          str <- lift getLine
+>         (lift . putStrLn) str  |          yield str
+>         loop                   |          stdinLn
+
+    You can think of 'yield' as creating a hole and a 'for' loop is one way to
+    fill that hole.
+
+    Notice how the final @loop@ only 'lift's actions from the base monad and
+    does nothing else.  This property is true for all 'Effect's, which are just
+    glorified wrappers around actions in the base monad.  This means we can run
+    these 'Effect's to remove their 'lift's and lower them back to the
+    equivalent computation in the base monad:
+
+@
+ 'runEffect' :: 'Monad' m => 'Effect' m r -> m r
+@
+
+    This is the real type signature of 'runEffect', which refuses to accept
+    anything other than an 'Effect'.  This ensures that we handle all inputs and
+    outputs before streaming data:
+
+> -- echo.hs
+>
+> main :: IO ()
+> main = runEffect loop
+
+    ... or you could inline the entire @loop@ into the following one-liner:
+
+> main = runEffect $ for stdinLn (lift . putStrLn)
+
+    Our final program loops over standard input and echoes every line to
+    standard output until we hit @Ctrl-D@ to end the input stream:
+
+> $ ghc -O2 echo.hs
+> $ ./echo
+> Test<Enter>
+> Test
+> ABC<Enter>
+> ABC
+> <Ctrl-D>
+> $
+
+    The final behavior is indistinguishable from just removing all the 'lift's
+    from @loop@:
+
+> main = do               |  loop = do
+>     eof <- isEof        |      eof <- lift isEof
+>     unless eof $ do     |      unless eof $ do
+>         str <- getLine  |          str <- lift getLine
+>         putStrLn str    |          (lift . putStrLn) str
+>         main            |          loop
+
+    This @main@ is what we might have written by hand if we were not using
+    @pipes@, but with @pipes@ we can decouple the input and output logic from
+    each other.  When we connect them back together, we still produce streaming
+    code equivalent to what a sufficiently careful Haskell programmer would
+    have written.
+
+    You can also use 'for' to loop over lists, too.  To do so, convert the list
+    to a 'Producer' using 'each', which is exported by default from "Pipes":
+
+> each :: Monad m => [a] -> Producer a m ()
+> each as = mapM_ yield as
+
+    Combine 'for' and 'each' to iterate over lists using a \"foreach\" loop:
+
+>>> runEffect $ for (each [1..4]) (lift . print)
+1
+2
+3
+4
+
+    'each' is actually more general and works for any 'Foldable':
+
+@
+ 'each' :: ('Monad' m, 'Foldable' f) => f a -> 'Producer' a m ()
+@
+
+     So you can loop over any 'Foldable' container or even a 'Maybe':
+
+>>> runEffect $ for (each (Just 1)) (lift . print)
+1
+
+-}
+
+{- $composability
+    You might wonder why the body of a 'for' loop can be a 'Producer'.  Let's
+    test out this feature by defining a new loop body that @duplicate@s every
+    value:
+
+> -- nested.hs
+>
+> import Pipes
+> import qualified Pipes.Prelude as P  -- Pipes.Prelude already has 'stdinLn'
+> 
+> duplicate :: Monad m => a -> Producer a m ()
+> duplicate x = do
+>     yield x
+>     yield x
+>
+> loop :: Producer String IO ()
+> loop = for P.stdinLn duplicate
+>
+> -- This is the exact same as:
+> --
+> -- loop = for P.stdinLn $ \x -> do
+> --     yield x
+> --     yield x
+
+    This time our @loop@ is a 'Producer' that outputs 'String's, specifically
+    two copies of each line that we read from standard input.  Since @loop@ is a
+    'Producer' we cannot run it because there is still unhandled output.
+    However, we can use yet another 'for' to handle this new duplicated stream:
+
+> -- nested.hs
+>
+> main = runEffect $ for loop (lift . putStrLn)
+
+    This creates a program which echoes every line from standard input to
+    standard output twice:
+
+> $ ./nested
+> Test<Enter>
+> Test
+> Test
+> ABC<Enter>
+> ABC
+> ABC
+> <Ctrl-D>
+> $
+
+    But is this really necessary?  Couldn't we have instead written this using a
+    nested for loop?
+
+> main = runEffect $
+>     for P.stdinLn $ \str1 ->
+>         for (duplicate str1) $ \str2 ->
+>             lift $ putStrLn str2
+
+    Yes, we could have!  In fact, this is a special case of the following
+    equality, which always holds no matter what:
+
+@
+ \-\- s :: Monad m =>      'Producer' a m ()  -- i.e. \'P.stdinLn\'
+ \-\- f :: Monad m => a -> 'Producer' b m ()  -- i.e. \'duplicate\'
+ \-\- g :: Monad m => b -> 'Producer' c m ()  -- i.e. \'(lift . putStrLn)\'
+
+\ for (for s f) g = for s (\\x -> for (f x) g)
+@
+
+    We can understand the rationale behind this equality if we first define the
+    following operator that is the point-free counterpart to 'for':
+
+@
+ (~>) :: Monad m
+      => (a -> 'Producer' b m ())
+      -> (b -> 'Producer' c m ())
+      -> (a -> 'Producer' c m ())
+ (f ~> g) x = for (f x) g
+@
+
+    Using ('~>') (pronounced \"into\"), we can transform our original equality
+    into the following more symmetric equation:
+
+@
+ f :: Monad m => a -> 'Producer' b m ()
+ g :: Monad m => b -> 'Producer' c m ()
+ h :: Monad m => c -> 'Producer' d m ()
+
+\ \-\- Associativity
+ (f ~> g) ~> h = f ~> (g ~> h)
+@
+
+    This looks just like an associativity law.  In fact, ('~>') has another nice
+    property, which is that 'yield' is its left and right identity:
+
+> -- Left Identity
+> yield ~> f = f
+
+> -- Right Identity
+> f ~> yield = f
+
+    In other words, 'yield' and ('~>') form a 'Category', specifically the
+    generator category, where ('~>') plays the role of the composition operator
+    and 'yield' is the identity.  If you don't know what a 'Category' is, that's
+    okay, and category theory is not a prerequisite for using @pipes@.  All you
+    really need to know is that @pipes@ uses some simple category theory to keep
+    the API intuitive and easy to use.
+
+    Notice that if we translate the left identity law to use 'for' instead of
+    ('~>') we get:
+
+> for (yield x) f = f x
+
+    This just says that if you iterate over a pure single-element 'Producer',
+    then you could instead cut out the middle man and directly apply the body of
+    the loop to that single element.
+
+    If we translate the right identity law to use 'for' instead of ('~>') we
+    get:
+
+> for s yield = s
+
+    This just says that if the only thing you do is re-'yield' every element of
+    a stream, you get back your original stream.
+
+    These three \"for loop\" laws summarize our intuition for how 'for' loops
+    should behave and because these are 'Category' laws in disguise that means
+    that 'Producer's are composable in a rigorous sense of the word.
+
+    In fact, we get more out of this than just a bunch of equations.  We also
+    get a useful operator: ('~>').  We can use this operator to condense
+    our original code into the following more succinct form that composes two
+    transformations:
+
+> main = runEffect $ for P.stdinLn (duplicate ~> lift . putStrLn)
+
+    This means that we can also choose to program in a more functional style and
+    think of stream processing in terms of composing transformations using
+    ('~>') instead of nesting a bunch of 'for' loops.
+
+    The above example is a microcosm of the design philosophy behind the @pipes@
+    library:
+
+    * Define the API in terms of categories
+
+    * Specify expected behavior in terms of category laws
+
+    * Think compositionally instead of sequentially
+-}
+
+{- $consumers
+    Sometimes you don't want to use a 'for' loop because you don't want to consume
+    every element of a 'Producer' or because you don't want to process every
+    value of a 'Producer' the exact same way.
+
+    The most general solution is to externally iterate over the 'Producer' using
+    the 'next' command:
+
+@
+ 'next' :: 'Monad' m => 'Producer' a m r -> m ('Either' r (a, 'Producer' a m r))
+@
+
+    Think of 'next' as pattern matching on the head of the 'Producer'.  This
+    'Either' returns a 'Left' if the 'Producer' is done or it returns a 'Right'
+    containing the next value, @a@, along with the remainder of the 'Producer'.
+
+    However, sometimes we can get away with something a little more simple and
+    elegant, like a 'Consumer', which represents an effectful sink of values.  A
+    'Consumer' is a monad transformer that extends the base monad with a new
+    'await' command. This 'await' command lets you receive input from an
+    anonymous upstream source.
+
+    The following @stdoutLn@ 'Consumer' shows how to incrementally 'await'
+    'String's and print them to standard output, terminating gracefully when
+    receiving a broken pipe error:
+
+> import Control.Monad (unless)
+> import Control.Exception (try, throwIO)
+> import qualified GHC.IO.Exception as G
+> import Pipes
+>
+> --          +--------+-- A 'Consumer' that awaits 'String's
+> --          |        |
+> --          v        v
+> stdoutLn :: Consumer String IO ()
+> stdoutLn = do
+>     str <- await  -- 'await' a 'String'
+>     x   <- lift $ try $ putStrLn str
+>     case x of
+>         -- Gracefully terminate if we got a broken pipe error
+>         Left e@(G.IOError { G.ioe_type = t}) ->
+>             lift $ unless (t == G.ResourceVanished) $ throwIO e
+>         -- Otherwise loop
+>         Right () -> stdoutLn
+
+    'await' is the dual of 'yield': we suspend our 'Consumer' until we receive a
+    new value.  If nobody provides a value (which is possible) then 'await'
+    never returns.  You can think of 'await' as having the following type:
+
+@
+ 'await' :: 'Monad' m => 'Consumer' a m a
+@
+
+    One way to feed a 'Consumer' is to repeatedly feed the same input using
+    ('>~') (pronounced \"feed\"):
+
+@
+ \-\-                 +- Feed       +- Consumer to    +- Returns new
+ \-\-                 |  action     |  feed           |  Effect
+ \-\-                 v             v                 v  
+ \-\-                 ----------    --------------    ----------
+ ('>~') :: 'Monad' m => 'Effect' m b -> 'Consumer' b m c -> 'Effect' m c
+@
+
+    @(draw >~ consumer)@ loops over @(consumer)@, substituting each 'await' in
+    @(consumer)@ with @(draw)@.
+
+    So the following code replaces every 'await' in 'P.stdoutLn' with
+    @(lift getLine)@ and then removes all the 'lift's:
+
+>>> runEffect $ lift getLine >~ stdoutLn
+Test<Enter>
+Test
+ABC<Enter>
+ABC
+42<Enter>
+42
+...
+
+    You might wonder why ('>~') uses an 'Effect' instead of a raw action in the
+    base monad.  The reason why is that ('>~') actually permits the following
+    more general type:
+
+@
+ ('>~') :: 'Monad' m => 'Consumer' a m b -> 'Consumer' b m c -> 'Consumer' a m c
+@
+
+    ('>~') is the dual of ('~>'), composing 'Consumer's instead of 'Producer's.
+
+    This means that you can feed a 'Consumer' with yet another 'Consumer' so
+    that you can 'await' while you 'await'.  For example, we could define the
+    following intermediate 'Consumer' that requests two 'String's and returns
+    them concatenated:
+
+> doubleUp :: Monad m => Consumer String m String
+> doubleUp = do
+>     str1 <- await
+>     str2 <- await
+>     return (str1 ++ str2)
+>
+> -- more concise: doubleUp = (++) <$> await <*> await
+
+    We can now insert this in between @(lift getLine)@ and @stdoutLn@ and see
+    what happens:
+
+>>> runEffect $ lift getLine >~ doubleUp >~ stdoutLn
+Test<Enter>
+ing<Enter>
+Testing
+ABC<Enter>
+DEF<Enter>
+ABCDEF
+42<Enter>
+000<Enter>
+42000
+...
+
+    'doubleUp' splits every request from 'stdoutLn' into two separate requests
+    and
+    returns back the concatenated result.
+
+    We didn't need to parenthesize the above chain of ('>~') operators, because
+    ('>~') is associative:
+
+> -- Associativity
+> (f >~ g) >~ h = f >~ (g >~ h)
+
+    ... so we can always omit the parentheses since the meaning is unambiguous:
+
+> f >~ g >~ h
+
+    Also, ('>~') has an identity, which is 'await'!
+
+> -- Left identity
+> await >~ f = f
+>
+> -- Right Identity
+> f >~ await = f
+
+    In other words, ('>~') and 'await' form a 'Category', too, specifically the
+    iteratee category, and 'Consumer's are also composable.
+-}
+
+{- $pipes
+    Our previous programs were unsatisfactory because they were biased either
+    towards the 'Producer' end or the 'Consumer' end.  As a result, we had to
+    choose between gracefully handling end of input (using 'P.stdinLn') or
+    gracefully handling end of output (using 'P.stdoutLn'), but not both at the
+    same time.
+
+    However, we don't need to restrict ourselves to using 'Producer's
+    exclusively or 'Consumer's exclusively.  We can connect 'Producer's and
+    'Consumer's directly together using ('>->') (pronounced \"pipe\"):
+
+@
+ ('>->') :: 'Monad' m => 'Producer' a m r -> 'Consumer' a m r -> 'Effect' m r
+@
+
+    This returns an 'Effect' which we can run:
+
+> -- echo2.hs
+>
+> import Pipes
+> import qualified Pipes.Prelude as P  -- Pipes.Prelude also provides 'stdoutLn'
+>
+> main = runEffect $ P.stdinLn >-> P.stdoutLn
+
+    This program is more declarative of our intent: we want to stream values
+    from 'P.stdinLn' to 'P.stdoutLn'.  The above \"pipeline\" not only echoes
+    standard input to standard output, but also handles both end of input and
+    broken pipe errors:
+
+> $ ./echo2
+> Test<Enter>
+> Test
+> ABC<Enter>
+> ABC
+> 42<Enter>
+> 42
+> <Ctrl-D>
+> $
+
+    ('>->') is \"pull-based\" meaning that control flow begins at the most
+    downstream component (i.e. 'P.stdoutLn' in the above example).  Any time a
+    component 'await's a value it blocks and transfers control upstream and
+    every time a component 'yield's a value it blocks and restores control back
+    downstream, satisfying the 'await'.  So in the above example, ('>->')
+    matches every 'await' from 'P.stdoutLn' with a 'yield' from 'P.stdinLn'.
+
+    Streaming stops when either 'P.stdinLn' terminates (i.e. end of input) or
+    'P.stdoutLn' terminates (i.e. broken pipe).  This is why ('>->') requires
+    that both the 'Producer' and 'Consumer' share the same type of return value:
+    whichever one terminates first provides the return value for the entire
+    'Effect'.
+
+    Let's test this by modifying our 'Producer' and 'Consumer' to each return a
+    diagnostic 'String':
+
+> -- echo3.hs
+>
+> import Control.Applicative ((<$))  -- (<$) modifies return values
+> import Pipes
+> import qualified Pipes.Prelude as P
+> import System.IO
+>
+> main = do
+>     hSetBuffering stdout NoBuffering
+>     str <- runEffect $
+>         ("End of input!" <$ P.stdinLn) >-> ("Broken pipe!" <$ P.stdoutLn)
+>     hPutStrLn stderr str
+
+    This lets us diagnose whether the 'Producer' or 'Consumer' terminated first:
+
+> $ ./echo3
+> Test<Enter>
+> Test
+> <Ctrl-D>
+> End of input!
+> $ ./echo3 | perl -e 'close STDIN'
+> Test<Enter>
+> Broken pipe!
+> $
+
+    You might wonder why ('>->') returns an 'Effect' that we have to run instead
+    of directly returning an action in the base monad.  This is because you can
+    connect things other than 'Producer's and 'Consumer's, like 'Pipe's, which
+    are effectful stream transformations.
+
+    A 'Pipe' is a monad transformer that is a mix between a 'Producer' and
+    'Consumer', because a 'Pipe' can both 'await' and 'yield'.  The following
+    example 'Pipe' is analagous to the Prelude's 'take', only allowing a fixed
+    number of values to flow through:
+
+> -- take.hs
+>
+> import Control.Monad (replicateM_)
+> import Pipes
+> import Prelude hiding (take)
+>
+> --              +--------- A 'Pipe' that
+> --              |    +---- 'await's 'a's and
+> --              |    | +-- 'yield's 'a's
+> --              |    | |
+> --              v    v v
+> take ::  Int -> Pipe a a IO ()
+> take n = do
+>     replicateM_ n $ do                     -- Repeat this block 'n' times
+>         x <- await                         -- 'await' a value of type 'a'
+>         yield x                            -- 'yield' a value of type 'a'
+>     lift $ putStrLn "You shall not pass!"  -- Fly, you fools!
+
+    You can use 'Pipe's to transform 'Producer's, 'Consumer's, or even other
+    'Pipe's using the same ('>->') operator:
+
+@
+ ('>->') :: 'Monad' m => 'Producer' a m r -> 'Pipe'   a b m r -> 'Producer' b m r
+ ('>->') :: 'Monad' m => 'Pipe'   a b m r -> 'Consumer' b m r -> 'Consumer' a m r
+ ('>->') :: 'Monad' m => 'Pipe'   a b m r -> 'Pipe'   b c m r -> 'Pipe'   a c m r
+@
+
+    For example, you can compose 'P.take' after 'P.stdinLn' to limit the number
+    of lines drawn from standard input:
+
+> maxInput :: Int -> Producer String IO ()
+> maxInput n = P.stdinLn >-> take n
+
+>>> runEffect $ maxInput 3 >-> P.stdoutLn
+Test<Enter>
+Test
+ABC<Enter>
+ABC
+42<Enter>
+42
+You shall not pass!
+>>>
+
+    ... or you can pre-compose 'P.take' before 'P.stdoutLn' to limit the number
+    of lines written to standard output:
+
+> maxOutput :: Int -> Consumer String IO ()
+> maxOutput n = take n >-> P.stdoutLn
+
+>>> runEffect $ P.stdinLn >-> maxOutput 3
+<Exact same behavior>
+
+    Those both gave the same behavior because ('>->') is associative:
+
+> (p1 >-> p2) >-> p3 = p1 >-> (p2 >-> p3)
+
+    Therefore we can just leave out the parentheses:
+
+>>> runEffect $ P.stdinLn >-> take 3 >-> P.stdoutLn
+<Exact same behavior>
+
+    ('>->') is designed to behave like the Unix pipe operator, except with less
+    quirks.  In fact, we can continue the analogy to Unix by defining 'cat'
+    (named after the Unix @cat@ utility), which reforwards elements endlessly:
+
+> cat :: Monad m => Pipe a a m r
+> cat = forever $ do
+>     x <- await
+>     yield x
+
+     'cat' is the identity of ('>->'), meaning that 'cat' satisfies the
+     following two laws:
+
+> -- Useless use of 'cat'
+> cat >-> p = p
+>
+> -- Forwarding output to 'cat' does nothing
+> p >-> cat = p
+
+    Therefore, ('>->') and 'cat' form a 'Category', specifically the category of
+    Unix pipes, and 'Pipe's are also composable.
+
+    A lot of Unix tools have very simple definitions when written using @pipes@:
+
+> -- unix.hs
+>
+> import Control.Monad (forever)
+> import Pipes
+> import qualified Pipes.Prelude as P  -- Pipes.Prelude provides 'take', too
+> import Prelude hiding (head)
+>
+> head :: Monad m => Int -> Pipe a a m ()
+> head = P.take
+>
+> yes :: Monad m => Producer String m r
+> yes = forever $ yield "y"
+>
+> main = runEffect $ yes >-> head 3 >-> P.stdoutLn
+
+    This prints out 3 \'@y@\'s, just like the equivalent Unix pipeline:
+
+> $ ./unix
+> y
+> y
+> y
+> $ yes | head -3
+> y
+> y
+> y
+> $
+
+    This lets us write \"Haskell pipes\" instead of Unix pipes.  These are much
+    easier to build than Unix pipes and we can connect them directly within
+    Haskell for interoperability with the Haskell language and ecosystem.
+-}
+
+{- $listT
+    @pipes@ also provides a \"ListT done right\" implementation.  This differs
+    from the implementation in @transformers@ because this 'ListT':
+
+    * obeys the monad laws, and
+
+    * streams data immediately instead of collecting all results into memory.
+
+    The latter property is actually an elegant consequence of obeying the monad
+    laws.
+
+    To bind a list within a 'ListT' computation, combine 'Select' and 'each':
+
+> import Pipes
+> 
+> pair :: ListT IO (Int, Int)
+> pair = do
+>     x <- Select $ each [1, 2]
+>     lift $ putStrLn $ "x = " ++ show x
+>     y <- Select $ each [3, 4]
+>     lift $ putStrLn $ "y = " ++ show y
+>     return (x, y)
+
+    You can then loop over a 'ListT' by using 'every':
+
+@
+ 'every' :: 'Monad' m => 'ListT' m a -> 'Producer' a m ()
+@
+
+    So you can use your 'ListT' within a 'for' loop:
+
+>>> runEffect $ for (every pair) (lift . print)
+x = 1
+y = 3
+(1,3)
+y = 4
+(1,4)
+x = 2
+y = 3
+(2,3)
+y = 4
+(2,4)
+
+    ... or a pipeline:
+
+>>> import qualified Pipes.Prelude as P
+>>> runEffect $ every pair >-> P.print
+<Exact same behavior>
+
+    Note that 'ListT' is lazy and only produces as many elements as we request:
+
+>>> runEffect $ for (every pair >-> P.take 2) (lift . print)
+x = 1
+y = 3
+(1,3)
+y = 4
+(1,4)
+
+    You can also go the other way, binding 'Producer's directly within a
+    'ListT'.  In fact, this is actually what 'Select' was already doing:
+
+@
+ 'Select' :: 'Producer' a m () -> 'ListT' m a
+@
+
+    This lets you write crazy code like:
+
+> import Pipes
+> import qualified Pipes.Prelude as P
+> 
+> input :: Producer String IO ()
+> input = P.stdinLn >-> P.takeWhile (/= "quit")
+> 
+> name :: ListT IO String
+> name = do
+>     firstName <- Select input
+>     lastName  <- Select input
+>     return (firstName ++ " " ++ lastName)
+
+    Here we're binding standard input non-deterministically (twice) as if it
+    were an effectful list:
+
+>>> runEffect $ every name >-> P.stdoutLn
+Daniel<Enter>
+Fischer<Enter>
+Daniel Fischer
+Wagner<Enter>
+Daniel Wagner
+quit<Enter>
+Donald<Enter>
+Stewart<Enter>
+Donald Stewart
+Duck<Enter>
+Donald Duck
+quit<Enter>
+quit<Enter>
+>>>
+
+    Notice how this streams out values immediately as they are generated, rather
+    than building up a large intermediate result and then printing all the
+    values in one batch at the end.
+
+    `ListT` computations can be combined in more ways than `Pipe`s, so try to
+    program in `ListT` as much as possible and defer converting it to a `Pipe`
+    as late as possible using `P.loop`.
+
+    You can combine `ListT` computations even if their inputs and outputs are
+    completely different:
+
+> data In
+>     = InA A
+>     | InB B
+>     | InC C
+>
+> data Out
+>     = OutE E
+>     | OutF F
+>     | OutG G
+>
+> -- Independent computations
+>
+> example1 :: A -> ListT IO D
+> example2 :: B -> ListT IO E
+> example3 :: C -> ListT IO F
+>
+> -- Combined computation
+>
+> total :: In -> ListT IO Out
+> total input = case input of
+>     InA a -> fmap OutD (example1 a)
+>     InB b -> fmap OutE (example2 b)
+>     InC c -> fmap OutF (example3 c)
+
+    Sometimes you have multiple computations that handle different inputs but
+    the same output, in which case you don't need to unify their outputs:
+
+> -- Overlapping outputs
+>
+> example1 :: A -> ListT IO Out
+> example2 :: B -> ListT IO Out
+> example3 :: C -> ListT IO Out
+>
+> -- Combined computation
+>
+> total :: In -> ListT IO Out
+> total input = case input of
+>     InA a -> example1 a
+>     InB b -> example2 b
+>     InC c -> example3 c
+
+    Other times you have multiple computations that handle the same input but
+    produce different outputs.  You can unify their outputs using the `Monoid`
+    and `Functor` instances for `ListT`:
+
+> -- Overlapping inputs
+>
+> example1 :: In -> ListT IO A
+> example2 :: In -> ListT IO B
+> example3 :: In -> ListT IO C
+>
+> -- Combined computation
+>
+> total :: In -> ListT IO Out
+> total input =
+>        fmap OutA (example1 input)
+>     <> fmap OutB (example2 input)
+>     <> fmap OutC (example3 input)
+
+    You can also chain `ListT` computations, feeding the output of the first
+    computation as the input to the next computation:
+
+> -- End-to-end
+>
+> aToB :: A -> ListT IO B
+> bToC :: B -> ListT IO C
+>
+> -- Combined computation
+>
+> aToC :: A -> LIstT IO C
+> aToC = aToB >=> bToC
+
+    ... or you can just use @do@ notation if you prefer.
+
+    However, the `Pipe` type is more general than `ListT` and can represent
+    things like termination.  Therefore you should consider mixing `Pipe`s with
+    `ListT` when you need to take advantage of these extra features:
+
+> -- Mix ListT with Pipes
+>
+> example :: In -> ListT IO Out
+>
+> pipe :: Pipe In Out IO ()
+> pipe = Pipes.takeWhile (not . isC) >-> loop example
+>   where
+>     isC (InC _) = True
+>     isC  _      = False
+
+    So promote your `ListT` logic to a `Pipe` when you need to take advantage of
+    these `Pipe`-specific features.
+-}
+
+{- $tricks
+    @pipes@ is more powerful than meets the eye so this section presents some
+    non-obvious tricks you may find useful.
+
+    Many pipe combinators will work on unusual pipe types and the next few
+    examples will use the 'cat' pipe to demonstrate this.
+
+    For example, you can loop over the output of a 'Pipe' using 'for', which is
+    how 'P.map' is defined:
+
+> map :: Monad m => (a -> b) -> Pipe a b m r
+> map f = for cat $ \x -> yield (f x)
+>
+> -- Read this as: For all values flowing downstream, apply 'f'
+
+    This is equivalent to:
+
+> map f = forever $ do
+>     x <- await
+>     yield (f x)
+
+    You can also feed a 'Pipe' input using ('>~').  This means we could have
+    instead defined the @yes@ pipe like this:
+
+> yes :: Monad m => Producer String m r
+> yes = return "y" >~ cat
+>
+> -- Read this as: Keep feeding "y" downstream
+
+    This is equivalent to:
+
+> yes = forever $ yield "y"
+
+    You can also sequence two 'Pipe's together.  This is how 'P.drop' is
+    defined:
+
+> drop :: Monad m => Int -> Pipe a a m r
+> drop n = do
+>     replicateM_ n await
+>     cat
+
+    This is equivalent to:
+
+> drop n = do
+>     replicateM_ n await
+>     forever $ do
+>         x <- await
+>         yield x
+
+    You can even compose pipes inside of another pipe:
+
+> customerService :: Producer String IO ()
+> customerService = do
+>     each [ "Hello, how can I help you?"        -- Begin with a script
+>          , "Hold for one second."
+>          ]
+>     P.stdinLn >-> P.takeWhile (/= "Goodbye!")  -- Now continue with a human
+
+    Also, you can often use 'each' in conjunction with ('~>') to traverse nested
+    data structures.  For example, you can print all non-'Nothing' elements
+    from a doubly-nested list:
+
+>>> runEffect $ (each ~> each ~> each ~> lift . print) [[Just 1, Nothing], [Just 2, Just 3]]
+1
+2
+3
+
+    Another neat thing to know is that 'every' has a more general type:
+
+@
+ 'every' :: ('Monad' m, 'Enumerable' t) => t m a -> 'Producer' a m ()
+@
+
+    'Enumerable' generalizes 'Foldable' and if you have an effectful container
+    of your own that you want others to traverse using @pipes@, just have your
+    container implement the 'toListT' method of the 'Enumerable' class:
+
+> class Enumerable t where
+>     toListT :: Monad m => t m a -> ListT m a
+
+    You can even use 'Enumerable' to traverse effectful types that are not even
+    proper containers, like 'Control.Monad.Trans.Maybe.MaybeT':
+
+> input :: MaybeT IO String
+> input = do
+>     str <- lift getLine
+>     guard (str /= "Fail")
+>     return str
+
+>>> runEffect $ every input >-> P.stdoutLn
+Test<Enter>
+Test
+>>> runEffect $ every input >-> P.stdoutLn
+Fail<Enter>
+>>>
+
+-}
+
+{- $conclusion
+    This tutorial covers the concepts of connecting, building, and reading
+    @pipes@ code.  However, this library is only the core component in an
+    ecosystem of streaming components.  Derived libraries that build immediately
+    upon @pipes@ include:
+
+    * @pipes-concurrency@: Concurrent reactive programming and message passing
+
+    * @pipes-parse@: Minimal utilities for stream parsing
+
+    * @pipes-safe@: Resource management and exception safety for @pipes@
+
+    * @pipes-group@: Grouping streams in constant space
+
+    These libraries provide functionality specialized to common streaming
+    domains.  Additionally, there are several libraries on Hackage that provide
+    even higher-level functionality, which you can find by searching under the
+    \"Pipes\" category or by looking for packages with a @pipes-@ prefix in
+    their name.  Current examples include:
+
+    * @pipes-extras@: Miscellaneous utilities
+
+    * @pipes-network@/@pipes-network-tls@: Networking
+
+    * @pipes-zlib@: Compression and decompression
+
+    * @pipes-binary@: Binary serialization
+
+    * @pipes-attoparsec@: High-performance parsing
+
+    * @pipes-aeson@: JSON serialization and deserialization
+
+    Even these derived packages still do not explore the full potential of
+    @pipes@ functionality, which actually permits bidirectional communication.
+    Advanced @pipes@ users can explore this library in greater detail by
+    studying the documentation in the "Pipes.Core" module to learn about the
+    symmetry of the underlying 'Proxy' type and operators.
+
+    To learn more about @pipes@, ask questions, or follow @pipes@ development,
+    you can subscribe to the @haskell-pipes@ mailing list at:
+
+    <https://groups.google.com/forum/#!forum/haskell-pipes>
+
+    ... or you can mail the list directly at:
+
+    <mailto:haskell-pipes@googlegroups.com>
+
+    Additionally, for questions regarding types or type errors, you might find
+    the following appendix on types very useful.
+-}
+
+{- $types
+    @pipes@ uses parametric polymorphism (i.e. generics) to overload all
+    operations.  You've probably noticed this overloading already:
+
+    * 'yield' works within both 'Producer's and 'Pipe's
+
+    * 'await' works within both 'Consumer's and 'Pipe's
+
+    * ('>->') connects 'Producer's, 'Consumer's, and 'Pipe's in varying ways
+
+    This overloading is great when it works, but when connections fail they
+    produce type errors that appear intimidating at first.  This section
+    explains the underlying types so that you can work through type errors
+    intelligently.
+
+    'Producer's, 'Consumer's, 'Pipe's, and 'Effect's are all special cases of a
+    single underlying type: a 'Proxy'.  This overarching type permits fully
+    bidirectional communication on both an upstream and downstream interface.
+    You can think of it as having the following shape:
+
+> Proxy a' a b' b m r
+>
+> Upstream | Downstream
+>     +---------+
+>     |         |
+> a' <==       <== b'  -- Information flowing upstream
+>     |         |
+> a  ==>       ==> b   -- Information flowing downstream
+>     |    |    |
+>     +----|----+
+>          v
+>          r
+
+    The four core types do not use the upstream flow of information.  This means
+    that the @a'@ and @b'@ in the above diagram go unused unless you use the
+    more advanced features provided in "Pipes.Core".
+
+    @pipes@ uses type synonyms to hide unused inputs or outputs and clean up
+    type signatures.  These type synonyms come in two flavors:
+
+    * Concrete type synonyms that explicitly close unused inputs and outputs of
+      the 'Proxy' type
+
+    * Polymorphic type synonyms that don't explicitly close unused inputs or
+      outputs
+
+    The concrete type synonyms use @()@ to close unused inputs and 'X' (the
+    uninhabited type) to close unused outputs:
+
+    * 'Effect': explicitly closes both ends, forbidding 'await's and 'yield's
+
+> type Effect = Proxy X () () X
+>
+>  Upstream | Downstream
+>     +---------+
+>     |         |
+> X  <==       <== ()
+>     |         |
+> () ==>       ==> X
+>     |    |    |
+>     +----|----+
+>          v
+>          r
+
+    * 'Producer': explicitly closes the upstream end, forbidding 'await's
+
+> type Producer b = Proxy X () () b
+>
+> Upstream | Downstream
+>     +---------+
+>     |         |
+> X  <==       <== ()
+>     |         |
+> () ==>       ==> b
+>     |    |    |
+>     +----|----+
+>          v
+>          r
+
+    * 'Consumer': explicitly closes the downstream end, forbidding 'yield's
+
+> type Consumer a = Proxy () a () X
+>
+> Upstream | Downstream
+>     +---------+
+>     |         |
+> () <==       <== ()
+>     |         |
+> a  ==>       ==> X
+>     |    |    |
+>     +----|----+
+>          v
+>          r
+
+    * 'Pipe': marks both ends open, allowing both 'await's and 'yield's
+
+> type Pipe a b = Proxy () a () b
+>
+> Upstream | Downstream
+>     +---------+
+>     |         |
+> () <==       <== ()
+>     |         |
+> a  ==>       ==> b
+>     |    |    |
+>     +----|----+
+>          v
+>          r
+
+    When you compose 'Proxy's using ('>->') all you are doing is placing them
+    side by side and fusing them laterally.  For example, when you compose a
+    'Producer', 'Pipe', and a 'Consumer', you can think of information flowing
+    like this:
+
+>        Producer                Pipe                 Consumer
+>     +-----------+          +----------+          +------------+
+>     |           |          |          |          |            |
+> X  <==         <==   ()   <==        <==   ()   <==          <== ()
+>     |  stdinLn  |          |  take 3  |          |  stdoutLn  |
+> () ==>         ==> String ==>        ==> String ==>          ==> X
+>     |     |     |          |    |     |          |      |     |
+>     +-----|-----+          +----|-----+          +------|-----+
+>           v                     v                       v
+>           ()                    ()                      ()
+
+     Composition fuses away the intermediate interfaces, leaving behind an
+     'Effect':
+
+>                    Effect
+>     +-----------------------------------+
+>     |                                   |
+> X  <==                                 <== ()
+>     |  stdinLn >-> take 3 >-> stdoutLn  |
+> () ==>                                 ==> X
+>     |                                   |
+>     +----------------|------------------+
+>                      v
+>                      ()
+
+    @pipes@ also provides polymorphic type synonyms with apostrophes at the end
+    of their names.  These use universal quantification to leave open any unused
+    input or output ends (which I mark using @*@):
+
+    * 'Producer'': marks the upstream end unused but still open
+
+> type Producer' b m r = forall x' x . Proxy x' x () b m r
+>
+> Upstream | Downstream
+>     +---------+
+>     |         |
+>  * <==       <== ()
+>     |         |
+>  * ==>       ==> b
+>     |    |    |
+>     +----|----+
+>          v
+>          r
+
+    * 'Consumer'': marks the downstream end unused but still open
+
+> type Consumer' a m r = forall y' y . Proxy () a y' y m r
+>
+> Upstream | Downstream
+>     +---------+
+>     |         |
+> () <==       <== * 
+>     |         |
+> a  ==>       ==> *
+>     |    |    |
+>     +----|----+
+>          v
+>          r
+
+    * 'Effect'': marks both ends unused but still open
+
+> type Effect' m r = forall x' x y' y . Proxy x' x y' y m r
+>
+> Upstream | Downstream
+>     +---------+
+>     |         |
+>  * <==       <== * 
+>     |         |
+>  * ==>       ==> *
+>     |    |    |
+>     +----|----+
+>          v
+>          r
+
+    Note that there is no polymorphic generalization of a 'Pipe'.
+
+    Like before, if you compose a 'Producer'', a 'Pipe', and a 'Consumer'':
+
+>        Producer'               Pipe                 Consumer'
+>     +-----------+          +----------+          +------------+
+>     |           |          |          |          |            |
+>  * <==         <==   ()   <==        <==   ()   <==          <== *
+>     |  stdinLn  |          |  take 3  |          |  stdoutLn  |
+>  * ==>         ==> String ==>        ==> String ==>          ==> *
+>     |     |     |          |     |    |          |      |     |
+>     +-----|-----+          +-----|----+          +------|-----+
+>           v                      v                      v
+>           ()                     ()                     ()
+
+    ... they fuse into an 'Effect'':
+
+>                    Effect'
+>     +-----------------------------------+
+>     |                                   |
+>  * <==                                 <== *
+>     |  stdinLn >-> take 3 >-> stdoutLn  |
+>  * ==>                                 ==> *
+>     |                                   |
+>     +----------------|------------------+
+>                      v
+>                      ()
+
+    Polymorphic type synonyms come in handy when you want to keep the type as
+    general as possible.  For example, the type signature for 'yield' uses
+    'Producer'' to keep the type signature simple while still leaving the
+    upstream input end open:
+
+@
+ 'yield' :: 'Monad' m => a -> 'Producer'' a m ()
+@
+
+    This type signature lets us use 'yield' within a 'Pipe', too, because the
+    'Pipe' type synonym is a special case of the polymorphic 'Producer'' type 
+    synonym:
+
+@
+ type 'Producer'' b m r = forall x' x . 'Proxy' x' x () b m r
+ type 'Pipe'    a b m r =               'Proxy' () a () b m r
+@
+
+    The same is true for 'await', which uses the polymorphic 'Consumer'' type
+    synonym:
+
+@
+ 'await' :: 'Monad' m => 'Consumer'' a m a
+@
+
+    We can use 'await' within a 'Pipe' because a 'Pipe' is a special case of the
+    polymorphic 'Consumer'' type synonym:
+
+@
+ type 'Consumer'' a   m r = forall y' y . 'Proxy' () a y' y m r
+ type 'Pipe'      a b m r =               'Proxy' () a () b m r
+@
+
+    However, polymorphic type synonyms cause problems in many other cases:
+
+    * They usually give the wrong behavior when used as the argument of a
+      function (known as the \"negative\" or \"contravariant\" position) like
+      this:
+
+> f :: Producer' a m r -> ...  -- Wrong
+>
+> f :: Producer  a m r -> ...  -- Right
+
+      The former function only accepts polymorphic 'Producer's as arguments.
+      The latter function accepts both polymorphic and concrete 'Producer's,
+      which is probably what you want.
+
+    * Even when you desire a polymorphic argument, this induces a higher-ranked
+      type, because it translates to a @forall@ which you cannot factor out to
+      the top-level to simplify the type signature:
+
+> f :: (forall x' x y' . Proxy x' x y' m r) -> ...
+
+      These kinds of type signatures require the @RankNTypes@ extension.
+
+    * Even when you have polymorphic type synonyms as the result of a function
+      (i.e.  the \"positive\" or \"covariant\" position), recent versions of
+      @ghc@ such still require the @RankNTypes@ extension.  For example, the
+      'Pipes.Prelude.fromHandle' function from "Pipes.Prelude" requires
+      @RankNTypes@ to compile correctly on @ghc-7.6.3@:
+
+> fromHandle :: MonadIO m => Handle -> Producer' String m ()
+
+    * You can't use polymorphic type synonyms inside other type constructors
+      without the @ImpredicativeTypes@ extension:
+
+> io :: IO (Producer' a m r)  -- Type error without ImpredicativeTypes
+
+    * You can't partially apply polymorphic type synonyms:
+
+> stack :: MaybeT (Producer' a m) r  -- Type error
+
+    In these scenarios you should fall back on the concrete type synonyms, which
+    are better behaved.  If concrete type synonyms are unsatisfactory, then ask
+    @ghc@ to infer the most general type signature and use that.
+
+    For the purposes of debugging type errors you can just remember that:
+
+>  Input --+    +-- Output
+>          |    |
+>          v    v
+> Proxy a' a b' b m r
+>       ^    ^
+>       |    |
+>       +----+-- Ignore these
+
+    For example, let's say that you try to run the 'P.stdinLn' 'Producer'.  This
+    produces the following type error:
+
+>>> runEffect P.stdinLn
+<interactive>:4:5:
+    Couldn't match expected type `X' with actual type `String'
+    Expected type: Effect m0 r0
+      Actual type: Proxy X () () String IO ()
+    In the first argument of `runEffect', namely `P.stdinLn'
+    In the expression: runEffect P.stdinLn
+
+    'runEffect' expects an 'Effect', which is equivalent to the following type:
+
+> Effect          IO () = Proxy X () () X      IO ()
+
+    ... but 'P.stdinLn' type-checks as a 'Producer', which has the following
+    type:
+
+> Producer String IO () = Proxy X () () String IO ()
+
+    The fourth type variable (the output) does not match.  For an 'Effect' this
+    type variable should be closed (i.e. 'X'), but 'P.stdinLn' has a 'String'
+    output, thus the type error:
+
+>    Couldn't match expected type `X' with actual type `String'
+
+    Any time you get type errors like these you can work through them by
+    expanding out the type synonyms and seeing which type variables do not
+    match.
+
+    You may also consult this table of type synonyms to more easily compare
+    them:
+
+> type Effect             = Proxy X  () () X
+> type Producer         b = Proxy X  () () b
+> type Consumer    a      = Proxy () a  () X
+> type Pipe        a    b = Proxy () a  () b
+>
+> type Server        b' b = Proxy X  () b' b 
+> type Client   a' a      = Proxy a' a  () X
+>
+> type Effect'            m r = forall x' x y' y . Proxy x' x y' y m r
+> type Producer'        b m r = forall x' x      . Proxy x' x () b m r
+> type Consumer'   a      m r = forall      y' y . Proxy () a y' y m r
+>
+> type Server'       b' b m r = forall x' x      . Proxy x' x b' b m r
+> type Client'  a' a      m r = forall      y' y . Proxy a' a y' y m r
+
+-}
+
+{- $timecomplexity
+    There are three functions that give quadratic time complexity when used in
+    within @pipes@:
+
+    * 'sequence'
+
+    * 'replicateM'
+
+    * 'mapM'
+
+    For example, the time complexity of this code segment scales quadratically
+    with `n`:
+
+> import Control.Monad (replicateM)
+> import Pipes
+>
+> quadratic :: Int -> Consumer a m [a]
+> quadratic n = replicateM n await
+
+    These three functions are generally bad practice to use, because all three
+    of them correspond to \"ListT done wrong\", building a list in memory
+    instead of streaming results.
+
+    However, sometimes situations arise where one deliberately intends to build
+    a list in memory.  The solution is to use the \"codensity transformation\"
+    to transform the code to run with linear time complexity.  This involves:
+
+    * wrapping the code in the @Codensity@ monad transformer (from
+      @Control.Monad.Codensity@ module of the @kan-extensions@ package) using
+      'lift'
+
+    * applying 'sequence' \/ 'replicateM' \/ 'mapM'
+
+    * unwrapping the code using @lowerCodensity@
+
+    To illustrate this, we'd transform the above example to:
+
+> import Control.Monad.Codensity (lowerCodensity)
+> 
+> linear :: Monad m => Int -> Consumer a m [a]
+> linear n = lowerCodensity $ replicateM n $ lift await
+
+    This will produce the exact same result, but in linear time.
+-}
+
+{- $copyright
+    This tutorial is licensed under a
+    <http://creativecommons.org/licenses/by/4.0/ Creative Commons Attribution 4.0 International License>
+-}
tests/Main.hs view
@@ -1,272 +1,272 @@-module Main (main) where--import Data.Function                        (on)-import Data.List                            (intercalate)-import Control.Monad                        ((>=>))-import Control.Monad.Trans.Writer           (Writer, runWriter, tell)-import Test.QuickCheck                      (Gen, Arbitrary(..), choose)-import Test.Framework                       (defaultMain, testGroup, Test)-import Test.Framework.Providers.QuickCheck2 (testProperty)--import Pipes-import Pipes.Core-import Prelude hiding (log)---main :: IO ()-main = defaultMain tests--tests :: [Test]-tests =-    [ testGroup "Kleisli Category"        $ testCategory (>=>) return-    , testGroup "Respond Category"        $ testCategory (/>/) respond-     ++ [ testProperty "Distributivity" prop_respond_Distributivity-        ]-    , testGroup "Request Category"        $ testCategory (\>\) request-     ++ [ testProperty "Distributivity" prop_request_Distributivity-        , testProperty "Zero Law"       prop_request_ZeroLaw-        ]-    , testGroup "Pull Category"           $ testCategory (>+>) pull-    , testGroup "Push Category"           $ testCategory (>~>) push-    , testGroup "Push/Pull"-        [ testProperty "Associativity"  prop_pushPull_Associativity-        ]-    , testGroup "Duals"-        [ testGroup "Request"-            [ testProperty "Composition" prop_dual_RequestComposition-            , testProperty "Identity"    prop_dual_RequestIdentity-            ]-        , testGroup "Respond"-            [ testProperty "Composition" prop_dual_RespondComposition-            , testProperty "Identity"    prop_dual_RespondIdentity-            ]-        , testProperty "Distributivity"  prop_dual_ReflectDistributivity-        , testProperty "Zero Law"        prop_dual_ReflectZeroLaw-        , testProperty "Involution"      prop_dual_Involution-        ]-    , testGroup "Functor Laws"-        [ testProperty "Identity"        prop_FunctorIdentity-        ]-    ]--arbitraryBoundedEnum' :: (Bounded a, Enum a) => Gen a-arbitraryBoundedEnum' =-  do let mn = minBound-         mx = maxBound `asTypeOf` mn-     n <- choose (fromEnum mn, fromEnum mx)-     return (toEnum n `asTypeOf` mn)--data ClientStep-    = ClientRequest-    | ClientLog-    | ClientInc-      deriving (Enum, Bounded)--instance Arbitrary ClientStep where-    arbitrary = arbitraryBoundedEnum'-    shrink _  = []--instance Show ClientStep where-    show x = case x of-        ClientRequest -> "request"-        ClientLog     -> "log"-        ClientInc     -> "inc"--data ServerStep-    = ServerRespond-    | ServerLog-    | ServerInc-      deriving (Enum, Bounded)--instance Arbitrary ServerStep where-    arbitrary = arbitraryBoundedEnum'-    shrink _  = []--instance Show ServerStep where-    show x = case x of-        ServerRespond -> "respond"-        ServerLog     -> "log"-        ServerInc     -> "inc"--data ProxyStep-    = ProxyRequest-    | ProxyRespond-    | ProxyLog-    | ProxyInc deriving (Enum, Bounded)--instance Arbitrary ProxyStep where-    arbitrary = arbitraryBoundedEnum'-    shrink _  = []--instance Show ProxyStep where-    show x = case x of-        ProxyRequest -> "request"-        ProxyRespond -> "respond"-        ProxyLog     -> "log"-        ProxyInc     -> "inc"--log :: Int -> Proxy a' a b' b (Writer [Int]) Int-log n = do-    lift (tell [n])-    return n--inc :: (Monad m) => Int -> Proxy a' a b' b m Int-inc n = return (n + 1)--correct :: String -> String-correct str = case str of-    [] -> "return"-    _  -> str--newtype AClient = AClient { unAClient :: [ClientStep] }--instance Arbitrary AClient where-    arbitrary = fmap AClient arbitrary-    shrink    = map AClient . shrink . unAClient--instance Show AClient where-    show = correct . intercalate " >=> " . map show . unAClient--aClient :: AClient -> Int -> Client Int Int (Writer [Int]) Int-aClient = foldr (>=>) return . map f . unAClient-  where-    f x = case x of-        ClientRequest -> request-        ClientLog     -> log-        ClientInc     -> inc--newtype AServer = AServer { unAServer :: [ServerStep] }--instance Arbitrary AServer where-    arbitrary = fmap AServer arbitrary-    shrink    = map AServer . shrink . unAServer--instance Show AServer where-    show = correct . intercalate " >=> " . map show . unAServer--aServer :: AServer -> Int -> Server Int Int (Writer [Int]) Int-aServer = foldr (>=>) return . map f . unAServer-  where-    f x = case x of-        ServerRespond -> respond-        ServerLog     -> log-        ServerInc     -> inc--newtype AProxy = AProxy { unAProxy :: [ProxyStep] }--instance Arbitrary AProxy where-    arbitrary = fmap AProxy arbitrary-    shrink    = map AProxy . shrink . unAProxy--instance Show AProxy where-    show = correct . intercalate " >=> " . map show . unAProxy--aProxy :: AProxy -> Int -> Proxy Int Int Int Int (Writer [Int]) Int-aProxy = foldr (>=>) return . map f . unAProxy-  where-    f x = case x of-        ProxyRequest -> request-        ProxyRespond -> respond-        ProxyLog     -> log-        ProxyInc     -> inc--type ProxyK    = Int -> Proxy Int Int Int Int (Writer [Int]) Int-type Operation = ProxyK -> ProxyK -> ProxyK--infix 0 ===--(===) :: ProxyK -> ProxyK -> AServer -> AClient -> Bool-(===) pl pr p0 p1 =-  let sv  = aServer p0-      cl  = aClient p1-      f p = runWriter (runEffect (p 0))-  in on (==) f (sv >+> pl >+> cl) (sv >+> pr >+> cl)--gen_prop_RightIdentity, gen_prop_LeftIdentity-    :: Operation-    -> ProxyK -- right/left identity element-    -> AProxy -> AServer -> AClient -> Bool-gen_prop_RightIdentity (>>>) idt f' =-    let f = aProxy  f'-    in (f >>> idt) === f--gen_prop_LeftIdentity (>>>) idt f' =-    let f = aProxy f'-    in (idt >>> f) === f--gen_prop_Associativity-    :: Operation-    -> AProxy -> AProxy -> AProxy -> AServer -> AClient -> Bool-gen_prop_Associativity (>>>) f' g' h' =-    let f = aProxy  f'-        g = aProxy  g'-        h = aProxy  h'-    in f >>> (g >>> h) === (f >>> g) >>> h--testCategory :: Operation -> ProxyK -> [Test]-testCategory op idt =-    [ testProperty "Left Identity"  $ gen_prop_LeftIdentity  op idt-    , testProperty "Right Identity" $ gen_prop_RightIdentity op idt-    , testProperty "Associativity"  $ gen_prop_Associativity op-    ]---- Respond Category--prop_respond_Distributivity f' g' h' =-    let f = aProxy  f'-        g = aProxy  g'-        h = aProxy  h'-    in (f >=> g) />/ h === (f />/ h) >=> (g />/ h)---- Request Category--prop_request_Distributivity f' g' h' =-    let f = aProxy  f'-        g = aProxy  g'-        h = aProxy  h'-    in f \>\ (g >=> h) === (f \>\ g) >=> (f \>\ h)--prop_request_ZeroLaw f' =-    let f = aProxy  f'-    in (f \>\ return) === return---- Push/Pull--prop_pushPull_Associativity f' g' h' =-    let f = aProxy f'-        g = aProxy g'-        h = aProxy h'-    in (f >+> g) >~> h === f >+> (g >~> h)---- Duals--prop_dual_RequestComposition f' g' =-    let f = aProxy f'-        g = aProxy g'-    in reflect . (f \>\ g) === reflect . g />/ reflect . f--prop_dual_RequestIdentity = reflect . request === respond--prop_dual_RespondComposition f' g' =-    let f = aProxy f'-        g = aProxy g'-    in  reflect . (f />/ g) === reflect . g \>\ reflect . f--prop_dual_RespondIdentity = reflect . respond === request--prop_dual_ReflectDistributivity f' g' =-    let f = aProxy f'-        g = aProxy g'-    in reflect . (f >=> g) === reflect . f >=> reflect . g--prop_dual_ReflectZeroLaw = reflect . return === return--prop_dual_Involution f' =-    let f = aProxy f'-    in (reflect . reflect) . f >=> return === f---- Functor Laws--prop_FunctorIdentity p' =-    let p = aProxy p'-    in fmap id p === id p+module Main (main) where
+
+import Data.Function                        (on)
+import Data.List                            (intercalate)
+import Control.Monad                        ((>=>))
+import Control.Monad.Trans.Writer           (Writer, runWriter, tell)
+import Test.QuickCheck                      (Gen, Arbitrary(..), choose)
+import Test.Framework                       (defaultMain, testGroup, Test)
+import Test.Framework.Providers.QuickCheck2 (testProperty)
+
+import Pipes
+import Pipes.Core
+import Prelude hiding (log)
+
+
+main :: IO ()
+main = defaultMain tests
+
+tests :: [Test]
+tests =
+    [ testGroup "Kleisli Category"        $ testCategory (>=>) return
+    , testGroup "Respond Category"        $ testCategory (/>/) respond
+     ++ [ testProperty "Distributivity" prop_respond_Distributivity
+        ]
+    , testGroup "Request Category"        $ testCategory (\>\) request
+     ++ [ testProperty "Distributivity" prop_request_Distributivity
+        , testProperty "Zero Law"       prop_request_ZeroLaw
+        ]
+    , testGroup "Pull Category"           $ testCategory (>+>) pull
+    , testGroup "Push Category"           $ testCategory (>~>) push
+    , testGroup "Push/Pull"
+        [ testProperty "Associativity"  prop_pushPull_Associativity
+        ]
+    , testGroup "Duals"
+        [ testGroup "Request"
+            [ testProperty "Composition" prop_dual_RequestComposition
+            , testProperty "Identity"    prop_dual_RequestIdentity
+            ]
+        , testGroup "Respond"
+            [ testProperty "Composition" prop_dual_RespondComposition
+            , testProperty "Identity"    prop_dual_RespondIdentity
+            ]
+        , testProperty "Distributivity"  prop_dual_ReflectDistributivity
+        , testProperty "Zero Law"        prop_dual_ReflectZeroLaw
+        , testProperty "Involution"      prop_dual_Involution
+        ]
+    , testGroup "Functor Laws"
+        [ testProperty "Identity"        prop_FunctorIdentity
+        ]
+    ]
+
+arbitraryBoundedEnum' :: (Bounded a, Enum a) => Gen a
+arbitraryBoundedEnum' =
+  do let mn = minBound
+         mx = maxBound `asTypeOf` mn
+     n <- choose (fromEnum mn, fromEnum mx)
+     return (toEnum n `asTypeOf` mn)
+
+data ClientStep
+    = ClientRequest
+    | ClientLog
+    | ClientInc
+      deriving (Enum, Bounded)
+
+instance Arbitrary ClientStep where
+    arbitrary = arbitraryBoundedEnum'
+    shrink _  = []
+
+instance Show ClientStep where
+    show x = case x of
+        ClientRequest -> "request"
+        ClientLog     -> "log"
+        ClientInc     -> "inc"
+
+data ServerStep
+    = ServerRespond
+    | ServerLog
+    | ServerInc
+      deriving (Enum, Bounded)
+
+instance Arbitrary ServerStep where
+    arbitrary = arbitraryBoundedEnum'
+    shrink _  = []
+
+instance Show ServerStep where
+    show x = case x of
+        ServerRespond -> "respond"
+        ServerLog     -> "log"
+        ServerInc     -> "inc"
+
+data ProxyStep
+    = ProxyRequest
+    | ProxyRespond
+    | ProxyLog
+    | ProxyInc deriving (Enum, Bounded)
+
+instance Arbitrary ProxyStep where
+    arbitrary = arbitraryBoundedEnum'
+    shrink _  = []
+
+instance Show ProxyStep where
+    show x = case x of
+        ProxyRequest -> "request"
+        ProxyRespond -> "respond"
+        ProxyLog     -> "log"
+        ProxyInc     -> "inc"
+
+log :: Int -> Proxy a' a b' b (Writer [Int]) Int
+log n = do
+    lift (tell [n])
+    return n
+
+inc :: (Monad m) => Int -> Proxy a' a b' b m Int
+inc n = return (n + 1)
+
+correct :: String -> String
+correct str = case str of
+    [] -> "return"
+    _  -> str
+
+newtype AClient = AClient { unAClient :: [ClientStep] }
+
+instance Arbitrary AClient where
+    arbitrary = fmap AClient arbitrary
+    shrink    = map AClient . shrink . unAClient
+
+instance Show AClient where
+    show = correct . intercalate " >=> " . map show . unAClient
+
+aClient :: AClient -> Int -> Client Int Int (Writer [Int]) Int
+aClient = foldr (>=>) return . map f . unAClient
+  where
+    f x = case x of
+        ClientRequest -> request
+        ClientLog     -> log
+        ClientInc     -> inc
+
+newtype AServer = AServer { unAServer :: [ServerStep] }
+
+instance Arbitrary AServer where
+    arbitrary = fmap AServer arbitrary
+    shrink    = map AServer . shrink . unAServer
+
+instance Show AServer where
+    show = correct . intercalate " >=> " . map show . unAServer
+
+aServer :: AServer -> Int -> Server Int Int (Writer [Int]) Int
+aServer = foldr (>=>) return . map f . unAServer
+  where
+    f x = case x of
+        ServerRespond -> respond
+        ServerLog     -> log
+        ServerInc     -> inc
+
+newtype AProxy = AProxy { unAProxy :: [ProxyStep] }
+
+instance Arbitrary AProxy where
+    arbitrary = fmap AProxy arbitrary
+    shrink    = map AProxy . shrink . unAProxy
+
+instance Show AProxy where
+    show = correct . intercalate " >=> " . map show . unAProxy
+
+aProxy :: AProxy -> Int -> Proxy Int Int Int Int (Writer [Int]) Int
+aProxy = foldr (>=>) return . map f . unAProxy
+  where
+    f x = case x of
+        ProxyRequest -> request
+        ProxyRespond -> respond
+        ProxyLog     -> log
+        ProxyInc     -> inc
+
+type ProxyK    = Int -> Proxy Int Int Int Int (Writer [Int]) Int
+type Operation = ProxyK -> ProxyK -> ProxyK
+
+infix 0 ===
+
+(===) :: ProxyK -> ProxyK -> AServer -> AClient -> Bool
+(===) pl pr p0 p1 =
+  let sv  = aServer p0
+      cl  = aClient p1
+      f p = runWriter (runEffect (p 0))
+  in on (==) f (sv >+> pl >+> cl) (sv >+> pr >+> cl)
+
+gen_prop_RightIdentity, gen_prop_LeftIdentity
+    :: Operation
+    -> ProxyK -- right/left identity element
+    -> AProxy -> AServer -> AClient -> Bool
+gen_prop_RightIdentity (>>>) idt f' =
+    let f = aProxy  f'
+    in (f >>> idt) === f
+
+gen_prop_LeftIdentity (>>>) idt f' =
+    let f = aProxy f'
+    in (idt >>> f) === f
+
+gen_prop_Associativity
+    :: Operation
+    -> AProxy -> AProxy -> AProxy -> AServer -> AClient -> Bool
+gen_prop_Associativity (>>>) f' g' h' =
+    let f = aProxy  f'
+        g = aProxy  g'
+        h = aProxy  h'
+    in f >>> (g >>> h) === (f >>> g) >>> h
+
+testCategory :: Operation -> ProxyK -> [Test]
+testCategory op idt =
+    [ testProperty "Left Identity"  $ gen_prop_LeftIdentity  op idt
+    , testProperty "Right Identity" $ gen_prop_RightIdentity op idt
+    , testProperty "Associativity"  $ gen_prop_Associativity op
+    ]
+
+-- Respond Category
+
+prop_respond_Distributivity f' g' h' =
+    let f = aProxy  f'
+        g = aProxy  g'
+        h = aProxy  h'
+    in (f >=> g) />/ h === (f />/ h) >=> (g />/ h)
+
+-- Request Category
+
+prop_request_Distributivity f' g' h' =
+    let f = aProxy  f'
+        g = aProxy  g'
+        h = aProxy  h'
+    in f \>\ (g >=> h) === (f \>\ g) >=> (f \>\ h)
+
+prop_request_ZeroLaw f' =
+    let f = aProxy  f'
+    in (f \>\ return) === return
+
+-- Push/Pull
+
+prop_pushPull_Associativity f' g' h' =
+    let f = aProxy f'
+        g = aProxy g'
+        h = aProxy h'
+    in (f >+> g) >~> h === f >+> (g >~> h)
+
+-- Duals
+
+prop_dual_RequestComposition f' g' =
+    let f = aProxy f'
+        g = aProxy g'
+    in reflect . (f \>\ g) === reflect . g />/ reflect . f
+
+prop_dual_RequestIdentity = reflect . request === respond
+
+prop_dual_RespondComposition f' g' =
+    let f = aProxy f'
+        g = aProxy g'
+    in  reflect . (f />/ g) === reflect . g \>\ reflect . f
+
+prop_dual_RespondIdentity = reflect . respond === request
+
+prop_dual_ReflectDistributivity f' g' =
+    let f = aProxy f'
+        g = aProxy g'
+    in reflect . (f >=> g) === reflect . f >=> reflect . g
+
+prop_dual_ReflectZeroLaw = reflect . return === return
+
+prop_dual_Involution f' =
+    let f = aProxy f'
+    in (reflect . reflect) . f >=> return === f
+
+-- Functor Laws
+
+prop_FunctorIdentity p' =
+    let p = aProxy p'
+    in fmap id p === id p