pipes 4.1.5 → 4.1.6
raw patch · 12 files changed
+5069/−4922 lines, 12 filesdep ~basesetup-changed
Dependency ranges changed: base
Files
- LICENSE +24/−24
- Setup.hs +2/−2
- benchmarks/LiftBench.hs +68/−68
- benchmarks/PreludeBench.hs +85/−85
- pipes.cabal +102/−102
- src/Pipes.hs +589/−517
- src/Pipes/Core.hs +894/−854
- src/Pipes/Internal.hs +269/−269
- src/Pipes/Lift.hs +380/−380
- src/Pipes/Prelude.hs +871/−836
- src/Pipes/Tutorial.hs +1513/−1513
- tests/Main.hs +272/−272
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,68 @@-{-# 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++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)+ ]+ ]
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.5 -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 && < 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 && < 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 && < 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 && < 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.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
src/Pipes.hs view
@@ -1,517 +1,589 @@-{-# 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 -@ --} -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) -@ --} -(~>) - :: 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 -@ --} -(>~) - :: 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 -@ --} -(>->) - :: 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,854 +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) -@ - - 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' -@ - --} - -{-| 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) -@ - - 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 -@ --} - -{-| 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) -@ - - 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,836 +1,871 @@-{-| 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 - , print - , toHandle - , drain - - -- * Pipes - -- $pipes - , map - , mapM - , sequence - , mapFoldable - , filter - , filterM - , take - , takeWhile - , drop - , dropWhile - , concat - , elemIndices - , findIndices - , scan - , scanM - , chain - , read - , show - - -- * 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 - , maximum - , minimum - , notElem - , null - , or - , print - , product - , read - , readLn - , sequence - , show - , 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 #-} - --- | '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 #-} - -{-| @(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 #-} - -{- $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 = loop - where - loop p = case p of - Request v _ -> closed v - Respond a fu -> do - as <- loop (fu ()) - return (a:as) - M m -> m >>= loop - Pure _ -> return [] -{-# 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++ -- * 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 #-}
src/Pipes/Tutorial.hs view
@@ -1,1513 +1,1513 @@-{-# 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+ ) 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.+-}
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