pipes 4.0.2 → 4.3.16
raw patch · 11 files changed
Files
- CHANGELOG.md +173/−0
- LICENSE +1/−1
- benchmarks/Common.hs +20/−0
- benchmarks/LiftBench.hs +0/−3
- pipes.cabal +35/−37
- src/Pipes.hs +307/−103
- src/Pipes/Core.hs +113/−71
- src/Pipes/Internal.hs +99/−65
- src/Pipes/Lift.hs +157/−82
- src/Pipes/Prelude.hs +419/−128
- src/Pipes/Tutorial.hs +219/−105
+ CHANGELOG.md view
@@ -0,0 +1,173 @@+4.3.16++* Fix example code for `every`+* Improved documentation for `ListT`++4.3.15++* Build against `ghc-9.0`++4.3.14++* Add `mapMaybe` and `wither`, and more laws for `filter` and `filterM`.++4.3.13++* Add `MonadFail` instance for `Proxy`++4.3.12++* Fix space leak introduced in version 4.3.10+ * This leak primarily affects the use of `forever`++4.3.11++* Fix documentation for `scanM`++4.3.10++* Relax `Monad` constraints to `Functor`+* Support GHC 8.8++4.3.9++* Increase upper bound on `exceptions`++4.3.8++* Increase upper bound on `exceptions`++4.3.7++* Documentation fix++4.3.6++* Fix implementation of `pass` in `MonadWriter` instance for `Proxy`++4.3.5++* Support `Semigroup` being a super-class of `Monoid`++4.3.4++* Increase upper bound on `mmorph`++4.3.3++* Make `X` a synonym for `Data.Void.Void`++4.3.2++* BUG FIX: Fix `MMonad` instance for `ListT`+ * The old instance was an infinite loop++4.3.1++* Support building against `ghc-7.4`++4.3.0++* BREAKING CHANGE: Remove `Alternative`/`MonadPlus` instances for `Proxy`+ * See commit 08e7302f43dbf2a40bd367c5ee73ee3367e17768 which explains why+* Add `Traversable` instance for `ListT`+* New `MonadThrow`/`MonadCatch`/`MMonad`/`Semigroup`/`MonadZip` instances for+ `ListT`+* New `MonadThrow`/`MonadCatch` instances for `Proxy`+* Fix lower bound on `mtl`+* Increase upper bound on `optparse-applicative`++4.2.0++* BREAKING CHANGE: Switch from `ErrorT` to `ExceptT`+* Add `Foldable` instance for `ListT`+* Fix all warnings+* Enable foldr/build fusion for `toList`++4.1.9++* Increase lower bound on `criterion`+* Increase upper bound on `transformers` for tests/benchmarks+* Optimize code by delaying `INLINABLE` annotations++4.1.8++* Increase upper bound on `transformers`+* Prepare for MRP (Monad of no Return Proposal)++4.1.7++* Increase lower bound on `deepseq`+* Add `unfoldr`+* Add `loop`+* Add `toListM'`+* Improve efficiency of `drop`+* License tutorial under Creative Commons license++4.1.6++* Increase lower bound on `base`+* Add diagrams to `Pipes.Core` documentation+* Add `mapM_`+* Add `takeWhile'`+* Add `seq`+* Improve efficiency of `toListM`++4.1.5++* Increase upper bound on `criterion`++4.1.4++* Increase upper bound on `criterion`+* Add `Monoid` instance for `Proxy`++4.1.3++* Increase lower bound on `mtl`+* Re-export `void`+* Add `fold'`+* Add `foldM'`++4.1.2++* Increase upper bounds on `transformers` and `mtl`++4.1.1++* Add `runListT`+* Add `MMonad` instance for `Proxy`+* Add `repeatM`+* Add laws to documentation of `Pipes.Prelude` utilities++4.1.0++* Remove Haskell98 support+* Use internal `X` type instead of `Data.Void`+* Document `Pipes.Lift` module:w+* Add `drain`+* Add `sequence`++4.0.2++* Improve performance of `each`+* Add tutorial appendix explaining how to work around quadratic time complexity++4.0.1++* Remove `WriterT` and `RWST` benchmarks+* Add `Enumerable` instance for `ErrorT`+* Add cabal flag for Haskell98 compilation+* Add several rewrite rules+* Add `mtl` instances for `ListT`+* Fix implementation of `pass`, which did not satisfy `Writer` laws+* Implement `fail` for `ListT`+* Add type synonym table to tutorial appendix+* Add QuickCheck tests for `pipes` laws+* Add `mapFoldable`+* Add `Monoid` instance for `ListT`+* Add manual proofs of `pipes` laws in `laws.md`++4.0.0++Major upgrade of `pipes` to no longer use `Proxy` type class
LICENSE view
@@ -1,4 +1,4 @@-Copyright (c) 2012, 2013 Gabriel Gonzalez+Copyright (c) 2012-2016 Gabriel Gonzalez All rights reserved. Redistribution and use in source and binary forms, with or without modification,
+ benchmarks/Common.hs view
@@ -0,0 +1,20 @@+module Common (commonMain) where++import Criterion.Main (Benchmark, runMode)+import Criterion.Main.Options as Criterion+import Data.Maybe (fromMaybe)+import Data.Monoid+import Options.Applicative++commonMain :: Int -- ^ default maximum data size+ -> (Int -> [Benchmark]) -- ^ the benchmarks to run+ -> IO ()+commonMain mdMax bench = do+ (maybeNewMax, critMode) <- execParser $ info (helper <*> options) mempty+ runMode critMode $ bench (fromMaybe mdMax maybeNewMax)++options :: Parser (Maybe Int, Criterion.Mode)+options =+ (,) <$> optional (option auto (help "benchmark maximum data size"+ <> metavar "N" <> short 'i' <> long "imax"))+ <*> Criterion.parseWith Criterion.defaultConfig
benchmarks/LiftBench.hs view
@@ -2,7 +2,6 @@ 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@@ -13,8 +12,6 @@ defaultMax :: Int defaultMax = 10000--instance NFData a => NFData (Sum a) main :: IO () main = commonMain defaultMax liftBenchmarks
pipes.cabal view
@@ -1,10 +1,11 @@ Name: pipes-Version: 4.0.2+Version: 4.3.16 Cabal-Version: >= 1.10 Build-Type: Simple+Tested-With: GHC == 7.10.3, GHC == 8.0.2, GHC == 8.2.2, GHC == 8.4.4, GHC == 8.6.5, GHC == 8.8.1 License: BSD3 License-File: LICENSE-Copyright: 2012, 2013 Gabriel Gonzalez+Copyright: 2012-2016 Gabriel Gonzalez Author: Gabriel Gonzalez Maintainer: Gabriel439@gmail.com Bug-Reports: https://github.com/Gabriel439/Haskell-Pipes-Library/issues@@ -17,7 +18,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@@ -34,26 +35,28 @@ . Read "Pipes.Tutorial" for an extensive tutorial. Category: Control, Pipes+Extra-Source-Files:+ CHANGELOG.md Source-Repository head Type: git Location: https://github.com/Gabriel439/Haskell-Pipes-Library Library- 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+ base >= 4.8 && < 5 ,+ transformers >= 0.2.0.0 && < 0.6 ,+ exceptions >= 0.4 && < 0.11,+ mmorph >= 1.0.4 && < 1.2 ,+ mtl >= 2.2.1 && < 2.3 ,+ void >= 0.4 && < 0.8 - if !flag(haskell98)- Build-Depends:- mmorph >= 1.0.0 && < 1.1,- mtl >= 2.0.1.0 && < 2.2+ if impl(ghc < 8.0)+ Build-depends:+ fail == 4.9.* ,+ semigroups >= 0.17 && < 0.20 Exposed-Modules: Pipes,@@ -64,54 +67,49 @@ Pipes.Tutorial GHC-Options: -O2 -Wall - if flag(haskell98)- CPP-Options: -Dhaskell98-- Benchmark prelude-benchmarks Default-Language: Haskell2010 Type: exitcode-stdio-1.0 HS-Source-Dirs: benchmarks Main-Is: PreludeBench.hs+ Other-Modules: Common GHC-Options: -O2 -Wall -rtsopts -fno-warn-unused-do-bind Build-Depends:- base >= 4 && < 5 ,- criterion >= 0.6.2.1 && < 0.9,- mtl >= 2.0.1.0 && < 2.2,- pipes >= 4.0.0 && < 4.1+ base >= 4.4 && < 5 ,+ criterion >= 1.1.1.0 && < 1.6,+ optparse-applicative >= 0.12 && < 0.17,+ mtl >= 2.1 && < 2.3,+ pipes test-suite tests Default-Language: Haskell2010 Type: exitcode-stdio-1.0 HS-Source-Dirs: tests Main-Is: Main.hs- GHC-Options: -Wall -threaded -rtsopts -with-rtsopts=-N -fno-warn-missing-signatures+ GHC-Options: -Wall -rtsopts -fno-warn-missing-signatures -fno-enable-rewrite-rules Build-Depends:- base >= 4 && < 5 ,- pipes >= 4.0.0 && < 4.1 ,+ base >= 4.4 && < 5 ,+ pipes , QuickCheck >= 2.4 && < 3 ,- mtl >= 2.0.1 && < 2.2 ,+ mtl >= 2.1 && < 2.3 , test-framework >= 0.4 && < 1 , test-framework-quickcheck2 >= 0.2.0 && < 0.4 ,- transformers >= 0.2.0.0 && < 0.4+ transformers >= 0.2.0.0 && < 0.6 Benchmark lift-benchmarks Default-Language: Haskell2010 Type: exitcode-stdio-1.0 HS-Source-Dirs: benchmarks Main-Is: LiftBench.hs+ Other-Modules: Common GHC-Options: -O2 -Wall -rtsopts -fno-warn-unused-do-bind Build-Depends:- base >= 4 && < 5 ,- criterion >= 0.6.2.1 && < 0.9,- deepseq ,- mtl >= 2.0.1.0 && < 2.2,- pipes >= 4.0.0 && < 4.1,- transformers >= 0.2.0.0 && < 0.4--Flag haskell98- Description: Haskell98 compliant subset of pipes.- Default: False+ base >= 4.4 && < 5 ,+ criterion >= 1.1.1.0 && < 1.6 ,+ optparse-applicative >= 0.12 && < 0.17,+ mtl >= 2.1 && < 2.3 ,+ pipes ,+ transformers >= 0.2.0.0 && < 0.6
src/Pipes.hs view
@@ -1,25 +1,20 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE Trustworthy #-}+ {-| This module is the recommended entry point to the @pipes@ library. Read "Pipes.Tutorial" if you want a tutorial explaining how to use this library. -} -{-# LANGUAGE- RankNTypes- , CPP- , FlexibleInstances- , MultiParamTypeClasses- , UndecidableInstances- #-}---- The rewrite RULES require the 'TrustWorthy' annotation-#if __GLASGOW_HASKELL__ >= 702-{-# LANGUAGE Trustworthy #-}-#endif- module Pipes ( -- * The Proxy Monad Transformer Proxy+ , X , Effect , Effect' , runEffect@@ -50,6 +45,7 @@ -- * ListT , ListT(..)+ , runListT , Enumerable(..) -- * Utilities@@ -60,40 +56,41 @@ -- * Re-exports -- $reexports+ , module Control.Monad , module Control.Monad.IO.Class , module Control.Monad.Trans.Class-#ifndef haskell98 , module Control.Monad.Morph-#endif- , module Data.Foldable- , module Data.Void+ , Foldable ) where -import Control.Applicative (Applicative(pure, (<*>)), Alternative(empty, (<|>)))-import Control.Monad (MonadPlus(mzero, mplus))+import Control.Monad (void, MonadPlus(mzero, mplus))+import Control.Monad.Catch (MonadThrow(..), MonadCatch(..))+import Control.Monad.Except (MonadError(..))+import Control.Monad.Fail (MonadFail(..)) import Control.Monad.IO.Class (MonadIO(liftIO))+import Control.Monad.Reader (MonadReader(..))+import Control.Monad.State (MonadState(..)) import Control.Monad.Trans.Class (MonadTrans(lift))-import Control.Monad.Trans.Error (ErrorT(runErrorT))+import Control.Monad.Trans.Except (ExceptT, runExceptT) 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.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(..))+import Control.Monad.Zip (MonadZip(..))+import Pipes.Core+import Pipes.Internal (Proxy(..))+import qualified Data.Foldable as F++#if MIN_VERSION_base(4,8,0)+import Control.Applicative (Alternative(..))+#else+import Control.Applicative+import Data.Foldable (Foldable)+import Data.Traversable (Traversable(..)) #endif+import Data.Semigroup -- Re-exports-#ifndef haskell98-import Control.Monad.Morph (MFunctor(hoist))-#endif+import Control.Monad.Morph (MFunctor(hoist), MMonad(embed)) infixl 4 <~ infixr 4 ~>@@ -137,30 +134,52 @@ {-| Produce a value @-'yield' :: 'Monad' m => a -> 'Pipe' x a m ()+'yield' :: 'Monad' m => a -> 'Producer' a m ()+'yield' :: 'Monad' m => a -> 'Pipe' x a m () @ -}-yield :: (Monad m) => a -> Producer' a m ()+yield :: Functor m => a -> Proxy x' x () a m () yield = respond-{-# INLINABLE yield #-}+{-# INLINABLE [1] yield #-} {-| @(for p body)@ loops over @p@ replacing each 'yield' with @body@. @-'for' :: 'Monad' m => 'Producer' b m r -> (b -> 'Effect' m ()) -> 'Effect' m r-'for' :: 'Monad' m => 'Producer' b m r -> (b -> 'Producer' c m ()) -> 'Producer' c m r-'for' :: 'Monad' m => 'Pipe' x b m r -> (b -> 'Consumer' x m ()) -> 'Consumer' x m r-'for' :: 'Monad' m => 'Pipe' x b m r -> (b -> 'Pipe' x c m ()) -> 'Pipe' x c m r+'for' :: 'Functor' m => 'Producer' b m r -> (b -> 'Effect' m ()) -> 'Effect' m r+'for' :: 'Functor' m => 'Producer' b m r -> (b -> 'Producer' c m ()) -> 'Producer' c m r+'for' :: 'Functor' m => 'Pipe' x b m r -> (b -> 'Consumer' x m ()) -> 'Consumer' x m r+'for' :: 'Functor' m => 'Pipe' x b m r -> (b -> 'Pipe' x c m ()) -> 'Pipe' x c m r @++ The following diagrams show the flow of information:++@+ .---> b+ / |+ +-----------+ / +-----|-----+ +---------------++ | | / | v | | |+ | | / | | | |+x ==> p ==> b ---' x ==> body ==> c = x ==> 'for' p body ==> c+ | | | | | |+ | | | | | | | | |+ +-----|-----+ +-----|-----+ +-------|-------++ v v v+ r () r+@++ For a more complete diagram including bidirectional flow, see "Pipes.Core#respond-diagram". -}-for :: (Monad m)+for :: Functor m => Proxy x' x b' b m a' -- ^ -> (b -> Proxy x' x c' c m b') -- ^ -> Proxy x' x c' c m a' for = (//>)-{-# INLINABLE for #-}+-- There are a number of useful rewrites which can be performed on various uses+-- of this combinator; to ensure that they fire we defer inlining until quite+-- late.+{-# INLINABLE [0] for #-} {-# RULES "for (for p f) g" forall p f g . for (for p f) g = for p (\a -> for (f a) g)@@ -190,19 +209,45 @@ yield x go in go++ ; "p1 >-> (p2 >-> p3)" forall p1 p2 p3 .+ p1 >-> (p2 >-> p3) = (p1 >-> p2) >-> p3++ ; "p >-> cat" forall p . p >-> cat = p++ ; "cat >-> p" forall p . cat >-> p = p+ #-} {-| Compose loop bodies @-('~>') :: 'Monad' m => (a -> 'Producer' b m r) -> (b -> 'Effect' m ()) -> (a -> 'Effect' m r)-('~>') :: 'Monad' m => (a -> 'Producer' b m r) -> (b -> 'Producer' c m ()) -> (a -> 'Producer' c m r)-('~>') :: 'Monad' m => (a -> 'Pipe' x b m r) -> (b -> 'Consumer' x m ()) -> (a -> 'Consumer' x m r)-('~>') :: 'Monad' m => (a -> 'Pipe' x b m r) -> (b -> 'Pipe' x c m ()) -> (a -> 'Pipe' x c m r)+('~>') :: 'Functor' m => (a -> 'Producer' b m r) -> (b -> 'Effect' m ()) -> (a -> 'Effect' m r)+('~>') :: 'Functor' m => (a -> 'Producer' b m r) -> (b -> 'Producer' c m ()) -> (a -> 'Producer' c m r)+('~>') :: 'Functor' m => (a -> 'Pipe' x b m r) -> (b -> 'Consumer' x m ()) -> (a -> 'Consumer' x m r)+('~>') :: 'Functor' m => (a -> 'Pipe' x b m r) -> (b -> 'Pipe' x c m ()) -> (a -> 'Pipe' x c m r) @++ The following diagrams show the flow of information:++@+ a .---> b a+ | / | |+ +-----|-----+ / +-----|-----+ +------|------++ | v | / | v | | v |+ | | / | | | |+x ==> f ==> b ---' x ==> g ==> c = x ==> f '~>' g ==> c+ | | | | | |+ | | | | | | | | |+ +-----|-----+ +-----|-----+ +------|------++ v v v+ r () r+@++ For a more complete diagram including bidirectional flow, see "Pipes.Core#respond-diagram". -} (~>)- :: (Monad m)+ :: Functor m => (a -> Proxy x' x b' b m a') -- ^ -> (b -> Proxy x' x c' c m b')@@ -213,7 +258,7 @@ -- | ('~>') with the arguments flipped (<~)- :: (Monad m)+ :: Functor m => (b -> Proxy x' x c' c m b') -- ^ -> (a -> Proxy x' x b' b m a')@@ -243,35 +288,51 @@ {-| Consume a value @-'await' :: 'Monad' m => 'Pipe' a y m a+'await' :: 'Functor' m => 'Pipe' a y m a @ -}-await :: (Monad m) => Consumer' a m a+await :: Functor m => Consumer' a m a await = request ()-{-# INLINABLE await #-}+{-# INLINABLE [1] await #-} {-| @(draw >~ p)@ loops over @p@ replacing each 'await' with @draw@ @-('>~') :: 'Monad' m => 'Effect' m b -> 'Consumer' b m c -> 'Effect' m c-('>~') :: 'Monad' m => 'Consumer' a m b -> 'Consumer' b m c -> 'Consumer' a m c-('>~') :: 'Monad' m => 'Producer' y m b -> 'Pipe' b y m c -> 'Producer' y m c-('>~') :: 'Monad' m => 'Pipe' a y m b -> 'Pipe' b y m c -> 'Pipe' a y m c+('>~') :: 'Functor' m => 'Effect' m b -> 'Consumer' b m c -> 'Effect' m c+('>~') :: 'Functor' m => 'Consumer' a m b -> 'Consumer' b m c -> 'Consumer' a m c+('>~') :: 'Functor' m => 'Producer' y m b -> 'Pipe' b y m c -> 'Producer' y m c+('>~') :: 'Functor' m => 'Pipe' a y m b -> 'Pipe' b y m c -> 'Pipe' a y m c @++ The following diagrams show the flow of information:++@+ +-----------+ +-----------+ +-------------++ | | | | | |+ | | | | | |+a ==> f ==> y .---> b ==> g ==> y = a ==> f '>~' g ==> y+ | | / | | | |+ | | | / | | | | | |+ +-----|-----+ / +-----|-----+ +------|------++ v / v v+ b ----' c c+@++ For a more complete diagram including bidirectional flow, see "Pipes.Core#request-diagram". -} (>~)- :: (Monad m)+ :: Functor m => Proxy a' a y' y m b -- ^ -> Proxy () b y' y m c -- ^ -> Proxy a' a y' y m c p1 >~ p2 = (\() -> p1) >\\ p2-{-# INLINABLE (>~) #-}+{-# INLINABLE [1] (>~) #-} -- | ('>~') with the arguments flipped (~<)- :: (Monad m)+ :: Functor m => Proxy () b y' y m c -- ^ -> Proxy a' a y' y m b@@ -299,53 +360,129 @@ -} -- | The identity 'Pipe', analogous to the Unix @cat@ program-cat :: (Monad m) => Pipe a a m r+cat :: Functor m => Pipe a a m r cat = pull ()-{-# INLINABLE cat #-}+{-# INLINABLE [1] 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+('>->') :: 'Functor' m => 'Producer' b m r -> 'Consumer' b m r -> 'Effect' m r+('>->') :: 'Functor' m => 'Producer' b m r -> 'Pipe' b c m r -> 'Producer' c m r+('>->') :: 'Functor' m => 'Pipe' a b m r -> 'Consumer' b m r -> 'Consumer' a m r+('>->') :: 'Functor' m => 'Pipe' a b m r -> 'Pipe' b c m r -> 'Pipe' a c m r @++ The following diagrams show the flow of information:++@+ +-----------+ +-----------+ +-------------++ | | | | | |+ | | | | | |+a ==> f ==> b ==> g ==> c = a ==> f '>->' g ==> c+ | | | | | |+ | | | | | | | | |+ +-----|-----+ +-----|-----+ +------|------++ v v v+ r r r+@++ For a more complete diagram including bidirectional flow, see "Pipes.Core#pull-diagram". -} (>->)- :: (Monad m)+ :: Functor m => Proxy a' a () b m r -- ^ -> Proxy () b c' c m r -- ^ -> Proxy a' a c' c m r p1 >-> p2 = (\() -> p1) +>> p2-{-# INLINABLE (>->) #-}+{-# INLINABLE [1] (>->) #-} {-| The list monad transformer, which extends a monad with non-determinism - 'return' corresponds to 'yield', yielding a single value+ The type variables signify: - ('>>=') corresponds to 'for', calling the second computation once for each- time the first computation 'yield's.+ * @m@ - The base monad+ * @a@ - The values that the computation 'yield's throughout its execution++ For basic construction and composition of 'ListT' computations, much can be+ accomplished using common typeclass methods.++ * 'return' corresponds to 'yield', yielding a single value.+ * ('>>=') corresponds to 'for', calling the second computation once+ for each time the first computation 'yield's.+ * 'mempty' neither 'yield's any values nor produces any effects in the+ base monad.+ * ('<>') sequences two computations, 'yield'ing all the values of the+ first followed by all the values of the second.+ * 'lift' converts an action in the base monad into a ListT computation+ which performs the action and 'yield's a single value.++ 'ListT' is a newtype wrapper for 'Producer'. You will likely need to use+ 'Select' and 'enumerate' to convert back and forth between these two types+ to take advantage of all the 'Producer'-related utilities that+ "Pipes.Prelude" has to offer.++ * To lift a plain list into a 'ListT' computation, first apply 'each'+ to turn the list into a 'Producer'. Then apply the 'Select'+ constructor to convert from 'Producer' to 'ListT'.+ * For other ways to construct 'ListT' computations, see the+ “Producers” section in "Pipes.Prelude" to build 'Producer's.+ These can then be converted to 'ListT' using 'Select'.+ * To aggregate the values from a 'ListT' computation (for example,+ to compute the sum of a 'ListT' of numbers), first apply+ 'enumerate' to obtain a 'Producer'. Then see the “Folds”+ section in "Pipes.Prelude" to proceed. -} newtype ListT m a = Select { enumerate :: Producer a m () } -instance (Monad m) => Functor (ListT m) where+instance Functor m => Functor (ListT m) where fmap f p = Select (for (enumerate p) (\a -> yield (f a)))+ {-# INLINE fmap #-} -instance (Monad m) => Applicative (ListT m) where+instance Functor m => Applicative (ListT m) where pure a = Select (yield a)+ {-# INLINE pure #-} mf <*> mx = Select ( for (enumerate mf) (\f -> for (enumerate mx) (\x -> yield (f x) ) ) ) -instance (Monad m) => Monad (ListT m) where- return a = Select (yield a)+instance Monad m => Monad (ListT m) where+ return = pure+ {-# INLINE return #-} m >>= f = Select (for (enumerate m) (\a -> enumerate (f a)))+ {-# INLINE (>>=) #-}+#if !MIN_VERSION_base(4,13,0) fail _ = mzero+ {-# INLINE fail #-}+#endif +instance Monad m => MonadFail (ListT m) where+ fail _ = mzero+ {-# INLINE fail #-}++instance Foldable m => Foldable (ListT m) where+ foldMap f = go . enumerate+ where+ go p = case p of+ Request v _ -> closed v+ Respond a fu -> f a `mappend` go (fu ())+ M m -> F.foldMap go m+ Pure _ -> mempty+ {-# INLINE foldMap #-}++instance (Functor m, Traversable m) => Traversable (ListT m) where+ traverse k (Select p) = fmap Select (traverse_ p)+ where+ traverse_ (Request v _ ) = closed v+ traverse_ (Respond a fu) = _Respond <$> k a <*> traverse_ (fu ())+ where+ _Respond a_ a' = Respond a_ (\_ -> a')+ traverse_ (M m ) = fmap M (traverse traverse_ m)+ traverse_ (Pure r ) = pure (Pure r)+ instance MonadTrans ListT where lift m = Select (do a <- lift m@@ -353,42 +490,62 @@ instance (MonadIO m) => MonadIO (ListT m) where liftIO m = lift (liftIO m)+ {-# INLINE liftIO #-} -instance (Monad m) => Alternative (ListT m) where+instance (Functor m) => Alternative (ListT m) where empty = Select (return ())+ {-# INLINE empty #-} p1 <|> p2 = Select (do enumerate p1 enumerate p2 ) instance (Monad m) => MonadPlus (ListT m) where mzero = empty+ {-# INLINE mzero #-} mplus = (<|>)+ {-# INLINE mplus #-} -#ifndef haskell98 instance MFunctor ListT where hoist morph = Select . hoist morph . enumerate-#endif+ {-# INLINE hoist #-} -instance (Monad m) => Monoid (ListT m a) where+instance MMonad ListT where+ embed f (Select p0) = Select (loop p0)+ where+ loop (Request a' fa ) = Request a' (\a -> loop (fa a ))+ loop (Respond b fb') = Respond b (\b' -> loop (fb' b'))+ loop (M m ) = for (enumerate (fmap loop (f m))) id+ loop (Pure r ) = Pure r+ {-# INLINE embed #-}++instance (Functor m) => Semigroup (ListT m a) where+ (<>) = (<|>)+ {-# INLINE (<>) #-}++instance (Functor m) => Monoid (ListT m a) where mempty = empty+ {-# INLINE mempty #-}+#if !(MIN_VERSION_base(4,11,0)) mappend = (<|>)+ {-# INLINE mappend #-}+#endif -#ifndef haskell98 instance (MonadState s m) => MonadState s (ListT m) where get = lift get+ {-# INLINE get #-} put s = lift (put s)+ {-# INLINE put #-} -#if MIN_VERSION_mtl(2,1,0) state f = lift (state f)-#endif+ {-# INLINE state #-} instance (MonadWriter w m) => MonadWriter w (ListT m) where-#if MIN_VERSION_mtl(2,1,0) writer = lift . writer-#endif+ {-# INLINE writer #-} tell w = lift (tell w)+ {-# INLINE tell #-} listen l = Select (go (enumerate l) mempty) where@@ -409,28 +566,67 @@ 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+ {-# INLINE ask #-} local f l = Select (local f (enumerate l))+ {-# INLINE local #-} -#if MIN_VERSION_mtl(2,1,0) reader f = lift (reader f)-#endif+ {-# INLINE reader #-} instance (MonadError e m) => MonadError e (ListT m) where throwError e = lift (throwError e)+ {-# INLINE throwError #-} catchError l k = Select (catchError (enumerate l) (\e -> enumerate (k e)))-#endif+ {-# INLINE catchError #-} +instance MonadThrow m => MonadThrow (ListT m) where+ throwM = Select . throwM+ {-# INLINE throwM #-}++instance MonadCatch m => MonadCatch (ListT m) where+ catch l k = Select (Control.Monad.Catch.catch (enumerate l) (\e -> enumerate (k e)))+ {-# INLINE catch #-}++instance Monad m => MonadZip (ListT m) where+ mzipWith f = go+ where+ go xs ys = Select $ do+ xres <- lift $ next (enumerate xs)+ case xres of+ Left r -> return r+ Right (x, xnext) -> do+ yres <- lift $ next (enumerate ys)+ case yres of+ Left r -> return r+ Right (y, ynext) -> do+ yield (f x y)+ enumerate (go (Select xnext) (Select ynext))++-- | Run a self-contained `ListT` computation+runListT :: Monad m => ListT m a -> m ()+runListT l = runEffect (enumerate (l >> mzero))+{-# INLINABLE runListT #-}+ {-| 'Enumerable' generalizes 'Data.Foldable.Foldable', converting effectful containers to 'ListT's.++ Instances of 'Enumerable' must satisfy these two laws:++> toListT (return r) = return r+>+> toListT $ do x <- m = do x <- toListT m+> f x toListT (f x)++ In other words, 'toListT' is monad morphism. -} class Enumerable t where- toListT :: (Monad m) => t m a -> ListT m a+ toListT :: Monad m => t m a -> ListT m a instance Enumerable ListT where toListT = id@@ -447,9 +643,9 @@ Nothing -> return () Just a -> yield a -instance Enumerable (ErrorT e) where+instance Enumerable (ExceptT e) where toListT m = Select $ do- x <- lift $ runErrorT m+ x <- lift $ runExceptT m case x of Left _ -> return () Right a -> yield a@@ -459,18 +655,23 @@ '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) {-# INLINABLE next #-} --- | Convert a 'F.Foldable' to a 'Producer'-each :: (Monad m, Foldable f) => f a -> Producer' a m ()+{-| Convert a 'F.Foldable' to a 'Producer'++@+'each' :: ('Functor' m, 'Foldable' f) => f a -> 'Producer' a m ()+@+-}+each :: (Functor m, Foldable f) => f a -> Proxy x' x () a m () each = F.foldr (\a p -> yield a >> p) (return ()) {-# INLINABLE each #-} {- The above code is the same as:@@ -481,19 +682,24 @@ build/foldr fusion -} --- | Convert an 'Enumerable' to a 'Producer'-every :: (Monad m, Enumerable t) => t m a -> Producer' a m ()+{-| Convert an 'Enumerable' to a 'Producer'++@+'every' :: ('Monad' m, 'Enumerable' t) => t m a -> 'Producer' a m ()+@+-}+every :: (Monad m, Enumerable t) => t m a -> Proxy x' x () a m () every it = discard >\\ enumerate (toListT it) {-# INLINABLE every #-} -- | Discards a value-discard :: (Monad m) => a -> m ()+discard :: Monad m => a -> m () discard _ = return () {-# INLINABLE discard #-} -- | ('>->') with the arguments flipped (<-<)- :: (Monad m)+ :: Functor m => Proxy () b c' c m r -- ^ -> Proxy a' a () b m r@@ -503,15 +709,13 @@ {-# INLINABLE (<-<) #-} {- $reexports+ "Control.Monad" re-exports 'void'+ "Control.Monad.IO.Class" re-exports 'MonadIO'. "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'+ "Data.Foldable" re-exports 'Foldable' (the class name only). -}
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 #-}@@ -222,10 +216,12 @@ (f '/>/' g) '/>/' h = f '/>/' (g '/>/' h) @ +#respond-diagram#+ The following diagrams show the flow of information: @-'respond' :: ('Monad' m)+'respond' :: 'Functor' m => a -> 'Proxy' x' x a' a m a' \ a@@ -237,13 +233,13 @@ x ==> / \\===> a | | | +----|----+- v + v a' -('/>/') :: ('Monad' m)+('/>/') :: 'Functor' 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 -> 'Proxy' x' x c' c m a') \ a /===> b a | / | |@@ -251,6 +247,23 @@ | v | / | v | | v | x' <== <== b' <==\\ / x'<== <== c' x' <== <== c' | f | X | g | = | f '/>/' g |+ x ==> ==> b ===/ \\ x ==> ==> c x ==> ==> c+ | | | \\ | | | | | |+ +----|----+ \\ +----|----+ +----|----++ v \\ v v+ a' \\==== b' a'++('//>') :: 'Functor' m+ => 'Proxy' x' x b' b m a'+ -> (b -> 'Proxy' x' x c' c m b')+ -> 'Proxy' x' x c' c m a'++\ /===> b+ / |+ +---------+ / +----|----+ +---------++ | | / | v | | |+ x' <== <== b' <==\\ / x'<== <== c' x' <== <== c'+ | f | X | g | = | f '//>' g | x ==> ==> b ===/ \\ x ==> ==> c x ==> ==> c' | | | \\ | | | | | | +----|----+ \\ +----|----+ +----|----+@@ -265,9 +278,9 @@ 'respond' is the identity of the respond category. -}-respond :: (Monad m) => a -> Proxy x' x a' a m a'+respond :: Functor m => a -> Proxy x' x a' a m a' respond a = Respond a Pure-{-# INLINABLE respond #-}+{-# INLINABLE [1] respond #-} {-| Compose two unfolds, creating a new unfold @@ -278,7 +291,7 @@ ('/>/') is the composition operator of the respond category. -} (/>/)- :: (Monad m)+ :: Functor m => (a -> Proxy x' x b' b m a') -- ^ -> (b -> Proxy x' x c' c m b')@@ -293,7 +306,7 @@ Point-ful version of ('/>/') -} (//>)- :: (Monad m)+ :: Functor m => Proxy x' x b' b m a' -- ^ -> (b -> Proxy x' x c' c m b')@@ -305,9 +318,9 @@ 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'))+ M m -> M (go <$> m) Pure a -> Pure a-{-# INLINABLE (//>) #-}+{-# INLINE [1] (//>) #-} {-# RULES "(Request x' fx ) //> fb" forall x' fx fb .@@ -315,7 +328,7 @@ "(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));+ (M m ) //> fb = M ((\p' -> p' //> fb) <$> m); "(Pure a ) //> fb" forall a fb . (Pure a ) //> fb = Pure a; #-}@@ -337,10 +350,12 @@ (f '\>\' g) '\>\' h = f '\>\' (g '\>\' h) @ +#request-diagram#+ The following diagrams show the flow of information: @-'request' :: ('Monad' m)+'request' :: 'Functor' m => a' -> 'Proxy' a' a y' y m a \ a'@@ -355,7 +370,7 @@ v a -('\>\') :: ('Monad' m)+('\>\') :: 'Functor' m => (b' -> 'Proxy' a' a y' y m b) -> (c' -> 'Proxy' b' b y' y m c) -> (c' -> 'Proxy' a' a y' y m c)@@ -371,6 +386,23 @@ +----|----+ / +----|----+ +----|----+ v / v v b ======/ c c++('>\\') :: Functor m+ => (b' -> Proxy a' a y' y m b)+ -> Proxy b' b y' y m c+ -> Proxy a' a y' y m c++\ b'<=====\\+ | \\+ +----|----+ \\ +---------+ +---------++ | v | \\ | | | |+ a' <== <== y' \\== b' <== <== y' a' <== <== y'+ | f | | g | = | f '>\\' g |+ a ==> ==> y /=> b ==> ==> y a ==> ==> y+ | | | / | | | | | |+ +----|----+ / +----|----+ +----|----++ v / v v+ b ======/ c c @ -} @@ -378,9 +410,9 @@ 'request' is the identity of the request category. -}-request :: (Monad m) => a' -> Proxy a' a y' y m a+request :: Functor m => a' -> Proxy a' a y' y m a request a' = Request a' Pure-{-# INLINABLE request #-}+{-# INLINABLE [1] request #-} {-| Compose two folds, creating a new fold @@ -391,7 +423,7 @@ ('\>\') is the composition operator of the request category. -} (\>\)- :: (Monad m)+ :: Functor m => (b' -> Proxy a' a y' y m b) -- ^ -> (c' -> Proxy b' b y' y m c)@@ -406,7 +438,7 @@ Point-ful version of ('\>\') -} (>\\)- :: (Monad m)+ :: Functor m => (b' -> Proxy a' a y' y m b) -- ^ -> Proxy b' b y' y m c@@ -418,9 +450,9 @@ 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'))+ M m -> M (go <$> m) Pure a -> Pure a-{-# INLINABLE (>\\) #-}+{-# INLINE [1] (>\\) #-} {-# RULES "fb' >\\ (Request b' fb )" forall fb' b' fb .@@ -428,7 +460,7 @@ "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' >\\ (M m ) = M ((\p' -> fb' >\\ p') <$> m); "fb' >\\ (Pure a )" forall fb' a . fb' >\\ (Pure a ) = Pure a; #-}@@ -453,7 +485,7 @@ The following diagram shows the flow of information: @-'push' :: ('Monad' m)+'push' :: 'Functor' m => a -> 'Proxy' a' a a' a m r \ a@@ -468,7 +500,7 @@ v r -('>~>') :: ('Monad' m)+('>~>') :: 'Functor' m => (a -> 'Proxy' a' a b' b m r) -> (b -> 'Proxy' b' b c' c m r) -> (a -> 'Proxy' a' a c' c m r)@@ -496,11 +528,11 @@ 'push' is the identity of the push category. -}-push :: (Monad m) => a -> Proxy a' a a' a m r+push :: Functor m => a -> Proxy a' a a' a m r push = go where go a = Respond a (\a' -> Request a' go)-{-# INLINABLE push #-}+{-# INLINABLE [1] push #-} {-| Compose two proxies blocked while 'request'ing data, creating a new proxy blocked while 'request'ing data@@ -512,7 +544,7 @@ ('>~>') is the composition operator of the push category. -} (>~>)- :: (Monad m)+ :: Functor m => (_a -> Proxy a' a b' b m r) -- ^ -> ( b -> Proxy b' b c' c m r)@@ -522,12 +554,12 @@ (fa >~> fb) a = fa a >>~ fb {-# INLINABLE (>~>) #-} -{-| @(p >>~ f)@ pairs each 'respond' in @p@ with an 'request' in @f@.+{-| @(p >>~ f)@ pairs each 'respond' in @p@ with a 'request' in @f@. Point-ful version of ('>~>') -} (>>~)- :: (Monad m)+ :: Functor m => Proxy a' a b' b m r -- ^ -> (b -> Proxy b' b c' c m r)@@ -537,9 +569,9 @@ 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))+ M m -> M ((\p' -> p' >>~ fb) <$> m) Pure r -> Pure r-{-# INLINABLE (>>~) #-}+{-# INLINE [1] (>>~) #-} {- $pull The 'pull' category closely corresponds to pull-based Unix pipes.@@ -558,10 +590,12 @@ (f '>+>' g) '>+>' h = f '>+>' (g '>+>' h) @ +#pull-diagram#+ The following diagrams show the flow of information: @-'pull' :: ('Monad' m)+'pull' :: 'Functor' m => a' -> 'Proxy' a' a a' a m r \ a'@@ -576,7 +610,7 @@ v r -('>+>') :: ('Monad' m)+('>+>') :: 'Functor' m -> (b' -> 'Proxy' a' a b' b m r) -> (c' -> 'Proxy' b' b c' c m r) -> (c' -> 'Proxy' a' a c' c m r)@@ -604,11 +638,11 @@ 'pull' is the identity of the pull category. -}-pull :: (Monad m) => a' -> Proxy a' a a' a m r+pull :: Functor m => a' -> Proxy a' a a' a m r pull = go where go a' = Request a' (\a -> Respond a go)-{-# INLINABLE pull #-}+{-# INLINABLE [1] pull #-} {-| Compose two proxies blocked in the middle of 'respond'ing, creating a new proxy blocked in the middle of 'respond'ing@@ -620,7 +654,7 @@ ('>+>') is the composition operator of the pull category. -} (>+>)- :: (Monad m)+ :: Functor m => ( b' -> Proxy a' a b' b m r) -- ^ -> (_c' -> Proxy b' b c' c m r)@@ -635,7 +669,7 @@ Point-ful version of ('>+>') -} (+>>)- :: (Monad m)+ :: Functor m => (b' -> Proxy a' a b' b m r) -- ^ -> Proxy b' b c' c m r@@ -645,9 +679,9 @@ 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'))+ M m -> M ((\p' -> fb' +>> p') <$> m) Pure r -> Pure r-{-# INLINABLE (+>>) #-}+{-# INLINABLE [1] (+>>) #-} {- $reflect @(reflect .)@ transforms each streaming category into its dual:@@ -682,13 +716,13 @@ -} -- | Switch the upstream and downstream ends-reflect :: (Monad m) => Proxy a' a b' b m r -> Proxy b b' a a' m r+reflect :: Functor m => Proxy a' a b' b m r -> Proxy b b' a a' m r reflect = go where go p = case p of Request a' fa -> Respond a' (\a -> go (fa a )) Respond b fb' -> Request b (\b' -> go (fb' b'))- M m -> M (m >>= \p' -> return (go p'))+ M m -> M (go <$> m) Pure r -> Pure r {-# INLINABLE reflect #-} @@ -696,30 +730,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 +772,7 @@ -- | Equivalent to ('/>/') with the arguments flipped (\<\)- :: (Monad m)+ :: Functor m => (b -> Proxy x' x c' c m b') -- ^ -> (a -> Proxy x' x b' b m a')@@ -750,7 +784,7 @@ -- | Equivalent to ('\>\') with the arguments flipped (/</)- :: (Monad m)+ :: Functor m => (c' -> Proxy b' b x' x m c) -- ^ -> (b' -> Proxy a' a x' x m b)@@ -762,7 +796,7 @@ -- | Equivalent to ('>~>') with the arguments flipped (<~<)- :: (Monad m)+ :: Functor m => (b -> Proxy b' b c' c m r) -- ^ -> (a -> Proxy a' a b' b m r)@@ -774,7 +808,7 @@ -- | Equivalent to ('>+>') with the arguments flipped (<+<)- :: (Monad m)+ :: Functor m => (c' -> Proxy b' b c' c m r) -- ^ -> (b' -> Proxy a' a b' b m r)@@ -786,7 +820,7 @@ -- | Equivalent to ('//>') with the arguments flipped (<\\)- :: (Monad m)+ :: Functor m => (b -> Proxy x' x c' c m b') -- ^ -> Proxy x' x b' b m a'@@ -798,7 +832,7 @@ -- | Equivalent to ('>\\') with the arguments flipped (//<)- :: (Monad m)+ :: Functor m => Proxy b' b y' y m c -- ^ -> (b' -> Proxy a' a y' y m b)@@ -810,7 +844,7 @@ -- | Equivalent to ('>>~') with the arguments flipped (~<<)- :: (Monad m)+ :: Functor m => (b -> Proxy b' b c' c m r) -- ^ -> Proxy a' a b' b m r@@ -822,7 +856,7 @@ -- | Equivalent to ('+>>') with the arguments flipped (<<+)- :: (Monad m)+ :: Functor m => Proxy b' b c' c m r -- ^ -> (b' -> Proxy a' a b' b m r)@@ -833,20 +867,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
@@ -18,39 +18,42 @@ any functions which can violate the monad transformer laws. -} -{-# LANGUAGE- FlexibleInstances- , MultiParamTypeClasses- , RankNTypes- , UndecidableInstances- , CPP- #-}---- The rewrite RULES require the 'TrustWorthy' annotation-#if __GLASGOW_HASKELL__ >= 702-{-# LANGUAGE Trustworthy #-}-#endif+{-# LANGUAGE CPP #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE Trustworthy #-} module Pipes.Internal ( -- * Internal Proxy(..) , unsafeHoist- , observe,+ , observe+ , X+ , closed ) where -import Control.Applicative (Applicative(pure, (<*>)), Alternative(empty, (<|>)))-import Control.Monad (MonadPlus(..))+import qualified Control.Monad.Fail as F (MonadFail(fail)) 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.Morph (MFunctor(hoist), MMonad(embed))+import Control.Monad.Except (MonadError(..))+import Control.Monad.Catch (MonadThrow(..), MonadCatch(..)) import Control.Monad.Reader (MonadReader(..)) import Control.Monad.State (MonadState(..))-import Control.Monad.Writer (MonadWriter(..))-import Data.Monoid (mempty,mappend)+import Control.Monad.Writer (MonadWriter(..), censor)+import Data.Void (Void)++#if MIN_VERSION_base(4,8,0)+import Control.Applicative (Alternative(..))+#else+import Control.Applicative #endif+import Data.Semigroup +import qualified Data.Void+ {-| A 'Proxy' is a monad transformer that receives and sends information on both an upstream and downstream interface. @@ -72,29 +75,35 @@ | M (m (Proxy a' a b' b m r)) | Pure r -instance (Monad m) => Functor (Proxy a' a b' b m) where+instance Functor m => Functor (Proxy a' a b' b m) where fmap f p0 = go p0 where go p = case p of Request a' fa -> Request a' (\a -> go (fa a )) Respond b fb' -> Respond b (\b' -> go (fb' b'))- M m -> M (m >>= \p' -> return (go p'))+ M m -> M (go <$> m) Pure r -> Pure (f r) -instance (Monad m) => Applicative (Proxy a' a b' b m) where+instance Functor m => Applicative (Proxy a' a b' b m) where pure = Pure pf <*> px = go pf where go p = case p of Request a' fa -> Request a' (\a -> go (fa a )) Respond b fb' -> Respond b (\b' -> go (fb' b'))- M m -> M (m >>= \p' -> return (go p'))- Pure f -> fmap f px+ M m -> M (go <$> m)+ Pure f -> fmap f px+ l *> r = go l where+ go p = case p of+ Request a' fa -> Request a' (\a -> go (fa a ))+ Respond b fb' -> Respond b (\b' -> go (fb' b'))+ M m -> M (go <$> m)+ Pure _ -> r -instance (Monad m) => Monad (Proxy a' a b' b m) where- return = Pure+instance Functor m => Monad (Proxy a' a b' b m) where+ return = pure (>>=) = _bind _bind- :: (Monad m)+ :: Functor m => Proxy a' a b' b m r -> (r -> Proxy a' a b' b m r') -> Proxy a' a b' b m r'@@ -102,8 +111,9 @@ 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+ M m -> M (go <$> m)+ Pure r -> f r+{-# NOINLINE[1] _bind #-} {-# RULES "_bind (Request a' k) f" forall a' k f .@@ -111,13 +121,27 @@ "_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 (M m) f = M ((\p -> _bind p f) <$> m); "_bind (Pure r ) f" forall r f . _bind (Pure r ) f = f r; #-} +instance (Functor m, Semigroup r) => Semigroup (Proxy a' a b' b m r) where+ p1 <> p2 = go p1 where+ go p = case p of+ Request a' fa -> Request a' (\a -> go (fa a ))+ Respond b fb' -> Respond b (\b' -> go (fb' b'))+ M m -> M (go <$> m)+ Pure r1 -> fmap (r1 <>) p2++instance (Functor m, Monoid r, Semigroup r) => Monoid (Proxy a' a b' b m r) where+ mempty = Pure mempty+#if !(MIN_VERSION_base(4,11,0))+ mappend = (<>)+#endif+ instance MonadTrans (Proxy a' a b' b) where- lift m = M (m >>= \r -> return (Pure r))+ lift m = M (Pure <$> m) {-| 'unsafeHoist' is like 'hoist', but faster. @@ -126,32 +150,42 @@ safe if you pass a monad morphism as the first argument. -} unsafeHoist- :: (Monad m)+ :: Functor m => (forall x . m x -> n x) -> Proxy a' a b' b m r -> Proxy a' a b' b n r unsafeHoist nat = go where go p = case p of Request a' fa -> Request a' (\a -> go (fa a )) Respond b fb' -> Respond b (\b' -> go (fb' b'))- M m -> M (nat (m >>= \p' -> return (go p')))- Pure r -> Pure r+ M m -> M (nat (go <$> m))+ Pure r -> Pure r {-# INLINABLE unsafeHoist #-} -#ifndef haskell98 instance MFunctor (Proxy a' a b' b) where- hoist nat p0 = go (observe p0) 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+ M m -> M (nat (go <$> m))+ 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 MMonad (Proxy a' a b' b) where+ embed f = go+ where+ go p = case p of+ Request a' fa -> Request a' (\a -> go (fa a ))+ Respond b fb' -> Respond b (\b' -> go (fb' b'))+ M m -> f m >>= go+ Pure r -> Pure r -#ifndef haskell98-instance (MonadReader r m) => MonadReader r (Proxy a' a b' b m) where+instance F.MonadFail m => F.MonadFail (Proxy a' a b' b m) where+ fail = lift . F.fail++instance MonadIO m => MonadIO (Proxy a' a b' b m) where+ liftIO m = M (liftIO (Pure <$> m))++instance MonadReader r m => MonadReader r (Proxy a' a b' b m) where ask = lift ask local f = go where@@ -159,22 +193,16 @@ Request a' fa -> Request a' (\a -> go (fa a )) Respond b fb' -> Respond b (\b' -> go (fb' b')) Pure r -> Pure r- M m -> M (local f m >>= \r -> return (go r))-#if MIN_VERSION_mtl(2,1,0)+ M m -> M (go <$> local f m) 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@@ -192,11 +220,11 @@ Request a' fa -> Request a' (\a -> go (fa a ) w) Respond b fb' -> Respond b (\b' -> go (fb' b') w) M m -> M (do- (p', w') <- listen m+ (p', w') <- censor (const mempty) (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,15 +235,13 @@ 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- empty = mzero- (<|>) = mplus+instance MonadThrow m => MonadThrow (Proxy a' a b' b m) where+ throwM = lift . throwM+ {-# INLINE throwM #-} -instance (MonadPlus m) => MonadPlus (Proxy a' a b' b m) where- mzero = lift mzero- mplus p0 p1 = go p0+instance MonadCatch m => MonadCatch (Proxy a' a b' b m) where+ catch p0 f = go p0 where go p = case p of Request a' fa -> Request a' (\a -> go (fa a ))@@ -223,7 +249,7 @@ Pure r -> Pure r M m -> M ((do p' <- m- return (go p') ) `mplus` return p1 )+ return (go p') ) `Control.Monad.Catch.catch` (\e -> return (f e)) ) {-| The monad transformer laws are correct when viewed through the 'observe' function:@@ -240,7 +266,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 +274,11 @@ M m' -> m' >>= go Pure r -> return (Pure r) {-# INLINABLE observe #-}++-- | The empty type, used to close output ends+type X = Void++-- | Use 'closed' to \"handle\" impossible outputs+closed :: X -> a+closed = Data.Void.absurd+{-# INLINABLE closed #-}
src/Pipes/Lift.hs view
@@ -1,109 +1,120 @@+{-# LANGUAGE CPP #-}+ {-| Many actions in base monad transformers cannot be automatically 'Control.Monad.Trans.Class.lift'ed. These functions lift these remaining actions so that they work in the 'Proxy' monad transformer.--} -{-# 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 (- -- * ErrorT- errorP-#ifndef haskell98- , runErrorP+ -- * Utilities+ distribute++ -- * ExceptT+ , exceptP+ , runExceptP , 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(..))-import qualified Control.Monad.Trans.Error as E+import qualified Control.Monad.Trans.Except as E import qualified Control.Monad.Trans.Maybe as M import qualified Control.Monad.Trans.Reader as R import qualified Control.Monad.Trans.State.Strict as S import qualified Control.Monad.Trans.Writer.Strict as W import qualified Control.Monad.Trans.RWS.Strict as RWS-import Data.Monoid (Monoid) import Pipes.Internal (Proxy(..), unsafeHoist)-#ifndef haskell98 import Control.Monad.Morph (hoist, MFunctor(..)) import Pipes.Core (runEffect, request, respond, (//>), (>\\))++#if MIN_VERSION_base(4,8,0)+#else+import Data.Monoid #endif --- | Wrap the base monad in 'E.ErrorT'-errorP- :: (Monad m, E.Error e)+-- | Distribute 'Proxy' over a monad transformer+distribute+ :: ( Monad m+ , MonadTrans t+ , MFunctor t+ , Monad (t m)+ , Monad (t (Proxy a' a b' b m))+ )+ => Proxy a' a b' b (t m) r+ -- ^ + -> t (Proxy a' a b' b m) r+ -- ^ +distribute p = runEffect $ request' >\\ unsafeHoist (hoist lift) p //> respond'+ where+ request' = lift . lift . request+ respond' = lift . lift . respond+{-# INLINABLE distribute #-}++-- | Wrap the base monad in 'E.ExceptT'+exceptP+ :: Monad m => Proxy a' a b' b m (Either e r)- -> Proxy a' a b' b (E.ErrorT e m) r-errorP p = do+ -> Proxy a' a b' b (E.ExceptT e m) r+exceptP p = do x <- unsafeHoist lift p- lift $ E.ErrorT (return x)-{-# INLINABLE errorP #-}+ lift $ E.ExceptT (return x)+{-# INLINABLE exceptP #-} -#ifndef haskell98--- | Run 'E.ErrorT' in the base monad-runErrorP- :: (Monad m, E.Error e)- => Proxy a' a b' b (E.ErrorT e m) r+-- | Run 'E.ExceptT' in the base monad+runExceptP+ :: Monad m+ => Proxy a' a b' b (E.ExceptT e m) r -> Proxy a' a b' b m (Either e r)-runErrorP = E.runErrorT . distribute -{-# INLINABLE runErrorP #-}+runExceptP = E.runExceptT . distribute+{-# INLINABLE runExceptP #-} -- | Catch an error in the base monad catchError- :: (Monad m, E.Error e) - => Proxy a' a b' b (E.ErrorT e m) r+ :: Monad m+ => Proxy a' a b' b (E.ExceptT e m) r -- ^- -> (e -> Proxy a' a b' b (E.ErrorT e m) r)+ -> (e -> Proxy a' a b' b (E.ExceptT e m) r) -- ^- -> Proxy a' a b' b (E.ErrorT e m) r-catchError e h = errorP . E.runErrorT $ - E.catchError (distribute e) (distribute . h)+ -> Proxy a' a b' b (E.ExceptT e m) r+catchError e h = exceptP . E.runExceptT $ + E.catchE (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 +136,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 +180,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 +191,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 +200,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 +228,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 +238,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 +259,6 @@ return r {-# INLINABLE rwsP #-} -#ifndef haskell98 -- | Run 'RWS.RWST' in the base monad runRWSP :: (Monad m, Monoid w)@@ -291,21 +293,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.ExceptT':++> import Control.Monad.Trans.Error+> import Pipes+>+> example :: Monad m => Pipe Int Int (ExceptT String m) r+> example = for cat $ \n ->+> if n == 0+> then lift $ throwError "Zero is forbidden"+> else yield n++ Without the tools in this module you cannot recover from any potential error+ until after you compose and run the pipeline:++>>> import qualified Pipes.Prelude as P+>>> runExceptT $ runEffect $ P.readLn >-> example >-> P.print+42<Enter>+42+1<Enter>+1+0<Enter>+Zero is forbidden+>>>++ This module provides `catchError`, which lets you catch and recover from+ errors inside the 'Pipe':++> import qualified Pipes.Lift as Lift+> +> caught :: Pipe Int Int (ExceptT String IO) r+> caught = example `Lift.catchError` \str -> do+> liftIO (putStrLn str)+> caught++ This lets you resume streaming in the face of errors raised within the base+ monad:++>>> runExceptT $ runEffect $ P.readLn >-> caught >-> P.print+0<Enter>+Zero is forbidden+42<Enter>+42+0<Enter>+Zero is forbidden+1<Enter>+1+...++ Another common use case is running a base monad before running the pipeline.+ For example, the following contrived 'Producer' uses 'S.StateT' gratuitously+ to increment numbers:++> import Control.Monad (forever)+> import Control.Monad.Trans.State.Strict+> import Pipes+> +> numbers :: Monad m => Producer Int (StateT Int m) r+> numbers = forever $ do+> n <- lift get+> yield n+> lift $ put $! n + 1++ You can run the 'StateT' monad by supplying an initial state, before you+ ever compose the 'Producer':++> import Pipes.Lift+>+> naturals :: Monad m => Producer Int m r+> naturals = evalStateP 0 numbers++ This deletes 'StateT' from the base monad entirely, give you a completely+ pure 'Pipes.Producer':++>>> Pipes.Prelude.toList naturals+[0,1,2,3,4,5,6...]++ Note that the convention for the 'S.StateT' run functions is backwards from+ @transformers@ for convenience: the initial state is the first argument.++ All of these functions internally use 'distribute', which can pull out most+ monad transformers from the base monad. For example, 'evalStateP' is+ defined in terms of 'distribute':++> evalStateP s p = evalStateT (distribute p) s++ Therefore you can use 'distribute' to run other monad transformers, too, as+ long as they implement the 'MFunctor' type class from the @mmorph@ library.+-}
src/Pipes/Prelude.hs view
@@ -16,37 +16,41 @@ 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 stdinLn , readLn , fromHandle+ , repeatM , replicateM+ , unfoldr -- * Consumers -- $consumers , stdoutLn+ , stdoutLn'+ , mapM_ , print , toHandle+ , drain -- * Pipes -- $pipes , map , mapM+ , sequence , mapFoldable , filter+ , mapMaybe , filterM+ , wither , take , takeWhile+ , takeWhile' , drop , dropWhile , concat@@ -57,11 +61,17 @@ , chain , read , show+ , seq + -- *ListT+ , loop+ -- * Folds -- $folds , fold+ , fold' , foldM+ , foldM' , all , any , and@@ -81,31 +91,29 @@ , product , toList , toListM+ , toListM' -- * 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 (liftM, 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 GHC.Exts (build) 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@@ -121,6 +129,7 @@ , length , map , mapM+ , mapM_ , maximum , minimum , notElem@@ -130,7 +139,9 @@ , product , read , readLn+ , sequence , show+ , seq , sum , take , takeWhile@@ -161,20 +172,24 @@ 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 #-} {-| Read 'String's from a 'IO.Handle' using 'IO.hGetLine' Terminates on end of input++@+'fromHandle' :: 'MonadIO' m => 'IO.Handle' -> 'Producer' 'String' m ()+@ -}-fromHandle :: (MonadIO m) => IO.Handle -> Producer' String m ()+fromHandle :: MonadIO m => IO.Handle -> Proxy x' x () String m () fromHandle h = go where go = do@@ -185,8 +200,29 @@ 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 ()+{-| Repeat a monadic action indefinitely, 'yield'ing each result++'repeatM' :: 'Monad' m => m a -> 'Producer' a m r+-}+repeatM :: Monad m => m a -> Proxy x' x () a m r+repeatM m = lift m >~ cat+{-# INLINABLE [1] repeatM #-}++{-# RULES+ "repeatM m >-> p" forall m p . repeatM m >-> p = lift m >~ p+ #-}++{-| Repeat a monadic action a fixed number of times, 'yield'ing each result++> replicateM 0 x = return ()+>+> replicateM (m + n) x = replicateM m x >> replicateM n x -- 0 <= {m,n}++@+'replicateM' :: 'Monad' m => Int -> m a -> 'Producer' a m ()+@+-}+replicateM :: Monad m => Int -> m a -> Proxy x' x () a m () replicateM n m = lift m >~ take n {-# INLINABLE replicateM #-} @@ -206,7 +242,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@@ -221,10 +257,34 @@ Right () -> go {-# INLINABLE stdoutLn #-} +{-| Write 'String's to 'IO.stdout' using 'putStrLn'++ This does not handle a broken output pipe, but has a polymorphic return+ value+-}+stdoutLn' :: MonadIO m => Consumer' String m r+stdoutLn' = for cat (\str -> liftIO (putStrLn str))+{-# INLINABLE [1] stdoutLn' #-}++{-# RULES+ "p >-> stdoutLn'" forall p .+ p >-> stdoutLn' = for p (\str -> liftIO (putStrLn str))+ #-}++-- | Consume all values using a monadic function+mapM_ :: Monad m => (a -> m ()) -> Consumer' a m r+mapM_ f = for cat (\a -> lift (f a))+{-# INLINABLE [1] mapM_ #-}++{-# RULES+ "p >-> mapM_ f" forall p f .+ p >-> mapM_ f = for p (\a -> lift (f a))+ #-}+ -- | 'print' values to 'IO.stdout' print :: (MonadIO m, Show a) => Consumer' a m r print = for cat (\a -> liftIO (Prelude.print a))-{-# INLINABLE print #-}+{-# INLINABLE [1] print #-} {-# RULES "p >-> print" forall p .@@ -232,15 +292,25 @@ #-} -- | 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 #-}+{-# INLINABLE [1] toHandle #-} {-# RULES "p >-> toHandle handle" forall p handle . p >-> toHandle handle = for p (\str -> liftIO (IO.hPutStrLn handle str)) #-} +-- | 'discard' all incoming values+drain :: Functor m => Consumer' a m r+drain = for cat discard+{-# INLINABLE [1] drain #-}++{-# RULES+ "p >-> drain" forall p .+ p >-> drain = for p discard+ #-}+ {- $pipes Use ('>->') to connect 'Producer's, 'Pipe's, and 'Consumer's: @@ -254,10 +324,15 @@ -} --- | Apply a function to all values flowing downstream-map :: (Monad m) => (a -> b) -> Pipe a b m r+{-| Apply a function to all values flowing downstream++> map id = cat+>+> map (g . f) = map f >-> map g+-}+map :: Functor m => (a -> b) -> Pipe a b m r map f = for cat (\a -> yield (f a))-{-# INLINABLE map #-}+{-# INLINABLE [1] map #-} {-# RULES "p >-> map f" forall p f . p >-> map f = for p (\a -> yield (f a))@@ -267,12 +342,17 @@ return (f a) ) >~ p #-} --- | Apply a monadic function to all values flowing downstream-mapM :: (Monad m) => (a -> m b) -> Pipe a b m r+{-| Apply a monadic function to all values flowing downstream++> mapM return = cat+>+> mapM (f >=> g) = mapM f >-> mapM g+-}+mapM :: Monad m => (a -> m b) -> Pipe a b m r mapM f = for cat $ \a -> do b <- lift (f a) yield b-{-# INLINABLE mapM #-}+{-# INLINABLE [1] mapM #-} {-# RULES "p >-> mapM f" forall p f . p >-> mapM f = for p (\a -> do@@ -285,36 +365,77 @@ return b ) >~ p #-} +-- | Convert a stream of actions to a stream of values+sequence :: Monad m => Pipe (m a) a m r+sequence = mapM id+{-# INLINABLE sequence #-}+ {- | Apply a function to all values flowing downstream, and forward each element of the result. -}-mapFoldable :: (Monad m, Foldable t) => (a -> t b) -> Pipe a b m r+mapFoldable :: (Functor m, Foldable t) => (a -> t b) -> Pipe a b m r mapFoldable f = for cat (\a -> each (f a))-{-# INLINABLE mapFoldable #-}+{-# INLINABLE [1] mapFoldable #-} {-# RULES "p >-> mapFoldable f" forall p f . p >-> mapFoldable f = for p (\a -> each (f a)) #-} --- | @(filter predicate)@ only forwards values that satisfy the predicate.-filter :: (Monad m) => (a -> Bool) -> Pipe a a m r+{-| @(filter predicate)@ only forwards values that satisfy the predicate.++> filter (pure True) = cat+>+> filter (liftA2 (&&) p1 p2) = filter p1 >-> filter p2+>+> filter f = mapMaybe (\a -> a <$ guard (f a))+-}+filter :: Functor m => (a -> Bool) -> Pipe a a m r filter predicate = for cat $ \a -> when (predicate a) (yield a)-{-# INLINABLE filter #-}+{-# INLINABLE [1] filter #-} {-# RULES "p >-> filter predicate" forall p predicate. p >-> filter predicate = for p (\a -> when (predicate a) (yield a)) #-} +{-| @(mapMaybe f)@ yields 'Just' results of 'f'.++Basic laws:++> mapMaybe (f >=> g) = mapMaybe f >-> mapMaybe g+>+> mapMaybe (pure @Maybe . f) = mapMaybe (Just . f) = map f+>+> mapMaybe (const Nothing) = drain++As a result of the second law,++> mapMaybe return = mapMaybe Just = cat+-}+mapMaybe :: Functor m => (a -> Maybe b) -> Pipe a b m r+mapMaybe f = for cat $ maybe (pure ()) yield . f+{-# INLINABLE [1] mapMaybe #-}++{-# RULES+ "p >-> mapMaybe f" forall p f.+ p >-> mapMaybe f = for p $ maybe (pure ()) yield . f+ #-}+ {-| @(filterM predicate)@ only forwards values that satisfy the monadic predicate++> filterM (pure (pure True)) = cat+>+> filterM (liftA2 (liftA2 (&&)) p1 p2) = filterM p1 >-> filterM p2+>+> filterM f = wither (\a -> (\b -> a <$ guard b) <$> f a) -}-filterM :: (Monad m) => (a -> m Bool) -> Pipe a a m r+filterM :: 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 #-}+{-# INLINABLE [1] filterM #-} {-# RULES "p >-> filterM predicate" forall p predicate .@@ -323,17 +444,62 @@ when b (yield a) ) #-} --- | @(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+{-| @(wither f)@ forwards 'Just' values produced by the+ monadic action.++Basic laws:++> wither (runMaybeT . (MaybeT . f >=> MaybeT . g)) = wither f >-> wither g+>+> wither (runMaybeT . lift . f) = wither (fmap Just . f) = mapM f+>+> wither (pure . f) = mapMaybe f++As a result of the second law,++> wither (runMaybeT . return) = cat++As a result of the third law,++> wither (pure . const Nothing) = wither (const (pure Nothing)) = drain+-}+wither :: Monad m => (a -> m (Maybe b)) -> Pipe a b m r+wither f = for cat $ lift . f >=> maybe (pure ()) yield+{-# INLINABLE [1] wither #-}++{-# RULES+ "p >-> wither f" forall p f .+ p >-> wither f = for p $ lift . f >=> maybe (pure ()) yield+ #-}++{-| @(take n)@ only allows @n@ values to pass through++> take 0 = return ()+>+> take (m + n) = take m >> take n++> take <infinity> = cat+>+> take (min m n) = take m >-> take n+-}+take :: Functor m => Int -> Pipe a a m ()+take = go+ where+ go 0 = return () + go n = do + a <- await+ yield a+ go (n-1) {-# INLINABLE take #-} {-| @(takeWhile p)@ allows values to pass downstream so long as they satisfy the predicate @p@.++> takeWhile (pure True) = cat+>+> takeWhile (liftA2 (&&) p1 p2) = takeWhile p1 >-> takeWhile p2 -}-takeWhile :: (Monad m) => (a -> Bool) -> Pipe a a m ()+takeWhile :: Functor m => (a -> Bool) -> Pipe a a m () takeWhile predicate = go where go = do@@ -345,17 +511,48 @@ 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+{-| @(takeWhile' p)@ is a version of takeWhile that returns the value failing+ the predicate.++> takeWhile' (pure True) = cat+>+> takeWhile' (liftA2 (&&) p1 p2) = takeWhile' p1 >-> takeWhile' p2+-}+takeWhile' :: Functor m => (a -> Bool) -> Pipe a a m a+takeWhile' predicate = go+ where+ go = do+ a <- await+ if (predicate a)+ then do+ yield a+ go+ else return a+{-# INLINABLE takeWhile' #-}++{-| @(drop n)@ discards @n@ values going downstream++> drop 0 = cat+>+> drop (m + n) = drop m >-> drop n+-}+drop :: Functor m => Int -> Pipe a a m r+drop = go+ where+ go 0 = cat+ go n = do+ await+ go (n-1) {-# INLINABLE drop #-} {-| @(dropWhile p)@ discards values going downstream until one violates the predicate @p@.++> dropWhile (pure False) = cat+>+> dropWhile (liftA2 (||) p1 p2) = dropWhile p1 >-> dropWhile p2 -}-dropWhile :: (Monad m) => (a -> Bool) -> Pipe a a m r+dropWhile :: Functor m => (a -> Bool) -> Pipe a a m r dropWhile predicate = go where go = do@@ -368,60 +565,71 @@ {-# INLINABLE dropWhile #-} -- | Flatten all 'Foldable' elements flowing downstream-concat :: (Monad m, Foldable f) => Pipe (f a) a m r+concat :: (Functor m, Foldable f) => Pipe (f a) a m r concat = for cat each-{-# INLINABLE concat #-}+{-# INLINABLE [1] concat #-} {-# RULES "p >-> concat" forall p . p >-> concat = for p each #-} -- | Outputs the indices of all elements that match the given element-elemIndices :: (Monad m, Eq a) => a -> Pipe a Int m r+elemIndices :: (Functor m, Eq a) => a -> Pipe a Int m r elemIndices a = findIndices (a ==) {-# INLINABLE elemIndices #-} -- | Outputs the indices of all elements that satisfied the predicate-findIndices :: (Monad m) => (a -> Bool) -> Pipe a Int m r-findIndices predicate = loop 0+findIndices :: Functor m => (a -> Bool) -> Pipe a Int m r+findIndices predicate = go 0 where- loop n = do+ go n = do a <- await when (predicate a) (yield n)- loop $! n + 1+ go $! 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+{-| Strict left scan++> Control.Foldl.purely scan :: Monad m => Fold a b -> Pipe a b m r+-}+scan :: Functor m => (x -> a -> x) -> x -> (x -> b) -> Pipe a b m r+scan step begin done = go begin where- loop x = do+ go x = do yield (done x) a <- await let x' = step x a- loop $! x'+ go $! x' {-# INLINABLE scan #-} --- | Strict, monadic left scan-scanM :: (Monad m) => (x -> a -> m x) -> m x -> (x -> m b) -> Pipe a b m r+{-| Strict, monadic left scan++> Control.Foldl.impurely scanM :: Monad m => FoldM m a b -> Pipe a b m r+-}+scanM :: Monad m => (x -> a -> m x) -> m x -> (x -> m b) -> Pipe a b m r scanM step begin done = do x <- lift begin- loop x+ go x where- loop x = do+ go x = do b <- lift (done x) yield b a <- await x' <- lift (step x a)- loop $! x'+ go $! x' {-# INLINABLE scanM #-} --- | Apply an action to all values flowing downstream-chain :: (Monad m) => (a -> m ()) -> Pipe a a m r+{-| Apply an action to all values flowing downstream++> chain (pure (return ())) = cat+>+> chain (liftA2 (>>) m1 m2) = chain m1 >-> chain m2+-}+chain :: Monad m => (a -> m ()) -> Pipe a a m r chain f = for cat $ \a -> do lift (f a) yield a-{-# INLINABLE chain #-}+{-# INLINABLE [1] chain #-} {-# RULES "p >-> chain f" forall p f .@@ -436,11 +644,11 @@ #-} -- | Parse 'Read'able values, only forwarding the value if the parse succeeds-read :: (Monad m, Read a) => Pipe String a m r+read :: (Functor m, Read a) => Pipe String a m r read = for cat $ \str -> case (reads str) of [(a, "")] -> yield a _ -> return ()-{-# INLINABLE read #-}+{-# INLINABLE [1] read #-} {-# RULES "p >-> read" forall p .@@ -450,15 +658,30 @@ #-} -- | Convert 'Show'able values to 'String's-show :: (Monad m, Show a) => Pipe a String m r+show :: (Functor m, Show a) => Pipe a String m r show = map Prelude.show {-# INLINABLE show #-} +-- | Evaluate all values flowing downstream to WHNF+seq :: Functor m => Pipe a a m r+seq = for cat $ \a -> yield $! a+{-# INLINABLE seq #-}++{-| Create a `Pipe` from a `ListT` transformation++> loop (k1 >=> k2) = loop k1 >-> loop k2+>+> loop return = cat+-}+loop :: Monad m => (a -> ListT m b) -> Pipe a b m r+loop k = for cat (every . k)+{-# INLINABLE loop #-}+ {- $folds Use these to fold the output of a 'Producer'. Many of these folds will stop drawing elements if they can compute their result early, like 'any': ->>> P.any null P.stdinLn+>>> P.any Prelude.null P.stdinLn Test<Enter> ABC<Enter> <Enter>@@ -467,55 +690,97 @@ -} --- | 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+{-| Strict fold of the elements of a 'Producer'++> Control.Foldl.purely fold :: Monad m => Fold a b -> Producer a m () -> m b+-}+fold :: Monad m => (x -> a -> x) -> x -> (x -> b) -> Producer a m () -> m b+fold step begin done p0 = go p0 begin where- 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+ go p x = case p of+ Request v _ -> closed v+ Respond a fu -> go (fu ()) $! step x a+ M m -> m >>= \p' -> go p' x Pure _ -> return (done x) {-# INLINABLE fold #-} --- | Strict, monadic fold of the elements of a 'Producer'+{-| Strict fold of the elements of a 'Producer' that preserves the return value++> Control.Foldl.purely fold' :: Monad m => Fold a b -> Producer a m r -> m (b, r)+-}+fold' :: Monad m => (x -> a -> x) -> x -> (x -> b) -> Producer a m r -> m (b, r)+fold' step begin done p0 = go p0 begin+ where+ go p x = case p of+ Request v _ -> closed v+ Respond a fu -> go (fu ()) $! step x a+ M m -> m >>= \p' -> go p' x+ Pure r -> return (done x, r)+{-# INLINABLE fold' #-}++{-| Strict, monadic fold of the elements of a 'Producer'++> Control.Foldl.impurely foldM :: Monad m => FoldM a b -> Producer a m () -> m b+-} foldM- :: (Monad m)+ :: 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+ go p0 x0 where- loop p x = case p of- Request v _ -> absurd v+ go p x = case p of+ Request v _ -> closed v Respond a fu -> do x' <- step x a- loop (fu ()) $! x'- M m -> m >>= \p' -> loop p' x+ go (fu ()) $! x'+ M m -> m >>= \p' -> go p' x Pure _ -> done x {-# INLINABLE foldM #-} +{-| Strict, monadic fold of the elements of a 'Producer'++> Control.Foldl.impurely foldM' :: Monad m => FoldM a b -> Producer a m r -> m (b, r)+-}+foldM'+ :: Monad m+ => (x -> a -> m x) -> m x -> (x -> m b) -> Producer a m r -> m (b, r)+foldM' step begin done p0 = do+ x0 <- begin+ go p0 x0+ where+ go p x = case p of+ Request v _ -> closed v+ Respond a fu -> do+ x' <- step x a+ go (fu ()) $! x'+ M m -> m >>= \p' -> go p' x+ Pure r -> do+ b <- done x+ return (b, r)+{-# INLINABLE foldM' #-}+ {-| @(all predicate p)@ determines whether all the elements of @p@ satisfy the predicate. -}-all :: (Monad m) => (a -> Bool) -> Producer a m () -> m Bool+all :: 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 +799,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,27 +820,27 @@ {-# 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 Left _ -> return Nothing- Right (a, p') -> loop a p'+ Right (a, p') -> go a p' where- loop a p = do+ go a p = do x <- next p case x of Left _ -> return (Just a)- Right (a', p') -> loop a' p'+ Right (a', p') -> go a' p' {-# INLINABLE last #-} -- | Count the number of elements in a 'Producer'-length :: (Monad m) => Producer a m () -> m Int+length :: Monad m => Producer a m () -> m Int length = fold (\n _ -> n + 1) 0 id {-# INLINABLE length #-} @@ -598,7 +863,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@@ -618,14 +883,15 @@ -- | Convert a pure 'Producer' into a list toList :: Producer a Identity () -> [a]-toList = loop+toList prod0 = build (go prod0) where- loop p = case p of- Request v _ -> absurd v- Respond a fu -> a:loop (fu ())- M m -> loop (runIdentity m)- Pure _ -> []-{-# INLINABLE toList #-}+ go prod cons nil =+ case prod of+ Request v _ -> closed v+ Respond a fu -> cons a (go (fu ()) cons nil)+ M m -> go (runIdentity m) cons nil+ Pure _ -> nil+{-# INLINE toList #-} {-| Convert an effectful 'Producer' into a list @@ -634,32 +900,43 @@ immediately as they are generated instead of loading all elements into memory. -}-toListM :: (Monad m) => Producer a m () -> m [a]-toListM = loop+toListM :: Monad m => Producer a m () -> m [a]+toListM = fold step begin done 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 []+ step x a = x . (a:)+ begin = id+ done x = x [] {-# INLINABLE toListM #-} +{-| Convert an effectful 'Producer' into a list alongside the return value++ Note: 'toListM'' is not an idiomatic use of @pipes@, but I provide it for+ simple testing purposes. Idiomatic @pipes@ style consumes the elements+ immediately as they are generated instead of loading all elements into+ memory.+-}+toListM' :: Monad m => Producer a m r -> m ([a], r)+toListM' = fold' step begin done+ where+ step x a = x . (a:)+ begin = id+ done x = x []+{-# INLINABLE toListM' #-}+ -- | Zip two 'Producer's-zip :: (Monad m)- => (Producer a m r)- -> (Producer b m r)- -> (Producer' (a, b) m r)+zip :: Monad m+ => (Producer a m r)+ -> (Producer b m r)+ -> (Proxy x' x () (a, b) m r) zip = zipWith (,) {-# INLINABLE zip #-} -- | Zip two 'Producer's using the provided combining function-zipWith :: (Monad m)+zipWith :: Monad m => (a -> b -> c) -> (Producer a m r) -> (Producer b m r)- -> (Producer' c m r)+ -> (Proxy x' x () c m r) zipWith f = go where go p1 p2 = do@@ -675,11 +952,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 +972,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 +981,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 +991,19 @@ x <- respond a lift $ put x {-# INLINABLE generalize #-}-#endif++{-| The natural unfold into a 'Producer' with a step function and a seed ++> unfoldr next = id+-}+unfoldr :: Monad m + => (s -> m (Either r (a, s))) -> s -> Producer a m r+unfoldr step = go where+ go s0 = do+ e <- lift (step s0)+ case e of+ Left r -> return r+ Right (a,s) -> do + yield a+ go s+{-# INLINABLE unfoldr #-}
src/Pipes/Tutorial.hs view
@@ -41,6 +41,8 @@ learn about by reading either: * the paper \"Monad Transformers - Step by Step\",+ + * part III \"Monads in the Real World\" of the tutorial \"All About Monads\", * chapter 18 of \"Real World Haskell\" on monad transformers, or: @@ -83,14 +85,14 @@ -- * Appendix: Time Complexity -- $timecomplexity++ -- * Copyright+ -- $copyright ) where import Control.Category import Control.Monad-import Control.Monad.Trans.Error-import Control.Monad.Trans.Writer.Strict import Pipes-import Pipes.Lift import qualified Pipes.Prelude as P import Prelude hiding ((.), id) @@ -241,22 +243,22 @@ 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 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+ '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- 'for' :: 'Monad' m => 'Producer' a m r -> (a -> 'Effect' m ()) -> 'Effect' m r+\ -- Producer X = Effect+ 'for' :: 'Monad' m => 'Producer' a m r -> (a -> 'Effect' m ()) -> 'Effect' m r @ This is the same trick that all @pipes@ functions use to work with various@@ -344,7 +346,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:@@ -370,47 +372,51 @@ {- $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:+ test out this feature by defining a new loop body that creates three copies+ of every value: > -- nested.hs > > import Pipes > import qualified Pipes.Prelude as P -- Pipes.Prelude already has 'stdinLn' > -> duplicate :: (Monad m) => a -> Producer a m ()-> duplicate x = do+> triple :: Monad m => a -> Producer a m ()+> triple x = do > yield x > yield x+> yield x > > loop :: Producer String IO ()-> loop = for P.stdinLn duplicate+> loop = for P.stdinLn triple > > -- This is the exact same as: > -- > -- loop = for P.stdinLn $ \x -> do > -- yield x > -- yield x+> -- yield x This time our @loop@ is a 'Producer' that outputs 'String's, specifically- 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:+ three copies of each line that we read from standard input. Since @loop@ is+ a 'Producer' we cannot run it because there is still unhandled output.+ However, we can use yet another 'for' to handle this new repeated stream: > -- nested.hs > > main = runEffect $ for loop (lift . putStrLn) This creates a program which echoes every line from standard input to- standard output twice:+ standard output three times: > $ ./nested > Test<Enter> > Test > Test+> Test > ABC<Enter> > ABC > ABC+> ABC > <Ctrl-D> > $ @@ -419,16 +425,16 @@ > main = runEffect $ > for P.stdinLn $ \str1 ->-> for (duplicate str1) $ \str2 ->+> for (triple str1) $ \str2 -> > lift $ putStrLn str2 Yes, we could have! In fact, this is a special case of the following equality, which always holds no matter what: @- \-\- s :: (Monad m) => 'Producer' a m () -- i.e. \'P.stdinLn\'- \-\- f :: (Monad m) => a -> 'Producer' b m () -- i.e. \'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. \'triple\'+ \-\- g :: Monad m => b -> 'Producer' c m () -- i.e. \'(lift . putStrLn)\' \ for (for s f) g = for s (\\x -> for (f x) g) @@@ -437,10 +443,10 @@ 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)+ (~>) :: Monad m+ => (a -> 'Producer' b m ())+ -> (b -> 'Producer' c m ())+ -> (a -> 'Producer' c m ()) (f ~> g) x = for (f x) g @ @@ -448,9 +454,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 ()+ g :: Monad m => b -> 'Producer' c m ()+ h :: Monad m => c -> 'Producer' d m () \ \-\- Associativity (f ~> g) ~> h = f ~> (g ~> h)@@ -498,7 +504,7 @@ our original code into the following more succinct form that composes two transformations: -> main = runEffect $ for P.stdinLn (duplicate ~> lift . putStrLn)+> main = runEffect $ for P.stdinLn (triple ~> lift . putStrLn) This means that we can also choose to program in a more functional style and think of stream processing in terms of composing transformations using@@ -568,7 +574,7 @@ @ One way to feed a 'Consumer' is to repeatedly feed the same input using- using ('>~') (pronounced \"feed\"):+ ('>~') (pronounced \"feed\"): @ \-\- +- Feed +- Consumer to +- Returns new@@ -608,7 +614,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@@ -744,7 +750,7 @@ 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+ example 'Pipe' is analogous to the Prelude's 'take', only allowing a fixed number of values to flow through: > -- take.hs@@ -812,7 +818,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 +844,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@@ -964,6 +970,104 @@ Notice how this streams out values immediately as they are generated, rather than building up a large intermediate result and then printing all the values in one batch at the end.++ `ListT` computations can be combined in more ways than `Pipe`s, so try to+ program in `ListT` as much as possible and defer converting it to a `Pipe`+ as late as possible using `P.loop`.++ You can combine `ListT` computations even if their inputs and outputs are+ completely different:++> data In+> = InA A+> | InB B+> | InC C+>+> data Out+> = OutD D+> | OutE E+> | OutF F+>+> -- Independent computations+>+> example1 :: A -> ListT IO D+> example2 :: B -> ListT IO E+> example3 :: C -> ListT IO F+>+> -- Combined computation+>+> total :: In -> ListT IO Out+> total input = case input of+> InA a -> fmap OutD (example1 a)+> InB b -> fmap OutE (example2 b)+> InC c -> fmap OutF (example3 c)++ Sometimes you have multiple computations that handle different inputs but+ the same output, in which case you don't need to unify their outputs:++> -- Overlapping outputs+>+> example1 :: A -> ListT IO Out+> example2 :: B -> ListT IO Out+> example3 :: C -> ListT IO Out+>+> -- Combined computation+>+> total :: In -> ListT IO Out+> total input = case input of+> InA a -> example1 a+> InB b -> example2 b+> InC c -> example3 c++ Other times you have multiple computations that handle the same input but+ produce different outputs. You can unify their outputs using the `Monoid`+ and `Functor` instances for `ListT`:++> -- Overlapping inputs+>+> example1 :: In -> ListT IO D+> example2 :: In -> ListT IO E+> example3 :: In -> ListT IO F+>+> -- Combined computation+>+> total :: In -> ListT IO Out+> total input =+> fmap OutD (example1 input)+> <> fmap OutE (example2 input)+> <> fmap OutF (example3 input)++ You can also chain `ListT` computations, feeding the output of the first+ computation as the input to the next computation:++> -- End-to-end+>+> aToB :: A -> ListT IO B+> bToC :: B -> ListT IO C+>+> -- Combined computation+>+> aToC :: A -> LIstT IO C+> aToC = aToB >=> bToC++ ... or you can just use @do@ notation if you prefer.++ However, the `Pipe` type is more general than `ListT` and can represent+ things like termination. Therefore you should consider mixing `Pipe`s with+ `ListT` when you need to take advantage of these extra features:++> -- Mix ListT with Pipes+>+> example :: In -> ListT IO Out+>+> pipe :: Pipe In Out IO ()+> pipe = Pipes.takeWhile (not . isC) >-> loop example+> where+> isC (InC _) = True+> isC _ = False++ So promote your `ListT` logic to a `Pipe` when you need to take advantage of+ these `Pipe`-specific features. -} {- $tricks@@ -976,7 +1080,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 +1094,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 +1106,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@@ -1019,7 +1123,7 @@ > customerService :: Producer String IO () > customerService = do-> each [ "Hello, how can I help you?" -- Begin with a script+> 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@@ -1036,7 +1140,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,15 +1148,16 @@ 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': -> input :: MaybeT IO Int+> input :: MaybeT IO String > input = do > str <- lift getLine > guard (str /= "Fail")+> return str >>> runEffect $ every input >-> P.stdoutLn Test<Enter>@@ -1075,12 +1180,16 @@ * @pipes-safe@: Resource management and exception safety for @pipes@ + * @pipes-group@: Grouping streams in constant space+ These libraries provide functionality specialized to common streaming domains. Additionally, there are several libraries on Hackage that provide even higher-level functionality, which you can find by searching under the \"Pipes\" category or by looking for packages with a @pipes-@ prefix in their name. Current examples include: + * @pipes-extras@: Miscellaneous utilities+ * @pipes-network@/@pipes-network-tls@: Networking * @pipes-zlib@: Compression and decompression@@ -1112,7 +1221,7 @@ {- $types @pipes@ uses parametric polymorphism (i.e. generics) to overload all- operations. You've probably noticed this overloading already::+ operations. You've probably noticed this overloading already: * 'yield' works within both 'Producer's and 'Pipe's @@ -1156,49 +1265,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 +1333,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 +1496,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 +1526,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 +1554,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,8 +1610,13 @@ > 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.+-}++{- $copyright+ This tutorial is licensed under a+ <http://creativecommons.org/licenses/by/4.0/ Creative Commons Attribution 4.0 International License> -}