pipes 3.3.0 → 4.0.0
raw patch · 27 files changed
+4090/−6443 lines, 27 filesdep +criteriondep +deepseqdep +mtldep ~base
Dependencies added: criterion, deepseq, mtl, pipes, void
Dependency ranges changed: base
Files
- Control/Pipe.hs +0/−201
- Control/Proxy.hs +0/−36
- Control/Proxy/Class.hs +0/−756
- Control/Proxy/Core.hs +0/−44
- Control/Proxy/Core/Correct.hs +0/−196
- Control/Proxy/Core/Fast.hs +0/−282
- Control/Proxy/Morph.hs +0/−123
- Control/Proxy/Pipe.hs +0/−214
- Control/Proxy/Prelude.hs +0/−1076
- Control/Proxy/Trans.hs +0/−31
- Control/Proxy/Trans/Codensity.hs +0/−160
- Control/Proxy/Trans/Either.hs +0/−224
- Control/Proxy/Trans/Identity.hs +0/−114
- Control/Proxy/Trans/Maybe.hs +0/−154
- Control/Proxy/Trans/Reader.hs +0/−135
- Control/Proxy/Trans/State.hs +0/−196
- Control/Proxy/Trans/Writer.hs +0/−195
- Control/Proxy/Tutorial.hs +0/−2270
- benchmarks/LiftBench.hs +100/−0
- benchmarks/PreludeBench.hs +85/−0
- pipes.cabal +54/−36
- src/Pipes.hs +424/−0
- src/Pipes/Core.hs +834/−0
- src/Pipes/Internal.hs +237/−0
- src/Pipes/Lift.hs +305/−0
- src/Pipes/Prelude.hs +629/−0
- src/Pipes/Tutorial.hs +1422/−0
− Control/Pipe.hs
@@ -1,201 +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- {-# DEPRECATED "Use 'Control.Proxy' instead of '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.Monad.Trans.Class (MonadTrans(lift))-import Control.Proxy.Class (C)-import Prelude hiding ((.), id)---- For documentation-import Control.Category (Category((.), 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:--> data 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 7 <+<-infixl 7 >+>---- | 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,36 +0,0 @@-{-| Recommended entry import for this library-- Read "Control.Proxy.Tutorial" for an extended 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 requires implementation hiding to enforce the monad- transformer laws.-- * "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,756 +0,0 @@--- | This module defines the theoretical framework underpinning this library--{-# LANGUAGE Rank2Types, KindSignatures #-}--module Control.Proxy.Class (- -- * The Proxy Class- Proxy(..),-- -- * Composition operators- (>->),- (>~>),- (\>\),- (/>/),-- -- ** Flipped operators- (<-<),- (<~<),- (/</),- (\<\),- (<<-),- (~<<),- (//<),- (<\\),-- -- * ListT Monad Transformers- -- $listT- RespondT(..),- RequestT(..),-- -- * Synonyms- C,- Pipe,- Producer,- Consumer,- CoPipe,- CoProducer,- CoConsumer,- Client,- Server,- Session,- ProduceT,- CoProduceT,-- -- * Laws- -- $laws-- -- * Polymorphic proxies- -- $poly- ProxyInternal(..),- MonadPlusP(..),-- -- * Deprecated- -- $deprecate- idT,- coidT,- ListT,- runRespondK,- runRequestK- ) 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 Data.Monoid (Monoid(mempty, mappend))--{- * 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.--}-infixr 5 <-<, ->>-infixl 5 >->, <<--infixr 6 >~>, ~<<-infixl 6 <~<, >>~-infixl 7 \<\, //>-infixr 7 />/, <\\-infixr 8 /</, >\\-infixl 8 \>\, //<-infixl 1 ?>= -- This should match the fixity of >>=--{-| The 'Proxy' class defines a 'Monad' that intersects four streaming- categories:-- * The \"request\" category: 'request' and ('\>\')-- * The \"respond\" category: 'respond' and ('/>/')-- * The \"pull\" category: 'pull' and ('>->')-- * The \"push\" category: 'push' and ('>~>')-- This class requires the \"point-ful\" version of each category's composition- operator for efficiency.-- Minimal definition:-- * 'request'-- * 'respond'-- * ('->>')-- * ('>>~')-- * ('>\\')-- * ('//>')-- * 'turn'--}-class (ProxyInternal p) => Proxy p where- {-| 'request' sends a value of type @a'@ upstream and receives a value of- type @a@.- -}- request :: (Monad m) => a' -> p a' a b' b m a-- -- | @(f >\\\\ p)@ replaces each 'request' in @p@ with @f@.- (>\\)- :: (Monad m)- => (b' -> p a' a x' x m b)- -> p b' b x' x m c- -> p a' a x' x m c-- {-| 'respond' sends a value of type @b@ downstream and receives a value of- type @b'@.- -}- respond :: (Monad m) => b -> p a' a b' b m b'-- -- | @(p \/\/> f)@ replaces each 'respond' in @p@ with @f@.- (//>)- :: (Monad m)- => p x' x b' b m a'- -> (b -> p x' x c' c m b')- -> p x' x c' c m a'-- -- | @pull = request >=> respond >=> pull@- pull :: (Monad m, Proxy p) => a' -> p a' a a' a m r- pull = go where- go a' =- request a' ?>= \a ->- respond a ?>= \a'2 ->- go a'2- {- DO NOT replace 'go' with 'push' or ghc-7.4.2 will not terminate while- compiling `pipes` -}-- -- | @(f ->> p)@ pairs each 'request' in @p@ with a 'respond' in @f@.- (->>)- :: (Monad m)- => (b' -> p a' a b' b m r)- -> p b' b c' c m r- -> p a' a c' c m r-- -- | @push = respond >=> request >=> push@- push :: (Monad m, Proxy p) => a -> p a' a a' a m r- push = go where- go a =- respond a ?>= \a' ->- request a' ?>= \a2 ->- go a2- {- DO NOT replace 'go' with 'push' or ghc-7.4.2 will not terminate while- compiling `pipes` -}-- -- | @(p >>~ f)@ pairs each 'respond' in @p@ with a 'request' in @f@.- (>>~)- :: (Monad m)- => p a' a b' b m r- -> (b -> p b' b c' c m r)- -> p a' a c' c m r-- -- | 'turn' swaps 'request's and 'respond's- turn :: (Monad m) => p a' a b' b m r -> p b b' a a' m r--{-| \"pull\" composition--> (f >-> g) x = f ->> g x-- Compose two proxies blocked on a 'respond', generating a new proxy 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)-f >-> g = \c' -> f ->> g c'-{-# INLINABLE (>->) #-}--{-| \"push\" composition--> (f >~> g) x = f x >>~ g-- Compose two proxies blocked on a 'request', generating 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)-k1 >~> k2 = \a -> k1 a >>~ k2-{-# INLINABLE (>~>) #-}--{-| \"request\" composition--> (f \>\ g) x = f >\\ g x-- Compose two folds, generating a new fold--}-(\>\)- :: (Monad m, Proxy p)- => (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 = \c' -> f >\\ g c'-{-# INLINABLE (\>\) #-}--{-| \"respond\" composition--> (f />/ g) x = f x //> g-- Compose two unfolds, generating a new unfold--}-(/>/)- :: (Monad m, Proxy p)- => (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 = \a -> f a //> g-{-# INLINABLE (/>/) #-}---- | Equivalent to ('>->') with the arguments flipped-(<-<)- :: (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-{-# INLINABLE (<-<) #-}---- | Equivalent to ('>~>') with the arguments flipped-(<~<)- :: (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-{-# INLINABLE (<~<) #-}---- | Equivalent to ('\>\') with the arguments flipped-(/</)- :: (Monad m, Proxy 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-{-# INLINABLE (/</) #-}---- | Equivalent to ('/>/') with the arguments flipped-(\<\)- :: (Monad m, Proxy 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-{-# INLINABLE (\<\) #-}---- | Equivalent to ('->>') with the arguments flipped-(<<-)- :: (Monad m, Proxy p)- => p b' b c' c m r- -> (b' -> p a' a b' b m r)- -> p a' a c' c m r-k <<- p = p ->> k-{-# INLINABLE (<<-) #-}---- | Equivalent to ('>>~') with the arguments flipped-(~<<)- :: (Monad m, Proxy p)- => (b -> p b' b c' c m r)- -> p a' a b' b m r- -> p a' a c' c m r-k ~<< p = p >>~ k-{-# INLINABLE (~<<) #-}---- | Equivalent to ('>\\') with the arguments flipped-(//<)- :: (Monad m, Proxy p)- => p b' b x' x m c- -> (b' -> p a' a x' x m b)- -> p a' a x' x m c-p //< f = f >\\ p-{-# INLINABLE (//<) #-}---- | Equivalent to ('//>') with the arguments flipped-(<\\)- :: (Monad m, Proxy p)- => (b -> p x' x c' c m b')- -> p x' x b' b m a'- -> p x' x c' c m a'-f <\\ p = p //> f-{-# INLINABLE (<\\) #-}---- | A monad transformer over a proxy's downstream output-newtype RespondT (p :: * -> * -> * -> * -> (* -> *) -> * -> *) a' a b' m b =- RespondT { runRespondT :: p a' a b' b m b' }--instance (Monad m, Proxy p) => Functor (RespondT p a' a b' m) where- fmap f p = RespondT (runRespondT p //> \a -> respond (f a))--instance (Monad m, Proxy p) => Applicative (RespondT p a' a b' m) where- pure a = RespondT (respond a)- mf <*> mx = RespondT (- runRespondT mf //> \f ->- runRespondT mx //> \x ->- respond (f x) )--instance (Monad m, Proxy p) => Monad (RespondT p a' a b' m) where- return a = RespondT (respond a)- m >>= f = RespondT (runRespondT m //> \a -> runRespondT (f a))--instance (Proxy p) => MonadTrans (RespondT p a' a b') where- lift m = RespondT (lift_P m ?>= \a -> respond a)--instance (MonadIO m, Proxy p) => MonadIO (RespondT p a' a b' m) where- liftIO m = lift (liftIO m)--instance (Monad m, Proxy p, Monoid b')- => Alternative (RespondT p a' a b' m) where- empty = RespondT (return_P mempty)- p1 <|> p2 = RespondT (- runRespondT p1 ?>= \r1 ->- runRespondT p2 ?>= \r2 ->- return_P (mappend r1 r2) )--instance (Monad m, Proxy p, Monoid b') => MonadPlus (RespondT p a' a b' m) where- mzero = empty- mplus = (<|>)--{- $listT- The 'RespondT' monad transformer is equivalent to 'ListT' over the- downstream output. The 'RespondT' Kleisli category corresponds to the- \"respond\" category.-- The 'RequestT' monad transformer is equivalent to 'ListT' over the upstream- output. The 'RequestT' Kleisli category corresponds to the \"request\"- category.-- Unlike 'ListT' from @transformers@, these monad transformers are correct by- construction and always satisfy the monad and monad transformer laws.--}----- | A monad transformer over a proxy's upstream output-newtype RequestT (p :: * -> * -> * -> * -> (* -> *) -> * -> *) a b' b m a' =- RequestT { runRequestT :: p a' a b' b m a }--instance (Monad m, Proxy p) => Functor (RequestT p a b' b m) where- fmap f p = RequestT (runRequestT p //< \a -> request (f a))--instance (Monad m, Proxy p) => Applicative (RequestT p a b' b m) where- pure a = RequestT (request a)- mf <*> mx = RequestT (- runRequestT mf //< \f ->- runRequestT mx //< \x ->- request (f x) )--instance (Monad m, Proxy p) => Monad (RequestT p a b' b m) where- return a = RequestT (request a)- m >>= f = RequestT (runRequestT m //< \a -> runRequestT (f a))--instance (Proxy p) => MonadTrans (RequestT p a' a b') where- lift m = RequestT (lift_P m ?>= \a -> request a)--instance (MonadIO m, Proxy p) => MonadIO (RequestT p a b' b m) where- liftIO m = lift (liftIO m)--instance (Monad m, Proxy p, Monoid a)- => Alternative (RequestT p a b' b m) where- empty = RequestT (return_P mempty)- p1 <|> p2 = RequestT (- runRequestT p1 ?>= \r1 ->- runRequestT p2 ?>= \r2 ->- return_P (mappend r1 r2) )--instance (Monad m, Proxy p, Monoid a) => MonadPlus (RequestT p a b' b m) where- mzero = empty- mplus = (<|>)---- | The empty type, denoting a \'@C@\'losed end-data C = C -- Constructor not exported, but I include it to avoid EmptyDataDecls---- | 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 'runProxy'-- 'Session's never 'request' or 'respond'.--}-type Session (p :: * -> * -> * -> * -> (* -> *) -> * -> *) = p C () () C---- | 'ProduceT' is 'ListT' over the downstream output-type ProduceT p = RespondT p C () ()---- | 'CoProduceT' is 'ListT' over the upstream output-type CoProduceT p = RequestT p () () C--{- $laws- First, all proxies sit at the intersection of five categories:-- * The Kleisli category (all proxies are monads)--> return >=> f = f->-> f >=> return = f->-> (f >=> g) >=> h = f >=> (g >=> h)-- * The \"request\" category--> request \>\ f = f->-> f \>\ request = f->-> (f \>\ g) \>\ h = f \>\ (g \>\ h)-- * The \"respond\" category--> respond />/ f = f->-> f />/ respond = f->-> (f />/ g) />/ h = f />/ (g />/ h)-- * The \"pull\" category--> pull >-> f = f->-> f >-> pull = f->-> (f >-> g) >-> h = (f >-> g) >-> h-- * The \"push\" category--> push >~> f = f->-> f >~> push = f->-> (f >~> g) >~> h = f >~> (g >~> h)-- Second, @(turn .)@ transforms each streaming category into its dual:-- * The \"request\" category--> turn . request = respond->-> turn . (f \>\ g) = turn . f \<\ turn . g-- * The \"respond\" category--> turn . respond = request->-> turn . (f />/ g) = turn . f /</ turn. g-- * The \"pull\" category--> turn . pull = push->-> turn . (f >-> g) = turn . f <~< turn . g-- * The \"push\" category--> turn . push = pull->-> turn . (f >~> g) = turn . f <-< turn . g-- Third, all proxies are monad transformers and must satisfy the monad- transformer laws, using:-- * @lift = lift_P@-- Fourth, all proxies are functors in the category of monads and must satisfy- the functor laws, using:-- * @hoist = hoist_P@-- Fifth, ('\>\') and ('/>/') both define functors between Kleisli categories--> a \>\ (b >=> c) = (a \>\ b) >=> (a \>\ c)->-> a \>\ return = return--> (b >=> c) />/ a = (b />/ a) >=> (c />/ a)->-> return />/ a = return-- Sixth, all proxies must satisfy these additional 'Proxy' laws:--> p \>\ lift . f = lift . f->-> p \>\ respond = respond->-> lift . f />/ p = lift . f->-> request />/ p = request->-> pull = request >=> respond >=> pull->-> push = respond >=> request >=> push->-> p1 >-> lift . f = lift . f->-> p1 >-> (lift . f >=> respond >=> p2) = lift . f >=> respond >=> (p1 >-> p2)->-> (lift . g >=> respond >=> p1) >-> (lift . f >=> request >=> lift . h >=> p2)-> = lift . (f >=> g >=> h) >=> (p1 >-> p2)->-> (lift . g >=> request >=> p1) >-> (lift . f >=> request >=> p2)-> = lift . (f >=> g) >=> request >=> (p1 >~> p2)->-> lift . f >~> p2 = lift . f->-> (lift . f >=> request >=> p1) >~> p2 = lift . f >=> request >=> (p1 >~> p2)->-> (lift . f >=> respond >=> lift . h >=> p1) >~> (lift . g >=> request >=> p2)-> = lift . (f >=> g >=> h) >=> (p1 >~> p2)->-> (lift . f >=> respond >=> p1) >~> (lift . g >=> respond >=> p2)-> = lift . (f >=> g) >=> (p1 >-> p2)---}--{- $poly- The 'ProxyInternal' and 'MonadPlusP' type classes duplicate 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 (Proxy 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) => ...-- 'ProxyInternal' and 'MonadPlusP' exist solely for internal type class- plumbing and I discourage you from using the methods in these classes- unless you enjoy making your code less readable. 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 @(ProxyInternal p)@ constraint is (basically) equivalent to the- following polymorphic constraint:--> (forall a' a b' b m . (Monad m)-> => Monad (p a' a b' b m)-> , MonadTrans (p a' a b' b )-> , MFunctor (p a' a b' b m)-> , MonadIO (p a' a b' b m)-> ) => ...--}-class ProxyInternal p where- return_P :: (Monad m) => r -> p a' a b' b m r- (?>=)- :: (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 :: (Monad m) => m r -> p a' a b' b m r-- hoist_P- :: (Monad m)- => (forall r . m r -> n r) -> (p a' a b' b m r' -> p a' a b' b n r')-- liftIO_P :: (MonadIO m) => IO r -> p a' a b' b m r-- thread_P- :: (Monad m)- => p a' a b' b m r -> s -> p (a', s) (a, s) (b', s) (b, s) m (r, s)--{-| The @(MonadPlusP p)@ constraint is equivalent to the following polymorphic- 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--{- $deprecate- These will be removed in version @4.0.0@--}--idT :: (Monad m, Proxy p) => a' -> p a' a a' a m r-idT = pull-{-# INLINABLE idT #-}-{-# DEPRECATED idT "Use 'pull' instead" #-}--coidT :: (Monad m, Proxy p) => a -> p a' a a' a m r-coidT = push-{-# INLINABLE coidT #-}-{-# DEPRECATED coidT "Use 'push' instead" #-}--class (Proxy p) => ListT p where-{-# DEPRECATED ListT "Use 'Proxy' instead" #-}--runRespondK :: (q -> RespondT p a' a b' m b) -> (q -> p a' a b' b m b')-runRespondK k q = runRespondT (k q)-{-# INLINABLE runRespondK #-}-{-# DEPRECATED runRespondK "Use '(runRespondT .)' instead" #-}--runRequestK :: (q -> RequestT p a b' b m a') -> (q -> p a' a b' b m a)-runRequestK k q = runRequestT (k q)-{-# INLINABLE runRequestK #-}-{-# DEPRECATED runRequestK "Use '(runRequestK .)' instead" #-}
− Control/Proxy/Core.hs
@@ -1,44 +0,0 @@--- | Default imports for the "Control.Proxy" hierarchy--module Control.Proxy.Core (- -- * Modules- -- $modules- module Control.Proxy.Class,- module Control.Proxy.Prelude,- module Control.Proxy.Trans,- module Control.Proxy.Trans.Identity,- module Control.Proxy.Morph,- module Control.Monad,- module Control.Monad.Trans.Class,- module Control.Monad.Morph,- ) where--import Control.Monad (forever, (>=>), (<=<))-import Control.Monad.Morph (MFunctor(hoist), MMonad(embed))-import Control.Monad.Trans.Class (MonadTrans(lift))-import Control.Proxy.Class-import Control.Proxy.Morph-import Control.Proxy.Prelude-import Control.Proxy.Trans-import Control.Proxy.Trans.Identity--{- $modules- "Control.Proxy.Class" defines the 'Proxy' type class that lets you program- generically over proxy implementations and their transformers.-- "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.Proxy.Morph" exports 'hoistP'.-- "Control.Monad" exports 'forever', ('>=>'), and ('<=<').-- "Control.Monad.Trans.Class" exports 'lift'.-- "Control.Monad.Morph" exports 'hoist'.--}
− Control/Proxy/Core/Correct.hs
@@ -1,196 +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(..),- ProxyStep(..),-- -- * Run Sessions - -- $run- runProxy,- runProxyK- ) where--import Control.Applicative (Applicative(pure, (<*>)))-import Control.Monad.IO.Class (MonadIO(liftIO))-import Control.Monad.Morph (MFunctor(hoist))-import Control.Monad.Trans.Class (MonadTrans(lift))-import Control.Proxy.Class (- Proxy(request, respond, (->>), (>>~), (>\\), (//>), turn),- ProxyInternal(return_P, (?>=), lift_P, liftIO_P, hoist_P, thread_P) )--{-| A 'ProxyCorrect' communicates with an upstream interface and a downstream- interface.-- The type variables signify:-- * @a'@ - The request supplied to the upstream interface-- * @a @ - The response provided by the upstream interface-- * @b'@ - The request supplied by the downstream interface-- * @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 (ProxyStep a' a b' b m r) }---- | The pure component of 'ProxyCorrect'-data ProxyStep a' a b' b m r- = Request a' (a -> ProxyCorrect a' a b' b m r)- | Respond b (b' -> ProxyCorrect a' a b' b m r)- | Pure r--instance (Monad m) => Functor (ProxyCorrect a' a b' b m) where- fmap f = go 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 m = Proxy (m >>= \r -> return (Pure r))--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 )))--instance (MonadIO m) => MonadIO (ProxyCorrect a' a b' b m) where- liftIO m = Proxy (liftIO (m >>= \r -> return (Pure r)))--instance ProxyInternal ProxyCorrect where- return_P = return- (?>=) = (>>=)-- lift_P = lift-- hoist_P = hoist-- liftIO_P = liftIO-- thread_P p s = Proxy (do- x <- unProxy p- return (case x of- Request a' fa ->- Request (a', s) (\(a , s') -> thread_P (fa a ) s')- Respond b fb' ->- Respond (b , s) (\(b', s') -> thread_P (fb' b') s')- Pure r ->- Pure (r, s) ) )--instance Proxy ProxyCorrect where- fb' ->> p = Proxy (do- x <- unProxy p- 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) )- p >>~ fb = Proxy (do- x <- unProxy p- 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')))))-- fb' >\\ p0 = go p0- where- go p = Proxy (do- y <- unProxy p- case y of- Request b' fb -> unProxy (fb' b' >>= \b -> go (fb b))- Respond x fx' -> return (Respond x (\x' -> go (fx' x')))- Pure a -> return (Pure a) )- p0 //> fb = go p0- where- go p = Proxy (do- y <- unProxy p- case y of- Request x' fx -> return (Request x' (\x -> go (fx x)))- Respond b fb' -> unProxy (fb b >>= \b' -> go (fb' b'))- Pure a -> return (Pure a) )-- turn = go- where- go p = Proxy (do- x <- unProxy p- return (case x of- Request a fa' -> Respond a (\a' -> go (fa' a'))- Respond b' fb -> Request 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', converting it back to the base monad-run :: (Monad m) => ProxyCorrect a' () () b m r -> m r-run p = do- x <- unProxy p- case x of- Request _ fa -> run (fa ())- Respond _ fb' -> run (fb' ())- Pure r -> return r--{-| 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 = run (k ()) where-{-# INLINABLE runProxy #-}--{-| Run a self-sufficient 'ProxyCorrect' Kleisli arrow, converting it back to a- Kleisli arrow in the base monad--}-runProxyK :: (Monad m) => (q -> ProxyCorrect a' () () b m r) -> (q -> m r)-runProxyK k q = run (k q)-{-# INLINABLE runProxyK #-}
− Control/Proxy/Core/Fast.hs
@@ -1,282 +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-- The monad transformer laws do hold when viewed through the safe API exported- from "Control.Proxy".-- 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.--}--{-# LANGUAGE Trustworthy #-}-{- The rewrite RULES require the 'TrustWorthy' annotation. Their proofs are- pretty trivial since they are just inlining the definition of their- respective operators. GHC doesn't do this inlining automatically because the- @go@ helper function is recursive.--}--module Control.Proxy.Core.Fast (- -- * Types- ProxyFast(..),-- -- * Run Sessions - -- $run- runProxy,- runProxyK,-- -- * Safety- observe- ) where--import Control.Applicative (Applicative(pure, (<*>)))-import Control.Monad.IO.Class (MonadIO(liftIO))-import Control.Monad.Morph (MFunctor(hoist))-import Control.Monad.Trans.Class (MonadTrans(lift))-import Control.Proxy.Class (- Proxy(request, respond, (->>), (>>~), (>\\), (//>), turn),- ProxyInternal(return_P, (?>=), lift_P, liftIO_P, hoist_P, thread_P))--{-| A 'ProxyFast' communicates with an upstream interface and a downstream- interface.-- The type variables signify:-- * @a'@ - The request supplied to the upstream interface-- * @a @ - The response provided by the upstream interface-- * @b'@ - The request supplied by the downstream interface-- * @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--{-# RULES- "_bind (Request a' k) f" forall a' k f .- _bind (Request a' k) f = Request a' (\a -> _bind (k a) f);- "_bind (Respond b k) f" forall b k f .- _bind (Respond b k) f = Respond b (\b' -> _bind (k b') f);- "_bind (M m) f" forall m f .- _bind (M m) f = M (m >>= \p -> return (_bind p f));- "_bind (Pure r ) f" forall r f .- _bind (Pure r) f = f r;- #-}---- | Only satisfies monad transformer 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))--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--instance (MonadIO m) => MonadIO (ProxyFast a' a b' b m) where- liftIO m = M (liftIO (m >>= \r -> return (Pure r)))--instance ProxyInternal ProxyFast where- return_P = Pure- (?>=) = _bind-- lift_P = _lift-- liftIO_P = liftIO-- hoist_P = hoist-- thread_P p s = case p of- Request a' fa -> Request (a', s) (\(a , s') -> thread_P (fa a ) s')- Respond b fb' -> Respond (b, s) (\(b', s') -> thread_P (fb' b') s')- M m -> M (m >>= \p' -> return (thread_P p' s))- Pure r -> Pure (r, s)--instance Proxy ProxyFast where- fb' ->> p = case p of- Request b' fb -> fb' b' >>~ fb- Respond c fc' -> Respond c (\c' -> fb' ->> fc' c')- M m -> M (m >>= \p' -> return (fb' ->> p'))- Pure r -> Pure r- p >>~ fb = case p of- Request a' fa -> Request a' (\a -> fa a >>~ fb)- Respond b fb' -> fb' ->> fb b- M m -> M (m >>= \p' -> return (p' >>~ fb))- Pure r -> Pure r-- request = \a' -> Request a' Pure- respond = \b -> Respond b Pure-- (>\\) = _req- (//>) = _resp-- turn = go- where- go p = case p of- Request a' fa -> Respond a' (\a -> go (fa a ))- Respond b fb' -> Request b (\b' -> go (fb' b'))- M m -> M (m >>= \p' -> return (go p'))- Pure r -> Pure r--_req- :: (Monad m)- => (b' -> ProxyFast a' a x' x m b)- -> ProxyFast b' b x' x m c- -> ProxyFast a' a x' x m c-fb' `_req` p0 = go p0 where- go p = case p of- Request b' fb -> fb' b' >>= \b -> go (fb b)- Respond x fx' -> Respond x (\x' -> go (fx' x'))- M m -> M (m >>= \p' -> return (go p'))- Pure a -> Pure a--{-# RULES- "_req fb' (Request b' fb )" forall fb' b' fb .- _req fb' (Request b' fb ) = _bind (fb' b') (\b -> _req fb' (fb b));- "_req fb' (Respond x fx')" forall fb' x fx' .- _req fb' (Respond x fx') = Respond x (\x' -> _req fb' (fx' x'));- "_req fb' (M m )" forall fb' m .- _req fb' (M m ) = M (m >>= \p' -> return (_req fb' p'));- "_req fb' (Pure a )" forall fb' a .- _req fb' (Pure a ) = Pure a;- #-}--_resp- :: (Monad m)- => ProxyFast x' x b' b m a'- -> (b -> ProxyFast x' x c' c m b')- -> ProxyFast x' x c' c m a'-p0 `_resp` fb = go p0 where- go p = case p of- Request x' fx -> Request x' (\x -> go (fx x))- Respond b fb' -> fb b >>= \b' -> go (fb' b')- M m -> M (m >>= \p' -> return (go p'))- Pure a -> Pure a--{-# RULES- "_resp (Request x' fx ) fb" forall x' fx fb .- _resp (Request x' fx ) fb = Request x' (\x -> _resp (fx x) fb);- "_resp (Respond b fb') fb" forall b fb' fb .- _resp (Respond b fb') fb = _bind (fb b) (\b' -> _resp (fb' b') fb);- "_resp (M m ) fb" forall m fb .- _resp (M m ) fb = M (m >>= \p' -> return (_resp p' fb));- "_resp (Pure a ) fb" forall a fb .- _resp (Pure a ) fb = Pure a;- #-}--{- $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', converting it back to the base monad-run :: (Monad m) => ProxyFast a' () () b m r -> m r-run p = case p of- Request _ fa -> run (fa ())- Respond _ fb' -> run (fb' ())- M m -> m >>= run- Pure r -> return r--{-| 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 = run (k ())-{-# INLINABLE runProxy #-}--{-| Run a self-sufficient 'ProxyFast' Kleisli arrow, converting it back to a- Kleisli arrow in the base monad--}-runProxyK :: (Monad m) => (q -> ProxyFast a' () () b m r) -> (q -> m r)-runProxyK k q = run (k q)-{-# INLINABLE runProxyK #-}--{-| 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 p0 = M (go p0) 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')))-{-# INLINABLE observe #-}
− Control/Proxy/Morph.hs
@@ -1,123 +0,0 @@-{-| A proxy morphism is a natural transformation:--> morph :: forall r . p a' a b' b m r -> q a' a b' b n r-- ... that defines a functor between five categories:-- * Functor between Kleisli categories:--> morph . p1 >=> morph . p2 = morph . (p1 >=> p2)->-> morph . return = return-- * Functor between 'P.Proxy' composition categories:--> morph . p1 >-> morph . p2 = morph . (p1 >-> p2)->-> morph . pull = pull--> morph . p1 >~> morph . p2 = morph . (p1 >~> p2)->-> morph . push = push-- * Functor between 'ListT' Kleisli categories:--> morph . p1 \>\ morph . p2 = morph . (p2 \>\ p2)->-> morph . request = request--> morph . p1 />/ morph . p2 = morph . (p2 />/ p2)->-> morph . respond = respond-- Examples of proxy morphisms include:-- * 'liftP' (from 'ProxyTrans')-- * 'squashP' (See below)-- * @'hoistP' f@ (See below) if @f@ is a proxy morphism-- * @(f . g)@, if @f@ and @g@ are both proxy morphisms-- * 'id'-- Proxy morphisms commonly arise when manipulating existing proxy transformer- code for compatibility purposes. The 'PFUnctor', 'ProxyTrans', and 'PMonad'- classes define standard ways to change proxy transformer stacks:-- * 'liftP' introduces a new proxy transformer layer of any type:.-- * 'squashP' flattens two identical monad transformer layers into a single- layer of the same type.-- * 'hoistP' maps proxy morphisms to modify deeper layers of the proxy- transformer stack.--}--{-# LANGUAGE KindSignatures, Rank2Types #-}--module Control.Proxy.Morph (- -- * Functors over Proxies- PFunctor(..),-- -- * Monads over Proxies- PMonad(..),- squashP- ) where--import Control.Proxy.Class (Proxy)---- For documentation-import Control.Proxy.Trans (ProxyTrans(liftP))--{-| A functor in the category of proxies, using 'hoistP' as the analog of- 'fmap':--> hoistP f . hoistP g = hoistP (f . g)->-> hoistP id = id--}-class PFunctor (t- :: (* -> * -> * -> * -> (* -> *) -> * -> *)- -> * -> * -> * -> * -> (* -> *) -> * -> * ) where- {-| Lift a proxy morphism from @p1@ to @p2@ into a proxy morphism from- @(t p1)@ to @(t p2)@- -}- hoistP- :: (Monad m1, Proxy p1)- => (forall _a' _a _b' _b _r .- p1 _a' _a _b' _b m1 _r -> p2 _a' _a _b' _b m2 _r)- -- ^ Proxy morphism- -> ( t p1 a' a b' b m1 r -> t p2 a' a b' b m2 r)--{-| A monad in the category of monads, using 'liftP' from 'ProxyTrans' as the- analog of 'return' and 'embedP' as the analog of ('=<<'):--> embedP liftP = id->-> embedP f (liftP p) = f p->-> embed g (embed f t) = embed (\p -> embed g (f p)) t--}-class (PFunctor t, ProxyTrans t) => PMonad t where- {-| Embed a newly created 'PMonad' layer within an existing layer-- 'embedP' is analogous to ('=<<')- -}- embedP- :: (Monad m2, Proxy p2)- => (forall _a' _a _b' _b _r- . p1 _a' _a _b' _b m1 _r -> t p2 _a' _a _b' _b m2 _r)- -- ^ Proxy morphism- -> ( t p1 a' a b' b m1 r -> t p2 a' a b' b m2 r)--{-| Squash two 'PMonad' layers into a single layer-- 'squashP' is analogous to 'join'--}-squashP- :: (Monad m, Proxy p, PMonad t)- => t (t p) a' a b' b m r -> t p a' a b' b m r-squashP = embedP id-{-# INLINABLE squashP #-}
− Control/Proxy/Pipe.hs
@@ -1,214 +0,0 @@-{-| 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.--}-{-# LANGUAGE KindSignatures #-}--module Control.Proxy.Pipe- {-# DEPRECATED "Use official 'Proxy' operations instead" #-} (- -- * 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, respond, request, (->>), Pipe, C)-import Control.Proxy.Trans.Identity (runIdentityP)---- For documentation-import Control.Proxy.Class (Consumer, Producer)--{-| 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 ()-{-# INLINABLE await #-}--{-| 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 b'-yield = respond-{-# INLINABLE yield #-}---- | 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)-{-# INLINABLE pipe #-}--infixr 7 <+<-infixl 7 >+>---- | Corresponds to ('<<<')/('.') from @Control.Category@-(<+<)- :: (Monad m, Proxy p)- => p b' b c' c m r- -> p a' a b' b m r- -> p a' a c' c m r-p1 <+< p2 = p2 >+> p1-{-# INLINABLE (<+<) #-}---- | Corresponds to ('>>>') from @Control.Category@-(>+>)- :: (Monad m, Proxy p)- => p a' a b' b m r- -> p b' b c' c m r- -> p a' a c' c m r-p1 >+> p2 = (\_ -> p1) ->> p2-{-# INLINABLE (>+>) #-}---- | 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-{-# INLINABLE idP #-}--{-| 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,1076 +0,0 @@--- | General purpose proxies--{-# LANGUAGE Rank2Types #-}--module Control.Proxy.Prelude (- -- * I/O- stdinS,- stdoutD,- readLnS,- hGetLineS,- hPutStrLnD,- printD,- printU,- printB,-- -- * Maps- mapD,- mapU,- mapMD,- mapMU,- useD,- useU,- execD,- execU,-- -- * Filters- takeB,- takeB_,- takeWhileD,- takeWhileU,- dropD,- dropU,- dropWhileD,- dropWhileU,- filterD,- filterU,-- -- * Lists and Enumerations- fromListS,- enumFromS,- enumFromToS,- eachS,- rangeS,-- -- * Folds- foldD,- allD,- allD_,- anyD,- anyD_,- sumD,- productD,- lengthD,- headD,- headD_,- lastD,- toListD,- foldrD,-- -- * ArrowChoice- -- $choice- leftD,- rightD,-- -- * Zips and Merges- zipD,- mergeD,-- -- * Closed Adapters- -- $open- unitD,- unitU,-- -- * Kleisli utilities- foreverK,-- -- * Re-exports- module Data.Monoid,-- -- * Deprecated- -- $deprecate- mapB,- mapMB,- useB,- execB,- fromListC,- enumFromC,- enumFromToC,- eachC,- rangeC,- getLineS,- getLineC,- readLnC,- putStrLnD,- putStrLnU,- putStrLnB,- hGetLineC,- hPutStrLnU,- hPutStrLnB,- hPrintD,- hPrintU,- hPrintB,- replicateK,- liftK,- hoistK,- raise,- raiseK,- hoistPK,- raiseP,- raisePK- ) where--import Control.Monad (forever)-import Control.Monad.Morph (MFunctor(hoist))-import Control.Monad.Trans.Class (MonadTrans(lift))-import Control.Proxy.Class-import Control.Proxy.Morph (PFunctor(hoistP))-import Control.Proxy.Trans (ProxyTrans(liftP))-import Control.Proxy.Trans.Identity (- IdentityP(IdentityP, runIdentityP), runIdentityK)-import Control.Proxy.Trans.Writer (WriterP, tell)-import Data.Monoid (- Monoid(mempty, mappend),- Endo(Endo, appEndo),- All(All, getAll),- Any(Any, getAny),- Sum(Sum, getSum),- Product(Product, getProduct),- First(First, getFirst),- Last(Last, getLast) )-import qualified System.IO as IO--{-| A 'Producer' that sends lines from 'stdin' downstream--> stdinS = hGetLineS stdin--}-stdinS :: (Proxy p) => () -> Producer p String IO r-stdinS () = runIdentityP $ forever $ do- str <- lift getLine- respond str-{-# INLINABLE stdinS #-}--{-| 'putStrLn's all values flowing \'@D@\'ownstream to 'stdout'--> stdoutD = hPutStrLnD stdout--}-stdoutD :: (Proxy p) => x -> p x String x String IO r-stdoutD = runIdentityK $ foreverK $ \x -> do- a <- request x- lift $ putStrLn a- respond a-{-# INLINABLE stdoutD #-}---- | '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-{-# INLINABLE readLnS #-}---- | 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-{-# INLINABLE hGetLineS #-}---- | '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-{-# INLINABLE hPutStrLnD #-}---- | '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-{-# INLINABLE printD #-}---- | '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-{-# INLINABLE printU #-}--{-| '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-{-# INLINABLE printB #-}--{-| @(mapD f)@ applies @f@ to all values going \'@D@\'ownstream.--> mapD f1 >-> mapD f2 = mapD (f2 . f1)->-> mapD id = pull--}-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 = runIdentityK (foreverK $ request >=> respond . f)-{-# INLINABLE mapD #-}--{-| @(mapU g)@ applies @g@ to all values going \'@U@\'pstream.--> mapU g1 >-> mapU g2 = mapU (g1 . g2)->-> mapU id = pull--}-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-{-# INLINABLE mapU #-}--{-| @(mapMD f)@ applies the monadic function @f@ to all values going downstream--> mapMD f1 >-> mapMD f2 = mapMD (f1 >=> f2)->-> mapMD return = pull--}-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-{-# INLINABLE mapMD #-}--{-| @(mapMU g)@ applies the monadic function @g@ to all values going upstream--> mapMU g1 >-> mapMU g2 = mapMU (g2 >=> g1)->-> mapMU return = pull--}-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-{-# INLINABLE mapMU #-}--{-| @(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 ()) = pull--}-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-{-# INLINABLE useD #-}--{-| @(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 ()) = pull--}-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-{-# INLINABLE useU #-}--{-| @(execD md)@ executes @md@ every time values flow downstream through it.--> execD md1 >-> execD md2 = execD (md1 >> md2)->-> execD (return ()) = pull--}-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 -}-{-# INLINABLE execD #-}--{-| @(execU mu)@ executes @mu@ every time values flow upstream through it.--> execU mu1 >-> execU mu2 = execU (mu2 >> mu1)->-> execU (return ()) = pull--}-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 -}-{-# INLINABLE execU #-}--{-| @(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 = runIdentityK (replicateK n $ request >=> respond)-{-# INLINABLE takeB #-}---- | '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)-{-# INLINABLE takeB_ #-}--{-| @(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 = pull--}-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 ()-{-# INLINABLE takeWhileD #-}--{-| @(takeWhileU p)@ allows values to pass upstream so long as they satisfy the- predicate @p@.--> takeWhileU p1 >-> takeWhileU p2 = takeWhileU (p1 <> p2)->-> takeWhileD mempty = pull--}-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 ()-{-# INLINABLE takeWhileU #-}--{-| @(dropD n)@ discards @n@ values going downstream--> dropD n1 >-> dropD n2 = dropD (n1 + n2) -- n2 >= 0 && n2 >= 0->-> dropD 0 = pull--}-dropD :: (Monad m, Proxy p) => Int -> () -> Pipe p a a m r-dropD n0 = \() -> runIdentityP (go n0) where- go n- | n <= 0 = pull ()- | otherwise = do- _ <- request ()- go (n - 1)-{- dropD n () = do- replicateM_ n $ request ()- pull () -}-{-# INLINABLE dropD #-}--{-| @(dropU n)@ discards @n@ values going upstream--> dropU n1 >-> dropU n2 = dropU (n1 + n2) -- n2 >= 0 && n2 >= 0->-> dropU 0 = pull--}-dropU :: (Monad m, Proxy p) => Int -> a' -> CoPipe p a' a' m r-dropU n0 = runIdentityK (go n0) where- go n- | n <= 0 = pull- | otherwise = \_ -> do- a' <- respond ()- go (n - 1) a'-{-# INLINABLE dropU #-}--{-| @(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 = pull--}-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- pull x-{-# INLINABLE dropWhileD #-}--{-| @(dropWhileU p)@ discards values going upstream until one violates the- predicate @p@.--> dropWhileU p1 >-> dropWhileU p2 = dropWhileU (p1 <> p2)->-> dropWhileU mempty = pull--}-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 pull a'-{-# INLINABLE dropWhileU #-}--{-| @(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 = pull--}-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-{-# INLINABLE filterD #-}--{-| @(filterU p)@ discards values going upstream if they fail the predicate @p@--> filterU p1 >-> filterU p2 = filterU (p1 <> p2)->-> filterU mempty = pull--}-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-{-# INLINABLE filterU #-}--{-| 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-{-# INLINABLE fromListS #-}---- | '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-{-# INLINABLE enumFromS #-}---- | '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-{-# INLINABLE enumFromToS #-}--{-| Non-deterministically choose from all values in the given list--> mappend <$> eachS xs <*> eachS ys = eachS (mappend <$> xs <*> ys)->-> eachS (pure mempty) = pure mempty--}-eachS :: (Monad m, Proxy p) => [b] -> ProduceT p m b-eachS bs = RespondT (fromListS bs ())-{-# INLINABLE eachS #-}---- | Non-deterministically choose from all values in the given range-rangeS :: (Enum b, Ord b, Monad m, Proxy p) => b -> b -> ProduceT p m b-rangeS b1 b2 = RespondT (enumFromToS b1 b2 ())-{-# INLINABLE rangeS #-}--{-| Strict fold over values flowing \'@D@\'ownstream.--> foldD f >-> foldD g = foldD (f <> g)->-> foldD mempty = idPull--}-foldD- :: (Monad m, Proxy p, Monoid w) => (a -> w) -> x -> WriterP w p x a x a m r-foldD f = go where- go x = do- a <- request x- tell (f a)- x2 <- respond a- go x2-{-# INLINABLE foldD #-}--{-| Fold that returns whether 'All' values flowing \'@D@\'ownstream satisfy the- predicate--}-allD :: (Monad m, Proxy p) => (a -> Bool) -> x -> WriterP All p x a x a m r-allD predicate = foldD (All . predicate)-{-# INLINABLE allD #-}--{-| 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 -> WriterP All p x a x a m ()-allD_ predicate = go where- go x = do- a <- request x- if (predicate a)- then do- x2 <- respond a- go x2- else tell (All False)-{-# INLINABLE allD_ #-}--{-| Fold that returns whether 'Any' value flowing \'@D@\'ownstream satisfies the- predicate--}-anyD :: (Monad m, Proxy p) => (a -> Bool) -> x -> WriterP Any p x a x a m r-anyD predicate = foldD (Any . predicate)-{-# INLINABLE anyD #-}--{-| 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 -> WriterP Any p x a x a m ()-anyD_ predicate = go where- go x = do- a <- request x- if (predicate a)- then tell (Any True)- else do- x2 <- respond a- go x2-{-# INLINABLE anyD_ #-}---- | Compute the 'Sum' of all values that flow \'@D@\'ownstream-sumD :: (Monad m, Proxy p, Num a) => x -> WriterP (Sum a) p x a x a m r-sumD = foldD Sum-{-# INLINABLE sumD #-}---- | Compute the 'Product' of all values that flow \'@D@\'ownstream-productD :: (Monad m, Proxy p, Num a) => x -> WriterP (Product a) p x a x a m r-productD = foldD Product-{-# INLINABLE productD #-}---- | Count how many values flow \'@D@\'ownstream-lengthD :: (Monad m, Proxy p) => x -> WriterP (Sum Int) p x a x a m r-lengthD = foldD (\_ -> Sum 1)-{-# INLINABLE lengthD #-}---- | Retrieve the first value going \'@D@\'ownstream-headD :: (Monad m, Proxy p) => x -> WriterP (First a) p x a x a m r-headD = foldD (First . Just)-{-# INLINABLE headD #-}--{-| Retrieve the first value going \'@D@\'ownstream-- 'headD_' terminates on the first value it receives--}-headD_ :: (Monad m, Proxy p) => x -> WriterP (First a) p x a x a m ()-headD_ x = do- a <- request x- tell $ First (Just a)-{-# INLINABLE headD_ #-}---- | Retrieve the last value going \'@D@\'ownstream-lastD :: (Monad m, Proxy p) => x -> WriterP (Last a) p x a x a m r-lastD = foldD (Last . Just)-{-# INLINABLE lastD #-}---- | Fold the values flowing \'@D@\'ownstream into a list-toListD :: (Monad m, Proxy p) => x -> WriterP [a] p x a x a m r-toListD = foldD (\x -> [x])-{-# INLINABLE toListD #-}--{-| 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 -> WriterP (Endo b) p x a x a m r-foldrD step = foldD (Endo . step)-{-# INLINABLE foldrD #-}--{- $choice- 'leftD' and 'rightD' satisfy the 'ArrowChoice' laws using @arr = mapD@.--}--{-| Lift a proxy to operate only on 'Left' values flowing \'@D@\'ownstream and- forward 'Right' values--}-leftD- :: (Monad m, Proxy p)- => (q -> p x a x b m r) -> (q -> p x (Either a e) x (Either b e) m r)-leftD k = runIdentityK (up \>\ (IdentityP . k />/ dn))- where- dn b = respond (Left b)- up x = do- ma <- request x- case ma of- Left a -> return a- Right e -> do- x2 <- respond (Right e)- up x2-{-# INLINABLE leftD #-}--{-| Lift a proxy to operate only on 'Right' values flowing \'@D@\'ownstream and- forward 'Left' values--}-rightD- :: (Monad m, Proxy p)- => (q -> p x a x b m r) -> (q -> p x (Either e a) x (Either e b) m r)-rightD k = runIdentityK (up \>\ (IdentityP . k />/ dn))- where- dn b = respond (Right b)- up x = do- ma <- request x- case ma of- Left e -> do- x2 <- respond (Left e)- up x2- Right a -> return a-{-# INLINABLE rightD #-}---- | 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-{-# INLINABLE zipD #-}---- | 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-{-# INLINABLE mergeD #-}--{- $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) => q -> p x' x y' () m r-unitD _ = runIdentityP go where- go = do- _ <- respond ()- go-{-# INLINABLE unitD #-}---- | Compose 'unitU' with a closed downstream end to create a polymorphic end-unitU :: (Monad m, Proxy p) => q -> p () x y' y m r-unitU _ = runIdentityP go where- go = do- _ <- request ()- go-{-# INLINABLE unitU #-}--{- $modules- These modules help you build, run, and extract folds--}--{-| 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--}-{-# INLINABLE foreverK #-}--{- $deprecate- To be removed in version @4.0.0@--}--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-{-# INLINABLE mapB #-}-{-# DEPRECATED mapB "Combine 'mapD' and 'mapU' instead" #-}--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-{-# INLINABLE mapMB #-}-{-# DEPRECATED mapMB "Combine 'mapMD' and 'mapMU' instead" #-}--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-{-# INLINABLE useB #-}-{-# DEPRECATED useB "Combined 'useD' and 'useU' instead" #-}--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-{-# INLINABLE execB #-}-{-# DEPRECATED execB "Combine 'execD' and 'execU' instead" #-}--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-{-# INLINABLE fromListC #-}-{-# DEPRECATED fromListC "Use 'turn . fromListS xs' instead" #-}--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'-{-# INLINABLE enumFromC #-}-{-# DEPRECATED enumFromC "Use 'turn . enumFromS n' instead" #-}--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-{-# INLINABLE enumFromToC #-}-{-# DEPRECATED enumFromToC "Use 'turn . enumFromToS n1 n2' instead" #-}--eachC :: (Monad m, Proxy p) => [a'] -> CoProduceT p m a'-eachC a's = RequestT (fromListC a's ())-{-# INLINABLE eachC #-}-{-# DEPRECATED eachC "Use 'RequestT $ turn $ fromListS xs ()' instead" #-}--rangeC- :: (Enum a', Ord a', Monad m, Proxy p) => a' -> a' -> CoProduceT p m a'-rangeC a'1 a'2 = RequestT (enumFromToC a'1 a'2 ())-{-# INLINABLE rangeC #-}-{-# DEPRECATED rangeC "Use 'RequestT $ turn $ enumFromToS n1 n2 ()' instead" #-}--getLineS :: (Proxy p) => () -> Producer p String IO r-getLineS () = runIdentityP $ forever $ do- str <- lift getLine- respond str-{-# INLINABLE getLineS #-}-{-# DEPRECATED getLineS "Use 'stdinS' instead" #-}--getLineC :: (Proxy p) => () -> CoProducer p String IO r-getLineC () = runIdentityP $ forever $ do- str <- lift getLine- request str-{-# INLINABLE getLineC #-}-{-# DEPRECATED getLineC "Use 'turn . stdinS' instead" #-}--readLnC :: (Read a', Proxy p) => () -> CoProducer p a' IO r-readLnC () = runIdentityP $ forever $ do- a <- lift readLn- request a-{-# INLINABLE readLnC #-}-{-# DEPRECATED readLnC "Use 'turn . readLnC' instead" #-}--putStrLnD :: (Proxy p) => x -> p x String x String IO r-putStrLnD = runIdentityK $ foreverK $ \x -> do- a <- request x- lift $ putStrLn a- respond a-{-# INLINABLE putStrLnD #-}-{-# DEPRECATED putStrLnD "Use 'stdoutD' instead" #-}--putStrLnU :: (Proxy p) => String -> p String x String x IO r-putStrLnU = runIdentityK $ foreverK $ \a' -> do- lift $ putStrLn a'- x <- request a'- respond x-{-# INLINABLE putStrLnU #-}-{-# DEPRECATED putStrLnU "Use 'execU putStrLn' instead" #-}--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-{-# INLINABLE putStrLnB #-}-{-# DEPRECATED putStrLnB "Not that useful" #-}--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-{-# INLINABLE hGetLineC #-}-{-# DEPRECATED hGetLineC "Use 'turn . hGetLineS h'" #-}---- | '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-{-# INLINABLE hPrintD #-}-{-# DEPRECATED hPrintD "Not that useful" #-}---- | '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-{-# INLINABLE hPrintU #-}-{-# DEPRECATED hPrintU "Not that useful" #-}--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-{-# INLINABLE hPrintB #-}-{-# DEPRECATED hPrintB "Not that useful" #-}--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-{-# INLINABLE hPutStrLnU #-}-{-# DEPRECATED hPutStrLnU "Not that useful" #-}--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-{-# INLINABLE hPutStrLnB #-}-{-# DEPRECATED hPutStrLnB "Not that useful" #-}--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)-{-# INLINABLE replicateK #-}-{-# DEPRECATED replicateK "Not very useful" #-}--liftK :: (Monad m, MonadTrans t) => (a -> m b) -> (a -> t m b)-liftK k a = lift (k a)-{-# INLINABLE liftK #-}-{-# DEPRECATED liftK "Use '(lift .)' instead" #-}--hoistK- :: (Monad m, MFunctor t)- => (forall a . m a -> n a) -- ^ Monad morphism- -> (b' -> t m b) -- ^ Kleisli arrow- -> (b' -> t n b)-hoistK k p a' = hoist k (p a')-{-# INLINABLE hoistK #-}-{-# DEPRECATED hoistK "Use '(hoist f .)' instead" #-}--raise :: (Monad m, MFunctor t1, MonadTrans t2) => t1 m r -> t1 (t2 m) r-raise = hoist lift-{-# INLINABLE raise #-}-{-# DEPRECATED raise "Use 'hoist lift' instead" #-}--raiseK- :: (Monad m, MFunctor t1, MonadTrans t2)- => (q -> t1 m r) -> (q -> t1 (t2 m) r)-raiseK = (hoist lift .)-{-# INLINABLE raiseK #-}-{-# DEPRECATED raiseK "Use '(hoist lift .)' instead" #-}--hoistPK- :: (Monad m, Proxy p1, PFunctor t)- => (forall _a' _a _b' _b _r .- p1 _a' _a _b' _b m _r -> p2 _a' _a _b' _b n _r) -- ^ Proxy morphism- -> (q -> t p1 a' a b' b m r) -- ^ Proxy Kleisli arrow- -> (q -> t p2 a' a b' b n r)-hoistPK f = (hoistP f .)-{-# INLINABLE hoistPK #-}-{-# DEPRECATED hoistPK "Use '(hoistP f .)' instead" #-}--raiseP- :: (Monad m, Proxy p, PFunctor t1, ProxyTrans t2)- => t1 p a' a b' b m r -- ^ Proxy- -> t1 (t2 p) a' a b' b m r-raiseP = hoistP liftP-{-# INLINABLE raiseP #-}-{-# DEPRECATED raiseP "Use 'hoistP liftP' instead" #-}--raisePK- :: (Monad m, Proxy p, PFunctor t1, ProxyTrans t2)- => (q -> t1 p a' a b' b m r) -- ^ Proxy Kleisli arrow- -> (q -> t1 (t2 p) a' a b' b m r)-raisePK = hoistPK liftP-{-# INLINABLE raisePK #-}-{-# DEPRECATED raisePK "Use '(hoistP liftP .)' instead" #-}
− Control/Proxy/Trans.hs
@@ -1,31 +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(..),-- -- * Deprecated- -- $deprecate- mapP- ) where--import Control.Proxy.Class (Proxy)---- | 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--{- $deprecate- To be removed in version @4.0.0@--}--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 .)-{-# INLINABLE mapP #-}-{-# DEPRECATED mapP "Use '(liftP .)' instead" #-}
− Control/Proxy/Trans/Codensity.hs
@@ -1,160 +0,0 @@-{-| This module provides the proxy transformer equivalent of 'CodensityT'.-- The base 'Proxy' implementations suffer a quadratic time complexity if- you repeatedly left-associate the monad bind operation. You can recover- linear time complexity just by adding 'runCodensityK' right after- 'runProxy', which transforms the base 'Proxy' implementation to use- continuation-passing style:--> -- Before:-> runProxy $ ...->-> -- After:-> runProxy $ runCodensityK $ ...-- Everything will still type-check if you you wrote your code to be- polymorphic over the base 'Proxy'.-- Note that even though 'CodensityP' has better time complexity for- left-associated binds, it has worse constant factors for everything else- (about 6x slower on pure benchmarks), because:-- * You cannot optimize it using rewrite rules-- * It has a slower composition operation-- So only use it if you actually need it, which is typically only the case if- you left associate your monad binds on the order of hundreds of times. Even- better: only wrap the problematic portions of the pipeline in- 'runCodensityK' so that the performance of the rest of the pipeline does not- suffer.--}--{-# LANGUAGE KindSignatures, PolymorphicComponents #-}--module Control.Proxy.Trans.Codensity (- -- * Codensity Proxy Transformer- CodensityP,- runCodensityP,- runCodensityK- ) where--import Control.Applicative (Applicative(pure, (<*>)), Alternative(empty, (<|>)))-import Control.Monad (MonadPlus(mzero, mplus))-import Control.Monad.IO.Class (MonadIO(liftIO))-import Control.Monad.Morph (MFunctor(hoist))-import Control.Monad.Trans.Class (MonadTrans(lift))-import Control.Proxy.Class (- Proxy(request, respond, (->>), (>>~), (>\\), (//>), turn),- ProxyInternal(return_P, (?>=), lift_P, liftIO_P, hoist_P, thread_P),- MonadPlusP(mzero_P, mplus_P) )-import Control.Proxy.Morph (PFunctor(hoistP))-import Control.Proxy.Trans (ProxyTrans(liftP))---- | The 'Codensity' proxy transformer-newtype CodensityP p a' a b' b (m :: * -> *) r- = CodensityP { unCodensityP- :: forall x . (Monad m, Proxy p)- => (r -> p a' a b' b m x) -> p a' a b' b m x }-{- The type class instances only satisfy their laws if you hide the constructor- for 'CodensityP'.-- Normally you would not have to hide it and you could rely on parametricity to- guarantee that 'CodensityP p' is isomorphic to 'p'. However, the 'MFunctor'- and 'PFunctor' type classes require including class constraints within the- constructor, which breaks parametricity and makes it possible to define- 'CodensityP' values which break the laws for the following type class- instances.--}--instance (Monad m, Proxy p) => Functor (CodensityP p a' a b' b m) where- fmap f p = CodensityP (\k ->- unCodensityP p (\a ->- k (f a)) )--instance (Monad m, Proxy p) => Applicative (CodensityP p a' a b' b m) where- pure = return- fp <*> xp = CodensityP (\k ->- unCodensityP fp (\f ->- unCodensityP xp (\x ->- k (f x) ) ) )--instance (Monad m, Proxy p) => Monad (CodensityP p a' a b' b m) where- return = return_P- (>>=) = (?>=)--instance (Proxy p) => MonadTrans (CodensityP p a' a b' b) where- lift = lift_P--instance (Proxy p) => MFunctor (CodensityP p a' a b' b) where- hoist = hoist_P--instance (MonadIO m, Proxy p) => MonadIO (CodensityP p a' a b' b m) where- liftIO = liftIO_P--instance (Monad m, MonadPlusP p) => Alternative (CodensityP p a' a b' b m) where- empty = mzero- (<|>) = mplus--instance (Monad m, MonadPlusP p) => MonadPlus (CodensityP p a' a b' b m) where- mzero = mzero_P- mplus = mplus_P--instance (Proxy p) => ProxyInternal (CodensityP p) where- return_P = \r -> CodensityP (\k -> k r)- m ?>= f = CodensityP (\k ->- unCodensityP m (\a ->- unCodensityP (f a) k ) )-- lift_P m = CodensityP (\k -> lift_P m ?>= k)-- hoist_P nat p = CodensityP (\k ->- hoist_P nat (unCodensityP p return_P) ?>= k)-- liftIO_P m = CodensityP (\k -> liftIO_P m ?>= k)-- thread_P p s = CodensityP (\k -> thread_P (unCodensityP p return_P) s ?>= k)--instance (MonadPlusP p) => MonadPlusP (CodensityP p) where- mzero_P = CodensityP (\_ -> mzero_P)- mplus_P m1 m2 = CodensityP (\k ->- mplus_P (unCodensityP m1 k) (unCodensityP m2 k) )--instance (Proxy p) => Proxy (CodensityP p) where- fb' ->> p = CodensityP (\k ->- ((\b' -> unCodensityP (fb' b') return_P) ->> unCodensityP p return_P)- ?>= k )- p >>~ fb = CodensityP (\k ->- (unCodensityP p return_P >>~ (\b -> unCodensityP (fb b) return_P))- ?>= k )- request = \a' -> CodensityP (\k -> request a' ?>= k)- respond = \b -> CodensityP (\k -> respond b ?>= k)-- fb' >\\ p = CodensityP (\k ->- ((\b' -> unCodensityP (fb' b') return_P) >\\ unCodensityP p return_P)- ?>= k )- p //> fb = CodensityP (\k ->- (unCodensityP p return_P //> (\b -> unCodensityP (fb b) return_P))- ?>= k )-- turn p = CodensityP (\k -> turn (unCodensityP p return_P) ?>= k)--instance ProxyTrans CodensityP where- liftP p = CodensityP (\k -> p ?>= k)--instance PFunctor CodensityP where- hoistP nat p = CodensityP (\k -> nat (unCodensityP p return_P) ?>= k)---- | Run a 'CodensityP' proxy, converting, converting it back to the base proxy-runCodensityP- :: (Monad m, Proxy p) => CodensityP p a' a b' b m r -> p a' a b' b m r-runCodensityP p = unCodensityP p return_P-{-# INLINABLE runCodensityP #-}--{-| Run a 'CodensityP' \'@K@\'leisli arrow, converting it back to the base proxy--}-runCodensityK- :: (Monad m, Proxy p)- => (q -> CodensityP p a' a b' b m r) -> (q -> p a' a b' b m r)-runCodensityK k q = runCodensityP (k q)-{-# INLINABLE runCodensityK #-}
− Control/Proxy/Trans/Either.hs
@@ -1,224 +0,0 @@--- | This module provides the proxy transformer equivalent of 'EitherT'.--{-# LANGUAGE KindSignatures, CPP #-}--module Control.Proxy.Trans.Either (- -- * EitherP- EitherP(..),- runEitherK,-- -- * Either operations- left,- right,-- -- * Symmetric monad- -- $symmetry- throw,- catch,- handle,- fmapL- ) where--import Control.Applicative (Applicative(pure, (<*>)), Alternative(empty, (<|>)))-import Control.Monad (MonadPlus(mzero, mplus))-import Control.Monad.IO.Class (MonadIO(liftIO))-import Control.Monad.Morph (MFunctor(hoist))-import Control.Monad.Trans.Class (MonadTrans(lift))-import Control.Proxy.Class (- Proxy(request, respond, (->>), (>>~), (>\\), (//>), turn),- ProxyInternal(return_P, (?>=), lift_P, liftIO_P, hoist_P, thread_P),- MonadPlusP(mzero_P, mplus_P) )-import Control.Proxy.Morph (PFunctor(hoistP), PMonad(embedP))-import Control.Proxy.Trans (ProxyTrans(liftP))-#if MIN_VERSION_base(4,6,0)-#else-import Prelude hiding (catch)-#endif-import Data.Monoid (Monoid(mempty, mappend))---- | 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 (Monad m, Proxy p) => 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) ) )--instance (Monad m, Proxy p) => 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) ) )--instance (Monad m, Proxy p) => Monad (EitherP e p a' a b' b m) where- return = return_P- (>>=) = (?>=)--instance (Proxy p) => MonadTrans (EitherP e p a' a b' b) where- lift = lift_P--instance (Proxy p) => MFunctor (EitherP e p a' a b' b) where- hoist = hoist_P--instance (MonadIO m, Proxy p) => MonadIO (EitherP e p a' a b' b m) where- liftIO = liftIO_P--instance (Monad m, Proxy p, Monoid e)- => Alternative (EitherP e p a' a b' b m) where- empty = mzero- (<|>) = mplus--instance (Monad m, Proxy p, Monoid e)- => MonadPlus (EitherP e p a' a b' b m) where- mzero = mzero_P- mplus = mplus_P--instance (Proxy p) => ProxyInternal (EitherP e p) where- return_P = \r -> EitherP (return_P (Right r))- m ?>= f = EitherP (- runEitherP m ?>= \e ->- case e of- Left l -> return_P (Left l)- Right r -> runEitherP (f r) )-- lift_P m = EitherP (lift_P (m >>= \x -> return (Right x)))-- hoist_P nat p = EitherP (hoist_P nat (runEitherP p))-- liftIO_P m = EitherP (liftIO_P (m >>= \x -> return (Right x)))-- thread_P p s = EitherP (- thread_P (runEitherP p) s ?>= \(x, s') ->- return_P (case x of- Left e -> Left e- Right r -> Right (r, s') ) )--instance (Proxy p) => Proxy (EitherP e p) where- fb' ->> p = EitherP ((\b' -> runEitherP (fb' b')) ->> runEitherP p)- p >>~ fb = EitherP (runEitherP p >>~ (\b -> runEitherP (fb b)))- request = \a' -> EitherP (request a' ?>= \a -> return_P (Right a ))- respond = \b -> EitherP (respond b ?>= \b' -> return_P (Right b'))-- p //> fb = EitherP (- (runEitherP p >>~ absorb) //> \b -> runEitherP (fb b) )- where- absorb b =- respond b ?>= \x ->- case x of- Left e -> return_P (Left e)- Right b' ->- request b' ?>= \b2 ->- absorb b2- fb' >\\ p = EitherP (- (\b' -> runEitherP (fb' b')) >\\ (absorb ->> runEitherP p) )- where- absorb b' =- request b' ?>= \x ->- case x of- Left e -> return_P (Left e)- Right b ->- respond b ?>= \b'2 ->- absorb b'2-- turn p = EitherP (turn (runEitherP p))--instance (Proxy p, Monoid e) => MonadPlusP (EitherP e p) where- mzero_P = EitherP (return_P (Left mempty))- mplus_P p1 p2 = EitherP (- runEitherP p1 ?>= \e1 ->- case e1 of- Right r -> return_P (Right r)- Left l1 ->- runEitherP p2 ?>= \e2 ->- case e2 of- Right r -> return_P (Right r)- Left l2 -> return_P (Left (mappend l1 l2)) )--instance ProxyTrans (EitherP e) where- liftP p = EitherP (p ?>= \x -> return_P (Right x))--instance PFunctor (EitherP e) where- hoistP nat p = EitherP (nat (runEitherP p))--instance PMonad (EitherP e) where- embedP nat p = EitherP (- runEitherP (nat (runEitherP p)) ?>= \x ->- return_P (case x of- Left e -> Left e- Right (Left e) -> Left e- Right (Right a) -> Right a ) )---- | 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)-{-# INLINABLE runEitherK #-}---- | 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))-{-# INLINABLE 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))-{-# INLINABLE 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-{-# INLINABLE throw #-}---- | 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 ))-{-# INLINABLE catch #-}---- | '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-{-# INLINABLE handle #-}---- | 'fmap' over the \'@L@\'eft variable-fmapL- :: (Monad m, Proxy p)- => (e -> f) -> EitherP e p a' a b' b m r -> EitherP f p a' a b' b m r-fmapL f p = catch p (\e -> throw (f e))-{-# INLINABLE fmapL #-}
− Control/Proxy/Trans/Identity.hs
@@ -1,114 +0,0 @@--- | This module provides the proxy transformer equivalent of 'IdentityT'.--{-# LANGUAGE KindSignatures #-}--module Control.Proxy.Trans.Identity (- -- * Identity Proxy Transformer- IdentityP(..),- runIdentityK,-- -- * Deprecated- -- $deprecate- identityK- ) where--import Control.Applicative (Applicative(pure, (<*>)), Alternative(empty, (<|>)))-import Control.Monad (MonadPlus(mzero, mplus))-import Control.Monad.IO.Class (MonadIO(liftIO))-import Control.Monad.Morph (MFunctor(hoist))-import Control.Monad.Trans.Class (MonadTrans(lift))-import Control.Proxy.Class (- Proxy(request, respond, (->>), (>>~), (>\\), (//>), turn),- ProxyInternal(return_P, (?>=), lift_P, liftIO_P, hoist_P, thread_P),- MonadPlusP(mzero_P, mplus_P) )-import Control.Proxy.Morph (PFunctor(hoistP), PMonad(embedP))-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 (Monad m, Proxy p) => Functor (IdentityP p a' a b' b m) where- fmap f p = IdentityP (- runIdentityP p ?>= \x ->- return_P (f x) )--instance (Monad m, Proxy p) => Applicative (IdentityP p a' a b' b m) where- pure = return- fp <*> xp = IdentityP (- runIdentityP fp ?>= \f ->- runIdentityP xp ?>= \x ->- return_P (f x) )--instance (Monad m, Proxy p) => Monad (IdentityP p a' a b' b m) where- return = return_P- (>>=) = (?>=)--instance (Proxy p) => MonadTrans (IdentityP p a' a b' b) where- lift = lift_P--instance (Proxy p) => MFunctor (IdentityP p a' a b' b) where- hoist = hoist_P--instance (MonadIO m, Proxy p) => MonadIO (IdentityP p a' a b' b m) where- liftIO = liftIO_P--instance (Monad m, MonadPlusP p) => Alternative (IdentityP p a' a b' b m) where- empty = mzero- (<|>) = mplus--instance (Monad m, MonadPlusP p) => MonadPlus (IdentityP p a' a b' b m) where- mzero = mzero_P- mplus = mplus_P--instance (Proxy p) => ProxyInternal (IdentityP p) where- return_P = \r -> IdentityP (return_P r)- m ?>= f = IdentityP (- runIdentityP m ?>= \x ->- runIdentityP (f x) )-- lift_P m = IdentityP (lift_P m)-- hoist_P nat p = IdentityP (hoist_P nat (runIdentityP p))-- liftIO_P m = IdentityP (liftIO_P m)-- thread_P p s = IdentityP (thread_P (runIdentityP p) s)--instance (Proxy p) => Proxy (IdentityP p) where- fb' ->> p = IdentityP ((\b' -> runIdentityP (fb' b')) ->> runIdentityP p)- p >>~ fb = IdentityP (runIdentityP p >>~ (\b -> runIdentityP (fb b)))-- request = \a' -> IdentityP (request a')- respond = \b -> IdentityP (respond b )-- fb' >\\ p = IdentityP ((\b' -> runIdentityP (fb' b')) >\\ runIdentityP p)- p //> fb = IdentityP (runIdentityP p //> (\b -> runIdentityP (fb b)))-- turn p = IdentityP (turn (runIdentityP p))--instance (MonadPlusP p) => MonadPlusP (IdentityP p) where- mzero_P = IdentityP mzero_P- mplus_P m1 m2 = IdentityP (mplus_P (runIdentityP m1) (runIdentityP m2))--instance ProxyTrans IdentityP where- liftP = IdentityP--instance PFunctor IdentityP where- hoistP nat p = IdentityP (nat (runIdentityP p))--instance PMonad IdentityP where- embedP nat p = nat (runIdentityP p)---- | Run an 'IdentityP' \'@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)-{-# INLINABLE runIdentityK #-}--{- $deprecate- To be removed in version @4.0.0@--}--identityK :: (q -> p a' a b' b m r) -> (q -> IdentityP p a' a b' b m r)-identityK k q = IdentityP (k q)-{-# INLINABLE identityK #-}-{-# DEPRECATED identityK "Use '(IdentityP .)' instead" #-}
− Control/Proxy/Trans/Maybe.hs
@@ -1,154 +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.Morph (MFunctor(hoist))-import Control.Monad.Trans.Class (MonadTrans(lift))-import Control.Proxy.Class (- Proxy(request, respond, (->>), (>>~), (>\\), (//>), turn),- ProxyInternal(return_P, (?>=), lift_P, liftIO_P, hoist_P, thread_P),- MonadPlusP(mzero_P, mplus_P) )-import Control.Proxy.Morph (PFunctor(hoistP), PMonad(embedP))-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 (Monad m, Proxy p) => 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) ) )--instance (Monad m, Proxy p) => 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)) )--instance (Monad m, Proxy p) => Monad (MaybeP p a' a b' b m) where- return = return_P- (>>=) = (?>=)--instance (Proxy p) => MonadTrans (MaybeP p a' a b' b) where- lift = lift_P--instance (Proxy p) => MFunctor (MaybeP p a' a b' b) where- hoist = hoist_P--instance (MonadIO m, Proxy p) => MonadIO (MaybeP p a' a b' b m) where- liftIO = liftIO_P--instance (Monad m, Proxy p) => Alternative (MaybeP p a' a b' b m) where- empty = mzero- (<|>) = mplus--instance (Monad m, Proxy p) => MonadPlus (MaybeP p a' a b' b m) where- mzero = mzero_P- mplus = mplus_P--instance (Proxy p) => ProxyInternal (MaybeP p) where- return_P = \r -> MaybeP (return_P (Just r))- m ?>= f = MaybeP (- runMaybeP m ?>= \ma ->- runMaybeP (case ma of- Nothing -> MaybeP (return_P Nothing)- Just a -> f a ) )-- lift_P m = MaybeP (lift_P (m >>= \x -> return (Just x)))-- hoist_P nat p = MaybeP (hoist_P nat (runMaybeP p))-- liftIO_P m = MaybeP (liftIO_P (m >>= \x -> return (Just x)))-- thread_P p s = MaybeP (- thread_P (runMaybeP p) s ?>= \(x, s') ->- return_P (case x of- Nothing -> Nothing- Just r -> Just (r, s') ) )--instance (Proxy p) => Proxy (MaybeP p) where- fb' ->> p = MaybeP ((\b' -> runMaybeP (fb' b')) ->> runMaybeP p)- p >>~ fb = MaybeP (runMaybeP p >>~ (\b -> runMaybeP (fb b)))- request = \a' -> MaybeP (request a' ?>= \a -> return_P (Just a ))- respond = \b -> MaybeP (respond b ?>= \b' -> return_P (Just b'))-- p //> fb = MaybeP (- (runMaybeP p >>~ absorb) //> \b -> runMaybeP (fb b) )- where- absorb b =- respond b ?>= \x ->- case x of- Nothing -> return_P Nothing- Just b' ->- request b' ?>= \b2 ->- absorb b2- fb' >\\ p = MaybeP (- (\b' -> runMaybeP (fb' b')) >\\ (absorb ->> runMaybeP p) )- where- absorb b' =- request b' ?>= \x ->- case x of- Nothing -> return_P Nothing- Just b ->- respond b ?>= \b'2 ->- absorb b'2-- turn p = MaybeP (turn (runMaybeP p))--instance (Proxy p) => MonadPlusP (MaybeP p) where- mzero_P = MaybeP (return_P Nothing)- mplus_P m1 m2 = MaybeP (- runMaybeP m1 ?>= \ma ->- case ma of- Nothing -> runMaybeP m2- Just a -> return_P (Just a) )--instance ProxyTrans MaybeP where- liftP p = MaybeP (p ?>= \x -> return_P (Just x))--instance PFunctor MaybeP where- hoistP nat p = MaybeP (nat (runMaybeP p))--instance PMonad MaybeP where- embedP nat p = MaybeP (- runMaybeP (nat (runMaybeP p)) ?>= \x ->- return_P (case x of- Nothing -> Nothing- Just Nothing -> Nothing- Just (Just a) -> Just a ) )---- | 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)-{-# INLINABLE runMaybeK #-}---- | A synonym for 'mzero'-nothing :: (Monad m, Proxy p) => MaybeP p a' a b' b m r-nothing = MaybeP (return_P Nothing)-{-# INLINABLE 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))-{-# INLINABLE just #-}
− Control/Proxy/Trans/Reader.hs
@@ -1,135 +0,0 @@--- | This module provides the proxy transformer equivalent of 'ReaderT'.--{-# LANGUAGE KindSignatures #-}--module Control.Proxy.Trans.Reader (- -- * ReaderP- ReaderP(..),- runReaderP,- runReaderK,-- -- * Reader operations- ask,- asks,- local,- withReaderP,- ) where--import Control.Applicative (Applicative(pure, (<*>)), Alternative(empty, (<|>)))-import Control.Monad (MonadPlus(mzero, mplus))-import Control.Monad.IO.Class (MonadIO(liftIO))-import Control.Monad.Morph (MFunctor(hoist))-import Control.Monad.Trans.Class (MonadTrans(lift))-import Control.Proxy.Class (- Proxy(request, respond, (->>), (>>~), (>\\), (//>), turn),- ProxyInternal(return_P, (?>=), lift_P, liftIO_P, hoist_P, thread_P),- MonadPlusP(mzero_P, mplus_P) )-import Control.Proxy.Morph (PFunctor(hoistP), PMonad(embedP))-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 (Monad m, Proxy p) => Functor (ReaderP i p a' a b' b m) where- fmap f p = ReaderP (\i ->- unReaderP p i ?>= \x ->- return_P (f x) )--instance (Monad m, Proxy p) => 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 (Monad m, Proxy p) => Monad (ReaderP i p a' a b' b m) where- return = return_P- (>>=) = (?>=)--instance (Proxy p) => MonadTrans (ReaderP i p a' a b' b) where- lift = lift_P--instance (Proxy p) => MFunctor (ReaderP i p a' a b' b) where- hoist = hoist_P--instance (MonadIO m, Proxy p) => MonadIO (ReaderP i p a' a b' b m) where- liftIO = liftIO_P--instance (Monad m, MonadPlusP p) => Alternative (ReaderP i p a' a b' b m) where- empty = mzero- (<|>) = mplus--instance (Monad m, MonadPlusP p) => MonadPlus (ReaderP i p a' a b' b m) where- mzero = mzero_P- mplus = mplus_P--instance (Proxy p) => ProxyInternal (ReaderP i p) where- return_P = \r -> ReaderP (\_ -> return_P r)- m ?>= f = ReaderP (\i ->- unReaderP m i ?>= \a -> - unReaderP (f a) i )-- lift_P m = ReaderP (\_ -> lift_P m)-- hoist_P nat p = ReaderP (\i -> hoist_P nat (unReaderP p i))-- liftIO_P m = ReaderP (\_ -> liftIO_P m)-- thread_P p s = ReaderP (\i -> thread_P (unReaderP p i) s)--instance (Proxy p) => Proxy (ReaderP i p) where- fb' ->> p = ReaderP (\i -> (\b' -> unReaderP (fb' b') i) ->> unReaderP p i)- p >>~ fb = ReaderP (\i -> unReaderP p i >>~ (\b -> unReaderP (fb b) i))-- request = \a -> ReaderP (\_ -> request a)- respond = \a -> ReaderP (\_ -> respond a)-- fb' >\\ p = ReaderP (\i -> (\b' -> unReaderP (fb' b') i) >\\ unReaderP p i)- p //> fb = ReaderP (\i -> unReaderP p i //> (\b -> unReaderP (fb b) i))-- turn p = ReaderP (\i -> turn (unReaderP p i))--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 ProxyTrans (ReaderP i) where- liftP m = ReaderP (\_ -> m)--instance PFunctor (ReaderP i) where- hoistP nat p = ReaderP (\i -> nat (unReaderP p i))--instance PMonad (ReaderP i) where- embedP nat p = ReaderP (\i -> unReaderP (nat (unReaderP p i)) i)---- | 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-{-# INLINABLE runReaderP #-}---- | 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)-{-# INLINABLE runReaderK #-}---- | Get the environment-ask :: (Monad m, Proxy p) => ReaderP i p a' a b' b m i-ask = ReaderP return_P-{-# INLINABLE ask #-}---- | Get a function of the environment-asks :: (Monad m, Proxy p) => (i -> r) -> ReaderP i p a' a b' b m r-asks f = ReaderP (\i -> return_P (f i))-{-# INLINABLE asks #-}---- | 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-{-# INLINABLE local #-}---- | 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))-{-# INLINABLE withReaderP #-}
− Control/Proxy/Trans/State.hs
@@ -1,196 +0,0 @@--- | This module provides the proxy transformer equivalent of 'StateT'.--{-# LANGUAGE KindSignatures #-}--module Control.Proxy.Trans.State (- -- * StateP- StateP(..),- state,- stateT,- 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.Morph (MFunctor(hoist))-import Control.Monad.Trans.Class (MonadTrans(lift))-import Control.Proxy.Class (- Proxy(request, respond, (->>), (>>~), (>\\), (//>), turn),- ProxyInternal(return_P, (?>=), lift_P, liftIO_P, hoist_P, thread_P),- MonadPlusP(mzero_P, mplus_P) )-import Control.Proxy.Morph (PFunctor(hoistP))-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', s) (a, s) (b', s) (b, s) m (r, s) }--instance (Monad m, Proxy p) => 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) )--instance (Monad m, Proxy p) => 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 (Monad m, Proxy p) => Monad (StateP s p a' a b' b m) where- return = return_P- (>>=) = (?>=)--instance (Proxy p) => MonadTrans (StateP s p a' a b' b) where- lift = lift_P--instance (Proxy p) => MFunctor (StateP s p a' a b' b) where- hoist = hoist_P--instance (MonadIO m, Proxy p) => MonadIO (StateP s p a' a b' b m) where- liftIO = liftIO_P--instance (Monad m, MonadPlusP p) => Alternative (StateP s p a' a b' b m) where- empty = mzero- (<|>) = mplus--instance (Monad m, MonadPlusP p) => MonadPlus (StateP s p a' a b' b m) where- mzero = mzero_P- mplus = mplus_P--instance (Proxy p) => ProxyInternal (StateP s p) where- 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))-- liftIO_P m = StateP (\s -> liftIO_P (m >>= \r -> return (r, s)))-- thread_P p s = StateP (\s' ->- ((up ->> thread_P (unStateP p s') s) >>~ dn) ?>= next )- where- up ((a', s1), s2) =- request ((a', s2 ), s1 ) ?>= \((a , s1'), s2') ->- respond ((a , s2'), s1') ?>= up- dn ((b , s1), s2) =- respond ((b , s2 ), s1 ) ?>= \((b', s1'), s2') ->- request ((b', s2'), s1') ?>= dn- next ((r, s1), s2) = return_P ((r, s2), s1)--instance (Proxy p) => Proxy (StateP s p) where- fb' ->> p = StateP (\s ->- (\(b', s') -> unStateP (fb' b') s') ->> unStateP p s)- p >>~ fb = StateP (\s ->- unStateP p s >>~ (\(b, s') -> unStateP (fb b) s') )- request = \a' -> StateP (\s -> request (a', s))- respond = \b -> StateP (\s -> respond (b , s))-- fb' >\\ p = StateP (\s ->- (\(b', s') -> unStateP (fb' b') s') >\\ unStateP p s)- p //> fb = StateP (\s ->- unStateP p s //> (\(b, s') -> unStateP (fb b) s') )-- turn p = StateP (\s -> turn (unStateP p s))--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 ProxyTrans (StateP s) where- liftP m = StateP (thread_P m)--instance PFunctor (StateP s) where- hoistP nat p = StateP (\s -> nat (unStateP p s))---- | Convert a State to a 'StateP'-state :: (Monad m, Proxy p) => (s -> (r, s)) -> StateP s p a' a b' b m r-state f = StateP (\s -> return_P (f s))-{-# INLINABLE state #-}---- | Convert a StateT to a 'StateP'-stateT :: (Monad m, Proxy p) => (s -> m (r, s)) -> StateP s p a' a b' b m r-stateT f = StateP (\s -> lift_P (f s))-{-# INLINABLE stateT #-}---- | Run a 'StateP' computation, producing the final result and state-runStateP- :: (Monad m, Proxy p)- => s -> StateP s p a' a b' b m r -> p a' a b' b m (r, s)-runStateP s0 m = up >\\ unStateP m s0 //> dn- where- up (a', s) =- request a' ?>= \a ->- return_P (a , s)- dn (b , s) =- respond b ?>= \b' ->- return_P (b', s)-{-# INLINABLE runStateP #-}---- | Run a 'StateP' \'@K@\'leisli arrow, procuding the final result and state-runStateK- :: (Monad m, Proxy p)- => s -> (q -> StateP s p a' a b' b m r) -> (q -> p a' a b' b m (r, s))-runStateK s k q = runStateP s (k q)-{-# INLINABLE runStateK #-}---- | Evaluate a 'StateP' computation, but discard the final state-evalStateP- :: (Monad m, Proxy p) => s -> StateP s p a' a b' b m r -> p a' a b' b m r-evalStateP s p = runStateP s p ?>= \(r, _) -> return_P r-{-# INLINABLE evalStateP #-}---- | Evaluate a 'StateP' \'@K@\'leisli arrow, but discard the final state-evalStateK- :: (Monad m, Proxy p)- => 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)-{-# INLINABLE evalStateK #-}---- | Evaluate a 'StateP' computation, but discard the final result-execStateP- :: (Monad m, Proxy p) => s -> StateP s p a' a b' b m r -> p a' a b' b m s-execStateP s p = runStateP s p ?>= \(_, s') -> return_P s'-{-# INLINABLE execStateP #-}---- | Evaluate a 'StateP' \'@K@\'leisli arrow, but discard the final result-execStateK- :: (Monad m, Proxy p)- => 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)-{-# INLINABLE execStateK #-}---- | Get the current state-get :: (Monad m, Proxy p) => StateP s p a' a b' b m s-get = StateP (\s -> return_P (s, s))-{-# INLINABLE get #-}---- | Set the current state-put :: (Monad m, Proxy p) => s -> StateP s p a' a b' b m ()-put s = StateP (\_ -> return_P ((), s))-{-# INLINABLE put #-}---- | Modify the current state using a function-modify :: (Monad m, Proxy p) => (s -> s) -> StateP s p a' a b' b m ()-modify f = StateP (\s -> return_P ((), f s))-{-# INLINABLE modify #-}---- | Get the state filtered through a function-gets :: (Monad m, Proxy p) => (s -> r) -> StateP s p a' a b' b m r-gets f = StateP (\s -> return_P (f s, s))-{-# INLINABLE gets #-}
− Control/Proxy/Trans/Writer.hs
@@ -1,195 +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,- writer,- writerT,- 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.Morph (MFunctor(hoist))-import Control.Monad.Trans.Class (MonadTrans(lift))-import Control.Proxy.Class (- Proxy(request, respond, (->>), (>>~), (>\\), (//>), turn),- ProxyInternal(return_P, (?>=), lift_P, liftIO_P, hoist_P, thread_P),- MonadPlusP(mzero_P, mplus_P) )-import Control.Proxy.Morph (PFunctor(hoistP))-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', w) (a, w) (b', w) (b, w) m (r, w) }--instance (Monad m, Proxy p) => 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 (Monad m, Proxy p) => 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) )--instance (Monad m, Proxy p) => Monad (WriterP w p a' a b' b m) where- return = return_P- (>>=) = (?>=)--instance (Proxy p) => MonadTrans (WriterP w p a' a b' b) where- lift = lift_P--instance (Proxy p) => MFunctor (WriterP w p a' a b' b) where- hoist = hoist_P--instance (MonadIO m, Proxy p) => MonadIO (WriterP w p a' a b' b m) where- liftIO = liftIO_P--instance (Monad m, MonadPlusP p) => Alternative (WriterP w p a' a b' b m) where- empty = mzero- (<|>) = mplus--instance (Monad m, MonadPlusP p) => MonadPlus (WriterP w p a' a b' b m) where- mzero = mzero_P- mplus = mplus_P--instance (Proxy p) => ProxyInternal (WriterP w p) where- 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))-- liftIO_P m = WriterP (\w -> liftIO_P (m >>= \r -> return (r, w)))-- thread_P p w = WriterP (\w' ->- ((up ->> thread_P (unWriterP p w') w) >>~ dn) ?>= next )- where- up ((a', w1), w2) =- request ((a', w2 ), w1 ) ?>= \((a , w1'), w2') ->- respond ((a , w2'), w1') ?>= up- dn ((b , w1), w2) =- respond ((b , w2 ), w1 ) ?>= \((b', w1'), w2') ->- request ((b', w2'), w1') ?>= dn- next ((r, w1), w2) = return_P ((r, w2), w1)--instance (Proxy p) => Proxy (WriterP w p) where- fb' ->> p = WriterP (\w ->- (\(b', w') -> unWriterP (fb' b') w') ->> unWriterP p w )- p >>~ fb = WriterP (\w ->- unWriterP p w >>~ (\(b, w') -> unWriterP (fb b) w') )-- request = \a' -> WriterP (\w -> request (a', w))- respond = \b -> WriterP (\w -> respond (b , w))-- fb' >\\ p = WriterP (\w ->- (\(b', w') -> unWriterP (fb' b') w') >\\ unWriterP p w )- p //> fb = WriterP (\w ->- unWriterP p w //> (\(b, w') -> unWriterP (fb b) w') )-- turn p = WriterP (\w -> turn (unWriterP p w))--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 ProxyTrans (WriterP w) where- liftP m = WriterP (thread_P m)--instance PFunctor (WriterP w) where- hoistP nat p = WriterP (\s -> nat (unWriterP p s))---- | Convert a Writer to a 'WriterP'-writer :: (Monad m, Proxy p, Monoid w) => (r, w) -> WriterP w p a' a b' b m r-writer x = writerP (return_P x)-{-# INLINABLE writer #-}---- | Convert a WriterT to a 'WriterP'-writerT :: (Monad m, Proxy p, Monoid w) => m (r, w) -> WriterP w p a' a b' b m r-writerT m = writerP (lift_P m)-{-# INLINABLE writerT #-}---- | Create a 'WriterP' from a proxy that generates a result and a monoid-writerP- :: (Monad m, Proxy p, Monoid w)- => p a' a b' b m (r, w) -> WriterP w p a' a b' b m r-writerP p = WriterP (\w ->- thread_P p w ?>= \((r, w2), w1) ->- let w' = mappend w1 w2- in w' `seq` return_P (r, w') )-{-# INLINABLE writerP #-}---- | Run a 'WriterP' computation, producing the final result and monoid-runWriterP- :: (Monad m, Proxy p, Monoid w)- => WriterP w p a' a b' b m r -> p a' a b' b m (r, w)-runWriterP p = up >\\ unWriterP p mempty //> dn- where- up (a', w) =- request a' ?>= \a ->- return_P (a , w)- dn (b , w) =- respond b ?>= \b' ->- return_P (b', w) -{-# INLINABLE runWriterP #-}---- | Run a 'WriterP' \'@K@\'leisli arrow, producing the final result and monoid-runWriterK- :: (Monad m, Proxy p, 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)-{-# INLINABLE runWriterK #-}---- | Evaluate a 'WriterP' computation, but discard the final result-execWriterP- :: (Monad m, Proxy p, 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-{-# INLINABLE execWriterP #-}---- | Evaluate a 'WriterP' \'@K@\'leisli arrow, but discard the final result-execWriterK- :: (Monad m, Proxy p, 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)-{-# INLINABLE execWriterK #-}---- | Add a value to the monoid-tell :: (Monad m, Proxy p, 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''))-{-# INLINABLE tell #-}---- | Modify the result of a writer computation-censor- :: (Monad m, Proxy p, 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) )-{-# INLINABLE censor #-}
− Control/Proxy/Tutorial.hs
@@ -1,2270 +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.-- I've condensed all the code examples into a self-contained code block in the- Appendix section that you can use to follow along.--}--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-- -- * Sequencing Proxies- -- $mixmonadcomp-- -- * ListT- -- $listT-- -- * Resource Management- -- $resource-- -- * Extensions- -- $extend-- -- ** Error handling- -- $error-- -- ** Folds- -- $folds-- -- ** State- -- $state-- -- * Branching, zips, and merges- -- $branch-- -- * Mixing Proxies- -- $proxytrans-- -- * Proxy Morphism Laws- -- $proxymorph-- -- * Functors on Proxies- -- $proxyfunctor-- -- * Conclusion- -- $conclusion-- -- * Appendix- -- $appendix- ) where---- For documentation-import Control.Category (Category)-import Control.Monad.Morph (MFunctor(hoist))-import Control.Monad.Trans.Class (MonadTrans(lift))-import Control.Proxy-import Control.Proxy.Core.Correct (ProxyCorrect)-import Control.Proxy.Trans.Either--{- $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, or-- * 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 ()-> 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-> lines' h >-> printer :: (Proxy p) => () -> Session p IO ()->-> promptInt >-> printer :: (Proxy p) => () -> Session p IO r-- ('>->') 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" ReadMode $ \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' and never 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' requests and- responds with 'Bool's:--> -- 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 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 can reuse the same 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, 'Pipe'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 'Proxy' that auto-forwards values both ways, beginning- from its upstream interface:--> pull :: (Monad m, Proxy p) => a' -> p a' a a' a m r-> pull = runIdentityK loop where-> loop a' = do-> a <- request a'-> a'2 <- respond a-> loop a'2->-> -- or: pull = runIdentityK $ foreverK $ request >=> respond-> -- = runIdentityK $ request >=> respond >=> request >=> respond ...-- Diagramatically, this looks like:--> +------+-> | |-> a' <========= a' <- All values pass-> | pull | straight through-> a =========> a <- immediately-> | |-> +------+-- 'pull' is completely invisible to composition, meaning that:--> pull >-> p = p->-> p >-> pull = p-- In other words, 'pull' is an identity of composition.-- This means that proxies form a true 'Category' where ('>->') is composition- and 'pull' 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 and the morphisms are the proxies.-- These 'Category' laws guarantee the following important properties:-- * You can reason about each proxy's behavior independently of other proxies- (otherwise composition wouldn't be associative)-- * You don't encounter weird behavior at the interface between two components- or at the 'Server' or 'Client' ends of a 'Session' (otherwise 'pull'- wouldn't be an identity)--}--{- $class- All the proxy code we wrote was generic over the 'Proxy' type class, which- defines the library's central API. This type class actually defines four- separate categories that all proxies obey! Each category has an identity- operation:-- * 'request': The identity of the \"request\" composition-- * 'respond': The identity of the \"respond\" composition-- * 'pull': The identity of pull-based composition-- * 'push': The identity of push-based composition-- ... and each category has a composition operation:-- * ('\>\'): \"request\" composition-- * ('/>/'): \"respond\" composition-- * ('>->'): pull-based composition-- * ('>~>'): push-based composition-- However, the 'Proxy' type class actually defines the \"pointful\" versions- of these composition operator for efficiency reasons:-- * ('->>'): \"Pointful\" version of ('>->')-- * ('>>~'): \"Pointful\" version of ('>~>')-- * ('>\\'): \"Pointful\" version of ('\>\')-- * ('//>'): \"Pointful\" version of ('/>/')-- For now I will only cover pull-based composition for simplicity, but just- keep these other categories in the back of your mind. If you ever struggle- with the pull-based category, chances are that an elegant solution resides- within one of the other three categories.-- @pipes@ defines everything in terms of these four categories, which is- why all the library's utilities are generic 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 -- Correct by construction-- 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, meaning that it requires no implementation- hiding.-- 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 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 downstream-> 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" 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 pull = pull-- ... 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: 'pull'.-- 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" 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) -- from the "safe" package->-> 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 an 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 @mmorph@- package, which transforms the base monad of any monad transformer that- implements 'MFunctor'. Since all proxies implement 'MFunctor' you can use- 'hoist' from 'MFunctor' 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 an Integer"-- Also, note that ('.') has higher precedence than ('>->'), so you can drop- the parentheses:-->>> runEitherT $ runProxy $ promptInt2 >-> hoist lift . printer-...-- For more information on using 'MFunctor', consult the tutorial in the- @Control.Monad.Morph@ module from the @mmorph@ package.--}--{- $utilities- "Control.Proxy.Prelude" 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:--> readLnS :: (Proxy p, Read a) => () -> Producer p a IO r-- ... so we can read 'Int's just by specializing its type:--> 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@ values 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 IO ()-> 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 'stdinS':--> stdinS :: (Proxy p) => () -> 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 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) => () -> Pipe p Int Int IO ()-> sink1 () = runIdentityP $ 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) => () -> Pipe p Int Int IO ()-> sink2 = intermediate >-> printD where-> intermediate () = runIdentityP $ 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 two possible ways to combine proxies:-- * \"Vertical\" composition, using ('>=>') from the Kleisli category-- * \"Horizontal\" composition: using ('>->') from the Proxy category-- You can assemble many proxies simply by composing them in one or both of- these two categories.--}--{- $listT- Proxies generalize lists by allowing you to interleave effects between list- elements, but you might be surprised to learn that they also generalize the- list monad, too! You can convert back and forth between proxies and- @ListT@-like monad transformers that bind proxy outputs at either end.-- For example, let's say that we want to select elements from two separate- lists, except interleaving side effects, too:--> -- +-- ListT that will compile to a 'Producer'-> -- |-> -- v-> pairs :: (Proxy p) => () -> ProduceT p IO (Int, Int)-> pairs () = do-> x <- rangeS 1 3 -- Select a number betwen 1 and 3-> lift $ putStrLn $ "Currently using: " ++ show x-> y <- eachS [4,6,8] -- Select one of 4, 6, or 8-> return (x, y)-- We can compile the above 'ProduceT' code to a 'Producer' using- 'runRespondK':--> -- runRespondK's type is actually more general-> runRespondK :: (() -> ProduceT p m b) -> () -> Producer p b m ()->-> runRespondK pairs :: (Proxy p) => () -> Producer p (Int, Int) IO ()-- The return value of the 'ProduceT' becomes the output of the corresponding- 'Producer', which produces one output for each permutation of elements that- we could have selected:-->>> runProxy $ runRespondK pairs >-> printD-Currently using: 1-(1,4)-(1,6)-(1,8)-Currently using: 2-(2,4)-(2,6)-(2,8)-Currently using: 3-(3,4)-(3,6)-(3,8)-- This works the other way around, too! You can wrap any 'Producer' in the- 'RespondT' newtype to bind its output in the 'ProduceT' monad:--> pairs2 :: (Proxy p) => () -> ProduceT p IO (Int, Int)-> pairs2 () = do-> x <- RespondT $ runIdentityP $ do-> respond 1-> lift $ putStrLn "Here"-> respond 2-> y <- RespondT $ runIdentityP $ do-> respond 3-> lift $ putStrLn "There"-> respond 4-> return (x, y)-->>> runProxy $ runRespondK pairs2 >-> printD-(1,3)-There-(1,4)-Here-(2,3)-There-(2,4)-- In fact, this is how 'eachS' and 'rangeS' are implemented:--> eachS :: (Monad m, Proxy p) => [b] -> ProduceT p m b-> eachS xs = RespondT (fromList xs ())->-> rangeS :: (Enum b, Monad m, Ord b, Proxy p) => b -> b -> ProduceT p m b-> rangeS n1 n2 = RespondT (enumFromS n1 n2 ())-- 'ProduceT' is actually a special case of 'RespondT', related by the- following type synonym:--> type ProduceT p = RespondT p C () ()-- This more general 'RespondT' monad lets you bind more general things than- 'Producer's. For example, you can bind 'Pipe' outputs this way:--> pairs3 :: (Proxy p) => () -> RespondT p () Int () IO (Int, Int)-> pairs3 () = do-> x <- RespondT $ runIdentityP $ replicateM_ 2 $ do-> a <- request ()-> lift $ putStrLn $ "Received " ++ show a-> respond a-> y <- RespondT $ runIdentityP $ replicateM_ 3 $ do-> a <- request ()-> lift $ putStrLn $ "Received " ++ show a-> respond a-> return (x, y)-- ... and you will get a 'Pipe' back when you 'runRespondK' the final result:--> runRespondK pairs3 :: Proxy p => () -> Pipe p Int (Int, Int) IO ()-->>> runProxy $ enumFromS 1 >-> runRespondK pairs3 >-> printD-Received 1-Received 2-(1,2)-Received 3-(1,3)-Received 4-(1,4)-Received 5-Received 6-(5,6)-Received 7-(5,7)-Received 8-(5,8)-- Proxies actually form two symmetric 'ListT'-like monad transformers: one- binds elements output from the proxy's downstream interface and one binds- elements output from the proxy's upstream interface. To distinguish them,- I call the downstream one 'RespondT' and the upstream one 'RequestT'.-- Remember how I said there were three extra categories? Well, two of them- directly correspond to the 'RespondT' and 'RequestT' monds:-- * ('\>\') and 'request': Equivalent to ('<=<') and 'return' for 'RequestT'-- * ('/>/') and 'respond': Equivalent to ('>=>') for 'return' for 'RespondT'-- In other words, two of the 'Proxy' categories are 'ListT' Kleisli- categories in disguise!-- 'RequestT' and 'RespondT' are correct by construction, meaning that they- always satisfy the monad and monad transformer laws without exception,- unlike 'ListT' from @transformers@. In other words, they behave like two- symmetric implementations of \"ListT done right\".--}--{- $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':--> readFileS :: () -> FilePath -> () -> Producer p String IO ()-> readFileS 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 $ readFileS "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 $ readFileS "test.txt" >-> return--- Outputs nothing-- But it gives exactly the wrong behavior if we partially demand the file:-->>> runProxy $ readFileS "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 @readFileS@ does not get a chance to- finalize the file.-- The @pipes-safe@ library solves this problem by providing resource- management abstractions built on top of @pipes@ and offers several other- nice features:-- * It is completely exception safe, even against asynchronous exceptions-- * It is backwards compatible with \"unmanaged\" ordinary proxies-- Backwards compatibility means that you don't need to buy in to the- @pipes-safe@ way of doing things. This matters because another common- approach is to just open 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 might write:--> cp :: FilePath -> FilePath -> IO ()-> cp inFile outFile =-> withFile inFile ReadMode $ \hIn ->-> withFile outFile WriteMode $ \hOut ->-> runProxy $ hGetLineS hIn >-> hPutStrLnD hOut-- Some people prefer that approach because it:-- * is straightforward, and-- * can reuse functions from @Control.Exception@-- The disadvantage is that this does not lazily allocate resources, nor does- this promptly deallocate them. Also, there is no way to recover from- exceptions and resume the 'Session'. On the other hand, @pipes-safe@ lets- you do all of these.-- Fortunately, you can choose whichever approach you prefer and rest assured- that the two approaches safely interoperate. @Control.Proxy.Safe.Tutorial@- from the @pipes-safe@ package provides a separate tutorial on how to:-- * extend @pipes@ with resource management,-- * handle exceptions natively within proxies, and-- * interoperate with unmanaged code.--}--{- $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', and 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 an Integer"-> Just n -> respond n-- There is no way to recover from the error and resume streaming data. You- can only handle the '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 an 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 $ E.runEitherK $ promptInt3 >-> printer :: IO (Either String r)-Enter an Integer:-Hello<Enter>-Left "Could not read an 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 'E.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 an 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 locally on a subset of the pipeline like so:-->>> runProxy $ (E.runEitherK $ heartbeat . promptInt3 >-> takeB_ 2) >-> printer--}--{- $folds- You can fold a stream of values using the 'WriterP' proxy transformer.--> import qualified Control.Proxy.Trans.Writer as W-- "Control.Proxy.Prelude" provides several common folds implemented this- way, such as:-- * 'lengthD': Count how many values flow downstream--> lengthD :: (Monad m, Proxy p) => x -> W.WriterP (Sum Int) p x a x a m r-- * 'toListD': Fold the values flowing downstream into a list.--> toListD :: (Monad m, Proxy p) => x -> W.WriterP [a] p x a x a m r-- * 'anyD': Determine whether any values satisfy the predicate--> anyD :: (Monad m, Proxy p) => (a -> Bool) -> x -> W.WriterP Any p x a x a m r-- Now, let's try these folds out and see if we can build a list from user- input:-->>> runProxy $ W.runWriterK $ promptInt >-> takeB_ 3 >-> toListD-Enter an Integer:-1<Enter>-Enter an Integer:-66<Enter>-Enter an Integer:-5<Enter>-((),[1,66,5])-- You can insert these folds anywhere in the middle of a pipeline and they- still work:-->>> runProxy $ W.runWriterK $ fromListS [5, 7, 4] >-> lengthD >-> printD-5-7-4-((),Sum {getSum = 3})-- You can also run multiple folds at the same time just by adding more- 'WriterP' layers to your proxy transformer stack. You can use 'liftP'- (see \"Proxy Transformers\" below) to mix these two folds together:--> fromListS [9, 10] >-> anyD even >-> liftP . sumD-> :: (Monad m, Proxy p)-> => () -> Producer (W.WriterP Any (W.WriterP (Sum Int) p)) c m ()-- Then you just run both 'WriterP' layers:-->>> runProxy $ W.runWriterK $ W.runWriterK $ fromListS [9, 10] >-> anyD even >-> mapP 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 -> W.WriterP (First a) p x a x a m ()-->>> runProxy $ runWriterK $ fromListS [3, 4, 9] >-> printD >-> headD_-3-((),First {getFirst = Just 3})-- Compare this to 'headD' without underscore, which folds the entire input:-->>> runProxy $ W.runWriterK $ fromListS [3, 4, 9] >-> 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.--}--{- $state- The 'StateP' proxy lets you embed 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.modify (+1)-- We could then embed it into any 'Proxy', such as the following ones:--> 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-- The state is shared across connected proxies, and we can prove this by- composing two 'StateP' proxies. Let's define a stateful consumer:--> increment2 :: (Proxy p) => () -> Consumer (S.StateP Int p) Int IO r-> increment2 () = forever $ do-> nTheirs <- request ()-> S.modify (+2)-> nOurs <- S.get-> lift $ print (nTheirs, nOurs)-- .. and hook it up directly to @increment@:-->>> runProxy $ S.evalStateK 0 $ increment >-> takeB_ 3 >-> increment2-(0,2)-(3,5)-(6,8)---}--{- $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 (Producer 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 (EitherP String p) Int IO r->-> increment2 :: (Proxy p) => () -> Consumer (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-- It's very easy to use. Just use 'liftP' to lift one proxy transformer to- match another one. For example, we can 'liftP' @increment2@ to match- @promptInt3@:--> promptInt3-> :: (Proxy stateP)-> => () -> Producer (EitherP String stateP ) Int IO r->-> liftP . increment2-> :: (Proxy p, ProxyTrans eitherP)-> => () -> Consumer (eitherP (StateP Int p)) Int IO r->-> promptInt3 >-> liftP . increment2-> :: (Proxy p)-> => () -> Session (EitherP String (StateP Int p)) IO r-- 'liftP' creates a new 'ProxyTrans' layer that type-checks as 'EitherP', and- @StateP Int p@ type-checks as the 'Proxy' in @promptInt3@'s signature.-->>> 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 an Integer"-- ... or we could instead 'liftP' @promptInt3@ to match @increment2@ and switch- the order of the two proxy transformers:--> liftP . promptInt3-> :: (Proxy p, ProxyTrans stateP)-> => () -> Producer (stateP (EitherP String p)) Int IO r->-> increment2-> :: (Proxy eitherP)-> => () -> Consumer (StateP Int eitherP ) Int IO r->-> liftP . promptInt3 >-> increment2-> :: (Proxy p)-> => () -> Session (StateP Int (EitherP String p)) IO r-- 'liftP' creates a new 'ProxyTrans' layer that type-checks as 'StateP', and- @EitherP Int p@ type-checks as the 'Proxy' in @increment2@'s signature.-->>> 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 an Integer"-- Like monad transformers, proxy transformers lift a base 'Monad' instance- to an extended 'Monad' instance and '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'.-- This means you can seamlessly mix effects from different proxy transformer- layers just by using 'liftP' to access inner layers:--> twoLayers-> :: (Proxy p)-> => () -> Consumer (E.EitherP String (S.StateP Int p)) Int IO r-> twoLayers () = forever $ do-> a <- request ()-> if (a >= 0)-> then liftP $ S.modify (+ a)-> else E.throw "Negative number"-->>> runProxy $ S.runStateK 0 $ E.runEitherK $ fromListS [1, 2, -4] >-> twoLayers-(Left "Negative number",3)-- This exactly resembles how you use 'lift' to access inner layers of a monad- transformer stack.--}--{- $proxymorph- Monad transformers impose certain laws to ensure that 'lift' behaves- correctly. These are known as the \"monad morphism 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 -- These are functor laws!->-> liftP . 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 morphism laws\":--> liftP . (f >-> g) = liftP . f >-> liftP . g -- These are functor laws, too!->-> liftP . pull = pull-- 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 we know that proxies also form three other- categories, so we expect 'liftP' to correctly lift those categories, too:--> liftP . (f >~> g) = liftP . f >~> liftP . g->-> liftP . push = push--> liftP . (f \>\ g) = liftP . f \>\ liftP . g->-> liftP . request = request--> liftP . (f />/ g) = liftP . f />/ liftP . g->-> liftP . respond = respond-- I want to highlight two of the above laws:--> liftP . request = request->-> liftP . respond = respond-- The \"pointful\" statement of those laws is:--> 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 these proxy morphism laws,- which ensures that 'liftP' always does \"the right thing\".--}--{- $proxyfunctor- Proxy transformers also implement 'hoistP' from the 'PFunctor' class in- "Control.Proxy.Morph". This exactly parallels 'hoist' from- @Control.Monad.Morph@.-- You will most commonly use 'hoistP' to insert arbitrary proxy transformer- layers to get two mismatched proxy transformer stacks to type-check.-- For example, consider the following two very different proxy transformer- stacks:--> p1 :: (Monad m, Proxy p) => a' -> StateP s (ReaderP i p) a' a a' a m a'-> p2 :: (Monad m, Proxy p) => a' -> MaybeP (WriterP w p) a' a a' a m a'-- I can normalize them to use same proxy transformer stack by judiciously- inserting extra proxy transformer layers using a combination of 'hoistP'- and 'liftP':--> p1' :: (Monad m, Proxy p)-> => a' -> StateP s (MaybeP (ReaderP i (WriterP w p))) a' a a' a m a'-> p1' = hoistP liftP . p1->-> p2' :: (Monad m, Proxy p)-> => a' -> StateP s (MaybeP (ReaderP i (WriterP w p))) a' a a' a m a'-> p2' = liftP . hoistP liftP . p2-- Now that I've made them agree on a common proxy transformer stack, I can- sequence them or compose them:--> pSequence-> :: (Proxy p)-> => a' -> StateP s (MaybeP (ReaderP i (WriterP w p))) a' a a' a m a'-> pSequence = p1' >=> p2'->-> pCompose-> :: (Proxy p)-> => a' -> StateP s (MaybeP (ReaderP i (WriterP w p))) a' a a' a m a'-> pCompose = p1' >-> p2'--}--{- $conclusion- The @pipes@ library implements all functionality using theoretically- inspired abstractions:-- * Monads, Monad Transformers, and Functors on Monads-- * Proxies, Proxy Transformers, and Functors on Proxies-- 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.--}---- $appendix--- I've provided the full code for the above examples here so you can easily--- play with the examples yourself:------ > import Control.Monad--- > import Control.Proxy hiding (zipD)--- > import System.IO--- > import qualified Data.Map as M--- > import Control.Monad.Trans.Either--- > import Safe (readMay)--- > import qualified Control.Proxy.Trans.Either as E--- > import qualified Control.Proxy.Trans.State as S--- >--- > lines' :: (Proxy p) => Handle -> () -> Producer p String IO ()--- > 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--- >--- > 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--- > {---- > promptInt = readLnS >-> execU (putStrLn "Enter an Integer:")--- > -}--- >--- > 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--- > {---- > printer :: (Proxy p, Show a) => x -> p x a x a IO r--- > printer = execD (putStrLn "Received a value:") >-> printD--- > -}--- >--- > take' :: (Proxy p) => Int -> () -> Pipe p a a IO ()--- > 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!"--- >--- > 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 "*"--- >--- > comparer :: (Proxy p) => Int -> Server p Int Bool IO r--- > comparer = runIdentityK $ foreverK $ \argument -> do--- > lift $ putStrLn $ "Server Receives: " ++ show argument--- > let result = argument > 2--- > lift $ putStrLn $ "Server Sends: " ++ show result--- > respond result--- >--- > 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--- >--- > 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 downstream--- > lift $ print 4--- >--- > 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 an Integer"--- > Just n -> respond n--- >--- > readIntS :: (Proxy p) => () -> Producer p Int IO r--- > readIntS = readLnS--- >--- > source1 :: (Proxy p) => () -> Producer p Int IO r--- > source1 () = runIdentityP $ do--- > fromListS [4, 4] () -- Source 1--- > readLnS () -- Source 2--- >--- > source2 :: (Proxy p) => () -> Producer p Int IO ()--- > source2 () = runIdentityP $ do--- > fromListS [4, 4] ()--- > (readLnS >-> takeB_ 3) () -- You can compose inside a do block!--- >--- > sink1 :: (Proxy p) => () -> Pipe p Int Int IO ()--- > sink1 () = runIdentityP $ do--- > (takeB_ 3 >-> printD) () -- Sink 1--- > (takeWhileD (< 4) >-> printD) () -- Sink 2--- >--- > sink2 :: (Proxy p) => () -> Pipe p Int Int IO ()--- > sink2 = intermediate >-> printD where--- > intermediate () = runIdentityP $ do--- > takeB_ 3 () -- Intermediate stage 1--- > takeWhileD (< 4) () -- Intermediate stage 2--- >--- > pairs :: (Proxy p) => () -> ProduceT p IO (Int, Int)--- > pairs () = do--- > x <- rangeS 1 3 -- Select a number betwen 1 and 3--- > lift $ putStrLn $ "Currently using: " ++ show x--- > y <- eachS [4,6,8] -- Select one of 4, 6, or 8--- > return (x, y)--- >--- > pairs2 :: (Proxy p) => () -> ProduceT p IO (Int, Int)--- > pairs2 () = do--- > x <- RespondT $ runIdentityP $ do--- > respond 1--- > lift $ putStrLn "Here"--- > respond 2--- > y <- RespondT $ runIdentityP $ do--- > respond 3--- > lift $ putStrLn "There"--- > respond 4--- > return (x, y)--- >--- > pairs3 :: (Proxy p) => () -> RespondT p () Int () IO (Int, Int)--- > pairs3 () = do--- > x <- RespondT $ runIdentityP $ replicateM_ 2 $ do--- > a <- request ()--- > lift $ putStrLn $ "Received " ++ show a--- > respond a--- > y <- RespondT $ runIdentityP $ replicateM_ 3 $ do--- > a <- request ()--- > lift $ putStrLn $ "Received " ++ show a--- > respond a--- > return (x, y)--- >--- > readFileS :: (Proxy p) => FilePath -> () -> Producer p String IO ()--- > readFileS file () = runIdentityP $ do--- > h <- lift $ openFile file ReadMode--- > lift $ putStrLn "Opening file"--- > hGetLineS h ()--- > lift $ putStrLn "Closing file"--- > lift $ hClose h--- >--- > cp :: FilePath -> FilePath -> IO ()--- > cp inFile outFile =--- > withFile inFile ReadMode $ \hIn ->--- > withFile outFile WriteMode $ \hOut ->--- > runProxy $ hGetLineS hIn >-> hPutStrLnD hOut--- >--- > promptInt3 :: (Proxy p) => () -> Producer (E.EitherP String p) Int IO r--- > promptInt3 () = forever $ do--- > str <- lift $ do--- > putStrLn "Enter an Integer:"--- > getLine--- > case readMay str of--- > Nothing -> E.throw "Could not read an Integer"--- > Just n -> respond n--- >--- > 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'--- >--- > increment :: (Monad m, Proxy p) => () -> Producer (S.StateP Int p) Int m r--- > increment () = forever $ do--- > n <- S.get--- > respond n--- > S.modify (+1)--- >--- > 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!--- >--- > increment2 :: (Proxy p) => () -> Consumer (S.StateP Int p) Int IO r--- > increment2 () = forever $ do--- > nTheirs <- request ()--- > S.modify (+2)--- > nOurs <- S.get--- > lift $ print (nTheirs, nOurs)--- >--- > 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) $ 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'--- >--- > p1 = runProxyK $ zipD <-< fromListS [1..3]--- > p2 = runProxyK $ p1 <-< fromListS [4..]--- > p3 = runProxy $ printD <-< p2--- >--- > 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'--- >--- > {---- > p1 = runProxyK $ fork <-< fromListS [1..3]--- > p2 = runProxyK $ raiseK printD <-< mapD (> 2) <-< p1--- > p3 = runProxy $ printD <-< mapD show <-< p2--- > -}--- >--- > {---- > p1 = runProxyK $ S.evalStateK 0 $ fork <-< increment--- > p2 = runProxyK $ raiseK printD <-< mapD (+ 10) <-< p1--- > p3 = runProxy $ E.runEitherK $ printD <-< (takeB_ 3 >=> E.throw) <-< p2--- > -}--- >--- > twoLayers--- > :: (Proxy p)--- > => () -> Consumer (E.EitherP String (S.StateP Int p)) Int IO r--- > twoLayers () = forever $ do--- > a <- request ()--- > if (a >= 0)--- > then liftP $ S.modify (+ a)--- > else E.throw "Negative number"
+ benchmarks/LiftBench.hs view
@@ -0,0 +1,100 @@+{-# LANGUAGE RankNTypes #-}+module Main (main) where++import Common (commonMain)+import Control.DeepSeq+import Control.Monad.Identity+import qualified Control.Monad.Trans.Reader as R+import qualified Control.Monad.Trans.State.Strict as S+import qualified Control.Monad.Trans.Writer.Strict as W+import qualified Control.Monad.Trans.RWS.Strict as RWS+import Criterion.Main+import Data.Monoid+import Pipes+import Pipes.Lift++defaultMax :: Int+defaultMax = 1000000++instance NFData a => NFData (Sum a)++main :: IO ()+main = commonMain defaultMax liftBenchmarks++iter :: forall m a . (Monad m , Ord a, Num a) => (a -> m a) -> a -> Effect m a+iter a vmax = loop 0+ where+ loop n+ | n > vmax = return vmax+ | otherwise = do+ x <- lift $ a n+ loop $! x++s_bench :: Int -> Effect (S.StateT Int Identity) Int+s_bench = iter (\n -> S.get >>= (\a -> S.put $! a + n) >> return (n + 1))++w_bench :: Int -> Effect (W.WriterT (Sum Int) Identity) Int+w_bench = iter (\n -> (W.tell $! Sum n) >> return (n + 1))++r_bench :: Int -> Effect (R.ReaderT Int Identity) Int+r_bench = iter (\n -> R.ask >>= (\a -> return $ n + a))++rwsp_bench :: Int -> Effect (RWS.RWST Int (Sum Int) Int Identity) Int+rwsp_bench = iter act+ where+ act n = do+ x <- RWS.ask+ RWS.tell (Sum n)+ s <- RWS.get+ RWS.put $! (s + n)+ return $ n + x++-- 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)+ ]+ , bgroup "WriterT" $ applyBench+ [+ -- Running WriterP after runEffect will space leak.+ bench "runWriterP_B" . nf (runB runWriterP . w_bench)+ , bench "execWriterP_B" . nf (runB execWriterP . w_bench)+ ]+ , bgroup "RWSP" $+ let defT f = (\d -> f d 1 0)+ in applyBench+ [+ bench "runRWSP_B" . nf (runB (runRWSP 1 0) . rwsp_bench)+ , bench "runRWSP_A" . nf (runA (defT RWS.runRWST) . rwsp_bench)+ , bench "evalRWSP_B" . nf (runB (evalRWSP 1 0) . rwsp_bench)+ , bench "evalRWSP_A" . nf (runA (defT RWS.evalRWST) . rwsp_bench)+ , bench "execRWSP_B" . nf (runB (execRWSP 1 0) . rwsp_bench)+ , bench "execRWSP_A" . nf (runA (defT RWS.execRWST) . rwsp_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 = 1000000++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,6 +1,6 @@ Name: pipes-Version: 3.3.0-Cabal-Version: >=1.8.0.2+Version: 4.0.0+Cabal-Version: >= 1.10 Build-Type: Simple License: BSD3 License-File: LICENSE@@ -10,58 +10,76 @@ Bug-Reports: https://github.com/Gabriel439/Haskell-Pipes-Library/issues Synopsis: Compositional pipelines Description:- \"Coroutines done right\". This library generalizes iteratees and coroutines- simply and elegantly.- .- Advantages over traditional iteratee\/coroutine implementations:+ `pipes` is a clean and powerful stream processing library that lets you build+ and connect reusable streaming components .- * /Concise API/: Use three simple commands: ('>->'), 'request', and 'respond'+ Advantages over traditional streaming libraries: .- * /Bidirectionality/: Implement duplex channels+ * /Concise API/: Use simple commands like 'for', ('>->'), 'await', and 'yield' . * /Blazing fast/: Implementation tuned for speed .- * /Elegant semantics/: Use practical category theory+ * /Lightweight Dependency/: @pipes@ is small and compiles very rapidly,+ including dependencies .- * /Extension Framework/: Mix and match extensions and create your own+ * /Elegant semantics/: Use practical category theory .- * /ListT/: Correct implementation of ListT that interconverts with pipes+ * /ListT/: Correct implementation of 'ListT' that interconverts with pipes .- * /Lightweight Dependency/: @pipes@ depends only on @transformers@ and- @mmorph@ 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 an extensive tutorial.-Category: Control, Pipes, Proxies+ Read "Pipes.Tutorial" for an extensive tutorial.+Category: Control, Pipes Source-Repository head Type: git Location: https://github.com/Gabriel439/Haskell-Pipes-Library Library+ Default-Language: Haskell2010+ HS-Source-Dirs: src Build-Depends: base >= 4 && < 5 , mmorph >= 1.0.0 && < 1.1,- transformers >= 0.2.0.0 && < 0.4+ mtl >= 2.0.1.0 && < 2.2,+ transformers >= 0.2.0.0 && < 0.4,+ void < 0.7 Exposed-Modules:- Control.Pipe,- Control.Proxy,- Control.Proxy.Class,- Control.Proxy.Core,- Control.Proxy.Core.Fast,- Control.Proxy.Core.Correct,- Control.Proxy.Morph,- Control.Proxy.Pipe,- Control.Proxy.Trans,- Control.Proxy.Trans.Codensity,- 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- GHC-Options: -O2+ Pipes,+ Pipes.Core,+ Pipes.Internal,+ Pipes.Lift,+ Pipes.Prelude,+ Pipes.Tutorial+ GHC-Options: -O2 -Wall++Benchmark prelude-benchmarks+ Default-Language: Haskell2010+ Type: exitcode-stdio-1.0+ HS-Source-Dirs: benchmarks+ Main-Is: PreludeBench.hs+ GHC-Options: -O2 -Wall -rtsopts -fno-warn-unused-do-bind++ Build-Depends:+ base >= 4 && < 5 ,+ criterion >= 0.8 && < 0.9,+ mtl >= 2.0.1.0 && < 2.2,+ pipes >= 4.0.0 && < 4.1++Benchmark lift-benchmarks+ Default-Language: Haskell2010+ Type: exitcode-stdio-1.0+ HS-Source-Dirs: benchmarks+ Main-Is: LiftBench.hs+ GHC-Options: -O2 -Wall -rtsopts -fno-warn-unused-do-bind++ Build-Depends:+ base >= 4 && < 5 ,+ criterion >= 0.8 && < 0.9,+ deepseq ,+ mtl >= 2.0.1.0 && < 2.2,+ pipes >= 4.0.0 && < 4.1,+ transformers >= 0.2.0.0 && < 0.4
+ src/Pipes.hs view
@@ -0,0 +1,424 @@+{-| 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.+-}++{-# LANGUAGE RankNTypes, CPP #-}++#if __GLASGOW_HASKELL__ >= 702+{-# LANGUAGE Trustworthy #-}+#endif+{- The rewrite RULES require the 'TrustWorthy' annotation. -}++module Pipes (+ -- * The Proxy Monad Transformer+ Proxy,+ Effect,+ Effect',+ runEffect,++ -- ** Producers+ -- $producers+ Producer,+ Producer',+ yield,+ for,+ (~>),+ (<~),++ -- ** Consumers+ -- $consumers+ Consumer,+ Consumer',+ await,+ (>~),+ (~<),++ -- ** Pipes+ -- $pipes+ Pipe,+ cat,+ (>->),+ (<-<),++ -- * ListT+ ListT(..),+ Enumerable(..),++ -- * Utilities+ next,+ each,+ every,+ discard,++ -- * Re-exports+ -- $reexports+ module Control.Monad.IO.Class,+ module Control.Monad.Trans.Class,+ module Control.Monad.Morph,+ module Data.Foldable,+ module Data.Void+ ) 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.Monad.Trans.Error (ErrorT(runErrorT))+import Control.Monad.Trans.Identity (IdentityT(runIdentityT))+import Control.Monad.Trans.Maybe (MaybeT(runMaybeT))+import Data.Foldable (Foldable)+import qualified Data.Foldable as F+import Data.Void (Void)+import qualified Data.Void as V+import Pipes.Internal (Proxy(..))+import Pipes.Core++-- Re-exports+import Control.Monad.Morph (MFunctor(hoist))++infixl 4 <~+infixr 4 ~>+infixl 5 ~<+infixr 5 >~+infixl 7 >->+infixr 7 <-<++{- $producers+ Use 'yield' to produce output and ('~>') \/ 'for' to substitute 'yield's.++ 'yield' and ('~>') obey the 'Control.Category.Category' laws:++@+\-\- Substituting \'yield\' with \'f\' gives \'f\'+'yield' '~>' f = f++\-\- Substituting every \'yield\' with another \'yield\' does nothing+f '~>' 'yield' = f++\-\- \'yield\' substitution is associative+(f '~>' g) '~>' h = f '~>' (g '~>' h)+@++ These are equivalent to the following \"for loop laws\":++@+\-\- Looping over a single yield simplifies to function application+'for' ('yield' x) f = f x++\-\- Re-yielding every element of a stream returns the original stream+'for' s 'yield' = s++\-\- Nested for loops can become a sequential 'for' loops if the inner loop+\-\- body ignores the outer loop variable+'for' s (\\a -\> 'for' (f a) g) = 'for' ('for' s f) g = 'for' s (f '~>' g)+@++-}++{-| Produce a value++@+'yield' :: 'Monad' m => a -> 'Pipe' x a m ()+@+-}+yield :: (Monad m) => a -> Producer' a m ()+yield = respond+{-# INLINABLE yield #-}++{-| @(for p body)@ loops over @p@ replacing each 'yield' with @body@.++@+'for' :: 'Monad' m => 'Producer' b m r -> (b -> 'Effect' m ()) -> 'Effect' m r+'for' :: 'Monad' m => 'Producer' b m r -> (b -> 'Producer' c m ()) -> 'Producer' c m r+'for' :: 'Monad' m => 'Pipe' x b m r -> (b -> 'Effect' m ()) -> 'Consumer' x m r+'for' :: 'Monad' m => 'Pipe' x b m r -> (b -> 'Producer' c m ()) -> 'Pipe' x c m r+'for' :: 'Monad' m => 'Pipe' x b m r -> (b -> 'Consumer' x m ()) -> 'Consumer' x m r+'for' :: 'Monad' m => 'Pipe' x b m r -> (b -> 'Pipe' x c m ()) -> 'Pipe' x c m r+@+-}+for :: (Monad m)+ => Proxy x' x b' b m a'+ -- ^+ -> (b -> Proxy x' x c' c m b')+ -- ^+ -> Proxy x' x c' c m a'+for = (//>)+{-# INLINABLE for #-}++{-# RULES+ "for cat f" forall f .+ for cat f =+ let go = do+ x <- await+ f x+ go+ in go+ ; "m >~ cat" forall m .+ m >~ cat =+ let go = do+ x <- m+ yield x+ go+ in go+ #-}++{-| Compose loop bodies++@+('~>') :: 'Monad' m => (a -> 'Producer' b m r) -> (b -> 'Effect' m ()) -> (a -> 'Effect' m r)+('~>') :: 'Monad' m => (a -> 'Producer' b m r) -> (b -> 'Producer' c m ()) -> (a -> 'Producer' c m r)+('~>') :: 'Monad' m => (a -> 'Pipe' x b m r) -> (b -> 'Effect' m ()) -> (a -> 'Consumer' x m r)+('~>') :: 'Monad' m => (a -> 'Pipe' x b m r) -> (b -> 'Producer' c m ()) -> (a -> 'Pipe' x c m r)+('~>') :: 'Monad' m => (a -> 'Pipe' x b m r) -> (b -> 'Consumer' x m ()) -> (a -> 'Consumer' x m r)+('~>') :: 'Monad' m => (a -> 'Pipe' x b m r) -> (b -> 'Pipe' x c m ()) -> (a -> 'Pipe' x c m r)+@+-}+(~>)+ :: (Monad m)+ => (a -> Proxy x' x b' b m a')+ -- ^+ -> (b -> Proxy x' x c' c m b')+ -- ^+ -> (a -> Proxy x' x c' c m a')+(~>) = (/>/)+{-# INLINABLE (~>) #-}++-- | ('~>') with the arguments flipped+(<~)+ :: (Monad m)+ => (b -> Proxy x' x c' c m b')+ -- ^+ -> (a -> Proxy x' x b' b m a')+ -- ^+ -> (a -> Proxy x' x c' c m a')+g <~ f = f ~> g+{-# INLINABLE (<~) #-}++{- $consumers+ Use 'await' to request input and ('>~') to substitute 'await's.++ 'await' and ('>~') obey the 'Control.Category.Category' laws:++@+\-\- Substituting every \'await\' with another \'await\' does nothing+'await' '>~' f = f++\-\- Substituting \'await\' with \'f\' gives \'f\'+f '>~' 'await' = f++\-\- \'await\' substitution is associative+(f '>~' g) '>~' h = f '>~' (g '>~' h)+@++-}++{-| Consume a value++@+'await' :: 'Monad' m => 'Pipe' a y m a+@+-}+await :: (Monad m) => Consumer' a m a+await = request ()+{-# INLINABLE await #-}++{-| @(draw >~ p)@ loops over @p@ replacing each 'await' with @draw@++@+('>~') :: 'Monad' m => 'Effect' m b -> 'Consumer' b m c -> 'Effect' m c+('>~') :: 'Monad' m => 'Consumer' a m b -> 'Consumer' b m c -> 'Consumer' a m c+('>~') :: 'Monad' m => 'Effect' m b -> 'Pipe' b y m c -> 'Producer' y m c+('>~') :: 'Monad' m => 'Consumer' a m b -> 'Pipe' b y m c -> 'Pipe' a y m c+('>~') :: 'Monad' m => 'Producer' y m b -> 'Pipe' b y m c -> 'Producer' y m c+('>~') :: 'Monad' m => 'Pipe' a y m b -> 'Pipe' b y m c -> 'Pipe' a y m c+@+-}+(>~)+ :: (Monad m)+ => Proxy a' a y' y m b+ -- ^+ -> Proxy () b y' y m c+ -- ^+ -> Proxy a' a y' y m c+p1 >~ p2 = (\() -> p1) >\\ p2+{-# INLINABLE (>~) #-}++-- | ('>~') with the arguments flipped+(~<)+ :: (Monad m)+ => Proxy () b y' y m c+ -- ^+ -> Proxy a' a y' y m b+ -- ^+ -> Proxy a' a y' y m c+p2 ~< p1 = p1 >~ p2+{-# INLINABLE (~<) #-}++{- $pipes+ Use 'await' and 'yield' to build 'Pipe's and ('>->') to connect 'Pipe's.++ 'cat' and ('>->') obey the 'Control.Category.Category' laws:++@+\-\- Useless use of cat+'cat' '>->' f = f++\-\- Redirecting output to cat does nothing+f '>->' 'cat' = f++\-\- The pipe operator is associative+(f '>->' g) '>->' h = f '>->' (g '>->' h)+@++-}++-- | The identity 'Pipe', analogous to the Unix @cat@ program+cat :: (Monad m) => Pipe a a m r+cat = pull ()+{-# INLINABLE cat #-}++{-| 'Pipe' composition, analogous to the Unix pipe operator++@+('>->') :: 'Monad' m => 'Producer' b m r -> 'Consumer' b m r -> 'Effect' m r+('>->') :: 'Monad' m => 'Producer' b m r -> 'Pipe' b c m r -> 'Producer' c m r+('>->') :: 'Monad' m => 'Pipe' a b m r -> 'Consumer' b m r -> 'Consumer' a m r+('>->') :: 'Monad' m => 'Pipe' a b m r -> 'Pipe' b c m r -> 'Pipe' a c m r+@+-}+(>->)+ :: (Monad m)+ => Proxy a' a () b m r+ -- ^+ -> Proxy () b c' c m r+ -- ^+ -> Proxy a' a c' c m r+p1 >-> p2 = (\() -> p1) +>> p2+{-# INLINABLE (>->) #-}++{-| The list monad transformer, which extends a monad with non-determinism++ 'return' corresponds to 'yield', yielding a single value++ ('>>=') corresponds to 'for', calling the second computation once for each+ time the first computation 'yield's.+-}+newtype ListT m a = Select { enumerate :: Producer a m () }++instance (Monad m) => Functor (ListT m) where+ fmap f p = Select (for (enumerate p) (\a -> yield (f a)))++instance (Monad m) => Applicative (ListT m) where+ pure a = Select (yield a)+ mf <*> mx = Select (+ for (enumerate mf) (\f ->+ for (enumerate mx) (\x ->+ yield (f x) ) ) )++instance (Monad m) => Monad (ListT m) where+ return a = Select (yield a)+ m >>= f = Select (for (enumerate m) (\a -> enumerate (f a)))++instance MonadTrans ListT where+ lift m = Select (do+ a <- lift m+ yield a )++instance (MonadIO m) => MonadIO (ListT m) where+ liftIO m = lift (liftIO m)++instance (Monad m) => Alternative (ListT m) where+ empty = Select (return ())+ p1 <|> p2 = Select (do+ enumerate p1+ enumerate p2 )++instance (Monad m) => MonadPlus (ListT m) where+ mzero = empty+ mplus = (<|>)++instance MFunctor ListT where+ hoist morph = Select . hoist morph . enumerate++{-| 'Enumerable' generalizes 'Data.Foldable.Foldable', converting effectful+ containers to 'ListT's.+-}+class Enumerable t where+ toListT :: (Monad m) => t m a -> ListT m a++instance Enumerable ListT where+ toListT = id++instance Enumerable IdentityT where+ toListT m = Select $ do+ a <- lift $ runIdentityT m+ yield a++instance Enumerable MaybeT where+ toListT m = Select $ do+ x <- lift $ runMaybeT m+ case x of+ Nothing -> return ()+ Just a -> yield a++instance Enumerable (ErrorT e) where+ toListT m = Select $ do+ x <- lift $ runErrorT m+ case x of+ Left _ -> return ()+ Right a -> yield a++{-| Consume the first value from a 'Producer'++ 'next' either fails with a 'Left' if the 'Producer' terminates or succeeds+ with a 'Right' providing the next value and the remainder of the 'Producer'.+-}+next :: (Monad m) => Producer a m r -> m (Either r (a, Producer a m r))+next = go+ where+ go p = case p of+ Request v _ -> V.absurd v+ Respond a fu -> return (Right (a, fu ()))+ M m -> m >>= go+ Pure r -> return (Left r)+{-# INLINABLE next #-}++-- | Convert a 'F.Foldable' to a 'Producer'+each :: (Monad m, F.Foldable f) => f a -> Producer' a m ()+each = F.mapM_ yield+{-# INLINABLE each #-}++-- | Convert an 'Enumerable' to a 'Producer'+every :: (Monad m, Enumerable t) => t m a -> Producer' a m ()+every it = discard >\\ enumerate (toListT it)+{-# INLINABLE every #-}++-- | Discards a value+discard :: (Monad m) => a -> m ()+discard _ = return ()+{-# INLINABLE discard #-}++-- | ('>->') with the arguments flipped+(<-<)+ :: (Monad m)+ => Proxy () b c' c m r+ -- ^+ -> Proxy a' a () b m r+ -- ^+ -> Proxy a' a c' c m r+p2 <-< p1 = p1 >-> p2+{-# INLINABLE (<-<) #-}++{- $reexports+ "Control.Monad.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)++ "Data.Void" re-exports 'Void'.+-}
+ src/Pipes/Core.hs view
@@ -0,0 +1,834 @@+{-| 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 CPP, RankNTypes #-}++#if __GLASGOW_HASKELL__ >= 702+{-# LANGUAGE Trustworthy #-}+#endif+{- The rewrite RULES require the 'TrustWorthy' annotation. Their proofs are+ pretty trivial since they are just inlining the definition of their+ respective operators. GHC doesn't do this inlining automatically for these+ functions because they are recursive.+-}++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+ Effect,+ Producer,+ Pipe,+ Consumer,+ Client,+ Server,++ -- * Polymorphic Type Synonyms+ Effect',+ Producer',+ Consumer',+ Client',+ Server',++ -- * Flipped operators+ (\<\),+ (/</),+ (<~<),+ (~<<),+ (<+<),+ (<\\),+ (//<),+ (<<+)+ ) where++import Data.Void (Void, absurd)+import Pipes.Internal (Proxy(..))++{- $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 _ -> absurd v+ Respond v _ -> absurd v+ M m -> m >>= go+ Pure r -> return r+{-# INLINABLE runEffect #-}++{-+ * Keep proxy composition lower in precedence than function composition, which+ is 9 at the time of of this comment, so that users can write things like:+++> lift . k >+> p+>+> hoist f . k >+> p++ * Keep the priorities different so that users can mix composition operators+ like:++> up \>\ p />/ dn+>+> up >~> p >+> dn++ * Keep 'request' and 'respond' composition lower in precedence than 'pull'+ and 'push' composition, so that users can do:++> read \>\ pull >+> writer++ * I arbitrarily choose a lower priority for downstream operators so that lazy+ pull-based computations need not evaluate upstream stages unless absolutely+ necessary.+-}+infixl 3 //>+infixr 3 <\\ -- GHC will raise a parse error if either of these lines ends+infixr 4 />/, >\\ -- with '\', which is why this comment is here+infixl 4 \<\, //<+infixl 5 \>\ -- Same thing here+infixr 5 /</+infixl 6 <<++infixr 6 +>>+infixl 7 >+>, >>~+infixr 7 <+<, ~<<+infixl 8 <~<+infixr 8 >~>++{- $categories+ A 'Control.Category.Category' is a set of components that you can connect+ with a composition operator, ('Control.Category..'), that has an identity,+ 'Control.Category.id'. The ('Control.Category..') and 'Control.Category.id'+ must satisfy the following three 'Control.Category.Category' laws:++@+\-\- Left identity+'Control.Category.id' 'Control.Category..' f = f++\-\- Right identity+f 'Control.Category..' 'Control.Category.id' = f++\-\- Associativity+(f 'Control.Category..' g) 'Control.Category..' h = f 'Control.Category..' (g 'Control.Category..' h)+@++ The 'Proxy' type sits at the intersection of five separate categories, four+ of which are named after their identity:++@+ Identity | Composition | Point-ful+ +-------------+-------------+-------------++ respond category | 'respond' | '/>/' | '//>' |+ request category | 'request' | '\>\' | '>\\' |+ push category | 'push' | '>~>' | '>>~' |+ pull category | 'pull' | '>+>' | '+>>' |+ Kleisli category | 'return' | 'Control.Monad.>=>' | '>>=' |+ +-------------+-------------+-------------++@++ Each composition operator has a \"point-ful\" version, analogous to how+ ('>>=') is the point-ful version of ('Control.Monad.>=>'). For example,+ ('//>') is the point-ful version of ('/>/'). The convention is that the+ odd character out faces the argument that is a function.+-}++{- $respond+ The 'respond' category closely corresponds to the generator design pattern.++ The 'respond' category obeys the category laws, where 'respond' is the+ identity and ('/>/') is composition:++@+\-\- Left identity+'respond' '/>/' f = f++\-\- Right identity+f '/>/' 'respond' = f++\-\- Associativity+(f '/>/' g) '/>/' h = f '/>/' (g '/>/' h)+@++ The following diagrams show the flow of information:++@+'respond' :: ('Monad' m)+ => a -> 'Proxy' x' x a' a m a'++\ a+ |+ +----|----++ | | |+ x' <== \\ /==== a'+ | X |+ x ==> / \\===> a+ | | |+ +----|----++ v + a'++('/>/') :: ('Monad' m)+ => (a -> 'Proxy' x' x b' b m a')+ -> (b -> 'Proxy' x' x c' c m b')+ -> (a -> 'Proxy' x' x b' b m a')++\ a /===> b a+ | / | |+ +----|----+ / +----|----+ +----|----++ | v | / | v | | v |+ x' <== <== b' <==\\ / x'<== <== c' x' <== <== c'+ | f | X | g | = | f '/>/' g |+ x ==> ==> b ===/ \\ x ==> ==> c x ==> ==> c'+ | | | \\ | | | | | |+ +----|----+ \\ +----|----+ +----|----++ v \\ v v+ a' \\==== b' a'+@++-}++{-| Send a value of type @a@ downstream and block waiting for a reply of type+ @a'@++ 'respond' is the identity of the respond category.+-}+respond :: (Monad m) => a -> Proxy x' x a' a m a'+respond a = Respond a Pure+{-# INLINABLE respond #-}++{-| Compose two unfolds, creating a new unfold++@+(f '/>/' g) x = f x '//>' g+@++ ('/>/') is the composition operator of the respond category.+-}+(/>/)+ :: (Monad m)+ => (a -> Proxy x' x b' b m a')+ -- ^+ -> (b -> Proxy x' x c' c m b')+ -- ^+ -> (a -> Proxy x' x c' c m a')+ -- ^+(fa />/ fb) a = fa a //> fb+{-# INLINABLE (/>/) #-}++{-| @(p \/\/> f)@ replaces each 'respond' in @p@ with @f@.++ Point-ful version of ('/>/')+-}+(//>)+ :: (Monad m)+ => Proxy x' x b' b m a'+ -- ^+ -> (b -> Proxy x' x c' c m b')+ -- ^+ -> Proxy x' x c' c m a'+ -- ^+p0 //> fb = go p0+ where+ go p = case p of+ Request x' fx -> Request x' (\x -> go (fx x))+ Respond b fb' -> fb b >>= \b' -> go (fb' b')+ M m -> M (m >>= \p' -> return (go p'))+ Pure a -> Pure a+{-# INLINABLE (//>) #-}++{-# RULES+ "(Request x' fx ) //> fb" forall x' fx fb .+ (Request x' fx ) //> fb = Request x' (\x -> fx x //> fb);+ "(Respond b fb') //> fb" forall b fb' fb .+ (Respond b fb') //> fb = fb b >>= \b' -> fb' b' //> fb;+ "(M m ) //> fb" forall m fb .+ (M m ) //> fb = M (m >>= \p' -> return (p' //> fb));+ "(Pure a ) //> fb" forall a fb .+ (Pure a ) //> fb = Pure a;+ #-}++{- $request+ The 'request' category closely corresponds to the iteratee design pattern.++ The 'request' category obeys the category laws, where 'request' is the+ identity and ('\>\') is composition:++@+-- Left identity+'request' '\>\' f = f++\-\- Right identity+f '\>\' 'request' = f++\-\- Associativity+(f '\>\' g) '\>\' h = f '\>\' (g '\>\' h)+@++ The following diagrams show the flow of information:++@+'request' :: ('Monad' m)+ => a' -> 'Proxy' a' a y' y m a++\ a'+ |+ +----|----++ | | |+ a' <=====/ <== y'+ | |+ a ======\\ ==> y+ | | |+ +----|----++ v+ a++('\>\') :: ('Monad' m)+ => (b' -> 'Proxy' a' a y' y m b)+ -> (c' -> 'Proxy' b' b y' y m c)+ -> (c' -> 'Proxy' a' a y' y m c)++\ b'<=====\\ c' c'+ | \\ | |+ +----|----+ \\ +----|----+ +----|----++ | v | \\ | v | | v |+ a' <== <== y' \\== b' <== <== y' a' <== <== y'+ | f | | g | = | f '\>\' g |+ a ==> ==> y /=> b ==> ==> y a ==> ==> y+ | | | / | | | | | |+ +----|----+ / +----|----+ +----|----++ v / v v+ b ======/ c c+@+-}++{-| Send a value of type @a'@ upstream and block waiting for a reply of type @a@++ 'request' is the identity of the request category.+-}+request :: (Monad m) => a' -> Proxy a' a y' y m a+request a' = Request a' Pure+{-# INLINABLE request #-}++{-| Compose two folds, creating a new fold++@+(f '\>\' g) x = f '>\\' g x+@++ ('\>\') is the composition operator of the request category.+-}+(\>\)+ :: (Monad m)+ => (b' -> Proxy a' a y' y m b)+ -- ^+ -> (c' -> Proxy b' b y' y m c)+ -- ^+ -> (c' -> Proxy a' a y' y m c)+ -- ^+(fb' \>\ fc') c' = fb' >\\ fc' c'+{-# INLINABLE (\>\) #-}++{-| @(f >\\\\ p)@ replaces each 'request' in @p@ with @f@.++ Point-ful version of ('\>\')+-}+(>\\)+ :: (Monad m)+ => (b' -> Proxy a' a y' y m b)+ -- ^+ -> Proxy b' b y' y m c+ -- ^+ -> Proxy a' a y' y m c+ -- ^+fb' >\\ p0 = go p0+ where+ go p = case p of+ Request b' fb -> fb' b' >>= \b -> go (fb b)+ Respond x fx' -> Respond x (\x' -> go (fx' x'))+ M m -> M (m >>= \p' -> return (go p'))+ Pure a -> Pure a+{-# INLINABLE (>\\) #-}++{-# RULES+ "fb' >\\ (Request b' fb )" forall fb' b' fb .+ fb' >\\ (Request b' fb ) = fb' b' >>= \b -> fb' >\\ fb b;+ "fb' >\\ (Respond x fx')" forall fb' x fx' .+ fb' >\\ (Respond x fx') = Respond x (\x' -> fb' >\\ fx' x');+ "fb' >\\ (M m )" forall fb' m .+ fb' >\\ (M m ) = M (m >>= \p' -> return (fb' >\\ p'));+ "fb' >\\ (Pure a )" forall fb' a .+ fb' >\\ (Pure a ) = Pure a;+ #-}++{- $push+ The 'push' category closely corresponds to push-based Unix pipes.++ The 'push' category obeys the category laws, where 'push' is the identity+ and ('>~>') is composition:++@+\-\- Left identity+'push' '>~>' f = f++\-\- Right identity+f '>~>' 'push' = f++\-\- Associativity+(f '>~>' g) '>~>' h = f '>~>' (g '>~>' h)+@++ The following diagram shows the flow of information:++@+'push' :: ('Monad' m)+ => a -> 'Proxy' a' a a' a m r++\ a+ |+ +----|----++ | v |+ a' <============ a'+ | |+ a ============> a+ | | |+ +----|----++ v+ r++('>~>') :: ('Monad' m)+ => (a -> 'Proxy' a' a b' b m r)+ -> (b -> 'Proxy' b' b c' c m r)+ -> (a -> 'Proxy' a' a c' c m r)++\ a b a+ | | |+ +----|----+ +----|----+ +----|----++ | v | | v | | v |+ a' <== <== b' <== <== c' a' <== <== c'+ | f | | g | = | f '>~>' g |+ a ==> ==> b ==> ==> c a ==> ==> c+ | | | | | | | | |+ +----|----+ +----|----+ +----|----++ v v v+ r r r+@++-}++{-| Forward responses followed by requests++@+'push' = 'respond' 'Control.Monad.>=>' 'request' 'Control.Monad.>=>' 'push'+@++ 'push' is the identity of the push category.+-}+push :: (Monad m) => a -> Proxy a' a a' a m r+push = go+ where+ go a = Respond a (\a' -> Request a' go)+{-# INLINABLE push #-}++{-| Compose two proxies blocked while 'request'ing data, creating a new proxy+ blocked while 'request'ing data++@+(f '>~>' g) x = f x '>>~' g+@++ ('>~>') is the composition operator of the push category.+-}+(>~>)+ :: (Monad m)+ => (_a -> Proxy a' a b' b m r)+ -- ^+ -> ( b -> Proxy b' b c' c m r)+ -- ^+ -> (_a -> Proxy a' a c' c m r)+ -- ^+(fa >~> fb) a = fa a >>~ fb+{-# INLINABLE (>~>) #-}++{-| @(p >>~ f)@ pairs each 'respond' in @p@ with an 'request' in @f@.++ Point-ful version of ('>~>')+-}+(>>~)+ :: (Monad m)+ => Proxy a' a b' b m r+ -- ^+ -> (b -> Proxy b' b c' c m r)+ -- ^+ -> Proxy a' a c' c m r+ -- ^+p >>~ fb = case p of+ Request a' fa -> Request a' (\a -> fa a >>~ fb)+ Respond b fb' -> fb' +>> fb b+ M m -> M (m >>= \p' -> return (p' >>~ fb))+ Pure r -> Pure r+{-# INLINABLE (>>~) #-}++{- $pull+ The 'pull' category closely corresponds to pull-based Unix pipes.++ The 'pull' category obeys the category laws, where 'pull' is the identity+ and ('>+>') is composition:++@+\-\- Left identity+'pull' '>+>' f = f++\-\- Right identity+f '>+>' 'pull' = f++\-\- Associativity+(f '>+>' g) '>+>' h = f '>+>' (g '>+>' h)+@++ The following diagrams show the flow of information:++@+'pull' :: ('Monad' m)+ => a' -> 'Proxy' a' a a' a m r++\ a'+ |+ +----|----++ | v |+ a' <============ a'+ | |+ a ============> a+ | | |+ +----|----++ v+ r++('>+>') :: ('Monad' m)+ -> (b' -> 'Proxy' a' a b' b m r)+ -> (c' -> 'Proxy' b' b c' c m r)+ -> (c' -> 'Proxy' a' a c' c m r)++\ b' c' c'+ | | |+ +----|----+ +----|----+ +----|----++ | v | | v | | v |+ a' <== <== b' <== <== c' a' <== <== c'+ | f | | g | = | f >+> g |+ a ==> ==> b ==> ==> c a ==> ==> c+ | | | | | | | | |+ +----|----+ +----|----+ +----|----++ v v v+ r r r+@++-}++{-| Forward requests followed by responses:++@+'pull' = 'request' 'Control.Monad.>=>' 'respond' 'Control.Monad.>=>' 'pull'+@++ 'pull' is the identity of the pull category.+-}+pull :: (Monad m) => a' -> Proxy a' a a' a m r+pull = go+ where+ go a' = Request a' (\a -> Respond a go)+{-# INLINABLE pull #-}++{-| Compose two proxies blocked in the middle of 'respond'ing, creating a new+ proxy blocked in the middle of 'respond'ing++@+(f '>+>' g) x = f '+>>' g x+@++ ('>+>') is the composition operator of the pull category.+-}+(>+>)+ :: (Monad m)+ => ( b' -> Proxy a' a b' b m r)+ -- ^+ -> (_c' -> Proxy b' b c' c m r)+ -- ^+ -> (_c' -> Proxy a' a c' c m r)+ -- ^+(fb' >+> fc') c' = fb' +>> fc' c'+{-# INLINABLE (>+>) #-}++{-| @(f +>> p)@ pairs each 'request' in @p@ with a 'respond' in @f@.++ Point-ful version of ('>+>')+-}+(+>>)+ :: (Monad m)+ => (b' -> Proxy a' a b' b m r)+ -- ^+ -> Proxy b' b c' c m r+ -- ^+ -> Proxy a' a c' c m r+ -- ^+fb' +>> p = case p of+ Request b' fb -> fb' b' >>~ fb+ Respond c fc' -> Respond c (\c' -> fb' +>> fc' c')+ M m -> M (m >>= \p' -> return (fb' +>> p'))+ Pure r -> Pure r+{-# INLINABLE (+>>) #-}++{- $reflect+ @(reflect .)@ transforms each streaming category into its dual:++ * The request category is the dual of the respond category++@+'reflect' '.' 'respond' = 'request'++'reflect' '.' (f '/>/' g) = 'reflect' '.' f '/</' 'reflect' '.' g+@++@+'reflect' '.' 'request' = 'respond'++'reflect' '.' (f '\>\' g) = 'reflect' '.' f '\<\' 'reflect' '.' g+@++ * The pull category is the dual of the push category++@+'reflect' '.' 'push' = 'pull'++'reflect' '.' (f '>~>' g) = 'reflect' '.' f '<+<' 'reflect' '.' g+@++@+'reflect' '.' 'pull' = 'push'++'reflect' '.' (f '>+>' g) = 'reflect' '.' f '<~<' 'reflect' '.' g+@+-}++-- | Switch the upstream and downstream ends+reflect :: (Monad m) => Proxy a' a b' b m r -> Proxy b b' a a' m r+reflect = go+ where+ go p = case p of+ Request a' fa -> Respond a' (\a -> go (fa a ))+ Respond b fb' -> Request b (\b' -> go (fb' b'))+ M m -> M (m >>= \p' -> return (go p'))+ Pure r -> Pure r+{-# INLINABLE reflect #-}++{-| An effect in the base monad++ 'Effect's neither 'Pipes.await' nor 'Pipes.yield'+-}+type Effect = Proxy Void () () Void++-- | 'Producer's can only 'Pipes.yield'+type Producer b = Proxy Void () () 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 () Void++{-| @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 () Void++{-| @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 Void () b' b++-- | Like 'Effect', but with a polymorphic type+type Effect' m r = forall x' x y' y . Proxy x' x y' y m r++-- | Like 'Producer', but with a polymorphic type+type Producer' b m r = forall x' x . Proxy x' x () b m r++-- | Like 'Consumer', but with a polymorphic type+type Consumer' a m r = forall y' y . Proxy () a y' y m r++-- | Like 'Server', but with a polymorphic type+type Server' b' b m r = forall x' x . Proxy x' x b' b m r++-- | Like 'Client', but with a polymorphic type+type Client' a' a m r = forall y' y . Proxy a' a y' y m r++-- | Equivalent to ('/>/') with the arguments flipped+(\<\)+ :: (Monad m)+ => (b -> Proxy x' x c' c m b')+ -- ^+ -> (a -> Proxy x' x b' b m a')+ -- ^+ -> (a -> Proxy x' x c' c m a')+ -- ^+p1 \<\ p2 = p2 />/ p1+{-# INLINABLE (\<\) #-}++-- | Equivalent to ('\>\') with the arguments flipped+(/</)+ :: (Monad m)+ => (c' -> Proxy b' b x' x m c)+ -- ^+ -> (b' -> Proxy a' a x' x m b)+ -- ^+ -> (c' -> Proxy a' a x' x m c)+ -- ^+p1 /</ p2 = p2 \>\ p1+{-# INLINABLE (/</) #-}++-- | Equivalent to ('>~>') with the arguments flipped+(<~<)+ :: (Monad m)+ => (b -> Proxy b' b c' c m r)+ -- ^+ -> (a -> Proxy a' a b' b m r)+ -- ^+ -> (a -> Proxy a' a c' c m r)+ -- ^+p1 <~< p2 = p2 >~> p1+{-# INLINABLE (<~<) #-}++-- | Equivalent to ('>+>') with the arguments flipped+(<+<)+ :: (Monad m)+ => (c' -> Proxy b' b c' c m r)+ -- ^+ -> (b' -> Proxy a' a b' b m r)+ -- ^+ -> (c' -> Proxy a' a c' c m r)+ -- ^+p1 <+< p2 = p2 >+> p1+{-# INLINABLE (<+<) #-}++-- | Equivalent to ('//>') with the arguments flipped+(<\\)+ :: (Monad m)+ => (b -> Proxy x' x c' c m b')+ -- ^+ -> Proxy x' x b' b m a'+ -- ^+ -> Proxy x' x c' c m a'+ -- ^+f <\\ p = p //> f+{-# INLINABLE (<\\) #-}++-- | Equivalent to ('>\\') with the arguments flipped+(//<)+ :: (Monad m)+ => Proxy b' b y' y m c+ -- ^+ -> (b' -> Proxy a' a y' y m b)+ -- ^+ -> Proxy a' a y' y m c+ -- ^+p //< f = f >\\ p+{-# INLINABLE (//<) #-}++-- | Equivalent to ('>>~') with the arguments flipped+(~<<)+ :: (Monad m)+ => (b -> Proxy b' b c' c m r)+ -- ^+ -> Proxy a' a b' b m r+ -- ^+ -> Proxy a' a c' c m r+ -- ^+k ~<< p = p >>~ k+{-# INLINABLE (~<<) #-}++-- | Equivalent to ('+>>') with the arguments flipped+(<<+)+ :: (Monad m)+ => Proxy b' b c' c m r+ -- ^+ -> (b' -> Proxy a' a b' b m r)+ -- ^+ -> Proxy a' a c' c m r+ -- ^+k <<+ p = p +>> k+{-# INLINABLE (<<+) #-}
+ src/Pipes/Internal.hs view
@@ -0,0 +1,237 @@+{-| This is an internal module, meaning that it is unsafe to import unless you+ understand the risks.++ This module provides a fast implementation by weakening the monad+ transformer laws. These laws do not hold if you can pattern match on the+ constructors, as the following counter-example illustrates:++@+'lift' '.' 'return' = 'M' '.' 'return' '.' 'Pure'++'return' = 'Pure'++'lift' '.' 'return' /= 'return'+@++ You do not need to worry about this if you do not import this module, since+ the other modules in this library do not export the constructors or export+ any functions which can violate the monad transformer laws.+-}++{-# LANGUAGE+ FlexibleInstances+ , MultiParamTypeClasses+ , RankNTypes+ , UndecidableInstances+ , CPP+ #-}+module Pipes.Internal (+ -- * Internal+ Proxy(..),+ unsafeHoist,+ observe,+ ) where++import Control.Applicative (Applicative(pure, (<*>)), Alternative(empty, (<|>)))+import Control.Monad (liftM, MonadPlus(..))+import Control.Monad.IO.Class (MonadIO(liftIO))+import Control.Monad.Morph (MFunctor(hoist))+import Control.Monad.Trans.Class (MonadTrans(lift))+import Control.Monad.Error (MonadError(..))+import Control.Monad.Reader (MonadReader(..))+import Control.Monad.State (MonadState(..))+import Control.Monad.Writer (MonadWriter(..))+import Data.Monoid (mempty,mappend)++{-| A 'Proxy' is a monad transformer that receives and sends information on both+ an upstream and downstream interface.++ The type variables signify:++ * @a'@ and @a@ - The upstream interface, where @(a')@s go out and @(a)@s+ come in++ * @b'@ and @b@ - The downstream interface, where @(b)@s go out and @(b')@s+ come in++ * @m @ - The base monad++ * @r @ - The return value+-}+data Proxy a' a b' b m r+ = Request a' (a -> Proxy a' a b' b m r )+ | Respond b (b' -> Proxy a' a b' b m r )+ | M (m (Proxy a' a b' b m r))+ | Pure r++instance (Monad m) => Functor (Proxy a' a b' b m) where+ fmap f p0 = go p0 where+ go p = case p of+ Request a' fa -> Request a' (\a -> go (fa a ))+ Respond b fb' -> Respond b (\b' -> go (fb' b'))+ M m -> M (m >>= \p' -> return (go p'))+ Pure r -> Pure (f r)++instance (Monad m) => Applicative (Proxy a' a b' b m) where+ pure = Pure+ pf <*> px = go pf where+ go p = case p of+ Request a' fa -> Request a' (\a -> go (fa a ))+ Respond b fb' -> Respond b (\b' -> go (fb' b'))+ M m -> M (m >>= \p' -> return (go p'))+ Pure f -> fmap f px++instance (Monad m) => Monad (Proxy a' a b' b m) where+ return = Pure+ (>>=) = _bind++_bind+ :: (Monad m)+ => Proxy a' a b' b m r+ -> (r -> Proxy a' a b' b m r')+ -> Proxy a' a b' b m r'+p0 `_bind` f = go p0 where+ go p = case p of+ Request a' fa -> Request a' (\a -> go (fa a ))+ Respond b fb' -> Respond b (\b' -> go (fb' b'))+ M m -> M (m >>= \p' -> return (go p'))+ Pure r -> f r++{-# RULES+ "_bind (Request a' k) f" forall a' k f .+ _bind (Request a' k) f = Request a' (\a -> _bind (k a) f);+ "_bind (Respond b k) f" forall b k f .+ _bind (Respond b k) f = Respond b (\b' -> _bind (k b') f);+ "_bind (M m) f" forall m f .+ _bind (M m) f = M (m >>= \p -> return (_bind p f));+ "_bind (Pure r ) f" forall r f .+ _bind (Pure r ) f = f r;+ #-}++instance MonadTrans (Proxy a' a b' b) where+ lift m = M (m >>= \r -> return (Pure r))++{-| 'unsafeHoist' is like 'hoist', but faster.++ This is labeled as unsafe because you will break the monad transformer laws+ if you do not pass a monad morphism as the first argument. This function is+ safe if you pass a monad morphism as the first argument.+-}+unsafeHoist+ :: (Monad m)+ => (forall x . m x -> n x) -> Proxy a' a b' b m r -> Proxy a' a b' b n r+unsafeHoist nat = go+ where+ go p = case p of+ Request a' fa -> Request a' (\a -> go (fa a ))+ Respond b fb' -> Respond b (\b' -> go (fb' b'))+ M m -> M (nat (m >>= \p' -> return (go p')))+ Pure r -> Pure r++instance MFunctor (Proxy a' a b' b) where+ hoist nat p0 = go (observe p0) where+ go p = case p of+ Request a' fa -> Request a' (\a -> go (fa a ))+ Respond b fb' -> Respond b (\b' -> go (fb' b'))+ M m -> M (nat (m >>= \p' -> return (go p')))+ Pure r -> Pure r++instance (MonadIO m) => MonadIO (Proxy a' a b' b m) where+ liftIO m = M (liftIO (m >>= \r -> return (Pure r)))++instance (MonadReader r m) => MonadReader r (Proxy a' a b' b m) where+ ask = lift ask+ local f = go+ where+ go p = case p of+ Request a' fa -> Request a' (\a -> go (fa a ))+ Respond b fb' -> Respond b (\b' -> go (fb' b'))+ Pure r -> Pure r+ M m -> M (go `liftM` local f m)+#if MIN_VERSION_mtl(2,1,0)+ reader = lift . reader+#else+#endif++instance (MonadState s m) => MonadState s (Proxy a' a b' b m) where+ get = lift get+ put = lift . put+#if MIN_VERSION_mtl(2,1,0)+ state = lift . state+#else+#endif++instance (MonadWriter w m) => MonadWriter w (Proxy a' a b' b m) where+#if MIN_VERSION_mtl(2,1,0)+ writer = lift . writer+#else+#endif+ tell = lift . tell+ listen proxy = go proxy 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)+ Pure r -> Pure (r, w)+ M m -> M (+ (\(p', w') -> go p' $! mappend w w') `liftM` listen m)++ pass = 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 (go `liftM` m)+ Pure (r, f) -> M (pass (return (Pure r, f)))++instance (MonadError e m) => MonadError e (Proxy a' a b' b m) where+ throwError = lift . throwError+ catchError p0 f = go p0+ where+ go p = case p of+ Request a' fa -> Request a' (\a -> go (fa a ))+ Respond b fb' -> Respond b (\b' -> go (fb' b'))+ Pure r -> Pure r+ M m -> M ((do+ p' <- m+ return (go p') ) `catchError` (\e -> return (f e)) )++instance (MonadPlus m) => Alternative (Proxy a' a b' b m) where+ empty = mzero+ (<|>) = mplus++instance (MonadPlus m) => MonadPlus (Proxy a' a b' b m) where+ mzero = lift mzero+ mplus p0 p1 = go p0+ where+ go p = case p of+ Request a' fa -> Request a' (\a -> go (fa a ))+ Respond b fb' -> Respond b (\b' -> go (fb' b'))+ Pure r -> Pure r+ M m -> M ((do+ p' <- m+ return (go p') ) `mplus` return p1 )++{-| The monad transformer laws are correct when viewed through the 'observe'+ function:++@+'observe' ('lift' ('return' r)) = 'observe' ('return' r)++'observe' ('lift' (m '>>=' f)) = 'observe' ('lift' m '>>=' 'lift' '.' f)+@++ This correctness comes at a small cost to performance, so use this function+ sparingly.++ This function is a convenience for low-level @pipes@ implementers. You do+ not need to use 'observe' if you stick to the safe API.+-}+observe :: (Monad m) => Proxy a' a b' b m r -> Proxy a' a b' b m r+observe p0 = M (go p0) where+ go p = case p of+ Request a' fa -> return (Request a' (\a -> observe (fa a )))+ Respond b fb' -> return (Respond b (\b' -> observe (fb' b')))+ M m' -> m' >>= go+ Pure r -> return (Pure r)+{-# INLINABLE observe #-}
+ src/Pipes/Lift.hs view
@@ -0,0 +1,305 @@+{-| 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.+-}++{-# LANGUAGE CPP #-}++module Pipes.Lift (+ -- * ErrorT+ errorP,+ runErrorP,+ catchError,+ liftCatchError,++ -- * MaybeT+ maybeP,+ runMaybeP,++ -- * ReaderT+ readerP,+ runReaderP,++ -- * StateT+ stateP,+ runStateP,+ evalStateP,+ execStateP,++ -- * WriterT+ -- $writert+ writerP,+ runWriterP,+ execWriterP,++ -- * RWST+ rwsP,+ runRWSP,+ evalRWSP,+ execRWSP+ ) where++import Control.Monad.Trans.Class (lift)+import qualified Control.Monad.Trans.Error as E+import qualified Control.Monad.Trans.Maybe as M+import qualified Control.Monad.Trans.Reader as R+import qualified Control.Monad.Trans.State.Strict as S+import qualified Control.Monad.Trans.Writer.Strict as W+import qualified Control.Monad.Trans.RWS.Strict as RWS+import Data.Monoid (Monoid(mempty, mappend))+import Pipes.Internal++-- | Wrap the base monad in 'E.ErrorT'+errorP+ :: (Monad m, E.Error e)+ => Proxy a' a b' b m (Either e r)+ -> Proxy a' a b' b (E.ErrorT e m) r+errorP p = do+ x <- unsafeHoist lift p+ lift $ E.ErrorT (return x)+{-# INLINABLE errorP #-}++-- | Run 'E.ErrorT' in the base monad+runErrorP+ :: (Monad m)+ => Proxy a' a b' b (E.ErrorT e m) r -> Proxy a' a b' b m (Either e r)+runErrorP = 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 (Right r)+ M m -> M (do+ x <- E.runErrorT m+ return (case x of+ Left e -> Pure (Left e)+ Right p' -> go p' ) )+{-# INLINABLE runErrorP #-}++-- | Catch an error in the base monad+catchError+ :: (Monad m) + => Proxy a' a b' b (E.ErrorT e m) r+ -- ^+ -> (e -> Proxy a' a b' b (E.ErrorT f m) r)+ -- ^+ -> Proxy a' a b' b (E.ErrorT f m) r+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 (E.ErrorT (do+ x <- E.runErrorT m+ return (Right (case x of+ Left e -> f e+ Right p' -> go p' )) ))+{-# 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 = 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 (Just r)+ M m -> M (do+ x <- M.runMaybeT m+ return (case x of+ Nothing -> Pure Nothing+ Just p' -> go 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 i = 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 (do+ p' <- R.runReaderT m i+ return (go 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 = go+ where+ go s p = case p of+ Request a' fa -> Request a' (\a -> go s (fa a ))+ Respond b fb' -> Respond b (\b' -> go s (fb' b'))+ Pure r -> Pure (r, s)+ M m -> M (do+ (p', s') <- S.runStateT m s+ return (go s' 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 = fmap fst . runStateP s+{-# 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 = fmap snd . runStateP s+{-# 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 = go mempty+ where+ go w p = case p of+ Request a' fa -> Request a' (\a -> go w (fa a ))+ Respond b fb' -> Respond b (\b' -> go w (fb' b'))+ Pure r -> Pure (r, w)+ M m -> M (do+ (p', w') <- W.runWriterT m+ let wt = mappend w w'+ wt `seq` return (go wt 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 = fmap snd . runWriterP+{-# 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)+ => i+ -> s+ -> Proxy a' a b' b (RWS.RWST i w s m) r+ -> Proxy a' a b' b m (r, s, w)+runRWSP i = go mempty+ where+ go w s p = case p of+ Request a' fa -> Request a' (\a -> go w s (fa a ))+ Respond b fb' -> Respond b (\b' -> go w s (fb' b'))+ Pure r -> Pure (r, s, w)+ M m -> M (do+ (p', s', w') <- RWS.runRWST m i s+ let wt = mappend w w'+ wt `seq` return (go w' s' p') )+{-# INLINABLE runRWSP #-}++-- | Evaluate 'RWS.RWST' in the base monad+evalRWSP :: (Monad m, Monoid w)+ => i+ -> s+ -> Proxy a' a b' b (RWS.RWST i w s m) r+ -> Proxy a' a b' b m (r, w)+evalRWSP i s = fmap go . runRWSP i s+ where go (r, _, w) = (r, w)+{-# INLINABLE evalRWSP #-}++-- | Execute 'RWS.RWST' in the base monad+execRWSP :: (Monad m, Monoid w)+ => i+ -> s+ -> Proxy a' a b' b (RWS.RWST i w s m) r+ -> Proxy a' a b' b m (s, w)+execRWSP i s = fmap go . runRWSP i s+ where go (_, s', w) = (s', w)+{-# INLINABLE execRWSP #-}
+ src/Pipes/Prelude.hs view
@@ -0,0 +1,629 @@+{-| 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 upcoming 'ByteString' and+ 'Text' utilities for @pipes@ will preserve newlines.+-}++{-# LANGUAGE RankNTypes #-}+{-# OPTIONS_GHC -fno-warn-unused-do-bind #-}++module Pipes.Prelude (+ -- * Producers+ -- $producers+ stdinLn,+ readLn,+ fromHandle,+ replicateM,++ -- * Consumers+ -- $consumers+ stdoutLn,+ print,+ toHandle,++ -- * Pipes+ -- $pipes+ map,+ mapM,+ filter,+ filterM,+ take,+ takeWhile,+ drop,+ dropWhile,+ concat,+ elemIndices,+ findIndices,+ scan,+ scanM,+ chain,+ read,+ show,++ -- * Folds+ -- $folds+ fold,+ foldM,+ all,+ any,+ and,+ or,+ elem,+ notElem,+ find,+ findIndex,+ head,+ index,+ last,+ length,+ maximum,+ minimum,+ null,+ sum,+ product,+ toList,+ toListM,++ -- * Zips+ zip,+ zipWith,++ -- * Utilities+ tee,+ generalize+ ) where++import Control.Exception (throwIO, try)+import Control.Monad (liftM, replicateM_, when, unless)+import Control.Monad.Trans.State.Strict (get, put)+import Data.Functor.Identity (Identity, runIdentity)+import Data.Void (absurd)+import Foreign.C.Error (Errno(Errno), ePIPE)+import qualified GHC.IO.Exception as G+import Pipes+import Pipes.Core+import Pipes.Internal+import Pipes.Lift (evalStateP)+import qualified System.IO as IO+import qualified Prelude+import Prelude hiding (+ all,+ and,+ any,+ concat,+ drop,+ dropWhile,+ elem,+ filter,+ head,+ last,+ length,+ map,+ mapM,+ maximum,+ minimum,+ notElem,+ null,+ or,+ print,+ product,+ read,+ readLn,+ show,+ sum,+ take,+ takeWhile,+ zip,+ zipWith )++{- $producers+ Use 'for' loops to iterate over 'Producer's whenever you want to perform the+ same action for every element:++> -- Echo all lines from standard input to standard output+> runEffect $ for P.stdinLn $ \str -> do+> lift $ putStrLn str++ ... or more concisely:++>>> runEffect $ for P.stdinLn (lift . putStrLn)+Test<Enter>+Test+ABC<Enter>+ABC+...++-}++{-| Read 'String's from 'IO.stdin' using 'getLine'++ Terminates on end of input+-}+stdinLn :: (MonadIO m) => Producer' String m ()+stdinLn = fromHandle IO.stdin+{-# INLINABLE stdinLn #-}++-- | 'read' values from 'IO.stdin', ignoring failed parses+readLn :: (MonadIO m) => (Read a) => Producer' a m ()+readLn = stdinLn >-> read+{-# INLINABLE readLn #-}++{-| Read 'String's from a 'IO.Handle' using 'IO.hGetLine'++ Terminates on end of input+-}+fromHandle :: (MonadIO m) => IO.Handle -> Producer' String m ()+fromHandle h = go+ where+ go = do+ eof <- liftIO $ IO.hIsEOF h+ unless eof $ do+ str <- liftIO $ IO.hGetLine h+ yield str+ go+{-# INLINABLE fromHandle #-}++-- | Repeat a monadic action a fixed number of times, 'yield'ing each result+replicateM :: (Monad m) => Int -> m a -> Producer a m ()+replicateM n m = lift m >~ take n+{-# INLINABLE replicateM #-}++{- $consumers+ Feed a 'Consumer' the same value repeatedly using ('>~'):++>>> runEffect $ lift getLine >~ P.stdoutLn+Test<Enter>+Test+ABC<Enter>+ABC+...++-}++{-| Write 'String's to 'IO.stdout' using 'putStrLn'++ Unlike 'toHandle', 'stdoutLn' gracefully terminates on a broken output pipe+-}+stdoutLn :: (MonadIO m) => Consumer' String m ()+stdoutLn = go+ where+ go = do+ str <- await+ x <- liftIO $ try (putStrLn str)+ case x of+ Left (G.IOError { G.ioe_type = G.ResourceVanished+ , G.ioe_errno = Just ioe })+ | Errno ioe == ePIPE+ -> return ()+ Left e -> liftIO (throwIO e)+ Right () -> go+{-# INLINABLE stdoutLn #-}++-- | 'print' values to 'IO.stdout'+print :: (MonadIO m) => (Show a) => Consumer' a m r+print = for cat (liftIO . Prelude.print)+{-# INLINABLE print #-}++-- | Write 'String's to a 'IO.Handle' using 'IO.hPutStrLn'+toHandle :: (MonadIO m) => IO.Handle -> Consumer' String m r+toHandle handle = for cat $ \str -> liftIO (IO.hPutStrLn handle str)+{-# INLINABLE toHandle #-}++{- $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 :: (Monad m) => (a -> b) -> Pipe a b m r+map f = for cat (yield . f)+{-# INLINABLE map #-}++-- | Apply a monadic function to all values flowing downstream+mapM :: (Monad m) => (a -> m b) -> Pipe a b m r+mapM f = for cat $ \a -> do+ b <- lift (f a)+ yield b+{-# INLINABLE mapM #-}++-- | @(filter predicate)@ only forwards values that satisfy the predicate.+filter :: (Monad m) => (a -> Bool) -> Pipe a a m r+filter predicate = for cat $ \a -> when (predicate a) (yield a)+{-# INLINABLE filter #-}++{-| @(filterM predicate)@ only forwards values that satisfy the monadic+ predicate+-}+filterM :: (Monad m) => (a -> m Bool) -> Pipe a a m r+filterM predicate = for cat $ \a -> do+ b <- lift (predicate a)+ when b (yield a)+{-# INLINABLE filterM #-}++-- | @(take n)@ only allows @n@ values to pass through+take :: (Monad m) => Int -> Pipe a a m ()+take n = replicateM_ n $ do+ a <- await+ yield a+{-# INLINABLE take #-}++{-| @(takeWhile p)@ allows values to pass downstream so long as they satisfy+ the predicate @p@.+-}+takeWhile :: (Monad m) => (a -> Bool) -> Pipe a a m ()+takeWhile predicate = go+ where+ go = do+ a <- await+ if (predicate a)+ then do+ yield a+ go+ else return ()+{-# INLINABLE takeWhile #-}++-- | @(drop n)@ discards @n@ values going downstream+drop :: (Monad m) => Int -> Pipe a a m r+drop n = do+ replicateM_ n await+ cat+{-# INLINABLE drop #-}++{-| @(dropWhile p)@ discards values going downstream until one violates the+ predicate @p@.+-}+dropWhile :: (Monad m) => (a -> Bool) -> Pipe a a m r+dropWhile predicate = go+ where+ go = do+ a <- await+ if (predicate a)+ then go+ else do+ yield a+ cat+{-# INLINABLE dropWhile #-}++-- | Flatten all 'Foldable' elements flowing downstream+concat :: (Monad m, Foldable f) => Pipe (f a) a m r+concat = for cat each+{-# INLINABLE concat #-}++-- | Outputs the indices of all elements that match the given element+elemIndices :: (Monad m, Eq a) => a -> Pipe a Int m r+elemIndices a = findIndices (a ==)+{-# INLINABLE elemIndices #-}++-- | Outputs the indices of all elements that satisfied the predicate+findIndices :: (Monad m) => (a -> Bool) -> Pipe a Int m r+findIndices predicate = loop 0+ where+ loop n = do+ a <- await+ when (predicate a) (yield n)+ loop $! n + 1+{-# INLINABLE findIndices #-}++-- | Strict left scan+scan :: (Monad m) => (x -> a -> x) -> x -> (x -> b) -> Pipe a b m r+scan step begin done = loop begin+ where+ loop x = do+ yield (done x)+ a <- await+ let x' = step x a+ loop $! x'+{-# INLINABLE scan #-}++-- | Strict, monadic left scan+scanM :: (Monad m) => (x -> a -> m x) -> m x -> (x -> m b) -> Pipe a b m r+scanM step begin done = do+ x <- lift begin+ loop x+ where+ loop x = do+ b <- lift (done x)+ yield b+ a <- await+ x' <- lift (step x a)+ loop $! x'+{-# INLINABLE scanM #-}++-- | Apply an action to all values flowing downstream+chain :: (Monad m) => (a -> m ()) -> Pipe a a m r+chain f = for cat $ \a -> do+ lift (f a)+ yield a+{-# INLINABLE chain #-}++-- | Parse 'Read'able values, only forwarding the value if the parse succeeds+read :: (Monad m, Read a) => Pipe String a m r+read = for cat $ \str -> case (reads str) of+ [(a, "")] -> yield a+ _ -> return ()+{-# INLINABLE read #-}++-- | Convert 'Show'able values to 'String's+show :: (Monad m, Show a) => Pipe a String m r+show = map Prelude.show+{-# INLINABLE show #-}++{- $folds+ Use these to fold the output of a 'Producer'. Many of these folds will stop+ drawing elements if they can compute their result early, like 'any':++>>> P.any null P.stdinLn+Test<Enter>+ABC<Enter>+<Enter>+True+>>>++-}++-- | Strict fold of the elements of a 'Producer'+fold :: (Monad m) => (x -> a -> x) -> x -> (x -> b) -> Producer a m () -> m b+fold step begin done p0 = loop p0 begin+ where+ loop p x = case p of+ Request v _ -> absurd v+ Respond a fu -> loop (fu ()) $! step x a+ M m -> m >>= \p' -> loop p' x+ Pure _ -> return (done x)+{-# INLINABLE fold #-}++-- | Strict, monadic fold of the elements of a 'Producer'+foldM+ :: (Monad m)+ => (x -> a -> m x) -> m x -> (x -> m b) -> Producer a m () -> m b+foldM step begin done p0 = do+ x0 <- begin+ loop p0 x0+ where+ loop p x = case p of+ Request v _ -> absurd v+ Respond a fu -> do+ x' <- step x a+ loop (fu ()) $! x'+ M m -> m >>= \p' -> loop p' x+ Pure _ -> done x+{-# 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 $ for p $ \a -> when (not $ predicate a) (yield 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 $ for p $ \a -> when (predicate a) (yield a)+{-# 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 $ for p $ \a -> when (predicate a) (yield a)+{-# 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+ case x of+ Left _ -> return Nothing+ Right (a, _) -> return (Just a)+{-# INLINABLE head #-}++-- | Index into a 'Producer'+index :: (Monad m) => Int -> Producer a m () -> m (Maybe a)+index n p = head (p >-> drop n)+{-# INLINABLE index #-}++-- | Retrieve the last element from a 'Producer'+last :: (Monad m) => Producer a m () -> m (Maybe a)+last p0 = do+ x <- next p0+ case x of+ Left _ -> return Nothing+ Right (a, p') -> loop a p'+ where+ loop a p = do+ x <- next p+ case x of+ Left _ -> return (Just a)+ Right (a', p') -> loop a' p'+{-# INLINABLE last #-}++-- | Count the number of elements in a 'Producer'+length :: (Monad m) => Producer a m () -> m Int+length = fold (\n _ -> n + 1) 0 id+{-# INLINABLE length #-}++-- | Find the maximum element of a 'Producer'+maximum :: (Monad m, Ord a) => Producer a m () -> m (Maybe a)+maximum = fold step Nothing id+ where+ step x a = Just $ case x of+ Nothing -> a+ Just a' -> max a a'+{-# INLINABLE maximum #-}++-- | Find the minimum element of a 'Producer'+minimum :: (Monad m, Ord a) => Producer a m () -> m (Maybe a)+minimum = fold step Nothing id+ where+ step x a = Just $ case x of+ Nothing -> a+ Just a' -> min a a'+{-# INLINABLE minimum #-}++-- | Determine if a 'Producer' is empty+null :: (Monad m) => Producer a m () -> m Bool+null p = do+ x <- next p+ return $ case x of+ Left _ -> True+ Right _ -> False+{-# INLINABLE null #-}++-- | Compute the sum of the elements of a 'Producer'+sum :: (Monad m, Num a) => Producer a m () -> m a+sum = fold (+) 0 id+{-# INLINABLE sum #-}++-- | Compute the product of the elements of a 'Producer'+product :: (Monad m, Num a) => Producer a m () -> m a+product = fold (*) 1 id+{-# INLINABLE product #-}++-- | Convert a pure 'Producer' into a list+toList :: Producer a Identity () -> [a]+toList = loop+ where+ loop p = case p of+ Request v _ -> absurd v+ Respond a fu -> a:loop (fu ())+ M m -> loop (runIdentity m)+ Pure _ -> []+{-# INLINABLE toList #-}++{-| Convert an effectful 'Producer' into a list++ Note: 'toListM' is not an idiomatic use of @pipes@, but I provide it for+ simple testing purposes. Idiomatic @pipes@ style consumes the elements+ immediately as they are generated instead of loading all elements into+ memory.+-}+toListM :: (Monad m) => Producer a m () -> m [a]+toListM = loop+ where+ loop p = case p of+ Request v _ -> absurd v+ Respond a fu -> do+ as <- loop (fu ())+ return (a:as)+ M m -> m >>= loop+ Pure _ -> return []+{-# INLINABLE toListM #-}++-- | Zip two 'Producer's+zip :: (Monad m)+ => (Producer a m r)+ -> (Producer b m r)+ -> (Producer' (a, b) m r)+zip = zipWith (,)+{-# INLINABLE zip #-}++-- | Zip two 'Producer's using the provided combining function+zipWith :: (Monad m)+ => (a -> b -> c)+ -> (Producer a m r)+ -> (Producer b m r)+ -> (Producer' c m r)+zipWith f = go+ where+ go p1 p2 = do+ e1 <- lift $ next p1+ case e1 of+ Left r -> return r+ Right (a, p1') -> do+ e2 <- lift $ next p2+ case e2 of+ Left r -> return r+ Right (b, p2') -> do+ yield (f a b)+ go p1' p2'+{-# INLINABLE zipWith #-}++{-| Transform a 'Consumer' to a 'Pipe' that reforwards all values further+ downstream+-}+tee :: (Monad m) => Consumer a m r -> Pipe a a m r+tee p = evalStateP Nothing $ do+ r <- up >\\ (hoist lift p //> dn)+ ma <- lift get+ case ma of+ Nothing -> return ()+ Just a -> yield a+ return r+ where+ up () = do+ ma <- lift get+ case ma of+ Nothing -> return ()+ Just a -> yield a+ a <- await+ lift $ put (Just a)+ return a+ dn v = absurd v+{-# INLINABLE tee #-}++{-| Transform a unidirectional 'Pipe' to a bidirectional 'Proxy'++> generalize (f >-> g) = generalize f >+> generalize g+>+> generalize cat = pull+-}+generalize :: (Monad m) => Pipe a b m r -> x -> Proxy x a x b m r+generalize p x0 = evalStateP x0 $ up >\\ hoist lift p //> dn+ where+ up () = do+ x <- lift get+ request x+ dn a = do+ x <- respond a+ lift $ put x+{-# INLINABLE generalize #-}
+ src/Pipes/Tutorial.hs view
@@ -0,0 +1,1422 @@+{-# OPTIONS_GHC -fno-warn-unused-imports #-}++{-| Conventional Haskell stream programming forces you to choose only two of the+ following three features:++ * Effects++ * Streaming++ * Composability++ If you sacrifice /Effects/ you get Haskell's pure and lazy lists, which you+ can transform using composable functions in constant space, but without+ interleaving effects.++ If you sacrifice /Streaming/ you get 'mapM', 'forM' and+ \"ListT done wrong\", which are composable and effectful, but do not return+ a single result until the whole list has first been processed and loaded+ into memory.++ If you sacrifice /Composability/ you write a tightly coupled read,+ transform, and write loop in 'IO', which is streaming and effectful, but is+ not modular or separable.++ @pipes@ gives you all three features: effectful, streaming, and composable+ programming. @pipes@ also provides a wide variety of stream programming+ abstractions which are all subsets of a single unified machinery:++ * effectful 'Producer's (like generators),++ * effectful 'Consumer's (like iteratees),++ * effectful 'Pipe's (like Unix pipes), and:++ * 'ListT' done right.++ All of these are connectable and you can combine them together in clever and+ unexpected ways because they all share the same underlying type.++ @pipes@ requires a basic understanding of monad transformers, which you can+ learn about by reading either:++ * the paper \"Monad Transformers - Step by Step\",++ * chapter 18 of \"Real World Haskell\" on monad transformers, or:++ * the documentation of the @transformers@ library.++ If you want a Quick Start guide to @pipes@, read the documentation in+ "Pipes.Prelude" from top to bottom.++ This tutorial is more extensive and explains the @pipes@ API in greater+ detail and illustrates several idioms.+-}++module Pipes.Tutorial (+ -- * Introduction+ -- $introduction++ -- * Producers+ -- $producers++ -- * Composability+ -- $composability++ -- * Consumers+ -- $consumers++ -- * Pipes+ -- $pipes++ -- * ListT+ -- $listT++ -- * Tricks+ -- $tricks++ -- * Conclusion+ -- $conclusion++ -- * Appendix: Types+ -- $types+ ) where++import Control.Category+import Control.Monad+import Control.Monad.Trans.Error+import Control.Monad.Trans.Writer.Strict+import Pipes+import Pipes.Lift+import qualified Pipes.Prelude as P+import Prelude hiding ((.), id)++{- $introduction+ The @pipes@ library decouples stream processing stages from each other so+ that you can mix and match diverse stages to produce useful streaming+ programs. If you are a library writer, @pipes@ lets you package up+ streaming components into a reusable interface. If you are an application+ writer, @pipes@ lets you connect pre-made streaming components with minimal+ effort to produce a highly-efficient program that streams data in constant+ memory.++ To enforce loose coupling, components can only communicate using two+ commands:++ * 'yield': Send output data++ * 'await': Receive input data++ @pipes@ has four types of components built around these two commands:++ * 'Producer's can only 'yield' values and they model streaming sources++ * 'Consumer's can only 'await' values and they model streaming sinks++ * 'Pipe's can both 'yield' and 'await' values and they model stream+ transformations++ * 'Effect's can neither 'yield' nor 'await' and they model non-streaming+ components++ You can connect these components together in four separate ways which+ parallel the four above types:++ * 'for' handles 'yield's++ * ('>~') handles 'await's++ * ('>->') handles both 'yield's and 'await's++ * ('>>=') handles return values++ As you connect components their types will change to reflect inputs and+ outputs that you've fused away. You know that you're done connecting things+ when you get an 'Effect', meaning that you have handled all inputs and+ outputs. You run this final 'Effect' to begin streaming.+-}++{- $producers+ 'Producer's are effectful streams of input. Specifically, a 'Producer' is a+ monad transformer that extends any base monad with a new 'yield' command.+ This 'yield' command lets you send output downstream to an anonymous+ handler, decoupling how you generate values from how you consume them.++ The following @stdinLn@ 'Producer' shows how to incrementally read in+ 'String's from standard input and 'yield' them downstream, terminating+ gracefully when reaching the end of the input:++> -- echo.hs+>+> import Control.Monad (unless)+> import Pipes+> import System.IO (isEOF)+>+> -- +--------+-- A 'Producer' that yields 'String's+> -- | |+> -- | | +-- Every monad transformer has a base monad.+> -- | | | This time the base monad is 'IO'.+> -- | | | +> -- | | | +-- Every monadic action has a return value.+> -- | | | | This action returns '()' when finished+> -- v v v v+> stdinLn :: Producer String IO ()+> stdinLn = do+> eof <- lift isEOF -- 'lift' an 'IO' action from the base monad+> unless eof $ do+> str <- lift getLine+> yield str -- 'yield' the 'String'+> stdinLn -- Loop++ 'yield' emits a value, suspending the current 'Producer' until the value is+ consumed. If nobody consumes the value (which is possible) then 'yield'+ never returns. You can think of 'yield' as having the following type:++@+ 'yield' :: 'Monad' m => a -> 'Producer' a m ()+@++ The true type of 'yield' is actually more general and powerful. Throughout+ the tutorial I will present type signatures like this that are simplified at+ first and then later reveal more general versions. So read the above type+ signature as simply saying: \"You can use 'yield' within a 'Producer', but+ you may be able to use 'yield' in other contexts, too.\"++ Click the link to 'yield' to navigate to its documentation. There you will+ see that 'yield' actually uses the 'Producer'' (with an apostrophe) type+ synonym which hides a lot of polymorphism behind a simple veneer. The+ documentation for 'yield' says that you can also use 'yield' within a+ 'Pipe', too, because of this polymorphism:++@+ 'yield' :: 'Monad' m => a -> 'Pipe' x a m ()+@++ Use simpler types like these to guide you until you understand the fully+ general type.++ 'for' loops are the simplest way to consume a 'Producer' like @stdinLn@.+ 'for' has the following type:++@+ \-\- +-- Producer +-- The body of the +-- Result+ \-\- | to loop | loop |+ \-\- v over v v+ \-\- -------------- ------------------ ----------+ 'for' :: 'Monad' m => 'Producer' a m r -> (a -> 'Effect' m ()) -> 'Effect' m r+@++ @(for producer body)@ loops over @(producer)@, substituting each 'yield' in+ @(producer)@ with @(body)@.++ You can also deduce that behavior purely from the type signature:++ * The body of the loop takes exactly one argument of type @(a)@, which is+ the same as the output type of the 'Producer'. Therefore, the body of the+ loop must get its input from that 'Producer' and nowhere else.++ * The return value of the input 'Producer' matches the return value of the+ result, therefore 'for' must loop over the entire 'Producer' and not skip+ anything.++ The above type signature is not the true type of 'for', which is actually+ more general. Think of the above type signature as saying: \"If the first+ argument of 'for' is a 'Producer' and the second argument returns an+ 'Effect', then the final result must be an 'Effect'.\"++ Click the link to 'for' to navigate to its documentation. There you will+ see the fully general type and underneath you will see equivalent simpler+ types. One of these says that if the body of the loop is a 'Producer', then+ the result is a 'Producer', too:++@+ 'for' :: 'Monad' m => 'Producer' a m r -> (a -> 'Producer' b m ()) -> 'Producer' b m r+@++ The first type signature I showed for 'for' was a special case of this+ slightly more general signature because a 'Producer' that never 'yield's is+ also an 'Effect':++@+ data 'Void' -- The uninhabited type++\ type 'Effect' m r = 'Producer' 'Void' 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 \'Void\'+ 'for' :: 'Monad' m => 'Producer' a m r -> (a -> 'Producer' 'Void' m ()) -> 'Producer' 'Void' m r++\ -- Producer Void = Effect+ 'for' :: 'Monad' m => 'Producer' a m r -> (a -> 'Effect' m ()) -> 'Effect' m r+@++ This is the same trick that all @pipes@ functions use to work with various+ combinations of 'Producer's, 'Consumer's, 'Pipe's, and 'Effect's. Each+ function really has just one general type, which you can then simplify down+ to multiple useful alternative types.++ Here's an example use of a 'for' @loop@, where the second argument (the+ loop body) is an 'Effect':++> -- echo.hs+>+> loop :: Effect IO ()+> loop = for stdinLn $ \str -> do -- Read this like: "for str in stdinLn"+> lift $ putStrLn str -- The body of the 'for' loop+>+> -- more concise: loop = for stdinLn (lift . putStrLn)++ In this example, 'for' loops over @stdinLn@ and replaces every 'yield' in+ @stdinLn@ with the body of the loop, printing each line. This is exactly+ equivalent to the following code, which I've placed side-by-side with the+ original definition of @stdinLn@ for comparison:++> loop = do | stdinLn = do+> eof <- lift isEOF | eof <- lift isEOF+> unless eof $ do | unless eof $ do+> str <- lift getLine | str <- lift getLine+> (lift . putStrLn) str | yield str+> loop | stdinLn++ You can think of 'yield' as creating a hole and a 'for' loop is one way to+ fill that hole.++ Notice how the final @loop@ only 'lift's actions from the base monad and+ does nothing else. This property is true for all 'Effect's, which are just+ glorified wrappers around actions in the base monad. This means we can run+ these 'Effect's to remove their 'lift's and lower them back to the+ equivalent computation in the base monad:++@+ 'runEffect' :: 'Monad' m => 'Effect' m r -> m r+@++ This is the real type signature of 'runEffect', which refuses to accept+ anything other than an 'Effect'. This ensures that we handle all inputs and+ outputs before streaming data:++> -- echo.hs+>+> main :: IO ()+> main = runEffect loop++ ... or you could inline the entire @loop@ into the following one-liner:++> main = runEffect $ for stdinLn (lift . putStrLn)++ Our final program loops over standard input and echoes every line to+ standard output until we hit @Ctrl-D@ to end the input stream:++> $ ghc -O2 echo.hs+> $ ./echo+> Test<Enter>+> Test+> ABC<Enter>+> ABC+> <Ctrl-D>+> $++ The final behavior is indistinguishable from just removing all the 'lift's+ from @loop@:++> main = do | loop = do+> eof <- isEof | eof <- lift isEof+> unless eof $ do | unless eof $ do+> str <- getLine | str <- lift getLine+> putStrLn str | (lift . putStrLn) str+> main | loop++ This @main@ is what we might have written by hand if we were not using+ @pipes@, but with @pipes@ we can decouple the input and output logic from+ each other. When we connect them back together, we still produce streaming+ code equivalent to what a sufficiently careful Haskell programmer would+ have written.++ You can also use 'for' to loop over lists, too. To do so, convert the list+ to a 'Producer' using 'each', which is exported by default from "Pipes":++> each :: (Monad m) => [a] -> Producer a m ()+> each as = mapM_ yield as++ Combine 'for' and 'each' to iterate over lists using a \"foreach\" loop:++>>> runEffect $ for (each [1..4]) (lift . print)+1+2+3+4++ 'each' is actually more general and works for any 'Foldable':++@+ 'each' :: ('Monad' m, 'Foldable' f) => f a -> 'Producer' a m ()+@++ So you can loop over any 'Foldable' container or even a 'Maybe':++>>> runEffect $ for (each (Just 1)) (lift . print)+1++-}++{- $composability+ You might wonder why the body of a 'for' loop can be a 'Producer'. Let's+ test out this feature by defining a new loop body that @duplicate@s every+ value:++> -- nested.hs+>+> import Pipes+> import qualified Pipes.Prelude as P -- Pipes.Prelude already has 'stdinLn'+> +> duplicate :: (Monad m) => a -> Producer a m ()+> duplicate x = do+> yield x+> yield x+>+> loop :: Producer String IO ()+> loop = for P.stdinLn duplicate+>+> -- This is the exact same as:+> --+> -- loop = for P.stdinLn $ \x -> do+> -- yield x+> -- yield x++ This time our @loop@ is a 'Producer' that outputs 'String's, specifically+ two copies of each line that we read from standard input. Since @loop@ is a+ 'Producer' we cannot run it because there is still unhandled output.+ However, we can use yet another 'for' to handle this new duplicated stream:++> -- nested.hs+>+> main = runEffect $ for loop (lift . putStrLn)++ This creates a program which echoes every line from standard input to+ standard output twice:++> $ ./nested+> Test<Enter>+> Test+> Test+> ABC<Enter>+> ABC+> ABC+> <Ctrl-D>+> $++ But is this really necessary? Couldn't we have instead written this using a+ nested for loop?++> main = runEffect $+> for P.stdinLn $ \str1 ->+> for (duplicate str1) $ \str2 ->+> lift $ putStrLn str2++ Yes, we could have! In fact, this is a special case of the following+ equality, which always holds no matter what:++@+ \-\- s :: (Monad m) => 'Producer' a m () -- i.e. \'P.stdinLn\'+ \-\- f :: (Monad m) => a -> 'Producer' b m () -- i.e. \'duplicate\'+ \-\- g :: (Monad m) => b -> 'Producer' c m () -- i.e. \'(lift . putStrLn)\'++\ for (for s f) g = for s (\\x -> for (f x) g)+@++ We can understand the rationale behind this equality if we first define the+ following operator that is the point-free counterpart to 'for':++@+ (~>) :: (Monad m)+ => (a -> 'Producer' b m r)+ -> (b -> 'Producer' c m r)+ -> (a -> 'Producer' c m r)+ (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 r+ g :: (Monad m) => b -> 'Producer' c m r+ h :: (Monad m) => c -> 'Producer' d m r++\ \-\- Associativity+ (f ~> g) ~> h = f ~> (g ~> h)+@++ This looks just like an associativity law. In fact, ('~>') has another nice+ property, which is that 'yield' is its left and right identity:++> -- Left Identity+> yield ~> f = f++> -- Right Identity+> f ~> yield = f++ In other words, 'yield' and ('~>') form a 'Category', specifically the+ generator category, where ('~>') plays the role of the composition operator+ and 'yield' is the identity. If you don't know what a 'Category' is, that's+ okay, and category theory is not a prerequisite for using @pipes@. All you+ really need to know is that @pipes@ uses some simple category theory to keep+ the API intuitive and easy to use.++ Notice that if we translate the left identity law to use 'for' instead of+ ('~>') we get:++> for (yield x) f = f x++ This just says that if you iterate over a pure single-element 'Producer',+ then you could instead cut out the middle man and directly apply the body of+ the loop to that single element.++ If we translate the right identity law to use 'for' instead of ('~>') we+ get:++> for s yield = s++ This just says that if the only thing you do is re-'yield' every element of+ a stream, you get back your original stream.++ These three \"for loop\" laws summarize our intuition for how 'for' loops+ should behave and because these are 'Category' laws in disguise that means+ that 'Producer's are composable in a rigorous sense of the word.++ In fact, we get more out of this than just a bunch of equations. We also+ get a useful operator: ('~>'). We can use this operator to condense+ our original code into the following more succinct form that composes two+ transformations:++> main = runEffect $ for P.stdinLn (duplicate ~> lift . putStrLn)++ This means that we can also choose to program in a more functional style and+ think of stream processing in terms of composing transformations using+ ('~>') instead of nesting a bunch of 'for' loops.++ The above example is a microcosm of the design philosophy behind the @pipes@+ library:++ * Define the API in terms of categories++ * Specify expected behavior in terms of category laws++ * Think compositionally instead of sequentially+-}++{- $consumers+ Sometimes you don't want to use a 'for' loop because you don't want to consume+ every element of a 'Producer' or because you don't want to process every+ value of a 'Producer' the exact same way.++ The most general solution is to externally iterate over the 'Producer' using+ the 'next' command:++@+ 'next' :: 'Monad' m => 'Producer' a m r -> m ('Either' r (a, 'Producer' a m r))+@++ Think of 'next' as pattern matching on the head of the 'Producer'. This+ 'Either' returns a 'Left' if the 'Producer' is done or it returns a 'Right'+ containing the next value, @a@, along with the remainder of the 'Producer'.++ However, sometimes we can get away with something a little more simple and+ elegant, like a 'Consumer', which represents an effectful sink of values. A+ 'Consumer' is a monad transformer that extends the base monad with a new+ 'await' command. This 'await' command lets you receive input from an+ anonymous upstream source.++ The following @stdoutLn@ 'Consumer' shows how to incrementally 'await'+ 'String's and print them to standard output, terminating gracefully when+ receiving a broken pipe error:++> import Control.Monad (unless)+> import Control.Exception (try, throwIO)+> import qualified GHC.IO.Exception as G+> import Pipes+>+> -- +--------+-- A 'Consumer' that awaits 'String's+> -- | |+> -- v v+> stdoutLn :: Consumer String IO ()+> stdoutLn = do+> str <- await -- 'await' a 'String'+> x <- lift $ try $ putStrLn str+> case x of+> -- Gracefully terminate if we got a broken pipe error+> Left e@(G.IOError { G.ioe_type = t}) ->+> lift $ unless (t == G.ResourceVanished) $ throwIO e+> -- Otherwise loop+> Right () -> stdoutLn++ 'await' is the dual of 'yield': we suspend our 'Consumer' until we receive a+ new value. If nobody provides a value (which is possible) then 'await'+ never returns. You can think of 'await' as having the following type:++@+ 'await' :: 'Monad' m => 'Consumer' a m a+@++ One way to feed a 'Consumer' is to repeatedly feed the same input using+ using ('>~') (pronounced \"feed\"):++@+ \-\- +- Feed +- Consumer to +- Returns new+ \-\- | action | feed | Effect+ \-\- v v v + \-\- ---------- -------------- ----------+ ('>~') :: 'Monad' m => 'Effect' m b -> 'Consumer' b m c -> 'Effect' m c+@++ @(draw >~ consumer)@ loops over @(consumer)@, substituting each 'await' in+ @(consumer)@ with @(draw)@.++ So the following code replaces every 'await' in 'P.stdoutLn' with+ @(lift getLine)@ and then removes all the 'lift's:++>>> runEffect $ lift getLine >~ stdoutLn+Test<Enter>+Test+ABC<Enter>+ABC+42<Enter>+42+...++ You might wonder why ('>~') uses an 'Effect' instead of a raw action in the+ base monad. The reason why is that ('>~') actually permits the following+ more general type:++@+ ('>~') :: 'Monad' m => 'Consumer' a m b -> 'Consumer' b m c -> 'Consumer' a m c+@++ ('>~') is the dual of ('~>'), composing 'Consumer's instead of 'Producer's.++ This means that you can feed a 'Consumer' with yet another 'Consumer' so+ that you can 'await' while you 'await'. For example, we could define the+ following intermediate 'Consumer' that requests two 'String's and returns+ them concatenated:++> doubleUp :: (Monad m) => Consumer String m String+> doubleUp = do+> str1 <- await+> str2 <- await+> return (str1 ++ str2)+>+> -- more concise: doubleUp = (++) <$> await <*> await++ We can now insert this in between @(lift getLine)@ and @stdoutLn@ and see+ what happens:++>>> runEffect $ lift getLine >~ doubleUp >~ stdoutLn+Test<Enter>+ing<Enter>+Testing+ABC<Enter>+DEF<Enter>+ABCDEF+42<Enter>+000<Enter>+42000+...++ 'doubleUp' splits every request from 'stdoutLn' into two separate requests+ and+ returns back the concatenated result.++ We didn't need to parenthesize the above chain of ('>~') operators, because+ ('>~') is associative:++> -- Associativity+> (f >~ g) >~ h = f >~ (g >~ h)++ ... so we can always omit the parentheses since the meaning is unambiguous:++> f >~ g >~ h++ Also, ('>~') has an identity, which is 'await'!++> -- Left identity+> await >~ f = f+>+> -- Right Identity+> f >~ await = f++ In other words, ('>~') and 'await' form a 'Category', too, specifically the+ iteratee category, and 'Consumer's are also composable.+-}++{- $pipes+ Our previous programs were unsatisfactory because they were biased either+ towards the 'Producer' end or the 'Consumer' end. As a result, we had to+ choose between gracefully handling end of input (using 'P.stdinLn') or+ gracefully handling end of output (using 'P.stdoutLn'), but not both at the+ same time.++ However, we don't need to restrict ourselves to using 'Producer's+ exclusively or 'Consumer's exclusively. We can connect 'Producer's and+ 'Consumer's directly together using ('>->') (pronounced \"pipe\"):++@+ ('>->') :: 'Monad' m => 'Producer' a m r -> 'Consumer' a m r -> 'Effect' m r+@++ This returns an 'Effect' which we can run:++> -- echo2.hs+>+> import Pipes+> import qualified Pipes.Prelude as P -- Pipes.Prelude also provides 'stdoutLn'+>+> main = runEffect $ P.stdinLn >-> P.stdoutLn++ This program is more declarative of our intent: we want to stream values+ from 'P.stdinLn' to 'P.stdoutLn'. The above \"pipeline\" not only echoes+ standard input to standard output, but also handles both end of input and+ broken pipe errors:++> $ ./echo2+> Test<Enter>+> Test+> ABC<Enter>+> ABC+> 42<Enter>+> 42+> <Ctrl-D>+> $++ ('>->') is \"pull-based\" meaning that control flow begins at the most+ downstream component (i.e. 'P.stdoutLn' in the above example). Any time a+ component 'await's a value it blocks and transfers control upstream and+ every time a component 'yield's a value it blocks and restores control back+ downstream, satisfying the 'await'. So in the above example, ('>->')+ matches every 'await' from 'P.stdoutLn' with a 'yield' from 'P.stdinLn'.++ Streaming stops when either 'P.stdinLn' terminates (i.e. end of input) or+ 'P.stdoutLn' terminates (i.e. broken pipe). This is why ('>->') requires+ that both the 'Producer' and 'Consumer' share the same type of return value:+ whichever one terminates first provides the return value for the entire+ 'Effect'.++ Let's test this by modifying our 'Producer' and 'Consumer' to each return a+ diagnostic 'String':++> -- echo3.hs+>+> import Control.Applicative ((<$)) -- (<$) modifies return values+> import Pipes+> import qualified Pipes.Prelude as P+> import System.IO+>+> main = do+> hSetBuffering stdout NoBuffering+> str <- runEffect $+> ("End of input!" <$ P.stdinLn) >-> ("Broken pipe!" <$ P.stdoutLn)+> hPutStrLn stderr str++ This lets us diagnose whether the 'Producer' or 'Consumer' terminated first:++> $ ./echo3+> Test<Enter>+> Test+> <Ctrl-D>+> End of input!+> $ ./echo3 | perl -e 'close STDIN'+> Test<Enter>+> Broken pipe!+> $++ You might wonder why ('>->') returns an 'Effect' that we have to run instead+ of directly returning an action in the base monad. This is because you can+ connect things other than 'Producer's and 'Consumer's, like 'Pipe's, which+ are effectful stream transformations.++ A 'Pipe' is a monad transformer that is a mix between a 'Producer' and+ 'Consumer', because a 'Pipe' can both 'await' and 'yield'. The following+ example 'Pipe' is analagous to the Prelude's 'take', only allowing a fixed+ number of values to flow through:++> -- take.hs+>+> import Control.Monad (replicateM_)+> import Pipes+> import Prelude hiding (take)+>+> -- +--------- A 'Pipe' that+> -- | +---- 'await's 'a's and+> -- | | +-- 'yield's 'a's+> -- | | |+> -- v v v+> take :: Int -> Pipe a a IO ()+> take n = do+> replicateM_ n $ do -- Repeat this block 'n' times+> x <- await -- 'await' a value of type 'a'+> yield x -- 'yield' a value of type 'a'+> lift $ putStrLn "You shall not pass!" -- Fly, you fools!++ You can use 'Pipe's to transform 'Producer's, 'Consumer's, or even other+ 'Pipe's using the same ('>->') operator:++@+ ('>->') :: 'Monad' m => 'Producer' a m r -> 'Pipe' a b m r -> 'Producer' b m r+ ('>->') :: 'Monad' m => 'Pipe' a b m r -> 'Consumer' b m r -> 'Consumer' a m r+ ('>->') :: 'Monad' m => 'Pipe' a b m r -> 'Pipe' b c m r -> 'Pipe' a c m r+@++ For example, you can compose 'P.take' after 'P.stdinLn' to limit the number+ of lines drawn from standard input:++> maxInput :: Int -> Producer String IO ()+> maxInput n = P.stdinLn >-> take n++>>> runEffect $ maxInput 3 >-> P.stdoutLn+Test<Enter>+Test+ABC<Enter>+ABC+42<Enter>+42+You shall not pass!+>>>++ ... or you can pre-compose 'P.take' before 'P.stdoutLn' to limit the number+ of lines written to standard output:++> maxOutput :: Int -> Consumer String IO ()+> maxOutput n = take n >-> P.stdoutLn++>>> runEffect $ P.stdinLn >-> maxOutput 3+<Exact same behavior>++ Those both gave the same behavior because ('>->') is associative:++> (p1 >-> p2) >-> p3 = p1 >-> (p2 >-> p3)++ Therefore we can just leave out the parentheses:++>>> runEffect $ P.stdinLn >-> take 3 >-> P.stdoutLn+<Exact same behavior>++ ('>->') is designed to behave like the Unix pipe operator, except with less+ quirks. In fact, we can continue the analogy to Unix by defining 'cat'+ (named after the Unix @cat@ utility), which reforwards elements endlessly:++> cat :: (Monad m) => Pipe a a m r+> cat = forever $ do+> x <- await+> yield x++ 'cat' is the identity of ('>->'), meaning that 'cat' satisfies the+ following two laws:++> -- Useless use of 'cat'+> cat >-> p = p+>+> -- Forwarding output to 'cat' does nothing+> p >-> cat = p++ Therefore, ('>->') and 'cat' form a 'Category', specifically the category of+ Unix pipes, and 'Pipe's are also composable.++ A lot of Unix tools have very simple definitions when written using @pipes@:++> -- unix.hs+>+> import Control.Monad (forever)+> import Pipes+> import qualified Pipes.Prelude as P -- Pipes.Prelude provides 'take', too+> import Prelude hiding (head)+>+> head :: (Monad m) => Int -> Pipe a a m ()+> head = P.take+>+> yes :: (Monad m) => Producer String m r+> yes = forever $ yield "y"+>+> main = runEffect $ yes >-> head 3 >-> P.stdoutLn++ This prints out 3 \'@y@\'s, just like the equivalent Unix pipeline:++> $ ./unix+> y+> y+> y+> $ yes | head -3+> y+> y+> y+> $++ This lets us write \"Haskell pipes\" instead of Unix pipes. These are much+ easier to build than Unix pipes and we can connect them directly within+ Haskell for interoperability with the Haskell language and ecosystem.+-}++{- $listT+ @pipes@ also provides a \"ListT done right\" implementation. This differs+ from the implementation in @transformers@ because this 'ListT':++ * obeys the monad laws, and++ * streams data immediately instead of collecting all results into memory.++ The latter property is actually an elegant consequence of obeying the monad+ laws.++ To bind a list within a 'ListT' computation, combine 'Select' and 'each':++> import Pipes+> +> pair :: ListT IO (Int, Int)+> pair = do+> x <- Select $ each [1, 2]+> lift $ putStrLn $ "x = " ++ show x+> y <- Select $ each [3, 4]+> lift $ putStrLn $ "y = " ++ show y+> return (x, y)++ You can then loop over a 'ListT' by using 'every':++@+ 'every' :: 'Monad' m => 'ListT' m a -> 'Producer' a m ()+@++ So you can use your 'ListT' within a 'for' loop:++>>> runEffect $ for (every pair) (lift . print)+x = 1+y = 3+(1,3)+y = 4+(1,4)+x = 2+y = 3+(2,3)+y = 4+(2,4)++ ... or a pipeline:++>>> import qualified Pipes.Prelude as P+>>> runEffect $ every pair >-> P.print+<Exact same behavior>++ Note that 'ListT' is lazy and only produces as many elements as we request:++>>> runEffect $ for (every pair >-> P.take 2) (lift . print)+x = 1+y = 3+(1,3)+y = 4+(1,4)++ You can also go the other way, binding 'Producer's directly within a+ 'ListT'. In fact, this is actually what 'Select' was already doing:++@+ 'Select' :: 'Producer' a m () -> 'ListT' m a+@++ This lets you write crazy code like:++> import Pipes+> import qualified Pipes.Prelude as P+> +> input :: Producer String IO ()+> input = P.stdinLn >-> P.takeWhile (/= "quit")+> +> name :: ListT IO String+> name = do+> firstName <- Select input+> lastName <- Select input+> return (firstName ++ " " ++ lastName)++ Here we're binding standard input non-deterministically (twice) as if it+ were an effectful list:++>>> runEffect $ every name >-> P.stdoutLn+Daniel<Enter>+Fischer<Enter>+Daniel Fischer+Wagner<Enter>+Daniel Wagner+quit<Enter>+Donald<Enter>+Stewart<Enter>+Donald Stewart+Duck<Enter>+Donald Duck+quit<Enter>+quit<Enter>+>>>++ Notice how this streams out values immediately as they are generated, rather+ than building up a large intermediate result and then printing all the+ values in one batch at the end.+-}++{- $tricks+ @pipes@ is more powerful than meets the eye so this section presents some+ non-obvious tricks you may find useful.++ Many pipe combinators will work on unusual pipe types and the next few+ examples will use the 'cat' pipe to demonstrate this.++ For example, you can loop over the output of a 'Pipe' using 'for', which is+ how 'P.map' is defined:++> map :: (Monad m) => (a -> b) -> Pipe a b m r+> map f = for cat $ \x -> yield (f x)+>+> -- Read this as: For all values flowing downstream, apply 'f'++ This is equivalent to:++> map f = forever $ do+> x <- await+> yield (f x)++ You can also feed a 'Pipe' input using ('>~'). This means we could have+ instead defined the @yes@ pipe like this:++> yes :: (Monad m) => Producer String m r+> yes = return "y" >~ cat+>+> -- Read this as: Keep feeding "y" downstream++ This is equivalent to:++> yes = forever $ yield "y"++ You can also sequence two 'Pipe's together. This is how 'P.drop' is+ defined:++> drop :: (Monad m) => Int -> Pipe a a m r+> drop n = do+> replicateM_ n await+> cat++ This is equivalent to:++> drop n = do+> replicateM_ n await+> forever $ do+> x <- await+> yield x++ You can even compose pipes inside of another pipe:++> customerService :: Producer String IO ()+> customerService = do+> each [ "Hello, how can I help you?" -- Begin with a script+> , "Hold for one second."+> ]+> P.stdinLn >-> P.takeWhile (/= "Goodbye!") -- Now continue with a human++ Also, you can often use 'each' in conjunction with ('~>') to traverse nested+ data structures. For example, you can print all non-'Nothing' elements+ from a doubly-nested list:++>>> runEffect $ (each ~> each ~> each ~> lift . print) [[Just 1, Nothing], [Just 2, Just 3]]+1+2+3++ Another neat thing to know is that 'every' has a more general type:++@+ 'every' :: ('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 Int+> input = do+> str <- lift getLine+> guard (str /= "Fail")++>>> 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@++ 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-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 'Void' (the+ uninhabited type) to close unused outputs:++ * 'Effect': explicitly closes both ends, forbidding 'await's and 'yield's++> type Effect = Proxy Void () () Void +>+> Upstream | Downstream+> +---------++> | |+> Void <== <== ()+> | |+> () ==> ==> Void+> | | |+> +----|----++> v+> r++ * 'Producer': explicitly closes the upstream end, forbidding 'await's++> type Producer b = Proxy Void () () b+>+> Upstream | Downstream+> +---------++> | |+> Void <== <== ()+> | |+> () ==> ==> b+> | | |+> +----|----++> v+> r++ * 'Consumer': explicitly closes the downstream end, forbidding 'yield's++> type Consumer a = Proxy () a () Void+>+> Upstream | Downstream+> +---------++> | |+> () <== <== ()+> | |+> a ==> ==> Void+> | | |+> +----|----++> 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+> +-----------+ +----------+ +------------++> | | | | | |+> Void <== <== () <== <== () <== <== ()+> | stdinLn | | take 3 | | stdoutLn |+> () ==> ==> String ==> ==> String ==> ==> Void+> | | | | | | | | |+> +-----|-----+ +----|-----+ +------|-----++> v v v+> () () ()++ Composition fuses away the intermediate interfaces, leaving behind an+ 'Effect':++> Effect+> +-----------------------------------++> | |+> Void <== <== ()+> | stdinLn >-> take 3 >-> stdoutLn |+> () ==> ==> Void+> | |+> +----------------|------------------++> 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' a 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 induce higher-rank types and require you to enable the @RankNTypes@+ extension to use them in your own type signatures.++ * They give the wrong behavior when used in the negative position of a+ function like this:++> f :: Producer' a m r -> ... -- Wrong+>+> f :: Producer a m r -> ... -- Right++ * You can't use them within other types without the @ImpredicativeTypes@+ extension:++> io :: IO (Producer' a m r) -- Type error++ * You can't partially apply them:++> stack :: MaybeT (Producer' a m) r -- Type error++ In these scenarios you should fall back on the concrete type synonyms, which+ are better behaved.++ 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 `Void' with actual type `String'+ Expected type: Effect m0 r0+ Actual type: Proxy Void () () 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 Void () () Void IO ()++ ... but 'P.stdinLn' type-checks as a 'Producer', which has the following+ type:++> Producer String IO () = Proxy Void () () String IO ()++ The fourth type variable (the output) does not match. For an 'Effect' this+ type variable should be closed (i.e. 'Void'), but 'P.stdinLn' has a 'String'+ output, thus the type error:++> Couldn't match expected type `Void' 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.+-}