pipes 4.0.2 → 4.1.0
raw patch · 8 files changed
+412/−370 lines, 8 filesdep −voiddep ~basedep ~pipes
Dependencies removed: void
Dependency ranges changed: base, pipes
Files
- LICENSE +1/−1
- pipes.cabal +9/−24
- src/Pipes.hs +37/−56
- src/Pipes/Core.hs +55/−53
- src/Pipes/Internal.hs +35/−37
- src/Pipes/Lift.hs +129/−60
- src/Pipes/Prelude.hs +64/−57
- src/Pipes/Tutorial.hs +82/−82
LICENSE view
@@ -1,4 +1,4 @@-Copyright (c) 2012, 2013 Gabriel Gonzalez+Copyright (c) 2012-2014 Gabriel Gonzalez All rights reserved. Redistribution and use in source and binary forms, with or without modification,
pipes.cabal view
@@ -1,10 +1,10 @@ Name: pipes-Version: 4.0.2+Version: 4.1.0 Cabal-Version: >= 1.10 Build-Type: Simple License: BSD3 License-File: LICENSE-Copyright: 2012, 2013 Gabriel Gonzalez+Copyright: 2012-2014 Gabriel Gonzalez Author: Gabriel Gonzalez Maintainer: Gabriel439@gmail.com Bug-Reports: https://github.com/Gabriel439/Haskell-Pipes-Library/issues@@ -17,7 +17,7 @@ . * /Concise API/: Use simple commands like 'for', ('>->'), 'await', and 'yield' .- * /Blazing fast/: Implementation tuned for speed+ * /Blazing fast/: Implementation tuned for speed, including shortcut fusion . * /Lightweight Dependency/: @pipes@ is small and compiles very rapidly, including dependencies@@ -39,21 +39,14 @@ Location: https://github.com/Gabriel439/Haskell-Pipes-Library Library- if !flag(haskell98)- Default-Language: Haskell2010- else- Default-Language: Haskell98+ Default-Language: Haskell2010 HS-Source-Dirs: src Build-Depends: base >= 4 && < 5 , transformers >= 0.2.0.0 && < 0.4,- void < 0.7-- if !flag(haskell98)- Build-Depends:- mmorph >= 1.0.0 && < 1.1,- mtl >= 2.0.1.0 && < 2.2+ mmorph >= 1.0.0 && < 1.1,+ mtl >= 2.0.1.0 && < 2.2 Exposed-Modules: Pipes,@@ -64,10 +57,6 @@ Pipes.Tutorial GHC-Options: -O2 -Wall - if flag(haskell98)- CPP-Options: -Dhaskell98-- Benchmark prelude-benchmarks Default-Language: Haskell2010 Type: exitcode-stdio-1.0@@ -79,7 +68,7 @@ base >= 4 && < 5 , criterion >= 0.6.2.1 && < 0.9, mtl >= 2.0.1.0 && < 2.2,- pipes >= 4.0.0 && < 4.1+ pipes >= 4.0.0 && < 4.2 test-suite tests Default-Language: Haskell2010@@ -90,7 +79,7 @@ Build-Depends: base >= 4 && < 5 ,- pipes >= 4.0.0 && < 4.1 ,+ pipes >= 4.0.0 && < 4.2 , QuickCheck >= 2.4 && < 3 , mtl >= 2.0.1 && < 2.2 , test-framework >= 0.4 && < 1 ,@@ -109,9 +98,5 @@ criterion >= 0.6.2.1 && < 0.9, deepseq , mtl >= 2.0.1.0 && < 2.2,- pipes >= 4.0.0 && < 4.1,+ pipes >= 4.0.0 && < 4.2, transformers >= 0.2.0.0 && < 0.4--Flag haskell98- Description: Haskell98 compliant subset of pipes.- Default: False
src/Pipes.hs view
@@ -1,25 +1,21 @@-{-| 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 , FlexibleInstances , MultiParamTypeClasses , UndecidableInstances+ , Trustworthy #-} --- The rewrite RULES require the 'TrustWorthy' annotation-#if __GLASGOW_HASKELL__ >= 702-{-# LANGUAGE Trustworthy #-}-#endif+{-| This module is the recommended entry point to the @pipes@ library. + Read "Pipes.Tutorial" if you want a tutorial explaining how to use this+ library.+-}+ module Pipes ( -- * The Proxy Monad Transformer Proxy+ , X , Effect , Effect' , runEffect@@ -62,38 +58,29 @@ -- $reexports , module Control.Monad.IO.Class , module Control.Monad.Trans.Class-#ifndef haskell98 , module Control.Monad.Morph-#endif , module Data.Foldable- , module Data.Void ) where import Control.Applicative (Applicative(pure, (<*>)), Alternative(empty, (<|>)))-import Control.Monad (MonadPlus(mzero, mplus))+import Control.Monad.Error (MonadError(..)) import Control.Monad.IO.Class (MonadIO(liftIO))+import Control.Monad (MonadPlus(mzero, mplus))+import Control.Monad.Reader (MonadReader(..))+import Control.Monad.State (MonadState(..)) import Control.Monad.Trans.Class (MonadTrans(lift)) import Control.Monad.Trans.Error (ErrorT(runErrorT)) import Control.Monad.Trans.Identity (IdentityT(runIdentityT)) import Control.Monad.Trans.Maybe (MaybeT(runMaybeT))+import Control.Monad.Writer (MonadWriter(..)) import Data.Foldable (Foldable)-import qualified Data.Foldable as F import Data.Monoid (Monoid(..))-import Data.Void (Void)-import qualified Data.Void as V-import Pipes.Internal (Proxy(..)) import Pipes.Core-#ifndef haskell98-import Control.Monad.Error (MonadError(..))-import Control.Monad.Reader (MonadReader(..))-import Control.Monad.State (MonadState(..))-import Control.Monad.Writer (MonadWriter(..))-#endif+import Pipes.Internal (Proxy(..))+import qualified Data.Foldable as F -- Re-exports-#ifndef haskell98 import Control.Monad.Morph (MFunctor(hoist))-#endif infixl 4 <~ infixr 4 ~>@@ -140,7 +127,7 @@ 'yield' :: 'Monad' m => a -> 'Pipe' x a m () @ -}-yield :: (Monad m) => a -> Producer' a m ()+yield :: Monad m => a -> Producer' a m () yield = respond {-# INLINABLE yield #-} @@ -153,7 +140,7 @@ 'for' :: 'Monad' m => 'Pipe' x b m r -> (b -> 'Pipe' x c m ()) -> 'Pipe' x c m r @ -}-for :: (Monad m)+for :: Monad m => Proxy x' x b' b m a' -- ^ -> (b -> Proxy x' x c' c m b')@@ -190,6 +177,14 @@ yield x go in go++ ; "p1 >-> (p2 >-> p3)" forall p1 p2 p3 .+ p1 >-> (p2 >-> p3) = (p1 >-> p2) >-> p3++ ; "p >-> cat" forall p . p >-> cat = p++ ; "cat >-> p" forall p . cat >-> p = p+ #-} {-| Compose loop bodies@@ -202,7 +197,7 @@ @ -} (~>)- :: (Monad m)+ :: Monad m => (a -> Proxy x' x b' b m a') -- ^ -> (b -> Proxy x' x c' c m b')@@ -213,7 +208,7 @@ -- | ('~>') with the arguments flipped (<~)- :: (Monad m)+ :: Monad m => (b -> Proxy x' x c' c m b') -- ^ -> (a -> Proxy x' x b' b m a')@@ -246,7 +241,7 @@ 'await' :: 'Monad' m => 'Pipe' a y m a @ -}-await :: (Monad m) => Consumer' a m a+await :: Monad m => Consumer' a m a await = request () {-# INLINABLE await #-} @@ -260,7 +255,7 @@ @ -} (>~)- :: (Monad m)+ :: Monad m => Proxy a' a y' y m b -- ^ -> Proxy () b y' y m c@@ -271,7 +266,7 @@ -- | ('>~') with the arguments flipped (~<)- :: (Monad m)+ :: Monad m => Proxy () b y' y m c -- ^ -> Proxy a' a y' y m b@@ -299,7 +294,7 @@ -} -- | The identity 'Pipe', analogous to the Unix @cat@ program-cat :: (Monad m) => Pipe a a m r+cat :: Monad m => Pipe a a m r cat = pull () {-# INLINABLE cat #-} @@ -313,7 +308,7 @@ @ -} (>->)- :: (Monad m)+ :: Monad m => Proxy a' a () b m r -- ^ -> Proxy () b c' c m r@@ -364,29 +359,22 @@ mzero = empty mplus = (<|>) -#ifndef haskell98 instance MFunctor ListT where hoist morph = Select . hoist morph . enumerate-#endif instance (Monad m) => Monoid (ListT m a) where mempty = empty mappend = (<|>) -#ifndef haskell98 instance (MonadState s m) => MonadState s (ListT m) where get = lift get put s = lift (put s) -#if MIN_VERSION_mtl(2,1,0) state f = lift (state f)-#endif instance (MonadWriter w m) => MonadWriter w (ListT m) where-#if MIN_VERSION_mtl(2,1,0) writer = lift . writer-#endif tell w = lift (tell w) @@ -409,28 +397,25 @@ M m -> M (do (p', w') <- listen m return (go p' $! mappend w w') )- Pure r -> Pure r+ Pure r -> Pure r instance (MonadReader i m) => MonadReader i (ListT m) where ask = lift ask local f l = Select (local f (enumerate l)) -#if MIN_VERSION_mtl(2,1,0) reader f = lift (reader f)-#endif instance (MonadError e m) => MonadError e (ListT m) where throwError e = lift (throwError e) catchError l k = Select (catchError (enumerate l) (\e -> enumerate (k e)))-#endif {-| 'Enumerable' generalizes 'Data.Foldable.Foldable', converting effectful containers to 'ListT's. -} class Enumerable t where- toListT :: (Monad m) => t m a -> ListT m a+ toListT :: Monad m => t m a -> ListT m a instance Enumerable ListT where toListT = id@@ -459,11 +444,11 @@ '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 :: 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+ Request v _ -> closed v Respond a fu -> return (Right (a, fu ())) M m -> m >>= go Pure r -> return (Left r)@@ -487,13 +472,13 @@ {-# INLINABLE every #-} -- | Discards a value-discard :: (Monad m) => a -> m ()+discard :: Monad m => a -> m () discard _ = return () {-# INLINABLE discard #-} -- | ('>->') with the arguments flipped (<-<)- :: (Monad m)+ :: Monad m => Proxy () b c' c m r -- ^ -> Proxy a' a () b m r@@ -507,11 +492,7 @@ "Control.Monad.Trans.Class" re-exports 'MonadTrans'. -#ifndef haskell98 "Control.Monad.Morph" re-exports 'MFunctor'. -#endif "Data.Foldable" re-exports 'Foldable' (the class name only)-- "Data.Void" re-exports 'Void' -}
src/Pipes/Core.hs view
@@ -13,12 +13,7 @@ * push-based 'Pipe's. -} -{-# LANGUAGE CPP, RankNTypes #-}---- The rewrite RULES require the 'TrustWorthy' annotation-#if __GLASGOW_HASKELL__ >= 702-{-# LANGUAGE Trustworthy #-}-#endif+{-# LANGUAGE RankNTypes, Trustworthy #-} module Pipes.Core ( -- * Proxy Monad Transformer@@ -58,6 +53,7 @@ , reflect -- * Concrete Type Synonyms+ , X , Effect , Producer , Pipe@@ -83,12 +79,10 @@ , (<<+) -- * Re-exports- , module Data.Void+ , closed ) where -import Data.Void (Void)-import qualified Data.Void as V-import Pipes.Internal (Proxy(..))+import Pipes.Internal (Proxy(..), X, closed) {- $proxy Diagrammatically, you can think of a 'Proxy' as having the following shape:@@ -121,12 +115,12 @@ -} -- | Run a self-contained 'Effect', converting it back to the base monad-runEffect :: (Monad m) => Effect m r -> m r+runEffect :: Monad m => Effect m r -> m r runEffect = go where go p = case p of- Request v _ -> V.absurd v- Respond v _ -> V.absurd v+ Request v _ -> closed v+ Respond v _ -> closed v M m -> m >>= go Pure r -> return r {-# INLINABLE runEffect #-}@@ -225,7 +219,7 @@ The following diagrams show the flow of information: @-'respond' :: ('Monad' m)+'respond' :: 'Monad' m => a -> 'Proxy' x' x a' a m a' \ a@@ -240,7 +234,7 @@ v a' -('/>/') :: ('Monad' m)+('/>/') :: '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')@@ -265,7 +259,7 @@ 'respond' is the identity of the respond category. -}-respond :: (Monad m) => a -> Proxy x' x a' a m a'+respond :: Monad m => a -> Proxy x' x a' a m a' respond a = Respond a Pure {-# INLINABLE respond #-} @@ -278,7 +272,7 @@ ('/>/') is the composition operator of the respond category. -} (/>/)- :: (Monad m)+ :: Monad m => (a -> Proxy x' x b' b m a') -- ^ -> (b -> Proxy x' x c' c m b')@@ -293,7 +287,7 @@ Point-ful version of ('/>/') -} (//>)- :: (Monad m)+ :: Monad m => Proxy x' x b' b m a' -- ^ -> (b -> Proxy x' x c' c m b')@@ -340,7 +334,7 @@ The following diagrams show the flow of information: @-'request' :: ('Monad' m)+'request' :: 'Monad' m => a' -> 'Proxy' a' a y' y m a \ a'@@ -355,7 +349,7 @@ v a -('\>\') :: ('Monad' m)+('\>\') :: '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)@@ -378,7 +372,7 @@ 'request' is the identity of the request category. -}-request :: (Monad m) => a' -> Proxy a' a y' y m a+request :: Monad m => a' -> Proxy a' a y' y m a request a' = Request a' Pure {-# INLINABLE request #-} @@ -391,7 +385,7 @@ ('\>\') is the composition operator of the request category. -} (\>\)- :: (Monad m)+ :: Monad m => (b' -> Proxy a' a y' y m b) -- ^ -> (c' -> Proxy b' b y' y m c)@@ -406,7 +400,7 @@ Point-ful version of ('\>\') -} (>\\)- :: (Monad m)+ :: Monad m => (b' -> Proxy a' a y' y m b) -- ^ -> Proxy b' b y' y m c@@ -453,7 +447,7 @@ The following diagram shows the flow of information: @-'push' :: ('Monad' m)+'push' :: 'Monad' m => a -> 'Proxy' a' a a' a m r \ a@@ -468,7 +462,7 @@ v r -('>~>') :: ('Monad' m)+('>~>') :: '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)@@ -496,7 +490,7 @@ 'push' is the identity of the push category. -}-push :: (Monad m) => a -> Proxy a' a a' a m r+push :: Monad m => a -> Proxy a' a a' a m r push = go where go a = Respond a (\a' -> Request a' go)@@ -512,7 +506,7 @@ ('>~>') is the composition operator of the push category. -} (>~>)- :: (Monad m)+ :: Monad m => (_a -> Proxy a' a b' b m r) -- ^ -> ( b -> Proxy b' b c' c m r)@@ -527,7 +521,7 @@ Point-ful version of ('>~>') -} (>>~)- :: (Monad m)+ :: Monad m => Proxy a' a b' b m r -- ^ -> (b -> Proxy b' b c' c m r)@@ -561,7 +555,7 @@ The following diagrams show the flow of information: @-'pull' :: ('Monad' m)+'pull' :: 'Monad' m => a' -> 'Proxy' a' a a' a m r \ a'@@ -576,7 +570,7 @@ v r -('>+>') :: ('Monad' m)+('>+>') :: '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)@@ -604,7 +598,7 @@ 'pull' is the identity of the pull category. -}-pull :: (Monad m) => a' -> Proxy a' a a' a m r+pull :: Monad m => a' -> Proxy a' a a' a m r pull = go where go a' = Request a' (\a -> Respond a go)@@ -620,7 +614,7 @@ ('>+>') is the composition operator of the pull category. -} (>+>)- :: (Monad m)+ :: Monad m => ( b' -> Proxy a' a b' b m r) -- ^ -> (_c' -> Proxy b' b c' c m r)@@ -635,7 +629,7 @@ Point-ful version of ('>+>') -} (+>>)- :: (Monad m)+ :: Monad m => (b' -> Proxy a' a b' b m r) -- ^ -> Proxy b' b c' c m r@@ -682,7 +676,7 @@ -} -- | Switch the upstream and downstream ends-reflect :: (Monad m) => Proxy a' a b' b m r -> Proxy b b' a a' m r+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@@ -696,30 +690,30 @@ 'Effect's neither 'Pipes.await' nor 'Pipes.yield' -}-type Effect = Proxy Void () () Void+type Effect = Proxy X () () X -- | 'Producer's can only 'Pipes.yield'-type Producer b = Proxy Void () () b+type Producer b = Proxy X () () b -- | 'Pipe's can both 'Pipes.await' and 'Pipes.yield' type Pipe a b = Proxy () a () b -- | 'Consumer's can only 'Pipes.await'-type Consumer a = Proxy () a () Void+type Consumer a = Proxy () a () X {-| @Client a' a@ sends requests of type @a'@ and receives responses of type @a@. 'Client's only 'request' and never 'respond'. -}-type Client a' a = Proxy a' a () Void+type Client a' a = Proxy a' a () X {-| @Server b' b@ receives requests of type @b'@ and sends responses of type @b@. 'Server's only 'respond' and never 'request'. -}-type Server b' b = Proxy Void () b' b+type Server b' b = Proxy X () b' b -- | Like 'Effect', but with a polymorphic type type Effect' m r = forall x' x y' y . Proxy x' x y' y m r@@ -738,7 +732,7 @@ -- | Equivalent to ('/>/') with the arguments flipped (\<\)- :: (Monad m)+ :: Monad m => (b -> Proxy x' x c' c m b') -- ^ -> (a -> Proxy x' x b' b m a')@@ -750,7 +744,7 @@ -- | Equivalent to ('\>\') with the arguments flipped (/</)- :: (Monad m)+ :: Monad m => (c' -> Proxy b' b x' x m c) -- ^ -> (b' -> Proxy a' a x' x m b)@@ -762,7 +756,7 @@ -- | Equivalent to ('>~>') with the arguments flipped (<~<)- :: (Monad m)+ :: Monad m => (b -> Proxy b' b c' c m r) -- ^ -> (a -> Proxy a' a b' b m r)@@ -774,7 +768,7 @@ -- | Equivalent to ('>+>') with the arguments flipped (<+<)- :: (Monad m)+ :: Monad m => (c' -> Proxy b' b c' c m r) -- ^ -> (b' -> Proxy a' a b' b m r)@@ -786,7 +780,7 @@ -- | Equivalent to ('//>') with the arguments flipped (<\\)- :: (Monad m)+ :: Monad m => (b -> Proxy x' x c' c m b') -- ^ -> Proxy x' x b' b m a'@@ -798,7 +792,7 @@ -- | Equivalent to ('>\\') with the arguments flipped (//<)- :: (Monad m)+ :: Monad m => Proxy b' b y' y m c -- ^ -> (b' -> Proxy a' a y' y m b)@@ -810,7 +804,7 @@ -- | Equivalent to ('>>~') with the arguments flipped (~<<)- :: (Monad m)+ :: Monad m => (b -> Proxy b' b c' c m r) -- ^ -> Proxy a' a b' b m r@@ -822,7 +816,7 @@ -- | Equivalent to ('+>>') with the arguments flipped (<<+)- :: (Monad m)+ :: Monad m => Proxy b' b c' c m r -- ^ -> (b' -> Proxy a' a b' b m r)@@ -833,20 +827,28 @@ {-# INLINABLE (<<+) #-} {-# RULES- "(p //> f) //> g" forall p f g . (p //> f) //> g = p //> (\a -> f a //> g)+ "(p //> f) //> g" forall p f g . (p //> f) //> g = p //> (\x -> f x //> g) ; "p //> respond" forall p . p //> respond = p ; "respond x //> f" forall x f . respond x //> f = f x - ; "f >\\ (g >\\ p)" forall f g p . f >\\ (g >\\ p) = (\a -> f >\\ g a) >\\ p+ ; "f >\\ (g >\\ p)" forall f g p . f >\\ (g >\\ p) = (\x -> f >\\ g x) >\\ p ; "request >\\ p" forall p . request >\\ p = p ; "f >\\ request x" forall f x . f >\\ request x = f x - #-}+ ; "(p >>~ f) >>~ g" forall p f g . (p >>~ f) >>~ g = p >>~ (\x -> f x >>~ g) -{- $reexports- @Data.Void@ re-exports the 'Void' type--}+ ; "p >>~ push" forall p . p >>~ push = p++ ; "push x >>~ f" forall x f . push x >>~ f = f x++ ; "f +>> (g +>> p)" forall f g p . f +>> (g +>> p) = (\x -> f +>> g x) +>> p++ ; "pull +>> p" forall p . pull +>> p = p++ ; "f +>> pull x" forall f x . f +>> pull x = f x++ #-}
src/Pipes/Internal.hs view
@@ -23,33 +23,28 @@ , MultiParamTypeClasses , RankNTypes , UndecidableInstances- , CPP+ , Trustworthy #-} --- The rewrite RULES require the 'TrustWorthy' annotation-#if __GLASGOW_HASKELL__ >= 702-{-# LANGUAGE Trustworthy #-}-#endif- module Pipes.Internal ( -- * Internal Proxy(..) , unsafeHoist- , observe,+ , observe+ , X+ , closed ) where import Control.Applicative (Applicative(pure, (<*>)), Alternative(empty, (<|>))) import Control.Monad (MonadPlus(..)) import Control.Monad.IO.Class (MonadIO(liftIO)) import Control.Monad.Trans.Class (MonadTrans(lift))-#ifndef haskell98 import Control.Monad.Morph (MFunctor(hoist)) 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)-#endif {-| A 'Proxy' is a monad transformer that receives and sends information on both an upstream and downstream interface.@@ -72,7 +67,7 @@ | M (m (Proxy a' a b' b m r)) | Pure r -instance (Monad m) => Functor (Proxy a' a b' b m) where+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 ))@@ -80,21 +75,21 @@ M m -> M (m >>= \p' -> return (go p')) Pure r -> Pure (f r) -instance (Monad m) => Applicative (Proxy a' a b' b m) where+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+ Pure f -> fmap f px -instance (Monad m) => Monad (Proxy a' a b' b m) where+instance Monad m => Monad (Proxy a' a b' b m) where return = Pure (>>=) = _bind _bind- :: (Monad m)+ :: Monad m => Proxy a' a b' b m r -> (r -> Proxy a' a b' b m r') -> Proxy a' a b' b m r'@@ -103,7 +98,7 @@ 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+ Pure r -> f r {-# RULES "_bind (Request a' k) f" forall a' k f .@@ -126,7 +121,7 @@ safe if you pass a monad morphism as the first argument. -} unsafeHoist- :: (Monad m)+ :: 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@@ -134,24 +129,21 @@ 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+ Pure r -> Pure r {-# INLINABLE unsafeHoist #-} -#ifndef haskell98 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-#endif+ Pure r -> Pure r -instance (MonadIO m) => MonadIO (Proxy a' a b' b m) where+instance MonadIO m => MonadIO (Proxy a' a b' b m) where liftIO m = M (liftIO (m >>= \r -> return (Pure r))) -#ifndef haskell98-instance (MonadReader r m) => MonadReader r (Proxy a' a b' b m) where+instance MonadReader r m => MonadReader r (Proxy a' a b' b m) where ask = lift ask local f = go where@@ -160,21 +152,15 @@ Respond b fb' -> Respond b (\b' -> go (fb' b')) Pure r -> Pure r M m -> M (local f m >>= \r -> return (go r))-#if MIN_VERSION_mtl(2,1,0) reader = lift . reader-#endif -instance (MonadState s m) => MonadState s (Proxy a' a b' b m) where+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-#endif -instance (MonadWriter w m) => MonadWriter w (Proxy a' a b' b m) where-#if MIN_VERSION_mtl(2,1,0)+instance MonadWriter w m => MonadWriter w (Proxy a' a b' b m) where writer = lift . writer-#endif tell = lift . tell listen p0 = go p0 mempty where@@ -194,9 +180,9 @@ M m -> M (do (p', w') <- listen m return (go p' $! mappend w w') )- Pure (r, f) -> M (pass (return (Pure r, \_ -> f w)))+ Pure (r, f) -> M (pass (return (Pure r, \_ -> f w))) -instance (MonadError e m) => MonadError e (Proxy a' a b' b m) where+instance MonadError e m => MonadError e (Proxy a' a b' b m) where throwError = lift . throwError catchError p0 f = go p0 where@@ -207,13 +193,12 @@ M m -> M ((do p' <- m return (go p') ) `catchError` (\e -> return (f e)) )-#endif -instance (MonadPlus m) => Alternative (Proxy a' a b' b m) where+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+instance MonadPlus m => MonadPlus (Proxy a' a b' b m) where mzero = lift mzero mplus p0 p1 = go p0 where@@ -240,7 +225,7 @@ 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 :: 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 )))@@ -248,3 +233,16 @@ M m' -> m' >>= go Pure r -> return (Pure r) {-# INLINABLE observe #-}++{-| The empty type, used to close output ends++ When @Data.Void@ is merged into @base@, this will change to:++> type X = Void+-}+newtype X = X X++-- | Use 'closed' to \"handle\" impossible outputs+closed :: X -> a+closed (X x) = closed x+{-# INLINABLE closed #-}
src/Pipes/Lift.hs view
@@ -1,58 +1,49 @@ {-| 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 #-}+ See the mini-tutorial at the bottom of this module for example code and+ typical use cases where this module will come in handy.+-} module Pipes.Lift (+ -- * Utilities+ distribute+ -- * ErrorT- errorP-#ifndef haskell98+ , errorP , runErrorP , catchError-#endif , liftCatchError -- * MaybeT , maybeP-#ifndef haskell98 , runMaybeP-#endif -- * ReaderT , readerP-#ifndef haskell98 , runReaderP-#endif -- * StateT , stateP-#ifndef haskell98 , runStateP , evalStateP , execStateP-#endif -- * WriterT -- $writert , writerP-#ifndef haskell98 , runWriterP , execWriterP-#endif -- * RWST , rwsP-#ifndef haskell98 , runRWSP , evalRWSP , execRWSP - -- * Utilities- , distribute-#endif-+ -- * Tutorial+ -- $tutorial ) where import Control.Monad.Trans.Class (lift, MonadTrans(..))@@ -64,11 +55,27 @@ import qualified Control.Monad.Trans.RWS.Strict as RWS import Data.Monoid (Monoid) import Pipes.Internal (Proxy(..), unsafeHoist)-#ifndef haskell98 import Control.Monad.Morph (hoist, MFunctor(..)) import Pipes.Core (runEffect, request, respond, (//>), (>\\))-#endif +-- | Distribute 'Proxy' over a monad transformer+distribute+ :: ( Monad m+ , MonadTrans t+ , MFunctor t+ , Monad (t m)+ , Monad (t (Proxy a' a b' b m))+ )+ => Proxy a' a b' b (t m) r+ -- ^ + -> t (Proxy a' a b' b m) r+ -- ^ +distribute p = runEffect $ request' >\\ unsafeHoist (hoist lift) p //> respond'+ where+ request' = lift . lift . request+ respond' = lift . lift . respond+{-# INLINABLE distribute #-}+ -- | Wrap the base monad in 'E.ErrorT' errorP :: (Monad m, E.Error e)@@ -79,7 +86,6 @@ lift $ E.ErrorT (return x) {-# INLINABLE errorP #-} -#ifndef haskell98 -- | Run 'E.ErrorT' in the base monad runErrorP :: (Monad m, E.Error e)@@ -99,11 +105,10 @@ catchError e h = errorP . E.runErrorT $ E.catchError (distribute e) (distribute . h) {-# INLINABLE catchError #-}-#endif -- | Catch an error using a catch function for the base monad liftCatchError- :: (Monad m)+ :: 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) )@@ -125,46 +130,42 @@ -- | Wrap the base monad in 'M.MaybeT' maybeP- :: (Monad m)+ :: 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 #-} -#ifndef haskell98 -- | Run 'M.MaybeT' in the base monad runMaybeP- :: (Monad m)+ :: Monad m => Proxy a' a b' b (M.MaybeT m) r -> Proxy a' a b' b m (Maybe r) runMaybeP p = M.runMaybeT $ distribute p {-# INLINABLE runMaybeP #-}-#endif -- | Wrap the base monad in 'R.ReaderT' readerP- :: (Monad m)+ :: 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 #-} -#ifndef haskell98 -- | Run 'R.ReaderT' in the base monad runReaderP- :: (Monad m)+ :: Monad m => i -> Proxy a' a b' b (R.ReaderT i m) r -> Proxy a' a b' b m r runReaderP r p = (`R.runReaderT` r) $ distribute p {-# INLINABLE runReaderP #-}-#endif -- | Wrap the base monad in 'S.StateT' stateP- :: (Monad m)+ :: 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@@ -173,10 +174,9 @@ return r {-# INLINABLE stateP #-} -#ifndef haskell98 -- | Run 'S.StateT' in the base monad runStateP- :: (Monad m)+ :: Monad m => s -> Proxy a' a b' b (S.StateT s m) r -> Proxy a' a b' b m (r, s)@@ -185,7 +185,7 @@ -- | Evaluate 'S.StateT' in the base monad evalStateP- :: (Monad m)+ :: Monad m => s -> Proxy a' a b' b (S.StateT s m) r -> Proxy a' a b' b m r@@ -194,13 +194,12 @@ -- | Execute 'S.StateT' in the base monad execStateP- :: (Monad m)+ :: Monad m => s -> Proxy a' a b' b (S.StateT s m) r -> Proxy a' a b' b m s execStateP s p = fmap snd $ runStateP s p {-# INLINABLE execStateP #-}-#endif {- $writert Note that 'runWriterP' and 'execWriterP' will keep the accumulator in@@ -223,10 +222,9 @@ return r {-# INLINABLE writerP #-} -#ifndef haskell98 -- | Run 'W.WriterT' in the base monad runWriterP- :: (Monad m, Data.Monoid.Monoid w)+ :: (Monad m, Monoid w) => Proxy a' a b' b (W.WriterT w m) r -> Proxy a' a b' b m (r, w) runWriterP p = W.runWriterT $ distribute p@@ -234,12 +232,11 @@ -- | Execute 'W.WriterT' in the base monad execWriterP- :: (Monad m, Data.Monoid.Monoid w)+ :: (Monad m, Monoid w) => Proxy a' a b' b (W.WriterT w m) r -> Proxy a' a b' b m w execWriterP p = fmap snd $ runWriterP p {-# INLINABLE execWriterP #-}-#endif -- | Wrap the base monad in 'RWS.RWST' rwsP@@ -256,7 +253,6 @@ return r {-# INLINABLE rwsP #-} -#ifndef haskell98 -- | Run 'RWS.RWST' in the base monad runRWSP :: (Monad m, Monoid w)@@ -291,21 +287,94 @@ f x = let (_, s', w) = x in (s', w) {-# INLINABLE execRWSP #-} --- | Distribute 'Proxy' over a monad transformer-distribute- :: ( Monad m- , MonadTrans t- , MFunctor t- , Monad (t m)- , Monad (t (Proxy a' a b' b m))- )- => Proxy a' a b' b (t m) r- -- ^ - -> t (Proxy a' a b' b m) r- -- ^ -distribute p = runEffect $ request' >\\ unsafeHoist (hoist lift) p //> respond'- where- request' = lift . lift . request- respond' = lift . lift . respond-{-# INLINABLE distribute #-}-#endif+{- $tutorial+ Probably the most useful functionality in this module is lifted error+ handling. Suppose that you have a 'Pipes.Pipe' whose base monad can fail+ using 'E.ErrorT':++> import Control.Monad.Trans.Error+> import Pipes+>+> example :: Monad m => Pipe Int Int (ErrorT String m) r+> example = for cat $ \n ->+> if n == 0+> then lift $ throwError "Zero is forbidden"+> else yield n++ Without the tools in this module you cannot recover from any potential error+ until after you compose and run the pipeline:++>>> import qualified Pipes.Prelude as P+>>> runErrorT $ runEffect $ P.readLn >-> example >-> P.print+42<Enter>+42+1<Enter>+1+0<Enter>+Zero is forbidden+>>>++ This module provides `catchError`, which lets you catch and recover from+ errors inside the 'Pipe':++> import qualified Pipes.Lift as Lift+> +> caught :: Pipe Int Int (ErrorT String IO) r+> caught = example `Lift.catchError` \str -> do+> liftIO (putStrLn str)+> caught++ This lets you resume streaming in the face of errors raised within the base+ monad:++>>> runErrorT $ runEffect $ P.readLn >-> caught >-> P.print+0<Enter>+Zero is forbidden+42<Enter>+42+0<Enter>+Zero is forbidden+1<Enter>+1+...++ Another common use case is running a base monad before running the pipeline.+ For example, the following contrived 'Producer' uses 'S.StateT' gratuitously+ to increment numbers:++> import Control.Monad (forever)+> import Control.Monad.Trans.State.Strict+> import Pipes+> +> numbers :: Monad m => Producer Int (StateT Int m) r+> numbers = forever $ do+> n <- lift get+> yield n+> lift $ put $! n + 1++ You can run the 'StateT' monad by supplying an initial state, before you+ ever compose the 'Producer':++> import Pipes.Lift+>+> naturals :: Monad m => Producer Int m r+> naturals = evalStateP 0 numbers++ This deletes 'StateT' from the base monad entirely, give you a completely+ pure 'Pipes.Producer':++>>> Pipes.Prelude.toList naturals+[0,1,2,3,4,5,6...]++ Note that the convention for the 'S.StateT' run functions is backwards from+ @transformers@ for convenience: the initial state is the first argument.++ All of these functions internally use 'distribute', which can pull out most+ monad transformers from the base monad. For example, 'evalStateP' is+ defined in terms of 'distribute':++> evalStateP s p = evalStateT (distribute p) s++ Therefore you can use 'distribute' to run other monad transformers, too, as+ long as they implement the 'MFunctor' type class from the @mmorph@ library.+-}
src/Pipes/Prelude.hs view
@@ -16,14 +16,9 @@ newlines. -} -{-# LANGUAGE RankNTypes, CPP #-}+{-# LANGUAGE RankNTypes, Trustworthy #-} {-# OPTIONS_GHC -fno-warn-unused-do-bind #-} --- The rewrite RULES require the 'TrustWorthy' annotation-#if __GLASGOW_HASKELL__ >= 702-{-# LANGUAGE Trustworthy #-}-#endif- module Pipes.Prelude ( -- * Producers -- $producers@@ -37,11 +32,13 @@ , stdoutLn , print , toHandle+ , drain -- * Pipes -- $pipes , map , mapM+ , sequence , mapFoldable , filter , filterM@@ -85,27 +82,23 @@ -- * Zips , zip , zipWith-#ifndef haskell98+ -- * Utilities , tee , generalize-#endif ) 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 qualified System.IO as IO-#ifndef haskell98-import Control.Monad.Trans.State.Strict (get, put) import Pipes.Lift (evalStateP)-#endif+import qualified GHC.IO.Exception as G+import qualified System.IO as IO import qualified Prelude import Prelude hiding ( all@@ -130,6 +123,7 @@ , product , read , readLn+ , sequence , show , sum , take@@ -161,12 +155,12 @@ Terminates on end of input -}-stdinLn :: (MonadIO m) => Producer' String m ()+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 :: (MonadIO m, Read a) => Producer' a m () readLn = stdinLn >-> read {-# INLINABLE readLn #-} @@ -174,7 +168,7 @@ Terminates on end of input -}-fromHandle :: (MonadIO m) => IO.Handle -> Producer' String m ()+fromHandle :: MonadIO m => IO.Handle -> Producer' String m () fromHandle h = go where go = do@@ -186,7 +180,7 @@ {-# 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 :: Monad m => Int -> m a -> Producer a m () replicateM n m = lift m >~ take n {-# INLINABLE replicateM #-} @@ -206,7 +200,7 @@ Unlike 'toHandle', 'stdoutLn' gracefully terminates on a broken output pipe -}-stdoutLn :: (MonadIO m) => Consumer' String m ()+stdoutLn :: MonadIO m => Consumer' String m () stdoutLn = go where go = do@@ -232,7 +226,7 @@ #-} -- | Write 'String's to a 'IO.Handle' using 'IO.hPutStrLn'-toHandle :: (MonadIO m) => IO.Handle -> Consumer' String m r+toHandle :: MonadIO m => IO.Handle -> Consumer' String m r toHandle handle = for cat (\str -> liftIO (IO.hPutStrLn handle str)) {-# INLINABLE toHandle #-} @@ -241,6 +235,16 @@ p >-> toHandle handle = for p (\str -> liftIO (IO.hPutStrLn handle str)) #-} +-- | 'discard' all incoming values+drain :: Monad m => Consumer' a m r+drain = for cat discard+{-# INLINABLE drain #-}++{-# RULES+ "p >-> drain" forall p .+ p >-> drain = for p discard+ #-}+ {- $pipes Use ('>->') to connect 'Producer's, 'Pipe's, and 'Consumer's: @@ -255,7 +259,7 @@ -} -- | Apply a function to all values flowing downstream-map :: (Monad m) => (a -> b) -> Pipe a b m r+map :: Monad m => (a -> b) -> Pipe a b m r map f = for cat (\a -> yield (f a)) {-# INLINABLE map #-} @@ -268,7 +272,7 @@ #-} -- | Apply a monadic function to all values flowing downstream-mapM :: (Monad m) => (a -> m b) -> Pipe a b m r+mapM :: Monad m => (a -> m b) -> Pipe a b m r mapM f = for cat $ \a -> do b <- lift (f a) yield b@@ -285,6 +289,11 @@ return b ) >~ p #-} +-- | Convert a stream of actions to a stream of values+sequence :: Monad m => Pipe (m a) a m r+sequence = mapM id+{-# INLINABLE sequence #-}+ {- | Apply a function to all values flowing downstream, and forward each element of the result. -}@@ -298,7 +307,7 @@ #-} -- | @(filter predicate)@ only forwards values that satisfy the predicate.-filter :: (Monad m) => (a -> Bool) -> Pipe a a m r+filter :: Monad m => (a -> Bool) -> Pipe a a m r filter predicate = for cat $ \a -> when (predicate a) (yield a) {-# INLINABLE filter #-} @@ -310,7 +319,7 @@ {-| @(filterM predicate)@ only forwards values that satisfy the monadic predicate -}-filterM :: (Monad m) => (a -> m Bool) -> Pipe a a m r+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)@@ -324,7 +333,7 @@ #-} -- | @(take n)@ only allows @n@ values to pass through-take :: (Monad m) => Int -> Pipe a a m ()+take :: Monad m => Int -> Pipe a a m () take n = replicateM_ n $ do a <- await yield a@@ -333,7 +342,7 @@ {-| @(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 :: Monad m => (a -> Bool) -> Pipe a a m () takeWhile predicate = go where go = do@@ -346,7 +355,7 @@ {-# INLINABLE takeWhile #-} -- | @(drop n)@ discards @n@ values going downstream-drop :: (Monad m) => Int -> Pipe a a m r+drop :: Monad m => Int -> Pipe a a m r drop n = do replicateM_ n await cat@@ -355,7 +364,7 @@ {-| @(dropWhile p)@ discards values going downstream until one violates the predicate @p@. -}-dropWhile :: (Monad m) => (a -> Bool) -> Pipe a a m r+dropWhile :: Monad m => (a -> Bool) -> Pipe a a m r dropWhile predicate = go where go = do@@ -382,7 +391,7 @@ {-# INLINABLE elemIndices #-} -- | Outputs the indices of all elements that satisfied the predicate-findIndices :: (Monad m) => (a -> Bool) -> Pipe a Int m r+findIndices :: Monad m => (a -> Bool) -> Pipe a Int m r findIndices predicate = loop 0 where loop n = do@@ -392,7 +401,7 @@ {-# INLINABLE findIndices #-} -- | Strict left scan-scan :: (Monad m) => (x -> a -> x) -> x -> (x -> b) -> Pipe a b m r+scan :: Monad m => (x -> a -> x) -> x -> (x -> b) -> Pipe a b m r scan step begin done = loop begin where loop x = do@@ -403,7 +412,7 @@ {-# INLINABLE scan #-} -- | Strict, monadic left scan-scanM :: (Monad m) => (x -> a -> m x) -> m x -> (x -> m b) -> Pipe a b m r+scanM :: Monad m => (x -> a -> m x) -> m x -> (x -> m b) -> Pipe a b m r scanM step begin done = do x <- lift begin loop x@@ -417,7 +426,7 @@ {-# INLINABLE scanM #-} -- | Apply an action to all values flowing downstream-chain :: (Monad m) => (a -> m ()) -> Pipe a a m r+chain :: Monad m => (a -> m ()) -> Pipe a a m r chain f = for cat $ \a -> do lift (f a) yield a@@ -468,11 +477,11 @@ -} -- | Strict fold of the elements of a 'Producer'-fold :: (Monad m) => (x -> a -> x) -> x -> (x -> b) -> Producer a m () -> m b+fold :: Monad m => (x -> a -> x) -> x -> (x -> b) -> Producer a m () -> m b fold step begin done p0 = loop p0 begin where loop p x = case p of- Request v _ -> absurd v+ Request v _ -> closed v Respond a fu -> loop (fu ()) $! step x a M m -> m >>= \p' -> loop p' x Pure _ -> return (done x)@@ -480,14 +489,14 @@ -- | Strict, monadic fold of the elements of a 'Producer' foldM- :: (Monad m)+ :: 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+ Request v _ -> closed v Respond a fu -> do x' <- step x a loop (fu ()) $! x'@@ -498,24 +507,24 @@ {-| @(all predicate p)@ determines whether all the elements of @p@ satisfy the predicate. -}-all :: (Monad m) => (a -> Bool) -> Producer a m () -> m Bool+all :: Monad m => (a -> Bool) -> Producer a m () -> m Bool all predicate p = null $ p >-> filter (\a -> not (predicate a)) {-# INLINABLE all #-} {-| @(any predicate p)@ determines whether any element of @p@ satisfies the predicate. -}-any :: (Monad m) => (a -> Bool) -> Producer a m () -> m Bool+any :: Monad m => (a -> Bool) -> Producer a m () -> m Bool any predicate p = liftM not $ null (p >-> filter predicate) {-# INLINABLE any #-} -- | Determines whether all elements are 'True'-and :: (Monad m) => Producer Bool m () -> m Bool+and :: 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 :: Monad m => Producer Bool m () -> m Bool or = any id {-# INLINABLE or #-} @@ -534,19 +543,19 @@ {-# 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 :: Monad m => (a -> Bool) -> Producer a m () -> m (Maybe a) find predicate p = head (p >-> filter predicate) {-# INLINABLE find #-} {-| Find the index of the first element of a 'Producer' that satisfies the predicate -}-findIndex :: (Monad m) => (a -> Bool) -> Producer a m () -> m (Maybe Int)+findIndex :: 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 :: Monad m => Producer a m () -> m (Maybe a) head p = do x <- next p return $ case x of@@ -555,12 +564,12 @@ {-# INLINABLE head #-} -- | Index into a 'Producer'-index :: (Monad m) => Int -> Producer a m () -> m (Maybe a)+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 :: Monad m => Producer a m () -> m (Maybe a) last p0 = do x <- next p0 case x of@@ -575,7 +584,7 @@ {-# INLINABLE last #-} -- | Count the number of elements in a 'Producer'-length :: (Monad m) => Producer a m () -> m Int+length :: Monad m => Producer a m () -> m Int length = fold (\n _ -> n + 1) 0 id {-# INLINABLE length #-} @@ -598,7 +607,7 @@ {-# INLINABLE minimum #-} -- | Determine if a 'Producer' is empty-null :: (Monad m) => Producer a m () -> m Bool+null :: Monad m => Producer a m () -> m Bool null p = do x <- next p return $ case x of@@ -621,7 +630,7 @@ toList = loop where loop p = case p of- Request v _ -> absurd v+ Request v _ -> closed v Respond a fu -> a:loop (fu ()) M m -> loop (runIdentity m) Pure _ -> []@@ -634,11 +643,11 @@ immediately as they are generated instead of loading all elements into memory. -}-toListM :: (Monad m) => Producer a m () -> m [a]+toListM :: Monad m => Producer a m () -> m [a] toListM = loop where loop p = case p of- Request v _ -> absurd v+ Request v _ -> closed v Respond a fu -> do as <- loop (fu ()) return (a:as)@@ -647,7 +656,7 @@ {-# INLINABLE toListM #-} -- | Zip two 'Producer's-zip :: (Monad m)+zip :: Monad m => (Producer a m r) -> (Producer b m r) -> (Producer' (a, b) m r)@@ -655,7 +664,7 @@ {-# INLINABLE zip #-} -- | Zip two 'Producer's using the provided combining function-zipWith :: (Monad m)+zipWith :: Monad m => (a -> b -> c) -> (Producer a m r) -> (Producer b m r)@@ -675,11 +684,10 @@ go p1' p2' {-# INLINABLE zipWith #-} -#ifndef haskell98 {-| 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 :: 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@@ -696,7 +704,7 @@ a <- await lift $ put (Just a) return a- dn v = absurd v+ dn v = closed v {-# INLINABLE tee #-} {-| Transform a unidirectional 'Pipe' to a bidirectional 'Proxy'@@ -705,7 +713,7 @@ > > generalize cat = pull -}-generalize :: (Monad m) => Pipe a b m r -> x -> Proxy x a x b m r+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@@ -715,4 +723,3 @@ x <- respond a lift $ put x {-# INLINABLE generalize #-}-#endif
src/Pipes/Tutorial.hs view
@@ -241,9 +241,9 @@ also an 'Effect': @- data 'Void' -- The uninhabited type+ data 'X' -- The uninhabited type -\ type 'Effect' m r = 'Producer' 'Void' m r+\ type 'Effect' m r = 'Producer' 'X' m r @ This is why 'for' permits two different type signatures. The first type@@ -252,10 +252,10 @@ @ '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+\ -- Specialize \'b\' to \'X\'+ 'for' :: 'Monad' m => 'Producer' a m r -> (a -> 'Producer' 'X' m ()) -> 'Producer' 'X' m r -\ -- Producer Void = Effect+\ -- Producer X = Effect 'for' :: 'Monad' m => 'Producer' a m r -> (a -> 'Effect' m ()) -> 'Effect' m r @ @@ -344,7 +344,7 @@ 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 :: Monad m => [a] -> Producer a m () > each as = mapM_ yield as Combine 'for' and 'each' to iterate over lists using a \"foreach\" loop:@@ -378,7 +378,7 @@ > import Pipes > import qualified Pipes.Prelude as P -- Pipes.Prelude already has 'stdinLn' > -> duplicate :: (Monad m) => a -> Producer a m ()+> duplicate :: Monad m => a -> Producer a m () > duplicate x = do > yield x > yield x@@ -426,9 +426,9 @@ 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)\'+ \-\- 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) @@@ -437,7 +437,7 @@ following operator that is the point-free counterpart to 'for': @- (~>) :: (Monad m)+ (~>) :: Monad m => (a -> 'Producer' b m r) -> (b -> 'Producer' c m r) -> (a -> 'Producer' c m r)@@ -448,9 +448,9 @@ 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+ 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)@@ -608,7 +608,7 @@ following intermediate 'Consumer' that requests two 'String's and returns them concatenated: -> doubleUp :: (Monad m) => Consumer String m String+> doubleUp :: Monad m => Consumer String m String > doubleUp = do > str1 <- await > str2 <- await@@ -812,7 +812,7 @@ 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 :: Monad m => Pipe a a m r > cat = forever $ do > x <- await > yield x@@ -838,10 +838,10 @@ > import qualified Pipes.Prelude as P -- Pipes.Prelude provides 'take', too > import Prelude hiding (head) >-> head :: (Monad m) => Int -> Pipe a a m ()+> head :: Monad m => Int -> Pipe a a m () > head = P.take >-> yes :: (Monad m) => Producer String m r+> yes :: Monad m => Producer String m r > yes = forever $ yield "y" > > main = runEffect $ yes >-> head 3 >-> P.stdoutLn@@ -976,7 +976,7 @@ 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 :: 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'@@ -990,7 +990,7 @@ 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 :: Monad m => Producer String m r > yes = return "y" >~ cat > > -- Read this as: Keep feeding "y" downstream@@ -1002,7 +1002,7 @@ 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 :: Monad m => Int -> Pipe a a m r > drop n = do > replicateM_ n await > cat@@ -1036,7 +1036,7 @@ Another neat thing to know is that 'every' has a more general type: @- 'every' :: ('Enumerable' t) => t m a -> 'Producer' a m ()+ 'every' :: ('Monad' m, 'Enumerable' t) => t m a -> 'Producer' a m () @ 'Enumerable' generalizes 'Foldable' and if you have an effectful container@@ -1044,7 +1044,7 @@ container implement the 'toListT' method of the 'Enumerable' class: > class Enumerable t where-> toListT :: (Monad m) => t m a -> ListT m a+> 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':@@ -1156,49 +1156,49 @@ * Polymorphic type synonyms that don't explicitly close unused inputs or outputs - The concrete type synonyms use @()@ to close unused inputs and 'Void' (the+ The concrete type synonyms use @()@ to close unused inputs and 'X' (the uninhabited type) to close unused outputs: * 'Effect': explicitly closes both ends, forbidding 'await's and 'yield's -> type Effect = Proxy Void () () Void +> type Effect = Proxy X () () X >-> Upstream | Downstream-> +---------+-> | |-> Void <== <== ()-> | |-> () ==> ==> Void-> | | |-> +----|----+-> v-> r+> Upstream | Downstream+> +---------++> | |+> X <== <== ()+> | |+> () ==> ==> X+> | | |+> +----|----++> v+> r * 'Producer': explicitly closes the upstream end, forbidding 'await's -> type Producer b = Proxy Void () () b+> type Producer b = Proxy X () () b >-> Upstream | Downstream-> +---------+-> | |-> Void <== <== ()-> | |-> () ==> ==> b-> | | |-> +----|----+-> v-> r+> Upstream | Downstream+> +---------++> | |+> X <== <== ()+> | |+> () ==> ==> b+> | | |+> +----|----++> v+> r * 'Consumer': explicitly closes the downstream end, forbidding 'yield's -> type Consumer a = Proxy () a () Void+> type Consumer a = Proxy () a () X > > Upstream | Downstream > +---------+ > | | > () <== <== () > | |-> a ==> ==> Void+> a ==> ==> X > | | | > +----|----+ > v@@ -1224,30 +1224,30 @@ '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-> () () ()+> Producer Pipe Consumer+> +-----------+ +----------+ +------------++> | | | | | |+> X <== <== () <== <== () <== <== ()+> | stdinLn | | take 3 | | stdoutLn |+> () ==> ==> String ==> ==> String ==> ==> X+> | | | | | | | | |+> +-----|-----+ +----|-----+ +------|-----++> v v v+> () () () Composition fuses away the intermediate interfaces, leaving behind an 'Effect': -> Effect-> +-----------------------------------+-> | |-> Void <== <== ()-> | stdinLn >-> take 3 >-> stdoutLn |-> () ==> ==> Void-> | |-> +----------------|------------------+-> v-> ()+> Effect+> +-----------------------------------++> | |+> X <== <== ()+> | stdinLn >-> take 3 >-> stdoutLn |+> () ==> ==> X+> | |+> +----------------|------------------++> v+> () @pipes@ also provides polymorphic type synonyms with apostrophes at the end of their names. These use universal quantification to leave open any unused@@ -1387,7 +1387,7 @@ 'Pipes.Prelude.fromHandle' function from "Pipes.Prelude" requires @RankNTypes@ to compile correctly on @ghc-7.6.3@: -> fromHandle :: (MonadIO m) => Handle -> Producer' String m ()+> fromHandle :: MonadIO m => Handle -> Producer' String m () * You can't use polymorphic type synonyms inside other type constructors without the @ImpredicativeTypes@ extension:@@ -1417,26 +1417,26 @@ >>> runEffect P.stdinLn <interactive>:4:5:- Couldn't match expected type `Void' with actual type `String'+ Couldn't match expected type `X' with actual type `String' Expected type: Effect m0 r0- Actual type: Proxy Void () () String IO ()+ Actual type: Proxy X () () String IO () In the first argument of `runEffect', namely `P.stdinLn' In the expression: runEffect P.stdinLn 'runEffect' expects an 'Effect', which is equivalent to the following type: -> Effect IO () = Proxy Void () () Void IO ()+> Effect IO () = Proxy X () () X IO () ... but 'P.stdinLn' type-checks as a 'Producer', which has the following type: -> Producer String IO () = Proxy Void () () String IO ()+> Producer String IO () = Proxy X () () String IO () The fourth type variable (the output) does not match. For an 'Effect' this- type variable should be closed (i.e. 'Void'), but 'P.stdinLn' has a 'String'+ type variable should be closed (i.e. 'X'), but 'P.stdinLn' has a 'String' output, thus the type error: -> Couldn't match expected type `Void' with actual type `String'+> Couldn't match expected type `X' with actual type `String' Any time you get type errors like these you can work through them by expanding out the type synonyms and seeing which type variables do not@@ -1445,13 +1445,13 @@ You may also consult this table of type synonyms to more easily compare them: -> type Effect = Proxy Void () () Void-> type Producer b = Proxy Void () () b-> type Consumer a = Proxy () a () Void-> type Pipe a b = Proxy () a () b+> type Effect = Proxy X () () X+> type Producer b = Proxy X () () b+> type Consumer a = Proxy () a () X+> type Pipe a b = Proxy () a () b >-> type Server b' b = Proxy Void () b' b -> type Client a' a = Proxy a' a () Void+> type Server b' b = Proxy X () b' b +> type Client a' a = Proxy a' a () X > > type Effect' m r = forall x' x y' y . Proxy x' x y' y m r > type Producer' b m r = forall x' x . Proxy x' x () b m r@@ -1501,7 +1501,7 @@ > import Control.Monad.Codensity (lowerCodensity) > -> linear :: (Monad m) => Int -> Consumer a m [a]+> linear :: Monad m => Int -> Consumer a m [a] > linear n = lowerCodensity $ replicateM n $ lift await This will produce the exact same result, but in linear time.