pipes 3.0.0 → 4.3.16
raw patch · 35 files changed
Files
- CHANGELOG.md +173/−0
- Control/MFunctor.hs +0/−56
- Control/PFunctor.hs +0/−32
- Control/Pipe.hs +0/−200
- Control/Proxy.hs +0/−35
- Control/Proxy/Class.hs +0/−452
- Control/Proxy/Core.hs +0/−45
- Control/Proxy/Core/Correct.hs +0/−186
- Control/Proxy/Core/Fast.hs +0/−238
- Control/Proxy/Pipe.hs +0/−197
- Control/Proxy/Prelude.hs +0/−21
- Control/Proxy/Prelude/Base.hs +0/−804
- Control/Proxy/Prelude/IO.hs +0/−224
- Control/Proxy/Prelude/Kleisli.hs +0/−87
- Control/Proxy/Synonym.hs +0/−66
- Control/Proxy/Trans.hs +0/−71
- Control/Proxy/Trans/Either.hs +0/−181
- Control/Proxy/Trans/Identity.hs +0/−136
- Control/Proxy/Trans/Maybe.hs +0/−136
- Control/Proxy/Trans/Reader.hs +0/−153
- Control/Proxy/Trans/State.hs +0/−166
- Control/Proxy/Trans/Writer.hs +0/−154
- Control/Proxy/Tutorial.hs +0/−1890
- LICENSE +1/−1
- benchmarks/Common.hs +20/−0
- benchmarks/LiftBench.hs +65/−0
- benchmarks/PreludeBench.hs +85/−0
- pipes.cabal +87/−41
- src/Pipes.hs +721/−0
- src/Pipes/Core.hs +894/−0
- src/Pipes/Internal.hs +284/−0
- src/Pipes/Lift.hs +386/−0
- src/Pipes/Prelude.hs +1009/−0
- src/Pipes/Tutorial.hs +1622/−0
- tests/Main.hs +272/−0
+ CHANGELOG.md view
@@ -0,0 +1,173 @@+4.3.16++* Fix example code for `every`+* Improved documentation for `ListT`++4.3.15++* Build against `ghc-9.0`++4.3.14++* Add `mapMaybe` and `wither`, and more laws for `filter` and `filterM`.++4.3.13++* Add `MonadFail` instance for `Proxy`++4.3.12++* Fix space leak introduced in version 4.3.10+ * This leak primarily affects the use of `forever`++4.3.11++* Fix documentation for `scanM`++4.3.10++* Relax `Monad` constraints to `Functor`+* Support GHC 8.8++4.3.9++* Increase upper bound on `exceptions`++4.3.8++* Increase upper bound on `exceptions`++4.3.7++* Documentation fix++4.3.6++* Fix implementation of `pass` in `MonadWriter` instance for `Proxy`++4.3.5++* Support `Semigroup` being a super-class of `Monoid`++4.3.4++* Increase upper bound on `mmorph`++4.3.3++* Make `X` a synonym for `Data.Void.Void`++4.3.2++* BUG FIX: Fix `MMonad` instance for `ListT`+ * The old instance was an infinite loop++4.3.1++* Support building against `ghc-7.4`++4.3.0++* BREAKING CHANGE: Remove `Alternative`/`MonadPlus` instances for `Proxy`+ * See commit 08e7302f43dbf2a40bd367c5ee73ee3367e17768 which explains why+* Add `Traversable` instance for `ListT`+* New `MonadThrow`/`MonadCatch`/`MMonad`/`Semigroup`/`MonadZip` instances for+ `ListT`+* New `MonadThrow`/`MonadCatch` instances for `Proxy`+* Fix lower bound on `mtl`+* Increase upper bound on `optparse-applicative`++4.2.0++* BREAKING CHANGE: Switch from `ErrorT` to `ExceptT`+* Add `Foldable` instance for `ListT`+* Fix all warnings+* Enable foldr/build fusion for `toList`++4.1.9++* Increase lower bound on `criterion`+* Increase upper bound on `transformers` for tests/benchmarks+* Optimize code by delaying `INLINABLE` annotations++4.1.8++* Increase upper bound on `transformers`+* Prepare for MRP (Monad of no Return Proposal)++4.1.7++* Increase lower bound on `deepseq`+* Add `unfoldr`+* Add `loop`+* Add `toListM'`+* Improve efficiency of `drop`+* License tutorial under Creative Commons license++4.1.6++* Increase lower bound on `base`+* Add diagrams to `Pipes.Core` documentation+* Add `mapM_`+* Add `takeWhile'`+* Add `seq`+* Improve efficiency of `toListM`++4.1.5++* Increase upper bound on `criterion`++4.1.4++* Increase upper bound on `criterion`+* Add `Monoid` instance for `Proxy`++4.1.3++* Increase lower bound on `mtl`+* Re-export `void`+* Add `fold'`+* Add `foldM'`++4.1.2++* Increase upper bounds on `transformers` and `mtl`++4.1.1++* Add `runListT`+* Add `MMonad` instance for `Proxy`+* Add `repeatM`+* Add laws to documentation of `Pipes.Prelude` utilities++4.1.0++* Remove Haskell98 support+* Use internal `X` type instead of `Data.Void`+* Document `Pipes.Lift` module:w+* Add `drain`+* Add `sequence`++4.0.2++* Improve performance of `each`+* Add tutorial appendix explaining how to work around quadratic time complexity++4.0.1++* Remove `WriterT` and `RWST` benchmarks+* Add `Enumerable` instance for `ErrorT`+* Add cabal flag for Haskell98 compilation+* Add several rewrite rules+* Add `mtl` instances for `ListT`+* Fix implementation of `pass`, which did not satisfy `Writer` laws+* Implement `fail` for `ListT`+* Add type synonym table to tutorial appendix+* Add QuickCheck tests for `pipes` laws+* Add `mapFoldable`+* Add `Monoid` instance for `ListT`+* Add manual proofs of `pipes` laws in `laws.md`++4.0.0++Major upgrade of `pipes` to no longer use `Proxy` type class
− Control/MFunctor.hs
@@ -1,56 +0,0 @@--- | This module temporarily holds this class until it can find a better home.--{-# LANGUAGE Rank2Types #-}--module Control.MFunctor (- -- * Functors over Monads- MFunctor(..),- raise- ) where--import Control.Monad.Trans.Class (MonadTrans(lift))-import Control.Monad.Trans.Identity (IdentityT, mapIdentityT)-import Control.Monad.Trans.Maybe (MaybeT, mapMaybeT)-import Control.Monad.Trans.Reader (ReaderT, mapReaderT)-import Control.Monad.Trans.RWS (RWST, mapRWST)-import qualified Control.Monad.Trans.State.Strict as StateStrict-import qualified Control.Monad.Trans.State.Lazy as StateLazy -import qualified Control.Monad.Trans.Writer.Strict as WriterStrict-import qualified Control.Monad.Trans.Writer.Lazy as WriterLazy---- | A functor in the category of monads-class MFunctor t where- {-| Lift a monad morphism from @m@ to @n@ into a monad morphism from- @(t m)@ to @(t n)@ -}- hoist :: (Monad m) => (forall a . m a -> n a) -> t m b -> t n b--instance MFunctor IdentityT where- hoist nat = mapIdentityT nat--instance MFunctor MaybeT where- hoist nat = mapMaybeT nat--instance MFunctor (ReaderT r) where- hoist nat = mapReaderT nat--instance MFunctor (RWST r w s) where- hoist nat = mapRWST nat--instance MFunctor (StateStrict.StateT s) where- hoist nat = StateStrict.mapStateT nat--instance MFunctor (StateLazy.StateT s) where- hoist nat = StateLazy.mapStateT nat--instance MFunctor (WriterStrict.WriterT w) where- hoist nat = WriterStrict.mapWriterT nat--instance MFunctor (WriterLazy.WriterT w) where- hoist nat = WriterLazy.mapWriterT nat--{-| Lift the base monad--> raise = hoist lift--}-raise :: (Monad m, MFunctor t1, MonadTrans t2) => t1 m r -> t1 (t2 m) r-raise = hoist lift
− Control/PFunctor.hs
@@ -1,32 +0,0 @@--- | This module defines functors in the category of proxies--{-# LANGUAGE KindSignatures, Rank2Types #-}--module Control.PFunctor (- -- * Functors over Proxies- PFunctor(..),- raiseP- ) where--import Control.Proxy.Class (Proxy)-import Control.Proxy.Trans (ProxyTrans(liftP))---- | A functor in the category of monads-class PFunctor (- t :: (* -> * -> * -> * -> (* -> *) -> * -> *)- -> * -> * -> * -> * -> (* -> *) -> * -> * ) where- {-| Lift a proxy morphism from @p@ to @q@ into a proxy morphism from- @(t p)@ to @(t q)@ -}- hoistP- :: (Monad m, Proxy p)- => (forall a' a b' b r1 . p a' a b' b m r1 -> q a' a b' b m r1)- -> (t p a' a b' b m r2 -> t q a' a b' b m r2)--{-| Lift the base proxy--> raiseP = hoistP liftP--}-raiseP- :: (Monad m, Proxy p, PFunctor t1, ProxyTrans t2)- => t1 p a' a b' b m r -> t1 (t2 p) a' a b' b m r-raiseP = hoistP liftP
− Control/Pipe.hs
@@ -1,200 +0,0 @@-{-| This module remains as a wistful reminder of this library's humble origins.- This library now builds upon the more general 'Proxy' type, but still keeps- the @pipes@ name. Read "Control.Proxy.Tutorial" to learn about this new- implementation.-- The 'Pipe' type is a monad transformer that enriches the base monad with the- ability to 'await' or 'yield' data to and from other 'Pipe's. -}--module Control.Pipe (- -- * Types- -- $types- Pipe(..),- Producer,- Consumer,- Pipeline,- -- * Create Pipes- -- $create- await,- yield,- pipe,- -- * Compose Pipes- -- $category- (<+<),- (>+>),- idP,- PipeC(..),- -- * Run Pipes- runPipe- ) where--import Control.Applicative (Applicative(pure, (<*>)))-import Control.Category (Category((.), id), (<<<), (>>>))-import Control.Monad (forever)-import Control.Monad.Trans.Class (MonadTrans(lift))-import Control.Proxy.Synonym (C)-import Prelude hiding ((.), id)--{- $types- The 'Pipe' type is strongly inspired by Mario Blazevic's @Coroutine@ type in- his concurrency article from Issue 19 of The Monad Reader.--}--{-|- The base type for pipes-- * @a@ - The type of input received from upstream pipes-- * @b@ - The type of output delivered to downstream pipes-- * @m@ - The base monad-- * @r@ - The type of the return value--}-data Pipe a b m r- = Await (a -> Pipe a b m r)- | Yield b (Pipe a b m r)- | M (m (Pipe a b m r))- | Pure r-{--Technically, the correct implementation that satisfies the monad transformer-laws is:--type PipeF a b x = Await (a -> x) | Yield b x deriving (Functor)--type Pipe a b = FreeT (PipeF a b)--}--instance (Monad m) => Functor (Pipe a b m) where- fmap f pr = go pr where- go p = case p of- Await k -> Await (\a -> go (k a))- Yield b p' -> Yield b (go p')- M m -> M (m >>= \p' -> return (go p'))- Pure r -> Pure (f r)--instance (Monad m) => Applicative (Pipe a b m) where- pure = Pure- pf <*> px = go pf where- go p = case p of- Await k -> Await (\a -> go (k a))- Yield b p' -> Yield b (go p')- M m -> M (m >>= \p' -> return (go p'))- Pure f -> fmap f px--instance (Monad m) => Monad (Pipe a b m) where- return = Pure- pm >>= f = go pm where- go p = case p of- Await k -> Await (\a -> go (k a))- Yield b p' -> Yield b (go p')- M m -> M (m >>= \p' -> return (go p'))- Pure r -> f r--instance MonadTrans (Pipe a b) where- lift m = M (m >>= \r -> return (Pure r))---- | A pipe that produces values-type Producer b m r = Pipe () b m r---- | A pipe that consumes values-type Consumer a m r = Pipe a C m r---- | A self-contained pipeline that is ready to be run-type Pipeline m r = Pipe () C m r--{- $create- 'yield' and 'await' are the only two primitives you need to create pipes.- Since @Pipe a b m@ is a monad, you can assemble 'yield' and 'await'- statements using ordinary @do@ notation. Since @Pipe a b@ is also a monad- transformer, you can use 'lift' to invoke the base monad. For example, you- could write a pipe stage that requests permission before forwarding any- output:--> check :: (Show a) => Pipe a a IO r-> check = forever $ do-> x <- await-> lift $ putStrLn $ "Can '" ++ (show x) ++ "' pass?"-> ok <- read <$> lift getLine-> when ok (yield x)--}--{-|- Wait for input from upstream.-- 'await' blocks until input is available from upstream.--}-await :: Pipe a b m a-await = Await Pure--{-|- Deliver output downstream.-- 'yield' restores control back upstream and binds its value to 'await'.--}-yield :: b -> Pipe a b m ()-yield b = Yield b (Pure ())--{-|- Convert a pure function into a pipe--> pipe f = forever $ do-> x <- await-> yield (f x)--}-pipe :: (Monad m) => (a -> b) -> Pipe a b m r-pipe f = go where- go = Await (\a -> Yield (f a) go)--{- $category- 'Pipe's form a 'Category', meaning that you can compose 'Pipe's using- ('>+>') and also define an identity 'Pipe': 'idP'. These satisfy the- category laws:--> idP >+> p = p->-> p >+> idP = p->-> (p1 >+> p2) >+> p3 = p1 >+> (p2 >+> p3)-- @(p1 >+> p2)@ satisfies all 'await's in @p2@ with 'yield's in @p1@. If any- 'Pipe' terminates the entire 'Pipeline' terminates.--}---- | 'Pipe's form a 'Category' instance when you rearrange the type variables-newtype PipeC m r a b = PipeC { unPipeC :: Pipe a b m r}--instance (Monad m) => Category (PipeC m r) where- id = PipeC idP- PipeC p1 . PipeC p2 = PipeC $ p1 <+< p2---- | Corresponds to ('<<<')/('.') from @Control.Category@-(<+<) :: (Monad m) => Pipe b c m r -> Pipe a b m r -> Pipe a c m r-(Yield b p1) <+< p2 = Yield b (p1 <+< p2)-(M m ) <+< p2 = M (m >>= \p1 -> return (p1 <+< p2))-(Pure r ) <+< _ = Pure r-(Await k ) <+< (Yield b p2) = k b <+< p2-p1 <+< (Await k) = Await (\a -> p1 <+< k a)-p1 <+< (M m) = M (m >>= \p2 -> return (p1 <+< p2))-_ <+< (Pure r) = Pure r---- | Corresponds to ('>>>') from @Control.Category@-(>+>) :: (Monad m) => Pipe a b m r -> Pipe b c m r -> Pipe a c m r-p2 >+> p1 = p1 <+< p2--infixr 8 <+<-infixl 8 >+>---- | Corresponds to 'id' from @Control.Category@-idP :: (Monad m) => Pipe a a m r-idP = go where- go = Await (\a -> Yield a go)---- | Run the 'Pipe' monad transformer, converting it back into the base monad-runPipe :: (Monad m) => Pipe () b m r -> m r-runPipe pl = go pl where- go p = case p of- Yield _ p' -> go p' - Await k -> go (k ())- M m -> m >>= go- Pure r -> return r
− Control/Proxy.hs
@@ -1,35 +0,0 @@-{-| Recommended entry import for this library-- Read "Control.Proxy.Tutorial" for an extended proxy tutorial. -}--module Control.Proxy (- -- * Modules- -- $default- module Control.Proxy.Core,- module Control.Proxy.Core.Fast- ) where--import Control.Proxy.Core-import Control.Proxy.Core.Fast hiding (Request, Respond, M, Pure)--{- $default- "Control.Proxy.Core" exports everything except 'runProxy'.-- This library provides two base proxy implementations, each of which export- their own 'runProxy' function:-- * "Control.Proxy.Core.Fast": This runs faster for code that is not- 'IO'-bound, but it only obeys the monad transformer laws modulo safe- observation functions.-- * "Control.Proxy.Core.Correct": This trades speed on pure code segments, but- strictly preserves the monad transformer laws.-- This module selects the currently recommended implementation (Fast).-- You can switch to the correct implementation by importing- "Control.Proxy.Core" and "Control.Proxy.Core.Correct".-- You can lock in the fast implementation (in case I change the recommended- default) by importing "Control.Proxy.Core" and "Control.Proxy.Core.Fast".--}
− Control/Proxy/Class.hs
@@ -1,452 +0,0 @@-{-# LANGUAGE Rank2Types #-}--{-| The 'Proxy' class defines the library's core API. Everything else in this- library builds exclusively on top of the 'Proxy' type class so that all- proxy implementations and extensions can share the same standard library.-- Several of these type classes duplicate methods from familiar type-classes- (such as ('?>=') duplicating ('>>=')). You do NOT need to use these- duplicate methods. Instead, read the \"Polymorphic proxies\" section below- which explains their purpose and how they help clean up type signatures. -}--module Control.Proxy.Class (- -- * Core proxy class- Proxy(..),- idT,- coidT,- (<-<),- (<~<),-- -- * request/respond substitution- Interact(..),- (/</),- (\<\),-- -- * Laws- -- $laws-- -- * Polymorphic proxies- -- $poly- MonadPlusP(..),- MonadIOP(..)- ) where--import Control.Monad.IO.Class (MonadIO)---- Documentation imports-import Control.Monad.Trans.Class (lift)-import Control.MFunctor(hoist)--{- * I make educated guesses about which associativy is most efficient for each- operator.- * 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--}-infixr 7 <-<-infixl 7 >->-infixr 8 /</-infixl 8 \>\-infixl 8 \<\-infixr 8 />/-infixl 1 ?>= -- This should match the fixity of >>=--{-| The core API for the @pipes@ library-- You should only use 'request', 'respond', and ('>->')-- I only provide ('>~>') for theoretical symmetry, and the remaining methods- just implement internal type class plumbing.--}-class Proxy p where- {-| 'request' input from upstream, passing an argument with the request-- @request a'@ passes @a'@ as a parameter to upstream that upstream may- use to decide what response to return. 'request' binds the upstream's- response of type @a@ to its own return value. -}- request :: (Monad m) => a' -> p a' a b' b m a-- {-| 'respond' with an output for downstream and bind downstream's next- 'request'- - @respond b@ satisfies a downstream 'request' by supplying the value @b@.- 'respond' blocks until downstream 'request's a new value and binds the- argument of type @b'@ from the next 'request' as its return value. -}- respond :: (Monad m) => b -> p a' a b' b m b'-- {-| Compose two proxies blocked on a 'respond', generating a new proxy- blocked on a 'respond'-- Begins from the downstream end and satisfies every 'request' with a- 'respond' -}- (>->)- :: (Monad m)- => (b' -> p a' a b' b m r)- -> (c' -> p b' b c' c m r)- -> (c' -> p a' a c' c m r)-- {-| Compose two proxies blocked on a 'request', generating a new proxy- blocked on a 'request'-- Begins from the upstream end and satisfies every 'respond' with a- 'request' -}- (>~>)- :: (Monad m)- => (a -> p a' a b' b m r)- -> (b -> p b' b c' c m r)- -> (a -> p a' a c' c m r)-- {-| 'return_P' is identical to 'return', except with a more polymorphic- constraint. -}- return_P :: (Monad m) => r -> p a' a b' b m r-- {-| ('?>=') is identical to ('>>='), except with a more polymorphic- constraint. -}- (?>=)- :: (Monad m)- => p a' a b' b m r -> (r -> p a' a b' b m r') -> p a' a b' b m r'-- {-| 'lift_P' is identical to 'lift', except with a more polymorphic- constraint. -}- lift_P :: (Monad m) => m r -> p a' a b' b m r-- {-| 'hoist_P' is identical to 'hoist', except with a more polymorphic- constraint. -}- hoist_P- :: (Monad m)- => (forall r . m r -> n r) -> (p a' a b' b m r' -> p a' a b' b n r')--{-| 'idT' forwards requests followed by responses--> idT = request >=> respond >=> idT--}-idT :: (Monad m, Proxy p) => a' -> p a' a a' a m r-idT = go where- go a' =- request a' ?>= \a ->- respond a ?>= \a'2 ->- go a'2--- idT = foreverK $ request >=> respond--{-| 'coidT' forwards responses followed by requests--> coidT = respond >=> request >=> coidT--}-coidT :: (Monad m, Proxy p) => a -> p a' a a' a m r-coidT = go where- go a =- respond a ?>= \a' ->- request a' ?>= \a2 ->- go a2--- coidT = foreverK $ respond >=> request--{-| Compose two proxies blocked on a 'respond', generating a new proxy blocked- on a 'respond'-- Begins from the downstream end and satisfies every 'request' with a- 'respond' -}-(<-<)- :: (Monad m, Proxy p)- => (c' -> p b' b c' c m r)- -> (b' -> p a' a b' b m r)- -> (c' -> p a' a c' c m r)-p1 <-< p2 = p2 >-> p1--{-| Compose two proxies blocked on a 'request', generating a new proxy blocked- on a 'request'-- Begins from the upstream end and satisfies every 'respond' with a 'request'-- You don't need to use this. I include it only for symmetry. -}-(<~<)- :: (Monad m, Proxy p)- => (b -> p b' b c' c m r)- -> (a -> p a' a b' b m r)- -> (a -> p a' a c' c m r)-p1 <~< p2 = p2 >~> p1---- | Two extra Proxy categories of theoretical interest-class Interact p where- -- | @f \\>\\ g@ replaces all 'request's in 'g' with 'f'.- (\>\) :: (Monad m)- => (b' -> p a' a x' x m b)- -> (c' -> p b' b x' x m c)- -> (c' -> p a' a x' x m c)-- -- | @f \/>\/ g@ replaces all 'respond's in 'f' with 'g'.- (/>/) :: (Monad m)- => (a -> p x' x b' b m a')- -> (b -> p x' x c' c m b')- -> (a -> p x' x c' c m a')---- | @f \/<\/ g@ replaces all 'request's in 'f' with 'g'.-(/</) :: (Monad m, Interact p)- => (c' -> p b' b x' x m c)- -> (b' -> p a' a x' x m b)- -> (c' -> p a' a x' x m c)-p1 /</ p2 = p2 \>\ p1---- | @f \\<\\ g@ replaces all 'respond's in 'g' with 'f'.-(\<\) :: (Monad m, Interact p)- => (b -> p x' x c' c m b')- -> (a -> p x' x b' b m a')- -> (a -> p x' x c' c m a')-p1 \<\ p2 = p2 />/ p1--{- $laws- The 'Proxy' class defines an interface to all core proxy capabilities that- all proxy-like types must implement.-- First, all proxies must support a bidirectional flow of information, defined- by:-- * ('>->')-- * ('>~>')-- * 'request'-- * 'respond'-- Intuitively, both @p1 >-> p2@ and @p1 >~> p2@ pair each 'request' in @p2@- with a 'respond' in @p1@. ('>->') accepts proxies blocked on 'respond' and- begins from the downstream end, whereas ('>~>') accepts proxies blocked on- 'request' and begins from the upstream end.-- Second, all proxies are monads, defined by:-- * 'return_P'-- * ('?>=')-- These must satify the monad laws using @(>>=) = (?>=)@ and- @return = return_P@.-- Third, all proxies are monad transformers, defined by:-- * 'lift_P'-- This must satisfy the monad transformer laws, using @lift = lift_P@.-- Fourth, all proxies are functors in the category of monads, defined by:-- * 'hoist_P'-- This must satisfy the functor laws, using @hoist = hoist_P@.-- All 'Proxy' instances must satisfy these additional laws:-- * ('>->') and 'idT' form a category:--> Define: idT = request >=> respond >=> idT->-> idT >-> p = p->-> p >-> idT = p->-> (p1 >-> p2) >-> p3 = p1 >-> (p2 >-> p3)-- * ('>~>') and 'coidT' form a category:--> Define: coidT = respond >=> request >=> coidT->-> coidT >~> p = p->-> p >~> coidT = p->-> (p1 >~> p2) >~> p3 = p1 >~> (p2 >~> p3)-- * @(hoistK f)@ defines a functor between proxy categories:--> Define: hoistK f = (hoist f .)->-> hoistK f (p1 >-> p2) = hoistK f p1 >-> hoistK p2->-> hoistK f idT = idT->-> hoistK f (p1 >~> p2) = hoistK f p1 >~> hoistK p2->-> hoistK f coidT = coidT-- Also, all proxies must satisfy the following 'Proxy' laws:--> -- Define: liftK = (lift .)->-> p1 >-> liftK f = liftK f->-> p1 >-> (liftK f >=> respond >=> p2) = liftK f >=> respond >=> (p1 >-> p2)->-> (liftK g >=> respond >=> p1) >-> (liftK f >=> request >=> liftK h >=> p2)-> = liftK (f >=> g >=> h) >=> (p1 >-> p2)->-> (liftK g >=> request >=> p1) >-> (liftK f >=> request >=> p2)-> = liftK (f >=> g) >=> request >=> (p1 >~> p2)->-> liftK f >~> p2 = liftK f->-> (liftK f >=> request >=> p1) >~> p2 = liftK f >=> request >=> (p1 >~> p2)->-> (liftK f >=> respond >=> liftK h >=> p1) >~> (liftK g >=> request >=> p2)-> = liftK (f >=> g >=> h) >=> (p1 >~> p2)->-> (liftK f >=> respond >=> p1) >~> (liftK g >=> respond >=> p2)-> = liftK (f >=> g) >=> (p1 >-> p2)-- The 'Interact' class exists primarily for theoretical interest and to- justify some of the functor laws for the 'ProxyTrans' type class. You will- probably never use it.-- The 'Interact' class defines the ability to:- - * Replace existing 'request' commands using ('\>\')-- * Replace existing 'respond' commands using ('/>/')- - Laws:-- * ('\>\') and 'request' form a category:--> request \>\ f = f->-> f \>\ request = f->-> (f \>\ g) \>\ h = f \>\ (g \>\ h)-- * ('/>/') and 'respond' form a category:--> respond />/ f = f->-> f />/ respond = f->-> (f />/ g) />/ h = f />/ (g />/ h)-- Additionally, ('\>\') and ('/>/') distribute in one direction over Kleisli- composition:--> a \>\ (b >=> c) = (a \>\ b) >=> (a \>\ c)->-> a \>\ return = return--> (b >=> c) />/ a = (b />/ a) >=> (c />/ a)->-> return />/ a = return--}--{- $poly- Many of these type classes contain methods which copy methods from more- familiar type classes. These duplicate methods serve two purposes.-- First, this library requires type class instances that would otherwise be- impossible to define without providing higher-kinded constraints. Rather- than use the following illegal polymorphic constraint:--> instance (forall a' a b' b . MonadTrans (p a' a b' b)) => ...-- ... the instance can instead use the following Haskell98 constraint:--> instance (MonadTransP p) => ...-- Second, these type classes don't require the @FlexibleContexts@ extension- to use and substantially clean up constraints in type signatures. They- convert messy constraints like this:--> p :: (MonadP (p a' a b' b m), MonadTrans (p a' a b' b)) => ...-- .. into cleaner and more general constraints like this:--> P :: (Proxy p) => ...-- These type classes exist solely for internal plumbing and you should never- directly use the duplicate methods from them. Instead, you can use all the- original type classes as long as you embed your proxy code within at least- one proxy transformer (or 'IdentityP' if don't use any transformers). The- type-class machinery will then automatically convert the messier and less- polymorphic constraints to the simpler and more general constraints.-- For example, consider the following almost-correct definition for @mapMD@- (from "Control.Proxy.Prelude.Base"):--> import Control.Monad.Trans.Class-> import Control.Proxy->-> mapMD f = foreverK $ \a' -> do-> a <- request a'-> b <- lift (f a)-> respond b-- The compiler infers the following messy constraint:--> mapMD-> :: (Monad m, Monad (p x a x b m), MonadTrans (p x a x b), Proxy p)-> => (a -> m b) -> x -> p x a x b m r-- Instead, you can embed the code in the @IdentityP@ proxy transformer by- wrapping it in 'runIdentityK':--> -- |difference| -> mapMD f = runIdentityK $ foreverK $ \a' -> do-> a <- request a'-> b <- lift (f a)-> respond b-- ... and now the compiler collapses all the constraints into the 'Proxy'- constraint:--> mapMD :: (Monad m, Proxy p) => (a -> m b) -> x -> p x a x b m r-- You do not incur any performance penalty for writing polymorphic code or- embedding it in 'IdentityP'. This library employs several rewrite @RULES@- which transform your polymorphic code into the equivalent type-specialized- hand-tuned code. These rewrite rules fire very robustly and they do not- require any assistance on your part from compiler pragmas like @INLINE@,- @NOINLINE@ or @SPECIALIZE@.-- If you nest proxies within proxies:--> example () = do-> request ()-> lift $ request ()-> lift $ lift $ request ()-- ... then you can still keep the nice constraints using:--> example () = runIdentityP . hoist (runIdentityP . hoist runIdentityP) $ do-> request ()-> lift $ request ()-> lift $ lift $ request ()-- You don't need to use 'runIdentityP' \/ 'runIdentityK' if you use any other- proxy transformers (In fact you can't, it's a type error). The following- code example illustrates this, where the 'throw' command (from the 'EitherP'- proxy transformer) suffices to guide the compiler to the cleaner type- signature:--> import Control.Monad-> import Control.Proxy-> import qualified Control.Proxy.Trans.Either as E->-> example :: (Monad m, Proxy p) => () -> Producer (EitherP String p) Char m ()-> example () = do-> c <- request ()-> when (c == ' ') $ E.throw "Error: received space"-> respond c--}--{-| The @(MonadPlusP p)@ constraint is equivalent to the following constraint:--> (forall a' a b' b m . (Monad m) => MonadPlus (p a' a b' b m)) => ...--}-class (Proxy p) => MonadPlusP p where- mzero_P :: (Monad m) => p a' a b' b m r- mplus_P- :: (Monad m) => p a' a b' b m r -> p a' a b' b m r -> p a' a b' b m r--{-| The @(MonadIOP p)@ constraint is equivalent to the following constraint:--> (forall a' a b' b m . (MonadIO m) => MonadIO (p a' a b' b m)) => ...--}-class (Proxy p) => MonadIOP p where- liftIO_P :: (MonadIO m) => IO r -> p a' a b' b m r
− Control/Proxy/Core.hs
@@ -1,45 +0,0 @@--- | Default imports for the "Control.Proxy" hierarchy--module Control.Proxy.Core (- -- * Modules- -- $modules- module Control.Proxy.Class,- module Control.Proxy.Synonym,- module Control.Proxy.Prelude,- module Control.Proxy.Trans,- module Control.Proxy.Trans.Identity,- module Control.Monad,- module Control.Monad.Trans.Class,- module Control.MFunctor- ) where--import Control.MFunctor (MFunctor(hoist))-import Control.Monad (forever, (>=>), (<=<))-import Control.Monad.Trans.Class (MonadTrans(lift))-import Control.Proxy.Class-import Control.Proxy.Synonym-import Control.Proxy.Trans-import Control.Proxy.Trans.Identity-import Control.Proxy.Prelude--{- $modules- "Control.Proxy.Class" defines the 'Proxy' type class that lets you program- generically over proxy implementations and their transformers.-- "Control.Proxy.Synonym" defines type synonyms for proxies that don't use all- of their inputs or outputs, such as 'Pipe's, 'Producer's, and 'Server's.-- "Control.Proxy.Prelude" provides a standard library of proxies.-- "Control.Proxy.Trans" defines the 'ProxyTrans' type class that lets you- write your own proxy extensions.-- "Control.Proxy.Trans.Identity" exports 'runIdentityP', which substantially- eases writing completely polymorphic proxies.-- "Control.Monad" exports 'forever', ('>=>'), and ('<=<').-- "Control.Monad.Trans.Class" exports 'lift'.-- "Control.MFunctor" exports 'hoist'.--}
− Control/Proxy/Core/Correct.hs
@@ -1,186 +0,0 @@-{-| This module provides the correct proxy implementation which strictly- enforces the monad transformer laws. You can safely import this module- without violating any laws or invariants.-- However, I advise that you stick to the 'Proxy' type class API rather than- import this module so that your code works with both 'Proxy' implementations- and also works with all proxy transformers. -}--module Control.Proxy.Core.Correct (- -- * Types- ProxyCorrect(..),- ProxyF(..),-- -- * Run Sessions - -- $run- runProxy,- runProxyK,- runPipe- ) where--import Control.Applicative (Applicative(pure, (<*>)))-import Control.Monad.IO.Class (MonadIO(liftIO))-import Control.Monad.Trans.Class (MonadTrans(lift))-import Control.MFunctor (MFunctor(hoist))-import Control.Proxy.Class-import Control.Proxy.Synonym (C)--{-| A 'ProxyCorrect' communicates with an upstream interface and a downstream- interface.-- The type variables of @ProxyCorrect req_a' resp_a req_b' resp_b m r@- signify:-- * @req_a'@ - The request supplied to the upstream interface-- * @resp_a@ - The response provided by the upstream interface-- * @req_b'@ - The request supplied by the downstream interface-- * @resp_b@ - The response provided to the downstream interface-- * @m @ - The base monad-- * @r @ - The final return value -}-data ProxyCorrect a' a b' b m r =- Proxy { unProxy :: m (ProxyF a' a b' b r (ProxyCorrect a' a b' b m r)) }---- | The base functor for the 'ProxyCorrect' type-data ProxyF a' a b' b r x- = Request a' (a -> x)- | Respond b (b' -> x)- | Pure r--instance (Monad m) => Functor (ProxyCorrect a' a b' b m) where- fmap f p0 = go p0 where- go p = Proxy (do- x <- unProxy p- return (case x of- Request a' fa -> Request a' (\a -> go (fa a ))- Respond b fb' -> Respond b (\b' -> go (fb' b'))- Pure r -> Pure (f r) ) )--instance (Monad m) => Applicative (ProxyCorrect a' a b' b m) where- pure r = Proxy (return (Pure r))- pf <*> px = go pf where- go p = Proxy (do- x <- unProxy p- case x of- Request a' fa -> return (Request a' (\a -> go (fa a )))- Respond b fb' -> return (Respond b (\b' -> go (fb' b')))- Pure f -> unProxy (fmap f px) )--instance (Monad m) => Monad (ProxyCorrect a' a b' b m) where- return = \r -> Proxy (return (Pure r))- p0 >>= f = go p0 where- go p = Proxy (do- x <- unProxy p- case x of- Request a' fa -> return (Request a' (\a -> go (fa a )))- Respond b fb' -> return (Respond b (\b' -> go (fb' b')))- Pure r -> unProxy (f r) )--instance MonadTrans (ProxyCorrect a' a b' b) where- lift = lift_P--instance (MonadIO m) => MonadIO (ProxyCorrect a' a b' b m) where- liftIO m = Proxy (liftIO (m >>= \r -> return (Pure r)))- -- liftIO = Proxy . liftIO . liftM Pure--instance MonadIOP ProxyCorrect where- liftIO_P = liftIO--instance Proxy ProxyCorrect where- fb'_0 >-> fc' = \c' -> fb'_0 >-| fc' c' where- fb' >-| p1 = Proxy (do- x <- unProxy p1- case x of- Request b' fb -> unProxy (fb' b' |-> fb)- Respond c fc' -> return (Respond c (\c' -> fb' >-| fc' c'))- Pure r -> return (Pure r) )- p2 |-> fb = Proxy (do- x <- unProxy p2- case x of- Request a' fa -> return (Request a' (\a -> fa a |-> fb))- Respond b fb' -> unProxy (fb' >-| fb b)- Pure r -> return (Pure r) )-- fa_0 >~> fb_0 = \a -> fa_0 a |-> fb_0 where- fb' >-| p1 = Proxy (do- x <- unProxy p1- case x of- Request b' fb -> unProxy (fb' b' |-> fb)- Respond c fc' -> return (Respond c (\c' -> fb' >-| fc' c'))- Pure r -> return (Pure r) )- p2 |-> fb = Proxy (do- x <- unProxy p2- case x of- Request a' fa -> return (Request a' (\a -> fa a |-> fb))- Respond b fb' -> unProxy (fb' >-| fb b)- Pure r -> return (Pure r) )-- request a' = Proxy (return (Request a' (\a -> Proxy (return (Pure a )))))- respond b = Proxy (return (Respond b (\b' -> Proxy (return (Pure b')))))-- return_P = return- (?>=) = (>>=)-- lift_P m = Proxy (m >>= \r -> return (Pure r))-- hoist_P = hoist--instance Interact ProxyCorrect where- k2 \>\ k1 = \a' -> go (k1 a') where- go p = Proxy (do- x <- unProxy p- case x of- Request b' fb -> unProxy (k2 b' >>= \b -> go (fb b))- Respond x fx' -> return (Respond x (\x' -> go (fx' x')))- Pure a -> return (Pure a) )- k2 />/ k1 = \a' -> go (k2 a') where- go p = Proxy (do- x <- unProxy p- case x of- Request x' fx -> return (Request x' (\x -> go (fx x)))- Respond b fb' -> unProxy (k1 b >>= \b' -> go (fb' b'))- Pure a -> return (Pure a) )--instance MFunctor (ProxyCorrect a' a b' b) where- hoist nat p0 = go p0 where- go p = Proxy (nat (do- x <- unProxy p- return (case x of- Request a' fa -> Request a' (\a -> go (fa a ))- Respond b fb' -> Respond b (\b' -> go (fb' b'))- Pure r -> Pure r )))--{- $run- The following commands run self-sufficient proxies, converting them back to- the base monad.-- These are the only functions specific to the 'ProxyCorrect' type.- Everything else programs generically over the 'Proxy' type class.-- Use 'runProxyK' if you are running proxies nested within proxies. It- provides a Kleisli arrow as its result that you can pass to another- 'runProxy' / 'runProxyK' command. -}--{-| Run a self-sufficient 'ProxyCorrect' Kleisli arrow, converting it back to- the base monad -}-runProxy :: (Monad m) => (() -> ProxyCorrect a' () () b m r) -> m r-runProxy k = go (k ()) where- go p = do- x <- unProxy p- case x of- Request _ fa -> go (fa ())- Respond _ fb' -> go (fb' ())- Pure r -> return r--{-| Run a self-sufficient 'ProxyCorrect' Kleisli arrow, converting it back to a- Kleisli arrow in the base monad -}-runProxyK :: (Monad m) => (() -> ProxyCorrect a' () () b m r) -> (() -> m r)-runProxyK p = \() -> runProxy p---- | Run the 'Pipe' monad transformer, converting it back to the base monad-runPipe :: (Monad m) => ProxyCorrect a' () () b m r -> m r-runPipe p = runProxy (\_ -> p)
− Control/Proxy/Core/Fast.hs
@@ -1,238 +0,0 @@-{-| This is an internal module, meaning that it is unsafe to import unless you- understand the risks.-- This module provides the fast proxy implementation, which achieves its speed- 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-- These laws only hold when viewed through certain safe observation functions,- like 'runProxy' and 'observe'.-- Also, you really should not use the constructors anyway, let alone the- concrete type and instead you should stick to the 'Proxy' type class API.- This not only ensures that your code does not violate the monad transformer- laws, but also guarantees that it works with the other proxy implementations- and with any proxy transformers. -}--module Control.Proxy.Core.Fast (- -- * Types- ProxyFast(..),-- -- * Run Sessions - -- $run- runProxy,- runProxyK,- runPipe,-- -- * Safety- observe- ) where--import Control.Applicative (Applicative(pure, (<*>)))--- import Control.Monad (ap, forever, liftM, (>=>))-import Control.Monad.IO.Class (MonadIO(liftIO))-import Control.Monad.Trans.Class (MonadTrans(lift))-import Control.MFunctor (MFunctor(hoist))-import Control.Proxy.Class-import Control.Proxy.Synonym (C)--{-| A 'ProxyFast' communicates with an upstream interface and a downstream- interface.-- The type variables of @ProxyFast req_a' resp_a req_b' resp_b m r@ signify:-- * @req_a'@ - The request supplied to the upstream interface-- * @resp_a@ - The response provided by the upstream interface-- * @req_b'@ - The request supplied by the downstream interface-- * @resp_b@ - The response provided to the downstream interface-- * @m @ - The base monad-- * @r @ - The final return value -}-data ProxyFast a' a b' b m r- = Request a' (a -> ProxyFast a' a b' b m r )- | Respond b (b' -> ProxyFast a' a b' b m r )- | M (m (ProxyFast a' a b' b m r))- | Pure r--instance (Monad m) => Functor (ProxyFast 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 (ProxyFast 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 (ProxyFast a' a b' b m) where- return = Pure- (>>=) = _bind--_bind- :: (Monad m)- => ProxyFast a' a b' b m r- -> (r -> ProxyFast a' a b' b m r')- -> ProxyFast 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---- | Only satisfies laws modulo 'observe'-instance MonadTrans (ProxyFast a' a b' b) where- lift = _lift--_lift :: (Monad m) => m r -> ProxyFast a' a b' b m r-_lift m = M (m >>= \r -> return (Pure r))--- _lift = M . liftM Pure--{- These never fire, for some reason, but keep them until I figure out how to- get them to work. -}-{-# RULES- "_lift m ?>= f" forall m f .- _bind (_lift m) f = M (m >>= \r -> return (f r))- #-}--instance (MonadIO m) => MonadIO (ProxyFast a' a b' b m) where- liftIO m = M (liftIO (m >>= \r -> return (Pure r)))- -- liftIO = M . liftIO . liftM Pure--instance MonadIOP ProxyFast where- liftIO_P = liftIO--instance Proxy ProxyFast where- fb'_0 >-> fc'_0 = \c' -> fb'_0 >-| fc'_0 c' where- p1 |-> fb = case p1 of- Request a' fa -> Request a' (\a -> fa a |-> fb)- Respond b fb' -> fb' >-| fb b- M m -> M (m >>= \p1' -> return (p1' |-> fb))- Pure r -> Pure r- fb' >-| p2 = case p2 of- Request b' fb -> fb' b' |-> fb- Respond c fc' -> Respond c (\c' -> fb' >-| fc' c')- M m -> M (m >>= \p2' -> return (fb' >-| p2'))- Pure r -> Pure r-- fa_0 >~> fb_0 = \a -> fa_0 a |-> fb_0 where- p1 |-> fb = case p1 of- Request a' fa -> Request a' (\a -> fa a |-> fb)- Respond b fb' -> fb' >-| fb b- M m -> M (m >>= \p1' -> return (p1' |-> fb))- Pure r -> Pure r- fb' >-| p2 = case p2 of- Request b' fb -> fb' b' |-> fb- Respond c fc' -> Respond c (\c' -> fb' >-| fc' c')- M m -> M (m >>= \p2' -> return (fb' >-| p2'))- Pure r -> Pure r-- request a' = Request a' Pure- respond b = Respond b Pure-- return_P = return- (?>=) = _bind-- lift_P = _lift-- hoist_P = hoist--{-# RULES- "_bind (Request a' Pure) f" forall a' f .- _bind (Request a' Pure) f = Request a' f;- "_bind (Respond b Pure) f" forall b f .- _bind (Respond b Pure) f = Respond b f- #-}--instance Interact ProxyFast where- k2 \>\ k1 = \a' -> go (k1 a') where- go p = case p of- Request b' fb -> k2 b' >>= \b -> go (fb b)- Respond x fx' -> Respond x (\x' -> go (fx' x'))- M m -> M (m >>= \p' -> return (go p'))- Pure a -> Pure a- k2 />/ k1 = \a' -> go (k2 a') where- go p = case p of- Request x' fx -> Request x' (\x -> go (fx x))- Respond b fb' -> k1 b >>= \b' -> go (fb' b')- M m -> M (m >>= \p' -> return (go p'))- Pure a -> Pure a--instance MFunctor (ProxyFast 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--{- $run- The following commands run self-sufficient proxies, converting them back to- the base monad.-- These are the only functions specific to the 'ProxyFast' type. Everything- else programs generically over the 'Proxy' type class.-- Use 'runProxyK' if you are running proxies nested within proxies. It- provides a Kleisli arrow as its result that you can pass to another- 'runProxy' / 'runProxyK' command. -}--{-| Run a self-sufficient 'ProxyFast' Kleisli arrow, converting it back to the- base monad -}-runProxy :: (Monad m) => (() -> ProxyFast a' () () b m r) -> m r-runProxy k = go (k ()) where- go p = case p of- Request _ fa -> go (fa ())- Respond _ fb' -> go (fb' ())- M m -> m >>= go- Pure r -> return r--{-| Run a self-sufficient 'ProxyFast' Kleisli arrow, converting it back to a- Kleisli arrow in the base monad -}-runProxyK :: (Monad m) => (() -> ProxyFast a' () () b m r) -> (() -> m r)-runProxyK p = \() -> runProxy p---- | Run the 'Pipe' monad transformer, converting it back to the base monad-runPipe :: (Monad m) => ProxyFast a' () () b m r -> m r-runPipe p = runProxy (\_ -> p)--{-| 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 moderate cost to performance, so use this- function sparingly or else you would be better off using- "Control.Proxy.Core.Correct".-- You do not need to use this function if you use the safe API exported from- "Control.Proxy", which does not export any functions or constructors that- can violate the monad transformer laws.--}-observe :: (Monad m) => ProxyFast a' a b' b m r -> ProxyFast a' a b' b m r-observe p = M (go p) where- go p = case p of- M m' -> m' >>= go- Pure r -> return (Pure r)- Request a' fa -> return (Request a' (\a -> observe (fa a )))- Respond b fb' -> return (Respond b (\b' -> observe (fb' b')))
− Control/Proxy/Pipe.hs
@@ -1,197 +0,0 @@-{-# LANGUAGE KindSignatures #-}--{-| This module provides an API similar to "Control.Pipe" for those who prefer- the classic 'Pipe' API.-- This module differs slightly from "Control.Pipe" in order to promote- seamless interoperability with both pipes and proxies. See the \"Upgrade- Pipes to Proxies\" section below for details. -}-module Control.Proxy.Pipe (- -- * Create Pipes- await,- yield,- pipe,-- -- * Compose Pipes- (<+<),- (>+>),- idP,-- -- * Synonyms- Pipeline,-- -- * Run Pipes- -- $run-- -- * Upgrade Pipes to Proxies- -- $upgrade- ) where--import Control.Monad (forever)-import Control.Proxy.Class (Proxy(request, respond, (>->), (?>=)))-import Control.Proxy.Synonym (Pipe, Consumer, Producer, C)-import Control.Proxy.Trans.Identity (runIdentityP)--{-| Wait for input from upstream-- 'await' blocks until input is available from upstream. -}-await :: (Monad m, Proxy p) => Pipe p a b m a-await = request ()--{-| Deliver output downstream-- 'yield' restores control back downstream and binds its value to 'await'. -}-yield :: (Monad m, Proxy p) => b -> p a' a b' b m ()-yield b = runIdentityP $ do- respond b- return ()---- | Convert a pure function into a pipe-pipe :: (Monad m, Proxy p) => (a -> b) -> Pipe p a b m r-pipe f = runIdentityP $ forever $ do- a <- request ()- respond (f a)--infixr 9 <+<-infixl 9 >+>---- | Corresponds to ('<<<')/('.') from @Control.Category@-(<+<)- :: (Monad m, Proxy p) => Pipe p b c m r -> Pipe p a b m r -> Pipe p a c m r-p1 <+< p2 = p2 >+> p1---- | Corresponds to ('>>>') from @Control.Category@-(>+>)- :: (Monad m, Proxy p) => Pipe p a b m r -> Pipe p b c m r -> Pipe p a c m r-p1 >+> p2 = ((\() -> p1) >-> (\() -> p2)) ()---- | Corresponds to 'id' from @Control.Category@-idP :: (Monad m, Proxy p) => Pipe p a a m r-idP = runIdentityP $ forever $ do- a <- request ()- respond a--{-| A self-contained 'Pipeline' that is ready to be run-- 'Pipeline's never 'request' nor 'respond'. -}-type Pipeline (p :: * -> * -> * -> * -> (* -> *) -> * -> *) = p C () () C--{- $run- The "Control.Proxy.Core.Fast" and "Control.Proxy.Core.Correct" modules- provide their corresponding 'runPipe' functions, specialized to their own- 'Proxy' implementations.-- Each implementation must supply its own 'runPipe' function since it is- the only non-polymorphic 'Pipe' function and the compiler uses it to- select which underlying proxy implementation to use. -}--{- $upgrade- You can upgrade classic 'Pipe' code to work with the proxy ecosystem in- steps. Each change enables greater interoperability with proxy utilities- and transformers and if time permits you should implement the entire upgrade- for your libraries if you want to take advantage of proxy standard- libraries.-- First, import "Control.Proxy" and "Control.Proxy.Pipe" instead of- "Control.Pipe". Then, add 'ProxyFast' after every 'Pipe', 'Producer', or- 'Consumer' in any type signature. For example, you would convert this:--> import Control.Pipe->-> fromList :: (Monad m) => [b] -> Producer b m ()-> fromList xs = mapM_ yield xs-- ... to this:--> import Control.Proxy-> import Control.Proxy.Pipe -- transition import->-> fromList :: (Monad m) => [b] -> Producer ProxyFast b m ()-> fromList xs = mapM_ yield xs-- The change ensures that all your code now works in the 'ProxyFast' monad,- which is the faster of the two proxy implementations.-- Second, modify all your 'Pipe's to take an empty '()' as their final- argument, and translate the following functions:-- * ('<+<') to ('<-<')-- * 'runPipe' to 'runProxy'-- For example, you would convert this:--> import Control.Proxy-> import Control.Proxy.Pipe->-> fromList :: (Monad m) => [b] -> Producer ProxyFast b m ()-> fromList xs = mapM_ yield xs-- ... to this:--> import Control.Proxy-> import Control.Proxy.Pipe->-> fromList :: (Monad m) => [b] -> () -> Producer ProxyFast b m ()-> fromList xs () = mapM_ yield xs-- Now when you call these within a @do@ block you must supplying an- additional @()@ argument:--> examplePipe () = do-> a <- request ()-> fromList [1..a] ()-- This change lets you switch from pipe composition, ('<+<'), to proxy- composition, ('<-<'), so that you can mix proxy utilities with pipes.-- Third, wrap your pipe's implementation in 'runIdentityP' (which- "Control.Proxy" exports):--> import Control.Proxy-> import Control.Proxy.Pipe->-> fromList xs () = runIdentityP $ mapM_ yield xs-- Then replace the 'ProxyFast' in the type signature with a type variable @p@- constrained by the 'Proxy' type class:--> fromList :: (Monad m, Proxy p) => [b] -> () -> Producer p b m ()-- This change upgrades your 'Pipe' to work natively within proxies and proxy- transformers, without any manual conversion or lifting. You can now compose- or sequence your 'Pipe' within any feature set transparently.-- Finally, replace each 'await' with @request ()@ and each 'yield' with- 'respond'. Also, replace every 'Pipeline' with 'Session'. This lets you- drop the "Control.Proxy.Pipe" import:--> import Control.Proxy->-> fromList :: (Monad m, Proxy p) => [b] -> () -> Producer p b m ()-> fromList xs () = runIdentityP $ mapM_ respond xs-- Also, I encourage you to continue using the 'Pipe', 'Consumer' and- 'Producer' type synonyms to simplify type signatures. The following- examples show how they cleanly mix with proxies and their extensions:--> import Control.Proxy-> import Control.Proxy.Trans.Either as E-> import Control.Proxy.Trans.State->-> -- A Producer enriched with pipe-local state-> example1 :: (Monad m, Proxy p) => () -> Producer (StateP Int p) Int m r-> example1 () = forever $ do-> n <- get-> respond n-> put (n + 1)->-> -- A Consumer enriched with error-handling-> example2 :: (Proxy p) => () -> Consumer (EitherP String p) Int IO ()-> example2 () = do-> n <- request ()-> if (n == 0)-> then E.throw "Error: received 0"-> else lift $ print n---}
− Control/Proxy/Prelude.hs
@@ -1,21 +0,0 @@--- | Entry point for the Control.Proxy.Prelude hierarchy--module Control.Proxy.Prelude (- -- * Modules- -- $modules- module Control.Proxy.Prelude.Base,- module Control.Proxy.Prelude.IO,- module Control.Proxy.Prelude.Kleisli- ) where--import Control.Proxy.Prelude.Base-import Control.Proxy.Prelude.IO-import Control.Proxy.Prelude.Kleisli--{- $modules- "Control.Proxy.Prelude.Base" provides pure utility proxies.-- "Control.Proxy.Prelude.IO" provides proxies for simple 'IO'.-- "Control.Proxy.Prelude.Kleisli" provides convenience functions for working- with Kleisli arrows. -}
− Control/Proxy/Prelude/Base.hs
@@ -1,804 +0,0 @@--- | General purpose proxies--module Control.Proxy.Prelude.Base (- -- * Maps- mapD,- mapU,- mapB,- mapMD,- mapMU,- mapMB,- useD,- useU,- useB,- execD,- execU,- execB,-- -- * Filters- takeB,- takeB_,- takeWhileD,- takeWhileU,- dropD,- dropU,- dropWhileD,- dropWhileU,- filterD,- filterU,-- -- * Lists- fromListS,- fromListC,-- -- * Enumerations- enumFromS,- enumFromC,- enumFromToS,- enumFromToC,-- -- * Folds- foldD,- foldU,- allD,- allU,- allD_,- allU_,- anyD,- anyU,- anyD_,- anyU_,- sumD,- sumU,- productD,- productU,- lengthD,- lengthU,- headD,- headD_,- headU,- headU_,- lastD,- lastU,- toListD,- toListU,- foldrD,- foldrU,- foldlD',- foldlU',-- -- * Zips and Merges- zipD,- mergeD,-- -- * Closed Adapters- -- $open- unitD,- unitU,-- -- * Modules- -- $modules- module Control.Monad.Trans.State.Strict,- module Control.Monad.Trans.Writer.Strict,- module Data.Monoid- ) where--import Control.MFunctor (hoist)-import Control.Monad.Trans.Class (lift)-import Control.Monad.Trans.Writer.Strict (- WriterT(runWriterT), execWriterT, runWriter, tell )-import Control.Monad.Trans.State.Strict (- StateT(runStateT), execStateT, runState, execState, get, put )-import Control.Proxy.Class-import Control.Proxy.Synonym-import Control.Proxy.Trans.Identity (runIdentityP, runIdentityK)-import Data.Monoid (- Monoid,- Endo(Endo, appEndo),- All(All, getAll),- Any(Any, getAny),- Sum(Sum, getSum),- Product(Product, getProduct),- First(First, getFirst),- Last(Last, getLast) )--{-| @(mapD f)@ applies @f@ to all values going \'@D@\'ownstream.--> mapD f1 >-> mapD f2 = mapD (f2 . f1)->-> mapD id = idT--}-mapD :: (Monad m, Proxy p) => (a -> b) -> x -> p x a x b m r-mapD f = runIdentityK go where- go x = do- a <- request x- x2 <- respond (f a)- go x2--- mapD f = foreverK $ request >=> respond . f--{-| @(mapU g)@ applies @g@ to all values going \'@U@\'pstream.--> mapU g1 >-> mapU g2 = mapU (g1 . g2)->-> mapU id = idT--}-mapU :: (Monad m, Proxy p) => (b' -> a') -> b' -> p a' x b' x m r-mapU g = runIdentityK go where- go b' = do- x <- request (g b')- b'2 <- respond x- go b'2--- mapU g = foreverK $ (request . g) >=> respond--{-| @(mapB f g)@ applies @f@ to all values going downstream and @g@ to all- values going upstream.-- Mnemonic: map \'@B@\'idirectional--> mapB f1 g1 >-> mapB f2 g2 = mapB (f2 . f1) (g1 . g2)->-> mapB id id = idT--}-mapB :: (Monad m, Proxy p) => (a -> b) -> (b' -> a') -> b' -> p a' a b' b m r-mapB f g = runIdentityK go where- go b' = do- a <- request (g b')- b'2 <- respond (f a )- go b'2--- mapB f g = foreverK $ request . g >=> respond . f--{-| @(mapMD f)@ applies the monadic function @f@ to all values going downstream--> mapMD f1 >-> mapMD f2 = mapMD (f1 >=> f2)->-> mapMD return = idT--}-mapMD :: (Monad m, Proxy p) => (a -> m b) -> x -> p x a x b m r-mapMD f = runIdentityK go where- go x = do- a <- request x- b <- lift (f a)- x2 <- respond b- go x2--- mapMD f = foreverK $ request >=> lift . f >=> respond--{-| @(mapMU g)@ applies the monadic function @g@ to all values going upstream--> mapMU g1 >-> mapMU g2 = mapMU (g2 >=> g1)->-> mapMU return = idT--}-mapMU :: (Monad m, Proxy p) => (b' -> m a') -> b' -> p a' x b' x m r-mapMU g = runIdentityK go where- go b' = do- a' <- lift (g b')- x <- request a'- b'2 <- respond x- go b'2--- mapMU g = foreverK $ lift . g >=> request >=> respond--{-| @(mapMB f g)@ applies the monadic function @f@ to all values going- downstream and the monadic function @g@ to all values going upstream.--> mapMB f1 g1 >-> mapMB f2 g2 = mapMB (f1 >=> f2) (g2 >=> g1)->-> mapMB return return = idT--}-mapMB- :: (Monad m, Proxy p) => (a -> m b) -> (b' -> m a') -> b' -> p a' a b' b m r-mapMB f g = runIdentityK go where- go b' = do- a' <- lift (g b')- a <- request a'- b <- lift (f a )- b'2 <- respond b- go b'2--- mapMB f g = foreverK $ lift . g >=> request >=> lift . f >=> respond--{-| @(useD f)@ executes the monadic function @f@ on all values flowing- \'@D@\'ownstream--> useD f1 >-> useD f2 = useD (\a -> f1 a >> f2 a)->-> useD (\_ -> return ()) = idT--}-useD :: (Monad m, Proxy p) => (a -> m r1) -> x -> p x a x a m r-useD f = runIdentityK go where- go x = do- a <- request x- lift $ f a- x2 <- respond a- go x2--{-| @(useU g)@ executes the monadic function @g@ on all values flowing- \'@U@\'pstream--> useU g1 >-> useU g2 = useU (\a' -> g2 a' >> g1 a')->-> useU (\_ -> return ()) = idT--}-useU :: (Monad m, Proxy p) => (a' -> m r2) -> a' -> p a' x a' x m r-useU g = runIdentityK go where- go a' = do- lift $ g a'- x <- request a'- a'2 <- respond x- go a'2--{-| @(useB f g)@ executes the monadic function @f@ on all values flowing- downstream and the monadic function @g@ on all values flowing upstream--> useB f1 g1 >-> useB f2 g2 = useB (\a -> f1 a >> f2 a) (\a' -> g2 a' >> g1 a')->-> useB (\_ -> return ()) (\_ -> return ()) = idT--}-useB- :: (Monad m, Proxy p) => (a -> m r1) -> (a' -> m r2) -> a' -> p a' a a' a m r-useB f g = runIdentityK go where- go a' = do- lift $ g a'- a <- request a'- lift $ f a- a'2 <- respond a- go a'2--{-| @(execD md)@ executes @md@ every time values flow downstream through it.--> execD md1 >-> execD md2 = execD (md1 >> md2)->-> execD (return ()) = idT--}-execD :: (Monad m, Proxy p) => m r1 -> a' -> p a' a a' a m r-execD md = runIdentityK go where- go a' = do- a <- request a'- lift md- a'2 <- respond a- go a'2-{- execD md = foreverK $ \a' -> do- a <- request a'- lift md- respond a -}--{-| @(execU mu)@ executes @mu@ every time values flow upstream through it.--> execU mu1 >-> execU mu2 = execU (mu2 >> mu1)->-> execU (return ()) = idT--}-execU :: (Monad m, Proxy p) => m r2 -> a' -> p a' a a' a m r-execU mu = runIdentityK go where- go a' = do- lift mu- a <- request a'- a'2 <- respond a- go a'2-{- execU mu = foreverK $ \a' -> do- lift mu- a <- request a'- respond a -}--{-| @(execB md mu)@ executes @mu@ every time values flow upstream through it,- and executes @md@ every time values flow downstream through it.--> execB md1 mu1 >-> execB md2 mu2 = execB (md1 >> md2) (mu2 >> mu1)->-> execB (return ()) = idT--}-execB :: (Monad m, Proxy p) => m r1 -> m r2 -> a' -> p a' a a' a m r-execB md mu = runIdentityK go where- go a' = do- lift mu- a <- request a'- lift md- a'2 <- respond a- go a'2-{- execB md mu = foreverK $ \a' -> do- lift mu- a <- request a'- lift md- respond a -}--{-| @(takeB n)@ allows @n@ upstream/downstream roundtrips to pass through--> takeB n1 >=> takeB n2 = takeB (n1 + n2) -- n1 >= 0 && n2 >= 0->-> takeB 0 = return--}-takeB :: (Monad m, Proxy p) => Int -> a' -> p a' a a' a m a'-takeB n0 = runIdentityK (go n0) where- go n- | n <= 0 = return- | otherwise = \a' -> do- a <- request a'- a'2 <- respond a- go (n - 1) a'2--- takeB n = replicateK n $ request >=> respond---- | 'takeB_' is 'takeB' with a @()@ return value, convenient for composing-takeB_ :: (Monad m, Proxy p) => Int -> a' -> p a' a a' a m ()-takeB_ n0 = runIdentityK (go n0) where- go n- | n <= 0 = \_ -> return ()- | otherwise = \a' -> do- a <- request a'- a'2 <- respond a- go (n - 1) a'2--- takeB_ n = fmap void (takeB n)--{-| @(takeWhileD p)@ allows values to pass downstream so long as they satisfy- the predicate @p@.--> -- Using the "All" monoid over functions:-> mempty = \_ -> True-> (p1 <> p2) a = p1 a && p2 a->-> takeWhileD p1 >-> takeWhileD p2 = takeWhileD (p1 <> p2)->-> takeWhileD mempty = idT--}-takeWhileD :: (Monad m, Proxy p) => (a -> Bool) -> a' -> p a' a a' a m ()-takeWhileD p = runIdentityK go where- go a' = do- a <- request a'- if (p a)- then do- a'2 <- respond a- go a'2- else return ()--{-| @(takeWhileU p)@ allows values to pass upstream so long as they satisfy the- predicate @p@.--> takeWhileU p1 >-> takeWhileU p2 = takeWhileU (p1 <> p2)->-> takeWhileD mempty = idT--}-takeWhileU :: (Monad m, Proxy p) => (a' -> Bool) -> a' -> p a' a a' a m ()-takeWhileU p = runIdentityK go where- go a' =- if (p a')- then do- a <- request a'- a'2 <- respond a- go a'2- else return_P ()--{-| @(dropD n)@ discards @n@ values going downstream--> dropD n1 >-> dropD n2 = dropD (n1 + n2) -- n2 >= 0 && n2 >= 0->-> dropD 0 = idT--}-dropD :: (Monad m, Proxy p) => Int -> () -> Pipe p a a m r-dropD n0 = \() -> runIdentityP (go n0) where- go n- | n <= 0 = idT ()- | otherwise = do- request ()- go (n - 1)-{- dropD n () = do- replicateM_ n $ request ()- idT () -}--{-| @(dropU n)@ discards @n@ values going upstream--> dropU n1 >-> dropU n2 = dropU (n1 + n2) -- n2 >= 0 && n2 >= 0->-> dropU 0 = idT--}-dropU :: (Monad m, Proxy p) => Int -> a' -> CoPipe p a' a' m r-dropU n0 = runIdentityK (go n0) where- go n- | n <= 0 = idT- | otherwise = \_ -> do- a' <- respond ()- go (n - 1) a'--{-| @(dropWhileD p)@ discards values going downstream until one violates the- predicate @p@.--> -- Using the "Any" monoid over functions:-> mempty = \_ -> False-> (p1 <> p2) a = p1 a || p2 a->-> dropWhileD p1 >-> dropWhileD p2 = dropWhileD (p1 <> p2)->-> dropWhileD mempty = idT--}-dropWhileD :: (Monad m, Proxy p) => (a -> Bool) -> () -> Pipe p a a m r-dropWhileD p () = runIdentityP go where- go = do- a <- request ()- if (p a)- then go- else do- x <- respond a- idT x--{-| @(dropWhileU p)@ discards values going upstream until one violates the- predicate @p@.--> dropWhileU p1 >-> dropWhileU p2 = dropWhileU (p1 <> p2)->-> dropWhileU mempty = idT--}-dropWhileU :: (Monad m, Proxy p) => (a' -> Bool) -> a' -> CoPipe p a' a' m r-dropWhileU p = runIdentityK go where- go a' =- if (p a')- then do- a2 <- respond ()- go a2- else idT a'--{-| @(filterD p)@ discards values going downstream if they fail the predicate- @p@--> -- Using the "All" monoid over functions:-> mempty = \_ -> True-> (p1 <> p2) a = p1 a && p2 a->-> filterD p1 >-> filterD p2 = filterD (p1 <> p2)->-> filterD mempty = idT--}-filterD :: (Monad m, Proxy p) => (a -> Bool) -> () -> Pipe p a a m r-filterD p = \() -> runIdentityP go where- go = do- a <- request ()- if (p a)- then do- respond a- go- else go--{-| @(filterU p)@ discards values going upstream if they fail the predicate @p@--> filterU p1 >-> filterU p2 = filterU (p1 <> p2)->-> filterU mempty = idT--}-filterU :: (Monad m, Proxy p) => (a' -> Bool) -> a' -> CoPipe p a' a' m r-filterU p = runIdentityK go where- go a' =- if (p a')- then do- request a'- a'2 <- respond ()- go a'2- else do- a'2 <- respond ()- go a'2--{-| Convert a list into a 'Producer'--> fromListS xs >=> fromListS ys = fromListS (xs ++ ys)->-> fromListS [] = return--}-fromListS :: (Monad m, Proxy p) => [b] -> () -> Producer p b m ()-fromListS xs = \_ -> foldr (\e a -> respond e ?>= \_ -> a) (return_P ()) xs--- fromListS xs _ = mapM_ respond xs--{-| Convert a list into a 'CoProducer'--> fromListC xs >=> fromListC ys = fromListC (xs ++ ys)->-> fromListC [] = return--}-fromListC :: (Monad m, Proxy p) => [a'] -> () -> CoProducer p a' m ()-fromListC xs = \_ -> foldr (\e a -> request e ?>= \_ -> a) (return_P ()) xs--- fromListC xs _ = mapM_ request xs---- | 'Producer' version of 'enumFrom'-enumFromS :: (Enum b, Monad m, Proxy p) => b -> () -> Producer p b m r-enumFromS b0 = \_ -> runIdentityP (go b0) where- go b = do- respond b- go (succ b)---- | 'CoProducer' version of 'enumFrom'-enumFromC :: (Enum a', Monad m, Proxy p) => a' -> () -> CoProducer p a' m r-enumFromC a'0 = \_ -> runIdentityP (go a'0) where- go a' = do- request a'- go (succ a')---- | 'Producer' version of 'enumFromTo'-enumFromToS- :: (Enum b, Ord b, Monad m, Proxy p) => b -> b -> () -> Producer p b m ()-enumFromToS b1 b2 _ = runIdentityP (go b1) where- go b- | b > b2 = return ()- | otherwise = do- respond b- go (succ b)---- | 'CoProducer' version of 'enumFromTo'-enumFromToC- :: (Enum a', Ord a', Monad m, Proxy p)- => a' -> a' -> () -> CoProducer p a' m ()-enumFromToC a1 a2 _ = runIdentityP (go a1) where- go n- | n > a2 = return ()- | otherwise = do- request n- go (succ n)--{-| Fold values flowing \'@D@\'ownstream--> foldD f >-> foldD g = foldD (f <> g)->-> foldD mempty = idT--}-foldD- :: (Monad m, Proxy p, Monoid w) => (a -> w) -> x -> p x a x a (WriterT w m) r-foldD f = runIdentityK go where- go x = do- a <- request x- lift $ tell $ f a- x2 <- respond a- go x2--{-| Fold values flowing \'@U@\'pstream--> foldU f >-> foldU g = foldU (g <> f)->-> foldU mempty = idT--}-foldU- :: (Monad m, Proxy p, Monoid w)- => (a' -> w) -> a' -> p a' x a' x (WriterT w m) r-foldU f = runIdentityK go where- go a' = do- lift $ tell $ f a'- x <- request a'- a'2 <- respond x- go a'2--{-| Fold that returns whether 'All' values flowing \'@D@\'ownstream satisfy the- predicate -}-allD :: (Monad m, Proxy p) => (a -> Bool) -> x -> p x a x a (WriterT All m) r-allD pred = foldD (All . pred)--{-| Fold that returns whether 'All' values flowing \'@U@\'pstream satisfy the- predicate -}-allU- :: (Monad m, Proxy p) => (a' -> Bool) -> a' -> p a' x a' x (WriterT All m) r-allU pred = foldU (All . pred)--{-| Fold that returns whether 'All' values flowing \'@D@\'ownstream satisfy the- predicate-- 'allD_' terminates on the first value that fails the predicate -}-allD_ :: (Monad m, Proxy p) => (a -> Bool) -> x -> p x a x a (WriterT All m) ()-allD_ pred = runIdentityK go where- go x = do- a <- request x- if (pred a)- then do- x2 <- respond a- go x2- else lift $ tell $ All False--{-| Fold that returns whether 'All' values flowing \'@U@\'pstream satisfy the- predicate-- 'allU_' terminates on the first value that fails the predicate -}-allU_- :: (Monad m, Proxy p) => (a' -> Bool) -> a' -> p a' x a' x (WriterT All m) ()-allU_ pred = runIdentityK go where- go a' =- if (pred a')- then do- x <- request a'- a'2 <- respond x- go a'2- else lift $ tell $ All False--{-| Fold that returns whether 'Any' value flowing \'@D@\'ownstream satisfies- the predicate -}-anyD :: (Monad m, Proxy p) => (a -> Bool) -> x -> p x a x a (WriterT Any m) r-anyD pred = foldD (Any . pred)--{-| Fold that returns whether 'Any' value flowing \'@U@\'pstream satisfies- the predicate -}-anyU- :: (Monad m, Proxy p) => (a' -> Bool) -> a' -> p a' x a' x (WriterT Any m) r-anyU pred = foldU (Any . pred)--{-| Fold that returns whether 'Any' value flowing \'@D@\'ownstream satisfies the- predicate-- 'anyD_' terminates on the first value that satisfies the predicate -}-anyD_ :: (Monad m, Proxy p) => (a -> Bool) -> x -> p x a x a (WriterT Any m) ()-anyD_ pred = runIdentityK go where- go x = do- a <- request x- if (pred a)- then lift $ tell $ Any True- else do- x2 <- respond a- go x2--{-| Fold that returns whether 'Any' value flowing \'@U@\'pstream satisfies the- predicate-- 'anyU_' terminates on the first value that satisfies the predicate -}-anyU_- :: (Monad m, Proxy p) => (a' -> Bool) -> a' -> p a' x a' x (WriterT Any m) ()-anyU_ pred = runIdentityK go where- go a' =- if (pred a')- then lift $ tell $ Any True- else do- x <- request a'- a'2 <- respond x- go a'2---- | Compute the 'Sum' of all values that flow \'@D@\'ownstream-sumD :: (Monad m, Proxy p, Num a) => x -> p x a x a (WriterT (Sum a) m) r-sumD = foldD Sum---- | Compute the 'Sum' of all values that flow \'@U@\'pstream-sumU :: (Monad m, Proxy p, Num a') => a' -> p a' x a' x (WriterT (Sum a') m) r-sumU = foldU Sum---- | Compute the 'Product' of all values that flow \'@D@\'ownstream-productD- :: (Monad m, Proxy p, Num a) => x -> p x a x a (WriterT (Product a) m) r-productD = foldD Product---- | Compute the 'Product' of all values that flow \'@U@\'pstream-productU- :: (Monad m, Proxy p, Num a') => a' -> p a' x a' x (WriterT (Product a') m) r-productU = foldU Product---- | Count how many values flow \'@D@\'ownstream-lengthD :: (Monad m, Proxy p) => x -> p x a x a (WriterT (Sum Int) m) r-lengthD = foldD (\_ -> Sum 1)---- | Count how many values flow \'@U@\'pstream-lengthU :: (Monad m, Proxy p) => a' -> p a' x a' x (WriterT (Sum Int) m) r-lengthU = foldU (\_ -> Sum 1)---- | Retrieve the first value going \'@D@\'ownstream-headD :: (Monad m, Proxy p) => x -> p x a x a (WriterT (First a) m) r-headD = foldD (First . Just)--{-| Retrieve the first value going \'@D@\'ownstream-- 'headD_' terminates on the first value it receives -}-headD_ :: (Monad m, Proxy p) => x -> p x a x a (WriterT (First a) m) ()-headD_ x = runIdentityP $ do- a <- request x- lift $ tell $ First (Just a)---- | Retrieve the first value going \'@U@\'pstream-headU :: (Monad m, Proxy p) => a' -> p a' x a' x (WriterT (First a') m) r-headU = foldU (First . Just)--{-| Retrieve the first value going \'@U@\'pstream-- 'headU_' terminates on the first value it receives -}-headU_ :: (Monad m, Proxy p) => a' -> p a' x a' x (WriterT (First a') m) ()-headU_ a' = runIdentityP $ lift $ tell $ First (Just a')---- | Retrieve the last value going \'@D@\'ownstream-lastD :: (Monad m, Proxy p) => x -> p x a x a (WriterT (Last a) m) r-lastD = foldD (Last . Just)---- | Retrieve the last value going \'@U@\'pstream-lastU :: (Monad m, Proxy p) => a' -> p a' x a' x (WriterT (Last a') m) r-lastU = foldU (Last . Just)---- | Fold the values flowing \'@D@\'ownstream into a list-toListD :: (Monad m, Proxy p) => x -> p x a x a (WriterT [a] m) r-toListD = foldD (\x -> [x])---- | Fold the values flowing \'@U@\'pstream into a list-toListU :: (Monad m, Proxy p) => a' -> p a' x a' x (WriterT [a'] m) r-toListU = foldU (\x -> [x])--{-| Fold equivalent to 'foldr'-- To see why, consider this isomorphic type for 'foldr':--> foldr :: (a -> b -> b) -> [a] -> Endo b--}-foldrD- :: (Monad m, Proxy p) => (a -> b -> b) -> x -> p x a x a (WriterT (Endo b) m) r-foldrD step = foldD (Endo . step)---- | Fold equivalent to 'foldr'-foldrU- :: (Monad m, Proxy p)- => (a' -> b -> b) -> a' -> p a' x a' x (WriterT (Endo b) m) r-foldrU step = foldU (Endo . step)---- | Left strict fold over \'@D@\'ownstream values-foldlD'- :: (Monad m, Proxy p) => (b -> a -> b) -> x -> p x a x a (StateT b m) r-foldlD' f = runIdentityK go where- go x = do- a <- request x- lift $ do- b <- get- put $! f b a- x2 <- respond a- go x2---- | Left strict fold over \'@U@\'pstream values-foldlU'- :: (Monad m, Proxy p) => (b -> a' -> b) -> a' -> p a' x a' x (StateT b m) r-foldlU' f = runIdentityK go where- go a' = do- lift $ do- b <- get- put $! f b a'- x <- request a'- a'2 <- respond x- go a'2---- | Zip values flowing downstream-zipD- :: (Monad m, Proxy p1, Proxy p2, Proxy p3)- => () -> Consumer p1 a (Consumer p2 b (Producer p3 (a, b) m)) r-zipD () = runIdentityP $ hoist (runIdentityP . hoist runIdentityP) go where- go = do- a <- request ()- lift $ do- b <- request ()- lift $ respond (a, b)- go---- | Interleave values flowing downstream using simple alternation-mergeD- :: (Monad m, Proxy p1, Proxy p2, Proxy p3)- => () -> Consumer p1 a (Consumer p2 a (Producer p3 a m)) r-mergeD () = runIdentityP $ hoist (runIdentityP . hoist runIdentityP) go where- go = do- a1 <- request ()- lift $ do- lift $ respond a1- a2 <- request ()- lift $ respond a2- go--{- $open- Use the @unit@ functions when you need to embed a proxy with a closed end- within an open proxy. For example, the following code will not type-check- because @fromListS [1..]@ is a 'Producer' and has a closed upstream end,- which conflicts with the 'request' statement preceding it:--> p () = do-> request ()-> fromList [1..] ()-- You fix this by composing 'unitD' upstream of it, which replaces its closed- upstream end with an open polymorphic end:--> p () = do-> request ()-> (fromList [1..] <-< unitD) ()---}---- | Compose 'unitD' with a closed upstream end to create a polymorphic end-unitD :: (Monad m, Proxy p) => y' -> p x' x y' () m r-unitD _ = runIdentityP go where- go = do- respond ()- go---- | Compose 'unitU' with a closed downstream end to create a polymorphic end-unitU :: (Monad m, Proxy p) => y' -> p () x y' y m r-unitU _ = runIdentityP go where- go = do- request ()- go--{- $modules- These modules help you build, run, and extract folds--}
− Control/Proxy/Prelude/IO.hs
@@ -1,224 +0,0 @@-{-| 'String'-based 'IO' operations.-- Note that 'String's are very inefficient, and I will release future separate- packages with 'ByteString' and 'Text' operations. I only provide these to- allow users to test simple I/O without requiring additional library- dependencies. -}--module Control.Proxy.Prelude.IO (- -- * Standard I/O- -- ** Input- getLineS,- getLineC,- readLnS,- readLnC,- -- ** Output- printB,- printD,- printU,- putStrLnB,- putStrLnD,- putStrLnU,- -- ** Interaction- promptS,- promptC,- -- * Handle I/O- -- ** Input- hGetLineS,- hGetLineC,- -- ** Output- hPrintB,- hPrintD,- hPrintU,- hPutStrLnB,- hPutStrLnD,- hPutStrLnU,- ) where--import Control.Monad (forever)-import Control.Monad.Trans.Class (lift)-import Control.Proxy.Prelude.Kleisli (foreverK)-import Control.Proxy.Class (Proxy(request, respond))-import Control.Proxy.Trans.Identity (runIdentityP, runIdentityK)-import Control.Proxy.Synonym (Client, Server, Producer, CoProducer)-import qualified System.IO as IO---- | A 'Producer' that sends lines from 'stdin' downstream-getLineS :: (Proxy p) => () -> Producer p String IO r-getLineS () = runIdentityP $ forever $ do- str <- lift getLine- respond str---- | A 'CoProducer' that sends lines from 'stdin' upstream-getLineC :: (Proxy p) => () -> CoProducer p String IO r-getLineC () = runIdentityP $ forever $ do- str <- lift getLine- request str---- | 'read' input from 'stdin' one line at a time and send \'@D@\'ownstream-readLnS :: (Read b, Proxy p) => () -> Producer p b IO r-readLnS () = runIdentityP $ forever $ do- a <- lift readLn- respond a---- | 'read' input from 'stdin' one line at a time and send \'@U@\'pstream-readLnC :: (Read a', Proxy p) => () -> CoProducer p a' IO r-readLnC () = runIdentityP $ forever $ do- a <- lift readLn- request a--{-| 'print's all values flowing through it to 'stdout'-- Prefixes upstream values with \"@U: @\" and downstream values with \"@D: @\"--}-printB :: (Show a', Show a, Proxy p) => a' -> p a' a a' a IO r-printB = runIdentityK $ foreverK $ \a' -> do- lift $ do- putStr "U: "- print a'- a <- request a'- lift $ do- putStr "D: "- print a- respond a---- | 'print's all values flowing \'@D@\'ownstream to 'stdout'-printD :: (Show a, Proxy p) => x -> p x a x a IO r-printD = runIdentityK $ foreverK $ \x -> do- a <- request x- lift $ print a- respond a---- | 'print's all values flowing \'@U@\'pstream to 'stdout'-printU :: (Show a', Proxy p) => a' -> p a' x a' x IO r-printU = runIdentityK $ foreverK $ \a' -> do- lift $ print a'- x <- request a'- respond x--{-| 'putStrLn's all values flowing through it to 'stdout'-- Prefixes upstream values with \"@U: @\" and downstream values with \"@D: @\"--}-putStrLnB :: (Proxy p) => String -> p String String String String IO r-putStrLnB = runIdentityK $ foreverK $ \a' -> do- lift $ do- putStr "U: "- putStrLn a'- a <- request a'- lift $ do- putStr "D: "- putStrLn a- respond a---- | 'putStrLn's all values flowing \'@D@\'ownstream to 'stdout'-putStrLnD :: (Proxy p) => x -> p x String x String IO r-putStrLnD = runIdentityK $ foreverK $ \x -> do- a <- request x- lift $ putStrLn a- respond a---- | 'putStrLn's all values flowing \'@U@\'pstream to 'stdout'-putStrLnU :: (Proxy p) => String -> p String x String x IO r-putStrLnU = runIdentityK $ foreverK $ \a' -> do- lift $ putStrLn a'- x <- request a'- respond x---- | Convert 'stdin'/'stdout' into a line-based 'Server'-promptS :: (Proxy p) => String -> Server p String String IO r-promptS = runIdentityK $ foreverK $ \send -> do- recv <- lift $ do- putStrLn send- getLine- respond recv---- | Convert 'stdin'/'stdout' into a line-based 'Client'-promptC :: (Proxy p) => () -> Client p String String IO r-promptC () = runIdentityP $ forever $ do- send <- lift getLine- recv <- request send- lift $ putStrLn recv---- | A 'Producer' that sends lines from a handle downstream-hGetLineS :: (Proxy p) => IO.Handle -> () -> Producer p String IO ()-hGetLineS h () = runIdentityP go where- go = do- eof <- lift $ IO.hIsEOF h- if eof- then return ()- else do- str <- lift $ IO.hGetLine h- respond str- go---- | A 'CoProducer' that sends lines from a 'Handle' upstream-hGetLineC :: (Proxy p) => IO.Handle -> () -> CoProducer p String IO ()-hGetLineC h () = runIdentityP go where- go = do- eof <- lift $ IO.hIsEOF h- if eof- then return ()- else do- str <- lift $ IO.hGetLine h- request str- go--{-| 'print's all values flowing through it to a 'Handle'-- Prefixes upstream values with \"@U: @\" and downstream values with \"@D: @\"--}-hPrintB :: (Show a, Show a', Proxy p) => IO.Handle -> a' -> p a' a a' a IO r-hPrintB h = runIdentityK $ foreverK $ \a' -> do- lift $ do- IO.hPutStr h "U: "- IO.hPrint h a'- a <- request a'- lift $ do- IO.hPutStr h "D: "- IO.hPrint h a- respond a---- | 'print's all values flowing \'@D@\'ownstream to a 'Handle'-hPrintD :: (Show a, Proxy p) => IO.Handle -> x -> p x a x a IO r-hPrintD h = runIdentityK $ foreverK $ \x -> do- a <- request x- lift $ IO.hPrint h a- respond a---- | 'print's all values flowing \'@U@\'pstream to a 'Handle'-hPrintU :: (Show a', Proxy p) => IO.Handle -> a' -> p a' x a' x IO r-hPrintU h = runIdentityK $ foreverK $ \a' -> do- lift $ IO.hPrint h a'- x <- request a'- respond x--{-| 'putStrLn's all values flowing through it to a 'Handle'-- Prefixes upstream values with \"@U: @\" and downstream values with \"@D: @\"--}-hPutStrLnB- :: (Proxy p) => IO.Handle -> String -> p String String String String IO r-hPutStrLnB h = runIdentityK $ foreverK $ \a' -> do- lift $ do- IO.hPutStr h "U: "- IO.hPutStrLn h a'- a <- request a'- lift $ do- IO.hPutStr h "D: "- IO.hPutStrLn h a- respond a---- | 'putStrLn's all values flowing \'@D@\'ownstream to a 'Handle'-hPutStrLnD :: (Proxy p) => IO.Handle -> x -> p x String x String IO r-hPutStrLnD h = runIdentityK $ foreverK $ \x -> do- a <- request x- lift $ IO.hPutStrLn h a- respond a---- | 'putStrLn's all values flowing \'@U@\'pstream to a 'Handle'-hPutStrLnU :: (Proxy p) => IO.Handle -> String -> p String x String x IO r-hPutStrLnU h = runIdentityK $ foreverK $ \a' -> do- lift $ IO.hPutStrLn h a'- x <- request a'- respond x
− Control/Proxy/Prelude/Kleisli.hs
@@ -1,87 +0,0 @@-{-# LANGUAGE Rank2Types #-}---- | Utility functions for Kleisli arrows--module Control.Proxy.Prelude.Kleisli (- -- * Core utility functions- foreverK,- replicateK,- liftK,- hoistK,- raiseK,- ) where--import Control.MFunctor (MFunctor(hoist))-import Control.Monad.Trans.Class (MonadTrans(lift))--{-| Compose a \'@K@\'leisli arrow with itself forever-- Use 'foreverK' to abstract away the following common recursion pattern:--> p a = do-> ...-> a' <- respond b-> p a'-- Using 'foreverK', you can instead write:--> p = foreverK $ \a -> do-> ...-> respond b--}-foreverK :: (Monad m) => (a -> m a) -> (a -> m b)-foreverK k = let r = \a -> k a >>= r in r-{- foreverK uses 'let' to avoid a space leak.- See: http://hackage.haskell.org/trac/ghc/ticket/5205 -}---- | Repeat a \'@K@\'leisli arrow multiple times-replicateK :: (Monad m) => Int -> (a -> m a) -> (a -> m a)-replicateK n0 k = go n0 where- go n- | n < 1 = return- | n == 1 = k- | otherwise = \a -> k a >>= go (n - 1)--{-| Convenience function equivalent to @(lift .)@--> liftK f >=> liftK g = liftK (f >=> g)->-> liftK return = return--}-liftK :: (Monad m, MonadTrans t) => (a -> m b) -> (a -> t m b)-liftK k a = lift (k a)--- liftK = (lift .)--{-| Convenience function equivalent to @(hoist f .)@--> hoistK f p1 >-> hoistK f p2 = hoistK f (p1 >-> p2)->-> hoistK f idT = idT--> hoistK f p1 >=> hoistK f p2 = hoistK f (p1 >=> p2)->-> hoistK f return = return--> hoistK f . hoistK g = hoistK (f . g)->-> hoistK id = id--}-hoistK- :: (Monad m, MFunctor t)- => (forall a . m a -> n a) -> ((b' -> t m b) -> (b' -> t n b))-hoistK k p a' = hoist k (p a')--- hoistK k = (hoist k .)--{-| Convenience function equivalent to @(hoist lift .)@--> raiseK p1 >-> raiseK p2 = raiseK (p1 >-> p2)->-> raiseK idT = idT--> raiseK p1 >=> raiseK p2 = raiseK (p1 >=> p2)->-> raiseK return = return--}-raiseK- :: (Monad m, MFunctor t1, MonadTrans t2) => (q -> t1 m r) -> (q -> t1 (t2 m) r)-raiseK = (hoist lift .)
− Control/Proxy/Synonym.hs
@@ -1,66 +0,0 @@-{-# LANGUAGE KindSignatures #-}--{-| These type synonyms simplify type signatures when proxies do not use all- their type variables. -}--module Control.Proxy.Synonym (- -- * Synonyms- Pipe,- Producer,- Consumer,- CoPipe,- CoProducer,- CoConsumer,- Client,- Server,- Session,-- -- * Closed- C- ) where---- | A unidirectional 'Proxy'.-type Pipe (p :: * -> * -> * -> * -> (* -> *) -> * -> *) a b = p () a () b--{-| A 'Pipe' that produces values-- 'Producer's never 'request'. -}-type Producer (p :: * -> * -> * -> * -> (* -> *) -> * -> *) b = p C () () b--{-| A 'Pipe' that consumes values-- 'Consumer's never 'respond'. -}-type Consumer (p :: * -> * -> * -> * -> (* -> *) -> * -> *) a = p () a () C---- | A 'Pipe' where everything flows upstream-type CoPipe (p :: * -> * -> * -> * -> (* -> *) -> * -> *) a' b' = p a' () b' ()--{-| A 'CoPipe' that produces values flowing upstream-- 'CoProducer's never 'respond'. -}-type CoProducer (p :: * -> * -> * -> * -> (* -> *) -> * -> *) a' = p a' () () C--{-| A 'CoConsumer' that consumes values flowing upstream-- 'CoConsumer's never 'request'. -}-type CoConsumer (p :: * -> * -> * -> * -> (* -> *) -> * -> *) b' = p C () b' ()--{-| @Server b' b@ receives requests of type @b'@ and sends responses of type- @b@.-- 'Server's never 'request'. -}-type Server (p :: * -> * -> * -> * -> (* -> *) -> * -> *) b' b = p C () b' b--{-| @Client a' a@ sends requests of type @a'@ and receives responses of- type @a@.-- 'Client's never 'respond'. -}-type Client (p :: * -> * -> * -> * -> (* -> *) -> * -> *) a' a = p a' a () C--{-| A self-contained 'Session', ready to be run by 'runSession'-- 'Session's never 'request' or 'respond'. -}-type Session (p :: * -> * -> * -> * -> (* -> *) -> * -> *) = p C () () C---- | The empty type, denoting a \'@C@\'losed end-data C = C -- Constructor not exported, but I include it to avoid EmptyDataDecls
− Control/Proxy/Trans.hs
@@ -1,71 +0,0 @@-{-| You can define your own proxy extensions by writing your own \"proxy- transformers\". Proxy transformers are monad transformers that also- correctly lift all proxy operations from the base proxy type to the- extended proxy type. Stack multiple proxy transformers to chain features- together.--}- -module Control.Proxy.Trans (- -- * Proxy Transformers- ProxyTrans(..),- mapP-- -- * Laws- -- $laws- ) where--import Control.Proxy.Class---- | Uniform interface to lifting proxies-class ProxyTrans t where- liftP :: (Monad m, Proxy p) => p a' a b' b m r -> t p a' a b' b m r--{-| Lift a 'Proxy' Kleisli arrow--> mapP = (lift .)--}-mapP :: (Monad m, Proxy p, ProxyTrans t)- => (q -> p a' a b' b m r) -> (q -> t p a' a b' b m r)-mapP = (liftP .)--{- $laws- 'mapP' defines a functor that preserves five categories:-- * Kleisli category-- * The two Proxy categories-- * \"request\" category-- * \"respond\" category-- Laws:-- * Functor between 'Proxy' categories--> mapP (f >-> g) = mapP f >-> mapP g->-> mapP idT = idT--> mapP (f >~> g) = mapP f >~> mapP g->-> mapP idPush = idPush-- * Functor between Kleisli categories--> mapP (f <=< g) = mapP f <=< mapP g->-> mapP return = return-- * Functor between \"request\" categories--> mapP (f /</ g) = mapP f /</ mapP g -- when /</ is defined->-> mapP request = request-- * Functor between \"respond\" categories--> mapP (f \<\ g) = mapP f \<\ mapP g -- when \<\ is defined->-> mapP respond = respond--}
− Control/Proxy/Trans/Either.hs
@@ -1,181 +0,0 @@--- | This module provides the proxy transformer equivalent of 'EitherT'.--{-# LANGUAGE KindSignatures #-}--module Control.Proxy.Trans.Either (- -- * EitherP- EitherP(..),- runEitherK,- -- * Either operations- left,- right,- -- * Symmetric monad- -- $symmetry- throw,- catch,- handle- ) where--import Control.Applicative (Applicative(pure, (<*>)), Alternative(empty, (<|>)))-import Control.Monad (MonadPlus(mzero, mplus))-import Control.Monad.IO.Class (MonadIO(liftIO))-import Control.Monad.Trans.Class (MonadTrans(lift))-import Control.MFunctor (MFunctor(hoist))-import Control.PFunctor (PFunctor(hoistP))-import Control.Proxy.Class-import Control.Proxy.Trans (ProxyTrans(liftP))-import Prelude hiding (catch)---- | The 'Either' proxy transformer-newtype EitherP e p a' a b' b (m :: * -> *) r- = EitherP { runEitherP :: p a' a b' b m (Either e r) }--instance (Proxy p, Monad m)- => Functor (EitherP e p a' a b' b m) where- fmap f p = EitherP (- runEitherP p ?>= \e ->- return_P (case e of- Left l -> Left l- Right r -> Right (f r) ) )- -- fmap f = EitherP . liftM (fmap f) . runEitherP--instance (Proxy p, Monad m)- => Applicative (EitherP e p a' a b' b m) where- pure = return- fp <*> xp = EitherP (- runEitherP fp ?>= \e1 ->- case e1 of- Left l -> return_P (Left l)- Right f ->- runEitherP xp ?>= \e2 ->- return_P (case e2 of- Left l -> Left l- Right x -> Right (f x) ) )- -- fp <*> xp = EitherP ((<*>) <$> (runEitherP fp) <*> (runEitherP xp))--instance (Proxy p, Monad m)- => Monad (EitherP e p a' a b' b m) where- return = return_P- (>>=) = (?>=)--instance (MonadPlusP p, Monad m)- => Alternative (EitherP e p a' a b' b m) where- empty = mzero- (<|>) = mplus--instance (MonadPlusP p )- => MonadPlusP (EitherP e p) where- mzero_P = EitherP mzero_P- mplus_P m1 m2 = EitherP (mplus_P (runEitherP m1) (runEitherP m2))--instance (MonadPlusP p, Monad m)- => MonadPlus (EitherP e p a' a b' b m) where- mzero = mzero_P- mplus = mplus_P--instance (Proxy p )- => MonadTrans (EitherP e p a' a b' b) where- lift = lift_P--instance (MonadIOP p )- => MonadIOP (EitherP e p) where- liftIO_P m = EitherP (liftIO_P (m >>= \x -> return (Right x)))- -- liftIO = EitherP . liftIO . liftM Right--instance (MonadIOP p, MonadIO m)- => MonadIO (EitherP e p a' a b' b m) where- liftIO = liftIO_P--instance (Proxy p )- => MFunctor (EitherP e p a' a b' b) where- hoist = hoist_P--instance (Proxy p )- => Proxy (EitherP e p) where- p1 >-> p2 = \c'1 -> EitherP (- ((\b' -> runEitherP (p1 b')) >-> (\c'2 -> runEitherP (p2 c'2))) c'1 )- -- p1 >-> p2 = (EitherP .) $ runEitherP . p1 >-> runEitherP . p2-- p1 >~> p2 = \c'1 -> EitherP (- ((\b' -> runEitherP (p1 b')) >~> (\c'2 -> runEitherP (p2 c'2))) c'1 )- -- p1 >~> p2 = (EitherP .) $ runEitherP . p1 >~> runEitherP . p2-- request = \a' -> EitherP (request a' ?>= \a -> return_P (Right a ))- respond = \b -> EitherP (respond b ?>= \b' -> return_P (Right b'))-- return_P = right- m ?>= f = EitherP (- runEitherP m ?>= \e ->- runEitherP (case e of- Left l -> left l- Right r -> f r ) )-- lift_P m = EitherP (lift_P (m >>= \x -> return (Right x)))- -- lift = EitherP . lift . liftM Right-- hoist_P nat p = EitherP (hoist_P nat (runEitherP p))- -- hoist nat = EitherP . hoist nat . runEitherP--instance ProxyTrans (EitherP e) where- liftP p = EitherP (p ?>= \x -> return_P (Right x))- -- liftP = EitherP . liftM Right--instance PFunctor (EitherP e) where- hoistP nat = EitherP . nat . runEitherP---- | Run an 'EitherP' \'@K@\'leisi arrow, returning either a 'Left' or 'Right'-runEitherK- :: (q -> EitherP e p a' a b' b m r) -> (q -> p a' a b' b m (Either e r))-runEitherK p q = runEitherP (p q)--- runEitherK = (runEitherP .)---- | Abort the computation and return a 'Left' result-left :: (Monad m, Proxy p) => e -> EitherP e p a' a b' b m r-left e = EitherP (return_P (Left e))--- left = EitherP . return . Left---- | Synonym for 'return'-right :: (Monad m, Proxy p) => r -> EitherP e p a' a b' b m r-right r = EitherP (return_P (Right r))--- right = EitherP . return . Right--{- $symmetry- 'EitherP' forms a second symmetric monad over the left type variable.-- 'throw' is symmetric to 'return'-- 'catch' is symmetric to ('>>=')-- These two functions obey the monad laws:--> catch m throw = m->-> catch (throw e) f = f e->-> catch (catch m f) g = catch m (\e -> catch (f e) g)--}---- | Synonym for 'left'-throw :: (Monad m, Proxy p) => e -> EitherP e p a' a b' b m r-throw = left---- | Resume from an aborted operation-catch- :: (Monad m, Proxy p)- => EitherP e p a' a b' b m r -- ^ Original computation- -> (e -> EitherP f p a' a b' b m r) -- ^ Handler- -> EitherP f p a' a b' b m r -- ^ Handled computation-catch m f = EitherP (- runEitherP m ?>= \e ->- runEitherP (case e of- Left l -> f l- Right r -> right r ))---- | 'catch' with the arguments flipped-handle- :: (Monad m, Proxy p)- => (e -> EitherP f p a' a b' b m r) -- ^ Handler- -> EitherP e p a' a b' b m r -- ^ Original computation- -> EitherP f p a' a b' b m r -- ^ Handled computation-handle f m = catch m f--- handle = flip catch
− Control/Proxy/Trans/Identity.hs
@@ -1,136 +0,0 @@--- | This module provides the proxy transformer equivalent of 'IdentityT'.--{-# LANGUAGE KindSignatures #-}--module Control.Proxy.Trans.Identity (- -- * Identity Proxy Transformer- IdentityP(..),- identityK,- runIdentityK- ) where--import Control.Applicative (Applicative(pure, (<*>)), Alternative(empty, (<|>)))-import Control.Monad (MonadPlus(mzero, mplus))-import Control.Monad.IO.Class (MonadIO(liftIO))-import Control.Monad.Trans.Class (MonadTrans(lift))-import Control.MFunctor (MFunctor(hoist))-import Control.PFunctor (PFunctor(hoistP))-import Control.Proxy.Class-import Control.Proxy.Trans (ProxyTrans(liftP))---- | The 'Identity' proxy transformer-newtype IdentityP p a' a b' b (m :: * -> *) r =- IdentityP { runIdentityP :: p a' a b' b m r }--instance (Proxy p, Monad m)- => Functor (IdentityP p a' a b' b m) where- fmap f p = IdentityP (- runIdentityP p ?>= \x ->- return_P (f x) )- -- fmap = liftM--instance (Proxy p, Monad m)- => Applicative (IdentityP p a' a b' b m) where- pure = return-- fp <*> xp = IdentityP (- runIdentityP fp ?>= \f ->- runIdentityP xp ?>= \x ->- return_P (f x) )- -- fp <*> xp = ap--instance (Proxy p, Monad m)- => Monad (IdentityP p a' a b' b m) where- return = return_P- (>>=) = (?>=)--instance (MonadPlusP p, Monad m)- => Alternative (IdentityP p a' a b' b m) where- empty = mzero- (<|>) = mplus--instance (MonadPlusP p )- => MonadPlusP (IdentityP p) where- mzero_P = IdentityP mzero_P- mplus_P m1 m2 = IdentityP (mplus_P (runIdentityP m1) (runIdentityP m2))--instance (MonadPlusP p, Monad m)- => MonadPlus (IdentityP p a' a b' b m) where- mzero = mzero_P- mplus = mplus_P--instance (Proxy p )- => MonadTrans (IdentityP p a' a b' b) where- lift = lift_P--instance (MonadIOP p )- => MonadIOP (IdentityP p) where- liftIO_P m = IdentityP (liftIO_P m)- -- liftIO = IdentityP . liftIO--instance (MonadIOP p, MonadIO m)- => MonadIO (IdentityP p a' a b' b m) where- liftIO = liftIO_P--instance (Proxy p )- => MFunctor (IdentityP p a' a b' b) where- hoist = hoist_P--instance (Proxy p )- => Proxy (IdentityP p) where- p1 >-> p2 = \c'1 -> IdentityP (- ((\c'2 -> runIdentityP (p1 c'2))- >-> (\b' -> runIdentityP (p2 b' )) ) c'1 )- -- p1 >-> p2 = (IdentityP .) $ runIdentityP . p1 >-> runIdentityP . p2-- p1 >~> p2 = \c'1 -> IdentityP (- ((\c'2 -> runIdentityP (p1 c'2))- >~> (\b' -> runIdentityP (p2 b' )) ) c'1 )- -- p1 >~> p2 = (IdentityP .) $ runIdentityP . p1 >~> runIdentityP . p2-- request = \a' -> IdentityP (request a')- -- request = P . request-- respond = \b -> IdentityP (respond b)- -- respond = P . respond-- return_P = \r -> IdentityP (return_P r)- -- return = P . return-- m ?>= f = IdentityP (- runIdentityP m ?>= \x ->- runIdentityP (f x) )-- lift_P m = IdentityP (lift_P m)- -- lift = P . lift-- hoist_P nat p = IdentityP (hoist_P nat (runIdentityP p))- -- hoist nat = IdentityP . hoist nat . runIdentityP--instance (Interact p )- => Interact (IdentityP p) where- p1 \>\ p2 = \c'1 -> IdentityP (- ((\b' -> runIdentityP (p1 b' ))- \>\ (\c'2 -> runIdentityP (p2 c'2)) ) c'1 )- -- p1 \>\ p2 = (IdentityP .) $ runIdentityP . p1 \>\ runIdentityP . p2-- p1 />/ p2 = \a1 -> IdentityP (- ((\a2 -> runIdentityP (p1 a2))- />/ (\b -> runIdentityP (p2 b )) ) a1 )- -- p1 />/ p2 = (IdentityP .) $ runIdentityP . p1 />/ runIdentityP . p2--instance ProxyTrans IdentityP where- liftP = IdentityP--instance PFunctor IdentityP where- hoistP nat = IdentityP . nat . runIdentityP---- | Wrap a \'@K@\'leisli arrow in 'IdentityP'-identityK :: (q -> p a' a b' b m r) -> (q -> IdentityP p a' a b' b m r)-identityK k q = IdentityP (k q)--- identityK = (IdentityP .)---- | Run an 'P' \'@K@\'leisli arrow-runIdentityK :: (q -> IdentityP p a' a b' b m r) -> (q -> p a' a b' b m r)-runIdentityK k q = runIdentityP (k q)--- runIdentityK = (runIdentityP .)
− Control/Proxy/Trans/Maybe.hs
@@ -1,136 +0,0 @@--- | This module provides the proxy transformer equivalent of 'MaybeT'.--{-# LANGUAGE KindSignatures #-}--module Control.Proxy.Trans.Maybe (- -- * MaybeP- MaybeP(..),- runMaybeK,- -- * Maybe operations- nothing,- just- ) where--import Control.Applicative (Applicative(pure, (<*>)), Alternative(empty, (<|>)))-import Control.Monad (MonadPlus(mzero, mplus))-import Control.Monad.IO.Class (MonadIO(liftIO))-import Control.Monad.Trans.Class (MonadTrans(lift))-import Control.MFunctor (MFunctor(hoist))-import Control.PFunctor (PFunctor(hoistP))-import Control.Proxy.Class-import Control.Proxy.Trans (ProxyTrans(liftP))---- | The 'Maybe' proxy transformer-newtype MaybeP p a' a b' b (m :: * -> *) r- = MaybeP { runMaybeP :: p a' a b' b m (Maybe r) }--instance (Proxy p, Monad m)- => Functor (MaybeP p a' a b' b m) where- fmap f p = MaybeP (- runMaybeP p ?>= \m ->- return_P (case m of- Nothing -> Nothing- Just x -> Just (f x) ) )- -- fmap f = MaybeP . fmap (fmap f) . runMaybeP--instance (Proxy p, Monad m)- => Applicative (MaybeP p a' a b' b m) where- pure = return-- fp <*> xp = MaybeP (- runMaybeP fp ?>= \m1 ->- case m1 of- Nothing -> return_P Nothing- Just f ->- runMaybeP xp ?>= \m2 ->- case m2 of- Nothing -> return_P Nothing- Just x -> return_P (Just (f x)) )- -- fp <*> xp = MaybeP ((<*>) <$> (runMaybeP fp) <*> (runMaybeP xp))--instance (Proxy p, Monad m)- => Monad (MaybeP p a' a b' b m) where- return = return_P- (>>=) = (?>=)--instance (Proxy p, Monad m)- => Alternative (MaybeP p a' a b' b m) where- empty = mzero- (<|>) = mplus--instance (Proxy p )- => MonadPlusP (MaybeP p) where- mzero_P = nothing- mplus_P m1 m2 = MaybeP (- runMaybeP m1 ?>= \ma ->- runMaybeP (case ma of- Nothing -> m2- Just a -> just a ) )--instance (Proxy p, Monad m)- => MonadPlus (MaybeP p a' a b' b m) where- mzero = mzero_P- mplus = mplus_P--instance (Proxy p )- => MonadTrans (MaybeP p a' a b' b) where- lift = lift_P--instance (MonadIOP p )- => MonadIOP (MaybeP p) where- liftIO_P m = MaybeP (liftIO_P (m >>= \x -> return (Just x)))- -- liftIO = MaybeP . liftIO . liftM Just--instance (MonadIOP p, MonadIO m)- => MonadIO (MaybeP p a' a b' b m) where- liftIO = liftIO_P--instance (Proxy p )- => MFunctor (MaybeP p a' a b' b) where- hoist = hoist_P--instance (Proxy p )- => Proxy (MaybeP p) where- p1 >-> p2 = \c'1 -> MaybeP (- ((\b' -> runMaybeP (p1 b')) >-> (\c'2 -> runMaybeP (p2 c'2))) c'1 )- -- p1 >-> p2 = (MaybeP .) $ runMaybeP . p1 >-> runMaybeP . p2-- p1 >~> p2 = \c'1 -> MaybeP (- ((\b' -> runMaybeP (p1 b')) >~> (\c'2 -> runMaybeP (p2 c'2))) c'1 )- -- p1 >~> p2 = (MaybeP .) $ runMaybeP . p1 >~> runMaybeP . p2-- request = \a' -> MaybeP (request a' ?>= \a -> return_P (Just a ))- respond = \b -> MaybeP (respond b ?>= \b' -> return_P (Just b'))-- return_P = just- m ?>= f = MaybeP (- runMaybeP m ?>= \ma ->- runMaybeP (case ma of- Nothing -> nothing- Just a -> f a ) )-- lift_P m = MaybeP (lift_P (m >>= \x -> return (Just x)))- -- lift = MaybeP . lift . liftM Just-- hoist_P nat p = MaybeP (hoist_P nat (runMaybeP p))- -- hoist nat = MaybeP . hoist nat . runMaybeP--instance ProxyTrans MaybeP where- liftP p = MaybeP (p ?>= \x -> return_P (Just x))- -- liftP = MaybeP . liftM Just--instance PFunctor MaybeP where- hoistP nat = MaybeP . nat . runMaybeP---- | Run a 'MaybeP' \'@K@\'leisli arrow, returning the result or 'Nothing'-runMaybeK :: (q -> MaybeP p a' a b' b m r) -> (q -> p a' a b' b m (Maybe r))-runMaybeK p q = runMaybeP (p q)--- runMaybeK = (runMaybeP .)---- | A synonym for 'mzero'-nothing :: (Monad m, Proxy p) => MaybeP p a' a b' b m r-nothing = MaybeP (return_P Nothing)---- | A synonym for 'return'-just :: (Monad m, Proxy p) => r -> MaybeP p a' a b' b m r-just r = MaybeP (return_P (Just r))
− Control/Proxy/Trans/Reader.hs
@@ -1,153 +0,0 @@--- | This module provides the proxy transformer equivalent of 'ReaderT'.--{-# LANGUAGE KindSignatures #-}--module Control.Proxy.Trans.Reader (- -- * ReaderP- ReaderP(..),- runReaderP,- runReaderK,- withReaderP,- -- * Reader operations- ask,- local,- asks,- ) where--import Control.Applicative (Applicative(pure, (<*>)), Alternative(empty, (<|>)))-import Control.Monad (MonadPlus(mzero, mplus))-import Control.Monad.IO.Class (MonadIO(liftIO))-import Control.Monad.Trans.Class (MonadTrans(lift))-import Control.MFunctor (MFunctor(hoist))-import Control.PFunctor (PFunctor(hoistP))-import Control.Proxy.Class-import Control.Proxy.Trans (ProxyTrans(liftP))---- | The 'Reader' proxy transformer-newtype ReaderP i p a' a b' b (m :: * -> *) r- = ReaderP { unReaderP :: i -> p a' a b' b m r }--instance (Proxy p, Monad m)- => Functor (ReaderP i p a' a b' b m) where- fmap f p = ReaderP (\i ->- unReaderP p i ?>= \x ->- return_P (f x) )--instance (Proxy p, Monad m)- => Applicative (ReaderP i p a' a b' b m) where- pure = return- p1 <*> p2 = ReaderP (\i ->- unReaderP p1 i ?>= \f -> - unReaderP p2 i ?>= \x -> - return_P (f x) )--instance (Proxy p, Monad m)- => Monad (ReaderP i p a' a b' b m) where- return = return_P- (>>=) = (?>=)--instance (MonadPlusP p, Monad m)- => Alternative (ReaderP i p a' a b' b m) where- empty = mzero- (<|>) = mplus--instance (MonadPlusP p )- => MonadPlusP (ReaderP i p) where- mzero_P = ReaderP (\_ -> mzero_P)- mplus_P m1 m2 = ReaderP (\i -> mplus_P (unReaderP m1 i) (unReaderP m2 i))--instance (MonadPlusP p, Monad m)- => MonadPlus (ReaderP i p a' a b' b m) where- mzero = mzero_P- mplus = mplus_P--instance (Proxy p )- => MonadTrans (ReaderP i p a' a b' b) where- lift = lift_P--instance (MonadIOP p )- => MonadIOP (ReaderP i p) where- liftIO_P m = ReaderP (\_ -> liftIO_P m)--instance (MonadIOP p, MonadIO m)- => MonadIO (ReaderP i p a' a b' b m) where- liftIO = liftIO_P--instance (Proxy p )- => MFunctor (ReaderP i p a' a b' b) where- hoist = hoist_P--instance (Proxy p )- => Proxy (ReaderP i p) where- p1 >-> p2 = \c'1 -> ReaderP (\i ->- ((\b' -> unReaderP (p1 b' ) i)- >-> (\c'2 -> unReaderP (p2 c'2) i) ) c'1 )- {- p1 >-> p2 = \c' -> ReaderP $ \i ->- ((`unReaderP` i) . p1 >-> (`unReaderP` i) . p2) c' -}-- p1 >~> p2 = \c'1 -> ReaderP (\i ->- ((\b' -> unReaderP (p1 b' ) i)- >~> (\c'2 -> unReaderP (p2 c'2) i) ) c'1 )- {- p1 >~> p2 = \c' -> ReaderP $ \i ->- ((`unReaderP` i) . p1 >~> (`unReaderP` i) . p2) c' -}-- return_P = \r -> ReaderP (\_ -> return_P r)- m ?>= f = ReaderP (\i ->- unReaderP m i ?>= \a -> - unReaderP (f a) i )-- request = \a -> ReaderP (\_ -> request a)- respond = \a -> ReaderP (\_ -> respond a)-- lift_P m = ReaderP (\_ -> lift_P m)-- hoist_P nat p = ReaderP (\i -> hoist_P nat (unReaderP p i))- -- hoist_P nat = ReaderP . fmap (hoist_P nat) . unReaderP--instance (Interact p)- => Interact (ReaderP i p) where- p1 \>\ p2 = \c'1 -> ReaderP (\i ->- ((\b' -> unReaderP (p1 b' ) i)- \>\ (\c'2 -> unReaderP (p2 c'2) i) ) c'1 )- {- p1 \>\ p2 = \c' -> ReaderP $ \i ->- ((`unReaderP` i) . p1 \>\ (`unReaderP` i) . p2) c' -}-- p1 />/ p2 = \a1 -> ReaderP (\i ->- ((\b -> unReaderP (p1 b ) i)- />/ (\a2 -> unReaderP (p2 a2) i) ) a1 )- {- p1 />/ p2 = \a -> ReaderP $ \i ->- ((`unReaderP` i) . p1 />/ (`unReaderP` i) . p2) a -}--instance ProxyTrans (ReaderP i) where- liftP m = ReaderP (\_ -> m)--instance PFunctor (ReaderP i) where- hoistP nat = ReaderP . (nat .) . unReaderP---- | Run a 'ReaderP' computation, supplying the environment-runReaderP :: i -> ReaderP i p a' a b' b m r -> p a' a b' b m r-runReaderP i m = unReaderP m i---- | Run a 'ReaderP' \'@K@\'leisli arrow, supplying the environment-runReaderK :: i -> (q -> ReaderP i p a' a b' b m r) -> (q -> p a' a b' b m r)-runReaderK i p q = runReaderP i (p q)--- runReaderK i = (runReaderP i .)---- | Modify a computation's environment (a more general version of 'local')-withReaderP- :: (j -> i) -> ReaderP i p a' a b' b m r -> ReaderP j p a' a b' b m r-withReaderP f p = ReaderP (\i -> unReaderP p (f i))--- withReaderP f p = ReaderP $ unReaderP p . f---- | Get the environment-ask :: (Proxy p, Monad m) => ReaderP i p a' a b' b m i-ask = ReaderP return_P---- | Get a function of the environment-asks :: (Proxy p, Monad m) => (i -> r) -> ReaderP i p a' a b' b m r-asks f = ReaderP (\i -> return_P (f i))---- | Modify a computation's environment (a specialization of 'withReaderP')-local- :: (i -> i) -> ReaderP i p a' a b' b m r -> ReaderP i p a' a b' b m r-local = withReaderP
− Control/Proxy/Trans/State.hs
@@ -1,166 +0,0 @@--- | This module provides the proxy transformer equivalent of 'StateT'.--{-# LANGUAGE KindSignatures #-}--module Control.Proxy.Trans.State (- -- * StateP- StateP(..),- runStateP,- runStateK,- evalStateP,- evalStateK,- execStateP,- execStateK,- -- * State operations- get,- put,- modify,- gets- ) where--import Control.Applicative (Applicative(pure, (<*>)), Alternative(empty, (<|>)))-import Control.Monad (MonadPlus(mzero, mplus))-import Control.Monad.IO.Class (MonadIO(liftIO))-import Control.Monad.Trans.Class (MonadTrans(lift))-import Control.MFunctor (MFunctor(hoist))-import Control.PFunctor (PFunctor(hoistP))-import Control.Proxy.Class-import Control.Proxy.Trans (ProxyTrans(liftP))---- | The 'State' proxy transformer-newtype StateP s p a' a b' b (m :: * -> *) r- = StateP { unStateP :: s -> p a' a b' b m (r, s) }--instance (Proxy p, Monad m)- => Functor (StateP s p a' a b' b m) where- fmap f p = StateP (\s0 ->- unStateP p s0 ?>= \(x, s1) ->- return_P (f x, s1) )--{- As far as I can tell, there is no way to write this using an Applicative- context -}-instance (Proxy p, Monad m)- => Applicative (StateP s p a' a b' b m) where- pure = return- p1 <*> p2 = StateP (\s0 ->- unStateP p1 s0 ?>= \(f, s1) ->- unStateP p2 s1 ?>= \(x, s2) ->- return_P (f x, s2) )--instance (Proxy p, Monad m)- => Monad (StateP s p a' a b' b m) where- return = return_P- (>>=) = (?>=)--instance (MonadPlusP p, Monad m)- => Alternative (StateP s p a' a b' b m) where- empty = mzero- (<|>) = mplus--instance (MonadPlusP p )- => MonadPlusP (StateP s p) where- mzero_P = StateP (\_ -> mzero_P)- mplus_P m1 m2 = StateP (\s -> mplus_P (unStateP m1 s) (unStateP m2 s))--instance (MonadPlusP p, Monad m)- => MonadPlus (StateP s p a' a b' b m) where- mzero = mzero_P- mplus = mplus_P--instance (Proxy p )- => MonadTrans (StateP s p a' a b' b) where- lift = lift_P--instance (MonadIOP p )- => MonadIOP (StateP s p) where- liftIO_P m = StateP (\s -> liftIO_P (m >>= \r -> return (r, s)))--instance (MonadIOP p, MonadIO m)- => MonadIO (StateP s p a' a b' b m) where- liftIO = liftIO_P--instance (Proxy p )- => MFunctor (StateP s p a' a b' b) where- hoist = hoist_P--instance (Proxy p )- => Proxy (StateP s p) where- p1 >-> p2 = \c'1 -> StateP (\s ->- ((\b' -> unStateP (p1 b') s) >-> (\c'2 -> unStateP (p2 c'2) s)) c'1 )- {- (p1 >-> p2) = \c' -> StateP $ \s ->- ((`unStateP` s) . p1 >-> (`unStateP` s) . p2) c' -}-- p1 >~> p2 = \c'1 -> StateP (\s ->- ((\b' -> unStateP (p1 b') s) >~> (\c'2 -> unStateP (p2 c'2) s)) c'1 )- {- (p1 >~> p2) = \c' -> StateP $ \s ->- ((`unStateP` s) . p1 >~> (`unStateP` s) . p2) c' -}-- request = \a' -> StateP (\s -> request a' ?>= \a -> return_P (a , s))- respond = \b -> StateP (\s -> respond b ?>= \b' -> return_P (b', s))-- return_P = \r -> StateP (\s -> return_P (r, s))- m ?>= f = StateP (\s ->- unStateP m s ?>= \(a, s') ->- unStateP (f a) s' )-- lift_P m = StateP (\s -> lift_P (m >>= \r -> return (r, s)))-- hoist_P nat p = StateP (\s -> hoist_P nat (unStateP p s))- -- hoist nat = StateP . fmap (hoist nat) . unStateP--instance ProxyTrans (StateP s) where- liftP m = StateP (\s -> m ?>= \r -> return_P (r, s))--instance PFunctor (StateP s) where- hoistP nat = StateP . (nat .) . unStateP---- | Run a 'StateP' computation, producing the final result and state-runStateP :: s -> StateP s p a' a b' b m r -> p a' a b' b m (r, s)-runStateP s m = unStateP m s---- | Run a 'StateP' \'@K@\'leisli arrow, procuding the final result and state-runStateK :: s -> (q -> StateP s p a' a b' b m r) -> (q -> p a' a b' b m (r, s))-runStateK s k q = unStateP (k q) s--- runStateK s = (runStateP s .)---- | Evaluate a 'StateP' computation, but discard the final state-evalStateP- :: (Proxy p, Monad m) => s -> StateP s p a' a b' b m r -> p a' a b' b m r-evalStateP s p = unStateP p s ?>= \x -> return_P (fst x)--- evalStateP s = liftM fst . runStateP s---- | Evaluate a 'StateP' \'@K@\'leisli arrow, but discard the final state-evalStateK- :: (Proxy p, Monad m)- => s -> (q -> StateP s p a' a b' b m r) -> (q -> p a' a b' b m r)-evalStateK s k q = evalStateP s (k q)--- evalStateK s = (evalStateP s .)---- | Evaluate a 'StateP' computation, but discard the final result-execStateP- :: (Proxy p, Monad m) => s -> StateP s p a' a b' b m r -> p a' a b' b m s-execStateP s p = unStateP p s ?>= \x -> return_P (snd x)--- execStateP s = liftM snd . runStateP s---- | Evaluate a 'StateP' \'@K@\'leisli arrow, but discard the final result-execStateK- :: (Proxy p, Monad m)- => s -> (q -> StateP s p a' a b' b m r) -> (q -> p a' a b' b m s)-execStateK s k q = execStateP s (k q)--- execStateK s = (execStateP s .)---- | Get the current state-get :: (Proxy p, Monad m) => StateP s p a' a b' b m s-get = StateP (\s -> return_P (s, s))---- | Set the current state-put :: (Proxy p, Monad m) => s -> StateP s p a' a b' b m ()-put s = StateP (\_ -> return_P ((), s))---- | Modify the current state using a function-modify :: (Proxy p, Monad m) => (s -> s) -> StateP s p a' a b' b m ()-modify f = StateP (\s -> return_P ((), f s))---- | Get the state filtered through a function-gets :: (Proxy p, Monad m) => (s -> r) -> StateP s p a' a b' b m r-gets f = StateP (\s -> return_P (f s, s))
− Control/Proxy/Trans/Writer.hs
@@ -1,154 +0,0 @@-{-| This module provides the proxy transformer equivalent of 'WriterT'.-- This module is even stricter than @Control.Monad.Trans.Writer.Strict@ by- being strict in the accumulated monoid. -- The underlying implementation uses the state monad to avoid quadratic blowup- from left-associative binds. -}--{-# LANGUAGE KindSignatures #-}--module Control.Proxy.Trans.Writer (- -- * WriterP- WriterP(..),- runWriterP,- runWriterK,- execWriterP,- execWriterK,- -- * Writer operations- tell,- censor- ) where--import Control.Applicative (Applicative(pure, (<*>)), Alternative(empty, (<|>)))-import Control.Monad (MonadPlus(mzero, mplus))-import Control.Monad.IO.Class (MonadIO(liftIO))-import Control.Monad.Trans.Class (MonadTrans(lift))-import Control.MFunctor (MFunctor(hoist))-import Control.PFunctor (PFunctor(hoistP))-import Control.Proxy.Class-import Control.Proxy.Trans (ProxyTrans(liftP))-import Data.Monoid (Monoid(mempty, mappend))---- | The strict 'Writer' proxy transformer-newtype WriterP w p a' a b' b (m :: * -> *) r- = WriterP { unWriterP :: w -> p a' a b' b m (r, w) }--instance (Proxy p, Monad m)- => Functor (WriterP w p a' a b' b m) where- fmap f p = WriterP (\w0 ->- unWriterP p w0 ?>= \(x, w1) ->- return_P (f x, w1) )--instance (Proxy p, Monad m)- => Applicative (WriterP w p a' a b' b m) where- pure = return- fp <*> xp = WriterP (\w0 ->- unWriterP fp w0 ?>= \(f, w1) ->- unWriterP xp w1 ?>= \(x, w2) ->- return_P (f x, w2) )- -- (<*>) = ap--instance (Proxy p, Monad m)- => Monad (WriterP w p a' a b' b m) where- return = return_P- (>>=) = (?>=)--instance (MonadPlusP p, Monad m)- => Alternative (WriterP w p a' a b' b m) where- empty = mzero- (<|>) = mplus--instance (MonadPlusP p )- => MonadPlusP (WriterP w p) where- mzero_P = WriterP (\_ -> mzero_P)- mplus_P m1 m2 = WriterP (\w -> mplus_P (unWriterP m1 w) (unWriterP m2 w))--instance (MonadPlusP p, Monad m)- => MonadPlus (WriterP w p a' a b' b m) where- mzero = mzero_P- mplus = mplus_P--instance (Proxy p )- => MonadTrans (WriterP w p a' a b' b) where- lift = lift_P--instance (MonadIOP p )- => MonadIOP (WriterP w p) where- liftIO_P m = WriterP (\w -> liftIO_P (m >>= \r -> return (r, w)))--instance (MonadIOP p, MonadIO m)- => MonadIO (WriterP w p a' a b' b m) where- liftIO = liftIO_P--instance (Proxy p )- => MFunctor (WriterP w p a' a b' b) where- hoist = hoist_P--instance (Proxy p )- => Proxy (WriterP w p) where- p1 >-> p2 = \c'1 -> WriterP (\w ->- ((\b' -> unWriterP (p1 b') w) >-> (\c'2 -> unWriterP (p2 c'2) w)) c'1 )- {- p1 >-> p2 = \c' -> WriterP $ \w ->- ((`unWriterP` w) . p1 >-> (`unWriterP` w) . p2) c' -}-- p1 >~> p2 = \c'1 -> WriterP (\w ->- ((\b' -> unWriterP (p1 b') w) >~> (\c'2 -> unWriterP (p2 c'2) w)) c'1 )- {- p1 >~> p2 = \c' -> WriterP $ \w ->- ((`unWriterP` w) . p1 >~> (`unWriterP` w) . p2) c' -}-- request = \a' -> WriterP (\w -> request a' ?>= \a -> return_P (a, w))- respond = \b -> WriterP (\w -> respond b ?>= \b' -> return_P (b', w))-- return_P = \r -> WriterP (\w -> return_P (r, w))- m ?>= f = WriterP (\w ->- unWriterP m w ?>= \(a, w') ->- unWriterP (f a) w' )-- lift_P m = WriterP (\w -> lift_P (m >>= \r -> return (r, w)))-- hoist_P nat p = WriterP (\w -> hoist_P nat (unWriterP p w))- -- hoist_P nat = WriterP . fmap (hoist_P nat) . unWriterP--instance ProxyTrans (WriterP w) where- liftP m = WriterP (\w -> m ?>= \r -> return_P (r, w))--instance PFunctor (WriterP w) where- hoistP nat = WriterP . (nat .) . unWriterP---- | Run a 'WriterP' computation, producing the final result and monoid-runWriterP :: (Monoid w) => WriterP w p a' a b' b m r -> p a' a b' b m (r, w)-runWriterP p = unWriterP p mempty---- | Run a 'WriterP' \'@K@\'leisli arrow, producing the final result and monoid-runWriterK- :: (Monoid w)- => (q -> WriterP w p a' a b' b m r) -> (q -> p a' a b' b m (r, w))-runWriterK k q = runWriterP (k q)--- runWriterK = (runWriterP . )---- | Evaluate a 'WriterP' computation, but discard the final result-execWriterP- :: (Proxy p, Monad m, Monoid w)- => WriterP w p a' a b' b m r -> p a' a b' b m w-execWriterP m = runWriterP m ?>= \(_, w) -> return_P w--- execWriterP m = liftM snd $ runWriterP m---- | Evaluate a 'WriterP' \'@K@\'leisli arrow, but discard the final result-execWriterK- :: (Proxy p, Monad m, Monoid w)- => (q -> WriterP w p a' a b' b m r) -> (q -> p a' a b' b m w)-execWriterK k q= execWriterP (k q)---- | Add a value to the monoid-tell :: (Proxy p, Monad m, Monoid w) => w -> WriterP w p a' a b' b m ()-tell w' = WriterP (\w -> let w'' = mappend w w' in w'' `seq` return_P ((), w''))---- | Modify the result of a writer computation-censor- :: (Proxy p, Monad m, Monoid w)- => (w -> w) -> WriterP w p a' a b' b m r -> WriterP w p a' a b' b m r-censor f p = WriterP (\w0 ->- unWriterP p w0 ?>= \(r, w1) ->- return_P (r, f w1) )--- censor f = WriterP . fmap (liftM (\(r, w) -> (r, f w))) . unWriterP
− Control/Proxy/Tutorial.hs
@@ -1,1890 +0,0 @@-{-| This module provides a brief introductory tutorial in the \"Introduction\"- section followed by a lengthy discussion of the library's design and idioms.--}--module Control.Proxy.Tutorial (- -- * Introduction- -- $intro-- -- * Bidirectionality- -- $bidir-- -- * Type Synonyms- -- $synonyms-- -- * Request and Respond- -- $interact-- -- * Composition- -- $composition-- -- * The Proxy Class- -- $class-- -- * Interleaving Effects- -- $interleave-- -- * Mixing Base Monads- -- $hoist-- -- * Utilities- -- $utilities-- -- * Mix Monads and Composition- -- $mixmonadcomp-- -- * Folds- -- $folds-- -- * Resource Management- -- $resource-- -- * Extensions- -- $extend-- -- * Error handling- -- $error-- -- * Local state- -- $state-- -- * Branching, zips, and merges- -- $branch-- -- * Proxy Transformers- -- $proxytrans-- -- * Conclusion- -- $conclusion- ) where---- For documentation-import Control.Category-import Control.Monad.Trans.Class-import Control.MFunctor-import Control.PFunctor-import Control.Proxy-import Control.Proxy.Core.Correct (ProxyCorrect)-import Control.Proxy.Trans.Either-import Prelude hiding (catch)--{- $intro- The @pipes@ library replaces lazy 'IO' with a safe, elegant, and- theoretically principled alternative. Use this library if you:-- * want to write high-performance streaming programs-- * believe that lazy 'IO' was a bad idea-- * enjoy composing modular and reusable components-- * love theory and elegant code-- This library unifies many kinds of streaming abstractions, all of which are- special cases of \"proxies\" (The @pipes@ name is a legacy of one such- abstraction).-- Let's begin with the simplest 'Proxy': a 'Producer'. The following- 'Producer' lazily streams lines from a 'Handle'--> import Control.Monad-> import Control.Proxy-> import System.IO-> -> -- Produces Strings ---+----------+-> -- | |-> -- v v-> lines' :: (Proxy p) => Handle -> () -> Producer p String IO r-> lines' h () = runIdentityP loop where-> loop = do-> eof <- lift $ hIsEOF h-> if eof-> then return ()-> else do-> str <- lift $ hGetLine h-> respond str -- Produce the string-> loop->-> -- Ignore the 'runIdentityP' and '()' for now-- But why limit ourselves to streaming lines from some file? Why not lazily- generate values from an industrious user?--> -- Uses 'IO' as the base monad --+-> -- |-> -- v-> promptInt :: (Proxy p) => () -> Producer p Int IO r-> promptInt () = runIdentityP $ forever $ do-> lift $ putStrLn "Enter an Integer:"-> n <- lift readLn -- 'lift' invokes an action in the base monad-> respond n-- Now we need to hook our 'Producer's up to a 'Consumer'. The following- 'Consumer' endlessly 'request's a stream of 'Show'able values and 'print's- them:--> -- Consumes 'a's ---+----------+ +-- Never terminates, so-> -- | | | the return value is-> -- v v v polymorphic-> printer :: (Proxy p, Show a) => () -> Consumer p a IO r-> printer () = runIdentityP $ forever $ do-> a <- request () -- Consume a value-> lift $ putStrLn "Received a value:"-> lift $ print a-- You can compose a 'Producer' and a 'Consumer' using ('>->'), which produces- a runnable 'Session':--> -- Self-contained session ---+ +--+-- These must match-> -- | | | each component-> -- v v v-> promptInt >-> printer :: (Proxy p) => () -> Session p IO r->-> lines' h >-> printer :: (Proxy p) => () -> Session p IO ()-- ('>->') connects each 'request' in @printer@ with a 'respond' in- @lines'@ or @promptInt@.-- Finally, you use 'runProxy' to run the 'Session' and convert it back to the- base monad. First we'll try our @lines'@ 'Producer', which will stream- lines from the following file:--> $ cat test.txt-> Line 1-> Line 2-> Line 3-- The following program never brings more than a single line into memory (not- that it matters for such a small file):-->>> withFile "test.txt" $ \h -> runProxy $ lines' h >-> printer-Received a value:-"Line 1"-Received a value:-"Line 2"-Received a value:-"Line 3"-- Similarly, we can lazily stream user input, requesting values from the user- only when we need them:-->>> runProxy $ promptInt >-> printer :: IO r-Enter an Integer:-1<Enter>-Received a value:-1-Enter an Integer:-5<Enter>-Received a value:-5-...-- The last example proceeds endlessly until we hit @Ctrl-C@ to interrupt it.-- We would like to limit the number of iterations, so lets define an- intermediate 'Proxy' that behaves like a verbose 'take'. I will call it a- 'Pipe' (this library's namesake) since values flow through it:--> 'a's flow in ---+ +--- 'a's flow out-> | |-> v v-> take' :: (Proxy p) => Int -> () -> Pipe p a a IO ()-> take' n () = runIdentityP $ do-> replicateM_ n $ do-> a <- request ()-> respond a-> lift $ putStrLn "You shall not pass!"-- This 'Pipe' forwards the first @n@ values it receives undisturbed, then it- outputs a cute message. You can compose it between the 'Producer' and- 'Consumer' using ('>->'):-->>> runProxy $ promptInt >-> take' 2 >-> printer :: IO ()-Enter an Integer:-9<Enter>-Received a value:-9-Enter an Integer:-2<Enter>-Received a value:-2-You shall not pass!-- When @take' 2@ terminates, it brings down every 'Proxy' composed with it.-- Notice how @promptInt@ behaves lazily and only 'respond's with as many- values as we 'request'. We 'request'ed exactly two values, so it only- prompts the user twice.-- We can already spot several improvements upon traditional lazy 'IO':-- * You can define your own lazy components that have nothing to do with files-- * @pipes@ never uses 'unsafePerformIO' or violates referential transparency.-- * You don't need strictness hacks to ensure the proper ordering of effects-- * You can interleave effects in downstream stages, too-- However, this library can offer even more than that!--}--{- $bidir- So far we've only defined proxies that send information downstream in the- direction of the ('>->') arrow. However, we don't need to limit ourselves- to unidirectional communication and we can enhance these proxies with the- ability to send information upstream with each 'request' that determines- how upstream stages 'respond'.-- For example, 'Client's generalize 'Consumer's because they can supply an- argument other than @()@ with each 'request'. The following 'Client'- sends three 'request's upstream, each of which provides an 'Int' @argument@- and expects a 'Bool' @result@:--> Sends out 'Int's ---+ +-- Receives back 'Bool's-> | |-> v v-> threeReqs :: (Proxy p) => () -> Client p Int Bool IO ()-> threeReqs () = runIdentityP $ forM_ [1, 3, 1] $ \argument -> do-> lift $ putStrLn $ "Client Sends: " ++ show (argument :: Int)-> result <- request argument-> lift $ putStrLn $ "Client Receives:" ++ show (result :: Bool)-> lift $ putStrLn "*"-- Notice how 'Client's use \"@request argument@\" instead of- \"@request ()@\". This sends \"@argument@\" upstream to parametrize the- 'request'.-- 'Server's similarly generalize 'Producer's because they receive arguments- other than @()@. The following 'Server' receives 'Int' 'request's and- 'respond's with 'Bool' values:--> Receives 'Int's ---+ +--- Replies with 'Bool's-> | |-> v v-> comparer :: (Proxy p) => Int -> Server p Int Bool IO r-> comparer = runIdentityK loop where-> loop argument = do-> lift $ putStrLn $ "Server Receives:" ++ show (argument :: Int)-> let result = argument > 2-> lift $ putStrLn $ "Server Sends: " ++ show (result :: Bool)-> nextArgument <- respond result-> loop nextArgument-- Notice how 'Server's receive their first argument as a parameter and bind- each subsequent argument using 'respond'. This library provides a- combinator which abstracts away this common pattern:--> foreverK :: (Monad m) => (a -> m a) -> a -> m b-> foreverK f = loop where-> loop argument = do-> nextArgument <- f argument-> loop nextArgument->-> -- or: foreverK f = f >=> foreverK f-> -- = f >=> f >=> f >=> f >=> ...-- We can use this to simplify the @comparer@ 'Server':--> comparer = runIdentityK $ foreverK $ \argument -> do-> lift $ putStrLn $ "Server Receives:" ++ show argument-> let result = argument > 2-> lift $ putStrLn $ "Server Sends: " ++ show result-> respond result-- ... which looks just like the way you might write a server's main loop in- another programming language.-- You can compose a 'Server' and 'Client' using ('>->'), and this also returns- a runnable 'Session':--> comparer >-> threeReqs :: (Proxy p) => () -> Session p IO ()-- Running this executes the client-server session:-->>> runProxy $ comparer >-> threeReqs :: IO ()-Client Sends: 1-Server Receives: 1-Server Sends: False-Client Receives: False-*-Client Sends: 3-Server Receives: 3-Server Sends: True-Client Receives: True-*-Client Sends: 1-Server Receives: 1-Server Sends: False-Client Receives: False-*-- 'Proxy's generalize 'Pipe's because they allow information to flow upstream.- The following 'Proxy' caches 'request's to reduce the load on the 'Server'- if the request matches a previous one:--> import qualified Data.Map as M->-> -- 'p' is the Proxy, as the (Proxy p) constraint indicates->-> cache :: (Proxy p, Ord key) => key -> p key val key val IO r-> cache = runIdentityK (loop M.empty) where-> loop _map key = case M.lookup key _map of-> Nothing -> do-> val <- request key-> key2 <- respond val-> loop (M.insert key val _map) key2-> Just val -> do-> lift $ putStrLn "Used cache!"-> key2 <- respond val-> loop _map key2-- You can compose the @cache@ 'Proxy' between the 'Server' and 'Client' using- ('>->'):-->>> runProxy $ comparer >-> cache >-> threeReqs-Client Sends: 1-Server Receives: 1-Server Sends: False-Client Receives: False-*-Client Sends: 3-Server Receives: 3-Server Sends: True-Client Receives: True-*-Client Sends: 1-Used cache!-Client Receives: False-*-- This bidirectional flow of information separates @pipes@ from other- streaming libraries which are unable to model 'Client's, 'Server's, or- 'Proxy's. Using @pipes@ you can define interfaces to RPC interfaces, REST- architectures, message buses, chat clients, web servers, network protocols- ... you name it!--}--{- $synonyms- You might wonder why ('>->') accepts 'Producer's, 'Consumer's, 'Pipe's,- 'Client's, 'Server's, and 'Proxy's. It turns out that these type-check- because they are all type synonyms that expand to the following central- type:--> (Proxy p) => p a' a b' b m r-- Like the name suggests, a 'Proxy' exposes two interfaces: an upstream- interface and a downstream interface. Each interface can both send and- receive values:--> Upstream | Downstream-> +---------+-> | |-> a' <== <== b'-> | Proxy |-> a ==> ==> b-> | |-> +---------+-- Proxies are monad transformers that enrich the base monad with the ability- to send or receive values upstream or downstream:--> | Sends | Receives | Receives | Sends | Base | Return-> | Upstream | Upstream | Downstream | Downstream | Monad | Value-> p a' a b' b m r-- We can selectively close certain inputs or outputs to generate specialized- proxies.-- For example, a 'Producer' is a 'Proxy' that can only output values to its- downstream interface:--> Upstream | Downstream-> +----------+-> | |-> C <== <== ()-> | Producer |-> () ==> ==> b-> | |-> +----------+->-> type Producer p b m r = p C () () b m r->-> -- The 'C' type is uninhabited, so it 'C'loses an output end-- A 'Consumer' is a 'Proxy' that can only receive values on its upstream- interface:--> Upstream | Downstream-> +----------+-> | |-> () <== <== ()-> | Consumer |-> a ==> ==> C-> | |-> +----------+->-> type Consumer p a m r = p () a () C m r-- A 'Pipe' is a 'Proxy' that can only receive values on its upstream interface- and send values on its downstream interface:--> Upstream | Downstream-> +--------+-> | |-> () <== <== ()-> | Pipe |-> a ==> ==> b-> | |-> +--------+->-> type Pipe p a b m r = p () a () b m r-- When we compose proxies, the type system ensures sure that their input and- output types match:--> promptInt >-> take' 2 >-> printer->-> +-----------+ +---------+ +---------+-> | | | | | |-> C <== <== () <== <== () <== <== ()-> | | | | | |-> | promptInt | | take' 2 | | printer |-> | | | | | |-> () ==> ==> Int ==> ==> Int ==> ==> C-> | | | | | |-> +-----------+ +---------+ +---------+-- Composition fuses these into a new 'Proxy' that has both ends closed, which- is a 'Session':--> +-----------------------------------+-> | |-> C <== <== ()-> | |-> | promptInt >-> take' 2 >-> printer |-> | |-> () ==> ==> C-> | |-> +-----------------------------------+->-> type Session p m r = p C () () C m r-- A 'Client' is a 'Proxy' that only uses its upstream interface:--> Upstream | Downstream-> +----------+-> | |-> a' <== <== ()-> | Client |-> a ==> ==> C-> | |-> +----------+->-> type Client p a' a m r = p a' a () C m r-- A 'Server' is a 'Proxy' that only uses its downstream interface:---> Upstream | Downstream-> +----------+-> | |-> C <== <== b'-> | Server |-> () ==> ==> b-> | |-> +----------+->-> type Server p b' b m r = p C () b' b m r-- The compiler ensures that the types match when we compose 'Server's,- 'Proxy's, and 'Client's.--> comparer >-> cache >-> threeReqs->-> +----------+ +-------+ +-----------+-> | | | | | |-> C <== <== Int <== <== Int <== <== ()-> | | | | | |-> | comparer | | cache | | threeReqs |-> | | | | | |-> () ==> ==> Bool ==> ==> Bool ==> ==> C-> | | | | | |-> +----------+ +-------+ +-----------+-- This similarly fuses into a 'Session':--> +----------------------------------+-> | |-> C <== <== ()-> | |-> | comparer >-> cache >-> threeReqs |-> | |-> () ==> ==> C-> | |-> +----------------------------------+-- @pipes@ encourages substantial code reuse by implementing all abstractions- as type synonyms on top of a single type class: 'Proxy'. This makes your- life easier because:-- * You only use one composition operator: ('>->')-- * You can mix multiple abstractions together as long as the types match--}--{- $interact- There are only two ways to interact with other proxies: 'request' and- 'respond'. Let's examine their type signatures to understand how they- work:--> request :: (Monad m, Proxy p) => a' -> p a' a b' b m a-> ^ ^-> | |-> Argument --+ Result --+-- 'request' sends an argument of type @a'@ upstream, and binds a result of- type @a@. Whenever you 'request', you block until upstream 'respond's with- a value.---> respond :: (Monad m, Proxy p) => b -> p a' a b' b m b'-> ^ ^-> | |-> Result --+ Next Argument --+-- 'respond' replies with a result of type @b@, and then binds the /next/- argument of type @b'@. Whenever you 'respond', you block until downstream- 'request's a new value.-- Wait, if 'respond' always binds the /next/ argument, where does the /first/- argument come from? Well, it turns out that every 'Proxy' receives this- initial argument as an ordinary parameter, as if they all began blocked on- a 'respond' statement.- - We can see this if we take all the previous proxies we defined and fully- expand every type synonym. The initial argument of each 'Proxy' matches- the type parameter corresponding to the return value of 'respond':--> These-> +-- Columns ---+-> | Match |-> v v-> promptInt :: (Proxy p) => () -> p C () () Int IO r-> printer :: (Proxy p, Show a) => () -> p () a () C IO r-> take' :: (Proxy p) => Int -> () -> p () a () a IO ()-> comparer :: (Proxy p) => Int -> p C () Int Bool IO r-> cache :: (Proxy p, Ord key) => key -> p key val key val IO r-- You can also study the type of composition, which follows this same pattern.- Composition requires two 'Proxy's blocked on a 'respond', and produces a new- 'Proxy' similarly blocked on a 'respond':--> (>->) :: (Monad m, Proxy p)-> => (b' -> p a' a b' b m r)-> -> (c' -> p b' b c' c m r)-> -> (c' -> p a' a c' c m r)-> ^ ^-> | These |-> +---Match----+-- This is why 'Producer's, 'Consumer's, and 'Client's all take @()@ as their- initial argument, because their corresponding 'respond' commands all have a- return value of @()@.-- This library also provides ('>~>'), which is the dual of the ('>->')- composition operator. ('>~>') composes two 'Proxy's blocked on a 'request'- and returns a new 'Proxy' blocked on a 'request':--> (>~>)-> :: (Monad m, Proxy p)-> => (a -> p a' a b' b m r)-> -> (b -> p b' b c' c m r)-> -> (a -> p a' a c' c m r)-- Conceptually, ('>->') composes pull-based systems and ('>~>') composes- push-based systems.-- In fact, if you went back through the previous code and systematically- replaced every:-- * ('>->') with ('>~>'),-- * 'respond' with 'request', and-- * 'request' with 'respond'-- ... then everything would still work and produce identical behavior, except- the compiler would now infer the symmetric types with all interfaces- reversed. We can therefore conclude the obvious: pull-based systems are- symmetric to push-based systems.-- Since these two composition operators are perfectly symmetric, I arbitrarily- standardize on using ('>->') and I provide all standard library proxies- blocked on 'respond' so that they work with ('>->'). This gives behavior- more familiar to Haskell programmers that work with lazy pull-based- functions. I only include the ('>~>') composition operator for theoretical- completeness.--}--{- $composition- When we compose @(p1 >-> p2)@, composition ensures that @p1@'s downstream- interface matches @p2@'s upstream interface. This follows from the type of- ('>->'):--> (>->) :: (Monad m, Proxy p)-> => (b' -> p a' a b' b m r)-> -> (c' -> p b' b c' c m r)-> -> (c' -> p a' a c' c m r)-- Diagramatically, this looks like:--> p1 >-> p2->-> +--------+ +--------+-> | | | |-> a' <== <== b' <== <== c'-> | p1 | | p2 |-> a ==> ==> b ==> ==> c-> | | | |-> +--------+ +--------+-- @p1@'s downstream @(b', b)@ interface matches @p2@'s upstream @(b', b)@- interface, so composition connects them on this shared interface. This- fuses away the @(b', b)@ interface, leaving behind @p1@'s upstream @(a', a)@- interface and @p2@'s downstream @(c', c)@ interface:--> +-----------------+-> | |-> a' <== <== c'-> | p1 >-> p2 |-> a ==> ==> c-> | |-> +-----------------+-- Proxy composition has the very nice property that it is associative, meaning- that it behaves the exact same way no matter how you group composition:--> (p1 >-> p2) >-> p3 = p1 >-> (p2 >-> p3)-- ... so you can safely elide the parentheses:--> p1 >-> p2 >-> p3-- Also, we can define a \'@T@\'ransparent 'Proxy' that auto-forwards values- both ways:--> idT :: (Monad m, Proxy p) => a' -> p a' a a' a m r-> idT = runIdentityK loop where-> loop a' = do-> a <- request a'-> a'2 <- respond a-> loop a'2->-> -- or: idT = runIdentityK $ foreverK $ request >=> respond-> -- = runIdentityK $ request >=> respond >=> request >=> respond ...-- Diagramatically, this looks like:--> +-----+-> | |-> a' <======== a' <- All values pass-> | idT | straight through-> a ========> a <- immediately-> | |-> +-----+-- Transparency means that:--> idT >-> p = p->-> p >-> idT = p-- In other words, 'idT' is an identity of composition.-- This means that proxies form a true 'Category' where ('>->') is composition- and 'idT' is the identity. The associativity law and the two- identity laws are just the 'Category' laws. The objects of the category are- the 'Proxy' interfaces.-- These 'Category' laws guarantee the following important properties:-- * You can reason about each proxy's behavior independently of other proxies-- * You don't encounter weird behavior at the interface between two components-- * You don't encounter corner cases at the 'Server' or 'Client' ends of a- 'Session'--}--{- $class- All the proxy code we wrote was generic over the 'Proxy' type class, which- defines the three central operations of this library's API:-- * ('>->'): Proxy composition-- * 'request': Request input from upstream-- * 'respond': Respond with output to downstream-- @pipes@ defines everything in terms of these three operations, which is- why all the library's utilities are polymorphic over the 'Proxy' type class.-- Let's look at some example instances of the 'Proxy' type class:--> instance Proxy ProxyFast -- Fastest implementation-> instance Proxy ProxyCorrect -- Strict monad transformer laws-- These two types provide the two alternative base implementations:-- * 'ProxyFast': This runs significantly faster on pure code segments and- employs several rewrite rules to optimize your code into the equivalent- hand-tuned code.-- * 'ProxyCorrect': This uses a monad transformer implementation that is- correct by construction, but runs about 8x slower on pure code segments.- However, for 'IO'-bound code, the performance gap is small.-- These two implementations differ only in the 'runProxy' function that they- export, which is how the compiler selects which 'Proxy' implementation to- use.-- "Control.Proxy" automatically selects the fast implementation for you, but- you can always choose the correct implementation instead by replacing- "Control.Proxy" with the following two imports:--> import Control.Proxy.Core -- Everything except the base implementation-> import Control.Proxy.Core.Correct -- The alternative base implementation-- These are not the only instances of the 'Proxy' type class! This library- also provides several \"proxy transformers\", which are like monad- transformers except that they also correctly lift the 'Proxy' type class:--> instance (Proxy p) => Proxy (IdentityP p)-> instance (Proxy p) => Proxy (EitherP e p)-> instance (Proxy p) => Proxy (MaybeP p)-> instance (Proxy p) => Proxy (ReaderP i p)-> instance (Proxy p) => Proxy (StateP s p)-> instance (Proxy p) => Proxy (WriterP w p)-- All of the 'Proxy' code we wrote so far also works seamlessly with all of- these proxy transformers. The 'Proxy' class abstracts over the- implementation details and extensions so that you can reuse the same library- code for any feature set.-- This polymorphism comes at a price: you must embed your 'Proxy' code in at- least one proxy transformer if you want clean type class constraints. If- you don't use extensions then you embed your code in the identity proxy- transformer: 'IdentityP'. This is why all the examples use 'runIdentityP'- or 'runIdentityK' to embed their code in 'IdentityP'. "Control.Proxy.Class"- provides a longer discussion on this subject.-- Without this 'IdentityP' embedding, the compiler infers uglier constraints,- which are also significantly less polymorphic. We can show this by- removing the 'runIdentityP' call from @promptInt@ and see what type the- compiler infers:--> promptInt () = forever $ do-> lift $ putStrLn "Enter an Integer:"-> n <- lift readLn-> respond n-->>> :t promptInt -- I've substantially cleaned up the inferred type-promptInt- :: (Monad (Producer p Int IO), MonadTrans (Producer p Int), Proxy p) =>- () -> Producer p Int IO r-- All 'Proxy' instances are already monads and monad transformers, but the- compiler cannot infer that without the 'IdentityP' embedding. When we embed- @promptInt@ in 'IdentityP', the compiler collapses the 'Monad' and- 'MonadTrans' constraints into the 'Proxy' constraint.-- Fortunately, you do not pay any performance price for this 'IdentityP'- embedding or the type class polymorphism. Your polymorphic code will still- run very rapidly, as fast as if you had specialized it to a concrete- 'Proxy' instance without the 'IdentityP' embedding. I've taken great care- to ensure that all optimizations and rewrite rules always see through these- abstractions without any assistance on your part.--}--{- $interleave- When you compose two proxies, you interleave their effects in the base- monad. The following two proxies demonstrate this interleaving of effects:--> downstream :: (Proxy p) => Consumer p () IO ()-> downstream () = runIdentityP $ do-> lift $ print 1-> request () -- Switch to upstream-> lift $ print 3-> request () -- Switch to upstream->-> upstream :: (Proxy p) => Producer p () IO ()-> upstream () = runIdentityP $ do-> lift $ print 2-> respond () -- Switch to downstraem-> lift $ print 4-- "Control.Proxy.Class" enumerates the 'Proxy' laws, which equationally- define how all 'Proxy' instances must behave. These laws require that- @(upstream >-> downstream)@ must reduce to the following:--> upstream >-> downstream -- This is true no matter what feature-> = -- set or 'Proxy' instance you select-> \() -> lift $ do-> print 1-> print 2-> print 3-> print 4-- Conceptually, 'runProxy' just applies this to @()@ and removes the 'lift':--> runProxy $ upstream >-> downstream-> =-> do print 1-> print 2-> print 3-> print 4-- Let's test this:-->>> runProxy $ upstream >-> downstream-1-2-3-4-- The 'Proxy' laws let you reason about how proxies interleave effects without- knowing any specifics about the underlying implementation. Intuitively, the- 'Proxy' laws say that:-- * 'request' blocks until upstream 'respond's-- * 'respond' blocks until downstream 'request's-- * If a 'Proxy' terminates, it terminates every 'Proxy' composed with it-- Several of the utilities in "Control.Proxy.Prelude.Base" use these- equational laws to rigorously prove things about their behavior. For- example, consider the 'mapD' proxy, which applies a function @f@ to all- values flowing downstream:--> mapD :: (Monad m, Proxy p) => (a -> b) -> x -> p x a x b m r-> mapD f = runIdentityK loop where-> loop x = do-> a <- request x-> x2 <- respond (f a)-> loop x2->-> -- or: mapD f = runIdentityK $ foreverK $ request >=> respond . f-- We can use the 'Proxy' laws to prove that:--> mapD f >-> mapD g = mapD (g . f)->-> mapD id = idT-- ... which is what we expect. We can fuse two consecutive 'mapD's into one- by composing their functions, and mapping 'id' does nothing at all, just- like the identity proxy: 'idT'.-- In fact, these are just the functor laws in disguise, where 'mapD' defines a- functor between the category of Haskell function composition and the- category of 'Proxy' composition. "Control.Proxy.Prelude.Base" is full of- utilities like this that are simultaneously practical and theoretically- elegant.--}--{- $hoist- Composition can't interleave two proxies if their base monads do not- match. For instance, I might try to modify @promptInt@ to use- @EitherT String@ to report the error instead of using exceptions:--> import Control.Monad.Trans.Either -- from the "either" package-> import Safe (readMay)->-> promptInt2 :: (Proxy p) => () -> Producer p Int (EitherT String IO) r-> promptInt2 () = runIdentityP $ forever $ do-> str <- lift $ lift $ do-> putStrLn "Enter an Integer:"-> getLine-> case readMay str of-> Nothing -> lift $ left "Could not read Integer"-> Just n -> respond n-- However, if I try to compose it with @printer@, I receive a type error:-->>> runEitherT $ runProxy $ promptInt2 >-> printer-<interactive>:2:40:- Couldn't match expected type `EitherT String IO'- with actual type `IO'- ...-- The type error says that @promptInt2@ uses @(EitherT String IO)@ for its- base monad, but @printer@ uses 'IO' for its base monad, so composition can't- interleave their effects.-- You can easily fix this using the 'hoist' function from the 'MFunctor' type- class in "Control.MFunctor", which transforms the base monad of any monad- transformer, including the 'Proxy' monad transformer. "Control.MFunctor"- really belongs in the @transformers@ package, however it currently resides- here because it requires the @Rank2Types@ extension.-- You will commonly use 'hoist' to 'lift' one proxy's base monad to match- another proxy's base monad, like so:-->>> runEitherT $ runProxy $ promptInt2 >-> (hoist lift . printer)-Enter an Integer:-Hello<Enter>-Left "Could not read Integer"-- This library provides three syntactic conveniences for making this easier to- write.-- First, ('.') has higher precedence than ('>->'), so you can drop the- parentheses:-->>> runEitherT $ runProxy $ promptInt2 >-> hoist lift . printer-...-- Second, "lift" is such a common argument to 'hoist' that "Control.MFunctor"- provides the 'raise' function:--> raise = hoist lift-->>> runEitherT $ runProxy $ promptInt2 >-> raise . printer-...-- Third, "Control.Proxy.Prelude.Kleisli" provides the 'hoistK' and 'raiseK'- functions in case you think composition looks ugly:--> hoistK f = (hoist f .)->-> raiseK = (raise .)-->>> runEitherT $ runProxy $ promptInt2 >-> raiseK printer-...-- Note that "Control.MFunctor" also provides 'MFunctor' instances for all the- monad transformers in the @transformers@ package. This means that you can- fix any incompatibility between two monad transformer stacks just using- various combinations of 'hoist' and 'lift'.-- To see how, consider the following contrived pathological example where I- want to mix two very different monad transformer stacks:--> m1 :: StateT s (ReaderT i IO) r-> m2 :: MaybeT (WriterT w IO) r-- I can interleave their transformers through judicious use of 'hoist' and- 'lift'--> mBoth :: StateT s (MaybeT (ReaderT i (WriterT w IO))) r-> mBoth = do-> hoist (lift . hoist lift) m1-> lift (hoist lift m2)--}--{- $utilities- The "Control.Proxy.Prelude" heirarchy provides several utility functions- for common tasks. We can redefine the previous example functions just by- composing these utilities.-- For example, 'readLnS' reads values from user input, so we can read 'Int's- just by specializing its type:--> readLnS :: (Proxy p, Read a) => () -> Producer p a IO r->-> readIntS :: (Proxy p) => () -> Producer p Int IO r-> readIntS = readLnS-- The @S@ suffix indicates that it belongs in the \'@S@\'erver position.-- @(takeB_ n)@ allows at most @n@ value to pass through it in \'@B@\'oth- directions:--> takeB_ :: (Monad m, Proxy p) => Int -> a' -> p a' a a' a m ()-- 'takeB_' has a more general type than @take'@ because it allows any type of- value to flow upstream.-- 'printD' prints all values flowing \'@D@\'ownstream:--> printD :: (Proxy p, Show a) => x -> p x a x a IO r-- 'printD' has a more general type than our original @printer@ because it- forwards all values further downstream after 'print'ing them. This means- that you could use it as an intermediate stage as well. However, 'printD'- still type-checks as the most downstream stage, too, since 'runProxy' just- discards any unused outbound values.-- These utilities do not clash with the Prelude namespace or common libraries- because they all end with a capital letter suffix that indicates their- directionality:-- * \'@D@\' suffix: interacts with values flowing \'@D@\'ownstream-- * \'@U@\' suffix: interacts with values flowing \'@U@\'pstream-- * \'@B@\' suffix: interacts with values flowing \'@B@\'oth ways (or:- \'@B@\'idirectional)-- * \'@S@\' suffix: belongs furthest upstream in the \'@S@\'erver position-- * \'@C@\' suffix: belongs furthest downstream in the \'@C@\'lient position-- We can assemble these functions into a silent version of our previous- 'Session':-->>> runProxy $ readIntS >-> takeB_ 2 >-> printD-4<Enter>-4-39<Enter>-39-- Fortunately, we don't have to give up our previous useful diagnostics.- We can use 'execU', which executes an action each time values flow upstream- through it, and 'execD', which executes an action each time values flow- downstream through it:--> promptInt :: (Proxy p) => () -> Producer p Int IO r-> promptInt = readLnS >-> execU (putStrLn "Enter an Integer:")->-> printer :: (Proxy p, Show a) => x -> p x a x a IO r-> printer = execD (putStrLn "Received a value:") >-> printD-- Similarly, we can build our old @take'@ on top of 'takeB_':--> take' :: (Proxy p) => Int -> a' -> p a' a a' a m ()-> take' n a' = runIdentityP $ do -- Remember, we need 'runIdentityP' if-> takeB_ n a' -- we use 'do' notation or 'lift'-> lift $ putStrLn "You shall not pass!"-->>> runProxy $ promptInt >-> take' 2 >-> printer-<Exact same behavior>-- Or perhaps I want to skip user input for testing and mock @promptInt@ by- replacing it with a predefined set of values:-->>> runProxy $ fromListS [4, 37, 1] >-> take'2 >-> printer-Received a value:-4-Received a value:-37-- What about our original @lines@ function? That's just 'hGetLineS':--> hGetLineS :: (Proxy p) => Handle -> () -> Producer p String IO ()-- You could hand-write loops that accomplish these same tasks, but proxies let- you:-- * Rapidly swap in and out components for testing, debugging, and fast- prototyping-- * Factor out common patterns into modular components-- * Mix and match simple stages to build sophisticated programs-- This compositional programming style emphasizes building a library of- reusable components and connecting them like Unix pipes to assemble the- desired streaming program.--}--{- $mixmonadcomp- Composition isn't the only way to assemble proxies. You can also sequence- predefined proxies using @do@ notation to generate more elaborate behaviors.-- Most commonly, you will sequence two sources to combine their outputs, very- similar to how the Unix @cat@ utility behaves:--> threeSources () = do-> source1 ()-> source2 ()-> source3 ()->-> -- or: threeSources = source1 >=> source2 >=> source3-- As a concrete example, we could create a 'Producer' where our first source- presets the first few values and then we let the user take over to generate- the remaining values:--> source1 :: (Proxy p) => () -> Producer p Int IO r-> source1 () = runIdentityP $ do-> fromListS [4, 4] () -- Source 1-> readLnS () -- Source 2->-> -- or: source1 = runIdentityK (fromListS [4, 4] >=> readLnS)-->>> runProxy $ source1 >-> printD-4-4-70<Enter>-70-34<Enter>-34-...-- What if we only want the user to provide three values? We can - selectively throttle it with 'takeB_':--> source2 :: (Proxy p) => () -> Producer p Int IO ()-> source2 () = runIdentityP $ do-> fromListS [4, 4] ()-> (readLnS >-> takeB_ 3) () -- You can compose inside a do block!->-> -- or: source2 = runIdentityK (fromListS [4, 4] >=> (readLnS >-> takeB_ 3))-- Notice that composition works inside of a @do@ block! This is a very handy- trick!-->>> runProxy $ source2 >-> printD-4-4-56<Enter>-56-41<Enter>-41-80<Enter>-80-- You can also concatenate sinks, too:--> sink1 :: (Proxy p) => () -> Consumer p Int IO ()-> sink1 () = do-> (takeB_ 3 >-> printD) () -- Sink 1-> (takeWhileD (< 4) >-> printD) () -- Sink 2->-> -- or: sink1 = (takeB_ 3 >-> printD) >=> (takeWhileD (< 4) >-> printD)-->>> runProxy $ source2 >-> sink1-4 -- The first sink-4 -- handles these-68<Enter> ---68-1<Enter> -- The second sink-1 -- handles these-5<Enter> ---- ... but the above example is gratuitous because you can simply concatenate- the intermediate stages:--> sink2 :: (Proxy p) => () -> Consumer p Int IO ()-> sink2 () = intermediate >-> printD where-> intermediate () = do-> takeB_ 3 () -- Intermediate stage 1-> takeWhileD (< 4) -- Intermediate stage 2->-> -- or: sink2 = (takeB_ 3 >=> takeWhileD (< 4)) >-> printD-->>> runProxy $ source2 >-> sink2-<Exact same behavior>-- These examples demonstrate the two principal ways to combine proxies:-- * \"Vertical\" composition, using ('>=>') from the Kleisli category-- * \"Horizontal\" composition: using ('>->') from the Proxy category-- You assemble most proxies simply by composing them in one or both of these- two categories.--}--{- $folds- You can fold a stream of values in two ways, both of which use the base- monad:-- * Use 'WriterT' in the base monad and 'tell' the values to fold-- * Use 'StateT' in the base monad and 'put' strict values-- 'WriterT' is more elegant in principle but leaks space for a large number of- values to fold. 'StateT' does not leak space if you keep the accumulator- strict, but is less elegant and doesn't guarantee write-only behavior. To- remedy this, I am currently working on a stricter 'WriterT' implementation- that does not leak space to add to the @transformers@ package.-- "Control.Proxy.Prelude.Base" provides several common folds using 'WriterT'- as the base monad, such as:-- * 'lengthD': Count how many values flow downstream--> lengthD :: (Monad m, Proxy p) => x -> p x a x a (WriterT (Sum Int) m) r-- * 'toListD': Fold the values flowing downstream into a list.--> toListD :: (Monad m, Proxy p) => x -> p x a x a (WriterT [a] m) r-- * 'anyD': Determine whether any values satisfy the predicate--> anyD :: (Monad m, Proxy p) => (a -> Bool) -> x -> p x a x a (WriterT Any m) r-- These 'WriterT' versions demonstrate how the elegant approach should work in- principle and they should be okay for folding a medium number of values- until I release the fixed 'WriterT'. If space leaks cause problems, you can- temporarily rewrite the 'WriterT' folds using the following two strict- 'StateT' folds:-- * 'foldlD'': Strictly fold values flowing downstream--> foldlD'-> :: (Monad m, Proxy p) => (b -> a -> b) -> x -> p x a x a (StateT b m) r-- * 'foldlU'': Strictly fold values flowing upstream--> foldU'-> :: (Monad m, Proxy p) => (b -> a' -> b) -> a' -> p a' x a' x (StateT b m) r-- Now, let's try these folds out and see if we can build a list from user- input:-->>> runWriterT $ runProxy $ raiseK promptInt >-> takeB_ 3 >-> toListD-Enter an Integer:-1<Enter>-Enter an Integer:-66<Enter>-Enter an Integer:-5<Enter>-((), [1, 66, 5])-- Notice that @promptInt@ uses 'IO' as its base monad, but 'toListD' uses- @(WriterT [Int] m)@ as its base monad, so I use 'raiseK' to get the base- monads to match.-- You can insert these folds anywhere in the middle of a pipeline and they- still work:-->>> runWriterT $ runProxy $ fromListS [5, 7, 4] >-> lengthD >-> raiseK printD-5-7-4-((), Sum 3)-- You can also run multiple folds at the same time just by adding more- 'WriterT' layers to your base monad:-->>> runWriterT $ runWriterT $ fromListS [9, 10] >-> anyD even >-> raiseK sumD-(((), Any {getAny = True},Sum {getSum = 19})-- I designed certain special folds to terminate the 'Session' early if they- can compute their result prematurely, in order to draw as little input as- possible. These folds end with an underscore, such as 'headD_', which- terminates the stream once it receives an input:--> headD_ :: (Monad m, Proxy p) => x -> p x a x a (WriterT (First a) m) ()-->>> runWriterT $ runProxy $ fromListS [3, 4, 9] >-> raiseK printD >-> headD_-3-((), First {getFirst = Just 3})-- Compare this to 'headD' without underscore, which folds the entire input:-->>> runWriterT $ runProxy $ fromListS [3, 4, 9] >-> raiseK printD >-> headD-3-4-9-((), First {getFirst = Just 3})-- Use the versions that don't prematurely terminate if you are running- multiple folds or if you want to continue to use the rest of the input when- the fold is done. Use the versions that do prematurely terminate if- collecting that single fold is the entire purpose of the session.--}--{- $resource- This core library provides utilities for lazily streaming from resources,- but does not provide utilities for lazily managing resource allocation and- deallocation. To frame the problem, let's assume that we try to be clever- and write a streaming utility that lazily opens a file only in response to- a 'request', such as the following 'Producer':--> readFile' :: FilePath -> () -> Producer p String IO-> readFile' file () = runIdentityP $ do-> h <- lift $ openFile file ReadMode-> lift $ putStrLn "Opening file"-> hGetLineS h ()-> lift $ putStrLn "Closing file"-> lift $ hClose h-- This works well if we fully demand the file:-->>> runProxy $ readFile' "test.txt" >-> printD-Opening file-"Line 1"-"Line 2"-"Line 3"-Closing file-- This also works well if we never demand the file at all, in which case we- never open it:-->>> runProxy $ readFile' "test.txt" >-> return--- Outputs nothing-- But it gives exactly the wrong behavior if we partially demand the file:-->>> runProxy $ readFile' "test.txt" >-> takeB_ 1 >-> printD-Opening file-"Line 1"-- Notice that this does not close the file, because once @takeB_ 1@ terminates- it terminates the entire 'Session' and @readFile'@ does not get a chance to- finalize the file.-- I will release a separate library in the near future that offers lazy- resource management, too, but in the meantime I advise that you use one of- the following two strategies to guarantee deterministic resource- deallocation.-- The first approach opens all resources before running the session and close- them all afterward. For example, if I wanted to emulate the Unix @cp@- command, streaming one line at a time, I would write:--> import System.IO->-> cp :: FilePath -> FilePath -> IO ()-> cp inFile outFile =-> withFile file1 ReadMode $ \hIn ->-> withFile file2 WriteMode $ \hOut ->-> runProxy $ hGetLineS hIn >-> hPutLineS hOut2-- The advantage of this approach is that it:-- * is straightforward,-- * requires no special integration with existing libraries, and-- * is exception safe.-- The disadvantage is that this does not lazily allocate resources, nor does- this promptly deallocate them.-- The second approach is to use something like 'ResourceT' (from the- @resourceT@ package) to register finalizers and ensure they get released- deterministically. You may prefer this approach if you have previously used- the @conduit@ library, which uses 'ResourceT' in its base monad to offer- resource determinism. You can use 'ResourceT' with @pipes@, too, just by- including it in the base monad.-- I plan to release a lazy resource management library very soon built on top- of @pipes@ that behaves similarly to 'ResourceT'. The main advantages of- this upcoming implementation will be that it:-- * uses a simpler and pure implementation-- * obeys several useful theoretical laws-- * requires no dependencies other than @pipes@-- However, if you don't need this extra power, then just stick to the former- simpler approach. I plan to release all standard libraries to be agnostic- of the finalization approach to let you use which one you prefer.--}--{- $extend- This library provides several extensions that add features on top of the- base 'Proxy' API. These extensions behave like monad transformers, except- that they also lift the 'Proxy' class through the extension so that the- extended proxy can still 'request', 'respond', compose with other proxies:--> instance (Proxy p) => Proxy (IdentityP p) -- Equivalent to IdentityT-> instance (Proxy p) => Proxy (EitherP e p) -- Equivalent to EitherT-> instance (Proxy p) => Proxy (MaybeP p) -- Equivalent to MaybeT-> instance (Proxy p) => Proxy (StateP s p) -- Equivalent to StateT-> instance (Proxy p) => Proxy (WriterP w p) -- Equivalent to WriterT-- Each of these proxy transformers provides the same API as the equivalent- monad transformer (sometimes even more). The following sections show some- common problems that these proxy transformers solve.--}--{- $error-- Our previous @promptInt@ example suffered from one major flaw:--> promptInt2 :: (Proxy p) => () -> Producer p Int (EitherT String IO) r-> promptInt2 () = runIdentityP $ forever $ do-> str <- lift $ lift $ do-> putStrLn "Enter an Integer:"-> getLine-> case readMay str of-> Nothing -> lift $ left "Could not read Integer"-> Just n -> respond n-- There is no way to recover from the error and resume streaming data. You- can only handle 'Left' value after using 'runProxy', but by then it is too - late.-- We can solve this by switching the order of the two monad transformers, but- using 'EitherP' this time instead of 'EitherT':--> import qualified Control.Proxy.Trans.Either as E->-> -- Proxy transformers play-> -- nice with type synonyms --+-> -- |-> -- v-> promptInt3 :: (Proxy p) => () -> Producer (E.EitherP String p) Int IO r-> -- i.e. (Proxy p) => () -> EitherP String p C () () Int IO r->-> promptInt3 () = forever $ do-> str <- lift $ do-> putStrLn "Enter an Integer:"-> getLine-> case readMay str of-> Nothing -> E.throw "Could not read Integer"-> Just n' -> respond n-- This example does not need 'runIdentityP' (nor would that type-check)- because the 'EitherP' proxy transformer gives the compiler enough- information to generalize the constraints.-- We've swapped the order of the transformers, so now we use 'runEitherK'- first to unwrap the 'EitherP' followed by 'runProxy'.--> runEitherK-> :: (q -> EitherP p a' a b' b m r) -> (q -> p a' a b' b m (Either e r))-->>> runProxy $ runEitherK $ promptInt3 >-> printer :: IO (Either String r)-Enter an Integer:-Hello<Enter>-Left "Could not read Integer"-- Notice how we can directly compose @printer@ with @promptInt@.- This works because @printer@'s base proxy type is completely polymorphic- over the 'Proxy' type class and doesn't use any features specific to any- proxy transformers:--> 'p' type-checks as anything --+-> that implements 'Proxy' |-> v-> printer :: (Proxy p, Show a) => () -> Consumer p a IO r-- This means that you can compose @printer@ with anything that implements the- 'Proxy' type class, including 'EitherP', without any lifting.-- 'EitherP' lets us catch and handle errors locally without disturbing other- proxies. For example, I can define a heartbeat function that just restarts- a given proxy each time it raises an error:--> heartbeat-> :: (Proxy p)-> => E.EitherP String p a' a b' b IO r-> -> E.EitherP String p a' a b' b IO r-> heartbeat p = p `E.catch` \err -> do-> lift $ putStrLn err -- Print the error-> heartbeat p -- Restart 'p'-- This uses the 'catch' function from "Control.Proxy.Trans.Either", which- lets you catch and handle errors locally without disturbing other proxies.-->>> runProxy $ E.runEitherK $ (heartbeat . promptInt3) >-> takeB_ 2 >-> printer-Enter an Integer:-Hello<Enter>-Could not read Integer-Enter an Integer-8-Received a value:-8-Enter an Integer-0-Received a value:-0-- It's very easy to prove that 'EitherP' has only a local effect. In fact,- we can run it entirely locally like so:-->>> runProxy $ (E.runEitherK $ heartbeat . promptInt3) >-> takeB_ 2 >-> printer-- Proxy transformers do not use the base monad at all, so you can use them to- isolate effects from other proxies, as the next section demonstrates.--}--{- $state- The 'StateP' proxy lets you embed local state into any 'Proxy' computation.- For example, we might want to gratuitously use state to generate successive- numbers:--> import qualified Control.Proxy.Trans.State as S->-> increment :: (Monad m, Proxy p) => () -> Producer (S.StateP Int p) Int m r-> increment () = forever $ do-> n <- S.get-> respond n-> S.put (n + 1)-- We could then embed it locally into any 'Proxy', such as the following one:--> numbers :: (Monad m, Proxy p) => () -> Producer p Int m ()-> numbers () = runIdentityP $ do-> (takeB_ 5 <-< S.evalStateK 10 increment) ()-> S.evalStateK 1 (takeB_ 3 <-< increment) () -- This works, too!-->>> runProxy $ numbers >-> printD-10-11-12-13-14-1-2-3-- We can also prove the effect is local even when you directly compose two- 'StateP' proxies before running them. Let's define a stateful consumer:--> increment2 :: (Proxy p) => () -> Consumer (S.StateP Int p) Int IO r-> increment2 () = forever $ do-> nOurs <- S.get-> nTheirs <- request ()-> lift $ print (nTheirs, nOurs)-> S.put (nOurs + 2)-- .. and hook it up directly to @increment@:-->>> runProxy $ S.evalStateK 0 $ increment >-> takeB_ 3 >-> increment2-(0, 0)-(1, 2)-(2, 4)-- They each share the same initial state, but they isolate their own side- effects completely from each other.--}--{- $branch- So far we've only considered linear chains of proxies, but @pipes@ allows- you to branch these chains and generate more sophisticated topologies. The- trick is to simply nest the 'Proxy' monad transformer within itself.-- For example, if I want to zip two inputs, I can just define the following- triply nested proxy:--> zipD-> :: (Monad m, Proxy p1, Proxy p2, Proxy p3)-> => () -> Consumer p1 a (Consumer p2 b (Consumer p3 (a, b) m)) r-> zipD = runIdentityP . hoist (runIdentityP . hoist runIdentityP) $ forever $ do-> -- Yes, this 'runIdentityP' mess is necessary. Sorry!->-> a <- request () -- Request from the outer 'Consumer'-> b <- lift $ request () -- Request from the inner 'Consumer'-> lift $ lift $ respond (a, b) -- Respond to the 'Producer'-- 'zipD' behaves analogously to a curried function. We partially apply it to- each layer using composition and 'runProxyK' or 'runProxy':--> -- 1st application-> p1 = runProxyK $ zipD <-< fromListS [1..3]->-> -- 2nd application-> p2 = runProxyK $ p1 <-< fromListS [4..]->-> -- 3rd application-> p3 = runProxy $ printD <-< p2-->>> p3-(1, 4)-(2, 5)-(3, 6)-- You can use this trick to fork output, too:--> fork-> :: (Monad m, Proxy p1, Proxy p2, Proxy p3)-> => () -> Consumer p1 a (Producer p2 a (Producer p3 a m)) r-> fork () =-> runIdentityP . hoist (runIdentityP . hoist runIdentityP) $ forever $ do-> a <- request () -- Request output from the 'Consumer'-> lift $ respond a -- Send output to the outer 'Producer'-> lift $ lift $ respond a -- Send output to the inner 'Producer'-- Again, we just keep partially applying it until it is fully applied:--> -- 1st application-> p1 = runProxyK $ fork <-< fromListS [1..3]->-> -- 2nd application-> p2 = runProxyK $ raiseK printD <-< mapD (> 2) <-< p1->-> -- 3rd application-> p3 = runProxy $ printD <-< mapD show <-< p2-->>> p3-False-"1"-False-"2"-True-"3"-- You can even merge or fork proxies that use entirely different feature sets:--> p1 = runProxyK $ S.evalStateK 0 $ fork <-< increment->-> p2 = runProxyK $ raiseK printD <-< mapD (+ 10) <-< p1->-> p3 = runProxy $ E.runEitherK $ printD <-< (takeB_ 3 >=> E.throw) <-< p2-->>> p3-10-0-11-1-12-2-Left ()-- We just forked a @(StateP p1)@ proxy and read out the result in both a- generic @p2@ proxy and an @(EitherP p3)@ proxy. That's pretty crazy, but it- gives you a sense of how versatile and robust proxies can be.-- You can implement arbitrary branching topologies using this trick. However,- I want to mention a few caveats:-- * The intermediate partially applied type signatures will be ugly as sin.- I warned you.-- * You cannot implement cyclic topologies (and cyclic topologies do not make- sense for proxies anyway)-- * You cannot use this trick to implement a polymorphic zip function of the- following form:--> zip' -- You can't define this-> :: (Monad m, Proxy p)-> => (() -> Producer p a m r)-> -> (() -> Producer p b m r)-> -> (() -> Producer p (a, b) m r)-- Partial application requires selecting a 'Proxy' instance, which is why you- cannot define @zip'@. You /can/ define a @zip'@ specialized to a concrete- 'Proxy' instance, but I don't really recommend doing that since you should- always strive to write polymorphic proxies to avoid locking your user into- a particular feature set.-- With those caveats out of the way, this approach affords many indispensable- features that other approaches do not allow:-- * It does not require extending the 'Proxy' type class-- * It handles almost every branching scenario, including more complicated- situations like concurrent interleavings-- * You can branch and merge mixtures of 'Server's, 'Client's, and 'Proxy's-- * You can branch and merge heterogeneous feature sets-- * It is completely polymorphic over the 'Proxy' class and uses no- implementation-specific details--}--{- $proxytrans- There is one last scenario that you will eventually encounter: mixing- proxies that have incompatible proxy transformer stacks. You solve this the- exact same way you mix different monad transformer stacks, except that- instead of using 'lift' and 'hoist' you use 'liftP' and 'hoistP'.-- For example, we might want to mix @promptInt3@ and @increment2@:--> promptInt3 :: (Proxy p) => () -> Producer (E.EitherP String p) Int IO r->-> increment2 :: (Proxy p) => () -> Consumer (S.StateP Int p) Int IO r-- Unfortunately, they use two different feature sets so neither one is fully- polymorphic over the 'Proxy' class and we cannot directly compose them.-- Fortunately, all proxy transformers implement the 'ProxyTrans' class,- analogous to the 'MonadTrans' class for transformers:--> class ProxyTrans t where-> liftP-> :: (Monad m, Proxy p)-> => p a' a b' b m r -> t p a' a b' b m r->-> -- mapP is slightly more elegant-> mapP-> :: (Monad m, Proxy p)-> => (q -> p a' a b' b m r) -> (q -> t p a' a b' b m r)-> mapP = (liftP . )-- It's very easy to use. Just use 'mapP' (equivalent to @(liftP .)@ to lift- one proxy transformer to match another one. For example, we can 'mapP'- @increment2@ to match @promptInt3@:--> promptInt3 >-> mapP increment2-> :: (Proxy p) => () -> Session (EitherP String (StateP Int p)) IO r-->>> runProxy $ S.evalStateK 0 $ E.runEitherK $ promptInt3 >-> mapP increment2-Enter an Integer:-4<Enter>-(4, 0)-Enter an Integer:-5<Enter>-(5, 2)-Enter an Integer:-Hello<Enter>-Left "Could not read Integer"-- ... or we could instead 'mapP' @promptInt3@ to match @increment2@ and switch- the order of the two proxy transformers:--> mapP promptInt3 >-> increment2-> :: (Proxy p) => () -> Session (StateP Int (EitherP String p)) IO r-->>> runProxy $ E.runEitherK $ S.evalStateK 0 $ mapP promptInt3 >-> increment2-Enter an Integer:-4<Enter>-(4, 0)-Enter an Integer:-5<Enter>-(5, 2)-Enter an Integer:-Hello<Enter>-Left "Could not read Integer"-- Like monad transformers, proxy transformers lift a base 'Monad' instance- to an extended 'Monad' instance. 'liftP' exactly mirrors the 'lift'- function from 'MonadTrans'. 'liftP' takes some base proxy, @p@, that- implements 'Monad' and \"lift\"s it to an extended proxy, @(t p)@, that also- implements 'Monad'.-- So for example, I could do something like:--> do liftP $ actionInBaseProxy-> actionInExtendedProxy-- Monad transformers impose certain laws to ensure that this lifting is- correct. These are known as the monad transformer laws;--> (lift .) (f >=> g) = (lift .) f >=> (lift .) g->-> (lift .) return = return-- If you convert these laws to @do@ notation, they just say:--> do x <- lift m = lift $ do x <- m-> lift (f x) f x->-> lift (return r) = return r-- Proxy transformers require the exact same laws to ensure that they lift the- base monad to the extended monad correctly. Just replace 'lift' with- 'liftP':--> (liftP .) (f >=> g) = (liftP .) f >=> (liftP .) g->-> (liftP .) return = return-- The only difference is that I also include 'mapP' in the 'ProxyTrans' type- class for convenience, which sweetens these laws a little bit:--> mapP = (lift .)->-> mapP (f >=> g) = mapP f >=> mapP g -- These are functor laws!->-> mapP return = return-- However, proxy transformers do one extra thing above and beyond ordinary- monad transformers. Proxy transformers lift the 'Proxy' type class, meaning- that if the base type implements 'Proxy', so does the extended type.-- This means that we need a set of laws that guarantee that the proxy- transformer lifts the 'Proxy' instance correctly. I call these laws the- \"proxy transformer laws\":--> mapP (f >-> g) = mapP f >-> mapP g -- These are functor laws, too!->-> mapP idT = idT-- In other words, a proxy transformer defines a functor from the base- composition to the extended composition! Neat!-- But we're not even done, because proxies actually form three other- categories, only one of which I have mentioned so far, and proxy- transformers lift these three other categories, too:--> -- The push-based category->-> mapP (f >~> g) = mapP f >~> mapP g->-> mapP coidT = coidT--> -- The "request" category->-> mapP (f \>\ g) = mapP f \>\ mapP g->-> mapP request = request--> -- The "respond" category->-> mapP (f />/ g) = mapP f />/ mapP g->-> mapP respond = respond-- I never even mentioned those last two categories because they are more- exotic and you probably never need to use them. However, even if we never- use those categories they still guarantee two really important laws that we- should remember:--> mapP request = request->-> mapP respond = respond-- We can translate those to 'liftP' to get:--> liftP $ request a' = request a'->-> liftP $ respond b = respond b-- In other words, 'request' and 'respond' in the extended proxy must behave- exactly the same as lifting 'request' and 'respond' from the base proxy.-- All the proxy transformers in this library obey the proxy transformer laws,- which ensure that 'liftP' / 'mapP' always do \"the right thing\".-- Proxy transformers also implement 'hoistP' from the 'PFunctor' class in- "Control.PFunctor". This exactly parallels 'hoist' for monad transformers.-- Just like monad transformers, we can mix two completely exotic proxy- transformer stacks using a combination of 'liftP' and 'hoistP'. Here's the- proxy transformer equivalent of the previous example I gave:--> p1 :: (Proxy p) => a' -> StateP s (ReaderP i p) a' a a' a m r-> p2 :: (Proxy p) => a' -> MaybeP (WriterP w p) a' a a' a m r-- As before, I can interleave their proxy transformers through judicious use- of 'hoistP' and 'liftP'--> pSequence-> :: (Proxy p) => StateP s (MaybeP (ReaderP i (WriterP w p))) a' a a' a r-> pSequence a' = do-> hoistP (liftP . hoistP liftP) (p1 a')-> liftP (hoistP liftP (p2 a'))-- ... but unlike ordinary monad transformers I could instead mix them by- composition, too!--> pCompose-> :: (Proxy p) => StateP s (MaybeP (ReaderP i (WriterP w p))) a' a a' a r-> pCompose =-> hoistP (liftP . hoistP liftP) . p1-> >-> liftP . hoistP liftP . p2--}--{- $conclusion- The @pipes@ library emphasizes the reuse of a small set of core abstractions- grounded in theory to implement all functionality:-- * Monads-- * Proxies: ('>->'), 'request', and 'respond'-- * Monad Transformers and Functors on Monads: 'lift' and 'hoist'-- * Proxy Transformers and Functors on Proxies: 'liftP' and 'hoistP'-- However, I don't expect everybody to immediately understand how so few- primitives can implement such a wide variety of features. This tutorial- gives a taste of how many interesting ways you can combine these few- abstractions, but these examples barely scratch the surface, despite this- tutorial's length. So if you don't know how to implement something using- @pipes@, just ask me and I will be happy to help.--}
LICENSE view
@@ -1,4 +1,4 @@-Copyright (c) 2012, Gabriel Gonzalez+Copyright (c) 2012-2016 Gabriel Gonzalez All rights reserved. Redistribution and use in source and binary forms, with or without modification,
+ benchmarks/Common.hs view
@@ -0,0 +1,20 @@+module Common (commonMain) where++import Criterion.Main (Benchmark, runMode)+import Criterion.Main.Options as Criterion+import Data.Maybe (fromMaybe)+import Data.Monoid+import Options.Applicative++commonMain :: Int -- ^ default maximum data size+ -> (Int -> [Benchmark]) -- ^ the benchmarks to run+ -> IO ()+commonMain mdMax bench = do+ (maybeNewMax, critMode) <- execParser $ info (helper <*> options) mempty+ runMode critMode $ bench (fromMaybe mdMax maybeNewMax)++options :: Parser (Maybe Int, Criterion.Mode)+options =+ (,) <$> optional (option auto (help "benchmark maximum data size"+ <> metavar "N" <> short 'i' <> long "imax"))+ <*> Criterion.parseWith Criterion.defaultConfig
+ benchmarks/LiftBench.hs view
@@ -0,0 +1,65 @@+{-# LANGUAGE RankNTypes #-}+module Main (main) where++import Common (commonMain)+import Control.Monad.Identity+import qualified Control.Monad.Trans.Reader as R+import qualified Control.Monad.Trans.State.Strict as S+import Criterion.Main+import Data.Monoid+import Pipes+import Pipes.Lift++defaultMax :: Int+defaultMax = 10000++main :: IO ()+main = commonMain defaultMax liftBenchmarks++iter :: forall m a . (Monad m , Ord a, Num a) => (a -> m a) -> a -> Effect m a+iter a vmax = loop 0+ where+ loop n+ | n > vmax = return vmax+ | otherwise = do+ x <- lift $ a n+ loop $! x++s_bench :: Int -> Effect (S.StateT Int Identity) Int+s_bench = iter (\n -> S.get >>= (\a -> S.put $! a + n) >> return (n + 1))++r_bench :: Int -> Effect (R.ReaderT Int Identity) Int+r_bench = iter (\n -> R.ask >>= (\a -> return $ n + a))++-- Run before Proxy+runB :: (a -> Effect Identity r) -> a -> r+runB f a = runIdentity $ runEffect $ f a++-- Run after Proxy+runA :: (Monad m) => (m r -> Identity a) -> Effect m r -> a+runA f a = runIdentity $ f (runEffect a)++liftBenchmarks :: Int -> [Benchmark]+liftBenchmarks vmax =+ let applyBench = map ($ vmax)+ in+ [+ bgroup "ReaderT" $+ let defT f = (\d -> f d 1)+ in applyBench+ [+ bench "runReaderP_B" . whnf (runB (runReaderP 1) . r_bench)+ , bench "runReaderP_A" . whnf (runA (defT R.runReaderT) . r_bench)+ ]+ , bgroup "StateT" $+ let defT f = (\s -> f s 0)+ in applyBench+ [+ bench "runStateP_B" . nf (runB (runStateP 0) . s_bench)+ , bench "runStateP_A" . nf (runA (defT S.runStateT) . s_bench)+ , bench "evalStateP_B" . whnf (runB (evalStateP 0) . s_bench)+ , bench "evalStateP_A" . whnf (runA (defT S.evalStateT) . s_bench)+ , bench "execStateP_B" . whnf (runB (execStateP 0) . s_bench)+ , bench "execStateP_A" . whnf (runA (defT S.execStateT) . s_bench)+ ]+ ]
+ benchmarks/PreludeBench.hs view
@@ -0,0 +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]+ ]+ ]
pipes.cabal view
@@ -1,69 +1,115 @@ Name: pipes-Version: 3.0.0-Cabal-Version: >=1.14.0+Version: 4.3.16+Cabal-Version: >= 1.10 Build-Type: Simple+Tested-With: GHC == 7.10.3, GHC == 8.0.2, GHC == 8.2.2, GHC == 8.4.4, GHC == 8.6.5, GHC == 8.8.1 License: BSD3 License-File: LICENSE-Copyright: 2012 Gabriel Gonzalez+Copyright: 2012-2016 Gabriel Gonzalez Author: Gabriel Gonzalez Maintainer: Gabriel439@gmail.com Bug-Reports: https://github.com/Gabriel439/Haskell-Pipes-Library/issues Synopsis: Compositional pipelines Description:- \"Coroutines done right\". This library generalizes- iteratees\/enumerators\/enumeratees simply and elegantly.+ `pipes` is a clean and powerful stream processing library that lets you build+ and connect reusable streaming components .- Advantages over traditional iteratee\/coroutine implementations:+ Advantages over traditional streaming libraries: .- * /Concise API/: Use three simple commands: ('>->'), 'request', and 'respond'+ * /Concise API/: Use simple commands like 'for', ('>->'), 'await', and 'yield' .- * /Bidirectionality/: Implement duplex channels+ * /Blazing fast/: Implementation tuned for speed, including shortcut fusion .- * /Blazing fast/: Implementation tuned for speed+ * /Lightweight Dependency/: @pipes@ is small and compiles very rapidly,+ including dependencies . * /Elegant semantics/: Use practical category theory .- * /Extension Framework/: Mix and match extensions and create your own+ * /ListT/: Correct implementation of 'ListT' that interconverts with pipes .- * /Lightweight Dependency/: @pipes@ depends only on @transformers@ and- compiles rapidly+ * /Bidirectionality/: Implement duplex channels . * /Extensive Documentation/: Second to none! .- Import "Control.Proxy" to use the library.+ Import "Pipes" to use the library. .- Read "Control.Proxy.Tutorial" for a really extensive tutorial.-Category: Control, Pipes, Proxies-Tested-With: GHC ==7.4.1+ Read "Pipes.Tutorial" for an extensive tutorial.+Category: Control, Pipes+Extra-Source-Files:+ CHANGELOG.md 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+ base >= 4.8 && < 5 ,+ transformers >= 0.2.0.0 && < 0.6 ,+ exceptions >= 0.4 && < 0.11,+ mmorph >= 1.0.4 && < 1.2 ,+ mtl >= 2.2.1 && < 2.3 ,+ void >= 0.4 && < 0.8++ if impl(ghc < 8.0)+ Build-depends:+ fail == 4.9.* ,+ semigroups >= 0.17 && < 0.20+ Exposed-Modules:- Control.MFunctor,- Control.PFunctor,- Control.Pipe,- Control.Proxy,- Control.Proxy.Class,- Control.Proxy.Core,- Control.Proxy.Core.Fast,- Control.Proxy.Core.Correct,- Control.Proxy.Pipe,- Control.Proxy.Synonym,- Control.Proxy.Trans,- Control.Proxy.Trans.Either,- Control.Proxy.Trans.Identity,- Control.Proxy.Trans.Maybe,- Control.Proxy.Trans.Reader,- Control.Proxy.Trans.State,- Control.Proxy.Trans.Writer,- Control.Proxy.Tutorial,- Control.Proxy.Prelude,- Control.Proxy.Prelude.Base,- Control.Proxy.Prelude.IO,- Control.Proxy.Prelude.Kleisli- Default-Language: Haskell98+ 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+ Other-Modules: Common+ GHC-Options: -O2 -Wall -rtsopts -fno-warn-unused-do-bind++ Build-Depends:+ base >= 4.4 && < 5 ,+ criterion >= 1.1.1.0 && < 1.6,+ optparse-applicative >= 0.12 && < 0.17,+ mtl >= 2.1 && < 2.3,+ pipes++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 ,+ 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.6++Benchmark lift-benchmarks+ Default-Language: Haskell2010+ Type: exitcode-stdio-1.0+ HS-Source-Dirs: benchmarks+ Main-Is: LiftBench.hs+ Other-Modules: Common+ GHC-Options: -O2 -Wall -rtsopts -fno-warn-unused-do-bind++ Build-Depends:+ base >= 4.4 && < 5 ,+ criterion >= 1.1.1.0 && < 1.6 ,+ optparse-applicative >= 0.12 && < 0.17,+ mtl >= 2.1 && < 2.3 ,+ pipes ,+ transformers >= 0.2.0.0 && < 0.6
+ src/Pipes.hs view
@@ -0,0 +1,721 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE 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+ , Foldable+ ) where++import Control.Monad (void, MonadPlus(mzero, mplus))+import Control.Monad.Catch (MonadThrow(..), MonadCatch(..))+import Control.Monad.Except (MonadError(..))+import Control.Monad.Fail (MonadFail(..))+import Control.Monad.IO.Class (MonadIO(liftIO))+import Control.Monad.Reader (MonadReader(..))+import Control.Monad.State (MonadState(..))+import Control.Monad.Trans.Class (MonadTrans(lift))+import Control.Monad.Trans.Except (ExceptT, runExceptT)+import Control.Monad.Trans.Identity (IdentityT(runIdentityT))+import Control.Monad.Trans.Maybe (MaybeT(runMaybeT))+import Control.Monad.Writer (MonadWriter(..))+import Control.Monad.Zip (MonadZip(..))+import Pipes.Core+import Pipes.Internal (Proxy(..))+import qualified Data.Foldable as F++#if MIN_VERSION_base(4,8,0)+import Control.Applicative (Alternative(..))+#else+import Control.Applicative+import Data.Foldable (Foldable)+import Data.Traversable (Traversable(..))+#endif+import Data.Semigroup++-- Re-exports+import Control.Monad.Morph (MFunctor(hoist), MMonad(embed))++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 -> 'Producer' a m ()+'yield' :: 'Monad' m => a -> 'Pipe' x a m ()+@+-}+yield :: Functor m => a -> Proxy x' x () a m ()+yield = respond+{-# INLINABLE [1] yield #-}++{-| @(for p body)@ loops over @p@ replacing each 'yield' with @body@.++@+'for' :: 'Functor' m => 'Producer' b m r -> (b -> 'Effect' m ()) -> 'Effect' m r+'for' :: 'Functor' m => 'Producer' b m r -> (b -> 'Producer' c m ()) -> 'Producer' c m r+'for' :: 'Functor' m => 'Pipe' x b m r -> (b -> 'Consumer' x m ()) -> 'Consumer' x m r+'for' :: 'Functor' 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 :: Functor m+ => Proxy x' x b' b m a'+ -- ^+ -> (b -> Proxy x' x c' c m b')+ -- ^+ -> Proxy x' x c' c m a'+for = (//>)+-- There are a number of useful rewrites which can be performed on various uses+-- of this combinator; to ensure that they fire we defer inlining until quite+-- late.+{-# INLINABLE [0] 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++@+('~>') :: 'Functor' m => (a -> 'Producer' b m r) -> (b -> 'Effect' m ()) -> (a -> 'Effect' m r)+('~>') :: 'Functor' m => (a -> 'Producer' b m r) -> (b -> 'Producer' c m ()) -> (a -> 'Producer' c m r)+('~>') :: 'Functor' m => (a -> 'Pipe' x b m r) -> (b -> 'Consumer' x m ()) -> (a -> 'Consumer' x m r)+('~>') :: 'Functor' 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".+-}+(~>)+ :: Functor 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+(<~)+ :: Functor 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' :: 'Functor' m => 'Pipe' a y m a+@+-}+await :: Functor m => Consumer' a m a+await = request ()+{-# INLINABLE [1] await #-}++{-| @(draw >~ p)@ loops over @p@ replacing each 'await' with @draw@++@+('>~') :: 'Functor' m => 'Effect' m b -> 'Consumer' b m c -> 'Effect' m c+('>~') :: 'Functor' m => 'Consumer' a m b -> 'Consumer' b m c -> 'Consumer' a m c+('>~') :: 'Functor' m => 'Producer' y m b -> 'Pipe' b y m c -> 'Producer' y m c+('>~') :: 'Functor' 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".+-}+(>~)+ :: Functor 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 [1] (>~) #-}++-- | ('>~') with the arguments flipped+(~<)+ :: Functor 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 :: Functor m => Pipe a a m r+cat = pull ()+{-# INLINABLE [1] cat #-}++{-| 'Pipe' composition, analogous to the Unix pipe operator++@+('>->') :: 'Functor' m => 'Producer' b m r -> 'Consumer' b m r -> 'Effect' m r+('>->') :: 'Functor' m => 'Producer' b m r -> 'Pipe' b c m r -> 'Producer' c m r+('>->') :: 'Functor' m => 'Pipe' a b m r -> 'Consumer' b m r -> 'Consumer' a m r+('>->') :: 'Functor' 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".+-}+(>->)+ :: Functor 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 [1] (>->) #-}++{-| The list monad transformer, which extends a monad with non-determinism++ The type variables signify:++ * @m@ - The base monad+ * @a@ - The values that the computation 'yield's throughout its execution++ For basic construction and composition of 'ListT' computations, much can be+ accomplished using common typeclass methods.++ * 'return' corresponds to 'yield', yielding a single value.+ * ('>>=') corresponds to 'for', calling the second computation once+ for each time the first computation 'yield's.+ * 'mempty' neither 'yield's any values nor produces any effects in the+ base monad.+ * ('<>') sequences two computations, 'yield'ing all the values of the+ first followed by all the values of the second.+ * 'lift' converts an action in the base monad into a ListT computation+ which performs the action and 'yield's a single value.++ 'ListT' is a newtype wrapper for 'Producer'. You will likely need to use+ 'Select' and 'enumerate' to convert back and forth between these two types+ to take advantage of all the 'Producer'-related utilities that+ "Pipes.Prelude" has to offer.++ * To lift a plain list into a 'ListT' computation, first apply 'each'+ to turn the list into a 'Producer'. Then apply the 'Select'+ constructor to convert from 'Producer' to 'ListT'.+ * For other ways to construct 'ListT' computations, see the+ “Producers” section in "Pipes.Prelude" to build 'Producer's.+ These can then be converted to 'ListT' using 'Select'.+ * To aggregate the values from a 'ListT' computation (for example,+ to compute the sum of a 'ListT' of numbers), first apply+ 'enumerate' to obtain a 'Producer'. Then see the “Folds”+ section in "Pipes.Prelude" to proceed.+-}+newtype ListT m a = Select { enumerate :: Producer a m () }++instance Functor m => Functor (ListT m) where+ fmap f p = Select (for (enumerate p) (\a -> yield (f a)))+ {-# INLINE fmap #-}++instance Functor m => Applicative (ListT m) where+ pure a = Select (yield a)+ {-# INLINE pure #-}+ mf <*> mx = Select (+ for (enumerate mf) (\f ->+ for (enumerate mx) (\x ->+ yield (f x) ) ) )++instance Monad m => Monad (ListT m) where+ return = pure+ {-# INLINE return #-}+ m >>= f = Select (for (enumerate m) (\a -> enumerate (f a)))+ {-# INLINE (>>=) #-}+#if !MIN_VERSION_base(4,13,0)+ fail _ = mzero+ {-# INLINE fail #-}+#endif++instance Monad m => MonadFail (ListT m) where+ fail _ = mzero+ {-# INLINE fail #-}++instance Foldable m => Foldable (ListT m) where+ foldMap f = go . enumerate+ where+ go p = case p of+ Request v _ -> closed v+ Respond a fu -> f a `mappend` go (fu ())+ M m -> F.foldMap go m+ Pure _ -> mempty+ {-# INLINE foldMap #-}++instance (Functor m, Traversable m) => Traversable (ListT m) where+ traverse k (Select p) = fmap Select (traverse_ p)+ where+ traverse_ (Request v _ ) = closed v+ traverse_ (Respond a fu) = _Respond <$> k a <*> traverse_ (fu ())+ where+ _Respond a_ a' = Respond a_ (\_ -> a')+ traverse_ (M m ) = fmap M (traverse traverse_ m)+ traverse_ (Pure r ) = pure (Pure r)++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)+ {-# INLINE liftIO #-}++instance (Functor m) => Alternative (ListT m) where+ empty = Select (return ())+ {-# INLINE empty #-}+ p1 <|> p2 = Select (do+ enumerate p1+ enumerate p2 )++instance (Monad m) => MonadPlus (ListT m) where+ mzero = empty+ {-# INLINE mzero #-}+ mplus = (<|>)+ {-# INLINE mplus #-}++instance MFunctor ListT where+ hoist morph = Select . hoist morph . enumerate+ {-# INLINE hoist #-}++instance MMonad ListT where+ embed f (Select p0) = Select (loop p0)+ where+ loop (Request a' fa ) = Request a' (\a -> loop (fa a ))+ loop (Respond b fb') = Respond b (\b' -> loop (fb' b'))+ loop (M m ) = for (enumerate (fmap loop (f m))) id+ loop (Pure r ) = Pure r+ {-# INLINE embed #-}++instance (Functor m) => Semigroup (ListT m a) where+ (<>) = (<|>)+ {-# INLINE (<>) #-}++instance (Functor m) => Monoid (ListT m a) where+ mempty = empty+ {-# INLINE mempty #-}+#if !(MIN_VERSION_base(4,11,0))+ mappend = (<|>)+ {-# INLINE mappend #-}+#endif++instance (MonadState s m) => MonadState s (ListT m) where+ get = lift get+ {-# INLINE get #-}++ put s = lift (put s)+ {-# INLINE put #-}++ state f = lift (state f)+ {-# INLINE state #-}++instance (MonadWriter w m) => MonadWriter w (ListT m) where+ writer = lift . writer+ {-# INLINE writer #-}++ tell w = lift (tell w)+ {-# INLINE tell #-}++ 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+ {-# INLINE ask #-}++ local f l = Select (local f (enumerate l))+ {-# INLINE local #-}++ reader f = lift (reader f)+ {-# INLINE reader #-}++instance (MonadError e m) => MonadError e (ListT m) where+ throwError e = lift (throwError e)+ {-# INLINE throwError #-}++ catchError l k = Select (catchError (enumerate l) (\e -> enumerate (k e)))+ {-# INLINE catchError #-}++instance MonadThrow m => MonadThrow (ListT m) where+ throwM = Select . throwM+ {-# INLINE throwM #-}++instance MonadCatch m => MonadCatch (ListT m) where+ catch l k = Select (Control.Monad.Catch.catch (enumerate l) (\e -> enumerate (k e)))+ {-# INLINE catch #-}++instance Monad m => MonadZip (ListT m) where+ mzipWith f = go+ where+ go xs ys = Select $ do+ xres <- lift $ next (enumerate xs)+ case xres of+ Left r -> return r+ Right (x, xnext) -> do+ yres <- lift $ next (enumerate ys)+ case yres of+ Left r -> return r+ Right (y, ynext) -> do+ yield (f x y)+ enumerate (go (Select xnext) (Select ynext))++-- | 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 (ExceptT e) where+ toListT m = Select $ do+ x <- lift $ runExceptT 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' :: ('Functor' m, 'Foldable' f) => f a -> 'Producer' a m ()+@+-}+each :: (Functor m, Foldable f) => f a -> Proxy x' x () 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 :: (Monad m, Enumerable t) => t m a -> Proxy x' x () 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+(<-<)+ :: Functor 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
@@ -0,0 +1,894 @@+{-| The core functionality for the 'Proxy' monad transformer++ Read "Pipes.Tutorial" if you want a beginners tutorial explaining how to use+ this library. The documentation in this module targets more advanced users+ who want to understand the theory behind this library.++ This module is not exported by default, and I recommend you use the+ unidirectional operations exported by the "Pipes" module if you can. You+ should only use this module if you require advanced features like:++ * bidirectional communication, or:++ * push-based 'Pipe's.+-}++{-# LANGUAGE RankNTypes, Trustworthy #-}++module Pipes.Core (+ -- * Proxy Monad Transformer+ -- $proxy+ Proxy+ , runEffect++ -- * Categories+ -- $categories++ -- ** Respond+ -- $respond+ , respond+ , (/>/)+ , (//>)++ -- ** Request+ -- $request+ , request+ , (\>\)+ , (>\\)++ -- ** Push+ -- $push+ , push+ , (>~>)+ , (>>~)++ -- ** Pull+ -- $pull+ , pull+ , (>+>)+ , (+>>)++ -- ** Reflect+ -- $reflect+ , reflect++ -- * Concrete Type Synonyms+ , X+ , Effect+ , Producer+ , Pipe+ , Consumer+ , Client+ , Server++ -- * Polymorphic Type Synonyms+ , Effect'+ , Producer'+ , Consumer'+ , Client'+ , Server'++ -- * Flipped operators+ , (\<\)+ , (/</)+ , (<~<)+ , (~<<)+ , (<+<)+ , (<\\)+ , (//<)+ , (<<+)++ -- * Re-exports+ , closed+ ) where++import Pipes.Internal (Proxy(..), X, closed)++{- $proxy+ Diagrammatically, you can think of a 'Proxy' as having the following shape:++@+ Upstream | Downstream+ +---------++ | |+ a' <== <== b'+ | |+ a ==> ==> b+ | | |+ +----|----++ v+ r+@++ You can connect proxies together in five different ways:++ * ('Pipes.>+>'): connect pull-based streams++ * ('Pipes.>~>'): connect push-based streams++ * ('Pipes.\>\'): chain folds++ * ('Pipes./>/'): chain unfolds++ * ('Control.Monad.>=>'): sequence proxies++-}++-- | Run a self-contained 'Effect', converting it back to the base monad+runEffect :: Monad m => Effect m r -> m r+runEffect = go+ where+ go p = case p of+ Request v _ -> closed v+ Respond v _ -> closed v+ M m -> m >>= go+ Pure r -> return r+{-# INLINABLE runEffect #-}++{- * Keep proxy composition lower in precedence than function composition, which+ is 9 at the time of of this comment, so that users can write things like:+++> lift . k >+> p+>+> hoist f . k >+> p++ * Keep the priorities different so that users can mix composition operators+ like:++> up \>\ p />/ dn+>+> up >~> p >+> dn++ * Keep 'request' and 'respond' composition lower in precedence than 'pull'+ and 'push' composition, so that users can do:++> read \>\ pull >+> writer++ * I arbitrarily choose a lower priority for downstream operators so that lazy+ pull-based computations need not evaluate upstream stages unless absolutely+ necessary.+-}+infixl 3 //>+infixr 3 <\\ -- GHC will raise a parse error if either of these lines ends+infixr 4 />/, >\\ -- with '\', which is why this comment is here+infixl 4 \<\, //<+infixl 5 \>\ -- Same thing here+infixr 5 /</+infixl 6 <<++infixr 6 +>>+infixl 7 >+>, >>~+infixr 7 <+<, ~<<+infixl 8 <~<+infixr 8 >~>++{- $categories+ A 'Control.Category.Category' is a set of components that you can connect+ with a composition operator, ('Control.Category..'), that has an identity,+ 'Control.Category.id'. The ('Control.Category..') and 'Control.Category.id'+ must satisfy the following three 'Control.Category.Category' laws:++@+\-\- Left identity+'Control.Category.id' 'Control.Category..' f = f++\-\- Right identity+f 'Control.Category..' 'Control.Category.id' = f++\-\- Associativity+(f 'Control.Category..' g) 'Control.Category..' h = f 'Control.Category..' (g 'Control.Category..' h)+@++ The 'Proxy' type sits at the intersection of five separate categories, four+ of which are named after their identity:++@+ Identity | Composition | Point-ful+ +-------------+-------------+-------------++ respond category | 'respond' | '/>/' | '//>' |+ request category | 'request' | '\>\' | '>\\' |+ push category | 'push' | '>~>' | '>>~' |+ pull category | 'pull' | '>+>' | '+>>' |+ Kleisli category | 'return' | 'Control.Monad.>=>' | '>>=' |+ +-------------+-------------+-------------++@++ Each composition operator has a \"point-ful\" version, analogous to how+ ('>>=') is the point-ful version of ('Control.Monad.>=>'). For example,+ ('//>') is the point-ful version of ('/>/'). The convention is that the+ odd character out faces the argument that is a function.+-}++{- $respond+ The 'respond' category closely corresponds to the generator design pattern.++ The 'respond' category obeys the category laws, where 'respond' is the+ identity and ('/>/') is composition:++@+\-\- Left identity+'respond' '/>/' f = f++\-\- Right identity+f '/>/' 'respond' = f++\-\- Associativity+(f '/>/' g) '/>/' h = f '/>/' (g '/>/' h)+@++#respond-diagram#++ The following diagrams show the flow of information:++@+'respond' :: 'Functor' m+ => a -> 'Proxy' x' x a' a m a'++\ a+ |+ +----|----++ | | |+ x' <== \\ /==== a'+ | X |+ x ==> / \\===> a+ | | |+ +----|----++ v+ a'++('/>/') :: 'Functor' 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'++('//>') :: 'Functor' 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 :: Functor m => a -> Proxy x' x a' a m a'+respond a = Respond a Pure+{-# INLINABLE [1] respond #-}++{-| Compose two unfolds, creating a new unfold++@+(f '/>/' g) x = f x '//>' g+@++ ('/>/') is the composition operator of the respond category.+-}+(/>/)+ :: Functor 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 ('/>/')+-}+(//>)+ :: Functor 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 (go <$> m)+ Pure a -> Pure a+{-# INLINE [1] (//>) #-}++{-# 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 ((\p' -> p' //> fb) <$> m);+ "(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' :: 'Functor' m+ => a' -> 'Proxy' a' a y' y m a++\ a'+ |+ +----|----++ | | |+ a' <=====/ <== y'+ | |+ a ======\\ ==> y+ | | |+ +----|----++ v+ a++('\>\') :: 'Functor' 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++('>\\') :: Functor 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 :: Functor m => a' -> Proxy a' a y' y m a+request a' = Request a' Pure+{-# INLINABLE [1] request #-}++{-| Compose two folds, creating a new fold++@+(f '\>\' g) x = f '>\\' g x+@++ ('\>\') is the composition operator of the request category.+-}+(\>\)+ :: Functor 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 ('\>\')+-}+(>\\)+ :: Functor 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 (go <$> m)+ Pure a -> Pure a+{-# INLINE [1] (>\\) #-}++{-# 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 ((\p' -> fb' >\\ p') <$> m);+ "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' :: 'Functor' m+ => a -> 'Proxy' a' a a' a m r++\ a+ |+ +----|----++ | v |+ a' <============ a'+ | |+ a ============> a+ | | |+ +----|----++ v+ r++('>~>') :: 'Functor' 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 :: Functor m => a -> Proxy a' a a' a m r+push = go+ where+ go a = Respond a (\a' -> Request a' go)+{-# INLINABLE [1] 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.+-}+(>~>)+ :: Functor 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 a 'request' in @f@.++ Point-ful version of ('>~>')+-}+(>>~)+ :: Functor 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 ((\p' -> p' >>~ fb) <$> m)+ Pure r -> Pure r+{-# INLINE [1] (>>~) #-}++{- $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' :: 'Functor' m+ => a' -> 'Proxy' a' a a' a m r++\ a'+ |+ +----|----++ | v |+ a' <============ a'+ | |+ a ============> a+ | | |+ +----|----++ v+ r++('>+>') :: 'Functor' 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 :: Functor m => a' -> Proxy a' a a' a m r+pull = go+ where+ go a' = Request a' (\a -> Respond a go)+{-# INLINABLE [1] 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.+-}+(>+>)+ :: Functor 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 ('>+>')+-}+(+>>)+ :: Functor 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 ((\p' -> fb' +>> p') <$> m)+ Pure r -> Pure r+{-# INLINABLE [1] (+>>) #-}++{- $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 :: Functor 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 (go <$> m)+ 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+(\<\)+ :: Functor 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+(/</)+ :: Functor 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+(<~<)+ :: Functor 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+(<+<)+ :: Functor 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+(<\\)+ :: Functor 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+(//<)+ :: Functor 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+(~<<)+ :: Functor 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+(<<+)+ :: Functor 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
@@ -0,0 +1,284 @@+{-| 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 CPP #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE Trustworthy #-}++module Pipes.Internal (+ -- * Internal+ Proxy(..)+ , unsafeHoist+ , observe+ , X+ , closed+ ) where++import qualified Control.Monad.Fail as F (MonadFail(fail))+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.Except (MonadError(..))+import Control.Monad.Catch (MonadThrow(..), MonadCatch(..))+import Control.Monad.Reader (MonadReader(..))+import Control.Monad.State (MonadState(..))+import Control.Monad.Writer (MonadWriter(..), censor)+import Data.Void (Void)++#if MIN_VERSION_base(4,8,0)+import Control.Applicative (Alternative(..))+#else+import Control.Applicative+#endif+import Data.Semigroup++import qualified Data.Void++{-| 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 Functor 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 (go <$> m)+ Pure r -> Pure (f r)++instance Functor 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 (go <$> m)+ Pure f -> fmap f px+ l *> r = go l 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 (go <$> m)+ Pure _ -> r++instance Functor m => Monad (Proxy a' a b' b m) where+ return = pure+ (>>=) = _bind++_bind+ :: Functor 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 (go <$> m)+ Pure r -> f r+{-# NOINLINE[1] _bind #-}++{-# 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 ((\p -> _bind p f) <$> m);+ "_bind (Pure r ) f" forall r f .+ _bind (Pure r ) f = f r;+ #-}++instance (Functor m, Semigroup r) => Semigroup (Proxy a' a b' b m r) where+ 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 (go <$> m)+ Pure r1 -> fmap (r1 <>) p2++instance (Functor m, Monoid r, Semigroup r) => Monoid (Proxy a' a b' b m r) where+ mempty = Pure mempty+#if !(MIN_VERSION_base(4,11,0))+ mappend = (<>)+#endif++instance MonadTrans (Proxy a' a b' b) where+ lift m = M (Pure <$> m)++{-| '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+ :: Functor 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 (go <$> m))+ 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 (go <$> m))+ 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 F.MonadFail m => F.MonadFail (Proxy a' a b' b m) where+ fail = lift . F.fail++instance MonadIO m => MonadIO (Proxy a' a b' b m) where+ liftIO m = M (liftIO (Pure <$> m))++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 (go <$> local f m)+ 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') <- censor (const mempty) (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 MonadThrow m => MonadThrow (Proxy a' a b' b m) where+ throwM = lift . throwM+ {-# INLINE throwM #-}++instance MonadCatch m => MonadCatch (Proxy a' a b' b m) where+ catch 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') ) `Control.Monad.Catch.catch` (\e -> return (f e)) )++{-| 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+type X = Void++-- | Use 'closed' to \"handle\" impossible outputs+closed :: X -> a+closed = Data.Void.absurd+{-# INLINABLE closed #-}
+ src/Pipes/Lift.hs view
@@ -0,0 +1,386 @@+{-# LANGUAGE CPP #-}++{-| 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++ -- * ExceptT+ , exceptP+ , runExceptP+ , 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.Except 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 Pipes.Internal (Proxy(..), unsafeHoist)+import Control.Monad.Morph (hoist, MFunctor(..))+import Pipes.Core (runEffect, request, respond, (//>), (>\\))++#if MIN_VERSION_base(4,8,0)+#else+import Data.Monoid+#endif++-- | 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.ExceptT'+exceptP+ :: Monad m+ => Proxy a' a b' b m (Either e r)+ -> Proxy a' a b' b (E.ExceptT e m) r+exceptP p = do+ x <- unsafeHoist lift p+ lift $ E.ExceptT (return x)+{-# INLINABLE exceptP #-}++-- | Run 'E.ExceptT' in the base monad+runExceptP+ :: Monad m+ => Proxy a' a b' b (E.ExceptT e m) r+ -> Proxy a' a b' b m (Either e r)+runExceptP = E.runExceptT . distribute+{-# INLINABLE runExceptP #-}++-- | Catch an error in the base monad+catchError+ :: Monad m+ => Proxy a' a b' b (E.ExceptT e m) r+ -- ^+ -> (e -> Proxy a' a b' b (E.ExceptT e m) r)+ -- ^+ -> Proxy a' a b' b (E.ExceptT e m) r+catchError e h = exceptP . E.runExceptT $ + E.catchE (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.ExceptT':++> import Control.Monad.Trans.Error+> import Pipes+>+> example :: Monad m => Pipe Int Int (ExceptT 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+>>> runExceptT $ 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 (ExceptT 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:++>>> runExceptT $ 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
@@ -0,0 +1,1009 @@+{-| General purpose utilities++ The names in this module clash heavily with the Haskell Prelude, so I+ recommend the following import scheme:++> import Pipes+> import qualified Pipes.Prelude as P -- or use any other qualifier you prefer++ Note that 'String'-based 'IO' is inefficient. The 'String'-based utilities+ in this module exist only for simple demonstrations without incurring a+ dependency on the @text@ package.++ Also, 'stdinLn' and 'stdoutLn' remove and add newlines, respectively. This+ behavior is intended to simplify examples. The corresponding @stdin@ and+ @stdout@ utilities from @pipes-bytestring@ and @pipes-text@ preserve+ newlines.+-}++{-# LANGUAGE RankNTypes, Trustworthy #-}+{-# OPTIONS_GHC -fno-warn-unused-do-bind #-}++module Pipes.Prelude (+ -- * Producers+ -- $producers+ stdinLn+ , readLn+ , fromHandle+ , repeatM+ , replicateM+ , unfoldr++ -- * Consumers+ -- $consumers+ , stdoutLn+ , stdoutLn'+ , mapM_+ , print+ , toHandle+ , drain++ -- * Pipes+ -- $pipes+ , map+ , mapM+ , sequence+ , mapFoldable+ , filter+ , mapMaybe+ , filterM+ , wither+ , take+ , takeWhile+ , takeWhile'+ , drop+ , dropWhile+ , concat+ , elemIndices+ , findIndices+ , scan+ , scanM+ , chain+ , read+ , show+ , seq++ -- *ListT+ , loop++ -- * Folds+ -- $folds+ , fold+ , fold'+ , foldM+ , foldM'+ , all+ , any+ , and+ , or+ , elem+ , notElem+ , find+ , findIndex+ , head+ , index+ , last+ , length+ , maximum+ , minimum+ , null+ , sum+ , product+ , toList+ , toListM+ , toListM'++ -- * Zips+ , zip+ , zipWith++ -- * Utilities+ , tee+ , generalize+ ) where++import Control.Exception (throwIO, try)+import Control.Monad (liftM, when, unless, (>=>))+import Control.Monad.Trans.State.Strict (get, put)+import Data.Functor.Identity (Identity, runIdentity)+import Foreign.C.Error (Errno(Errno), ePIPE)+import GHC.Exts (build)+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 :: MonadIO m => IO.Handle -> Proxy x' x () 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 :: Monad m => m a -> Proxy x' x () a m r+repeatM m = lift m >~ cat+{-# INLINABLE [1] 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 :: Monad m => Int -> m a -> Proxy x' x () a m ()+replicateM n m = lift m >~ take n+{-# INLINABLE replicateM #-}++{- $consumers+ Feed a 'Consumer' the same value repeatedly using ('>~'):++>>> runEffect $ lift getLine >~ P.stdoutLn+Test<Enter>+Test+ABC<Enter>+ABC+...++-}++{-| Write 'String's to 'IO.stdout' using 'putStrLn'++ Unlike 'toHandle', 'stdoutLn' gracefully terminates on a broken output pipe+-}+stdoutLn :: MonadIO m => Consumer' String m ()+stdoutLn = go+ where+ go = do+ str <- await+ x <- liftIO $ try (putStrLn str)+ case x of+ Left (G.IOError { G.ioe_type = G.ResourceVanished+ , G.ioe_errno = Just ioe })+ | Errno ioe == ePIPE+ -> return ()+ Left e -> liftIO (throwIO e)+ Right () -> go+{-# INLINABLE stdoutLn #-}++{-| Write 'String's to 'IO.stdout' using 'putStrLn'++ This does not handle a broken output pipe, but has a polymorphic return+ value+-}+stdoutLn' :: MonadIO m => Consumer' String m r+stdoutLn' = for cat (\str -> liftIO (putStrLn str))+{-# INLINABLE [1] stdoutLn' #-}++{-# RULES+ "p >-> stdoutLn'" forall p .+ p >-> stdoutLn' = for p (\str -> liftIO (putStrLn str))+ #-}++-- | Consume all values using a monadic function+mapM_ :: Monad m => (a -> m ()) -> Consumer' a m r+mapM_ f = for cat (\a -> lift (f a))+{-# INLINABLE [1] 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 [1] 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 [1] toHandle #-}++{-# RULES+ "p >-> toHandle handle" forall p handle .+ p >-> toHandle handle = for p (\str -> liftIO (IO.hPutStrLn handle str))+ #-}++-- | 'discard' all incoming values+drain :: Functor m => Consumer' a m r+drain = for cat discard+{-# INLINABLE [1] 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 :: Functor m => (a -> b) -> Pipe a b m r+map f = for cat (\a -> yield (f a))+{-# INLINABLE [1] 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 [1] 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 :: (Functor m, Foldable t) => (a -> t b) -> Pipe a b m r+mapFoldable f = for cat (\a -> each (f a))+{-# INLINABLE [1] 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 f = mapMaybe (\a -> a <$ guard (f a))+-}+filter :: Functor m => (a -> Bool) -> Pipe a a m r+filter predicate = for cat $ \a -> when (predicate a) (yield a)+{-# INLINABLE [1] filter #-}++{-# RULES+ "p >-> filter predicate" forall p predicate.+ p >-> filter predicate = for p (\a -> when (predicate a) (yield a))+ #-}++{-| @(mapMaybe f)@ yields 'Just' results of 'f'.++Basic laws:++> mapMaybe (f >=> g) = mapMaybe f >-> mapMaybe g+>+> mapMaybe (pure @Maybe . f) = mapMaybe (Just . f) = map f+>+> mapMaybe (const Nothing) = drain++As a result of the second law,++> mapMaybe return = mapMaybe Just = cat+-}+mapMaybe :: Functor m => (a -> Maybe b) -> Pipe a b m r+mapMaybe f = for cat $ maybe (pure ()) yield . f+{-# INLINABLE [1] mapMaybe #-}++{-# RULES+ "p >-> mapMaybe f" forall p f.+ p >-> mapMaybe f = for p $ maybe (pure ()) yield . f+ #-}++{-| @(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 f = wither (\a -> (\b -> a <$ guard b) <$> f a)+-}+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 [1] filterM #-}++{-# RULES+ "p >-> filterM predicate" forall p predicate .+ p >-> filterM predicate = for p (\a -> do+ b <- lift (predicate a)+ when b (yield a) )+ #-}++{-| @(wither f)@ forwards 'Just' values produced by the+ monadic action.++Basic laws:++> wither (runMaybeT . (MaybeT . f >=> MaybeT . g)) = wither f >-> wither g+>+> wither (runMaybeT . lift . f) = wither (fmap Just . f) = mapM f+>+> wither (pure . f) = mapMaybe f++As a result of the second law,++> wither (runMaybeT . return) = cat++As a result of the third law,++> wither (pure . const Nothing) = wither (const (pure Nothing)) = drain+-}+wither :: Monad m => (a -> m (Maybe b)) -> Pipe a b m r+wither f = for cat $ lift . f >=> maybe (pure ()) yield+{-# INLINABLE [1] wither #-}++{-# RULES+ "p >-> wither f" forall p f .+ p >-> wither f = for p $ lift . f >=> maybe (pure ()) yield+ #-}++{-| @(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 :: Functor m => Int -> Pipe a a m ()+take = go+ where+ go 0 = return () + go n = do + a <- await+ yield a+ go (n-1)+{-# INLINABLE take #-}++{-| @(takeWhile p)@ allows values to pass downstream so long as they satisfy+ the predicate @p@.++> takeWhile (pure True) = cat+>+> takeWhile (liftA2 (&&) p1 p2) = takeWhile p1 >-> takeWhile p2+-}+takeWhile :: Functor 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' :: Functor 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 :: Functor m => Int -> Pipe a a m r+drop = go+ where+ go 0 = cat+ go n = do+ await+ go (n-1)+{-# INLINABLE drop #-}++{-| @(dropWhile p)@ discards values going downstream until one violates the+ predicate @p@.++> dropWhile (pure False) = cat+>+> dropWhile (liftA2 (||) p1 p2) = dropWhile p1 >-> dropWhile p2+-}+dropWhile :: Functor 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 :: (Functor m, Foldable f) => Pipe (f a) a m r+concat = for cat each+{-# INLINABLE [1] concat #-}++{-# RULES+ "p >-> concat" forall p . p >-> concat = for p each+ #-}++-- | Outputs the indices of all elements that match the given element+elemIndices :: (Functor 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 :: Functor m => (a -> Bool) -> Pipe a Int m r+findIndices predicate = go 0+ where+ go n = do+ a <- await+ when (predicate a) (yield n)+ go $! n + 1+{-# INLINABLE findIndices #-}++{-| Strict left scan++> Control.Foldl.purely scan :: Monad m => Fold a b -> Pipe a b m r+-}+scan :: Functor m => (x -> a -> x) -> x -> (x -> b) -> Pipe a b m r+scan step begin done = go begin+ where+ go x = do+ yield (done x)+ a <- await+ let x' = step x a+ go $! x'+{-# INLINABLE scan #-}++{-| Strict, monadic left scan++> Control.Foldl.impurely scanM :: Monad m => FoldM m a b -> Pipe a b m r+-}+scanM :: Monad m => (x -> a -> m x) -> m x -> (x -> m b) -> Pipe a b m r+scanM step begin done = do+ x <- lift begin+ go x+ where+ go x = do+ b <- lift (done x)+ yield b+ a <- await+ x' <- lift (step x a)+ go $! x'+{-# INLINABLE scanM #-}++{-| Apply an action to all values flowing downstream++> chain (pure (return ())) = cat+>+> chain (liftA2 (>>) m1 m2) = chain m1 >-> chain m2+-}+chain :: Monad m => (a -> m ()) -> Pipe a a m r+chain f = for cat $ \a -> do+ lift (f a)+ yield a+{-# INLINABLE [1] 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 :: (Functor m, Read a) => Pipe String a m r+read = for cat $ \str -> case (reads str) of+ [(a, "")] -> yield a+ _ -> return ()+{-# INLINABLE [1] 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 :: (Functor m, Show a) => Pipe a String m r+show = map Prelude.show+{-# INLINABLE show #-}++-- | Evaluate all values flowing downstream to WHNF+seq :: Functor m => Pipe a a m r+seq = for cat $ \a -> yield $! a+{-# INLINABLE seq #-}++{-| Create a `Pipe` from a `ListT` transformation++> loop (k1 >=> k2) = loop k1 >-> loop k2+>+> loop return = cat+-}+loop :: Monad m => (a -> ListT m b) -> Pipe a b m r+loop k = for cat (every . k)+{-# INLINABLE loop #-}++{- $folds+ Use these to fold the output of a 'Producer'. Many of these folds will stop+ drawing elements if they can compute their result early, like 'any':++>>> P.any Prelude.null P.stdinLn+Test<Enter>+ABC<Enter>+<Enter>+True+>>>++-}++{-| Strict fold of the elements of a 'Producer'++> Control.Foldl.purely fold :: Monad m => Fold a b -> Producer a m () -> m b+-}+fold :: Monad m => (x -> a -> x) -> x -> (x -> b) -> Producer a m () -> m b+fold step begin done p0 = go p0 begin+ where+ go p x = case p of+ Request v _ -> closed v+ Respond a fu -> go (fu ()) $! step x a+ M m -> m >>= \p' -> go p' x+ Pure _ -> return (done x)+{-# INLINABLE fold #-}++{-| Strict fold of the elements of a 'Producer' that preserves the return value++> Control.Foldl.purely fold' :: Monad m => Fold a b -> Producer a m r -> m (b, r)+-}+fold' :: Monad m => (x -> a -> x) -> x -> (x -> b) -> Producer a m r -> m (b, r)+fold' step begin done p0 = go p0 begin+ where+ go p x = case p of+ Request v _ -> closed v+ Respond a fu -> go (fu ()) $! step x a+ M m -> m >>= \p' -> go p' x+ Pure r -> return (done x, r)+{-# INLINABLE fold' #-}++{-| Strict, monadic fold of the elements of a 'Producer'++> Control.Foldl.impurely foldM :: Monad m => FoldM a b -> Producer a m () -> m b+-}+foldM+ :: Monad m+ => (x -> a -> m x) -> m x -> (x -> m b) -> Producer a m () -> m b+foldM step begin done p0 = do+ x0 <- begin+ go p0 x0+ where+ go p x = case p of+ Request v _ -> closed v+ Respond a fu -> do+ x' <- step x a+ go (fu ()) $! x'+ M m -> m >>= \p' -> go p' x+ Pure _ -> done x+{-# INLINABLE foldM #-}++{-| Strict, monadic fold of the elements of a 'Producer'++> Control.Foldl.impurely foldM' :: Monad m => FoldM a b -> Producer a m r -> m (b, r)+-}+foldM'+ :: Monad m+ => (x -> a -> m x) -> m x -> (x -> m b) -> Producer a m r -> m (b, r)+foldM' step begin done p0 = do+ x0 <- begin+ go p0 x0+ where+ go p x = case p of+ Request v _ -> closed v+ Respond a fu -> do+ x' <- step x a+ go (fu ()) $! x'+ M m -> m >>= \p' -> go p' x+ Pure r -> do+ b <- done x+ return (b, r)+{-# INLINABLE foldM' #-}++{-| @(all predicate p)@ determines whether all the elements of @p@ satisfy the+ predicate.+-}+all :: Monad m => (a -> Bool) -> Producer a m () -> m Bool+all predicate p = null $ p >-> filter (\a -> not (predicate a))+{-# INLINABLE all #-}++{-| @(any predicate p)@ determines whether any element of @p@ satisfies the+ predicate.+-}+any :: Monad m => (a -> Bool) -> Producer a m () -> m Bool+any predicate p = liftM not $ null (p >-> filter predicate)+{-# INLINABLE any #-}++-- | Determines whether all elements are 'True'+and :: Monad m => Producer Bool m () -> m Bool+and = all id+{-# INLINABLE and #-}++-- | Determines whether any element is 'True'+or :: Monad m => Producer Bool m () -> m Bool+or = any id+{-# INLINABLE or #-}++{-| @(elem a p)@ returns 'True' if @p@ has an element equal to @a@, 'False'+ otherwise+-}+elem :: (Monad m, Eq a) => a -> Producer a m () -> m Bool+elem a = any (a ==)+{-# INLINABLE elem #-}++{-| @(notElem a)@ returns 'False' if @p@ has an element equal to @a@, 'True'+ otherwise+-}+notElem :: (Monad m, Eq a) => a -> Producer a m () -> m Bool+notElem a = all (a /=)+{-# INLINABLE notElem #-}++-- | Find the first element of a 'Producer' that satisfies the predicate+find :: Monad m => (a -> Bool) -> Producer a m () -> m (Maybe a)+find predicate p = head (p >-> filter predicate)+{-# INLINABLE find #-}++{-| Find the index of the first element of a 'Producer' that satisfies the+ predicate+-}+findIndex :: Monad m => (a -> Bool) -> Producer a m () -> m (Maybe Int)+findIndex predicate p = head (p >-> findIndices predicate)+{-# INLINABLE findIndex #-}++-- | Retrieve the first element from a 'Producer'+head :: Monad m => Producer a m () -> m (Maybe a)+head p = do+ x <- next p+ return $ case x of+ Left _ -> Nothing+ Right (a, _) -> Just a+{-# INLINABLE head #-}++-- | Index into a 'Producer'+index :: Monad m => Int -> Producer a m () -> m (Maybe a)+index n p = head (p >-> drop n)+{-# INLINABLE index #-}++-- | Retrieve the last element from a 'Producer'+last :: Monad m => Producer a m () -> m (Maybe a)+last p0 = do+ x <- next p0+ case x of+ Left _ -> return Nothing+ Right (a, p') -> go a p'+ where+ go a p = do+ x <- next p+ case x of+ Left _ -> return (Just a)+ Right (a', p') -> go a' p'+{-# INLINABLE last #-}++-- | Count the number of elements in a 'Producer'+length :: Monad m => Producer a m () -> m Int+length = fold (\n _ -> n + 1) 0 id+{-# INLINABLE length #-}++-- | Find the maximum element of a 'Producer'+maximum :: (Monad m, Ord a) => Producer a m () -> m (Maybe a)+maximum = fold step Nothing id+ where+ step x a = Just $ case x of+ Nothing -> a+ Just a' -> max a a'+{-# INLINABLE maximum #-}++-- | Find the minimum element of a 'Producer'+minimum :: (Monad m, Ord a) => Producer a m () -> m (Maybe a)+minimum = fold step Nothing id+ where+ step x a = Just $ case x of+ Nothing -> a+ Just a' -> min a a'+{-# INLINABLE minimum #-}++-- | Determine if a 'Producer' is empty+null :: Monad m => Producer a m () -> m Bool+null p = do+ x <- next p+ return $ case x of+ Left _ -> True+ Right _ -> False+{-# INLINABLE null #-}++-- | Compute the sum of the elements of a 'Producer'+sum :: (Monad m, Num a) => Producer a m () -> m a+sum = fold (+) 0 id+{-# INLINABLE sum #-}++-- | Compute the product of the elements of a 'Producer'+product :: (Monad m, Num a) => Producer a m () -> m a+product = fold (*) 1 id+{-# INLINABLE product #-}++-- | Convert a pure 'Producer' into a list+toList :: Producer a Identity () -> [a]+toList prod0 = build (go prod0)+ where+ go prod cons nil =+ case prod of+ Request v _ -> closed v+ Respond a fu -> cons a (go (fu ()) cons nil)+ M m -> go (runIdentity m) cons nil+ Pure _ -> nil+{-# INLINE toList #-}++{-| Convert an effectful 'Producer' into a list++ Note: 'toListM' is not an idiomatic use of @pipes@, but I provide it for+ simple testing purposes. Idiomatic @pipes@ style consumes the elements+ immediately as they are generated instead of loading all elements into+ memory.+-}+toListM :: Monad m => Producer a m () -> m [a]+toListM = fold step begin done+ where+ step x a = x . (a:)+ begin = id+ done x = x []+{-# INLINABLE toListM #-}++{-| Convert an effectful 'Producer' into a list alongside the return value++ Note: 'toListM'' is not an idiomatic use of @pipes@, but I provide it for+ simple testing purposes. Idiomatic @pipes@ style consumes the elements+ immediately as they are generated instead of loading all elements into+ memory.+-}+toListM' :: Monad m => Producer a m r -> m ([a], r)+toListM' = fold' step begin done+ where+ step x a = x . (a:)+ begin = id+ done x = x []+{-# INLINABLE toListM' #-}++-- | Zip two 'Producer's+zip :: Monad m+ => (Producer a m r)+ -> (Producer b m r)+ -> (Proxy x' x () (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)+ -> (Proxy x' x () c m r)+zipWith f = go+ where+ go p1 p2 = do+ e1 <- lift $ next p1+ case e1 of+ Left r -> return r+ Right (a, p1') -> do+ e2 <- lift $ next p2+ case e2 of+ Left r -> return r+ Right (b, p2') -> do+ yield (f a b)+ go p1' p2'+{-# INLINABLE zipWith #-}++{-| Transform a 'Consumer' to a 'Pipe' that reforwards all values further+ downstream+-}+tee :: Monad m => Consumer a m r -> Pipe a a m r+tee p = evalStateP Nothing $ do+ r <- up >\\ (hoist lift p //> dn)+ ma <- lift get+ case ma of+ Nothing -> return ()+ Just a -> yield a+ return r+ where+ up () = do+ ma <- lift get+ case ma of+ Nothing -> return ()+ Just a -> yield a+ a <- await+ lift $ put (Just a)+ return a+ dn v = closed v+{-# INLINABLE tee #-}++{-| Transform a unidirectional 'Pipe' to a bidirectional 'Proxy'++> generalize (f >-> g) = generalize f >+> generalize g+>+> generalize cat = pull+-}+generalize :: Monad m => Pipe a b m r -> x -> Proxy x a x b m r+generalize p x0 = evalStateP x0 $ up >\\ hoist lift p //> dn+ where+ up () = do+ x <- lift get+ request x+ dn a = do+ x <- respond a+ lift $ put x+{-# INLINABLE generalize #-}++{-| The natural unfold into a 'Producer' with a step function and a seed ++> unfoldr next = id+-}+unfoldr :: Monad m + => (s -> m (Either r (a, s))) -> s -> Producer a m r+unfoldr step = go where+ go s0 = do+ e <- lift (step s0)+ case e of+ Left r -> return r+ Right (a,s) -> do + yield a+ go s+{-# INLINABLE unfoldr #-}
+ src/Pipes/Tutorial.hs view
@@ -0,0 +1,1622 @@+{-# 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\",+ + * part III \"Monads in the Real World\" of the tutorial \"All About Monads\",++ * chapter 18 of \"Real World Haskell\" on monad transformers, or:++ * the documentation of the @transformers@ library.++ If you want a Quick Start guide to @pipes@, read the documentation in+ "Pipes.Prelude" from top to bottom.++ This tutorial is more extensive and explains the @pipes@ API in greater+ detail and illustrates several idioms.+-}++module Pipes.Tutorial (+ -- * Introduction+ -- $introduction++ -- * Producers+ -- $producers++ -- * Composability+ -- $composability++ -- * Consumers+ -- $consumers++ -- * Pipes+ -- $pipes++ -- * ListT+ -- $listT++ -- * Tricks+ -- $tricks++ -- * Conclusion+ -- $conclusion++ -- * Appendix: Types+ -- $types++ -- * Appendix: Time Complexity+ -- $timecomplexity++ -- * Copyright+ -- $copyright+ ) where++import Control.Category+import Control.Monad+import Pipes+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 creates three copies+ of every value:++> -- nested.hs+>+> import Pipes+> import qualified Pipes.Prelude as P -- Pipes.Prelude already has 'stdinLn'+> +> triple :: Monad m => a -> Producer a m ()+> triple x = do+> yield x+> yield x+> yield x+>+> loop :: Producer String IO ()+> loop = for P.stdinLn triple+>+> -- This is the exact same as:+> --+> -- loop = for P.stdinLn $ \x -> do+> -- yield x+> -- yield x+> -- yield x++ This time our @loop@ is a 'Producer' that outputs 'String's, specifically+ three 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 repeated stream:++> -- nested.hs+>+> main = runEffect $ for loop (lift . putStrLn)++ This creates a program which echoes every line from standard input to+ standard output three times:++> $ ./nested+> Test<Enter>+> Test+> Test+> Test+> ABC<Enter>+> ABC+> 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 (triple 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. \'triple\'+ \-\- 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 (triple ~> 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 analogous to the Prelude's 'take', only allowing a fixed+ number of values to flow through:++> -- take.hs+>+> import Control.Monad (replicateM_)+> import Pipes+> import Prelude hiding (take)+>+> -- +--------- A 'Pipe' that+> -- | +---- 'await's 'a's and+> -- | | +-- 'yield's 'a's+> -- | | |+> -- v v v+> take :: Int -> Pipe a a IO ()+> take n = do+> replicateM_ n $ do -- Repeat this block 'n' times+> x <- await -- 'await' a value of type 'a'+> yield x -- 'yield' a value of type 'a'+> lift $ putStrLn "You shall not pass!" -- Fly, you fools!++ You can use 'Pipe's to transform 'Producer's, 'Consumer's, or even other+ 'Pipe's using the same ('>->') operator:++@+ ('>->') :: 'Monad' m => 'Producer' a m r -> 'Pipe' a b m r -> 'Producer' b m r+ ('>->') :: 'Monad' m => 'Pipe' a b m r -> 'Consumer' b m r -> 'Consumer' a m r+ ('>->') :: 'Monad' m => 'Pipe' a b m r -> 'Pipe' b c m r -> 'Pipe' a c m r+@++ For example, you can compose 'P.take' after 'P.stdinLn' to limit the number+ of lines drawn from standard input:++> maxInput :: Int -> Producer String IO ()+> maxInput n = P.stdinLn >-> take n++>>> runEffect $ maxInput 3 >-> P.stdoutLn+Test<Enter>+Test+ABC<Enter>+ABC+42<Enter>+42+You shall not pass!+>>>++ ... or you can pre-compose 'P.take' before 'P.stdoutLn' to limit the number+ of lines written to standard output:++> maxOutput :: Int -> Consumer String IO ()+> maxOutput n = take n >-> P.stdoutLn++>>> runEffect $ P.stdinLn >-> maxOutput 3+<Exact same behavior>++ Those both gave the same behavior because ('>->') is associative:++> (p1 >-> p2) >-> p3 = p1 >-> (p2 >-> p3)++ Therefore we can just leave out the parentheses:++>>> runEffect $ P.stdinLn >-> take 3 >-> P.stdoutLn+<Exact same behavior>++ ('>->') is designed to behave like the Unix pipe operator, except with less+ quirks. In fact, we can continue the analogy to Unix by defining 'cat'+ (named after the Unix @cat@ utility), which reforwards elements endlessly:++> cat :: Monad m => Pipe a a m r+> cat = forever $ do+> x <- await+> yield x++ 'cat' is the identity of ('>->'), meaning that 'cat' satisfies the+ following two laws:++> -- Useless use of 'cat'+> cat >-> p = p+>+> -- Forwarding output to 'cat' does nothing+> p >-> cat = p++ Therefore, ('>->') and 'cat' form a 'Category', specifically the category of+ Unix pipes, and 'Pipe's are also composable.++ A lot of Unix tools have very simple definitions when written using @pipes@:++> -- unix.hs+>+> import Control.Monad (forever)+> import Pipes+> import qualified Pipes.Prelude as P -- Pipes.Prelude provides 'take', too+> import Prelude hiding (head)+>+> head :: Monad m => Int -> Pipe a a m ()+> head = P.take+>+> yes :: Monad m => Producer String m r+> yes = forever $ yield "y"+>+> main = runEffect $ yes >-> head 3 >-> P.stdoutLn++ This prints out 3 \'@y@\'s, just like the equivalent Unix pipeline:++> $ ./unix+> y+> y+> y+> $ yes | head -3+> y+> y+> y+> $++ This lets us write \"Haskell pipes\" instead of Unix pipes. These are much+ easier to build than Unix pipes and we can connect them directly within+ Haskell for interoperability with the Haskell language and ecosystem.+-}++{- $listT+ @pipes@ also provides a \"ListT done right\" implementation. This differs+ from the implementation in @transformers@ because this 'ListT':++ * obeys the monad laws, and++ * streams data immediately instead of collecting all results into memory.++ The latter property is actually an elegant consequence of obeying the monad+ laws.++ To bind a list within a 'ListT' computation, combine 'Select' and 'each':++> import Pipes+> +> pair :: ListT IO (Int, Int)+> pair = do+> x <- Select $ each [1, 2]+> lift $ putStrLn $ "x = " ++ show x+> y <- Select $ each [3, 4]+> lift $ putStrLn $ "y = " ++ show y+> return (x, y)++ You can then loop over a 'ListT' by using 'every':++@+ 'every' :: 'Monad' m => 'ListT' m a -> 'Producer' a m ()+@++ So you can use your 'ListT' within a 'for' loop:++>>> runEffect $ for (every pair) (lift . print)+x = 1+y = 3+(1,3)+y = 4+(1,4)+x = 2+y = 3+(2,3)+y = 4+(2,4)++ ... or a pipeline:++>>> import qualified Pipes.Prelude as P+>>> runEffect $ every pair >-> P.print+<Exact same behavior>++ Note that 'ListT' is lazy and only produces as many elements as we request:++>>> runEffect $ for (every pair >-> P.take 2) (lift . print)+x = 1+y = 3+(1,3)+y = 4+(1,4)++ You can also go the other way, binding 'Producer's directly within a+ 'ListT'. In fact, this is actually what 'Select' was already doing:++@+ 'Select' :: 'Producer' a m () -> 'ListT' m a+@++ This lets you write crazy code like:++> import Pipes+> import qualified Pipes.Prelude as P+> +> input :: Producer String IO ()+> input = P.stdinLn >-> P.takeWhile (/= "quit")+> +> name :: ListT IO String+> name = do+> firstName <- Select input+> lastName <- Select input+> return (firstName ++ " " ++ lastName)++ Here we're binding standard input non-deterministically (twice) as if it+ were an effectful list:++>>> runEffect $ every name >-> P.stdoutLn+Daniel<Enter>+Fischer<Enter>+Daniel Fischer+Wagner<Enter>+Daniel Wagner+quit<Enter>+Donald<Enter>+Stewart<Enter>+Donald Stewart+Duck<Enter>+Donald Duck+quit<Enter>+quit<Enter>+>>>++ Notice how this streams out values immediately as they are generated, rather+ than building up a large intermediate result and then printing all the+ values in one batch at the end.++ `ListT` computations can be combined in more ways than `Pipe`s, so try to+ program in `ListT` as much as possible and defer converting it to a `Pipe`+ as late as possible using `P.loop`.++ You can combine `ListT` computations even if their inputs and outputs are+ completely different:++> data In+> = InA A+> | InB B+> | InC C+>+> data Out+> = OutD D+> | OutE E+> | OutF F+>+> -- Independent computations+>+> example1 :: A -> ListT IO D+> example2 :: B -> ListT IO E+> example3 :: C -> ListT IO F+>+> -- Combined computation+>+> total :: In -> ListT IO Out+> total input = case input of+> InA a -> fmap OutD (example1 a)+> InB b -> fmap OutE (example2 b)+> InC c -> fmap OutF (example3 c)++ Sometimes you have multiple computations that handle different inputs but+ the same output, in which case you don't need to unify their outputs:++> -- Overlapping outputs+>+> example1 :: A -> ListT IO Out+> example2 :: B -> ListT IO Out+> example3 :: C -> ListT IO Out+>+> -- Combined computation+>+> total :: In -> ListT IO Out+> total input = case input of+> InA a -> example1 a+> InB b -> example2 b+> InC c -> example3 c++ Other times you have multiple computations that handle the same input but+ produce different outputs. You can unify their outputs using the `Monoid`+ and `Functor` instances for `ListT`:++> -- Overlapping inputs+>+> example1 :: In -> ListT IO D+> example2 :: In -> ListT IO E+> example3 :: In -> ListT IO F+>+> -- Combined computation+>+> total :: In -> ListT IO Out+> total input =+> fmap OutD (example1 input)+> <> fmap OutE (example2 input)+> <> fmap OutF (example3 input)++ You can also chain `ListT` computations, feeding the output of the first+ computation as the input to the next computation:++> -- End-to-end+>+> aToB :: A -> ListT IO B+> bToC :: B -> ListT IO C+>+> -- Combined computation+>+> aToC :: A -> LIstT IO C+> aToC = aToB >=> bToC++ ... or you can just use @do@ notation if you prefer.++ However, the `Pipe` type is more general than `ListT` and can represent+ things like termination. Therefore you should consider mixing `Pipe`s with+ `ListT` when you need to take advantage of these extra features:++> -- Mix ListT with Pipes+>+> example :: In -> ListT IO Out+>+> pipe :: Pipe In Out IO ()+> pipe = Pipes.takeWhile (not . isC) >-> loop example+> where+> isC (InC _) = True+> isC _ = False++ So promote your `ListT` logic to a `Pipe` when you need to take advantage of+ these `Pipe`-specific features.+-}++{- $tricks+ @pipes@ is more powerful than meets the eye so this section presents some+ non-obvious tricks you may find useful.++ Many pipe combinators will work on unusual pipe types and the next few+ examples will use the 'cat' pipe to demonstrate this.++ For example, you can loop over the output of a 'Pipe' using 'for', which is+ how 'P.map' is defined:++> map :: Monad m => (a -> b) -> Pipe a b m r+> map f = for cat $ \x -> yield (f x)+>+> -- Read this as: For all values flowing downstream, apply 'f'++ This is equivalent to:++> map f = forever $ do+> x <- await+> yield (f x)++ You can also feed a 'Pipe' input using ('>~'). This means we could have+ instead defined the @yes@ pipe like this:++> yes :: Monad m => Producer String m r+> yes = return "y" >~ cat+>+> -- Read this as: Keep feeding "y" downstream++ This is equivalent to:++> yes = forever $ yield "y"++ You can also sequence two 'Pipe's together. This is how 'P.drop' is+ defined:++> drop :: Monad m => Int -> Pipe a a m r+> drop n = do+> replicateM_ n await+> cat++ This is equivalent to:++> drop n = do+> replicateM_ n await+> forever $ do+> x <- await+> yield x++ You can even compose pipes inside of another pipe:++> customerService :: Producer String IO ()+> customerService = do+> each [ "Hello, how can I help you?" -- Begin with a script+> , "Hold for one second."+> ]+> P.stdinLn >-> P.takeWhile (/= "Goodbye!") -- Now continue with a human++ Also, you can often use 'each' in conjunction with ('~>') to traverse nested+ data structures. For example, you can print all non-'Nothing' elements+ from a doubly-nested list:++>>> runEffect $ (each ~> each ~> each ~> lift . print) [[Just 1, Nothing], [Just 2, Just 3]]+1+2+3++ Another neat thing to know is that 'every' has a more general type:++@+ 'every' :: ('Monad' m, 'Enumerable' t) => t m a -> 'Producer' a m ()+@++ 'Enumerable' generalizes 'Foldable' and if you have an effectful container+ of your own that you want others to traverse using @pipes@, just have your+ container implement the 'toListT' method of the 'Enumerable' class:++> class Enumerable t where+> toListT :: Monad m => t m a -> ListT m a++ You can even use 'Enumerable' to traverse effectful types that are not even+ proper containers, like 'Control.Monad.Trans.Maybe.MaybeT':++> input :: MaybeT IO String+> input = do+> str <- lift getLine+> guard (str /= "Fail")+> return str++>>> runEffect $ every input >-> P.stdoutLn+Test<Enter>+Test+>>> runEffect $ every input >-> P.stdoutLn+Fail<Enter>+>>>++-}++{- $conclusion+ This tutorial covers the concepts of connecting, building, and reading+ @pipes@ code. However, this library is only the core component in an+ ecosystem of streaming components. Derived libraries that build immediately+ upon @pipes@ include:++ * @pipes-concurrency@: Concurrent reactive programming and message passing++ * @pipes-parse@: Minimal utilities for stream parsing++ * @pipes-safe@: Resource management and exception safety for @pipes@++ * @pipes-group@: Grouping streams in constant space++ These libraries provide functionality specialized to common streaming+ domains. Additionally, there are several libraries on Hackage that provide+ even higher-level functionality, which you can find by searching under the+ \"Pipes\" category or by looking for packages with a @pipes-@ prefix in+ their name. Current examples include:++ * @pipes-extras@: Miscellaneous utilities++ * @pipes-network@/@pipes-network-tls@: Networking++ * @pipes-zlib@: Compression and decompression++ * @pipes-binary@: Binary serialization++ * @pipes-attoparsec@: High-performance parsing++ * @pipes-aeson@: JSON serialization and deserialization++ Even these derived packages still do not explore the full potential of+ @pipes@ functionality, which actually permits bidirectional communication.+ Advanced @pipes@ users can explore this library in greater detail by+ studying the documentation in the "Pipes.Core" module to learn about the+ symmetry of the underlying 'Proxy' type and operators.++ To learn more about @pipes@, ask questions, or follow @pipes@ development,+ you can subscribe to the @haskell-pipes@ mailing list at:++ <https://groups.google.com/forum/#!forum/haskell-pipes>++ ... or you can mail the list directly at:++ <mailto:haskell-pipes@googlegroups.com>++ Additionally, for questions regarding types or type errors, you might find+ the following appendix on types very useful.+-}++{- $types+ @pipes@ uses parametric polymorphism (i.e. generics) to overload all+ operations. You've probably noticed this overloading already:++ * 'yield' works within both 'Producer's and 'Pipe's++ * 'await' works within both 'Consumer's and 'Pipe's++ * ('>->') connects 'Producer's, 'Consumer's, and 'Pipe's in varying ways++ This overloading is great when it works, but when connections fail they+ produce type errors that appear intimidating at first. This section+ explains the underlying types so that you can work through type errors+ intelligently.++ 'Producer's, 'Consumer's, 'Pipe's, and 'Effect's are all special cases of a+ single underlying type: a 'Proxy'. This overarching type permits fully+ bidirectional communication on both an upstream and downstream interface.+ You can think of it as having the following shape:++> Proxy a' a b' b m r+>+> Upstream | Downstream+> +---------++> | |+> a' <== <== b' -- Information flowing upstream+> | |+> a ==> ==> b -- Information flowing downstream+> | | |+> +----|----++> v+> r++ The four core types do not use the upstream flow of information. This means+ that the @a'@ and @b'@ in the above diagram go unused unless you use the+ more advanced features provided in "Pipes.Core".++ @pipes@ uses type synonyms to hide unused inputs or outputs and clean up+ type signatures. These type synonyms come in two flavors:++ * Concrete type synonyms that explicitly close unused inputs and outputs of+ the 'Proxy' type++ * Polymorphic type synonyms that don't explicitly close unused inputs or+ outputs++ The concrete type synonyms use @()@ to close unused inputs and 'X' (the+ uninhabited type) to close unused outputs:++ * 'Effect': explicitly closes both ends, forbidding 'await's and 'yield's++> type Effect = Proxy X () () X+>+> Upstream | Downstream+> +---------++> | |+> X <== <== ()+> | |+> () ==> ==> X+> | | |+> +----|----++> v+> r++ * 'Producer': explicitly closes the upstream end, forbidding 'await's++> type Producer b = Proxy X () () b+>+> Upstream | Downstream+> +---------++> | |+> X <== <== ()+> | |+> () ==> ==> b+> | | |+> +----|----++> v+> r++ * 'Consumer': explicitly closes the downstream end, forbidding 'yield's++> type Consumer a = Proxy () a () X+>+> Upstream | Downstream+> +---------++> | |+> () <== <== ()+> | |+> a ==> ==> X+> | | |+> +----|----++> v+> r++ * 'Pipe': marks both ends open, allowing both 'await's and 'yield's++> type Pipe a b = Proxy () a () b+>+> Upstream | Downstream+> +---------++> | |+> () <== <== ()+> | |+> a ==> ==> b+> | | |+> +----|----++> v+> r++ When you compose 'Proxy's using ('>->') all you are doing is placing them+ side by side and fusing them laterally. For example, when you compose a+ 'Producer', 'Pipe', and a 'Consumer', you can think of information flowing+ like this:++> Producer Pipe Consumer+> +-----------+ +----------+ +------------++> | | | | | |+> X <== <== () <== <== () <== <== ()+> | stdinLn | | take 3 | | stdoutLn |+> () ==> ==> String ==> ==> String ==> ==> X+> | | | | | | | | |+> +-----|-----+ +----|-----+ +------|-----++> v v v+> () () ()++ Composition fuses away the intermediate interfaces, leaving behind an+ 'Effect':++> Effect+> +-----------------------------------++> | |+> X <== <== ()+> | stdinLn >-> take 3 >-> stdoutLn |+> () ==> ==> X+> | |+> +----------------|------------------++> v+> ()++ @pipes@ also provides polymorphic type synonyms with apostrophes at the end+ of their names. These use universal quantification to leave open any unused+ input or output ends (which I mark using @*@):++ * 'Producer'': marks the upstream end unused but still open++> type Producer' b m r = forall x' x . Proxy x' x () b m r+>+> Upstream | Downstream+> +---------++> | |+> * <== <== ()+> | |+> * ==> ==> b+> | | |+> +----|----++> v+> r++ * 'Consumer'': marks the downstream end unused but still open++> type Consumer' a m r = forall y' y . Proxy () a y' y m r+>+> Upstream | Downstream+> +---------++> | |+> () <== <== * +> | |+> a ==> ==> *+> | | |+> +----|----++> v+> r++ * 'Effect'': marks both ends unused but still open++> type Effect' m r = forall x' x y' y . Proxy x' x y' y m r+>+> Upstream | Downstream+> +---------++> | |+> * <== <== * +> | |+> * ==> ==> *+> | | |+> +----|----++> v+> r++ Note that there is no polymorphic generalization of a 'Pipe'.++ Like before, if you compose a 'Producer'', a 'Pipe', and a 'Consumer'':++> Producer' Pipe Consumer'+> +-----------+ +----------+ +------------++> | | | | | |+> * <== <== () <== <== () <== <== *+> | stdinLn | | take 3 | | stdoutLn |+> * ==> ==> String ==> ==> String ==> ==> *+> | | | | | | | | |+> +-----|-----+ +-----|----+ +------|-----++> v v v+> () () ()++ ... they fuse into an 'Effect'':++> Effect'+> +-----------------------------------++> | |+> * <== <== *+> | stdinLn >-> take 3 >-> stdoutLn |+> * ==> ==> *+> | |+> +----------------|------------------++> v+> ()++ Polymorphic type synonyms come in handy when you want to keep the type as+ general as possible. For example, the type signature for 'yield' uses+ 'Producer'' to keep the type signature simple while still leaving the+ upstream input end open:++@+ 'yield' :: 'Monad' m => a -> 'Producer'' a m ()+@++ This type signature lets us use 'yield' within a 'Pipe', too, because the+ 'Pipe' type synonym is a special case of the polymorphic 'Producer'' type + synonym:++@+ type 'Producer'' b m r = forall x' x . 'Proxy' x' x () b m r+ type 'Pipe' a b m r = 'Proxy' () a () b m r+@++ The same is true for 'await', which uses the polymorphic 'Consumer'' type+ synonym:++@+ 'await' :: 'Monad' m => 'Consumer'' a m a+@++ We can use 'await' within a 'Pipe' because a 'Pipe' is a special case of the+ polymorphic 'Consumer'' type synonym:++@+ type 'Consumer'' a m r = forall y' y . 'Proxy' () a y' y m r+ type 'Pipe' a b m r = 'Proxy' () a () b m r+@++ However, polymorphic type synonyms cause problems in many other cases:++ * They usually give the wrong behavior when used as the argument of a+ function (known as the \"negative\" or \"contravariant\" position) like+ this:++> f :: Producer' a m r -> ... -- Wrong+>+> f :: Producer a m r -> ... -- Right++ The former function only accepts polymorphic 'Producer's as arguments.+ The latter function accepts both polymorphic and concrete 'Producer's,+ which is probably what you want.++ * Even when you desire a polymorphic argument, this induces a higher-ranked+ type, because it translates to a @forall@ which you cannot factor out to+ the top-level to simplify the type signature:++> f :: (forall x' x y' . Proxy x' x y' m r) -> ...++ These kinds of type signatures require the @RankNTypes@ extension.++ * Even when you have polymorphic type synonyms as the result of a function+ (i.e. the \"positive\" or \"covariant\" position), recent versions of+ @ghc@ such still require the @RankNTypes@ extension. For example, the+ 'Pipes.Prelude.fromHandle' function from "Pipes.Prelude" requires+ @RankNTypes@ to compile correctly on @ghc-7.6.3@:++> fromHandle :: MonadIO m => Handle -> Producer' String m ()++ * You can't use polymorphic type synonyms inside other type constructors+ without the @ImpredicativeTypes@ extension:++> io :: IO (Producer' a m r) -- Type error without ImpredicativeTypes++ * You can't partially apply polymorphic type synonyms:++> stack :: MaybeT (Producer' a m) r -- Type error++ In these scenarios you should fall back on the concrete type synonyms, which+ are better behaved. If concrete type synonyms are unsatisfactory, then ask+ @ghc@ to infer the most general type signature and use that.++ For the purposes of debugging type errors you can just remember that:++> Input --+ +-- Output+> | |+> v v+> Proxy a' a b' b m r+> ^ ^+> | |+> +----+-- Ignore these++ For example, let's say that you try to run the 'P.stdinLn' 'Producer'. This+ produces the following type error:++>>> runEffect P.stdinLn+<interactive>:4:5:+ Couldn't match expected type `X' with actual type `String'+ Expected type: Effect m0 r0+ Actual type: Proxy X () () String IO ()+ In the first argument of `runEffect', namely `P.stdinLn'+ In the expression: runEffect P.stdinLn++ 'runEffect' expects an 'Effect', which is equivalent to the following type:++> Effect IO () = Proxy X () () X IO ()++ ... but 'P.stdinLn' type-checks as a 'Producer', which has the following+ type:++> Producer String IO () = Proxy X () () String IO ()++ The fourth type variable (the output) does not match. For an 'Effect' this+ type variable should be closed (i.e. 'X'), but 'P.stdinLn' has a 'String'+ output, thus the type error:++> Couldn't match expected type `X' with actual type `String'++ Any time you get type errors like these you can work through them by+ expanding out the type synonyms and seeing which type variables do not+ match.++ You may also consult this table of type synonyms to more easily compare+ them:++> type Effect = Proxy X () () X+> type Producer b = Proxy X () () b+> type Consumer a = Proxy () a () X+> type Pipe a b = Proxy () a () b+>+> type Server b' b = Proxy X () b' b +> type Client a' a = Proxy a' a () X+>+> type Effect' m r = forall x' x y' y . Proxy x' x y' y m r+> type Producer' b m r = forall x' x . Proxy x' x () b m r+> type Consumer' a m r = forall y' y . Proxy () a y' y m r+>+> type Server' b' b m r = forall x' x . Proxy x' x b' b m r+> type Client' a' a m r = forall y' y . Proxy a' a y' y m r++-}++{- $timecomplexity+ There are three functions that give quadratic time complexity when used in+ within @pipes@:++ * 'sequence'++ * 'replicateM'++ * 'mapM'++ For example, the time complexity of this code segment scales quadratically+ with `n`:++> import Control.Monad (replicateM)+> import Pipes+>+> quadratic :: Int -> Consumer a m [a]+> quadratic n = replicateM n await++ These three functions are generally bad practice to use, because all three+ of them correspond to \"ListT done wrong\", building a list in memory+ instead of streaming results.++ However, sometimes situations arise where one deliberately intends to build+ a list in memory. The solution is to use the \"codensity transformation\"+ to transform the code to run with linear time complexity. This involves:++ * wrapping the code in the @Codensity@ monad transformer (from+ @Control.Monad.Codensity@ module of the @kan-extensions@ package) using+ 'lift'++ * applying 'sequence' \/ 'replicateM' \/ 'mapM'++ * unwrapping the code using @lowerCodensity@++ To illustrate this, we'd transform the above example to:++> import Control.Monad.Codensity (lowerCodensity)+> +> linear :: Monad m => Int -> Consumer a m [a]+> linear n = lowerCodensity $ replicateM n $ lift await++ This will produce the exact same result, but in linear time.+-}++{- $copyright+ This tutorial is licensed under a+ <http://creativecommons.org/licenses/by/4.0/ Creative Commons Attribution 4.0 International License>+-}
+ tests/Main.hs view
@@ -0,0 +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