conduit 1.1.7 → 1.3.6.1
raw patch · 34 files changed
Files
- ChangeLog.md +181/−0
- Data/Conduit.hs +0/−513
- Data/Conduit/Internal.hs +0/−1149
- Data/Conduit/Lift.hs +0/−571
- Data/Conduit/List.hs +0/−581
- README.md +9/−0
- benchmarks/optimize-201408.hs +412/−0
- benchmarks/unfused.hs +77/−0
- benchmarks/utf8-memory-usage.hs +0/−12
- changelog.md +0/−15
- conduit.cabal +103/−25
- fusion-macros.h +23/−0
- src/Conduit.hs +43/−0
- src/Data/Conduit.hs +107/−0
- src/Data/Conduit/Combinators.hs +2556/−0
- src/Data/Conduit/Combinators/Stream.hs +474/−0
- src/Data/Conduit/Combinators/Unqualified.hs +1206/−0
- src/Data/Conduit/Internal.hs +20/−0
- src/Data/Conduit/Internal/Conduit.hs +1333/−0
- src/Data/Conduit/Internal/Fusion.hs +286/−0
- src/Data/Conduit/Internal/List/Stream.hs +502/−0
- src/Data/Conduit/Internal/Pipe.hs +619/−0
- src/Data/Conduit/Lift.hs +518/−0
- src/Data/Conduit/List.hs +883/−0
- src/Data/Streaming/FileRead.hs +37/−0
- src/Data/Streaming/Filesystem.hs +100/−0
- src/System/Win32File.hsc +100/−0
- test/Data/Conduit/Extra/ZipConduitSpec.hs +11/−3
- test/Data/Conduit/StreamSpec.hs +602/−0
- test/Spec.hs +664/−0
- test/StreamSpec.hs +512/−0
- test/doctests.hs +6/−0
- test/main.hs +296/−352
- test/subdir/dummyfile.txt +0/−0
+ ChangeLog.md view
@@ -0,0 +1,181 @@+# ChangeLog for conduit++## 1.3.6.1++* Forward compatibility with `-Wnoncanonical-monad-instances` becoming an error++## 1.3.6++* Avoid dropping upstream items in `mergeSource` [#513](https://github.com/snoyberg/conduit/pull/513)++## 1.3.5++* Add `groupOn`++## 1.3.4.3++* Fix space leak in `*>` [#496](https://github.com/snoyberg/conduit/issues/496) [#497](https://github.com/snoyberg/conduit/pull/497)++## 1.3.4.2++* Fix GHC 9.2 build [#473](https://github.com/snoyberg/conduit/pull/473)++## 1.3.4.1++* Library and tests compile and run with GHC 9.0.1 [#455](https://github.com/snoyberg/conduit/pull/455)++## 1.3.4++* Add `foldWhile` [#453](https://github.com/snoyberg/conduit/issues/453) [#456](https://github.com/snoyberg/conduit/pull/456).++## 1.3.3++* Add `uncons`, `unconsM`, `unconsEither`, `unconsEitherM`.++## 1.3.2.1++* Fix isChunksForExactlyE [#445](https://github.com/snoyberg/conduit/issues/445) [#446](https://github.com/snoyberg/conduit/pull/446)++## 1.3.2++* Add `mapInputM` [#435](https://github.com/snoyberg/conduit/pull/435)++## 1.3.1.2++* More eagerly emit groups in `chunksOf` [#427](https://github.com/snoyberg/conduit/pull/427)++## 1.3.1.1++* Use lower-case imports (better for cross-compilation) [#408](https://github.com/snoyberg/conduit/pull/408)++## 1.3.1++* Add `MonadFail` instance for `ConduitT`.++## 1.3.0.3++* Improve fusion framework rewrite rules++## 1.3.0.2++* Replace `ReadMode` with `WriteMode` in `withSinkFile`++## 1.3.0.1++* Test suite compatibility with GHC 8.4.1 [#358](https://github.com/snoyberg/conduit/issues/358)++## 1.3.0++* Drop monad-control and exceptions in favor of unliftio+* Drop mmorph dependency+* Deprecate old type synonyms and operators+* Drop finalizers from the library entirely+ * Much simpler+ * Less guarantees about prompt finalization+ * No more `yieldOr`, `addCleanup`+ * Replace the `Resumable` types with `SealedConduitT`+* Add the `Conduit` and `Data.Conduit.Combinators` modules, stolen from+ `conduit-combinators`++## 1.2.13++* Add `Semigroup` instances [#345](https://github.com/snoyberg/conduit/pull/345)++## 1.2.12.1++* Fix `pass` in `ConduitM` `MonadWriter` instance++## 1.2.12++* Add `exceptC`, `runExceptC` and `catchExceptC` to `Data.Conduit.Lift`++## 1.2.11++* Add `unfoldEither` and `unfoldEitherM` to `Data.Conduit.List`++## 1.2.10++* Add `PrimMonad` instances for `ConduitM` and `Pipe`+ [#306](https://github.com/snoyberg/conduit/pull/306)++## 1.2.9.1++* Ensure downstream and inner sink receive same inputs in+ `passthroughSink`+ [#304](https://github.com/snoyberg/conduit/issues/304)++## 1.2.9++* `chunksOf` [#296](https://github.com/snoyberg/conduit/pull/296)++## 1.2.8++* Implement+ [the reskinning idea](http://www.snoyman.com/blog/2016/09/proposed-conduit-reskin):+ * `.|`+ * `runConduitPure`+ * `runConduitRes`++## 1.2.7++* Expose yieldM for ConduitM [#270](https://github.com/snoyberg/conduit/pull/270)++## 1.2.6.6++* Fix test suite compilation on older GHCs++## 1.2.6.5++* In zipConduitApp, left bias not respected mixing monadic and non-monadic conduits [#263](https://github.com/snoyberg/conduit/pull/263)++## 1.2.6.4++* Fix benchmark by adding a type signature++## 1.2.6.3++* Doc updates++## 1.2.6.2++* resourcet cannot be built with GHC 8 [#242](https://github.com/snoyberg/conduit/issues/242)+* Remove upper bound on transformers [#253](https://github.com/snoyberg/conduit/issues/253)++## 1.2.6++* `sourceToList`+* Canonicalise Monad instances [#237](https://github.com/snoyberg/conduit/pull/237)++## 1.2.5++* mapAccum and mapAccumM should be strict in their state [#218](https://github.com/snoyberg/conduit/issues/218)++## 1.2.4.1++* Some documentation improvements++## 1.2.4++* [fuseBothMaybe](https://github.com/snoyberg/conduit/issues/199)++__1.2.3__ Expose `connect` and `fuse` as synonyms for `$$` and `=$=`, respectively.++__1.2.2__ Lots more stream fusion.++__1.2__ Two performance optimizations added. (1) A stream fusion framework. This is a non-breaking change. (2) Codensity transform applied to the `ConduitM` datatype. This only affects users importing the `.Internal` module. Both changes are thoroughly described in the following to blog posts: [Speeding up conduit](https://www.fpcomplete.com/blog/2014/08/iap-speeding-up-conduit), and [conduit stream fusion](https://www.fpcomplete.com/blog/2014/08/conduit-stream-fusion).++__1.1__ Refactoring into conduit and conduit-extra packages. Core functionality is now in conduit, whereas most common helper modules (including Text, Binary, Zlib, etc) are in conduit-extra. To upgrade to this version, there should only be import list and conduit file changes necessary.++__1.0__ Simplified the user-facing interface back to the Source, Sink, and Conduit types, with Producer and Consumer for generic code. Error messages have been simplified, and optional leftovers and upstream terminators have been removed from the external API. Some long-deprecated functions were finally removed.++__0.5__ The internals of the package are now separated to the .Internal module, leaving only the higher-level interface in the advertised API. Internally, switched to a `Leftover` constructor and slightly tweaked the finalization semantics.++__0.4__ Inspired by the design of the pipes package: we now have a single unified type underlying `Source`, `Sink`, and `Conduit`. This type is named `Pipe`. There are type synonyms provided for the other three types. Additionally, `BufferedSource` is no longer provided. Instead, the connect-and-resume operator, `$$+`, can be used for the same purpose.++__0.3__ ResourceT has been greatly simplified, specialized for IO, and moved into a separate package. Instead of hard-coding ResourceT into the conduit datatypes, they can now live around any monad. The Conduit datatype has been enhanced to better allow generation of streaming output. The SourceResult, SinkResult, and ConduitResult datatypes have been removed entirely.++__0.2__ Instead of storing state in mutable variables, we now use CPS. A `Source` returns the next `Source`, and likewise for `Sink`s and `Conduit`s. Not only does this take better advantage of GHC\'s optimizations (about a 20% speedup), but it allows some operations to have a reduction in algorithmic complexity from exponential to linear. This also allowed us to remove the `Prepared` set of types. Also, the `State` functions (e.g., `sinkState`) use better constructors for return types, avoiding the need for a dummy state on completion.++__0.1__ `BufferedSource` is now an abstract type, and has a much more efficient internal representation. The result was a 41% speedup on microbenchmarks (note: do not expect speedups anywhere near that in real usage). In general, we are moving towards `BufferedSource` being a specific tool used internally as needed, but using `Source` for all external APIs.++__0.0__ Initial release.
− Data/Conduit.hs
@@ -1,513 +0,0 @@-{-# LANGUAGE RankNTypes #-}-{-# LANGUAGE DeriveFunctor #-}--- | If this is your first time with conduit, you should probably start with--- the tutorial:--- <https://haskell.fpcomplete.com/user/snoyberg/library-documentation/conduit-overview>.-module Data.Conduit- ( -- * Core interface- -- ** Types- Source- , Conduit- , Sink- , ConduitM- -- ** Connect/fuse operators- , ($$)- , ($=)- , (=$)- , (=$=)-- -- *** Fuse with upstream results- , fuseBoth- , fuseUpstream-- -- ** Primitives- , await- , yield- , leftover-- -- ** Finalization- , bracketP- , addCleanup- , yieldOr-- -- ** Exception handling- , catchC- , handleC- , tryC-- -- * Generalized conduit types- , Producer- , Consumer- , toProducer- , toConsumer-- -- * Utility functions- , awaitForever- , transPipe- , mapOutput- , mapOutputMaybe- , mapInput- , passthroughSink-- -- * Connect-and-resume- , ResumableSource- , newResumableSource- , ($$+)- , ($$++)- , ($$+-)- , ($=+)- , unwrapResumable- , closeResumableSource-- -- ** For @Conduit@s- , ResumableConduit- , newResumableConduit- , (=$$+)- , (=$$++)- , (=$$+-)- , unwrapResumableConduit-- -- * Fusion with leftovers- , fuseLeftovers- , fuseReturnLeftovers-- -- * Flushing- , Flush (..)-- -- * Newtype wrappers- -- ** ZipSource- , ZipSource (..)- , sequenceSources-- -- ** ZipSink- , ZipSink (..)- , sequenceSinks-- -- ** ZipConduit- , ZipConduit (..)- , sequenceConduits- ) where--import Control.Monad.Trans.Class (lift)-import Data.Conduit.Internal hiding (await, awaitForever, yield, yieldOr, leftover, bracketP, addCleanup, transPipe, mapOutput, mapOutputMaybe, mapInput, yieldM)-import qualified Data.Conduit.Internal as CI-import Control.Monad.Morph (hoist)-import Control.Monad (liftM, forever, when, unless)-import Control.Applicative (Applicative (..))-import Data.Traversable (Traversable (..))-import Control.Monad.Trans.Resource (MonadResource)---- Define fixity of all our operators-infixr 0 $$-infixl 1 $=-infixr 2 =$-infixr 2 =$=-infixr 0 $$+-infixr 0 $$++-infixr 0 $$+--infixl 1 $=+---- | The connect operator, which pulls data from a source and pushes to a sink.--- If you would like to keep the @Source@ open to be used for other--- operations, use the connect-and-resume operator '$$+'.------ Since 0.4.0-($$) :: Monad m => Source m a -> Sink a m b -> m b-src $$ sink = do- (rsrc, res) <- src $$+ sink- rsrc $$+- return ()- return res-{-# INLINE ($$) #-}---- | Left fuse, combining a source and a conduit together into a new source.------ Both the @Source@ and @Conduit@ will be closed when the newly-created--- @Source@ is closed.------ Leftover data from the @Conduit@ will be discarded.------ Note: Since version 1.0.18, this operator has been generalized to be--- identical to @=$=@.------ Since 0.4.0-($=) :: Monad m => Conduit a m b -> ConduitM b c m r -> ConduitM a c m r-ConduitM src $= ConduitM con = ConduitM $ pipeL src con-{-# INLINE ($=) #-}---- | Right fuse, combining a conduit and a sink together into a new sink.------ Both the @Conduit@ and @Sink@ will be closed when the newly-created @Sink@--- is closed.------ Leftover data returned from the @Sink@ will be discarded.------ Note: Since version 1.0.18, this operator has been generalized to be--- identical to @=$=@.------ Since 0.4.0-(=$) :: Monad m => Conduit a m b -> ConduitM b c m r -> ConduitM a c m r-ConduitM con =$ ConduitM sink = ConduitM $ pipeL con sink-{-# INLINE (=$) #-}---- | Fusion operator, combining two @Conduit@s together into a new @Conduit@.------ Both @Conduit@s will be closed when the newly-created @Conduit@ is closed.------ Leftover data returned from the right @Conduit@ will be discarded.------ Since 0.4.0-(=$=) :: Monad m => Conduit a m b -> ConduitM b c m r -> ConduitM a c m r-ConduitM left =$= ConduitM right = ConduitM $ pipeL left right-{-# INLINE (=$=) #-}---- | Wait for a single input value from upstream. If no data is available,--- returns @Nothing@.------ Since 0.5.0-await :: Monad m => Consumer i m (Maybe i)-await = ConduitM CI.await-{-# RULES "await >>= maybe" forall x y. await >>= maybe x y = ConduitM (NeedInput (unConduitM . y) (unConduitM . const x)) #-}-{-# INLINE [1] await #-}---- | Send a value downstream to the next component to consume. If the--- downstream component terminates, this call will never return control. If you--- would like to register a cleanup function, please use 'yieldOr' instead.------ Since 0.5.0-yield :: Monad m- => o -- ^ output value- -> ConduitM i o m ()-yield = ConduitM . CI.yield-{-# INLINE [1] yield #-}--yieldM :: Monad m => m o -> ConduitM i o m ()-yieldM = ConduitM . CI.yieldM-{-# INLINE [1] yieldM #-}--{-# RULES- "yield o >> p" forall o (p :: ConduitM i o m r). yield o >> p = ConduitM (HaveOutput (unConduitM p) (return ()) o)- ; "mapM_ yield" mapM_ yield = ConduitM . sourceList- ; "yieldOr o c >> p" forall o c (p :: ConduitM i o m r). yieldOr o c >> p =- ConduitM (HaveOutput (unConduitM p) c o)- ; "when yield next" forall b o p. when b (yield o) >> p =- if b then ConduitM (HaveOutput (unConduitM p) (return ()) o) else p- ; "unless yield next" forall b o p. unless b (yield o) >> p =- if b then p else ConduitM (HaveOutput (unConduitM p) (return ()) o)- ; "lift m >>= yield" forall m. lift m >>= yield = yieldM m- #-}---- | Provide a single piece of leftover input to be consumed by the next--- component in the current monadic binding.------ /Note/: it is highly encouraged to only return leftover values from input--- already consumed from upstream.------ Since 0.5.0-leftover :: i -> ConduitM i o m ()-leftover = ConduitM . CI.leftover-{-# INLINE [1] leftover #-}-{-# RULES "leftover l >> p" forall l (p :: ConduitM i o m r). leftover l >> p =- ConduitM (Leftover (unConduitM p) l) #-}---- | Perform some allocation and run an inner component. Two guarantees are--- given about resource finalization:------ 1. It will be /prompt/. The finalization will be run as early as possible.------ 2. It is exception safe. Due to usage of @resourcet@, the finalization will--- be run in the event of any exceptions.------ Since 0.5.0-bracketP :: MonadResource m- => IO a- -> (a -> IO ())- -> (a -> ConduitM i o m r)- -> ConduitM i o m r-bracketP alloc free inside = ConduitM $ CI.bracketP alloc free $ unConduitM . inside---- | Add some code to be run when the given component cleans up.------ The supplied cleanup function will be given a @True@ if the component ran to--- completion, or @False@ if it terminated early due to a downstream component--- terminating.------ Note that this function is not exception safe. For that, please use--- 'bracketP'.------ Since 0.4.1-addCleanup :: Monad m- => (Bool -> m ())- -> ConduitM i o m r- -> ConduitM i o m r-addCleanup f = ConduitM . CI.addCleanup f . unConduitM---- | Similar to 'yield', but additionally takes a finalizer to be run if the--- downstream component terminates.------ Since 0.5.0-yieldOr :: Monad m- => o- -> m () -- ^ finalizer- -> ConduitM i o m ()-yieldOr o m = ConduitM $ CI.yieldOr o m-{-# INLINE [1] yieldOr #-}---- | Wait for input forever, calling the given inner component for each piece of--- new input. Returns the upstream result type.------ This function is provided as a convenience for the common pattern of--- @await@ing input, checking if it's @Just@ and then looping.------ Since 0.5.0-awaitForever :: Monad m => (i -> ConduitM i o m r) -> ConduitM i o m ()-awaitForever f = ConduitM $ CI.awaitForever (unConduitM . f)---- | Transform the monad that a @ConduitM@ lives in.------ Note that the monad transforming function will be run multiple times,--- resulting in unintuitive behavior in some cases. For a fuller treatment,--- please see:------ <https://github.com/snoyberg/conduit/wiki/Dealing-with-monad-transformers>------ This function is just a synonym for 'hoist'.------ Since 0.4.0-transPipe :: Monad m => (forall a. m a -> n a) -> ConduitM i o m r -> ConduitM i o n r-transPipe = hoist---- | Apply a function to all the output values of a @ConduitM@.------ This mimics the behavior of `fmap` for a `Source` and `Conduit` in pre-0.4--- days. It can also be simulated by fusing with the @map@ conduit from--- "Data.Conduit.List".------ Since 0.4.1-mapOutput :: Monad m => (o1 -> o2) -> ConduitM i o1 m r -> ConduitM i o2 m r-mapOutput f (ConduitM p) = ConduitM $ CI.mapOutput f p---- | Same as 'mapOutput', but use a function that returns @Maybe@ values.------ Since 0.5.0-mapOutputMaybe :: Monad m => (o1 -> Maybe o2) -> ConduitM i o1 m r -> ConduitM i o2 m r-mapOutputMaybe f (ConduitM p) = ConduitM $ CI.mapOutputMaybe f p---- | Apply a function to all the input values of a @ConduitM@.------ Since 0.5.0-mapInput :: Monad m- => (i1 -> i2) -- ^ map initial input to new input- -> (i2 -> Maybe i1) -- ^ map new leftovers to initial leftovers- -> ConduitM i2 o m r- -> ConduitM i1 o m r-mapInput f g (ConduitM p) = ConduitM $ CI.mapInput f g p---- | The connect-and-resume operator. This does not close the @Source@, but--- instead returns it to be used again. This allows a @Source@ to be used--- incrementally in a large program, without forcing the entire program to live--- in the @Sink@ monad.------ Mnemonic: connect + do more.------ Since 0.5.0-($$+) :: Monad m => Source m a -> Sink a m b -> m (ResumableSource m a, b)-src $$+ sink = connectResume (ResumableSource src (return ())) sink-{-# INLINE ($$+) #-}---- | Continue processing after usage of @$$+@.------ Since 0.5.0-($$++) :: Monad m => ResumableSource m a -> Sink a m b -> m (ResumableSource m a, b)-($$++) = connectResume-{-# INLINE ($$++) #-}---- | Complete processing of a @ResumableSource@. This will run the finalizer--- associated with the @ResumableSource@. In order to guarantee process resource--- finalization, you /must/ use this operator after using @$$+@ and @$$++@.------ Since 0.5.0-($$+-) :: Monad m => ResumableSource m a -> Sink a m b -> m b-rsrc $$+- sink = do- (ResumableSource _ final, res) <- connectResume rsrc sink- final- return res-{-# INLINE ($$+-) #-}---- | Left fusion for a resumable source.------ Since 1.0.16-($=+) :: Monad m => ResumableSource m a -> Conduit a m b -> ResumableSource m b-ResumableSource src final $=+ sink = ResumableSource (src $= sink) final---- | Execute the finalizer associated with a @ResumableSource@, rendering the--- @ResumableSource@ invalid for further use.------ This is just a more explicit version of @$$+- return ()@.------ Since 1.1.3-closeResumableSource :: Monad m => ResumableSource m a -> m ()-closeResumableSource = ($$+- return ())---- | Provide for a stream of data that can be flushed.------ A number of @Conduit@s (e.g., zlib compression) need the ability to flush--- the stream at some point. This provides a single wrapper datatype to be used--- in all such circumstances.------ Since 0.3.0-data Flush a = Chunk a | Flush- deriving (Show, Eq, Ord)-instance Functor Flush where- fmap _ Flush = Flush- fmap f (Chunk a) = Chunk (f a)---- | A wrapper for defining an 'Applicative' instance for 'Source's which allows--- to combine sources together, generalizing 'zipSources'. A combined source--- will take input yielded from each of its @Source@s until any of them stop--- producing output.------ Since 1.0.13-newtype ZipSource m o = ZipSource { getZipSource :: Source m o }--instance Monad m => Functor (ZipSource m) where- fmap f = ZipSource . mapOutput f . getZipSource-instance Monad m => Applicative (ZipSource m) where- pure = ZipSource . forever . yield- (ZipSource f) <*> (ZipSource x) = ZipSource $ zipSourcesApp f x---- | Coalesce all values yielded by all of the @Source@s.------ Implemented on top of @ZipSource@, see that data type for more details.------ Since 1.0.13-sequenceSources :: (Traversable f, Monad m) => f (Source m o) -> Source m (f o)-sequenceSources = getZipSource . sequenceA . fmap ZipSource---- | A wrapper for defining an 'Applicative' instance for 'Sink's which allows--- to combine sinks together, generalizing 'zipSinks'. A combined sink--- distributes the input to all its participants and when all finish, produces--- the result. This allows to define functions like------ @--- sequenceSinks :: (Monad m)--- => [Sink i m r] -> Sink i m [r]--- sequenceSinks = getZipSink . sequenceA . fmap ZipSink--- @------ Note that the standard 'Applicative' instance for conduits works--- differently. It feeds one sink with input until it finishes, then switches--- to another, etc., and at the end combines their results.------ Since 1.0.13-newtype ZipSink i m r = ZipSink { getZipSink :: Sink i m r }--instance Monad m => Functor (ZipSink i m) where- fmap f (ZipSink x) = ZipSink (liftM f x)-instance Monad m => Applicative (ZipSink i m) where- pure = ZipSink . return- (ZipSink f) <*> (ZipSink x) =- ZipSink $ liftM (uncurry ($)) $ zipSinks f x---- | Send incoming values to all of the @Sink@ providing, and ultimately--- coalesce together all return values.------ Implemented on top of @ZipSink@, see that data type for more details.------ Since 1.0.13-sequenceSinks :: (Traversable f, Monad m) => f (Sink i m r) -> Sink i m (f r)-sequenceSinks = getZipSink . sequenceA . fmap ZipSink---- | The connect-and-resume operator. This does not close the @Conduit@, but--- instead returns it to be used again. This allows a @Conduit@ to be used--- incrementally in a large program, without forcing the entire program to live--- in the @Sink@ monad.------ Leftover data returned from the @Sink@ will be discarded.------ Mnemonic: connect + do more.------ Since 1.0.17-(=$$+) :: Monad m => Conduit a m b -> Sink b m r -> Sink a m (ResumableConduit a m b, r)-(=$$+) conduit = connectResumeConduit (ResumableConduit conduit (return ()))-{-# INLINE (=$$+) #-}---- | Continue processing after usage of '=$$+'. Connect a 'ResumableConduit' to--- a sink and return the output of the sink together with a new--- 'ResumableConduit'.------ Since 1.0.17-(=$$++) :: Monad m => ResumableConduit i m o -> Sink o m r -> Sink i m (ResumableConduit i m o, r)-(=$$++) = connectResumeConduit-{-# INLINE (=$$++) #-}---- | Complete processing of a 'ResumableConduit'. This will run the finalizer--- associated with the @ResumableConduit@. In order to guarantee process--- resource finalization, you /must/ use this operator after using '=$$+' and--- '=$$++'.------ Since 1.0.17-(=$$+-) :: Monad m => ResumableConduit i m o -> Sink o m r -> Sink i m r-rsrc =$$+- sink = do- (ResumableConduit _ final, res) <- connectResumeConduit rsrc sink- lift final- return res-{-# INLINE (=$$+-) #-}---infixr 0 =$$+-infixr 0 =$$++-infixr 0 =$$+----- | Provides an alternative @Applicative@ instance for @ConduitM@. In this instance,--- every incoming value is provided to all @ConduitM@s, and output is coalesced together.--- Leftovers from individual @ConduitM@s will be used within that component, and then discarded--- at the end of their computation. Output and finalizers will both be handled in a left-biased manner.------ As an example, take the following program:------ @--- main :: IO ()--- main = do--- let src = mapM_ yield [1..3 :: Int]--- conduit1 = CL.map (+1)--- conduit2 = CL.concatMap (replicate 2)--- conduit = getZipConduit $ ZipConduit conduit1 <* ZipConduit conduit2--- sink = CL.mapM_ print--- src $$ conduit =$ sink--- @------ It will produce the output: 2, 1, 1, 3, 2, 2, 4, 3, 3------ Since 1.0.17-newtype ZipConduit i o m r = ZipConduit { getZipConduit :: ConduitM i o m r }- deriving Functor-instance Monad m => Applicative (ZipConduit i o m) where- pure = ZipConduit . pure- ZipConduit left <*> ZipConduit right = ZipConduit (zipConduitApp left right)---- | Provide identical input to all of the @Conduit@s and combine their outputs--- into a single stream.------ Implemented on top of @ZipConduit@, see that data type for more details.------ Since 1.0.17-sequenceConduits :: (Traversable f, Monad m) => f (ConduitM i o m r) -> ConduitM i o m (f r)-sequenceConduits = getZipConduit . sequenceA . fmap ZipConduit---- | Fuse two @ConduitM@s together, and provide the return value of both. Note--- that this will force the entire upstream @ConduitM@ to be run to produce the--- result value, even if the downstream terminates early.------ Since 1.1.5-fuseBoth :: Monad m => ConduitM a b m r1 -> ConduitM b c m r2 -> ConduitM a c m (r1, r2)-fuseBoth (ConduitM up) (ConduitM down) =- ConduitM $ pipeL up (withUpstream $ generalizeUpstream down)-{-# INLINE fuseBoth #-}---- | Same as @fuseBoth@, but ignore the return value from the downstream--- @Conduit@. Same caveats of forced consumption apply.------ Since 1.1.5-fuseUpstream :: Monad m => ConduitM a b m r -> Conduit b m c -> ConduitM a c m r-fuseUpstream up down = fmap fst (fuseBoth up down)-{-# INLINE fuseUpstream #-}
− Data/Conduit/Internal.hs
@@ -1,1149 +0,0 @@-{-# OPTIONS_HADDOCK not-home #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE CPP #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE UndecidableInstances #-}-{-# LANGUAGE RankNTypes #-}-{-# LANGUAGE TupleSections #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE ImpredicativeTypes #-}-module Data.Conduit.Internal- ( -- * Types- Pipe (..)- , ConduitM (..)- , Source- , Producer- , Sink- , Consumer- , Conduit- , ResumableSource (..)- , ResumableConduit (..)- -- * Primitives- , await- , awaitE- , awaitForever- , yield- , yieldM- , yieldOr- , leftover- -- * Finalization- , bracketP- , addCleanup- -- * Composition- , idP- , pipe- , pipeL- , connectResume- , connectResumeConduit- , runPipe- , injectLeftovers- , (>+>)- , (<+<)- , fuseLeftovers- , fuseReturnLeftovers- -- * Generalizing- , sourceToPipe- , sinkToPipe- , conduitToPipe- , toProducer- , toConsumer- -- * Exceptions- , catchP- , handleP- , tryP- , catchC- , handleC- , tryC- -- * Utilities- , transPipe- , mapOutput- , mapOutputMaybe- , mapInput- , sourceList- , withUpstream- , unwrapResumable- , unwrapResumableConduit- , newResumableSource- , newResumableConduit- , Data.Conduit.Internal.enumFromTo- , zipSinks- , zipSources- , zipSourcesApp- , zipConduitApp- , passthroughSink- , generalizeUpstream- ) where--import Control.Applicative (Applicative (..))-import Control.Exception.Lifted as E (Exception, catch)-import Control.Monad ((>=>), liftM, ap, when, liftM2)-import Control.Monad.Error.Class(MonadError(..))-import Control.Monad.Reader.Class(MonadReader(..))-import Control.Monad.RWS.Class(MonadRWS())-import Control.Monad.Writer.Class(MonadWriter(..))-import Control.Monad.State.Class(MonadState(..))-import Control.Monad.Trans.Class (MonadTrans (lift))-import Control.Monad.IO.Class (MonadIO (liftIO))-import Control.Monad.Base (MonadBase (liftBase))-import Data.Void (Void, absurd)-import Data.Monoid (Monoid (mappend, mempty))-import Control.Monad.Trans.Resource-import qualified GHC.Exts-import qualified Data.IORef as I-import Control.Monad.Morph (MFunctor (..))-#if MIN_VERSION_exceptions(0, 6, 0)-import qualified Control.Monad.Catch as Catch-#endif---- | The underlying datatype for all the types in this package. In has six--- type parameters:------ * /l/ is the type of values that may be left over from this @Pipe@. A @Pipe@--- with no leftovers would use @Void@ here, and one with leftovers would use--- the same type as the /i/ parameter. Leftovers are automatically provided to--- the next @Pipe@ in the monadic chain.------ * /i/ is the type of values for this @Pipe@'s input stream.------ * /o/ is the type of values for this @Pipe@'s output stream.------ * /u/ is the result type from the upstream @Pipe@.------ * /m/ is the underlying monad.------ * /r/ is the result type.------ A basic intuition is that every @Pipe@ produces a stream of output values--- (/o/), and eventually indicates that this stream is terminated by sending a--- result (/r/). On the receiving end of a @Pipe@, these become the /i/ and /u/--- parameters.------ Since 0.5.0-data Pipe l i o u m r =- -- | Provide new output to be sent downstream. This constructor has three- -- fields: the next @Pipe@ to be used, a finalization function, and the- -- output value.- HaveOutput (Pipe l i o u m r) (m ()) o- -- | Request more input from upstream. The first field takes a new input- -- value and provides a new @Pipe@. The second takes an upstream result- -- value, which indicates that upstream is producing no more results.- | NeedInput (i -> Pipe l i o u m r) (u -> Pipe l i o u m r)- -- | Processing with this @Pipe@ is complete, providing the final result.- | Done r- -- | Require running of a monadic action to get the next @Pipe@.- | PipeM (m (Pipe l i o u m r))- -- | Return leftover input, which should be provided to future operations.- | Leftover (Pipe l i o u m r) l--instance Monad m => Functor (Pipe l i o u m) where- fmap = liftM--instance Monad m => Applicative (Pipe l i o u m) where- pure = return- (<*>) = ap--instance Monad m => Monad (Pipe l i o u m) where- return = Done-- HaveOutput p c o >>= fp = HaveOutput (p >>= fp) c o- NeedInput p c >>= fp = NeedInput (p >=> fp) (c >=> fp)- Done x >>= fp = fp x- PipeM mp >>= fp = PipeM ((>>= fp) `liftM` mp)- Leftover p i >>= fp = Leftover (p >>= fp) i--instance MonadBase base m => MonadBase base (Pipe l i o u m) where- liftBase = lift . liftBase--instance MonadTrans (Pipe l i o u) where- lift mr = PipeM (Done `liftM` mr)--instance MonadIO m => MonadIO (Pipe l i o u m) where- liftIO = lift . liftIO--instance MonadThrow m => MonadThrow (Pipe l i o u m) where- throwM = lift . throwM--#if MIN_VERSION_exceptions(0, 6, 0)-instance Catch.MonadCatch m => Catch.MonadCatch (Pipe l i o u m) where- catch p0 onErr =- go p0- where- go (Done r) = Done r- go (PipeM mp) = PipeM $ Catch.catch (liftM go mp) (return . onErr)- go (Leftover p i) = Leftover (go p) i- go (NeedInput x y) = NeedInput (go . x) (go . y)- go (HaveOutput p c o) = HaveOutput (go p) c o- {-# INLINE catch #-}-#endif--instance Monad m => Monoid (Pipe l i o u m ()) where- mempty = return ()- mappend = (>>)--instance MonadResource m => MonadResource (Pipe l i o u m) where- liftResourceT = lift . liftResourceT--instance MonadReader r m => MonadReader r (Pipe l i o u m) where- ask = lift ask- local f (HaveOutput p c o) = HaveOutput (local f p) c o- local f (NeedInput p c) = NeedInput (\i -> local f (p i)) (\u -> local f (c u))- local _ (Done x) = Done x- local f (PipeM mp) = PipeM (local f mp)- local f (Leftover p i) = Leftover (local f p) i---- Provided for doctest-#ifndef MIN_VERSION_mtl-#define MIN_VERSION_mtl(x, y, z) 0-#endif--instance MonadWriter w m => MonadWriter w (Pipe l i o u m) where-#if MIN_VERSION_mtl(2, 1, 0)- writer = lift . writer-#endif-- tell = lift . tell-- listen (HaveOutput p c o) = HaveOutput (listen p) c o- listen (NeedInput p c) = NeedInput (\i -> listen (p i)) (\u -> listen (c u))- listen (Done x) = Done (x,mempty)- listen (PipeM mp) =- PipeM $- do (p,w) <- listen mp- return $ do (x,w') <- listen p- return (x, w `mappend` w')- listen (Leftover p i) = Leftover (listen p) i-- pass (HaveOutput p c o) = HaveOutput (pass p) c o- pass (NeedInput p c) = NeedInput (\i -> pass (p i)) (\u -> pass (c u))- pass (PipeM mp) = PipeM $ mp >>= (return . pass)- pass (Done (x,_)) = Done x- pass (Leftover p i) = Leftover (pass p) i--instance MonadState s m => MonadState s (Pipe l i o u m) where- get = lift get- put = lift . put-#if MIN_VERSION_mtl(2, 1, 0)- state = lift . state-#endif--instance MonadRWS r w s m => MonadRWS r w s (Pipe l i o u m)--instance MonadError e m => MonadError e (Pipe l i o u m) where- throwError = lift . throwError- catchError (HaveOutput p c o) f = HaveOutput (catchError p f) c o- catchError (NeedInput p c) f = NeedInput (\i -> catchError (p i) f) (\u -> catchError (c u) f)- catchError (Done x) _ = Done x- catchError (PipeM mp) f =- PipeM $ catchError (liftM (flip catchError f) mp) (\e -> return (f e))- catchError (Leftover p i) f = Leftover (catchError p f) i---- | Core datatype of the conduit package. This type represents a general--- component which can consume a stream of input values @i@, produce a stream--- of output values @o@, perform actions in the @m@ monad, and produce a final--- result @r@. The type synonyms provided here are simply wrappers around this--- type.------ Since 1.0.0-newtype ConduitM i o m r = ConduitM { unConduitM :: Pipe i i o () m r }- deriving (Functor, Applicative, Monad, MonadIO, MonadTrans, MonadThrow, MFunctor-#if MIN_VERSION_exceptions(0, 6, 0)- , Catch.MonadCatch-#endif- )--instance MonadReader r m => MonadReader r (ConduitM i o m) where- ask = ConduitM ask- local f (ConduitM m) = ConduitM (local f m)--instance MonadWriter w m => MonadWriter w (ConduitM i o m) where-#if MIN_VERSION_mtl(2, 1, 0)- writer = ConduitM . writer-#endif- tell = ConduitM . tell- listen (ConduitM m) = ConduitM (listen m)- pass (ConduitM m) = ConduitM (pass m)--instance MonadState s m => MonadState s (ConduitM i o m) where- get = ConduitM get- put = ConduitM . put-#if MIN_VERSION_mtl(2, 1, 0)- state = ConduitM . state-#endif--instance MonadRWS r w s m => MonadRWS r w s (ConduitM i o m)--instance MonadError e m => MonadError e (ConduitM i o m) where- throwError = ConduitM . throwError- catchError (ConduitM m) f = ConduitM $ catchError m (unConduitM . f)--instance MonadBase base m => MonadBase base (ConduitM i o m) where- liftBase = lift . liftBase--instance MonadResource m => MonadResource (ConduitM i o m) where- liftResourceT = lift . liftResourceT--instance Monad m => Monoid (ConduitM i o m ()) where- mempty = return ()- mappend = (>>)---- | Provides a stream of output values, without consuming any input or--- producing a final result.------ Since 0.5.0-type Source m o = ConduitM () o m ()---- | A component which produces a stream of output values, regardless of the--- input stream. A @Producer@ is a generalization of a @Source@, and can be--- used as either a @Source@ or a @Conduit@.------ Since 1.0.0-type Producer m o = forall i. ConduitM i o m ()---- | Consumes a stream of input values and produces a final result, without--- producing any output.------ > type Sink i m r = ConduitM i Void m r------ Since 0.5.0-type Sink i = ConduitM i Void---- | A component which consumes a stream of input values and produces a final--- result, regardless of the output stream. A @Consumer@ is a generalization of--- a @Sink@, and can be used as either a @Sink@ or a @Conduit@.------ Since 1.0.0-type Consumer i m r = forall o. ConduitM i o m r---- | Consumes a stream of input values and produces a stream of output values,--- without producing a final result.------ Since 0.5.0-type Conduit i m o = ConduitM i o m ()---- | A @Source@ which has been started, but has not yet completed.------ This type contains both the current state of the @Source@, and the finalizer--- to be run to close it.------ Since 0.5.0-data ResumableSource m o = ResumableSource (Source m o) (m ())---- | Since 1.0.13-instance MFunctor ResumableSource where- hoist nat (ResumableSource src m) = ResumableSource (hoist nat src) (nat m)---- | Wait for a single input value from upstream.------ Since 0.5.0-await :: Pipe l i o u m (Maybe i)-await = NeedInput (Done . Just) (\_ -> Done Nothing)-{-# RULES "CI.await >>= maybe" forall x y. await >>= maybe x y = NeedInput y (const x) #-}-{-# INLINE [1] await #-}---- | This is similar to @await@, but will return the upstream result value as--- @Left@ if available.------ Since 0.5.0-awaitE :: Pipe l i o u m (Either u i)-awaitE = NeedInput (Done . Right) (Done . Left)-{-# RULES "awaitE >>= either" forall x y. awaitE >>= either x y = NeedInput y x #-}-{-# INLINE [1] awaitE #-}---- | Wait for input forever, calling the given inner @Pipe@ for each piece of--- new input. Returns the upstream result type.------ Since 0.5.0-awaitForever :: Monad m => (i -> Pipe l i o r m r') -> Pipe l i o r m r-awaitForever inner =- self- where- self = awaitE >>= either return (\i -> inner i >> self)-{-# INLINE [1] awaitForever #-}---- | Send a single output value downstream. If the downstream @Pipe@--- terminates, this @Pipe@ will terminate as well.------ Since 0.5.0-yield :: Monad m- => o -- ^ output value- -> Pipe l i o u m ()-yield = HaveOutput (Done ()) (return ())-{-# INLINE [1] yield #-}--yieldM :: Monad m => m o -> Pipe l i o u m ()-yieldM = PipeM . liftM (HaveOutput (Done ()) (return ()))-{-# INLINE [1] yieldM #-}---- | Similar to @yield@, but additionally takes a finalizer to be run if the--- downstream @Pipe@ terminates.------ Since 0.5.0-yieldOr :: Monad m- => o- -> m () -- ^ finalizer- -> Pipe l i o u m ()-yieldOr o f = HaveOutput (Done ()) f o-{-# INLINE [1] yieldOr #-}--{-# RULES- "CI.yield o >> p" forall o (p :: Pipe l i o u m r). yield o >> p = HaveOutput p (return ()) o- ; "mapM_ CI.yield" mapM_ yield = sourceList- ; "CI.yieldOr o c >> p" forall o c (p :: Pipe l i o u m r). yieldOr o c >> p = HaveOutput p c o- ; "lift m >>= CI.yield" forall m. lift m >>= yield = yieldM m- #-}---- | Provide a single piece of leftover input to be consumed by the next pipe--- in the current monadic binding.------ /Note/: it is highly encouraged to only return leftover values from input--- already consumed from upstream.------ Since 0.5.0-leftover :: l -> Pipe l i o u m ()-leftover = Leftover (Done ())-{-# INLINE [1] leftover #-}-{-# RULES "leftover l >> p" forall l (p :: Pipe l i o u m r). leftover l >> p = Leftover p l #-}---- | Perform some allocation and run an inner @Pipe@. Two guarantees are given--- about resource finalization:------ 1. It will be /prompt/. The finalization will be run as early as possible.------ 2. It is exception safe. Due to usage of @resourcet@, the finalization will--- be run in the event of any exceptions.------ Since 0.5.0-bracketP :: MonadResource m- => IO a- -> (a -> IO ())- -> (a -> Pipe l i o u m r)- -> Pipe l i o u m r-bracketP alloc free inside =- PipeM start- where- start = do- (key, seed) <- allocate alloc free- return $ addCleanup (const $ release key) (inside seed)---- | Add some code to be run when the given @Pipe@ cleans up.------ Since 0.4.1-addCleanup :: Monad m- => (Bool -> m ()) -- ^ @True@ if @Pipe@ ran to completion, @False@ for early termination.- -> Pipe l i o u m r- -> Pipe l i o u m r-addCleanup cleanup (Done r) = PipeM (cleanup True >> return (Done r))-addCleanup cleanup (HaveOutput src close x) = HaveOutput- (addCleanup cleanup src)- (cleanup False >> close)- x-addCleanup cleanup (PipeM msrc) = PipeM (liftM (addCleanup cleanup) msrc)-addCleanup cleanup (NeedInput p c) = NeedInput- (addCleanup cleanup . p)- (addCleanup cleanup . c)-addCleanup cleanup (Leftover p i) = Leftover (addCleanup cleanup p) i---- | The identity @Pipe@.------ Since 0.5.0-idP :: Monad m => Pipe l a a r m r-idP = NeedInput (HaveOutput idP (return ())) Done---- | Compose a left and right pipe together into a complete pipe. The left pipe--- will be automatically closed when the right pipe finishes.------ Since 0.5.0-pipe :: Monad m => Pipe l a b r0 m r1 -> Pipe Void b c r1 m r2 -> Pipe l a c r0 m r2-pipe =- goRight (return ())- where- goRight final left right =- case right of- HaveOutput p c o -> HaveOutput (recurse p) (c >> final) o- NeedInput rp rc -> goLeft rp rc final left- Done r2 -> PipeM (final >> return (Done r2))- PipeM mp -> PipeM (liftM recurse mp)- Leftover _ i -> absurd i- where- recurse = goRight final left-- goLeft rp rc final left =- case left of- HaveOutput left' final' o -> goRight final' left' (rp o)- NeedInput left' lc -> NeedInput (recurse . left') (recurse . lc)- Done r1 -> goRight (return ()) (Done r1) (rc r1)- PipeM mp -> PipeM (liftM recurse mp)- Leftover left' i -> Leftover (recurse left') i- where- recurse = goLeft rp rc final---- | Same as 'pipe', but automatically applies 'injectLeftovers' to the right @Pipe@.------ Since 0.5.0-pipeL :: Monad m => Pipe l a b r0 m r1 -> Pipe b b c r1 m r2 -> Pipe l a c r0 m r2--- Note: The following should be equivalent to the simpler:------ pipeL l r = l `pipe` injectLeftovers r------ However, this version tested as being significantly more efficient.-pipeL =- goRight (return ())- where- goRight final left right =- case right of- HaveOutput p c o -> HaveOutput (recurse p) (c >> final) o- NeedInput rp rc -> goLeft rp rc final left- Done r2 -> PipeM (final >> return (Done r2))- PipeM mp -> PipeM (liftM recurse mp)- Leftover right' i -> goRight final (HaveOutput left final i) right'- where- recurse = goRight final left-- goLeft rp rc final left =- case left of- HaveOutput left' final' o -> goRight final' left' (rp o)- NeedInput left' lc -> NeedInput (recurse . left') (recurse . lc)- Done r1 -> goRight (return ()) (Done r1) (rc r1)- PipeM mp -> PipeM (liftM recurse mp)- Leftover left' i -> Leftover (recurse left') i- where- recurse = goLeft rp rc final---- | Connect a @Source@ to a @Sink@ until the latter closes. Returns both the--- most recent state of the @Source@ and the result of the @Sink@.------ We use a @ResumableSource@ to keep track of the most recent finalizer--- provided by the @Source@.------ Since 0.5.0-connectResume :: Monad m- => ResumableSource m o- -> Sink o m r- -> m (ResumableSource m o, r)-connectResume (ResumableSource (ConduitM left0) leftFinal0) (ConduitM right0) =- goRight leftFinal0 left0 right0- where- goRight leftFinal left right =- case right of- HaveOutput _ _ o -> absurd o- NeedInput rp rc -> goLeft rp rc leftFinal left- Done r2 -> return (ResumableSource (ConduitM left) leftFinal, r2)- PipeM mp -> mp >>= goRight leftFinal left- Leftover p i -> goRight leftFinal (HaveOutput left leftFinal i) p-- goLeft rp rc leftFinal left =- case left of- HaveOutput left' leftFinal' o -> goRight leftFinal' left' (rp o)- NeedInput _ lc -> recurse (lc ())- Done () -> goRight (return ()) (Done ()) (rc ())- PipeM mp -> mp >>= recurse- Leftover p () -> recurse p- where- recurse = goLeft rp rc leftFinal---- | Run a pipeline until processing completes.------ Since 0.5.0-runPipe :: Monad m => Pipe Void () Void () m r -> m r-runPipe (HaveOutput _ _ o) = absurd o-runPipe (NeedInput _ c) = runPipe (c ())-runPipe (Done r) = return r-runPipe (PipeM mp) = mp >>= runPipe-runPipe (Leftover _ i) = absurd i---- | Transforms a @Pipe@ that provides leftovers to one which does not,--- allowing it to be composed.------ This function will provide any leftover values within this @Pipe@ to any--- calls to @await@. If there are more leftover values than are demanded, the--- remainder are discarded.------ Since 0.5.0-injectLeftovers :: Monad m => Pipe i i o u m r -> Pipe l i o u m r-injectLeftovers =- go []- where- go ls (HaveOutput p c o) = HaveOutput (go ls p) c o- go (l:ls) (NeedInput p _) = go ls $ p l- go [] (NeedInput p c) = NeedInput (go [] . p) (go [] . c)- go _ (Done r) = Done r- go ls (PipeM mp) = PipeM (liftM (go ls) mp)- go ls (Leftover p l) = go (l:ls) p---- | Transform the monad that a @Pipe@ lives in.------ Note that the monad transforming function will be run multiple times,--- resulting in unintuitive behavior in some cases. For a fuller treatment,--- please see:------ <https://github.com/snoyberg/conduit/wiki/Dealing-with-monad-transformers>------ This function is just a synonym for 'hoist'.------ Since 0.4.0-transPipe :: Monad m => (forall a. m a -> n a) -> Pipe l i o u m r -> Pipe l i o u n r-transPipe f (HaveOutput p c o) = HaveOutput (transPipe f p) (f c) o-transPipe f (NeedInput p c) = NeedInput (transPipe f . p) (transPipe f . c)-transPipe _ (Done r) = Done r-transPipe f (PipeM mp) =- PipeM (f $ liftM (transPipe f) $ collapse mp)- where- -- Combine a series of monadic actions into a single action. Since we- -- throw away side effects between different actions, an arbitrary break- -- between actions will lead to a violation of the monad transformer laws.- -- Example available at:- --- -- http://hpaste.org/75520- collapse mpipe = do- pipe' <- mpipe- case pipe' of- PipeM mpipe' -> collapse mpipe'- _ -> return pipe'-transPipe f (Leftover p i) = Leftover (transPipe f p) i---- | Apply a function to all the output values of a @Pipe@.------ This mimics the behavior of `fmap` for a `Source` and `Conduit` in pre-0.4--- days.------ Since 0.4.1-mapOutput :: Monad m => (o1 -> o2) -> Pipe l i o1 u m r -> Pipe l i o2 u m r-mapOutput f =- go- where- go (HaveOutput p c o) = HaveOutput (go p) c (f o)- go (NeedInput p c) = NeedInput (go . p) (go . c)- go (Done r) = Done r- go (PipeM mp) = PipeM (liftM (go) mp)- go (Leftover p i) = Leftover (go p) i-{-# INLINE mapOutput #-}---- | Same as 'mapOutput', but use a function that returns @Maybe@ values.------ Since 0.5.0-mapOutputMaybe :: Monad m => (o1 -> Maybe o2) -> Pipe l i o1 u m r -> Pipe l i o2 u m r-mapOutputMaybe f =- go- where- go (HaveOutput p c o) = maybe id (\o' p' -> HaveOutput p' c o') (f o) (mapOutputMaybe f p)- go (NeedInput p c) = NeedInput (go . p) (go . c)- go (Done r) = Done r- go (PipeM mp) = PipeM (liftM (go) mp)- go (Leftover p i) = Leftover (go p) i-{-# INLINE mapOutputMaybe #-}---- | Apply a function to all the input values of a @Pipe@.------ Since 0.5.0-mapInput :: Monad m- => (i1 -> i2) -- ^ map initial input to new input- -> (l2 -> Maybe l1) -- ^ map new leftovers to initial leftovers- -> Pipe l2 i2 o u m r- -> Pipe l1 i1 o u m r-mapInput f f' (HaveOutput p c o) = HaveOutput (mapInput f f' p) c o-mapInput f f' (NeedInput p c) = NeedInput (mapInput f f' . p . f) (mapInput f f' . c)-mapInput _ _ (Done r) = Done r-mapInput f f' (PipeM mp) = PipeM (liftM (mapInput f f') mp)-mapInput f f' (Leftover p i) = maybe id (flip Leftover) (f' i) $ mapInput f f' p--enumFromTo :: (Enum o, Eq o, Monad m)- => o- -> o- -> Pipe l i o u m ()-enumFromTo start stop =- loop start- where- loop i- | i == stop = HaveOutput (Done ()) (return ()) i- | otherwise = HaveOutput (loop (succ i)) (return ()) i-{-# INLINE enumFromTo #-}---- | Convert a list into a source.------ Since 0.3.0-sourceList :: Monad m => [a] -> Pipe l i a u m ()-sourceList =- go- where- go [] = Done ()- go (o:os) = HaveOutput (go os) (return ()) o-{-# INLINE [1] sourceList #-}---- | The equivalent of @GHC.Exts.build@ for @Pipe@.------ Since 0.4.2-build :: Monad m => (forall b. (o -> b -> b) -> b -> b) -> Pipe l i o u m ()-build g = g (\o p -> HaveOutput p (return ()) o) (return ())--{-# RULES- "sourceList/build" forall (f :: (forall b. (a -> b -> b) -> b -> b)). sourceList (GHC.Exts.build f) = build f #-}--sourceToPipe :: Monad m => Source m o -> Pipe l i o u m ()-sourceToPipe =- go . unConduitM- where- go (HaveOutput p c o) = HaveOutput (go p) c o- go (NeedInput _ c) = go $ c ()- go (Done ()) = Done ()- go (PipeM mp) = PipeM (liftM go mp)- go (Leftover p ()) = go p--sinkToPipe :: Monad m => Sink i m r -> Pipe l i o u m r-sinkToPipe =- go . injectLeftovers . unConduitM- where- go (HaveOutput _ _ o) = absurd o- go (NeedInput p c) = NeedInput (go . p) (const $ go $ c ())- go (Done r) = Done r- go (PipeM mp) = PipeM (liftM go mp)- go (Leftover _ l) = absurd l--conduitToPipe :: Monad m => Conduit i m o -> Pipe l i o u m ()-conduitToPipe =- go . injectLeftovers . unConduitM- where- go (HaveOutput p c o) = HaveOutput (go p) c o- go (NeedInput p c) = NeedInput (go . p) (const $ go $ c ())- go (Done ()) = Done ()- go (PipeM mp) = PipeM (liftM go mp)- go (Leftover _ l) = absurd l---- | Returns a tuple of the upstream and downstream results. Note that this--- will force consumption of the entire input stream.------ Since 0.5.0-withUpstream :: Monad m- => Pipe l i o u m r- -> Pipe l i o u m (u, r)-withUpstream down =- down >>= go- where- go r =- loop- where- loop = awaitE >>= either (\u -> return (u, r)) (\_ -> loop)---- | Unwraps a @ResumableSource@ into a @Source@ and a finalizer.------ A @ResumableSource@ represents a @Source@ which has already been run, and--- therefore has a finalizer registered. As a result, if we want to turn it--- into a regular @Source@, we need to ensure that the finalizer will be run--- appropriately. By appropriately, I mean:------ * If a new finalizer is registered, the old one should not be called.------ * If the old one is called, it should not be called again.------ This function returns both a @Source@ and a finalizer which ensures that the--- above two conditions hold. Once you call that finalizer, the @Source@ is--- invalidated and cannot be used.------ Since 0.5.2-unwrapResumable :: MonadIO m => ResumableSource m o -> m (Source m o, m ())-unwrapResumable (ResumableSource src final) = do- ref <- liftIO $ I.newIORef True- let final' = do- x <- liftIO $ I.readIORef ref- when x final- return (liftIO (I.writeIORef ref False) >> src, final')---- | Turn a @Source@ into a @ResumableSource@ with no attached finalizer.------ Since 1.1.4-newResumableSource :: Monad m => Source m o -> ResumableSource m o-newResumableSource s = ResumableSource s (return ())--infixr 9 <+<-infixl 9 >+>---- | Fuse together two @Pipe@s, connecting the output from the left to the--- input of the right.------ Notice that the /leftover/ parameter for the @Pipe@s must be @Void@. This--- ensures that there is no accidental data loss of leftovers during fusion. If--- you have a @Pipe@ with leftovers, you must first call 'injectLeftovers'.------ Since 0.5.0-(>+>) :: Monad m => Pipe l a b r0 m r1 -> Pipe Void b c r1 m r2 -> Pipe l a c r0 m r2-(>+>) = pipe-{-# INLINE (>+>) #-}---- | Same as '>+>', but reverse the order of the arguments.------ Since 0.5.0-(<+<) :: Monad m => Pipe Void b c r1 m r2 -> Pipe l a b r0 m r1 -> Pipe l a c r0 m r2-(<+<) = flip pipe-{-# INLINE (<+<) #-}---- | Generalize a 'Source' to a 'Producer'.------ Since 1.0.0-toProducer :: Monad m => Source m a -> Producer m a-toProducer =- ConduitM . go . unConduitM- where- go (HaveOutput p c o) = HaveOutput (go p) c o- go (NeedInput _ c) = go (c ())- go (Done r) = Done r- go (PipeM mp) = PipeM (liftM go mp)- go (Leftover p ()) = go p---- | Generalize a 'Sink' to a 'Consumer'.------ Since 1.0.0-toConsumer :: Monad m => Sink a m b -> Consumer a m b-toConsumer =- ConduitM . go . unConduitM- where- go (HaveOutput _ _ o) = absurd o- go (NeedInput p c) = NeedInput (go . p) (go . c)- go (Done r) = Done r- go (PipeM mp) = PipeM (liftM go mp)- go (Leftover p l) = Leftover (go p) l---- | Since 1.0.4-instance MFunctor (Pipe l i o u) where- hoist = transPipe---- | See 'catchC' for more details.------ Since 1.0.11-catchP :: (MonadBaseControl IO m, Exception e)- => Pipe l i o u m r- -> (e -> Pipe l i o u m r)- -> Pipe l i o u m r-catchP p0 onErr =- go p0- where- go (Done r) = Done r- go (PipeM mp) = PipeM $ E.catch (liftM go mp) (return . onErr)- go (Leftover p i) = Leftover (go p) i- go (NeedInput x y) = NeedInput (go . x) (go . y)- go (HaveOutput p c o) = HaveOutput (go p) c o-{-# INLINABLE catchP #-}---- | The same as @flip catchP@.------ Since 1.0.11-handleP :: (MonadBaseControl IO m, Exception e)- => (e -> Pipe l i o u m r)- -> Pipe l i o u m r- -> Pipe l i o u m r-handleP = flip catchP-{-# INLINE handleP #-}---- | See 'tryC' for more details.------ Since 1.0.11-tryP :: (MonadBaseControl IO m, Exception e)- => Pipe l i o u m r- -> Pipe l i o u m (Either e r)-tryP =- go- where- go (Done r) = Done (Right r)- go (PipeM mp) = PipeM $ E.catch (liftM go mp) (return . Done . Left)- go (Leftover p i) = Leftover (go p) i- go (NeedInput x y) = NeedInput (go . x) (go . y)- go (HaveOutput p c o) = HaveOutput (go p) c o-{-# INLINABLE tryP #-}---- | Catch all exceptions thrown by the current component of the pipeline.------ Note: this will /not/ catch exceptions thrown by other components! For--- example, if an exception is thrown in a @Source@ feeding to a @Sink@, and--- the @Sink@ uses @catchC@, the exception will /not/ be caught.------ Due to this behavior (as well as lack of async exception handling), you--- should not try to implement combinators such as @onException@ in terms of this--- primitive function.------ Note also that the exception handling will /not/ be applied to any--- finalizers generated by this conduit.------ Since 1.0.11-catchC :: (MonadBaseControl IO m, Exception e)- => ConduitM i o m r- -> (e -> ConduitM i o m r)- -> ConduitM i o m r-catchC (ConduitM p) f = ConduitM (catchP p (unConduitM . f))-{-# INLINE catchC #-}---- | The same as @flip catchC@.------ Since 1.0.11-handleC :: (MonadBaseControl IO m, Exception e)- => (e -> ConduitM i o m r)- -> ConduitM i o m r- -> ConduitM i o m r-handleC = flip catchC-{-# INLINE handleC #-}---- | A version of @try@ for use within a pipeline. See the comments in @catchC@--- for more details.------ Since 1.0.11-tryC :: (MonadBaseControl IO m, Exception e)- => ConduitM i o m r- -> ConduitM i o m (Either e r)-tryC = ConduitM . tryP . unConduitM-{-# INLINE tryC #-}---- | Combines two sinks. The new sink will complete when both input sinks have--- completed.------ Any leftovers are discarded.------ Since 0.4.1-zipSinks :: Monad m => Sink i m r -> Sink i m r' -> Sink i m (r, r')-zipSinks (ConduitM x0) (ConduitM y0) =- ConduitM $ injectLeftovers x0 >< injectLeftovers y0- where- (><) :: Monad m => Pipe Void i Void () m r1 -> Pipe Void i Void () m r2 -> Pipe l i o () m (r1, r2)-- Leftover _ i >< _ = absurd i- _ >< Leftover _ i = absurd i- HaveOutput _ _ o >< _ = absurd o- _ >< HaveOutput _ _ o = absurd o-- PipeM mx >< y = PipeM (liftM (>< y) mx)- x >< PipeM my = PipeM (liftM (x ><) my)- Done x >< Done y = Done (x, y)- NeedInput px cx >< NeedInput py cy = NeedInput (\i -> px i >< py i) (\() -> cx () >< cy ())- NeedInput px cx >< y@Done{} = NeedInput (\i -> px i >< y) (\u -> cx u >< y)- x@Done{} >< NeedInput py cy = NeedInput (\i -> x >< py i) (\u -> x >< cy u)---- | Combines two sources. The new source will stop producing once either--- source has been exhausted.------ Since 1.0.13-zipSources :: Monad m => Source m a -> Source m b -> Source m (a, b)-zipSources (ConduitM left0) (ConduitM right0) =- ConduitM $ go left0 right0- where- go (Leftover left ()) right = go left right- go left (Leftover right ()) = go left right- go (Done ()) (Done ()) = Done ()- go (Done ()) (HaveOutput _ close _) = PipeM (close >> return (Done ()))- go (HaveOutput _ close _) (Done ()) = PipeM (close >> return (Done ()))- go (Done ()) (PipeM _) = Done ()- go (PipeM _) (Done ()) = Done ()- go (PipeM mx) (PipeM my) = PipeM (liftM2 go mx my)- go (PipeM mx) y@HaveOutput{} = PipeM (liftM (\x -> go x y) mx)- go x@HaveOutput{} (PipeM my) = PipeM (liftM (go x) my)- go (HaveOutput srcx closex x) (HaveOutput srcy closey y) = HaveOutput (go srcx srcy) (closex >> closey) (x, y)- go (NeedInput _ c) right = go (c ()) right- go left (NeedInput _ c) = go left (c ())---- | Combines two sources. The new source will stop producing once either--- source has been exhausted.------ Since 1.0.13-zipSourcesApp :: Monad m => Source m (a -> b) -> Source m a -> Source m b-zipSourcesApp (ConduitM left0) (ConduitM right0) =- ConduitM $ go left0 right0- where- go (Leftover left ()) right = go left right- go left (Leftover right ()) = go left right- go (Done ()) (Done ()) = Done ()- go (Done ()) (HaveOutput _ close _) = PipeM (close >> return (Done ()))- go (HaveOutput _ close _) (Done ()) = PipeM (close >> return (Done ()))- go (Done ()) (PipeM _) = Done ()- go (PipeM _) (Done ()) = Done ()- go (PipeM mx) (PipeM my) = PipeM (liftM2 go mx my)- go (PipeM mx) y@HaveOutput{} = PipeM (liftM (\x -> go x y) mx)- go x@HaveOutput{} (PipeM my) = PipeM (liftM (go x) my)- go (HaveOutput srcx closex x) (HaveOutput srcy closey y) = HaveOutput (go srcx srcy) (closex >> closey) (x y)- go (NeedInput _ c) right = go (c ()) right- go left (NeedInput _ c) = go left (c ())---- |------ Since 1.0.17-zipConduitApp- :: Monad m- => ConduitM i o m (x -> y)- -> ConduitM i o m x- -> ConduitM i o m y-zipConduitApp (ConduitM left0) (ConduitM right0) =- ConduitM $ go (return ()) (return ()) (injectLeftovers left0) (injectLeftovers right0)- where- go _ _ (Done f) (Done x) = Done (f x)- go _ finalY (HaveOutput x finalX o) y = HaveOutput- (go finalX finalY x y)- (finalX >> finalY)- o- go finalX _ x (HaveOutput y finalY o) = HaveOutput- (go finalX finalY x y)- (finalX >> finalY)- o- go _ _ (Leftover _ i) _ = absurd i- go _ _ _ (Leftover _ i) = absurd i- go finalX finalY (PipeM mx) y = PipeM (flip (go finalX finalY) y `liftM` mx)- go finalX finalY x (PipeM my) = PipeM (go finalX finalY x `liftM` my)- go finalX finalY (NeedInput px cx) (NeedInput py cy) = NeedInput- (\i -> go finalX finalY (px i) (py i))- (\u -> go finalX finalY (cx u) (cy u))- go finalX finalY (NeedInput px cx) (Done y) = NeedInput- (\i -> go finalX finalY (px i) (Done y))- (\u -> go finalX finalY (cx u) (Done y))- go finalX finalY (Done x) (NeedInput py cy) = NeedInput- (\i -> go finalX finalY (Done x) (py i))- (\u -> go finalX finalY (Done x) (cy u))---- | Same as normal fusion (e.g. @=$=@), except instead of discarding leftovers--- from the downstream component, return them.------ Since 1.0.17-fuseReturnLeftovers :: Monad m- => ConduitM a b m ()- -> ConduitM b c m r- -> ConduitM a c m (r, [b])-fuseReturnLeftovers (ConduitM left0) (ConduitM right0) =- ConduitM $ goRight (return ()) [] left0 right0- where- goRight final bs left right =- case right of- HaveOutput p c o -> HaveOutput (recurse p) (c >> final) o- NeedInput rp rc ->- case bs of- [] -> goLeft rp rc final left- b:bs' -> goRight final bs' left (rp b)- Done r2 -> PipeM (final >> return (Done (r2, bs)))- PipeM mp -> PipeM (liftM recurse mp)- Leftover p b -> goRight final (b:bs) left p- where- recurse = goRight final bs left-- goLeft rp rc final left =- case left of- HaveOutput left' final' o -> goRight final' [] left' (rp o)- NeedInput left' lc -> NeedInput (recurse . left') (recurse . lc)- Done r1 -> goRight (return ()) [] (Done r1) (rc r1)- PipeM mp -> PipeM (liftM recurse mp)- Leftover left' i -> Leftover (recurse left') i- where- recurse = goLeft rp rc final---- | Similar to @fuseReturnLeftovers@, but use the provided function to convert--- downstream leftovers to upstream leftovers.------ Since 1.0.17-fuseLeftovers- :: Monad m- => ([b] -> [a])- -> ConduitM a b m ()- -> ConduitM b c m r- -> ConduitM a c m r-fuseLeftovers f left right = do- (r, bs) <- fuseReturnLeftovers left right- ConduitM $ mapM_ leftover $ reverse $ f bs- return r---- | A generalization of 'ResumableSource'. Allows to resume an arbitrary--- conduit, keeping its state and using it later (or finalizing it).------ Since 1.0.17-data ResumableConduit i m o =- ResumableConduit (Conduit i m o) (m ())---- | Connect a 'ResumableConduit' to a sink and return the output of the sink--- together with a new 'ResumableConduit'.------ Since 1.0.17-connectResumeConduit- :: Monad m- => ResumableConduit i m o- -> Sink o m r- -> Sink i m (ResumableConduit i m o, r)-connectResumeConduit (ResumableConduit (ConduitM left0) leftFinal0) (ConduitM right0) =- ConduitM $ goRight leftFinal0 left0 right0- where- goRight leftFinal left right =- case right of- HaveOutput _ _ o -> absurd o- NeedInput rp rc -> goLeft rp rc leftFinal left- Done r2 -> Done (ResumableConduit (ConduitM left) leftFinal, r2)- PipeM mp -> PipeM (liftM (goRight leftFinal left) mp)- Leftover p i -> goRight leftFinal (HaveOutput left leftFinal i) p-- goLeft rp rc leftFinal left =- case left of- HaveOutput left' leftFinal' o -> goRight leftFinal' left' (rp o)- NeedInput left' lc -> NeedInput (recurse . left') (recurse . lc)- Done () -> goRight (return ()) (Done ()) (rc ())- PipeM mp -> PipeM (liftM recurse mp)- Leftover left' i -> Leftover (recurse left') i -- recurse p- where- recurse = goLeft rp rc leftFinal---- | Unwraps a @ResumableConduit@ into a @Conduit@ and a finalizer.------ Since 'unwrapResumable' for more information.------ Since 1.0.17-unwrapResumableConduit :: MonadIO m => ResumableConduit i m o -> m (Conduit i m o, m ())-unwrapResumableConduit (ResumableConduit src final) = do- ref <- liftIO $ I.newIORef True- let final' = do- x <- liftIO $ I.readIORef ref- when x final- return (liftIO (I.writeIORef ref False) >> src, final')---- | Turn a @Conduit@ into a @ResumableConduit@ with no attached finalizer.------ Since 1.1.4-newResumableConduit :: Monad m => Conduit i m o -> ResumableConduit i m o-newResumableConduit c = ResumableConduit c (return ())---- | Turn a @Sink@ into a @Conduit@ in the following way:------ * All input passed to the @Sink@ is yielded downstream.------ * When the @Sink@ finishes processing, the result is passed to the provided to the finalizer function.------ Note that the @Sink@ will stop receiving input as soon as the downstream it--- is connected to shuts down.------ An example usage would be to write the result of a @Sink@ to some mutable--- variable while allowing other processing to continue.------ Since 1.1.0-passthroughSink :: Monad m- => Sink i m r- -> (r -> m ()) -- ^ finalizer- -> Conduit i m i-passthroughSink (ConduitM sink0) final =- ConduitM $ go [] sink0- where- go _ (Done r) = do- lift $ final r- awaitForever yield- go is (Leftover sink i) = go (i:is) sink- go _ (HaveOutput _ _ o) = absurd o- go is (PipeM mx) = do- x <- lift mx- go is x- go (i:is) (NeedInput next _) = go is (next i)- go [] (NeedInput next done) = do- mx <- await- case mx of- Nothing -> go [] (done ())- Just x -> do- yield x- go [] (next x)---- | Generalize the upstream return value for a @Pipe@ from unit to any type.------ Since 1.1.5-generalizeUpstream :: Monad m => Pipe l i o () m r -> Pipe l i o u m r-generalizeUpstream =- go- where- go (HaveOutput p f o) = HaveOutput (go p) f o- go (NeedInput x y) = NeedInput (go . x) (\_ -> go (y ()))- go (Done r) = Done r- go (PipeM mp) = PipeM (liftM go mp)- go (Leftover p l) = Leftover (go p) l-{-# INLINE generalizeUpstream #-}
− Data/Conduit/Lift.hs
@@ -1,571 +0,0 @@-{-# LANGUAGE RankNTypes #-}--- | Allow monad transformers to be run\/eval\/exec in a section of conduit--- rather then needing to run across the whole conduit. The circumvents many--- of the problems with breaking the monad transformer laws. For more--- information, see the announcement blog post:--- <http://www.yesodweb.com/blog/2014/01/conduit-transformer-exception>------ This module was added in conduit 1.0.11.-module Data.Conduit.Lift (- -- * ErrorT- errorC,- runErrorC,- catchErrorC,--- liftCatchError,-- -- * CatchT- runCatchC,- catchCatchC,-- -- * MaybeT- maybeC,- runMaybeC,-- -- * ReaderT- readerC,- runReaderC,-- -- * StateT, lazy- stateLC,- runStateLC,- evalStateLC,- execStateLC,-- -- ** Strict- stateC,- runStateC,- evalStateC,- execStateC,-- -- * WriterT, lazy- writerLC,- runWriterLC,- execWriterLC,-- -- ** Strict- writerC,- runWriterC,- execWriterC,-- -- * RWST, lazy- rwsLC,- runRWSLC,- evalRWSLC,- execRWSLC,-- -- ** Strict- rwsC,- runRWSC,- evalRWSC,- execRWSC,-- -- * Utilities-- distribute- ) where--import Data.Conduit-import Data.Conduit.Internal (ConduitM (..), Pipe (..))--import Control.Monad.Morph (hoist, lift, MFunctor(..), )-import Control.Monad.Trans.Class (MonadTrans(..))-import Control.Exception (SomeException)--import Data.Monoid (Monoid(..))---import qualified Control.Monad.Trans.Error as E-import qualified Control.Monad.Trans.Maybe as M-import qualified Control.Monad.Trans.Reader as R--import qualified Control.Monad.Trans.State.Strict as SS-import qualified Control.Monad.Trans.Writer.Strict as WS-import qualified Control.Monad.Trans.RWS.Strict as RWSS--import qualified Control.Monad.Trans.State.Lazy as SL-import qualified Control.Monad.Trans.Writer.Lazy as WL-import qualified Control.Monad.Trans.RWS.Lazy as RWSL-import Control.Monad.Catch.Pure (CatchT (runCatchT))---catAwaitLifted- :: (Monad (t (ConduitM o1 o m)), Monad m, MonadTrans t) =>- ConduitM i o1 (t (ConduitM o1 o m)) ()-catAwaitLifted = go- where- go = do- x <- lift . lift $ await- case x of- Nothing -> return ()- Just x2 -> do- yield x2- go--catYieldLifted- :: (Monad (t (ConduitM i o1 m)), Monad m, MonadTrans t) =>- ConduitM o1 o (t (ConduitM i o1 m)) ()-catYieldLifted = go- where- go = do- x <- await- case x of- Nothing -> return ()- Just x2 -> do- lift . lift $ yield x2- go---distribute- :: (Monad (t (ConduitM b o m)), Monad m, Monad (t m), MonadTrans t,- MFunctor t) =>- ConduitM b o (t m) () -> t (ConduitM b o m) ()-distribute p = catAwaitLifted =$= hoist (hoist lift) p $$ catYieldLifted---- | Run 'E.ErrorT' in the base monad------ Since 1.0.11-errorC- :: (Monad m, Monad (t (E.ErrorT e m)), MonadTrans t, E.Error e,- MFunctor t) =>- t m (Either e b) -> t (E.ErrorT e m) b-errorC p = do- x <- hoist lift p- lift $ E.ErrorT (return x)---- | Run 'E.ErrorT' in the base monad------ Since 1.0.11-runErrorC- :: (Monad m, E.Error e) =>- ConduitM i o (E.ErrorT e m) r -> ConduitM i o m (Either e r)-runErrorC =- ConduitM . go . unConduitM- where- go (Done r) = Done (Right r)- go (PipeM mp) = PipeM $ do- eres <- E.runErrorT mp- return $ case eres of- Left e -> Done $ Left e- Right p -> go p- go (Leftover p i) = Leftover (go p) i- go (HaveOutput p f o) = HaveOutput (go p) (E.runErrorT f >> return ()) o- go (NeedInput x y) = NeedInput (go . x) (go . y)-{-# INLINABLE runErrorC #-}---- | Catch an error in the base monad------ Since 1.0.11-catchErrorC- :: (Monad m, E.Error e) =>- ConduitM i o (E.ErrorT e m) r- -> (e -> ConduitM i o (E.ErrorT e m) r)- -> ConduitM i o (E.ErrorT e m) r-catchErrorC c0 h =- ConduitM $ go $ unConduitM c0- where- go (Done r) = Done r- go (PipeM mp) = PipeM $ do- eres <- lift $ E.runErrorT mp- return $ case eres of- Left e -> unConduitM $ h e- Right p -> go p- go (Leftover p i) = Leftover (go p) i- go (HaveOutput p f o) = HaveOutput (go p) f o- go (NeedInput x y) = NeedInput (go . x) (go . y)-{-# INLINABLE catchErrorC #-}---- | Run 'CatchT' in the base monad------ Since 1.1.0-runCatchC- :: Monad m =>- ConduitM i o (CatchT m) r -> ConduitM i o m (Either SomeException r)-runCatchC =- ConduitM . go . unConduitM- where- go (Done r) = Done (Right r)- go (PipeM mp) = PipeM $ do- eres <- runCatchT mp- return $ case eres of- Left e -> Done $ Left e- Right p -> go p- go (Leftover p i) = Leftover (go p) i- go (HaveOutput p f o) = HaveOutput (go p) (runCatchT f >> return ()) o- go (NeedInput x y) = NeedInput (go . x) (go . y)-{-# INLINABLE runCatchC #-}---- | Catch an exception in the base monad------ Since 1.1.0-catchCatchC- :: Monad m =>- ConduitM i o (CatchT m) r- -> (SomeException -> ConduitM i o (CatchT m) r)- -> ConduitM i o (CatchT m) r-catchCatchC c0 h =- ConduitM $ go $ unConduitM c0- where- go (Done r) = Done r- go (PipeM mp) = PipeM $ do- eres <- lift $ runCatchT mp- return $ case eres of- Left e -> unConduitM $ h e- Right p -> go p- go (Leftover p i) = Leftover (go p) i- go (HaveOutput p f o) = HaveOutput (go p) f o- go (NeedInput x y) = NeedInput (go . x) (go . y)-{-# INLINABLE catchCatchC #-}---- | Wrap the base monad in 'M.MaybeT'------ Since 1.0.11-maybeC- :: (Monad m, Monad (t (M.MaybeT m)),- MonadTrans t,- MFunctor t) =>- t m (Maybe b) -> t (M.MaybeT m) b-maybeC p = do- x <- hoist lift p- lift $ M.MaybeT (return x)-{-# INLINABLE maybeC #-}---- | Run 'M.MaybeT' in the base monad------ Since 1.0.11-runMaybeC- :: Monad m =>- ConduitM i o (M.MaybeT m) r -> ConduitM i o m (Maybe r)-runMaybeC =- ConduitM . go . unConduitM- where- go (Done r) = Done (Just r)- go (PipeM mp) = PipeM $ do- mres <- M.runMaybeT mp- return $ case mres of- Nothing -> Done Nothing- Just p -> go p- go (Leftover p i) = Leftover (go p) i- go (HaveOutput p c o) = HaveOutput (go p) (M.runMaybeT c >> return ()) o- go (NeedInput x y) = NeedInput (go . x) (go . y)-{-# INLINABLE runMaybeC #-}---- | Wrap the base monad in 'R.ReaderT'------ Since 1.0.11-readerC- :: (Monad m, Monad (t1 (R.ReaderT t m)),- MonadTrans t1,- MFunctor t1) =>- (t -> t1 m b) -> t1 (R.ReaderT t m) b-readerC k = do- i <- lift R.ask- hoist lift (k i)-{-# INLINABLE readerC #-}---- | Run 'R.ReaderT' in the base monad------ Since 1.0.11-runReaderC- :: Monad m =>- r -> ConduitM i o (R.ReaderT r m) res -> ConduitM i o m res-runReaderC r = hoist (`R.runReaderT` r)-{-# INLINABLE runReaderC #-}----- | Wrap the base monad in 'SL.StateT'------ Since 1.0.11-stateLC- :: (Monad m, Monad (t1 (SL.StateT t m)),- MonadTrans t1,- MFunctor t1) =>- (t -> t1 m (b, t)) -> t1 (SL.StateT t m) b-stateLC k = do- s <- lift SL.get- (r, s') <- hoist lift (k s)- lift (SL.put s')- return r-{-# INLINABLE stateLC #-}--thread :: Monad m- => (r -> s -> res)- -> (forall a. t m a -> s -> m (a, s))- -> s- -> ConduitM i o (t m) r- -> ConduitM i o m res-thread toRes runM s0 =- ConduitM . go s0 . unConduitM- where- go s (Done r) = Done (toRes r s)- go s (PipeM mp) = PipeM $ do- (p, s') <- runM mp s- return $ go s' p- go s (Leftover p i) = Leftover (go s p) i- go s (NeedInput x y) = NeedInput (go s . x) (go s . y)- go s (HaveOutput p f o) = HaveOutput (go s p) (runM f s >> return ()) o-{-# INLINABLE thread #-}---- | Run 'SL.StateT' in the base monad------ Since 1.0.11-runStateLC- :: Monad m =>- s -> ConduitM i o (SL.StateT s m) r -> ConduitM i o m (r, s)-runStateLC = thread (,) SL.runStateT-{-# INLINABLE runStateLC #-}---- | Evaluate 'SL.StateT' in the base monad------ Since 1.0.11-evalStateLC- :: Monad m =>- s -> ConduitM i o (SL.StateT s m) r -> ConduitM i o m r-evalStateLC s p = fmap fst $ runStateLC s p-{-# INLINABLE evalStateLC #-}---- | Execute 'SL.StateT' in the base monad------ Since 1.0.11-execStateLC- :: Monad m =>- s -> ConduitM i o (SL.StateT s m) r -> ConduitM i o m s-execStateLC s p = fmap snd $ runStateLC s p-{-# INLINABLE execStateLC #-}----- | Wrap the base monad in 'SS.StateT'------ Since 1.0.11-stateC- :: (Monad m, Monad (t1 (SS.StateT t m)),- MonadTrans t1,- MFunctor t1) =>- (t -> t1 m (b, t)) -> t1 (SS.StateT t m) b-stateC k = do- s <- lift SS.get- (r, s') <- hoist lift (k s)- lift (SS.put s')- return r-{-# INLINABLE stateC #-}---- | Run 'SS.StateT' in the base monad------ Since 1.0.11-runStateC- :: Monad m =>- s -> ConduitM i o (SS.StateT s m) r -> ConduitM i o m (r, s)-runStateC = thread (,) SS.runStateT-{-# INLINABLE runStateC #-}---- | Evaluate 'SS.StateT' in the base monad------ Since 1.0.11-evalStateC- :: Monad m =>- s -> ConduitM i o (SS.StateT s m) r -> ConduitM i o m r-evalStateC s p = fmap fst $ runStateC s p-{-# INLINABLE evalStateC #-}---- | Execute 'SS.StateT' in the base monad------ Since 1.0.11-execStateC- :: Monad m =>- s -> ConduitM i o (SS.StateT s m) r -> ConduitM i o m s-execStateC s p = fmap snd $ runStateC s p-{-# INLINABLE execStateC #-}----- | Wrap the base monad in 'WL.WriterT'------ Since 1.0.11-writerLC- :: (Monad m, Monad (t (WL.WriterT w m)), MonadTrans t, Monoid w,- MFunctor t) =>- t m (b, w) -> t (WL.WriterT w m) b-writerLC p = do- (r, w) <- hoist lift p- lift $ WL.tell w- return r-{-# INLINABLE writerLC #-}---- | Run 'WL.WriterT' in the base monad------ Since 1.0.11-runWriterLC- :: (Monad m, Monoid w) =>- ConduitM i o (WL.WriterT w m) r -> ConduitM i o m (r, w)-runWriterLC = thread (,) run mempty- where- run m w = do- (a, w') <- WL.runWriterT m- return (a, w `mappend` w')-{-# INLINABLE runWriterLC #-}---- | Execute 'WL.WriterT' in the base monad------ Since 1.0.11-execWriterLC- :: (Monad m, Monoid w) =>- ConduitM i o (WL.WriterT w m) r -> ConduitM i o m w-execWriterLC p = fmap snd $ runWriterLC p-{-# INLINABLE execWriterLC #-}----- | Wrap the base monad in 'WS.WriterT'------ Since 1.0.11-writerC- :: (Monad m, Monad (t (WS.WriterT w m)), MonadTrans t, Monoid w,- MFunctor t) =>- t m (b, w) -> t (WS.WriterT w m) b-writerC p = do- (r, w) <- hoist lift p- lift $ WS.tell w- return r-{-# INLINABLE writerC #-}---- | Run 'WS.WriterT' in the base monad------ Since 1.0.11-runWriterC- :: (Monad m, Monoid w) =>- ConduitM i o (WS.WriterT w m) r -> ConduitM i o m (r, w)-runWriterC = thread (,) run mempty- where- run m w = do- (a, w') <- WS.runWriterT m- return (a, w `mappend` w')-{-# INLINABLE runWriterC #-}---- | Execute 'WS.WriterT' in the base monad------ Since 1.0.11-execWriterC- :: (Monad m, Monoid w) =>- ConduitM i o (WS.WriterT w m) r -> ConduitM i o m w-execWriterC p = fmap snd $ runWriterC p-{-# INLINABLE execWriterC #-}----- | Wrap the base monad in 'RWSL.RWST'------ Since 1.0.11-rwsLC- :: (Monad m, Monad (t1 (RWSL.RWST t w t2 m)), MonadTrans t1,- Monoid w, MFunctor t1) =>- (t -> t2 -> t1 m (b, t2, w)) -> t1 (RWSL.RWST t w t2 m) b-rwsLC k = do- i <- lift RWSL.ask- s <- lift RWSL.get- (r, s', w) <- hoist lift (k i s)- lift $ do- RWSL.put s'- RWSL.tell w- return r-{-# INLINABLE rwsLC #-}---- | Run 'RWSL.RWST' in the base monad------ Since 1.0.11-runRWSLC- :: (Monad m, Monoid w) =>- r- -> s- -> ConduitM i o (RWSL.RWST r w s m) res- -> ConduitM i o m (res, s, w)-runRWSLC r s0 = thread toRes run (s0, mempty)- where- toRes a (s, w) = (a, s, w)- run m (s, w) = do- (res, s', w') <- RWSL.runRWST m r s- return (res, (s', w `mappend` w'))-{-# INLINABLE runRWSLC #-}---- | Evaluate 'RWSL.RWST' in the base monad------ Since 1.0.11-evalRWSLC- :: (Monad m, Monoid w) =>- r- -> s- -> ConduitM i o (RWSL.RWST r w s m) res- -> ConduitM i o m (res, w)-evalRWSLC i s p = fmap f $ runRWSLC i s p- where f x = let (r, _, w) = x in (r, w)-{-# INLINABLE evalRWSLC #-}---- | Execute 'RWSL.RWST' in the base monad------ Since 1.0.11-execRWSLC- :: (Monad m, Monoid w) =>- r- -> s- -> ConduitM i o (RWSL.RWST r w s m) res- -> ConduitM i o m (s, w)-execRWSLC i s p = fmap f $ runRWSLC i s p- where f x = let (_, s2, w2) = x in (s2, w2)-{-# INLINABLE execRWSLC #-}----- | Wrap the base monad in 'RWSS.RWST'------ Since 1.0.11-rwsC- :: (Monad m, Monad (t1 (RWSS.RWST t w t2 m)), MonadTrans t1,- Monoid w, MFunctor t1) =>- (t -> t2 -> t1 m (b, t2, w)) -> t1 (RWSS.RWST t w t2 m) b-rwsC k = do- i <- lift RWSS.ask- s <- lift RWSS.get- (r, s', w) <- hoist lift (k i s)- lift $ do- RWSS.put s'- RWSS.tell w- return r-{-# INLINABLE rwsC #-}---- | Run 'RWSS.RWST' in the base monad------ Since 1.0.11-runRWSC- :: (Monad m, Monoid w) =>- r- -> s- -> ConduitM i o (RWSS.RWST r w s m) res- -> ConduitM i o m (res, s, w)-runRWSC r s0 = thread toRes run (s0, mempty)- where- toRes a (s, w) = (a, s, w)- run m (s, w) = do- (res, s', w') <- RWSS.runRWST m r s- return (res, (s', w `mappend` w'))-{-# INLINABLE runRWSC #-}---- | Evaluate 'RWSS.RWST' in the base monad------ Since 1.0.11-evalRWSC- :: (Monad m, Monoid w) =>- r- -> s- -> ConduitM i o (RWSS.RWST r w s m) res- -> ConduitM i o m (res, w)-evalRWSC i s p = fmap f $ runRWSC i s p- where f x = let (r, _, w) = x in (r, w)-{-# INLINABLE evalRWSC #-}---- | Execute 'RWSS.RWST' in the base monad------ Since 1.0.11-execRWSC- :: (Monad m, Monoid w) =>- r- -> s- -> ConduitM i o (RWSS.RWST r w s m) res- -> ConduitM i o m (s, w)-execRWSC i s p = fmap f $ runRWSC i s p- where f x = let (_, s2, w2) = x in (s2, w2)-{-# INLINABLE execRWSC #-}-
− Data/Conduit/List.hs
@@ -1,581 +0,0 @@-{-# LANGUAGE RankNTypes #-}--- | Higher-level functions to interact with the elements of a stream. Most of--- these are based on list functions.------ Note that these functions all deal with individual elements of a stream as a--- sort of \"black box\", where there is no introspection of the contained--- elements. Values such as @ByteString@ and @Text@ will likely need to be--- treated specially to deal with their contents properly (@Word8@ and @Char@,--- respectively). See the "Data.Conduit.Binary" and "Data.Conduit.Text"--- modules.-module Data.Conduit.List- ( -- * Sources- sourceList- , sourceNull- , unfold- , unfoldM- , enumFromTo- , iterate- -- * Sinks- -- ** Pure- , fold- , foldMap- , take- , drop- , head- , peek- , consume- , sinkNull- -- ** Monadic- , foldMapM- , foldM- , mapM_- -- * Conduits- -- ** Pure- , map- , mapMaybe- , mapFoldable- , catMaybes- , concat- , concatMap- , concatMapAccum- , scanl- , scan- , mapAccum- , groupBy- , groupOn1- , isolate- , filter- -- ** Monadic- , mapM- , iterM- , scanlM- , scanM- , mapAccumM- , mapMaybeM- , mapFoldableM- , concatMapM- , concatMapAccumM- -- * Misc- , sequence- ) where--import qualified Prelude-import Prelude- ( ($), return, (==), (-), Int- , (.), id, Maybe (..), Monad- , Bool (..)- , (>>)- , (>>=)- , seq- , otherwise- , Enum (succ), Eq- , maybe- , either- , (<=)- )-import Data.Monoid (Monoid, mempty, mappend)-import qualified Data.Foldable as F-import Data.Conduit-import qualified Data.Conduit.Internal as CI-import Control.Monad (when, (<=<), liftM, void)-import Control.Monad.Trans.Class (lift)---- | Generate a source from a seed value.------ Since 0.4.2-unfold :: Monad m- => (b -> Maybe (a, b))- -> b- -> Producer m a-unfold f =- go- where- go seed =- case f seed of- Just (a, seed') -> yield a >> go seed'- Nothing -> return ()---- | A monadic unfold.------ Since 1.1.2-unfoldM :: Monad m- => (b -> m (Maybe (a, b)))- -> b- -> Producer m a-unfoldM f =- go- where- go seed = do- mres <- lift $ f seed- case mres of- Just (a, seed') -> yield a >> go seed'- Nothing -> return ()--sourceList :: Monad m => [a] -> Producer m a-sourceList = Prelude.mapM_ yield---- | Enumerate from a value to a final value, inclusive, via 'succ'.------ This is generally more efficient than using @Prelude@\'s @enumFromTo@ and--- combining with @sourceList@ since this avoids any intermediate data--- structures.------ Since 0.4.2-enumFromTo :: (Enum a, Eq a, Monad m)- => a- -> a- -> Producer m a-enumFromTo x = CI.ConduitM . CI.enumFromTo x-{-# INLINE enumFromTo #-}---- | Produces an infinite stream of repeated applications of f to x.-iterate :: Monad m => (a -> a) -> a -> Producer m a-iterate f =- go- where- go a = yield a >> go (f a)---- | A strict left fold.------ Since 0.3.0-fold :: Monad m- => (b -> a -> b)- -> b- -> Consumer a m b-fold f =- loop- where- loop accum =- await >>= maybe (return accum) go- where- go a =- let accum' = f accum a- in accum' `seq` loop accum'---- | A monadic strict left fold.------ Since 0.3.0-foldM :: Monad m- => (b -> a -> m b)- -> b- -> Consumer a m b-foldM f =- loop- where- loop accum = do- await >>= maybe (return accum) go- where- go a = do- accum' <- lift $ f accum a- accum' `seq` loop accum'---- | A monoidal strict left fold.------ Since 0.5.3-foldMap :: (Monad m, Monoid b)- => (a -> b)- -> Consumer a m b-foldMap f =- fold combiner mempty- where- combiner accum = mappend accum . f---- | A monoidal strict left fold in a Monad.------ Since 1.0.8-foldMapM :: (Monad m, Monoid b)- => (a -> m b)- -> Consumer a m b-foldMapM f =- foldM combiner mempty- where- combiner accum = liftM (mappend accum) . f---- | Apply the action to all values in the stream.------ Since 0.3.0-mapM_ :: Monad m- => (a -> m ())- -> Consumer a m ()-mapM_ f = awaitForever $ lift . f-{-# INLINE [1] mapM_ #-}--srcMapM_ :: Monad m => Source m a -> (a -> m ()) -> m ()-srcMapM_ (CI.ConduitM src) f =- go src- where- go (CI.Done ()) = return ()- go (CI.PipeM mp) = mp >>= go- go (CI.Leftover p ()) = go p- go (CI.HaveOutput p _ o) = f o >> go p- go (CI.NeedInput _ c) = go (c ())-{-# INLINE srcMapM_ #-}-{-# RULES "connect to mapM_" forall f src. src $$ mapM_ f = srcMapM_ src f #-}---- | Ignore a certain number of values in the stream. This function is--- semantically equivalent to:------ > drop i = take i >> return ()------ However, @drop@ is more efficient as it does not need to hold values in--- memory.------ Since 0.3.0-drop :: Monad m- => Int- -> Consumer a m ()-drop =- loop- where- loop i | i <= 0 = return ()- loop count = await >>= maybe (return ()) (\_ -> loop (count - 1))---- | Take some values from the stream and return as a list. If you want to--- instead create a conduit that pipes data to another sink, see 'isolate'.--- This function is semantically equivalent to:------ > take i = isolate i =$ consume------ Since 0.3.0-take :: Monad m- => Int- -> Consumer a m [a]-take =- loop id- where- loop front 0 = return $ front []- loop front count = await >>= maybe- (return $ front [])- (\x -> loop (front .(x:)) (count - 1))---- | Take a single value from the stream, if available.------ Since 0.3.0-head :: Monad m => Consumer a m (Maybe a)-head = await---- | Look at the next value in the stream, if available. This function will not--- change the state of the stream.------ Since 0.3.0-peek :: Monad m => Consumer a m (Maybe a)-peek = await >>= maybe (return Nothing) (\x -> leftover x >> return (Just x))---- | Apply a transformation to all values in a stream.------ Since 0.3.0-map :: Monad m => (a -> b) -> Conduit a m b-map f = awaitForever $ yield . f-{-# INLINE [1] map #-}---- Since a Source never has any leftovers, fusion rules on it are safe.-{-# RULES "source/map fusion $=" forall f src. src $= map f = mapFuseRight src f #-}-{-# RULES "source/map fusion =$=" forall f src. src =$= map f = mapFuseRight src f #-}--mapFuseRight :: Monad m => Source m a -> (a -> b) -> Source m b-mapFuseRight (CI.ConduitM src) f = CI.ConduitM (CI.mapOutput f src)-{-# INLINE mapFuseRight #-}--{---It might be nice to include these rewrite rules, but they may have subtle-differences based on leftovers.--{-# RULES "map-to-mapOutput pipeL" forall f src. pipeL src (map f) = mapOutput f src #-}-{-# RULES "map-to-mapOutput $=" forall f src. src $= (map f) = mapOutput f src #-}-{-# RULES "map-to-mapOutput pipe" forall f src. pipe src (map f) = mapOutput f src #-}-{-# RULES "map-to-mapOutput >+>" forall f src. src >+> (map f) = mapOutput f src #-}--{-# RULES "map-to-mapInput pipeL" forall f sink. pipeL (map f) sink = mapInput f (Prelude.const Prelude.Nothing) sink #-}-{-# RULES "map-to-mapInput =$" forall f sink. map f =$ sink = mapInput f (Prelude.const Prelude.Nothing) sink #-}-{-# RULES "map-to-mapInput pipe" forall f sink. pipe (map f) sink = mapInput f (Prelude.const Prelude.Nothing) sink #-}-{-# RULES "map-to-mapInput >+>" forall f sink. map f >+> sink = mapInput f (Prelude.const Prelude.Nothing) sink #-}--{-# RULES "map-to-mapOutput =$=" forall f con. con =$= map f = mapOutput f con #-}-{-# RULES "map-to-mapInput =$=" forall f con. map f =$= con = mapInput f (Prelude.const Prelude.Nothing) con #-}--{-# INLINE [1] map #-}---}---- | Apply a monadic transformation to all values in a stream.------ If you do not need the transformed values, and instead just want the monadic--- side-effects of running the action, see 'mapM_'.------ Since 0.3.0-mapM :: Monad m => (a -> m b) -> Conduit a m b-mapM f = awaitForever $ yield <=< lift . f---- | Apply a monadic action on all values in a stream.------ This @Conduit@ can be used to perform a monadic side-effect for every--- value, whilst passing the value through the @Conduit@ as-is.------ > iterM f = mapM (\a -> f a >>= \() -> return a)------ Since 0.5.6-iterM :: Monad m => (a -> m ()) -> Conduit a m a-iterM f = awaitForever $ \a -> lift (f a) >> yield a---- | Apply a transformation that may fail to all values in a stream, discarding--- the failures.------ Since 0.5.1-mapMaybe :: Monad m => (a -> Maybe b) -> Conduit a m b-mapMaybe f = awaitForever $ maybe (return ()) yield . f---- | Apply a monadic transformation that may fail to all values in a stream,--- discarding the failures.------ Since 0.5.1-mapMaybeM :: Monad m => (a -> m (Maybe b)) -> Conduit a m b-mapMaybeM f = awaitForever $ maybe (return ()) yield <=< lift . f---- | Filter the @Just@ values from a stream, discarding the @Nothing@ values.------ Since 0.5.1-catMaybes :: Monad m => Conduit (Maybe a) m a-catMaybes = awaitForever $ maybe (return ()) yield---- | Generalization of 'catMaybes'. It puts all values from--- 'F.Foldable' into stream.------ Since 1.0.6-concat :: (Monad m, F.Foldable f) => Conduit (f a) m a-concat = awaitForever $ F.mapM_ yield---- | Apply a transformation to all values in a stream, concatenating the output--- values.------ Since 0.3.0-concatMap :: Monad m => (a -> [b]) -> Conduit a m b-concatMap f = awaitForever $ sourceList . f---- | Apply a monadic transformation to all values in a stream, concatenating--- the output values.------ Since 0.3.0-concatMapM :: Monad m => (a -> m [b]) -> Conduit a m b-concatMapM f = awaitForever $ sourceList <=< lift . f---- | 'concatMap' with an accumulator.------ Since 0.3.0-concatMapAccum :: Monad m => (a -> accum -> (accum, [b])) -> accum -> Conduit a m b-concatMapAccum f x0 = void (mapAccum f x0) =$= concat---- | Deprecated synonym for @mapAccum@------ Since 1.0.6-scanl :: Monad m => (a -> s -> (s, b)) -> s -> Conduit a m b-scanl f s = void $ mapAccum f s-{-# DEPRECATED scanl "Use mapAccum instead" #-}---- | Deprecated synonym for @mapAccumM@------ Since 1.0.6-scanlM :: Monad m => (a -> s -> m (s, b)) -> s -> Conduit a m b-scanlM f s = void $ mapAccumM f s-{-# DEPRECATED scanlM "Use mapAccumM instead" #-}---- | Analog of @mapAccumL@ for lists.------ Since 1.1.1-mapAccum :: Monad m => (a -> s -> (s, b)) -> s -> ConduitM a b m s-mapAccum f =- loop- where- loop s = await >>= maybe (return s) go- where- go a = case f a s of- (s', b) -> yield b >> loop s'---- | Monadic `mapAccum`.------ Since 1.1.1-mapAccumM :: Monad m => (a -> s -> m (s, b)) -> s -> ConduitM a b m s-mapAccumM f =- loop- where- loop s = await >>= maybe (return s) go- where- go a = do (s', b) <- lift $ f a s- yield b- loop s'---- | Analog of 'Prelude.scanl' for lists.------ Since 1.1.1-scan :: Monad m => (a -> b -> b) -> b -> ConduitM a b m b-scan f =- mapAccum $ \a b -> let b' = f a b in (b', b')---- | Monadic @scanl@.------ Since 1.1.1-scanM :: Monad m => (a -> b -> m b) -> b -> ConduitM a b m b-scanM f =- mapAccumM $ \a b -> do b' <- f a b- return (b', b')---- | 'concatMapM' with an accumulator.------ Since 0.3.0-concatMapAccumM :: Monad m => (a -> accum -> m (accum, [b])) -> accum -> Conduit a m b-concatMapAccumM f x0 = void (mapAccumM f x0) =$= concat----- | Generalization of 'mapMaybe' and 'concatMap'. It applies function--- to all values in a stream and send values inside resulting--- 'Foldable' downstream.------ Since 1.0.6-mapFoldable :: (Monad m, F.Foldable f) => (a -> f b) -> Conduit a m b-mapFoldable f = awaitForever $ F.mapM_ yield . f---- | Monadic variant of 'mapFoldable'.------ Since 1.0.6-mapFoldableM :: (Monad m, F.Foldable f) => (a -> m (f b)) -> Conduit a m b-mapFoldableM f = awaitForever $ F.mapM_ yield <=< lift . f----- | Consume all values from the stream and return as a list. Note that this--- will pull all values into memory. For a lazy variant, see--- "Data.Conduit.Lazy".------ Since 0.3.0-consume :: Monad m => Consumer a m [a]-consume =- loop id- where- loop front = await >>= maybe (return $ front []) (\x -> loop $ front . (x:))---- | Grouping input according to an equality function.------ Since 0.3.0-groupBy :: Monad m => (a -> a -> Bool) -> Conduit a m [a]-groupBy f =- start- where- start = await >>= maybe (return ()) (loop id)-- loop rest x =- await >>= maybe (yield (x : rest [])) go- where- go y- | f x y = loop (rest . (y:)) x- | otherwise = yield (x : rest []) >> loop id y----- | 'groupOn1' is similar to @groupBy id@------ returns a pair, indicating there are always 1 or more items in the grouping.--- This is designed to be converted into a NonEmpty structure--- but it avoids a dependency on another package------ > import Data.List.NonEmpty--- >--- > groupOn1 :: (Monad m, Eq b) => (a -> b) -> Conduit a m (NonEmpty a)--- > groupOn1 f = CL.groupOn1 f =$= CL.map (uncurry (:|))------ Since 1.1.7-groupOn1 :: (Monad m, Eq b)- => (a -> b)- -> Conduit a m (a, [a])-groupOn1 f =- start- where- start = await >>= maybe (return ()) (loop id)-- loop rest x =- await >>= maybe (yield (x, rest [])) go- where- go y- | f x == f y = loop (rest . (y:)) x- | otherwise = yield (x, rest []) >> loop id y----- | Ensure that the inner sink consumes no more than the given number of--- values. Note this this does /not/ ensure that the sink consumes all of those--- values. To get the latter behavior, combine with 'sinkNull', e.g.:------ > src $$ do--- > x <- isolate count =$ do--- > x <- someSink--- > sinkNull--- > return x--- > someOtherSink--- > ...------ Since 0.3.0-isolate :: Monad m => Int -> Conduit a m a-isolate =- loop- where- loop 0 = return ()- loop count = await >>= maybe (return ()) (\x -> yield x >> loop (count - 1))---- | Keep only values in the stream passing a given predicate.------ Since 0.3.0-filter :: Monad m => (a -> Bool) -> Conduit a m a-filter f = awaitForever $ \i -> when (f i) (yield i)--filterFuseRight :: Monad m => Source m a -> (a -> Bool) -> Source m a-filterFuseRight (CI.ConduitM src) f =- CI.ConduitM (go src)- where- go (CI.Done ()) = CI.Done ()- go (CI.PipeM mp) = CI.PipeM (liftM go mp)- go (CI.Leftover p i) = CI.Leftover (go p) i- go (CI.HaveOutput p c o)- | f o = CI.HaveOutput (go p) c o- | otherwise = go p- go (CI.NeedInput p c) = CI.NeedInput (go . p) (go . c)--- Intermediate finalizers are dropped, but this is acceptable: the next--- yielded value would be demanded by downstream in any event, and that new--- finalizer will always override the existing finalizer.-{-# RULES "source/filter fusion $=" forall f src. src $= filter f = filterFuseRight src f #-}-{-# RULES "source/filter fusion =$=" forall f src. src =$= filter f = filterFuseRight src f #-}-{-# INLINE filterFuseRight #-}---- | Ignore the remainder of values in the source. Particularly useful when--- combined with 'isolate'.------ Since 0.3.0-sinkNull :: Monad m => Consumer a m ()-sinkNull = awaitForever $ \_ -> return ()-{-# RULES "connect to sinkNull" forall src. src $$ sinkNull = srcSinkNull src #-}--srcSinkNull :: Monad m => Source m a -> m ()-srcSinkNull (CI.ConduitM src) =- go src- where- go (CI.Done ()) = return ()- go (CI.PipeM mp) = mp >>= go- go (CI.Leftover p ()) = go p- go (CI.HaveOutput p _ _) = go p- go (CI.NeedInput _ c) = go (c ())-{-# INLINE srcSinkNull #-}---- | A source that outputs no values. Note that this is just a type-restricted--- synonym for 'mempty'.------ Since 0.3.0-sourceNull :: Monad m => Producer m a-sourceNull = return ()---- | Run a @Pipe@ repeatedly, and output its result value downstream. Stops--- when no more input is available from upstream.------ Since 0.5.0-sequence :: Monad m- => Consumer i m o -- ^ @Pipe@ to run repeatedly- -> Conduit i m o-sequence sink =- self- where- self = awaitForever $ \i -> leftover i >> sink >>= yield
+ README.md view
@@ -0,0 +1,9 @@+## conduit++`conduit` is a solution to the streaming data problem, allowing for production,+transformation, and consumption of streams of data in constant memory. It is an+alternative to lazy I\/O which guarantees deterministic resource handling.++For more information about conduit in general, and how this package in+particular fits into the ecosystem, see [the conduit+homepage](https://github.com/snoyberg/conduit#readme).
+ benchmarks/optimize-201408.hs view
@@ -0,0 +1,412 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE RankNTypes #-}+-- Collection of three benchmarks: a simple integral sum, monte carlo analysis,+-- and sliding vector.+import Control.DeepSeq+import Control.Monad (foldM)+import Control.Monad (when, liftM)+import Control.Monad.IO.Class (liftIO)+import Gauge.Main+import Data.Conduit+import qualified Data.Conduit.Internal as CI+import qualified Data.Conduit.List as CL+import qualified Data.Foldable as F+import Data.IORef+import Data.List (foldl')+import Data.Monoid (mempty)+import qualified Data.Sequence as Seq+import qualified Data.Vector as VB+import qualified Data.Vector.Generic as V+import qualified Data.Vector.Generic.Mutable as VM+import qualified Data.Vector.Unboxed as VU+import System.Environment (withArgs)+import qualified System.Random.MWC as MWC+import Test.Hspec++data TestBench = TBGroup String [TestBench]+ | TBBench Benchmark+ | forall a b. (Eq b, Show b) => TBPure String a b (a -> b)+ | forall a. (Eq a, Show a) => TBIO String a (IO a)+ | forall a. (Eq a, Show a) => TBIOTest String (a -> IO ()) (IO a)+ | forall a. (Eq a, Show a) => TBIOBench String a (IO a) (IO ())++toSpec :: TestBench -> Spec+toSpec (TBGroup name tbs) = describe name $ mapM_ toSpec tbs+toSpec (TBBench _) = return ()+toSpec (TBPure name a b f) = it name $ f a `shouldBe` b+toSpec (TBIO name a f) = it name $ f >>= (`shouldBe` a)+toSpec (TBIOTest name spec f) = it name $ f >>= spec+toSpec (TBIOBench name a f _) = it name $ f >>= (`shouldBe` a)++toBench :: TestBench -> Benchmark+toBench (TBGroup name tbs) = bgroup name $ map toBench tbs+toBench (TBBench b) = b+toBench (TBPure name a _ f) = bench name $ whnf f a+toBench (TBIO name _ f) = bench name $ whnfIO f+toBench (TBIOTest name _ f) = bench name $ whnfIO f+toBench (TBIOBench name _ _ f) = bench name $ whnfIO f++runTestBench :: [TestBench] -> IO ()+runTestBench tbs = do+ withArgs [] $ hspec $ mapM_ toSpec tbs+ defaultMain $ map toBench tbs++main :: IO ()+main = runTestBench =<< sequence+ [ sumTB+ , mapSumTB+ , monteCarloTB+ , fmap (TBGroup "sliding window") $ sequence+ [ slidingWindow 10+ , slidingWindow 30+ , slidingWindow 100+ , slidingWindow 1000+ ]+ ]++-----------------------------------------------------------------------++sumTB :: IO TestBench+sumTB = do+ upperRef <- newIORef upper0+ return $ TBGroup "sum"+ [ TBPure "Data.List.foldl'" upper0 expected+ $ \upper -> foldl' (+) 0 [1..upper]+ , TBIO "Control.Monad.foldM" expected $ do+ upper <- readIORef upperRef+ foldM plusM 0 [1..upper]+ , TBPure "low level" upper0 expected $ \upper ->+ let go x !t+ | x > upper = t+ | otherwise = go (x + 1) (t + x)+ in go 1 0+ , TBIO "boxed vectors, I/O" expected $ do+ upper <- readIORef upperRef+ VB.foldM' plusM 0 $ VB.enumFromTo 1 upper+ , TBPure "boxed vectors" upper0 expected+ $ \upper -> VB.foldl' (+) 0 (VB.enumFromTo 1 upper)+ , TBPure "unboxed vectors" upper0 expected+ $ \upper -> VU.foldl' (+) 0 (VU.enumFromTo 1 upper)+ , TBPure "conduit, pure, fold" upper0 expected+ $ \upper -> runConduitPure $ CL.enumFromTo 1 upper .| CL.fold (+) 0+ , TBPure "conduit, pure, foldM" upper0 expected+ $ \upper -> runConduitPure $ CL.enumFromTo 1 upper .| CL.foldM plusM 0+ , TBIO "conduit, IO, fold" expected $ do+ upper <- readIORef upperRef+ runConduit $ CL.enumFromTo 1 upper .| CL.fold (+) 0+ , TBIO "conduit, IO, foldM" expected $ do+ upper <- readIORef upperRef+ runConduit $ CL.enumFromTo 1 upper .| CL.foldM plusM 0+ ]+ where+ upper0 = 10000 :: Int+ expected = sum [1..upper0]++ plusM x y = return $! x + y++-----------------------------------------------------------------------++mapSumTB :: IO TestBench+mapSumTB = return $ TBGroup "map + sum"+ [ TBPure "boxed vectors" upper0 expected+ $ \upper -> VB.foldl' (+) 0+ $ VB.map (+ 1)+ $ VB.map (* 2)+ $ VB.enumFromTo 1 upper+ , TBPure "unboxed vectors" upper0 expected+ $ \upper -> VU.foldl' (+) 0+ $ VU.map (+ 1)+ $ VU.map (* 2)+ $ VU.enumFromTo 1 upper+ , TBPure "conduit, connect1" upper0 expected $ \upper -> runConduitPure+ $ CL.enumFromTo 1 upper+ .| CL.map (* 2)+ .| CL.map (+ 1)+ .| CL.fold (+) 0+ ]+ where+ upper0 = 10000 :: Int+ expected = sum $ map (+ 1) $ map (* 2) [1..upper0]++-----------------------------------------------------------------------++monteCarloTB :: IO TestBench+monteCarloTB = return $ TBGroup "monte carlo"+ [ TBIOTest "conduit" closeEnough $ do+ gen <- MWC.createSystemRandom+ successes <- runConduit+ $ CL.replicateM count (MWC.uniform gen)+ .| CL.fold (\t (x, y) ->+ if (x*x + y*(y :: Double) < 1)+ then t + 1+ else t)+ (0 :: Int)+ return $ fromIntegral successes / fromIntegral count * 4+ , TBIOTest "low level" closeEnough $ do+ gen <- MWC.createSystemRandom+ let go :: Int -> Int -> IO Double+ go 0 !t = return $! fromIntegral t / fromIntegral count * 4+ go i !t = do+ (x, y) <- MWC.uniform gen+ let t'+ | x*x + y*(y :: Double) < 1 = t + 1+ | otherwise = t+ go (i - 1) t'+ go count (0 :: Int)+ ]+ where+ count = 100000 :: Int++ closeEnough x+ | abs (x - 3.14159 :: Double) < 0.2 = return ()+ | otherwise = error $ "Monte carlo analysis too inaccurate: " ++ show x++-----------------------------------------------------------------------++slidingWindow :: Int -> IO TestBench+slidingWindow window = do+ upperRef <- newIORef upper0+ return $ TBGroup (show window)+ [ TBIOBench "low level, Seq" expected+ (swLowLevelSeq window upperRef id (\x y -> x . (F.toList y:)) ($ []))+ (swLowLevelSeq window upperRef () (\() y -> rnf y) id)+ , TBIOBench "conduit, Seq" expected+ (swConduitSeq window upperRef id (\x y -> x . (F.toList y:)) ($ []))+ (swConduitSeq window upperRef () (\() y -> rnf y) id)+ {- https://ghc.haskell.org/trac/ghc/ticket/9446+ , TBIOBench "low level, boxed Vector" expected+ (swLowLevelVector window upperRef id (\x y -> x . (VB.toList y:)) ($ []))+ (swLowLevelVector window upperRef () (\() y -> rnf (y :: VB.Vector Int)) id)+ -}+ , TBBench $ bench "low level, boxed Vector" $ whnfIO $+ swLowLevelVector window upperRef () (\() y -> rnf (y :: VB.Vector Int)) id++ {- https://ghc.haskell.org/trac/ghc/ticket/9446+ , TBIOBench "conduit, boxed Vector" expected+ (swConduitVector window upperRef id (\x y -> x . (VB.toList y:)) ($ []))+ (swConduitVector window upperRef () (\() y -> rnf (y :: VB.Vector Int)) id)+ -}++ , TBBench $ bench "conduit, boxed Vector" $ whnfIO $+ swConduitVector window upperRef () (\() y -> rnf (y :: VB.Vector Int)) id+++ , TBIOBench "low level, unboxed Vector" expected+ (swLowLevelVector window upperRef id (\x y -> x . (VU.toList y:)) ($ []))+ (swLowLevelVector window upperRef () (\() y -> rnf (y :: VU.Vector Int)) id)+ , TBIOBench "conduit, unboxed Vector" expected+ (swConduitVector window upperRef id (\x y -> x . (VU.toList y:)) ($ []))+ (swConduitVector window upperRef () (\() y -> rnf (y :: VU.Vector Int)) id)+ ]+ where+ upper0 = 10000+ expected =+ loop [1..upper0]+ where+ loop input+ | length x == window = x : loop y+ | otherwise = []+ where+ x = take window input+ y = drop 1 input++swLowLevelSeq :: Int -> IORef Int -> t -> (t -> Seq.Seq Int -> t) -> (t -> t') -> IO t'+swLowLevelSeq window upperRef t0 f final = do+ upper <- readIORef upperRef++ let phase1 i !s+ | i > window = phase2 i s t0+ | otherwise = phase1 (i + 1) (s Seq.|> i)++ phase2 i !s !t+ | i > upper = t'+ | otherwise = phase2 (i + 1) s' t'+ where+ t' = f t s+ s' = Seq.drop 1 s Seq.|> i++ return $! final $! phase1 1 mempty++swLowLevelVector :: V.Vector v Int+ => Int+ -> IORef Int+ -> t+ -> (t -> v Int -> t)+ -> (t -> t')+ -> IO t'+swLowLevelVector window upperRef t0 f final = do+ upper <- readIORef upperRef++ let go !i !t _ _ _ | i > upper = return $! final $! t+ go !i !t !end _mv mv2 | end == bufSz = newBuf >>= go i t sz mv2+ go !i !t !end mv mv2 = do+ VM.unsafeWrite mv end i+ when (end > sz) $ VM.unsafeWrite mv2 (end - sz) i+ let end' = end + 1+ t' <-+ if end' < sz+ then return t+ else do+ v <- V.unsafeFreeze $ VM.unsafeSlice (end' - sz) sz mv+ return $! f t v+ go (i + 1) t' end' mv mv2++ mv <- newBuf+ mv2 <- newBuf+ go 1 t0 0 mv mv2+ where+ sz = window+ bufSz = 2 * window+ newBuf = VM.new bufSz++swConduitSeq :: Int+ -> IORef Int+ -> t+ -> (t -> Seq.Seq Int -> t)+ -> (t -> t')+ -> IO t'+swConduitSeq window upperRef t0 f final = do+ upper <- readIORef upperRef++ t <- runConduit+ $ CL.enumFromTo 1 upper+ .| slidingWindowC window+ .| CL.fold f t0+ return $! final t++swConduitVector :: V.Vector v Int+ => Int+ -> IORef Int+ -> t+ -> (t -> v Int -> t)+ -> (t -> t')+ -> IO t'+swConduitVector window upperRef t0 f final = do+ upper <- readIORef upperRef++ t <- runConduit+ $ CL.enumFromTo 1 upper+ .| slidingVectorC window+ .| CL.fold f t0+ return $! final t++slidingWindowC :: Monad m => Int -> ConduitT a (Seq.Seq a) m ()+slidingWindowC = slidingWindowCC+{-# INLINE [0] slidingWindowC #-}+{-# RULES "unstream slidingWindowC"+ forall i. slidingWindowC i = CI.unstream (CI.streamConduit (slidingWindowCC i) (slidingWindowS i))+ #-}++slidingWindowCC :: Monad m => Int -> ConduitT a (Seq.Seq a) m ()+slidingWindowCC sz =+ go sz mempty+ where+ goContinue st = await >>=+ maybe (return ())+ (\x -> do+ let st' = st Seq.|> x+ yield st' >> goContinue (Seq.drop 1 st')+ )+ go 0 st = yield st >> goContinue (Seq.drop 1 st)+ go !n st = CL.head >>= \m ->+ case m of+ Nothing | n < sz -> yield st+ | otherwise -> return ()+ Just x -> go (n-1) (st Seq.|> x)+{-# INLINE slidingWindowCC #-}++slidingWindowS :: Monad m => Int -> CI.Stream m a () -> CI.Stream m (Seq.Seq a) ()+slidingWindowS sz (CI.Stream step ms0) =+ CI.Stream step' $ liftM (\s -> Left (s, sz, mempty)) ms0+ where+ step' (Left (s, 0, st)) = return $ CI.Emit (Right (s, st)) st+ step' (Left (s, i, st)) = do+ res <- step s+ return $ case res of+ CI.Stop () -> CI.Stop ()+ CI.Skip s' -> CI.Skip $ Left (s', i, st)+ CI.Emit s' a -> CI.Skip $ Left (s', i - 1, st Seq.|> a)+ step' (Right (s, st)) = do+ res <- step s+ return $ case res of+ CI.Stop () -> CI.Stop ()+ CI.Skip s' -> CI.Skip $ Right (s', st)+ CI.Emit s' a ->+ let st' = Seq.drop 1 st Seq.|> a+ in CI.Emit (Right (s', st')) st'+{-# INLINE slidingWindowS #-}++slidingVectorC :: V.Vector v a => Int -> ConduitT a (v a) IO ()+slidingVectorC = slidingVectorCC+{-# INLINE [0] slidingVectorC #-}+{-# RULES "unstream slidingVectorC"+ forall i. slidingVectorC i = CI.unstream (CI.streamConduit (slidingVectorCC i) (slidingVectorS i))+ #-}++slidingVectorCC :: V.Vector v a => Int -> ConduitT a (v a) IO ()+slidingVectorCC sz = do+ mv <- newBuf+ mv2 <- newBuf+ go 0 mv mv2+ where+ bufSz = 2 * sz+ newBuf = liftIO (VM.new bufSz)++ go !end _mv mv2 | end == bufSz = newBuf >>= go sz mv2+ go !end mv mv2 = do+ mx <- await+ case mx of+ Nothing -> when (end > 0 && end < sz) $ do+ v <- liftIO $ V.unsafeFreeze $ VM.take end mv+ yield v+ Just x -> do+ liftIO $ do+ VM.unsafeWrite mv end x+ when (end > sz) $ VM.unsafeWrite mv2 (end - sz) x+ let end' = end + 1+ when (end' >= sz) $ do+ v <- liftIO $ V.unsafeFreeze $ VM.unsafeSlice (end' - sz) sz mv+ yield v+ go end' mv mv2++slidingVectorS :: V.Vector v a => Int -> CI.Stream IO a () -> CI.Stream IO (v a) ()+slidingVectorS sz (CI.Stream step ms0) =+ CI.Stream step' ms1+ where+ bufSz = 2 * sz+ newBuf = liftIO (VM.new bufSz)++ ms1 = do+ s <- ms0+ mv <- newBuf+ mv2 <- newBuf+ return (s, 0, mv, mv2)++ step' (_, -1, _, _) = return $ CI.Stop ()+ step' (s, end, _mv, mv2) | end == bufSz = do+ mv3 <- newBuf+ return $ CI.Skip (s, sz, mv2, mv3)+ step' (s, end, mv, mv2) = do+ res <- step s+ case res of+ CI.Stop ()+ | end > 0 && end < sz -> do+ v <- liftIO $ V.unsafeFreeze $ VM.take end mv+ return $ CI.Emit (s, -1, mv, mv2) v+ | otherwise -> return $ CI.Stop ()+ CI.Skip s' -> return $ CI.Skip (s', end, mv, mv2)+ CI.Emit s' x -> liftIO $ do+ VM.unsafeWrite mv end x+ when (end > sz) $ VM.unsafeWrite mv2 (end - sz) x+ let end' = end + 1+ state = (s', end', mv, mv2)+ if end' >= sz+ then do+ v <- V.unsafeFreeze $ VM.unsafeSlice (end' - sz) sz mv+ return $ CI.Emit state v+ else return $ CI.Skip state+{-# INLINE slidingVectorS #-}
+ benchmarks/unfused.hs view
@@ -0,0 +1,77 @@+{-# LANGUAGE RankNTypes, BangPatterns #-}+-- Compare low-level, fused, unfused, and partially fused+import Data.Conduit+import qualified Data.Conduit.List as CL+import Gauge.Main++-- | unfused+enumFromToC :: (Eq a, Monad m, Enum a) => a -> a -> ConduitT i a m ()+enumFromToC x0 y =+ loop x0+ where+ loop x+ | x == y = yield x+ | otherwise = yield x >> loop (succ x)+{-# INLINE enumFromToC #-}++-- | unfused+mapC :: Monad m => (a -> b) -> ConduitT a b m ()+mapC f = awaitForever $ yield . f+{-# INLINE mapC #-}++-- | unfused+foldC :: Monad m => (b -> a -> b) -> b -> ConduitT a o m b+foldC f =+ loop+ where+ loop !b = await >>= maybe (return b) (loop . f b)+{-# INLINE foldC #-}++main :: IO ()+main = defaultMain+ [ bench "low level" $ flip whnf upper0 $ \upper ->+ let loop x t+ | x > upper = t+ | otherwise = loop (x + 1) (t + ((x * 2) + 1))+ in loop 1 0+ , bench "completely fused" $ flip whnf upper0 $ \upper ->+ runConduitPure+ $ CL.enumFromTo 1 upper+ .| CL.map (* 2)+ .| CL.map (+ 1)+ .| CL.fold (+) 0+ , bench "runConduit, completely fused" $ flip whnf upper0 $ \upper ->+ runConduitPure+ $ CL.enumFromTo 1 upper+ .| CL.map (* 2)+ .| CL.map (+ 1)+ .| CL.fold (+) 0+ , bench "completely unfused" $ flip whnf upper0 $ \upper ->+ runConduitPure+ $ enumFromToC 1 upper+ .| mapC (* 2)+ .| mapC (+ 1)+ .| foldC (+) 0+ , bench "beginning fusion" $ flip whnf upper0 $ \upper ->+ runConduitPure+ $ (CL.enumFromTo 1 upper .| CL.map (* 2))+ .| mapC (+ 1)+ .| foldC (+) 0+ , bench "middle fusion" $ flip whnf upper0 $ \upper ->+ runConduitPure+ $ enumFromToC 1 upper+ .| (CL.map (* 2) .| CL.map (+ 1))+ .| foldC (+) 0+ , bench "ending fusion" $ flip whnf upper0 $ \upper ->+ runConduitPure+ $ enumFromToC 1 upper+ .| mapC (* 2)+ .| (CL.map (+ 1) .| CL.fold (+) 0)+ , bench "performance of CL.enumFromTo without fusion" $ flip whnf upper0 $ \upper ->+ runConduitPure+ $ CL.enumFromTo 1 upper+ .| mapC (* 2)+ .| (CL.map (+ 1) .| CL.fold (+) 0)+ ]+ where+ upper0 = 100000 :: Int
− benchmarks/utf8-memory-usage.hs
@@ -1,12 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-import Control.Monad (replicateM_)-import Data.ByteString (ByteString)-import Data.Conduit-import qualified Data.Conduit.List as CL-import Data.Conduit.Text (decode, utf8)--src :: Source IO ByteString-src = replicateM_ 1000000 $ yield "Hello World!\n"--main :: IO ()-main = src $$ decode utf8 =$ CL.sinkNull
− changelog.md
@@ -1,15 +0,0 @@-__1.1__ Refactoring into conduit and conduit-extra packages. Core functionality is now in conduit, whereas most common helper modules (including Text, Binary, Zlib, etc) are in conduit-extra. To upgrade to this version, there should only be import list and conduit file changes necessary.--__1.0__ Simplified the user-facing interface back to the Source, Sink, and Conduit types, with Producer and Consumer for generic code. Error messages have been simplified, and optional leftovers and upstream terminators have been removed from the external API. Some long-deprecated functions were finally removed.--__0.5__ The internals of the package are now separated to the .Internal module, leaving only the higher-level interface in the advertised API. Internally, switched to a `Leftover` constructor and slightly tweaked the finalization semantics.--__0.4__ Inspired by the design of the pipes package: we now have a single unified type underlying `Source`, `Sink`, and `Conduit`. This type is named `Pipe`. There are type synonyms provided for the other three types. Additionally, `BufferedSource` is no longer provided. Instead, the connect-and-resume operator, `$$+`, can be used for the same purpose.--__0.3__ ResourceT has been greatly simplified, specialized for IO, and moved into a separate package. Instead of hard-coding ResourceT into the conduit datatypes, they can now live around any monad. The Conduit datatype has been enhanced to better allow generation of streaming output. The SourceResult, SinkResult, and ConduitResult datatypes have been removed entirely.--__0.2__ Instead of storing state in mutable variables, we now use CPS. A `Source` returns the next `Source`, and likewise for `Sink`s and `Conduit`s. Not only does this take better advantage of GHC\'s optimizations (about a 20% speedup), but it allows some operations to have a reduction in algorithmic complexity from exponential to linear. This also allowed us to remove the `Prepared` set of types. Also, the `State` functions (e.g., `sinkState`) use better constructors for return types, avoiding the need for a dummy state on completion.--__0.1__ `BufferedSource` is now an abstract type, and has a much more efficient internal representation. The result was a 41% speedup on microbenchmarks (note: do not expect speedups anywhere near that in real usage). In general, we are moving towards `BufferedSource` being a specific tool used internally as needed, but using `Source` for all external APIs.--__0.0__ Initial release.
conduit.cabal view
@@ -1,55 +1,106 @@ Name: conduit-Version: 1.1.7+Version: 1.3.6.1 Synopsis: Streaming data processing library.-Description:- @conduit@ is a solution to the streaming data problem, allowing for production, transformation, and consumption of streams of data in constant memory. It is an alternative to lazy I\/O which guarantees deterministic resource handling, and fits in the same general solution space as @enumerator@\/@iteratee@ and @pipes@. For a tutorial, please visit <https://haskell.fpcomplete.com/user/snoyberg/library-documentation/conduit-overview>.+description:+ `conduit` is a solution to the streaming data problem, allowing for production,+ transformation, and consumption of streams of data in constant memory. It is an+ alternative to lazy I\/O which guarantees deterministic resource handling.+ .+ For more information about conduit in general, and how this package in+ particular fits into the ecosystem, see [the conduit+ homepage](https://github.com/snoyberg/conduit#readme).+ .+ Hackage documentation generation is not reliable. For up to date documentation, please see: <http://www.stackage.org/package/conduit>. License: MIT License-file: LICENSE Author: Michael Snoyman Maintainer: michael@snoyman.com Category: Data, Conduit Build-type: Simple-Cabal-version: >=1.8+Cabal-version: >=1.10 Homepage: http://github.com/snoyberg/conduit extra-source-files: test/main.hs- , changelog.md+ , test/doctests.hs+ , test/subdir/dummyfile.txt+ , README.md+ , ChangeLog.md+ , fusion-macros.h Library+ default-language: Haskell2010+ hs-source-dirs: src Exposed-modules: Data.Conduit+ Data.Conduit.Combinators Data.Conduit.List Data.Conduit.Internal Data.Conduit.Lift- Build-depends: base >= 4.3 && < 5- , resourcet >= 1.1 && < 1.2- , exceptions- , lifted-base >= 0.1- , transformers-base >= 0.4.1 && < 0.5- , monad-control >= 0.3.1 && < 0.4- , containers- , transformers >= 0.2.2 && < 0.5+ Data.Conduit.Internal.Fusion+ Data.Conduit.Internal.List.Stream+ Data.Conduit.Combinators.Stream+ Conduit+ other-modules: Data.Conduit.Internal.Pipe+ Data.Conduit.Internal.Conduit+ Data.Conduit.Combinators.Unqualified+ Data.Streaming.FileRead+ Data.Streaming.Filesystem+ Build-depends: base >= 4.12 && < 5+ , resourcet >= 1.2 && < 1.4+ , transformers >= 0.4 , mtl- , void >= 0.5.5- , mmorph- ghc-options: -Wall+ , primitive+ , unliftio-core+ , exceptions+ , mono-traversable >= 1.0.7+ , vector+ , bytestring+ , text+ , filepath+ , directory -test-suite test+ if os(windows)+ build-depends: Win32+ other-modules: System.Win32File+ cpp-options: -DWINDOWS+ else+ build-depends: unix++ ghc-options: -Wall+ include-dirs: .++test-suite conduit-test+ default-language: Haskell2010 hs-source-dirs: test main-is: main.hs other-modules: Data.Conduit.Extra.ZipConduitSpec+ , Data.Conduit.StreamSpec+ , Spec+ , StreamSpec type: exitcode-stdio-1.0 cpp-options: -DTEST build-depends: conduit , base , hspec >= 1.3- , QuickCheck+ , QuickCheck >= 2.7 , transformers , mtl , resourcet- , void , containers , exceptions >= 0.6+ , safe+ , split >= 0.2.0.0+ , mono-traversable+ , text+ , vector+ , directory+ , bytestring+ , silently+ , filepath+ , unliftio >= 0.2.4.0 ghc-options: -Wall + if os(windows)+ cpp-options: -DWINDOWS+ --test-suite doctests -- hs-source-dirs: test -- main-is: doctests.hs@@ -57,16 +108,43 @@ -- ghc-options: -threaded -- build-depends: base, directory, doctest >= 0.8 -benchmark utf8-memory-usage+-- benchmark utf8-memory-usage+-- type: exitcode-stdio-1.0+-- hs-source-dirs: benchmarks+-- build-depends: base+-- , text-stream-decode+-- , bytestring+-- , text+-- , conduit+-- main-is: utf8-memory-usage.hs+-- ghc-options: -Wall -O2 -with-rtsopts=-s++benchmark optimize-201408+ default-language: Haskell2010 type: exitcode-stdio-1.0 hs-source-dirs: benchmarks build-depends: base- , text-stream-decode- , bytestring- , text , conduit- main-is: utf8-memory-usage.hs- ghc-options: -Wall -O2 -with-rtsopts=-s+ , vector+ , deepseq+ , containers+ , transformers+ , hspec+ , mwc-random+ , gauge+ main-is: optimize-201408.hs+ ghc-options: -Wall -O2 -rtsopts++benchmark unfused+ default-language: Haskell2010+ type: exitcode-stdio-1.0+ hs-source-dirs: benchmarks+ build-depends: base+ , conduit+ , gauge+ , transformers+ main-is: unfused.hs+ ghc-options: -Wall -O2 -rtsopts source-repository head type: git
+ fusion-macros.h view
@@ -0,0 +1,23 @@+#define INLINE_RULE0(new,old) ;\+ new = old ;\+ {-# INLINE [0] new #-} ;\+ {-# RULES "inline new" new = old #-}++#define INLINE_RULE(new,vars,body) ;\+ new vars = body ;\+ {-# INLINE [0] new #-} ;\+ {-# RULES "inline new" forall vars. new vars = body #-}++#define STREAMING0(name, nameC, nameS) ;\+ name = nameC ;\+ {-# INLINE [0] name #-} ;\+ {-# RULES "unstream name" \+ name = unstream (streamConduit nameC nameS) \+ #-}++#define STREAMING(name, nameC, nameS, vars) ;\+ name = nameC ;\+ {-# INLINE [0] name #-} ;\+ {-# RULES "unstream name" forall vars. \+ name vars = unstream (streamConduit (nameC vars) (nameS vars)) \+ #-}
+ src/Conduit.hs view
@@ -0,0 +1,43 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE FlexibleContexts #-}+-- | Your intended one-stop-shop for conduit functionality.+-- This re-exports functions from many commonly used modules.+-- When there is a conflict with standard functions, functions+-- in this module are disambiguated by adding a trailing C+-- (or for chunked functions, replacing a trailing E with CE).+-- This means that the Conduit module can be imported unqualified+-- without causing naming conflicts.+--+-- For more information on the naming scheme and intended usages of the+-- combinators, please see the "Data.Conduit.Combinators" documentation.+module Conduit+ ( -- * Core conduit library+ module Data.Conduit+ , module Data.Conduit.Lift+ -- * Commonly used combinators+ , module Data.Conduit.Combinators.Unqualified+ -- * Monadic lifting+ , MonadIO (..)+ , MonadTrans (..)+ , MonadThrow (..)+ , MonadUnliftIO (..)+ , PrimMonad (..)+ -- * ResourceT+ , MonadResource+ , ResourceT+ , runResourceT+ -- * Acquire+ , module Data.Acquire+ -- * Pure pipelines+ , Identity (..)+ ) where++import Data.Conduit+import Control.Monad.IO.Unlift (MonadIO (..), MonadUnliftIO (..))+import Control.Monad.Trans.Class (MonadTrans (..))+import Control.Monad.Primitive (PrimMonad (..), PrimState)+import Data.Conduit.Lift+import Data.Conduit.Combinators.Unqualified+import Data.Functor.Identity (Identity (..))+import Control.Monad.Trans.Resource (MonadResource, MonadThrow (..), runResourceT, ResourceT)+import Data.Acquire hiding (with)
+ src/Data/Conduit.hs view
@@ -0,0 +1,107 @@+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE FlexibleContexts #-}+-- | If this is your first time with conduit, you should probably start with+-- the tutorial:+-- <https://github.com/snoyberg/conduit#readme>.+module Data.Conduit+ ( -- * Core interface+ -- ** Types+ ConduitT+ -- *** Deprecated+ , Source+ , Conduit+ , Sink+ , ConduitM+ -- ** Connect/fuse operators+ , (.|)+ , connect+ , fuse+ -- *** Deprecated+ , ($$)+ , ($=)+ , (=$)+ , (=$=)++ -- *** Fuse with upstream results+ , fuseBoth+ , fuseBothMaybe+ , fuseUpstream++ -- ** Primitives+ , await+ , yield+ , yieldM+ , leftover+ , runConduit+ , runConduitPure+ , runConduitRes++ -- ** Finalization+ , bracketP++ -- ** Exception handling+ , catchC+ , handleC+ , tryC++ -- * Generalized conduit types+ , Producer+ , Consumer+ , toProducer+ , toConsumer++ -- * Utility functions+ , awaitForever+ , transPipe+ , mapOutput+ , mapOutputMaybe+ , mapInput+ , mapInputM+ , mergeSource+ , passthroughSink+ , sourceToList++ -- * Connect-and-resume+ , SealedConduitT+ , sealConduitT+ , unsealConduitT+ , ($$+)+ , ($$++)+ , ($$+-)+ , ($=+)++ -- ** For @Conduit@s+ , (=$$+)+ , (=$$++)+ , (=$$+-)++ -- * Fusion with leftovers+ , fuseLeftovers+ , fuseReturnLeftovers++ -- * Flushing+ , Flush (..)++ -- * Newtype wrappers+ -- ** ZipSource+ , ZipSource (..)+ , sequenceSources++ -- ** ZipSink+ , ZipSink (..)+ , sequenceSinks++ -- ** ZipConduit+ , ZipConduit (..)+ , sequenceConduits++ -- * Convenience reexports+ , Void -- FIXME consider instead relaxing type of runConduit+ ) where++import Data.Conduit.Internal.Conduit+import Data.Void (Void)+import Data.Functor.Identity (Identity, runIdentity)+import Control.Monad.Trans.Resource (ResourceT, runResourceT)+import Control.Monad.IO.Unlift (MonadUnliftIO)
+ src/Data/Conduit/Combinators.hs view
@@ -0,0 +1,2556 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE NoMonomorphismRestriction #-}+{-# LANGUAGE BangPatterns #-}+-- | This module is meant as a replacement for Data.Conduit.List.+-- That module follows a naming scheme which was originally inspired+-- by its enumerator roots. This module is meant to introduce a naming+-- scheme which encourages conduit best practices.+--+-- There are two versions of functions in this module. Those with a trailing+-- E work in the individual elements of a chunk of data, e.g., the bytes of+-- a ByteString, the Chars of a Text, or the Ints of a Vector Int. Those+-- without a trailing E work on unchunked streams.+--+-- FIXME: discuss overall naming, usage of mono-traversable, etc+--+-- Mention take (Conduit) vs drop (Consumer)+module Data.Conduit.Combinators+ ( -- * Producers+ -- ** Pure+ yieldMany+ , unfold+ , enumFromTo+ , iterate+ , repeat+ , replicate+ , sourceLazy++ -- ** Monadic+ , repeatM+ , repeatWhileM+ , replicateM++ -- ** I\/O+ , sourceFile+ , sourceFileBS+ , sourceHandle+ , sourceHandleUnsafe+ , sourceIOHandle+ , stdin+ , withSourceFile++ -- ** Filesystem+ , sourceDirectory+ , sourceDirectoryDeep++ -- * Consumers+ -- ** Pure+ , drop+ , dropE+ , dropWhile+ , dropWhileE+ , fold+ , foldE+ , foldl+ , foldl1+ , foldlE+ , foldMap+ , foldMapE+ , foldWhile+ , all+ , allE+ , any+ , anyE+ , and+ , andE+ , or+ , orE+ , asum+ , elem+ , elemE+ , notElem+ , notElemE+ , sinkLazy+ , sinkList+ , sinkVector+ , sinkVectorN+ , sinkLazyBuilder+ , sinkNull+ , awaitNonNull+ , head+ , headDef+ , headE+ , peek+ , peekE+ , last+ , lastDef+ , lastE+ , length+ , lengthE+ , lengthIf+ , lengthIfE+ , maximum+ , maximumE+ , minimum+ , minimumE+ , null+ , nullE+ , sum+ , sumE+ , product+ , productE+ , find++ -- ** Monadic+ , mapM_+ , mapM_E+ , foldM+ , foldME+ , foldMapM+ , foldMapME++ -- ** I\/O+ , sinkFile+ , sinkFileCautious+ , sinkTempFile+ , sinkSystemTempFile+ , sinkFileBS+ , sinkHandle+ , sinkIOHandle+ , print+ , stdout+ , stderr+ , withSinkFile+ , withSinkFileBuilder+ , withSinkFileCautious+ , sinkHandleBuilder+ , sinkHandleFlush++ -- * Transformers+ -- ** Pure+ , map+ , mapE+ , omapE+ , concatMap+ , concatMapE+ , take+ , takeE+ , takeWhile+ , takeWhileE+ , takeExactly+ , takeExactlyE+ , concat+ , filter+ , filterE+ , mapWhile+ , conduitVector+ , scanl+ , mapAccumWhile+ , concatMapAccum+ , intersperse+ , slidingWindow+ , chunksOfE+ , chunksOfExactlyE++ -- ** Monadic+ , mapM+ , mapME+ , omapME+ , concatMapM+ , filterM+ , filterME+ , iterM+ , scanlM+ , mapAccumWhileM+ , concatMapAccumM++ -- ** Textual+ , encodeUtf8+ , decodeUtf8+ , decodeUtf8Lenient+ , line+ , lineAscii+ , unlines+ , unlinesAscii+ , takeExactlyUntilE+ , linesUnbounded+ , linesUnboundedAscii+ , splitOnUnboundedE++ -- ** Builders+ , builderToByteString+ , unsafeBuilderToByteString+ , builderToByteStringWith+ , builderToByteStringFlush+ , builderToByteStringWithFlush+ , BufferAllocStrategy+ , allNewBuffersStrategy+ , reuseBufferStrategy++ -- * Special+ , vectorBuilder+ , mapAccumS+ , peekForever+ , peekForeverE+ ) where++-- BEGIN IMPORTS++import Data.ByteString.Builder (Builder, toLazyByteString, hPutBuilder)+import qualified Data.ByteString.Builder.Internal as BB (flush)+import qualified Data.ByteString.Builder.Extra as BB (runBuilder, Next(Done, More, Chunk))+import qualified Data.NonNull as NonNull+import qualified Data.Traversable+import qualified Data.ByteString as S+import qualified Data.ByteString.Lazy as BL+import Data.ByteString.Lazy.Internal (defaultChunkSize)+import Control.Applicative (Alternative(..), (<$>))+import Control.Exception (catch, throwIO, finally, bracket, try, evaluate)+import Control.Category (Category (..))+import Control.Monad (unless, when, (>=>), liftM, forever)+import Control.Monad.IO.Unlift (MonadIO (..), MonadUnliftIO, withRunInIO)+import Control.Monad.Primitive (PrimMonad, PrimState, unsafePrimToPrim)+import Control.Monad.Trans.Class (lift)+import Control.Monad.Trans.Resource (MonadResource, MonadThrow, allocate, throwM)+import Data.Conduit+import Data.Conduit.Internal (ConduitT (..), Pipe (..))+import qualified Data.Conduit.List as CL+import Data.IORef+import Data.Maybe (fromMaybe, isNothing, isJust)+import Data.Monoid (Monoid (..))+import Data.MonoTraversable+import qualified Data.Sequences as Seq+import qualified Data.Vector.Generic as V+import qualified Data.Vector.Generic.Mutable as VM+import Data.Void (absurd)+import Prelude (Bool (..), Eq (..), Int,+ Maybe (..), Either (..), Monad (..), Num (..),+ Ord (..), fromIntegral, maybe, either,+ ($), Functor (..), Enum, seq, Show, Char,+ otherwise, Either (..), not,+ ($!), succ, FilePath, IO, String)+import Data.Word (Word8)+import qualified Prelude+import qualified System.IO as IO+import System.IO.Error (isDoesNotExistError)+import System.IO.Unsafe (unsafePerformIO)+import Data.ByteString (ByteString)+import Data.Text (Text)+import qualified Data.Text as T+import qualified Data.Text.Encoding as TE+import qualified Data.Text.Encoding.Error as TEE+import Data.Conduit.Combinators.Stream+import Data.Conduit.Internal.Fusion+import Data.Primitive.MutVar (MutVar, newMutVar, readMutVar,+ writeMutVar)+import qualified Data.Streaming.FileRead as FR+import qualified Data.Streaming.Filesystem as F+import GHC.ForeignPtr (mallocPlainForeignPtrBytes, unsafeForeignPtrToPtr)+import Foreign.ForeignPtr (touchForeignPtr, ForeignPtr)+import Foreign.Ptr (Ptr, plusPtr, minusPtr)+import Data.ByteString.Internal (ByteString (PS), mallocByteString)+import System.FilePath ((</>), (<.>), takeDirectory, takeFileName)+import System.Directory (renameFile, getTemporaryDirectory, removeFile)++import qualified Data.Sequences as DTE+import Data.Sequences (LazySequence (..))++-- Defines INLINE_RULE0, INLINE_RULE, STREAMING0, and STREAMING.+#include "fusion-macros.h"++-- END IMPORTS++-- TODO:+--+-- * The functions sourceRandom* are based on, initReplicate and+-- initRepeat have specialized versions for when they're used with+-- ($$). How does this interact with stream fusion?+--+-- * Is it possible to implement fusion for vectorBuilder? Since it+-- takes a Sink yielding function as an input, the rewrite rule+-- would need to trigger when that parameter looks something like+-- (\x -> unstream (...)). I don't see anything preventing doing+-- this, but it would be quite a bit of code.++-- NOTE: Fusion isn't possible for the following operations:+--+-- * Due to a lack of leftovers:+-- - dropE, dropWhile, dropWhileE+-- - headE+-- - peek, peekE+-- - null, nullE+-- - takeE, takeWhile, takeWhileE+-- - mapWhile+-- - codeWith+-- - line+-- - lineAscii+--+-- * Due to a use of leftover in a dependency:+-- - Due to "codeWith": encodeBase64, decodeBase64, encodeBase64URL, decodeBase64URL, decodeBase16+-- - due to "CT.decode": decodeUtf8, decodeUtf8Lenient+--+-- * Due to lack of resource cleanup (e.g. bracketP):+-- - sourceDirectory+-- - sourceDirectoryDeep+-- - sourceFile+--+-- * takeExactly / takeExactlyE - no monadic bind. Another way to+-- look at this is that subsequent streams drive stream evaluation,+-- so there's no way for the conduit to guarantee a certain amount+-- of demand from the upstream.++-- | Yield each of the values contained by the given @MonoFoldable@.+--+-- This will work on many data structures, including lists, @ByteString@s, and @Vector@s.+--+-- Subject to fusion+--+-- @since 1.3.0+yieldMany, yieldManyC :: (Monad m, MonoFoldable mono)+ => mono+ -> ConduitT i (Element mono) m ()+yieldManyC = ofoldMap yield+{-# INLINE yieldManyC #-}+STREAMING(yieldMany, yieldManyC, yieldManyS, x)++-- | Generate a producer from a seed value.+--+-- Subject to fusion+--+-- @since 1.3.0+unfold :: Monad m+ => (b -> Maybe (a, b))+ -> b+ -> ConduitT i a m ()+INLINE_RULE(unfold, f x, CL.unfold f x)++-- | Enumerate from a value to a final value, inclusive, via 'succ'.+--+-- This is generally more efficient than using @Prelude@\'s @enumFromTo@ and+-- combining with @sourceList@ since this avoids any intermediate data+-- structures.+--+-- Subject to fusion+--+-- @since 1.3.0+enumFromTo :: (Monad m, Enum a, Ord a) => a -> a -> ConduitT i a m ()+INLINE_RULE(enumFromTo, f t, CL.enumFromTo f t)++-- | Produces an infinite stream of repeated applications of f to x.+--+-- Subject to fusion+--+-- @since 1.3.0+iterate :: Monad m => (a -> a) -> a -> ConduitT i a m ()+INLINE_RULE(iterate, f t, CL.iterate f t)++-- | Produce an infinite stream consisting entirely of the given value.+--+-- Subject to fusion+--+-- @since 1.3.0+repeat :: Monad m => a -> ConduitT i a m ()+INLINE_RULE(repeat, x, iterate id x)++-- | Produce a finite stream consisting of n copies of the given value.+--+-- Subject to fusion+--+-- @since 1.3.0+replicate :: Monad m+ => Int+ -> a+ -> ConduitT i a m ()+INLINE_RULE(replicate, n x, CL.replicate n x)++-- | Generate a producer by yielding each of the strict chunks in a @LazySequence@.+--+-- For more information, see 'toChunks'.+--+-- Subject to fusion+--+-- @since 1.3.0+sourceLazy :: (Monad m, LazySequence lazy strict)+ => lazy+ -> ConduitT i strict m ()+INLINE_RULE(sourceLazy, x, yieldMany (toChunks x))++-- | Repeatedly run the given action and yield all values it produces.+--+-- Subject to fusion+--+-- @since 1.3.0+repeatM, repeatMC :: Monad m+ => m a+ -> ConduitT i a m ()+repeatMC m = forever $ lift m >>= yield+{-# INLINE repeatMC #-}+STREAMING(repeatM, repeatMC, repeatMS, m)++-- | Repeatedly run the given action and yield all values it produces, until+-- the provided predicate returns @False@.+--+-- Subject to fusion+--+-- @since 1.3.0+repeatWhileM, repeatWhileMC :: Monad m+ => m a+ -> (a -> Bool)+ -> ConduitT i a m ()+repeatWhileMC m f =+ loop+ where+ loop = do+ x <- lift m+ when (f x) $ yield x >> loop+STREAMING(repeatWhileM, repeatWhileMC, repeatWhileMS, m f)++-- | Perform the given action n times, yielding each result.+--+-- Subject to fusion+--+-- @since 1.3.0+replicateM :: Monad m+ => Int+ -> m a+ -> ConduitT i a m ()+INLINE_RULE(replicateM, n m, CL.replicateM n m)++-- | Stream the contents of a file as binary data.+--+-- @since 1.3.0+sourceFile :: MonadResource m+ => FilePath+ -> ConduitT i S.ByteString m ()+sourceFile fp =+ bracketP+ (FR.openFile fp)+ FR.closeFile+ loop+ where+ loop h = do+ bs <- liftIO $ FR.readChunk h+ unless (S.null bs) $ do+ yield bs+ loop h++-- | Stream the contents of a 'IO.Handle' as binary data. Note that this+-- function will /not/ automatically close the @Handle@ when processing+-- completes, since it did not acquire the @Handle@ in the first place.+--+-- @since 1.3.0+sourceHandle :: MonadIO m+ => IO.Handle+ -> ConduitT i S.ByteString m ()+sourceHandle h =+ loop+ where+ loop = do+ bs <- liftIO (S.hGetSome h defaultChunkSize)+ if S.null bs+ then return ()+ else yield bs >> loop++-- | Same as @sourceHandle@, but instead of allocating a new buffer for each+-- incoming chunk of data, reuses the same buffer. Therefore, the @ByteString@s+-- yielded by this function are not referentially transparent between two+-- different @yield@s.+--+-- This function will be slightly more efficient than @sourceHandle@ by+-- avoiding allocations and reducing garbage collections, but should only be+-- used if you can guarantee that you do not reuse a @ByteString@ (or any slice+-- thereof) between two calls to @await@.+--+-- @since 1.3.0+sourceHandleUnsafe :: MonadIO m => IO.Handle -> ConduitT i ByteString m ()+sourceHandleUnsafe handle = do+ fptr <- liftIO $ mallocPlainForeignPtrBytes defaultChunkSize+ let ptr = unsafeForeignPtrToPtr fptr+ loop = do+ count <- liftIO $ IO.hGetBuf handle ptr defaultChunkSize+ when (count > 0) $ do+ yield (PS fptr 0 count)+ loop++ loop++ liftIO $ touchForeignPtr fptr++-- | An alternative to 'sourceHandle'.+-- Instead of taking a pre-opened 'IO.Handle', it takes an action that opens+-- a 'IO.Handle' (in read mode), so that it can open it only when needed+-- and close it as soon as possible.+--+-- @since 1.3.0+sourceIOHandle :: MonadResource m+ => IO IO.Handle+ -> ConduitT i S.ByteString m ()+sourceIOHandle alloc = bracketP alloc IO.hClose sourceHandle++-- | Same as 'sourceFile'. The alternate name is a holdover from an older+-- version, when 'sourceFile' was more polymorphic than it is today.+--+-- @since 1.3.0+sourceFileBS :: MonadResource m => FilePath -> ConduitT i ByteString m ()+sourceFileBS = sourceFile+{-# INLINE sourceFileBS #-}++-- | @sourceHandle@ applied to @stdin@.+--+-- Subject to fusion+--+-- @since 1.3.0+stdin :: MonadIO m => ConduitT i ByteString m ()+INLINE_RULE0(stdin, sourceHandle IO.stdin)++-- | Stream all incoming data to the given file.+--+-- @since 1.3.0+sinkFile :: MonadResource m+ => FilePath+ -> ConduitT S.ByteString o m ()+sinkFile fp = sinkIOHandle (IO.openBinaryFile fp IO.WriteMode)++-- | Cautious version of 'sinkFile'. The idea here is to stream the+-- values to a temporary file in the same directory of the destination+-- file, and only on successfully writing the entire file, moves it+-- atomically to the destination path.+--+-- In the event of an exception occurring, the temporary file will be+-- deleted and no move will be made. If the application shuts down+-- without running exception handling (such as machine failure or a+-- SIGKILL), the temporary file will remain and the destination file+-- will be untouched.+--+-- @since 1.3.0+sinkFileCautious+ :: MonadResource m+ => FilePath+ -> ConduitM S.ByteString o m ()+sinkFileCautious fp =+ bracketP (cautiousAcquire fp) cautiousCleanup inner+ where+ inner (tmpFP, h) = do+ sinkHandle h+ liftIO $ do+ IO.hClose h+ renameFile tmpFP fp++-- | Like 'sinkFileCautious', but uses the @with@ pattern instead of+-- @MonadResource@.+--+-- @since 1.3.0+withSinkFileCautious+ :: (MonadUnliftIO m, MonadIO n)+ => FilePath+ -> (ConduitM S.ByteString o n () -> m a)+ -> m a+withSinkFileCautious fp inner =+ withRunInIO $ \run -> bracket+ (cautiousAcquire fp)+ cautiousCleanup+ (\(tmpFP, h) -> do+ a <- run $ inner $ sinkHandle h+ IO.hClose h+ renameFile tmpFP fp+ return a)++-- | Helper function for Cautious functions above, do not export!+cautiousAcquire :: FilePath -> IO (FilePath, IO.Handle)+cautiousAcquire fp = IO.openBinaryTempFile (takeDirectory fp) (takeFileName fp <.> "tmp")++-- | Helper function for Cautious functions above, do not export!+cautiousCleanup :: (FilePath, IO.Handle) -> IO ()+cautiousCleanup (tmpFP, h) = do+ IO.hClose h+ removeFile tmpFP `Control.Exception.catch` \e ->+ if isDoesNotExistError e+ then return ()+ else throwIO e++-- | Stream data into a temporary file in the given directory with the+-- given filename pattern, and return the temporary filename. The+-- temporary file will be automatically deleted when exiting the+-- active 'ResourceT' block, if it still exists.+--+-- @since 1.3.0+sinkTempFile :: MonadResource m+ => FilePath -- ^ temp directory+ -> String -- ^ filename pattern+ -> ConduitM ByteString o m FilePath+sinkTempFile tmpdir pattern = do+ (_releaseKey, (fp, h)) <- allocate+ (IO.openBinaryTempFile tmpdir pattern)+ (\(fp, h) -> IO.hClose h `finally` (removeFile fp `Control.Exception.catch` \e ->+ if isDoesNotExistError e+ then return ()+ else throwIO e))+ sinkHandle h+ liftIO $ IO.hClose h+ return fp++-- | Same as 'sinkTempFile', but will use the default temp file+-- directory for the system as the first argument.+--+-- @since 1.3.0+sinkSystemTempFile+ :: MonadResource m+ => String -- ^ filename pattern+ -> ConduitM ByteString o m FilePath+sinkSystemTempFile pattern = do+ dir <- liftIO getTemporaryDirectory+ sinkTempFile dir pattern++-- | Stream all incoming data to the given 'IO.Handle'. Note that this function+-- does /not/ flush and will /not/ close the @Handle@ when processing completes.+--+-- @since 1.3.0+sinkHandle :: MonadIO m+ => IO.Handle+ -> ConduitT S.ByteString o m ()+sinkHandle h = awaitForever (liftIO . S.hPut h)++-- | Stream incoming builders, executing them directly on the buffer of the+-- given 'IO.Handle'. Note that this function does /not/ automatically close the+-- @Handle@ when processing completes.+-- Pass 'Data.ByteString.Builder.Extra.flush' to flush the buffer.+--+-- @since 1.3.0+sinkHandleBuilder :: MonadIO m => IO.Handle -> ConduitM Builder o m ()+sinkHandleBuilder h = awaitForever (liftIO . hPutBuilder h)++-- | Stream incoming @Flush@es, executing them on @IO.Handle@+-- Note that this function does /not/ automatically close the @Handle@ when+-- processing completes+--+-- @since 1.3.0+sinkHandleFlush :: MonadIO m+ => IO.Handle+ -> ConduitM (Flush S.ByteString) o m ()+sinkHandleFlush h =+ awaitForever $ \mbs -> liftIO $+ case mbs of+ Chunk bs -> S.hPut h bs+ Flush -> IO.hFlush h++-- | An alternative to 'sinkHandle'.+-- Instead of taking a pre-opened 'IO.Handle', it takes an action that opens+-- a 'IO.Handle' (in write mode), so that it can open it only when needed+-- and close it as soon as possible.+--+-- @since 1.3.0+sinkIOHandle :: MonadResource m+ => IO IO.Handle+ -> ConduitT S.ByteString o m ()+sinkIOHandle alloc = bracketP alloc IO.hClose sinkHandle++-- | Like 'IO.withBinaryFile', but provides a source to read bytes from.+--+-- @since 1.3.0+withSourceFile+ :: (MonadUnliftIO m, MonadIO n)+ => FilePath+ -> (ConduitM i ByteString n () -> m a)+ -> m a+withSourceFile fp inner =+ withRunInIO $ \run ->+ IO.withBinaryFile fp IO.ReadMode $+ run . inner . sourceHandle++-- | Like 'IO.withBinaryFile', but provides a sink to write bytes to.+--+-- @since 1.3.0+withSinkFile+ :: (MonadUnliftIO m, MonadIO n)+ => FilePath+ -> (ConduitM ByteString o n () -> m a)+ -> m a+withSinkFile fp inner =+ withRunInIO $ \run ->+ IO.withBinaryFile fp IO.WriteMode $+ run . inner . sinkHandle++-- | Same as 'withSinkFile', but lets you use a 'BB.Builder'.+--+-- @since 1.3.0+withSinkFileBuilder+ :: (MonadUnliftIO m, MonadIO n)+ => FilePath+ -> (ConduitM Builder o n () -> m a)+ -> m a+withSinkFileBuilder fp inner =+ withRunInIO $ \run ->+ IO.withBinaryFile fp IO.WriteMode $ \h ->+ run $ inner $ CL.mapM_ (liftIO . hPutBuilder h)++-- | Stream the contents of the given directory, without traversing deeply.+--+-- This function will return /all/ of the contents of the directory, whether+-- they be files, directories, etc.+--+-- Note that the generated filepaths will be the complete path, not just the+-- filename. In other words, if you have a directory @foo@ containing files+-- @bar@ and @baz@, and you use @sourceDirectory@ on @foo@, the results will be+-- @foo/bar@ and @foo/baz@.+--+-- @since 1.3.0+sourceDirectory :: MonadResource m => FilePath -> ConduitT i FilePath m ()+sourceDirectory dir =+ bracketP (F.openDirStream dir) F.closeDirStream go+ where+ go ds =+ loop+ where+ loop = do+ mfp <- liftIO $ F.readDirStream ds+ case mfp of+ Nothing -> return ()+ Just fp -> do+ yield $ dir </> fp+ loop++-- | Deeply stream the contents of the given directory.+--+-- This works the same as @sourceDirectory@, but will not return directories at+-- all. This function also takes an extra parameter to indicate whether+-- symlinks will be followed.+--+-- @since 1.3.0+sourceDirectoryDeep :: MonadResource m+ => Bool -- ^ Follow directory symlinks+ -> FilePath -- ^ Root directory+ -> ConduitT i FilePath m ()+sourceDirectoryDeep followSymlinks =+ start+ where+ start :: MonadResource m => FilePath -> ConduitT i FilePath m ()+ start dir = sourceDirectory dir .| awaitForever go++ go :: MonadResource m => FilePath -> ConduitT i FilePath m ()+ go fp = do+ ft <- liftIO $ F.getFileType fp+ case ft of+ F.FTFile -> yield fp+ F.FTFileSym -> yield fp+ F.FTDirectory -> start fp+ F.FTDirectorySym+ | followSymlinks -> start fp+ | otherwise -> return ()+ F.FTOther -> return ()++-- | Ignore a certain number of values in the stream.+--+-- Note: since this function doesn't produce anything, you probably want to+-- use it with ('>>') instead of directly plugging it into a pipeline:+--+-- >>> runConduit $ yieldMany [1..5] .| drop 2 .| sinkList+-- []+-- >>> runConduit $ yieldMany [1..5] .| (drop 2 >> sinkList)+-- [3,4,5]+--+-- @since 1.3.0+drop :: Monad m+ => Int+ -> ConduitT a o m ()+INLINE_RULE(drop, n, CL.drop n)++-- | Drop a certain number of elements from a chunked stream.+--+-- Note: you likely want to use it with monadic composition. See the docs+-- for 'drop'.+--+-- @since 1.3.0+dropE :: (Monad m, Seq.IsSequence seq)+ => Seq.Index seq+ -> ConduitT seq o m ()+dropE =+ loop+ where+ loop i = if i <= 0+ then return ()+ else await >>= maybe (return ()) (go i)++ go i sq = do+ unless (onull y) $ leftover y+ loop i'+ where+ (x, y) = Seq.splitAt i sq+ i' = i - fromIntegral (olength x)+{-# INLINEABLE dropE #-}++-- | Drop all values which match the given predicate.+--+-- Note: you likely want to use it with monadic composition. See the docs+-- for 'drop'.+--+-- @since 1.3.0+dropWhile :: Monad m+ => (a -> Bool)+ -> ConduitT a o m ()+dropWhile f =+ loop+ where+ loop = await >>= maybe (return ()) go+ go x = if f x then loop else leftover x+{-# INLINE dropWhile #-}++-- | Drop all elements in the chunked stream which match the given predicate.+--+-- Note: you likely want to use it with monadic composition. See the docs+-- for 'drop'.+--+-- @since 1.3.0+dropWhileE :: (Monad m, Seq.IsSequence seq)+ => (Element seq -> Bool)+ -> ConduitT seq o m ()+dropWhileE f =+ loop+ where+ loop = await >>= maybe (return ()) go++ go sq =+ if onull x then loop else leftover x+ where+ x = Seq.dropWhile f sq+{-# INLINE dropWhileE #-}++-- | Monoidally combine all values in the stream.+--+-- Subject to fusion+--+-- @since 1.3.0+fold :: (Monad m, Monoid a)+ => ConduitT a o m a+INLINE_RULE0(fold, CL.foldMap id)++-- | Monoidally combine all elements in the chunked stream.+--+-- Subject to fusion+--+-- @since 1.3.0+foldE :: (Monad m, MonoFoldable mono, Monoid (Element mono))+ => ConduitT mono o m (Element mono)+INLINE_RULE0(foldE, CL.fold (\accum mono -> accum `mappend` ofoldMap id mono) mempty)++-- | A strict left fold.+--+-- Subject to fusion+--+-- @since 1.3.0+foldl :: Monad m => (a -> b -> a) -> a -> ConduitT b o m a+INLINE_RULE(foldl, f x, CL.fold f x)++-- | A strict left fold on a chunked stream.+--+-- Subject to fusion+--+-- @since 1.3.0+foldlE :: (Monad m, MonoFoldable mono)+ => (a -> Element mono -> a)+ -> a+ -> ConduitT mono o m a+INLINE_RULE(foldlE, f x, CL.fold (ofoldlPrime f) x)++-- Work around CPP not supporting identifiers with primes...+ofoldlPrime :: MonoFoldable mono => (a -> Element mono -> a) -> a -> mono -> a+ofoldlPrime = ofoldl'++-- | Apply the provided mapping function and monoidal combine all values.+--+-- Subject to fusion+--+-- @since 1.3.0+foldMap :: (Monad m, Monoid b)+ => (a -> b)+ -> ConduitT a o m b+INLINE_RULE(foldMap, f, CL.foldMap f)++-- | Apply the provided mapping function and monoidal combine all elements of the chunked stream.+--+-- Subject to fusion+--+-- @since 1.3.0+foldMapE :: (Monad m, MonoFoldable mono, Monoid w)+ => (Element mono -> w)+ -> ConduitT mono o m w+INLINE_RULE(foldMapE, f, CL.foldMap (ofoldMap f))++-- | A strict left fold with no starting value. Returns 'Nothing'+-- when the stream is empty.+--+-- Subject to fusion+foldl1, foldl1C :: Monad m => (a -> a -> a) -> ConduitT a o m (Maybe a)+foldl1C f =+ await >>= maybe (return Nothing) loop+ where+ loop !prev = await >>= maybe (return $ Just prev) (loop . f prev)+STREAMING(foldl1, foldl1C, foldl1S, f)++-- | A strict left fold on a chunked stream, with no starting value.+-- Returns 'Nothing' when the stream is empty.+--+-- Subject to fusion+--+-- @since 1.3.0+foldl1E :: (Monad m, MonoFoldable mono, a ~ Element mono)+ => (a -> a -> a)+ -> ConduitT mono o m (Maybe a)+INLINE_RULE(foldl1E, f, foldl (foldMaybeNull f) Nothing)++-- Helper for foldl1E+foldMaybeNull :: (MonoFoldable mono, e ~ Element mono)+ => (e -> e -> e)+ -> Maybe e+ -> mono+ -> Maybe e+foldMaybeNull f macc mono =+ case (macc, NonNull.fromNullable mono) of+ (Just acc, Just nn) -> Just $ ofoldl' f acc nn+ (Nothing, Just nn) -> Just $ NonNull.ofoldl1' f nn+ _ -> macc+{-# INLINE foldMaybeNull #-}++-- | Check that all values in the stream return True.+--+-- Subject to shortcut logic: at the first False, consumption of the stream+-- will stop.+--+-- Subject to fusion+--+-- @since 1.3.0+all, allC :: Monad m+ => (a -> Bool)+ -> ConduitT a o m Bool+allC f = fmap isNothing $ find (Prelude.not . f)+{-# INLINE allC #-}+STREAMING(all, allC, allS, f)++-- | Check that all elements in the chunked stream return True.+--+-- Subject to shortcut logic: at the first False, consumption of the stream+-- will stop.+--+-- Subject to fusion+--+-- @since 1.3.0+allE :: (Monad m, MonoFoldable mono)+ => (Element mono -> Bool)+ -> ConduitT mono o m Bool+INLINE_RULE(allE, f, all (oall f))++-- | Check that at least one value in the stream returns True.+--+-- Subject to shortcut logic: at the first True, consumption of the stream+-- will stop.+--+-- Subject to fusion+--+-- @since 1.3.0+any, anyC :: Monad m+ => (a -> Bool)+ -> ConduitT a o m Bool+anyC = fmap isJust . find+{-# INLINE anyC #-}+STREAMING(any, anyC, anyS, f)++-- | Check that at least one element in the chunked stream returns True.+--+-- Subject to shortcut logic: at the first True, consumption of the stream+-- will stop.+--+-- Subject to fusion+--+-- @since 1.3.0+anyE :: (Monad m, MonoFoldable mono)+ => (Element mono -> Bool)+ -> ConduitT mono o m Bool+INLINE_RULE(anyE, f, any (oany f))++-- | Are all values in the stream True?+--+-- Consumption stops once the first False is encountered.+--+-- Subject to fusion+--+-- @since 1.3.0+and :: Monad m => ConduitT Bool o m Bool+INLINE_RULE0(and, all id)++-- | Are all elements in the chunked stream True?+--+-- Consumption stops once the first False is encountered.+--+-- Subject to fusion+--+-- @since 1.3.0+andE :: (Monad m, MonoFoldable mono, Element mono ~ Bool)+ => ConduitT mono o m Bool+INLINE_RULE0(andE, allE id)++-- | Are any values in the stream True?+--+-- Consumption stops once the first True is encountered.+--+-- Subject to fusion+--+-- @since 1.3.0+or :: Monad m => ConduitT Bool o m Bool+INLINE_RULE0(or, any id)++-- | Are any elements in the chunked stream True?+--+-- Consumption stops once the first True is encountered.+--+-- Subject to fusion+--+-- @since 1.3.0+orE :: (Monad m, MonoFoldable mono, Element mono ~ Bool)+ => ConduitT mono o m Bool+INLINE_RULE0(orE, anyE id)++-- | 'Alternative'ly combine all values in the stream.+--+-- @since 1.3.0+asum :: (Monad m, Alternative f)+ => ConduitT (f a) o m (f a)+INLINE_RULE0(asum, foldl (<|>) empty)++-- | Are any values in the stream equal to the given value?+--+-- Stops consuming as soon as a match is found.+--+-- Subject to fusion+--+-- @since 1.3.0+elem :: (Monad m, Eq a) => a -> ConduitT a o m Bool+INLINE_RULE(elem, x, any (== x))++-- | Are any elements in the chunked stream equal to the given element?+--+-- Stops consuming as soon as a match is found.+--+-- Subject to fusion+--+-- @since 1.3.0+elemE :: (Monad m, Seq.IsSequence seq, Eq (Element seq))+ => Element seq+ -> ConduitT seq o m Bool+INLINE_RULE(elemE, f, any (oelem f))++-- | Are no values in the stream equal to the given value?+--+-- Stops consuming as soon as a match is found.+--+-- Subject to fusion+--+-- @since 1.3.0+notElem :: (Monad m, Eq a) => a -> ConduitT a o m Bool+INLINE_RULE(notElem, x, all (/= x))++-- | Are no elements in the chunked stream equal to the given element?+--+-- Stops consuming as soon as a match is found.+--+-- Subject to fusion+--+-- @since 1.3.0+notElemE :: (Monad m, Seq.IsSequence seq, Eq (Element seq))+ => Element seq+ -> ConduitT seq o m Bool+INLINE_RULE(notElemE, x, all (onotElem x))++-- | Consume all incoming strict chunks into a lazy sequence.+-- Note that the entirety of the sequence will be resident at memory.+--+-- This can be used to consume a stream of strict ByteStrings into a lazy+-- ByteString, for example.+--+-- Subject to fusion+--+-- @since 1.3.0+sinkLazy, sinkLazyC :: (Monad m, LazySequence lazy strict)+ => ConduitT strict o m lazy+sinkLazyC = (fromChunks . ($ [])) <$> CL.fold (\front next -> front . (next:)) id+{-# INLINE sinkLazyC #-}+STREAMING0(sinkLazy, sinkLazyC, sinkLazyS)++-- | Consume all values from the stream and return as a list. Note that this+-- will pull all values into memory.+--+-- Subject to fusion+--+-- @since 1.3.0+sinkList :: Monad m => ConduitT a o m [a]+INLINE_RULE0(sinkList, CL.consume)++-- | Sink incoming values into a vector, growing the vector as necessary to fit+-- more elements.+--+-- Note that using this function is more memory efficient than @sinkList@ and+-- then converting to a @Vector@, as it avoids intermediate list constructors.+--+-- Subject to fusion+--+-- @since 1.3.0+sinkVector, sinkVectorC :: (V.Vector v a, PrimMonad m)+ => ConduitT a o m (v a)+sinkVectorC = do+ let initSize = 10+ mv0 <- VM.new initSize+ let go maxSize i mv | i >= maxSize = do+ let newMax = maxSize * 2+ mv' <- VM.grow mv maxSize+ go newMax i mv'+ go maxSize i mv = do+ mx <- await+ case mx of+ Nothing -> V.slice 0 i <$> V.unsafeFreeze mv+ Just x -> do+ VM.write mv i x+ go maxSize (i + 1) mv+ go initSize 0 mv0+{-# INLINEABLE sinkVectorC #-}+STREAMING0(sinkVector, sinkVectorC, sinkVectorS)++-- | Sink incoming values into a vector, up until size @maxSize@. Subsequent+-- values will be left in the stream. If there are less than @maxSize@ values+-- present, returns a @Vector@ of smaller size.+--+-- Note that using this function is more memory efficient than @sinkList@ and+-- then converting to a @Vector@, as it avoids intermediate list constructors.+--+-- Subject to fusion+--+-- @since 1.3.0+sinkVectorN, sinkVectorNC :: (V.Vector v a, PrimMonad m)+ => Int -- ^ maximum allowed size+ -> ConduitT a o m (v a)+sinkVectorNC maxSize = do+ mv <- VM.new maxSize+ let go i | i >= maxSize = V.unsafeFreeze mv+ go i = do+ mx <- await+ case mx of+ Nothing -> V.slice 0 i <$> V.unsafeFreeze mv+ Just x -> do+ VM.write mv i x+ go (i + 1)+ go 0+{-# INLINEABLE sinkVectorNC #-}+STREAMING(sinkVectorN, sinkVectorNC, sinkVectorNS, maxSize)++-- | Same as @sinkBuilder@, but afterwards convert the builder to its lazy+-- representation.+--+-- Alternatively, this could be considered an alternative to @sinkLazy@, with+-- the following differences:+--+-- * This function will allow multiple input types, not just the strict version+-- of the lazy structure.+--+-- * Some buffer copying may occur in this version.+--+-- Subject to fusion+--+-- @since 1.3.0+sinkLazyBuilder, sinkLazyBuilderC :: Monad m => ConduitT Builder o m BL.ByteString+sinkLazyBuilderC = fmap toLazyByteString fold+{-# INLINE sinkLazyBuilderC #-}+STREAMING0(sinkLazyBuilder, sinkLazyBuilderC, sinkLazyBuilderS)++-- | Consume and discard all remaining values in the stream.+--+-- Subject to fusion+--+-- @since 1.3.0+sinkNull :: Monad m => ConduitT a o m ()+INLINE_RULE0(sinkNull, CL.sinkNull)++-- | Same as @await@, but discards any leading 'onull' values.+--+-- @since 1.3.0+awaitNonNull :: (Monad m, MonoFoldable a) => ConduitT a o m (Maybe (NonNull.NonNull a))+awaitNonNull =+ go+ where+ go = await >>= maybe (return Nothing) go'++ go' = maybe go (return . Just) . NonNull.fromNullable+{-# INLINE awaitNonNull #-}++-- | Take a single value from the stream, if available.+--+-- @since 1.3.0+head :: Monad m => ConduitT a o m (Maybe a)+head = CL.head++-- | Same as 'head', but returns a default value if none are available from the stream.+--+-- @since 1.3.0+headDef :: Monad m => a -> ConduitT a o m a+headDef a = fromMaybe a <$> head++-- | Get the next element in the chunked stream.+--+-- @since 1.3.0+headE :: (Monad m, Seq.IsSequence seq) => ConduitT seq o m (Maybe (Element seq))+headE =+ loop+ where+ loop = await >>= maybe (return Nothing) go+ go x =+ case Seq.uncons x of+ Nothing -> loop+ Just (y, z) -> do+ unless (onull z) $ leftover z+ return $ Just y+{-# INLINE headE #-}++-- | View the next value in the stream without consuming it.+--+-- @since 1.3.0+peek :: Monad m => ConduitT a o m (Maybe a)+peek = CL.peek+{-# INLINE peek #-}++-- | View the next element in the chunked stream without consuming it.+--+-- @since 1.3.0+peekE :: (Monad m, MonoFoldable mono) => ConduitT mono o m (Maybe (Element mono))+peekE =+ loop+ where+ loop = await >>= maybe (return Nothing) go+ go x =+ case headMay x of+ Nothing -> loop+ Just y -> do+ leftover x+ return $ Just y+{-# INLINE peekE #-}++-- | Retrieve the last value in the stream, if present.+--+-- Subject to fusion+--+-- @since 1.3.0+last, lastC :: Monad m => ConduitT a o m (Maybe a)+lastC =+ await >>= maybe (return Nothing) loop+ where+ loop prev = await >>= maybe (return $ Just prev) loop+STREAMING0(last, lastC, lastS)++-- | Same as 'last', but returns a default value if none are available from the stream.+--+-- @since 1.3.0+lastDef :: Monad m => a -> ConduitT a o m a+lastDef a = fromMaybe a <$> last++-- | Retrieve the last element in the chunked stream, if present.+--+-- Subject to fusion+--+-- @since 1.3.0+lastE, lastEC :: (Monad m, Seq.IsSequence seq) => ConduitT seq o m (Maybe (Element seq))+lastEC =+ awaitNonNull >>= maybe (return Nothing) (loop . NonNull.last)+ where+ loop prev = awaitNonNull >>= maybe (return $ Just prev) (loop . NonNull.last)+STREAMING0(lastE, lastEC, lastES)++-- | Count how many values are in the stream.+--+-- Subject to fusion+--+-- @since 1.3.0+length :: (Monad m, Num len) => ConduitT a o m len+INLINE_RULE0(length, foldl (\x _ -> x + 1) 0)++-- | Count how many elements are in the chunked stream.+--+-- Subject to fusion+--+-- @since 1.3.0+lengthE :: (Monad m, Num len, MonoFoldable mono) => ConduitT mono o m len+INLINE_RULE0(lengthE, foldl (\x y -> x + fromIntegral (olength y)) 0)++-- | Count how many values in the stream pass the given predicate.+--+-- Subject to fusion+--+-- @since 1.3.0+lengthIf :: (Monad m, Num len) => (a -> Bool) -> ConduitT a o m len+INLINE_RULE(lengthIf, f, foldl (\cnt a -> if f a then (cnt + 1) else cnt) 0)++-- | Count how many elements in the chunked stream pass the given predicate.+--+-- Subject to fusion+--+-- @since 1.3.0+lengthIfE :: (Monad m, Num len, MonoFoldable mono)+ => (Element mono -> Bool) -> ConduitT mono o m len+INLINE_RULE(lengthIfE, f, foldlE (\cnt a -> if f a then (cnt + 1) else cnt) 0)++-- | Get the largest value in the stream, if present.+--+-- Subject to fusion+--+-- @since 1.3.0+maximum :: (Monad m, Ord a) => ConduitT a o m (Maybe a)+INLINE_RULE0(maximum, foldl1 max)++-- | Get the largest element in the chunked stream, if present.+--+-- Subject to fusion+--+-- @since 1.3.0+maximumE :: (Monad m, Seq.IsSequence seq, Ord (Element seq)) => ConduitT seq o m (Maybe (Element seq))+INLINE_RULE0(maximumE, foldl1E max)++-- | Get the smallest value in the stream, if present.+--+-- Subject to fusion+--+-- @since 1.3.0+minimum :: (Monad m, Ord a) => ConduitT a o m (Maybe a)+INLINE_RULE0(minimum, foldl1 min)++-- | Get the smallest element in the chunked stream, if present.+--+-- Subject to fusion+--+-- @since 1.3.0+minimumE :: (Monad m, Seq.IsSequence seq, Ord (Element seq)) => ConduitT seq o m (Maybe (Element seq))+INLINE_RULE0(minimumE, foldl1E min)++-- | True if there are no values in the stream.+--+-- This function does not modify the stream.+--+-- @since 1.3.0+null :: Monad m => ConduitT a o m Bool+null = (maybe True (\_ -> False)) `fmap` peek+{-# INLINE null #-}++-- | True if there are no elements in the chunked stream.+--+-- This function may remove empty leading chunks from the stream, but otherwise+-- will not modify it.+--+-- @since 1.3.0+nullE :: (Monad m, MonoFoldable mono)+ => ConduitT mono o m Bool+nullE =+ go+ where+ go = await >>= maybe (return True) go'+ go' x = if onull x then go else leftover x >> return False+{-# INLINE nullE #-}++-- | Get the sum of all values in the stream.+--+-- Subject to fusion+--+-- @since 1.3.0+sum :: (Monad m, Num a) => ConduitT a o m a+INLINE_RULE0(sum, foldl (+) 0)++-- | Get the sum of all elements in the chunked stream.+--+-- Subject to fusion+--+-- @since 1.3.0+sumE :: (Monad m, MonoFoldable mono, Num (Element mono)) => ConduitT mono o m (Element mono)+INLINE_RULE0(sumE, foldlE (+) 0)++-- | Get the product of all values in the stream.+--+-- Subject to fusion+--+-- @since 1.3.0+product :: (Monad m, Num a) => ConduitT a o m a+INLINE_RULE0(product, foldl (*) 1)++-- | Get the product of all elements in the chunked stream.+--+-- Subject to fusion+--+-- @since 1.3.0+productE :: (Monad m, MonoFoldable mono, Num (Element mono)) => ConduitT mono o m (Element mono)+INLINE_RULE0(productE, foldlE (*) 1)++-- | Find the first matching value.+--+-- Subject to fusion+--+-- @since 1.3.0+find, findC :: Monad m => (a -> Bool) -> ConduitT a o m (Maybe a)+findC f =+ loop+ where+ loop = await >>= maybe (return Nothing) go+ go x = if f x then return (Just x) else loop+{-# INLINE findC #-}+STREAMING(find, findC, findS, f)++-- | Apply the action to all values in the stream.+--+-- Note: if you want to /pass/ the values instead of /consuming/ them, use+-- 'iterM' instead.+--+-- Subject to fusion+--+-- @since 1.3.0+mapM_ :: Monad m => (a -> m ()) -> ConduitT a o m ()+INLINE_RULE(mapM_, f, CL.mapM_ f)++-- | Apply the action to all elements in the chunked stream.+--+-- Note: the same caveat as with 'mapM_' applies. If you don't want to+-- consume the values, you can use 'iterM':+--+-- > iterM (omapM_ f)+--+-- Subject to fusion+--+-- @since 1.3.0+mapM_E :: (Monad m, MonoFoldable mono) => (Element mono -> m ()) -> ConduitT mono o m ()+INLINE_RULE(mapM_E, f, CL.mapM_ (omapM_ f))++-- | A monadic strict left fold.+--+-- Subject to fusion+--+-- @since 1.3.0+foldM :: Monad m => (a -> b -> m a) -> a -> ConduitT b o m a+INLINE_RULE(foldM, f x, CL.foldM f x)++-- | A monadic strict left fold on a chunked stream.+--+-- Subject to fusion+--+-- @since 1.3.0+foldME :: (Monad m, MonoFoldable mono)+ => (a -> Element mono -> m a)+ -> a+ -> ConduitT mono o m a+INLINE_RULE(foldME, f x, foldM (ofoldlM f) x)++-- | Apply the provided monadic mapping function and monoidal combine all values.+--+-- Subject to fusion+--+-- @since 1.3.0+foldMapM :: (Monad m, Monoid w) => (a -> m w) -> ConduitT a o m w+INLINE_RULE(foldMapM, f, CL.foldMapM f)++-- | Apply the provided monadic mapping function and monoidal combine all+-- elements in the chunked stream.+--+-- Subject to fusion+--+-- @since 1.3.0+foldMapME :: (Monad m, MonoFoldable mono, Monoid w)+ => (Element mono -> m w)+ -> ConduitT mono o m w+INLINE_RULE(foldMapME, f, CL.foldM (ofoldlM (\accum e -> mappend accum `liftM` f e)) mempty)++-- | 'sinkFile' specialized to 'ByteString' to help with type+-- inference.+--+-- @since 1.3.0+sinkFileBS :: MonadResource m => FilePath -> ConduitT ByteString o m ()+sinkFileBS = sinkFile+{-# INLINE sinkFileBS #-}++-- | Print all incoming values to stdout.+--+-- Subject to fusion+--+-- @since 1.3.0+print :: (Show a, MonadIO m) => ConduitT a o m ()+INLINE_RULE0(print, mapM_ (liftIO . Prelude.print))++-- | @sinkHandle@ applied to @stdout@.+--+-- Subject to fusion+--+-- @since 1.3.0+stdout :: MonadIO m => ConduitT ByteString o m ()+INLINE_RULE0(stdout, sinkHandle IO.stdout)++-- | @sinkHandle@ applied to @stderr@.+--+-- Subject to fusion+--+-- @since 1.3.0+stderr :: MonadIO m => ConduitT ByteString o m ()+INLINE_RULE0(stderr, sinkHandle IO.stderr)++-- | Apply a transformation to all values in a stream.+--+-- Subject to fusion+--+-- @since 1.3.0+map :: Monad m => (a -> b) -> ConduitT a b m ()+INLINE_RULE(map, f, CL.map f)++-- | Apply a transformation to all elements in a chunked stream.+--+-- Subject to fusion+--+-- @since 1.3.0+mapE :: (Monad m, Functor f) => (a -> b) -> ConduitT (f a) (f b) m ()+INLINE_RULE(mapE, f, CL.map (fmap f))++-- | Apply a monomorphic transformation to all elements in a chunked stream.+--+-- Unlike @mapE@, this will work on types like @ByteString@ and @Text@ which+-- are @MonoFunctor@ but not @Functor@.+--+-- Subject to fusion+--+-- @since 1.3.0+omapE :: (Monad m, MonoFunctor mono) => (Element mono -> Element mono) -> ConduitT mono mono m ()+INLINE_RULE(omapE, f, CL.map (omap f))++-- | Apply the function to each value in the stream, resulting in a foldable+-- value (e.g., a list). Then yield each of the individual values in that+-- foldable value separately.+--+-- Generalizes concatMap, mapMaybe, and mapFoldable.+--+-- Subject to fusion+--+-- @since 1.3.0+concatMap, concatMapC :: (Monad m, MonoFoldable mono)+ => (a -> mono)+ -> ConduitT a (Element mono) m ()+concatMapC f = awaitForever (yieldMany . f)+{-# INLINE concatMapC #-}+STREAMING(concatMap, concatMapC, concatMapS, f)++-- | Apply the function to each element in the chunked stream, resulting in a+-- foldable value (e.g., a list). Then yield each of the individual values in+-- that foldable value separately.+--+-- Generalizes concatMap, mapMaybe, and mapFoldable.+--+-- Subject to fusion+--+-- @since 1.3.0+concatMapE :: (Monad m, MonoFoldable mono, Monoid w)+ => (Element mono -> w)+ -> ConduitT mono w m ()+INLINE_RULE(concatMapE, f, CL.map (ofoldMap f))++-- | Stream up to n number of values downstream.+--+-- Note that, if downstream terminates early, not all values will be consumed.+-- If you want to force /exactly/ the given number of values to be consumed,+-- see 'takeExactly'.+--+-- Subject to fusion+--+-- @since 1.3.0+take :: Monad m => Int -> ConduitT a a m ()+INLINE_RULE(take, n, CL.isolate n)++-- | Stream up to n number of elements downstream in a chunked stream.+--+-- Note that, if downstream terminates early, not all values will be consumed.+-- If you want to force /exactly/ the given number of values to be consumed,+-- see 'takeExactlyE'.+--+-- @since 1.3.0+takeE :: (Monad m, Seq.IsSequence seq)+ => Seq.Index seq+ -> ConduitT seq seq m ()+takeE =+ loop+ where+ loop i = if i <= 0+ then return ()+ else await >>= maybe (return ()) (go i)++ go i sq = do+ unless (onull x) $ yield x+ unless (onull y) $ leftover y+ loop i'+ where+ (x, y) = Seq.splitAt i sq+ i' = i - fromIntegral (olength x)+{-# INLINEABLE takeE #-}++-- | Stream all values downstream that match the given predicate.+--+-- Same caveats regarding downstream termination apply as with 'take'.+--+-- @since 1.3.0+takeWhile :: Monad m+ => (a -> Bool)+ -> ConduitT a a m ()+takeWhile f =+ loop+ where+ loop = await >>= maybe (return ()) go+ go x = if f x+ then yield x >> loop+ else leftover x+{-# INLINE takeWhile #-}++-- | Stream all elements downstream that match the given predicate in a chunked stream.+--+-- Same caveats regarding downstream termination apply as with 'takeE'.+--+-- @since 1.3.0+takeWhileE :: (Monad m, Seq.IsSequence seq)+ => (Element seq -> Bool)+ -> ConduitT seq seq m ()+takeWhileE f =+ loop+ where+ loop = await >>= maybe (return ()) go++ go sq = do+ unless (onull x) $ yield x+ if onull y+ then loop+ else leftover y+ where+ (x, y) = Seq.span f sq+{-# INLINE takeWhileE #-}++-- | Consume precisely the given number of values and feed them downstream.+--+-- This function is in contrast to 'take', which will only consume up to the+-- given number of values, and will terminate early if downstream terminates+-- early. This function will discard any additional values in the stream if+-- they are unconsumed.+--+-- Note that this function takes a downstream @ConduitT@ as a parameter, as+-- opposed to working with normal fusion. For more information, see+-- <http://www.yesodweb.com/blog/2013/10/core-flaw-pipes-conduit>, the section+-- titled \"pipes and conduit: isolate\".+--+-- @since 1.3.0+takeExactly :: Monad m+ => Int+ -> ConduitT a b m r+ -> ConduitT a b m r+takeExactly count inner = take count .| do+ r <- inner+ CL.sinkNull+ return r++-- | Same as 'takeExactly', but for chunked streams.+--+-- @since 1.3.0+takeExactlyE :: (Monad m, Seq.IsSequence a)+ => Seq.Index a+ -> ConduitT a b m r+ -> ConduitT a b m r+takeExactlyE count inner = takeE count .| do+ r <- inner+ CL.sinkNull+ return r+{-# INLINE takeExactlyE #-}++-- | Flatten out a stream by yielding the values contained in an incoming+-- @MonoFoldable@ as individually yielded values.+--+-- Subject to fusion+--+-- @since 1.3.0+concat, concatC :: (Monad m, MonoFoldable mono)+ => ConduitT mono (Element mono) m ()+concatC = awaitForever yieldMany+STREAMING0(concat, concatC, concatS)++-- | Keep only values in the stream passing a given predicate.+--+-- Subject to fusion+--+-- @since 1.3.0+filter :: Monad m => (a -> Bool) -> ConduitT a a m ()+INLINE_RULE(filter, f, CL.filter f)++-- | Keep only elements in the chunked stream passing a given predicate.+--+-- Subject to fusion+--+-- @since 1.3.0+filterE :: (Seq.IsSequence seq, Monad m) => (Element seq -> Bool) -> ConduitT seq seq m ()+INLINE_RULE(filterE, f, CL.map (Seq.filter f))++-- | Map values as long as the result is @Just@.+--+-- @since 1.3.0+mapWhile :: Monad m => (a -> Maybe b) -> ConduitT a b m ()+mapWhile f =+ loop+ where+ loop = await >>= maybe (return ()) go+ go x =+ case f x of+ Just y -> yield y >> loop+ Nothing -> leftover x+{-# INLINE mapWhile #-}++-- | Break up a stream of values into vectors of size n. The final vector may+-- be smaller than n if the total number of values is not a strict multiple of+-- n. No empty vectors will be yielded.+--+-- @since 1.3.0+conduitVector :: (V.Vector v a, PrimMonad m)+ => Int -- ^ maximum allowed size+ -> ConduitT a (v a) m ()+conduitVector size =+ loop+ where+ loop = do+ v <- sinkVectorN size+ unless (V.null v) $ do+ yield v+ loop+{-# INLINE conduitVector #-}++-- | Analog of 'Prelude.scanl' for lists.+--+-- Subject to fusion+--+-- @since 1.3.0+scanl, scanlC :: Monad m => (a -> b -> a) -> a -> ConduitT b a m ()+scanlC f =+ loop+ where+ loop seed =+ await >>= maybe (yield seed) go+ where+ go b = do+ let seed' = f seed b+ seed' `seq` yield seed+ loop seed'+STREAMING(scanl, scanlC, scanlS, f x)++-- | 'mapWhile' with a break condition dependent on a strict accumulator.+-- Equivalently, 'CL.mapAccum' as long as the result is @Right@. Instead of+-- producing a leftover, the breaking input determines the resulting+-- accumulator via @Left@.+--+-- Subject to fusion+mapAccumWhile, mapAccumWhileC :: Monad m => (a -> s -> Either s (s, b)) -> s -> ConduitT a b m s+mapAccumWhileC f =+ loop+ where+ loop !s = await >>= maybe (return s) go+ where+ go a = either (return $!) (\(s', b) -> yield b >> loop s') $ f a s+{-# INLINE mapAccumWhileC #-}+STREAMING(mapAccumWhile, mapAccumWhileC, mapAccumWhileS, f s)+++-- | Specialized version of 'mapAccumWhile' that does not provide values downstream.+--+-- @since 1.3.4+foldWhile :: Monad m => (a -> s -> Either e s) -> s -> ConduitT a o m (Either e s)+foldWhile f = loop+ where+ loop !s = await >>= maybe (return $ Right s) go+ where+ go a = either (return . Left $!) loop $ f a s+{-# INLINE foldWhile #-}+++-- | 'concatMap' with an accumulator.+--+-- Subject to fusion+--+-- @since 1.3.0+concatMapAccum :: Monad m => (a -> accum -> (accum, [b])) -> accum -> ConduitT a b m ()+INLINE_RULE0(concatMapAccum, CL.concatMapAccum)++-- | Insert the given value between each two values in the stream.+--+-- Subject to fusion+--+-- @since 1.3.0+intersperse, intersperseC :: Monad m => a -> ConduitT a a m ()+intersperseC x =+ await >>= omapM_ go+ where+ go y = yield y >> concatMap (\z -> [x, z])+STREAMING(intersperse, intersperseC, intersperseS, x)++-- | Sliding window of values+-- 1,2,3,4,5 with window size 2 gives+-- [1,2],[2,3],[3,4],[4,5]+--+-- Best used with structures that support O(1) snoc.+--+-- Subject to fusion+--+-- @since 1.3.0+slidingWindow, slidingWindowC :: (Monad m, Seq.IsSequence seq, Element seq ~ a) => Int -> ConduitT a seq m ()+slidingWindowC sz = go (max 1 sz) mempty+ where goContinue st = await >>=+ maybe (return ())+ (\x -> do+ let st' = Seq.snoc st x+ yield st' >> goContinue (Seq.unsafeTail st')+ )+ go 0 st = yield st >> goContinue (Seq.unsafeTail st)+ go !n st = CL.head >>= \m ->+ case m of+ Nothing -> yield st+ Just x -> go (n-1) (Seq.snoc st x)+STREAMING(slidingWindow, slidingWindowC, slidingWindowS, sz)+++-- | Split input into chunk of size 'chunkSize'+--+-- The last element may be smaller than the 'chunkSize' (see also+-- 'chunksOfExactlyE' which will not yield this last element)+--+-- @since 1.3.0+chunksOfE :: (Monad m, Seq.IsSequence seq) => Seq.Index seq -> ConduitT seq seq m ()+chunksOfE chunkSize = chunksOfExactlyE chunkSize >> (await >>= maybe (return ()) yield)++-- | Split input into chunk of size 'chunkSize'+--+-- If the input does not split into chunks exactly, the remainder will be+-- leftover (see also 'chunksOfE')+--+-- @since 1.3.0+chunksOfExactlyE :: (Monad m, Seq.IsSequence seq) => Seq.Index seq -> ConduitT seq seq m ()+chunksOfExactlyE chunkSize = await >>= maybe (return ()) start+ where+ start b+ | onull b = chunksOfExactlyE chunkSize+ | Seq.lengthIndex b < chunkSize = continue (Seq.lengthIndex b) [b]+ | otherwise = let (first,rest) = Seq.splitAt chunkSize b in+ yield first >> start rest+ continue !sofar bs = do+ next <- await+ case next of+ Nothing -> leftover (mconcat $ Prelude.reverse bs)+ Just next' ->+ let !sofar' = Seq.lengthIndex next' + sofar+ bs' = next':bs+ in if sofar' < chunkSize+ then continue sofar' bs'+ else start (mconcat (Prelude.reverse bs'))++-- | Apply a monadic transformation to all values in a stream.+--+-- If you do not need the transformed values, and instead just want the monadic+-- side-effects of running the action, see 'mapM_'.+--+-- Subject to fusion+--+-- @since 1.3.0+mapM :: Monad m => (a -> m b) -> ConduitT a b m ()+INLINE_RULE(mapM, f, CL.mapM f)++-- | Apply a monadic transformation to all elements in a chunked stream.+--+-- Subject to fusion+--+-- @since 1.3.0+mapME :: (Monad m, Data.Traversable.Traversable f) => (a -> m b) -> ConduitT (f a) (f b) m ()+INLINE_RULE(mapME, f, CL.mapM (Data.Traversable.mapM f))++-- | Apply a monadic monomorphic transformation to all elements in a chunked stream.+--+-- Unlike @mapME@, this will work on types like @ByteString@ and @Text@ which+-- are @MonoFunctor@ but not @Functor@.+--+-- Subject to fusion+--+-- @since 1.3.0+omapME :: (Monad m, MonoTraversable mono)+ => (Element mono -> m (Element mono))+ -> ConduitT mono mono m ()+INLINE_RULE(omapME, f, CL.mapM (omapM f))++-- | Apply the monadic function to each value in the stream, resulting in a+-- foldable value (e.g., a list). Then yield each of the individual values in+-- that foldable value separately.+--+-- Generalizes concatMapM, mapMaybeM, and mapFoldableM.+--+-- Subject to fusion+--+-- @since 1.3.0+concatMapM, concatMapMC :: (Monad m, MonoFoldable mono)+ => (a -> m mono)+ -> ConduitT a (Element mono) m ()+concatMapMC f = awaitForever (lift . f >=> yieldMany)+STREAMING(concatMapM, concatMapMC, concatMapMS, f)++-- | Keep only values in the stream passing a given monadic predicate.+--+-- Subject to fusion+--+-- @since 1.3.0+filterM, filterMC :: Monad m+ => (a -> m Bool)+ -> ConduitT a a m ()+filterMC f =+ awaitForever go+ where+ go x = do+ b <- lift $ f x+ when b $ yield x+STREAMING(filterM, filterMC, filterMS, f)++-- | Keep only elements in the chunked stream passing a given monadic predicate.+--+-- Subject to fusion+--+-- @since 1.3.0+filterME :: (Monad m, Seq.IsSequence seq) => (Element seq -> m Bool) -> ConduitT seq seq m ()+INLINE_RULE(filterME, f, CL.mapM (Seq.filterM f))++-- | Apply a monadic action on all values in a stream.+--+-- This @Conduit@ can be used to perform a monadic side-effect for every+-- value, whilst passing the value through the @Conduit@ as-is.+--+-- > iterM f = mapM (\a -> f a >>= \() -> return a)+--+-- Subject to fusion+--+-- @since 1.3.0+iterM :: Monad m => (a -> m ()) -> ConduitT a a m ()+INLINE_RULE(iterM, f, CL.iterM f)++-- | Analog of 'Prelude.scanl' for lists, monadic.+--+-- Subject to fusion+--+-- @since 1.3.0+scanlM, scanlMC :: Monad m => (a -> b -> m a) -> a -> ConduitT b a m ()+scanlMC f =+ loop+ where+ loop seed =+ await >>= maybe (yield seed) go+ where+ go b = do+ seed' <- lift $ f seed b+ seed' `seq` yield seed+ loop seed'+STREAMING(scanlM, scanlMC, scanlMS, f x)++-- | Monadic `mapAccumWhile`.+--+-- Subject to fusion+mapAccumWhileM, mapAccumWhileMC :: Monad m => (a -> s -> m (Either s (s, b))) -> s -> ConduitT a b m s+mapAccumWhileMC f =+ loop+ where+ loop !s = await >>= maybe (return s) go+ where+ go a = lift (f a s) >>= either (return $!) (\(s', b) -> yield b >> loop s')+{-# INLINE mapAccumWhileMC #-}+STREAMING(mapAccumWhileM, mapAccumWhileMC, mapAccumWhileMS, f s)++-- | 'concatMapM' with an accumulator.+--+-- Subject to fusion+--+-- @since 1.3.0+concatMapAccumM :: Monad m => (a -> accum -> m (accum, [b])) -> accum -> ConduitT a b m ()+INLINE_RULE(concatMapAccumM, f x, CL.concatMapAccumM f x)++-- | Encode a stream of text as UTF8.+--+-- Subject to fusion+--+-- @since 1.3.0+encodeUtf8 :: (Monad m, DTE.Utf8 text binary) => ConduitT text binary m ()+INLINE_RULE0(encodeUtf8, map DTE.encodeUtf8)++-- | Decode a stream of binary data as UTF8.+--+-- @since 1.3.0+decodeUtf8 :: MonadThrow m => ConduitT ByteString Text m ()+decodeUtf8 =+ loop TE.streamDecodeUtf8+ where+ loop parse =+ await >>= maybe done go+ where+ parse' = unsafePerformIO . try . evaluate . parse+ done =+ case parse' mempty of+ Left e -> throwM (e :: TEE.UnicodeException)+ Right (TE.Some t bs _) -> do+ unless (T.null t) (yield t)+ unless (S.null bs) (yield $ T.replicate (S.length bs) (T.singleton '\xFFFD'))++ go bs = do+ case parse' bs of+ Left e -> do+ leftover bs+ throwM (e :: TEE.UnicodeException)+ Right (TE.Some t _ next) -> do+ unless (T.null t) (yield t)+ loop next++-- | Decode a stream of binary data as UTF8, replacing any invalid bytes with+-- the Unicode replacement character.+--+-- @since 1.3.0+decodeUtf8Lenient :: Monad m => ConduitT ByteString Text m ()+decodeUtf8Lenient =+ loop (TE.streamDecodeUtf8With TEE.lenientDecode)+ where+ loop parse =+ await >>= maybe done go+ where+ done = do+ let TE.Some t bs _ = parse mempty+ unless (T.null t) (yield t)+ unless (S.null bs) (yield $ T.replicate (S.length bs) (T.singleton '\xFFFD'))++ go bs = do+ let TE.Some t _ next = parse bs+ unless (T.null t) (yield t)+ loop next++-- | Stream in the entirety of a single line.+--+-- Like @takeExactly@, this will consume the entirety of the line regardless of+-- the behavior of the inner Conduit.+--+-- @since 1.3.0+line :: (Monad m, Seq.IsSequence seq, Element seq ~ Char)+ => ConduitT seq o m r+ -> ConduitT seq o m r+line = takeExactlyUntilE (== '\n')+{-# INLINE line #-}++-- | Same as 'line', but operates on ASCII/binary data.+--+-- @since 1.3.0+lineAscii :: (Monad m, Seq.IsSequence seq, Element seq ~ Word8)+ => ConduitT seq o m r+ -> ConduitT seq o m r+lineAscii = takeExactlyUntilE (== 10)+{-# INLINE lineAscii #-}++-- | Stream in the chunked input until an element matches a predicate.+--+-- Like @takeExactly@, this will consume the entirety of the prefix+-- regardless of the behavior of the inner Conduit.+takeExactlyUntilE :: (Monad m, Seq.IsSequence seq)+ => (Element seq -> Bool)+ -> ConduitT seq o m r+ -> ConduitT seq o m r+takeExactlyUntilE f inner =+ loop .| do+ x <- inner+ sinkNull+ return x+ where+ loop = await >>= omapM_ go+ go t =+ if onull y+ then yield x >> loop+ else do+ unless (onull x) $ yield x+ let y' = Seq.drop 1 y+ unless (onull y') $ leftover y'+ where+ (x, y) = Seq.break f t+{-# INLINE takeExactlyUntilE #-}++-- | Insert a newline character after each incoming chunk of data.+--+-- Subject to fusion+--+-- @since 1.3.0+unlines :: (Monad m, Seq.IsSequence seq, Element seq ~ Char) => ConduitT seq seq m ()+INLINE_RULE0(unlines, concatMap (:[Seq.singleton '\n']))++-- | Same as 'unlines', but operates on ASCII/binary data.+--+-- Subject to fusion+--+-- @since 1.3.0+unlinesAscii :: (Monad m, Seq.IsSequence seq, Element seq ~ Word8) => ConduitT seq seq m ()+INLINE_RULE0(unlinesAscii, concatMap (:[Seq.singleton 10]))++-- | Split a stream of arbitrarily-chunked data, based on a predicate+-- on elements. Elements that satisfy the predicate will cause chunks+-- to be split, and aren't included in these output chunks. Note+-- that, if you have unknown or untrusted input, this function is+-- /unsafe/, since it would allow an attacker to form chunks of+-- massive length and exhaust memory.+splitOnUnboundedE, splitOnUnboundedEC :: (Monad m, Seq.IsSequence seq) => (Element seq -> Bool) -> ConduitT seq seq m ()+splitOnUnboundedEC f =+ start+ where+ start = await >>= maybe (return ()) (loop id)++ loop bldr t =+ if onull y+ then do+ mt <- await+ case mt of+ Nothing -> let finalChunk = mconcat $ bldr [t]+ in unless (onull finalChunk) $ yield finalChunk+ Just t' -> loop (bldr . (t:)) t'+ else yield (mconcat $ bldr [x]) >> loop id (Seq.drop 1 y)+ where+ (x, y) = Seq.break f t+STREAMING(splitOnUnboundedE, splitOnUnboundedEC, splitOnUnboundedES, f)++-- | Convert a stream of arbitrarily-chunked textual data into a stream of data+-- where each chunk represents a single line. Note that, if you have+-- unknown or untrusted input, this function is /unsafe/, since it would allow an+-- attacker to form lines of massive length and exhaust memory.+--+-- Subject to fusion+--+-- @since 1.3.0+linesUnbounded :: (Monad m, Seq.IsSequence seq, Element seq ~ Char)+ => ConduitT seq seq m ()+INLINE_RULE0(linesUnbounded, splitOnUnboundedE (== '\n'))++-- | Same as 'linesUnbounded', but for ASCII/binary data.+--+-- Subject to fusion+--+-- @since 1.3.0+linesUnboundedAscii :: (Monad m, Seq.IsSequence seq, Element seq ~ Word8)+ => ConduitT seq seq m ()+INLINE_RULE0(linesUnboundedAscii, splitOnUnboundedE (== 10))++-- | Incrementally execute builders and pass on the filled chunks as+-- bytestrings.+--+-- @since 1.3.0+builderToByteString :: PrimMonad m => ConduitT Builder S.ByteString m ()+builderToByteString = builderToByteStringWith defaultStrategy+{-# INLINE builderToByteString #-}++-- | Same as 'builderToByteString', but input and output are wrapped in+-- 'Flush'.+--+-- @since 1.3.0+builderToByteStringFlush :: PrimMonad m+ => ConduitT (Flush Builder) (Flush S.ByteString) m ()+builderToByteStringFlush = builderToByteStringWithFlush defaultStrategy+{-# INLINE builderToByteStringFlush #-}++-- | Incrementally execute builders on the given buffer and pass on the filled+-- chunks as bytestrings. Note that, if the given buffer is too small for the+-- execution of a build step, a larger one will be allocated.+--+-- WARNING: This conduit yields bytestrings that are NOT+-- referentially transparent. Their content will be overwritten as soon+-- as control is returned from the inner sink!+--+-- @since 1.3.0+unsafeBuilderToByteString :: PrimMonad m+ => ConduitT Builder S.ByteString m ()+unsafeBuilderToByteString =+ builderToByteStringWith (reuseBufferStrategy (allocBuffer defaultChunkSize))+{-# INLINE unsafeBuilderToByteString #-}+++-- | A conduit that incrementally executes builders and passes on the+-- filled chunks as bytestrings to an inner sink.+--+-- INV: All bytestrings passed to the inner sink are non-empty.+--+-- @since 1.3.0+builderToByteStringWith :: PrimMonad m+ => BufferAllocStrategy+ -> ConduitT Builder S.ByteString m ()+builderToByteStringWith =+ bbhelper (liftM (fmap Chunk) await) yield'+ where+ yield' Flush = return ()+ yield' (Chunk bs) = yield bs+{-# INLINE builderToByteStringWith #-}++-- |+--+-- @since 1.3.0+builderToByteStringWithFlush+ :: PrimMonad m+ => BufferAllocStrategy+ -> ConduitT (Flush Builder) (Flush S.ByteString) m ()+builderToByteStringWithFlush = bbhelper await yield+{-# INLINE builderToByteStringWithFlush #-}++bbhelper+ :: PrimMonad m+ => m (Maybe (Flush Builder))+ -> (Flush S.ByteString -> m ())+ -> BufferAllocStrategy+ -> m ()+bbhelper await' yield' strat = do+ (recv, finish) <- unsafePrimToPrim $ newByteStringBuilderRecv strat+ let loop = await' >>= maybe finish' cont+ finish' = do+ mbs <- unsafePrimToPrim finish+ maybe (return ()) (yield' . Chunk) mbs+ cont fbuilder = do+ let builder =+ case fbuilder of+ Flush -> BB.flush+ Chunk b -> b+ popper <- unsafePrimToPrim $ recv builder+ let cont' = do+ bs <- unsafePrimToPrim popper+ unless (S.null bs) $ do+ yield' (Chunk bs)+ cont'+ cont'+ case fbuilder of+ Flush -> yield' Flush+ Chunk _ -> return ()+ loop+ loop+{-# INLINE bbhelper #-}++-- | Provides a series of @ByteString@s until empty, at which point it provides+-- an empty @ByteString@.+--+-- @since 1.3.0+--+type BuilderPopper = IO S.ByteString++type BuilderRecv = Builder -> IO BuilderPopper++type BuilderFinish = IO (Maybe S.ByteString)++newByteStringBuilderRecv :: BufferAllocStrategy -> IO (BuilderRecv, BuilderFinish)+newByteStringBuilderRecv (ioBufInit, nextBuf) = do+ refBuf <- newIORef ioBufInit+ return (push refBuf, finish refBuf)+ where+ finish refBuf = do+ ioBuf <- readIORef refBuf+ buf <- ioBuf+ return $ unsafeFreezeNonEmptyBuffer buf++ push refBuf builder = do+ refWri <- newIORef $ Left $ BB.runBuilder builder+ return $ popper refBuf refWri++ popper refBuf refWri = do+ ioBuf <- readIORef refBuf+ ebWri <- readIORef refWri+ case ebWri of+ Left bWri -> do+ !buf@(Buffer _ _ op ope) <- ioBuf+ (bytes, next) <- bWri op (ope `minusPtr` op)+ let op' = op `plusPtr` bytes+ case next of+ BB.Done -> do+ writeIORef refBuf $ return $ updateEndOfSlice buf op'+ return S.empty+ BB.More minSize bWri' -> do+ let buf' = updateEndOfSlice buf op'+ {-# INLINE cont #-}+ cont mbs = do+ -- sequencing the computation of the next buffer+ -- construction here ensures that the reference to the+ -- foreign pointer `fp` is lost as soon as possible.+ ioBuf' <- nextBuf minSize buf'+ writeIORef refBuf ioBuf'+ writeIORef refWri $ Left bWri'+ case mbs of+ Just bs | not $ S.null bs -> return bs+ _ -> popper refBuf refWri+ cont $ unsafeFreezeNonEmptyBuffer buf'+ BB.Chunk bs bWri' -> do+ let buf' = updateEndOfSlice buf op'+ let yieldBS = do+ nextBuf 1 buf' >>= writeIORef refBuf+ writeIORef refWri $ Left bWri'+ if S.null bs+ then popper refBuf refWri+ else return bs+ case unsafeFreezeNonEmptyBuffer buf' of+ Nothing -> yieldBS+ Just bs' -> do+ writeIORef refWri $ Right yieldBS+ return bs'+ Right action -> action++-- | A buffer @Buffer fpbuf p0 op ope@ describes a buffer with the underlying+-- byte array @fpbuf..ope@, the currently written slice @p0..op@ and the free+-- space @op..ope@.+--+-- @since 1.3.0+data Buffer = Buffer {-# UNPACK #-} !(ForeignPtr Word8) -- underlying pinned array+ {-# UNPACK #-} !(Ptr Word8) -- beginning of slice+ {-# UNPACK #-} !(Ptr Word8) -- next free byte+ {-# UNPACK #-} !(Ptr Word8) -- first byte after buffer++-- | Convert the buffer to a bytestring. This operation is unsafe in the sense+-- that created bytestring shares the underlying byte array with the buffer.+-- Hence, depending on the later use of this buffer (e.g., if it gets reset and+-- filled again) referential transparency may be lost.+--+-- @since 1.3.0+--+{-# INLINE unsafeFreezeBuffer #-}+unsafeFreezeBuffer :: Buffer -> S.ByteString+unsafeFreezeBuffer (Buffer fpbuf p0 op _) =+ PS fpbuf (p0 `minusPtr` unsafeForeignPtrToPtr fpbuf) (op `minusPtr` p0)++-- | Convert a buffer to a non-empty bytestring. See 'unsafeFreezeBuffer' for+-- the explanation of why this operation may be unsafe.+--+-- @since 1.3.0+--+{-# INLINE unsafeFreezeNonEmptyBuffer #-}+unsafeFreezeNonEmptyBuffer :: Buffer -> Maybe S.ByteString+unsafeFreezeNonEmptyBuffer buf+ | sliceSize buf <= 0 = Nothing+ | otherwise = Just $ unsafeFreezeBuffer buf++-- | Update the end of slice pointer.+--+-- @since 1.3.0+--+{-# INLINE updateEndOfSlice #-}+updateEndOfSlice :: Buffer -- Old buffer+ -> Ptr Word8 -- New end of slice+ -> Buffer -- Updated buffer+updateEndOfSlice (Buffer fpbuf p0 _ ope) op' = Buffer fpbuf p0 op' ope++-- | The size of the written slice in the buffer.+--+-- @since 1.3.0+--+sliceSize :: Buffer -> Int+sliceSize (Buffer _ p0 op _) = op `minusPtr` p0++-- | A buffer allocation strategy @(buf0, nextBuf)@ specifies the initial+-- buffer to use and how to compute a new buffer @nextBuf minSize buf@ with at+-- least size @minSize@ from a filled buffer @buf@. The double nesting of the+-- @IO@ monad helps to ensure that the reference to the filled buffer @buf@ is+-- lost as soon as possible, but the new buffer doesn't have to be allocated+-- too early.+--+-- @since 1.3.0+type BufferAllocStrategy = (IO Buffer, Int -> Buffer -> IO (IO Buffer))++-- | Safe default: allocate new buffers of default chunk size+--+-- @since 1.3.0+defaultStrategy :: BufferAllocStrategy+defaultStrategy = allNewBuffersStrategy defaultChunkSize++-- | The simplest buffer allocation strategy: whenever a buffer is requested,+-- allocate a new one that is big enough for the next build step to execute.+--+-- NOTE that this allocation strategy may spill quite some memory upon direct+-- insertion of a bytestring by the builder. Thats no problem for garbage+-- collection, but it may lead to unreasonably high memory consumption in+-- special circumstances.+--+-- @since 1.3.0+allNewBuffersStrategy :: Int -- Minimal buffer size.+ -> BufferAllocStrategy+allNewBuffersStrategy bufSize =+ ( allocBuffer bufSize+ , \reqSize _ -> return (allocBuffer (max reqSize bufSize)) )++-- | An unsafe, but possibly more efficient buffer allocation strategy:+-- reuse the buffer, if it is big enough for the next build step to execute.+--+-- @since 1.3.0+reuseBufferStrategy :: IO Buffer+ -> BufferAllocStrategy+reuseBufferStrategy buf0 =+ (buf0, tryReuseBuffer)+ where+ tryReuseBuffer reqSize buf+ | bufferSize buf >= reqSize = return $ return (reuseBuffer buf)+ | otherwise = return $ allocBuffer reqSize++-- | The size of the whole byte array underlying the buffer.+--+-- @since 1.3.0+--+bufferSize :: Buffer -> Int+bufferSize (Buffer fpbuf _ _ ope) =+ ope `minusPtr` unsafeForeignPtrToPtr fpbuf++-- | @allocBuffer size@ allocates a new buffer of size @size@.+--+-- @since 1.3.0+--+{-# INLINE allocBuffer #-}+allocBuffer :: Int -> IO Buffer+allocBuffer size = do+ fpbuf <- mallocByteString size+ let !pbuf = unsafeForeignPtrToPtr fpbuf+ return $! Buffer fpbuf pbuf pbuf (pbuf `plusPtr` size)++-- | Resets the beginning of the next slice and the next free byte such that+-- the whole buffer can be filled again.+--+-- @since 1.3.0+--+{-# INLINE reuseBuffer #-}+reuseBuffer :: Buffer -> Buffer+reuseBuffer (Buffer fpbuf _ _ ope) = Buffer fpbuf p0 p0 ope+ where+ p0 = unsafeForeignPtrToPtr fpbuf++-- | Generally speaking, yielding values from inside a Conduit requires+-- some allocation for constructors. This can introduce an overhead,+-- similar to the overhead needed to represent a list of values instead of+-- a vector. This overhead is even more severe when talking about unboxed+-- values.+--+-- This combinator allows you to overcome this overhead, and efficiently+-- fill up vectors. It takes two parameters. The first is the size of each+-- mutable vector to be allocated. The second is a function. The function+-- takes an argument which will yield the next value into a mutable+-- vector.+--+-- Under the surface, this function uses a number of tricks to get high+-- performance. For more information on both usage and implementation,+-- please see:+-- <https://www.schoolofhaskell.com/user/snoyberg/library-documentation/vectorbuilder>+--+-- @since 1.3.0+vectorBuilder :: (PrimMonad m, PrimMonad n, V.Vector v e, PrimState m ~ PrimState n)+ => Int -- ^ size+ -> ((e -> n ()) -> ConduitT i Void m r)+ -> ConduitT i (v e) m r+vectorBuilder size inner = do+ ref <- do+ mv <- VM.new size+ newMutVar $! S 0 mv id+ res <- onAwait (yieldS ref) (inner (addE ref))+ vs <- do+ S idx mv front <- readMutVar ref+ end <-+ if idx == 0+ then return []+ else do+ v <- V.unsafeFreeze mv+ return [V.unsafeTake idx v]+ return $ front end+ Prelude.mapM_ yield vs+ return res+{-# INLINE vectorBuilder #-}++data S s v e = S+ {-# UNPACK #-} !Int -- index+ !(V.Mutable v s e)+ ([v e] -> [v e])++onAwait :: Monad m+ => ConduitT i o m ()+ -> ConduitT i Void m r+ -> ConduitT i o m r+onAwait (ConduitT callback) (ConduitT sink0) = ConduitT $ \rest -> let+ go (Done r) = rest r+ go (HaveOutput _ o) = absurd o+ go (NeedInput f g) = callback $ \() -> NeedInput (go . f) (go . g)+ go (PipeM mp) = PipeM (liftM go mp)+ go (Leftover f i) = Leftover (go f) i+ in go (sink0 Done)+{-# INLINE onAwait #-}++yieldS :: PrimMonad m+ => MutVar (PrimState m) (S (PrimState m) v e)+ -> ConduitT i (v e) m ()+yieldS ref = do+ S idx mv front <- readMutVar ref+ Prelude.mapM_ yield (front [])+ writeMutVar ref $! S idx mv id+{-# INLINE yieldS #-}++addE :: (PrimMonad m, V.Vector v e)+ => MutVar (PrimState m) (S (PrimState m) v e)+ -> e+ -> m ()+addE ref e = do+ S idx mv front <- readMutVar ref+ VM.write mv idx e+ let idx' = succ idx+ size = VM.length mv+ if idx' >= size+ then do+ v <- V.unsafeFreeze mv+ let front' = front . (v:)+ mv' <- VM.new size+ writeMutVar ref $! S 0 mv' front'+ else writeMutVar ref $! S idx' mv front+{-# INLINE addE #-}++-- | Consume a source with a strict accumulator, in a way piecewise defined by+-- a controlling stream. The latter will be evaluated until it terminates.+--+-- >>> let f a s = liftM (:s) $ mapC (*a) =$ CL.take a+-- >>> reverse $ runIdentity $ yieldMany [0..3] $$ mapAccumS f [] (yieldMany [1..])+-- [[],[1],[4,6],[12,15,18]] :: [[Int]]+mapAccumS+ :: Monad m+ => (a -> s -> ConduitT b Void m s)+ -> s+ -> ConduitT () b m ()+ -> ConduitT a Void m s+mapAccumS f s xs = do+ (_, u) <- loop (sealConduitT xs, s)+ return u+ where loop r@(ys, !t) = await >>= maybe (return r) go+ where go a = lift (ys $$++ f a t) >>= loop+{-# INLINE mapAccumS #-}++-- | Run a consuming conduit repeatedly, only stopping when there is no more+-- data available from upstream.+--+-- @since 1.3.0+peekForever :: Monad m => ConduitT i o m () -> ConduitT i o m ()+peekForever inner =+ loop+ where+ loop = do+ mx <- peek+ case mx of+ Nothing -> return ()+ Just _ -> inner >> loop++-- | Run a consuming conduit repeatedly, only stopping when there is no more+-- data available from upstream.+--+-- In contrast to 'peekForever', this function will ignore empty+-- chunks of data. So for example, if a stream of data contains an+-- empty @ByteString@, it is still treated as empty, and the consuming+-- function is not called.+--+-- @since 1.3.0+peekForeverE :: (Monad m, MonoFoldable i)+ => ConduitT i o m ()+ -> ConduitT i o m ()+peekForeverE inner =+ loop+ where+ loop = do+ mx <- peekE+ case mx of+ Nothing -> return ()+ Just _ -> inner >> loop
+ src/Data/Conduit/Combinators/Stream.hs view
@@ -0,0 +1,474 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE ViewPatterns #-}+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE TypeFamilies #-}+-- | These are stream fusion versions of some of the functions in+-- "Data.Conduit.Combinators". Many functions don't have stream+-- versions here because instead they have @RULES@ which inline a+-- definition that fuses.+module Data.Conduit.Combinators.Stream+ ( yieldManyS+ , repeatMS+ , repeatWhileMS+ , foldl1S+ , allS+ , anyS+ , sinkLazyS+ , sinkVectorS+ , sinkVectorNS+ , sinkLazyBuilderS+ , lastS+ , lastES+ , findS+ , concatMapS+ , concatMapMS+ , concatS+ , scanlS+ , scanlMS+ , mapAccumWhileS+ , mapAccumWhileMS+ , intersperseS+ , slidingWindowS+ , filterMS+ , splitOnUnboundedES+ , initReplicateS+ , initRepeatS+ )+ where++-- BEGIN IMPORTS++import Control.Monad (liftM)+import Control.Monad.Primitive (PrimMonad)+import qualified Data.ByteString.Lazy as BL+import Data.ByteString.Builder (Builder, toLazyByteString)+import Data.Conduit.Internal.Fusion+import Data.Conduit.Internal.List.Stream (foldS)+import Data.Maybe (isNothing, isJust)+import Data.MonoTraversable+#if ! MIN_VERSION_base(4,8,0)+import Data.Monoid (Monoid (..))+#endif+import qualified Data.NonNull as NonNull+import qualified Data.Sequences as Seq+import qualified Data.Vector.Generic as V+import qualified Data.Vector.Generic.Mutable as VM+import Prelude++#if MIN_VERSION_mono_traversable(1,0,0)+import Data.Sequences (LazySequence (..))+#else+import Data.Sequences.Lazy+#endif++-- END IMPORTS++yieldManyS :: (Monad m, MonoFoldable mono)+ => mono+ -> StreamProducer m (Element mono)+yieldManyS mono _ =+ Stream (return . step) (return (otoList mono))+ where+ step [] = Stop ()+ step (x:xs) = Emit xs x+{-# INLINE yieldManyS #-}++repeatMS :: Monad m+ => m a+ -> StreamProducer m a+repeatMS m _ =+ Stream step (return ())+ where+ step _ = liftM (Emit ()) m+{-# INLINE repeatMS #-}++repeatWhileMS :: Monad m+ => m a+ -> (a -> Bool)+ -> StreamProducer m a+repeatWhileMS m f _ =+ Stream step (return ())+ where+ step _ = do+ x <- m+ return $ if f x+ then Emit () x+ else Stop ()+{-# INLINE repeatWhileMS #-}++foldl1S :: Monad m+ => (a -> a -> a)+ -> StreamConsumer a m (Maybe a)+foldl1S f (Stream step ms0) =+ Stream step' (liftM (Nothing, ) ms0)+ where+ step' (mprev, s) = do+ res <- step s+ return $ case res of+ Stop () -> Stop mprev+ Skip s' -> Skip (mprev, s')+ Emit s' a -> Skip (Just $ maybe a (`f` a) mprev, s')+{-# INLINE foldl1S #-}++allS :: Monad m+ => (a -> Bool)+ -> StreamConsumer a m Bool+allS f = fmapS isNothing (findS (Prelude.not . f))+{-# INLINE allS #-}++anyS :: Monad m+ => (a -> Bool)+ -> StreamConsumer a m Bool+anyS f = fmapS isJust (findS f)+{-# INLINE anyS #-}++--TODO: use a definition like+-- fmapS (fromChunks . ($ [])) <$> CL.fold (\front next -> front . (next:)) id++sinkLazyS :: (Monad m, LazySequence lazy strict)+ => StreamConsumer strict m lazy+sinkLazyS = fmapS (fromChunks . ($ [])) $ foldS (\front next -> front . (next:)) id+{-# INLINE sinkLazyS #-}++sinkVectorS :: (V.Vector v a, PrimMonad m)+ => StreamConsumer a m (v a)+sinkVectorS (Stream step ms0) = do+ Stream step' $ do+ s0 <- ms0+ mv0 <- VM.new initSize+ return (initSize, 0, mv0, s0)+ where+ initSize = 10+ step' (maxSize, i, mv, s) = do+ res <- step s+ case res of+ Stop () -> liftM (Stop . V.slice 0 i) $ V.unsafeFreeze mv+ Skip s' -> return $ Skip (maxSize, i, mv, s')+ Emit s' x -> do+ VM.write mv i x+ let i' = i + 1+ if i' >= maxSize+ then do+ let newMax = maxSize * 2+ mv' <- VM.grow mv maxSize+ return $ Skip (newMax, i', mv', s')+ else return $ Skip (maxSize, i', mv, s')+{-# INLINE sinkVectorS #-}++sinkVectorNS :: (V.Vector v a, PrimMonad m)+ => Int -- ^ maximum allowed size+ -> StreamConsumer a m (v a)+sinkVectorNS maxSize (Stream step ms0) = do+ Stream step' $ do+ s0 <- ms0+ mv0 <- VM.new maxSize+ return (0, mv0, s0)+ where+ step' (i, mv, _) | i >= maxSize = liftM Stop $ V.unsafeFreeze mv+ step' (i, mv, s) = do+ res <- step s+ case res of+ Stop () -> liftM (Stop . V.slice 0 i) $ V.unsafeFreeze mv+ Skip s' -> return $ Skip (i, mv, s')+ Emit s' x -> do+ VM.write mv i x+ let i' = i + 1+ return $ Skip (i', mv, s')+{-# INLINE sinkVectorNS #-}++sinkLazyBuilderS :: Monad m => StreamConsumer Builder m BL.ByteString+sinkLazyBuilderS = fmapS toLazyByteString (foldS mappend mempty)+{-# INLINE sinkLazyBuilderS #-}++lastS :: Monad m+ => StreamConsumer a m (Maybe a)+lastS (Stream step ms0) =+ Stream step' (liftM (Nothing,) ms0)+ where+ step' (mlast, s) = do+ res <- step s+ return $ case res of+ Stop () -> Stop mlast+ Skip s' -> Skip (mlast, s')+ Emit s' x -> Skip (Just x, s')+{-# INLINE lastS #-}++lastES :: (Monad m, Seq.IsSequence seq)+ => StreamConsumer seq m (Maybe (Element seq))+lastES (Stream step ms0) =+ Stream step' (liftM (Nothing, ) ms0)+ where+ step' (mlast, s) = do+ res <- step s+ return $ case res of+ Stop () -> Stop (fmap NonNull.last mlast)+ Skip s' -> Skip (mlast, s')+ Emit s' (NonNull.fromNullable -> mlast'@(Just _)) -> Skip (mlast', s')+ Emit s' _ -> Skip (mlast, s')+{-# INLINE lastES #-}++findS :: Monad m+ => (a -> Bool) -> StreamConsumer a m (Maybe a)+findS f (Stream step ms0) =+ Stream step' ms0+ where+ step' s = do+ res <- step s+ return $ case res of+ Stop () -> Stop Nothing+ Skip s' -> Skip s'+ Emit s' x ->+ if f x+ then Stop (Just x)+ else Skip s'+{-# INLINE findS #-}++concatMapS :: (Monad m, MonoFoldable mono)+ => (a -> mono)+ -> StreamConduit a m (Element mono)+concatMapS f (Stream step ms0) =+ Stream step' (liftM ([], ) ms0)+ where+ step' ([], s) = do+ res <- step s+ return $ case res of+ Stop () -> Stop ()+ Skip s' -> Skip ([], s')+ Emit s' x -> Skip (otoList (f x), s')+ step' ((x:xs), s) = return (Emit (xs, s) x)+{-# INLINE concatMapS #-}++concatMapMS :: (Monad m, MonoFoldable mono)+ => (a -> m mono)+ -> StreamConduit a m (Element mono)+concatMapMS f (Stream step ms0) =+ Stream step' (liftM ([], ) ms0)+ where+ step' ([], s) = do+ res <- step s+ case res of+ Stop () -> return $ Stop ()+ Skip s' -> return $ Skip ([], s')+ Emit s' x -> do+ o <- f x+ return $ Skip (otoList o, s')+ step' ((x:xs), s) = return (Emit (xs, s) x)+{-# INLINE concatMapMS #-}++concatS :: (Monad m, MonoFoldable mono)+ => StreamConduit mono m (Element mono)+concatS = concatMapS id+{-# INLINE concatS #-}++data ScanState a s+ = ScanEnded+ | ScanContinues a s++scanlS :: Monad m => (a -> b -> a) -> a -> StreamConduit b m a+scanlS f seed0 (Stream step ms0) =+ Stream step' (liftM (ScanContinues seed0) ms0)+ where+ step' ScanEnded = return $ Stop ()+ step' (ScanContinues seed s) = do+ res <- step s+ return $ case res of+ Stop () -> Emit ScanEnded seed+ Skip s' -> Skip (ScanContinues seed s')+ Emit s' x -> Emit (ScanContinues seed' s') seed+ where+ !seed' = f seed x+{-# INLINE scanlS #-}++scanlMS :: Monad m => (a -> b -> m a) -> a -> StreamConduit b m a+scanlMS f seed0 (Stream step ms0) =+ Stream step' (liftM (ScanContinues seed0) ms0)+ where+ step' ScanEnded = return $ Stop ()+ step' (ScanContinues seed s) = do+ res <- step s+ case res of+ Stop () -> return $ Emit ScanEnded seed+ Skip s' -> return $ Skip (ScanContinues seed s')+ Emit s' x -> do+ !seed' <- f seed x+ return $ Emit (ScanContinues seed' s') seed+{-# INLINE scanlMS #-}++mapAccumWhileS :: Monad m =>+ (a -> s -> Either s (s, b)) -> s -> StreamConduitT a b m s+mapAccumWhileS f initial (Stream step ms0) =+ Stream step' (liftM (initial, ) ms0)+ where+ step' (!accum, s) = do+ res <- step s+ return $ case res of+ Stop () -> Stop accum+ Skip s' -> Skip (accum, s')+ Emit s' x -> case f x accum of+ Right (!accum', r) -> Emit (accum', s') r+ Left !accum' -> Stop accum'+{-# INLINE mapAccumWhileS #-}++mapAccumWhileMS :: Monad m =>+ (a -> s -> m (Either s (s, b))) -> s -> StreamConduitT a b m s+mapAccumWhileMS f initial (Stream step ms0) =+ Stream step' (liftM (initial, ) ms0)+ where+ step' (!accum, s) = do+ res <- step s+ case res of+ Stop () -> return $ Stop accum+ Skip s' -> return $ Skip (accum, s')+ Emit s' x -> do+ lr <- f x accum+ return $ case lr of+ Right (!accum', r) -> Emit (accum', s') r+ Left !accum' -> Stop accum'+{-# INLINE mapAccumWhileMS #-}++data IntersperseState a s+ = IFirstValue s+ | IGotValue s a+ | IEmitValue s a++intersperseS :: Monad m => a -> StreamConduit a m a+intersperseS sep (Stream step ms0) =+ Stream step' (liftM IFirstValue ms0)+ where+ step' (IFirstValue s) = do+ res <- step s+ return $ case res of+ Stop () -> Stop ()+ Skip s' -> Skip (IFirstValue s')+ Emit s' x -> Emit (IGotValue s' x) x+ -- Emit the separator once we know it's not the end of the list.+ step' (IGotValue s x) = do+ res <- step s+ return $ case res of+ Stop () -> Stop ()+ Skip s' -> Skip (IGotValue s' x)+ Emit s' x' -> Emit (IEmitValue s' x') sep+ -- We emitted a separator, now emit the value that comes after.+ step' (IEmitValue s x) = return $ Emit (IGotValue s x) x+{-# INLINE intersperseS #-}++data SlidingWindowState seq s+ = SWInitial Int seq s+ | SWSliding seq s+ | SWEarlyExit++slidingWindowS :: (Monad m, Seq.IsSequence seq, Element seq ~ a) => Int -> StreamConduit a m seq+slidingWindowS sz (Stream step ms0) =+ Stream step' (liftM (SWInitial (max 1 sz) mempty) ms0)+ where+ step' (SWInitial n st s) = do+ res <- step s+ return $ case res of+ Stop () -> Emit SWEarlyExit st+ Skip s' -> Skip (SWInitial n st s')+ Emit s' x ->+ if n == 1+ then Emit (SWSliding (Seq.unsafeTail st') s') st'+ else Skip (SWInitial (n - 1) st' s')+ where+ st' = Seq.snoc st x+ -- After collecting the initial window, each upstream element+ -- causes an additional window to be yielded.+ step' (SWSliding st s) = do+ res <- step s+ return $ case res of+ Stop () -> Stop ()+ Skip s' -> Skip (SWSliding st s')+ Emit s' x -> Emit (SWSliding (Seq.unsafeTail st') s') st'+ where+ st' = Seq.snoc st x+ step' SWEarlyExit = return $ Stop ()++{-# INLINE slidingWindowS #-}++filterMS :: Monad m+ => (a -> m Bool)+ -> StreamConduit a m a+filterMS f (Stream step ms0) = do+ Stream step' ms0+ where+ step' s = do+ res <- step s+ case res of+ Stop () -> return $ Stop ()+ Skip s' -> return $ Skip s'+ Emit s' x -> do+ r <- f x+ return $+ if r+ then Emit s' x+ else Skip s'+{-# INLINE filterMS #-}++data SplitState seq s+ = SplitDone+ -- When no element of seq passes the predicate. This allows+ -- 'splitOnUnboundedES' to not run 'Seq.break' multiple times due+ -- to 'Skip's being sent by the upstream.+ | SplitNoSep seq s+ | SplitState seq s++splitOnUnboundedES :: (Monad m, Seq.IsSequence seq)+ => (Element seq -> Bool) -> StreamConduit seq m seq+splitOnUnboundedES f (Stream step ms0) =+ Stream step' (liftM (SplitState mempty) ms0)+ where+ step' SplitDone = return $ Stop ()+ step' (SplitNoSep t s) = do+ res <- step s+ return $ case res of+ Stop () | not (onull t) -> Emit SplitDone t+ | otherwise -> Stop ()+ Skip s' -> Skip (SplitNoSep t s')+ Emit s' t' -> Skip (SplitState (t `mappend` t') s')+ step' (SplitState t s) = do+ if onull y+ then do+ res <- step s+ return $ case res of+ Stop () | not (onull t) -> Emit SplitDone t+ | otherwise -> Stop ()+ Skip s' -> Skip (SplitNoSep t s')+ Emit s' t' -> Skip (SplitState (t `mappend` t') s')+ else return $ Emit (SplitState (Seq.drop 1 y) s) x+ where+ (x, y) = Seq.break f t+{-# INLINE splitOnUnboundedES #-}++-- | Streaming versions of @Data.Conduit.Combinators.Internal.initReplicate@+initReplicateS :: Monad m => m seed -> (seed -> m a) -> Int -> StreamProducer m a+initReplicateS mseed f cnt _ =+ Stream step (liftM (cnt, ) mseed)+ where+ step (ix, _) | ix <= 0 = return $ Stop ()+ step (ix, seed) = do+ x <- f seed+ return $ Emit (ix - 1, seed) x+{-# INLINE initReplicateS #-}++-- | Streaming versions of @Data.Conduit.Combinators.Internal.initRepeat@+initRepeatS :: Monad m => m seed -> (seed -> m a) -> StreamProducer m a+initRepeatS mseed f _ =+ Stream step mseed+ where+ step seed = do+ x <- f seed+ return $ Emit seed x+{-# INLINE initRepeatS #-}++-- | Utility function+fmapS :: Monad m+ => (a -> b)+ -> StreamConduitT i o m a+ -> StreamConduitT i o m b+fmapS f s inp =+ case s inp of+ Stream step ms0 -> Stream (fmap (liftM (fmap f)) step) ms0+{-# INLINE fmapS #-}
+ src/Data/Conduit/Combinators/Unqualified.hs view
@@ -0,0 +1,1206 @@+{-# OPTIONS_HADDOCK not-home #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE NoMonomorphismRestriction #-}+module Data.Conduit.Combinators.Unqualified+ ( -- ** Producers+ -- *** Pure+ CC.yieldMany+ , unfoldC+ , enumFromToC+ , iterateC+ , repeatC+ , replicateC+ , CC.sourceLazy++ -- *** Monadic+ , repeatMC+ , repeatWhileMC+ , replicateMC++ -- *** I\/O+ , CC.sourceFile+ , CC.sourceFileBS+ , CC.sourceHandle+ , CC.sourceHandleUnsafe+ , CC.sourceIOHandle+ , stdinC+ , CC.withSourceFile++ -- *** Filesystem+ , CC.sourceDirectory+ , CC.sourceDirectoryDeep++ -- ** Consumers+ -- *** Pure+ , dropC+ , dropCE+ , dropWhileC+ , dropWhileCE+ , foldC+ , foldCE+ , foldlC+ , foldlCE+ , foldMapC+ , foldMapCE+ , allC+ , allCE+ , anyC+ , anyCE+ , andC+ , andCE+ , orC+ , orCE+ , asumC+ , elemC+ , elemCE+ , notElemC+ , notElemCE+ , CC.sinkLazy+ , CC.sinkList+ , CC.sinkVector+ , CC.sinkVectorN+ , CC.sinkLazyBuilder+ , CC.sinkNull+ , CC.awaitNonNull+ , headC+ , headDefC+ , headCE+ , peekC+ , peekCE+ , lastC+ , lastDefC+ , lastCE+ , lengthC+ , lengthCE+ , lengthIfC+ , lengthIfCE+ , maximumC+ , maximumCE+ , minimumC+ , minimumCE+ , nullC+ , nullCE+ , sumC+ , sumCE+ , productC+ , productCE+ , findC++ -- *** Monadic+ , mapM_C+ , mapM_CE+ , foldMC+ , foldMCE+ , foldMapMC+ , foldMapMCE++ -- *** I\/O+ , CC.sinkFile+ , CC.sinkFileCautious+ , CC.sinkTempFile+ , CC.sinkSystemTempFile+ , CC.sinkFileBS+ , CC.sinkHandle+ , CC.sinkIOHandle+ , printC+ , stdoutC+ , stderrC+ , CC.withSinkFile+ , CC.withSinkFileBuilder+ , CC.withSinkFileCautious+ , CC.sinkHandleBuilder+ , CC.sinkHandleFlush++ -- ** Transformers+ -- *** Pure+ , mapC+ , mapCE+ , omapCE+ , concatMapC+ , concatMapCE+ , takeC+ , takeCE+ , takeWhileC+ , takeWhileCE+ , takeExactlyC+ , takeExactlyCE+ , concatC+ , filterC+ , filterCE+ , mapWhileC+ , conduitVector+ , scanlC+ , mapAccumWhileC+ , concatMapAccumC+ , intersperseC+ , slidingWindowC+ , chunksOfCE+ , chunksOfExactlyCE++ -- *** Monadic+ , mapMC+ , mapMCE+ , omapMCE+ , concatMapMC+ , filterMC+ , filterMCE+ , iterMC+ , scanlMC+ , mapAccumWhileMC+ , concatMapAccumMC++ -- *** Textual+ , encodeUtf8C+ , decodeUtf8C+ , decodeUtf8LenientC+ , lineC+ , lineAsciiC+ , unlinesC+ , unlinesAsciiC+ , linesUnboundedC+ , linesUnboundedAsciiC++ -- ** Builders+ , CC.builderToByteString+ , CC.unsafeBuilderToByteString+ , CC.builderToByteStringWith+ , CC.builderToByteStringFlush+ , CC.builderToByteStringWithFlush+ , CC.BufferAllocStrategy+ , CC.allNewBuffersStrategy+ , CC.reuseBufferStrategy++ -- ** Special+ , vectorBuilderC+ , CC.mapAccumS+ , CC.peekForever+ , CC.peekForeverE+ ) where++-- BEGIN IMPORTS++import qualified Data.Conduit.Combinators as CC+-- BEGIN IMPORTS++import qualified Data.Traversable+import Control.Applicative (Alternative)+import Control.Monad.IO.Class (MonadIO (..))+import Control.Monad.Primitive (PrimMonad, PrimState)+import Control.Monad.Trans.Resource (MonadThrow)+import Data.Conduit+import Data.Monoid (Monoid (..))+import Data.MonoTraversable+import qualified Data.Sequences as Seq+import qualified Data.Vector.Generic as V+import Prelude (Bool (..), Eq (..), Int,+ Maybe (..), Monad (..), Num (..),+ Ord (..), Functor (..), Either (..),+ Enum, Show, Char)+import Data.Word (Word8)+import Data.ByteString (ByteString)+import Data.Text (Text)++import qualified Data.Sequences as DTE+++-- END IMPORTS++-- | Generate a producer from a seed value.+--+-- @since 1.3.0+unfoldC :: Monad m+ => (b -> Maybe (a, b))+ -> b+ -> ConduitT i a m ()+unfoldC = CC.unfold+{-# INLINE unfoldC #-}++-- | Enumerate from a value to a final value, inclusive, via 'succ'.+--+-- This is generally more efficient than using @Prelude@\'s @enumFromTo@ and+-- combining with @sourceList@ since this avoids any intermediate data+-- structures.+--+-- @since 1.3.0+enumFromToC :: (Monad m, Enum a, Ord a) => a -> a -> ConduitT i a m ()+enumFromToC = CC.enumFromTo+{-# INLINE enumFromToC #-}++-- | Produces an infinite stream of repeated applications of f to x.+--+-- @since 1.3.0+iterateC :: Monad m => (a -> a) -> a -> ConduitT i a m ()+iterateC = CC.iterate+{-# INLINE iterateC #-}++-- | Produce an infinite stream consisting entirely of the given value.+--+-- @since 1.3.0+repeatC :: Monad m => a -> ConduitT i a m ()+repeatC = CC.repeat+{-# INLINE repeatC #-}++-- | Produce a finite stream consisting of n copies of the given value.+--+-- @since 1.3.0+replicateC :: Monad m+ => Int+ -> a+ -> ConduitT i a m ()+replicateC = CC.replicate+{-# INLINE replicateC #-}++-- | Repeatedly run the given action and yield all values it produces.+--+-- @since 1.3.0+repeatMC :: Monad m+ => m a+ -> ConduitT i a m ()+repeatMC = CC.repeatM+{-# INLINE repeatMC #-}++-- | Repeatedly run the given action and yield all values it produces, until+-- the provided predicate returns @False@.+--+-- @since 1.3.0+repeatWhileMC :: Monad m+ => m a+ -> (a -> Bool)+ -> ConduitT i a m ()+repeatWhileMC = CC.repeatWhileM+{-# INLINE repeatWhileMC #-}++-- | Perform the given action n times, yielding each result.+--+-- @since 1.3.0+replicateMC :: Monad m+ => Int+ -> m a+ -> ConduitT i a m ()+replicateMC = CC.replicateM+{-# INLINE replicateMC #-}++-- | @sourceHandle@ applied to @stdin@.+--+-- @since 1.3.0+stdinC :: MonadIO m => ConduitT i ByteString m ()+stdinC = CC.stdin+{-# INLINE stdinC #-}++-- | Ignore a certain number of values in the stream.+--+-- Note: since this function doesn't produce anything, you probably want to+-- use it with ('>>') instead of directly plugging it into a pipeline:+--+-- >>> runConduit $ yieldMany [1..5] .| dropC 2 .| sinkList+-- []+-- >>> runConduit $ yieldMany [1..5] .| (dropC 2 >> sinkList)+-- [3,4,5]+--+-- @since 1.3.0+dropC :: Monad m+ => Int+ -> ConduitT a o m ()+dropC = CC.drop+{-# INLINE dropC #-}++-- | Drop a certain number of elements from a chunked stream.+--+-- Note: you likely want to use it with monadic composition. See the docs+-- for 'dropC'.+--+-- @since 1.3.0+dropCE :: (Monad m, Seq.IsSequence seq)+ => Seq.Index seq+ -> ConduitT seq o m ()+dropCE = CC.dropE+{-# INLINE dropCE #-}++-- | Drop all values which match the given predicate.+--+-- Note: you likely want to use it with monadic composition. See the docs+-- for 'dropC'.+--+-- @since 1.3.0+dropWhileC :: Monad m+ => (a -> Bool)+ -> ConduitT a o m ()+dropWhileC = CC.dropWhile+{-# INLINE dropWhileC #-}++-- | Drop all elements in the chunked stream which match the given predicate.+--+-- Note: you likely want to use it with monadic composition. See the docs+-- for 'dropC'.+--+-- @since 1.3.0+dropWhileCE :: (Monad m, Seq.IsSequence seq)+ => (Element seq -> Bool)+ -> ConduitT seq o m ()+dropWhileCE = CC.dropWhileE+{-# INLINE dropWhileCE #-}++-- | Monoidally combine all values in the stream.+--+-- @since 1.3.0+foldC :: (Monad m, Monoid a)+ => ConduitT a o m a+foldC = CC.fold+{-# INLINE foldC #-}++-- | Monoidally combine all elements in the chunked stream.+--+-- @since 1.3.0+foldCE :: (Monad m, MonoFoldable mono, Monoid (Element mono))+ => ConduitT mono o m (Element mono)+foldCE = CC.foldE+{-# INLINE foldCE #-}++-- | A strict left fold.+--+-- @since 1.3.0+foldlC :: Monad m => (a -> b -> a) -> a -> ConduitT b o m a+foldlC = CC.foldl+{-# INLINE foldlC #-}++-- | A strict left fold on a chunked stream.+--+-- @since 1.3.0+foldlCE :: (Monad m, MonoFoldable mono)+ => (a -> Element mono -> a)+ -> a+ -> ConduitT mono o m a+foldlCE = CC.foldlE+{-# INLINE foldlCE #-}++-- | Apply the provided mapping function and monoidal combine all values.+--+-- @since 1.3.0+foldMapC :: (Monad m, Monoid b)+ => (a -> b)+ -> ConduitT a o m b+foldMapC = CC.foldMap+{-# INLINE foldMapC #-}++-- | Apply the provided mapping function and monoidal combine all elements of the chunked stream.+--+-- @since 1.3.0+foldMapCE :: (Monad m, MonoFoldable mono, Monoid w)+ => (Element mono -> w)+ -> ConduitT mono o m w+foldMapCE = CC.foldMapE+{-# INLINE foldMapCE #-}++-- | Check that all values in the stream return True.+--+-- Subject to shortcut logic: at the first False, consumption of the stream+-- will stop.+--+-- @since 1.3.0+allC :: Monad m+ => (a -> Bool)+ -> ConduitT a o m Bool+allC = CC.all+{-# INLINE allC #-}++-- | Check that all elements in the chunked stream return True.+--+-- Subject to shortcut logic: at the first False, consumption of the stream+-- will stop.+--+-- @since 1.3.0+allCE :: (Monad m, MonoFoldable mono)+ => (Element mono -> Bool)+ -> ConduitT mono o m Bool+allCE = CC.allE+{-# INLINE allCE #-}++-- | Check that at least one value in the stream returns True.+--+-- Subject to shortcut logic: at the first True, consumption of the stream+-- will stop.+--+-- @since 1.3.0+anyC :: Monad m+ => (a -> Bool)+ -> ConduitT a o m Bool+anyC = CC.any+{-# INLINE anyC #-}++-- | Check that at least one element in the chunked stream returns True.+--+-- Subject to shortcut logic: at the first True, consumption of the stream+-- will stop.+--+-- @since 1.3.0+anyCE :: (Monad m, MonoFoldable mono)+ => (Element mono -> Bool)+ -> ConduitT mono o m Bool+anyCE = CC.anyE+{-# INLINE anyCE #-}++-- | Are all values in the stream True?+--+-- Consumption stops once the first False is encountered.+--+-- @since 1.3.0+andC :: Monad m => ConduitT Bool o m Bool+andC = CC.and+{-# INLINE andC #-}++-- | Are all elements in the chunked stream True?+--+-- Consumption stops once the first False is encountered.+--+-- @since 1.3.0+andCE :: (Monad m, MonoFoldable mono, Element mono ~ Bool)+ => ConduitT mono o m Bool+andCE = CC.andE+{-# INLINE andCE #-}++-- | Are any values in the stream True?+--+-- Consumption stops once the first True is encountered.+--+-- @since 1.3.0+orC :: Monad m => ConduitT Bool o m Bool+orC = CC.or+{-# INLINE orC #-}++-- | Are any elements in the chunked stream True?+--+-- Consumption stops once the first True is encountered.+--+-- @since 1.3.0+orCE :: (Monad m, MonoFoldable mono, Element mono ~ Bool)+ => ConduitT mono o m Bool+orCE = CC.orE+{-# INLINE orCE #-}++-- | 'Alternative'ly combine all values in the stream.+--+-- @since 1.3.0+asumC :: (Monad m, Alternative f) => ConduitT (f a) o m (f a)+asumC = CC.asum++-- | Are any values in the stream equal to the given value?+--+-- Stops consuming as soon as a match is found.+--+-- @since 1.3.0+elemC :: (Monad m, Eq a) => a -> ConduitT a o m Bool+elemC = CC.elem+{-# INLINE elemC #-}++-- | Are any elements in the chunked stream equal to the given element?+--+-- Stops consuming as soon as a match is found.+--+-- @since 1.3.0+#if MIN_VERSION_mono_traversable(1,0,0)+elemCE :: (Monad m, Seq.IsSequence seq, Eq (Element seq))+#else+elemCE :: (Monad m, Seq.EqSequence seq)+#endif+ => Element seq+ -> ConduitT seq o m Bool+elemCE = CC.elemE+{-# INLINE elemCE #-}++-- | Are no values in the stream equal to the given value?+--+-- Stops consuming as soon as a match is found.+--+-- @since 1.3.0+notElemC :: (Monad m, Eq a) => a -> ConduitT a o m Bool+notElemC = CC.notElem+{-# INLINE notElemC #-}++-- | Are no elements in the chunked stream equal to the given element?+--+-- Stops consuming as soon as a match is found.+--+-- @since 1.3.0+#if MIN_VERSION_mono_traversable(1,0,0)+notElemCE :: (Monad m, Seq.IsSequence seq, Eq (Element seq))+#else+notElemCE :: (Monad m, Seq.EqSequence seq)+#endif+ => Element seq+ -> ConduitT seq o m Bool+notElemCE = CC.notElemE+{-# INLINE notElemCE #-}++-- | Take a single value from the stream, if available.+--+-- @since 1.3.0+headC :: Monad m => ConduitT a o m (Maybe a)+headC = CC.head++-- | Same as 'headC', but returns a default value if none are available from the stream.+--+-- @since 1.3.0+headDefC :: Monad m => a -> ConduitT a o m a+headDefC = CC.headDef++-- | Get the next element in the chunked stream.+--+-- @since 1.3.0+headCE :: (Monad m, Seq.IsSequence seq) => ConduitT seq o m (Maybe (Element seq))+headCE = CC.headE+{-# INLINE headCE #-}++-- | View the next value in the stream without consuming it.+--+-- @since 1.3.0+peekC :: Monad m => ConduitT a o m (Maybe a)+peekC = CC.peek+{-# INLINE peekC #-}++-- | View the next element in the chunked stream without consuming it.+--+-- @since 1.3.0+peekCE :: (Monad m, MonoFoldable mono) => ConduitT mono o m (Maybe (Element mono))+peekCE = CC.peekE+{-# INLINE peekCE #-}++-- | Retrieve the last value in the stream, if present.+--+-- @since 1.3.0+lastC :: Monad m => ConduitT a o m (Maybe a)+lastC = CC.last+{-# INLINE lastC #-}++-- | Same as 'lastC', but returns a default value if none are available from the stream.+--+-- @since 1.3.0+lastDefC :: Monad m => a -> ConduitT a o m a+lastDefC = CC.lastDef++-- | Retrieve the last element in the chunked stream, if present.+--+-- @since 1.3.0+lastCE :: (Monad m, Seq.IsSequence seq) => ConduitT seq o m (Maybe (Element seq))+lastCE = CC.lastE+{-# INLINE lastCE #-}++-- | Count how many values are in the stream.+--+-- @since 1.3.0+lengthC :: (Monad m, Num len) => ConduitT a o m len+lengthC = CC.length+{-# INLINE lengthC #-}++-- | Count how many elements are in the chunked stream.+--+-- @since 1.3.0+lengthCE :: (Monad m, Num len, MonoFoldable mono) => ConduitT mono o m len+lengthCE = CC.lengthE+{-# INLINE lengthCE #-}++-- | Count how many values in the stream pass the given predicate.+--+-- @since 1.3.0+lengthIfC :: (Monad m, Num len) => (a -> Bool) -> ConduitT a o m len+lengthIfC = CC.lengthIf+{-# INLINE lengthIfC #-}++-- | Count how many elements in the chunked stream pass the given predicate.+--+-- @since 1.3.0+lengthIfCE :: (Monad m, Num len, MonoFoldable mono)+ => (Element mono -> Bool) -> ConduitT mono o m len+lengthIfCE = CC.lengthIfE+{-# INLINE lengthIfCE #-}++-- | Get the largest value in the stream, if present.+--+-- @since 1.3.0+maximumC :: (Monad m, Ord a) => ConduitT a o m (Maybe a)+maximumC = CC.maximum+{-# INLINE maximumC #-}++-- | Get the largest element in the chunked stream, if present.+--+-- @since 1.3.0+#if MIN_VERSION_mono_traversable(1,0,0)+maximumCE :: (Monad m, Seq.IsSequence seq, Ord (Element seq)) => ConduitT seq o m (Maybe (Element seq))+#else+maximumCE :: (Monad m, Seq.OrdSequence seq) => ConduitT seq o m (Maybe (Element seq))+#endif+maximumCE = CC.maximumE+{-# INLINE maximumCE #-}++-- | Get the smallest value in the stream, if present.+--+-- @since 1.3.0+minimumC :: (Monad m, Ord a) => ConduitT a o m (Maybe a)+minimumC = CC.minimum+{-# INLINE minimumC #-}++-- | Get the smallest element in the chunked stream, if present.+--+-- @since 1.3.0+#if MIN_VERSION_mono_traversable(1,0,0)+minimumCE :: (Monad m, Seq.IsSequence seq, Ord (Element seq)) => ConduitT seq o m (Maybe (Element seq))+#else+minimumCE :: (Monad m, Seq.OrdSequence seq) => ConduitT seq o m (Maybe (Element seq))+#endif+minimumCE = CC.minimumE+{-# INLINE minimumCE #-}++-- | True if there are no values in the stream.+--+-- This function does not modify the stream.+--+-- @since 1.3.0+nullC :: Monad m => ConduitT a o m Bool+nullC = CC.null+{-# INLINE nullC #-}++-- | True if there are no elements in the chunked stream.+--+-- This function may remove empty leading chunks from the stream, but otherwise+-- will not modify it.+--+-- @since 1.3.0+nullCE :: (Monad m, MonoFoldable mono)+ => ConduitT mono o m Bool+nullCE = CC.nullE+{-# INLINE nullCE #-}++-- | Get the sum of all values in the stream.+--+-- @since 1.3.0+sumC :: (Monad m, Num a) => ConduitT a o m a+sumC = CC.sum+{-# INLINE sumC #-}++-- | Get the sum of all elements in the chunked stream.+--+-- @since 1.3.0+sumCE :: (Monad m, MonoFoldable mono, Num (Element mono)) => ConduitT mono o m (Element mono)+sumCE = CC.sumE+{-# INLINE sumCE #-}++-- | Get the product of all values in the stream.+--+-- @since 1.3.0+productC :: (Monad m, Num a) => ConduitT a o m a+productC = CC.product+{-# INLINE productC #-}++-- | Get the product of all elements in the chunked stream.+--+-- @since 1.3.0+productCE :: (Monad m, MonoFoldable mono, Num (Element mono)) => ConduitT mono o m (Element mono)+productCE = CC.productE+{-# INLINE productCE #-}++-- | Find the first matching value.+--+-- @since 1.3.0+findC :: Monad m => (a -> Bool) -> ConduitT a o m (Maybe a)+findC = CC.find+{-# INLINE findC #-}++-- | Apply the action to all values in the stream.+--+-- Note: if you want to /pass/ the values instead of /consuming/ them, use+-- 'iterM' instead.+--+-- @since 1.3.0+mapM_C :: Monad m => (a -> m ()) -> ConduitT a o m ()+mapM_C = CC.mapM_+{-# INLINE mapM_C #-}++-- | Apply the action to all elements in the chunked stream.+--+-- Note: the same caveat as with 'mapM_C' applies. If you don't want to+-- consume the values, you can use 'iterM':+--+-- > iterM (omapM_ f)+--+-- @since 1.3.0+mapM_CE :: (Monad m, MonoFoldable mono) => (Element mono -> m ()) -> ConduitT mono o m ()+mapM_CE = CC.mapM_E+{-# INLINE mapM_CE #-}++-- | A monadic strict left fold.+--+-- @since 1.3.0+foldMC :: Monad m => (a -> b -> m a) -> a -> ConduitT b o m a+foldMC = CC.foldM+{-# INLINE foldMC #-}++-- | A monadic strict left fold on a chunked stream.+--+-- @since 1.3.0+foldMCE :: (Monad m, MonoFoldable mono)+ => (a -> Element mono -> m a)+ -> a+ -> ConduitT mono o m a+foldMCE = CC.foldME+{-# INLINE foldMCE #-}++-- | Apply the provided monadic mapping function and monoidal combine all values.+--+-- @since 1.3.0+foldMapMC :: (Monad m, Monoid w) => (a -> m w) -> ConduitT a o m w+foldMapMC = CC.foldMapM+{-# INLINE foldMapMC #-}++-- | Apply the provided monadic mapping function and monoidal combine all+-- elements in the chunked stream.+--+-- @since 1.3.0+foldMapMCE :: (Monad m, MonoFoldable mono, Monoid w)+ => (Element mono -> m w)+ -> ConduitT mono o m w+foldMapMCE = CC.foldMapME+{-# INLINE foldMapMCE #-}++-- | Print all incoming values to stdout.+--+-- @since 1.3.0+printC :: (Show a, MonadIO m) => ConduitT a o m ()+printC = CC.print+{-# INLINE printC #-}++-- | @sinkHandle@ applied to @stdout@.+--+-- @since 1.3.0+stdoutC :: MonadIO m => ConduitT ByteString o m ()+stdoutC = CC.stdout+{-# INLINE stdoutC #-}++-- | @sinkHandle@ applied to @stderr@.+--+-- @since 1.3.0+stderrC :: MonadIO m => ConduitT ByteString o m ()+stderrC = CC.stderr+{-# INLINE stderrC #-}++-- | Apply a transformation to all values in a stream.+--+-- @since 1.3.0+mapC :: Monad m => (a -> b) -> ConduitT a b m ()+mapC = CC.map+{-# INLINE mapC #-}++-- | Apply a transformation to all elements in a chunked stream.+--+-- @since 1.3.0+mapCE :: (Monad m, Functor f) => (a -> b) -> ConduitT (f a) (f b) m ()+mapCE = CC.mapE+{-# INLINE mapCE #-}++-- | Apply a monomorphic transformation to all elements in a chunked stream.+--+-- Unlike @mapE@, this will work on types like @ByteString@ and @Text@ which+-- are @MonoFunctor@ but not @Functor@.+--+-- @since 1.3.0+omapCE :: (Monad m, MonoFunctor mono) => (Element mono -> Element mono) -> ConduitT mono mono m ()+omapCE = CC.omapE+{-# INLINE omapCE #-}++-- | Apply the function to each value in the stream, resulting in a foldable+-- value (e.g., a list). Then yield each of the individual values in that+-- foldable value separately.+--+-- Generalizes concatMap, mapMaybe, and mapFoldable.+--+-- @since 1.3.0+concatMapC :: (Monad m, MonoFoldable mono)+ => (a -> mono)+ -> ConduitT a (Element mono) m ()+concatMapC = CC.concatMap+{-# INLINE concatMapC #-}++-- | Apply the function to each element in the chunked stream, resulting in a+-- foldable value (e.g., a list). Then yield each of the individual values in+-- that foldable value separately.+--+-- Generalizes concatMap, mapMaybe, and mapFoldable.+--+-- @since 1.3.0+concatMapCE :: (Monad m, MonoFoldable mono, Monoid w)+ => (Element mono -> w)+ -> ConduitT mono w m ()+concatMapCE = CC.concatMapE+{-# INLINE concatMapCE #-}++-- | Stream up to n number of values downstream.+--+-- Note that, if downstream terminates early, not all values will be consumed.+-- If you want to force /exactly/ the given number of values to be consumed,+-- see 'takeExactly'.+--+-- @since 1.3.0+takeC :: Monad m => Int -> ConduitT a a m ()+takeC = CC.take+{-# INLINE takeC #-}++-- | Stream up to n number of elements downstream in a chunked stream.+--+-- Note that, if downstream terminates early, not all values will be consumed.+-- If you want to force /exactly/ the given number of values to be consumed,+-- see 'takeExactlyE'.+--+-- @since 1.3.0+takeCE :: (Monad m, Seq.IsSequence seq)+ => Seq.Index seq+ -> ConduitT seq seq m ()+takeCE = CC.takeE+{-# INLINE takeCE #-}++-- | Stream all values downstream that match the given predicate.+--+-- Same caveats regarding downstream termination apply as with 'take'.+--+-- @since 1.3.0+takeWhileC :: Monad m+ => (a -> Bool)+ -> ConduitT a a m ()+takeWhileC = CC.takeWhile+{-# INLINE takeWhileC #-}++-- | Stream all elements downstream that match the given predicate in a chunked stream.+--+-- Same caveats regarding downstream termination apply as with 'takeE'.+--+-- @since 1.3.0+takeWhileCE :: (Monad m, Seq.IsSequence seq)+ => (Element seq -> Bool)+ -> ConduitT seq seq m ()+takeWhileCE = CC.takeWhileE+{-# INLINE takeWhileCE #-}++-- | Consume precisely the given number of values and feed them downstream.+--+-- This function is in contrast to 'take', which will only consume up to the+-- given number of values, and will terminate early if downstream terminates+-- early. This function will discard any additional values in the stream if+-- they are unconsumed.+--+-- Note that this function takes a downstream @ConduitT@ as a parameter, as+-- opposed to working with normal fusion. For more information, see+-- <http://www.yesodweb.com/blog/2013/10/core-flaw-pipes-conduit>, the section+-- titled \"pipes and conduit: isolate\".+--+-- @since 1.3.0+takeExactlyC :: Monad m+ => Int+ -> ConduitT a b m r+ -> ConduitT a b m r+takeExactlyC = CC.takeExactly+{-# INLINE takeExactlyC #-}++-- | Same as 'takeExactly', but for chunked streams.+--+-- @since 1.3.0+takeExactlyCE :: (Monad m, Seq.IsSequence a)+ => Seq.Index a+ -> ConduitT a b m r+ -> ConduitT a b m r+takeExactlyCE = CC.takeExactlyE+{-# INLINE takeExactlyCE #-}++-- | Flatten out a stream by yielding the values contained in an incoming+-- @MonoFoldable@ as individually yielded values.+--+-- @since 1.3.0+concatC :: (Monad m, MonoFoldable mono)+ => ConduitT mono (Element mono) m ()+concatC = CC.concat+{-# INLINE concatC #-}++-- | Keep only values in the stream passing a given predicate.+--+-- @since 1.3.0+filterC :: Monad m => (a -> Bool) -> ConduitT a a m ()+filterC = CC.filter+{-# INLINE filterC #-}++-- | Keep only elements in the chunked stream passing a given predicate.+--+-- @since 1.3.0+filterCE :: (Seq.IsSequence seq, Monad m) => (Element seq -> Bool) -> ConduitT seq seq m ()+filterCE = CC.filterE+{-# INLINE filterCE #-}++-- | Map values as long as the result is @Just@.+--+-- @since 1.3.0+mapWhileC :: Monad m => (a -> Maybe b) -> ConduitT a b m ()+mapWhileC = CC.mapWhile+{-# INLINE mapWhileC #-}++-- | Break up a stream of values into vectors of size n. The final vector may+-- be smaller than n if the total number of values is not a strict multiple of+-- n. No empty vectors will be yielded.+--+-- @since 1.3.0+conduitVector :: (V.Vector v a, PrimMonad m)+ => Int -- ^ maximum allowed size+ -> ConduitT a (v a) m ()+conduitVector = CC.conduitVector+{-# INLINE conduitVector #-}++-- | Analog of 'Prelude.scanl' for lists.+--+-- @since 1.3.0+scanlC :: Monad m => (a -> b -> a) -> a -> ConduitT b a m ()+scanlC = CC.scanl+{-# INLINE scanlC #-}++-- | 'mapWhileC' with a break condition dependent on a strict accumulator.+-- Equivalently, 'CL.mapAccum' as long as the result is @Right@. Instead of+-- producing a leftover, the breaking input determines the resulting+-- accumulator via @Left@.+mapAccumWhileC :: Monad m =>+ (a -> s -> Either s (s, b)) -> s -> ConduitT a b m s+mapAccumWhileC = CC.mapAccumWhile+{-# INLINE mapAccumWhileC #-}++-- | 'concatMap' with an accumulator.+--+-- @since 1.3.0+concatMapAccumC :: Monad m => (a -> accum -> (accum, [b])) -> accum -> ConduitT a b m ()+concatMapAccumC = CC.concatMapAccum+{-# INLINE concatMapAccumC #-}++-- | Insert the given value between each two values in the stream.+--+-- @since 1.3.0+intersperseC :: Monad m => a -> ConduitT a a m ()+intersperseC = CC.intersperse+{-# INLINE intersperseC #-}++-- | Sliding window of values+-- 1,2,3,4,5 with window size 2 gives+-- [1,2],[2,3],[3,4],[4,5]+--+-- Best used with structures that support O(1) snoc.+--+-- @since 1.3.0+slidingWindowC :: (Monad m, Seq.IsSequence seq, Element seq ~ a) => Int -> ConduitT a seq m ()+slidingWindowC = CC.slidingWindow+{-# INLINE slidingWindowC #-}+++-- | Split input into chunk of size 'chunkSize'+--+-- The last element may be smaller than the 'chunkSize' (see also+-- 'chunksOfExactlyE' which will not yield this last element)+--+-- @since 1.3.0+chunksOfCE :: (Monad m, Seq.IsSequence seq) => Seq.Index seq -> ConduitT seq seq m ()+chunksOfCE = CC.chunksOfE+{-# INLINE chunksOfCE #-}++-- | Split input into chunk of size 'chunkSize'+--+-- If the input does not split into chunks exactly, the remainder will be+-- leftover (see also 'chunksOfE')+--+-- @since 1.3.0+chunksOfExactlyCE :: (Monad m, Seq.IsSequence seq) => Seq.Index seq -> ConduitT seq seq m ()+chunksOfExactlyCE = CC.chunksOfExactlyE+{-# INLINE chunksOfExactlyCE #-}++-- | Apply a monadic transformation to all values in a stream.+--+-- If you do not need the transformed values, and instead just want the monadic+-- side-effects of running the action, see 'mapM_'.+--+-- @since 1.3.0+mapMC :: Monad m => (a -> m b) -> ConduitT a b m ()+mapMC = CC.mapM+{-# INLINE mapMC #-}++-- | Apply a monadic transformation to all elements in a chunked stream.+--+-- @since 1.3.0+mapMCE :: (Monad m, Data.Traversable.Traversable f) => (a -> m b) -> ConduitT (f a) (f b) m ()+mapMCE = CC.mapME+{-# INLINE mapMCE #-}++-- | Apply a monadic monomorphic transformation to all elements in a chunked stream.+--+-- Unlike @mapME@, this will work on types like @ByteString@ and @Text@ which+-- are @MonoFunctor@ but not @Functor@.+--+-- @since 1.3.0+omapMCE :: (Monad m, MonoTraversable mono)+ => (Element mono -> m (Element mono))+ -> ConduitT mono mono m ()+omapMCE = CC.omapME+{-# INLINE omapMCE #-}++-- | Apply the monadic function to each value in the stream, resulting in a+-- foldable value (e.g., a list). Then yield each of the individual values in+-- that foldable value separately.+--+-- Generalizes concatMapM, mapMaybeM, and mapFoldableM.+--+-- @since 1.3.0+concatMapMC :: (Monad m, MonoFoldable mono)+ => (a -> m mono)+ -> ConduitT a (Element mono) m ()+concatMapMC = CC.concatMapM+{-# INLINE concatMapMC #-}++-- | Keep only values in the stream passing a given monadic predicate.+--+-- @since 1.3.0+filterMC :: Monad m+ => (a -> m Bool)+ -> ConduitT a a m ()+filterMC = CC.filterM+{-# INLINE filterMC #-}++-- | Keep only elements in the chunked stream passing a given monadic predicate.+--+-- @since 1.3.0+filterMCE :: (Monad m, Seq.IsSequence seq) => (Element seq -> m Bool) -> ConduitT seq seq m ()+filterMCE = CC.filterME+{-# INLINE filterMCE #-}++-- | Apply a monadic action on all values in a stream.+--+-- This @Conduit@ can be used to perform a monadic side-effect for every+-- value, whilst passing the value through the @Conduit@ as-is.+--+-- > iterM f = mapM (\a -> f a >>= \() -> return a)+--+-- @since 1.3.0+iterMC :: Monad m => (a -> m ()) -> ConduitT a a m ()+iterMC = CC.iterM+{-# INLINE iterMC #-}++-- | Analog of 'Prelude.scanl' for lists, monadic.+--+-- @since 1.3.0+scanlMC :: Monad m => (a -> b -> m a) -> a -> ConduitT b a m ()+scanlMC = CC.scanlM+{-# INLINE scanlMC #-}++-- | Monadic `mapAccumWhileC`.+mapAccumWhileMC :: Monad m => (a -> s -> m (Either s (s, b))) -> s -> ConduitT a b m s+mapAccumWhileMC = CC.mapAccumWhileM+{-# INLINE mapAccumWhileMC #-}++-- | 'concatMapM' with an accumulator.+--+-- @since 1.3.0+concatMapAccumMC :: Monad m => (a -> accum -> m (accum, [b])) -> accum -> ConduitT a b m ()+concatMapAccumMC = CC.concatMapAccumM+{-# INLINE concatMapAccumMC #-}++-- | Encode a stream of text as UTF8.+--+-- @since 1.3.0+encodeUtf8C :: (Monad m, DTE.Utf8 text binary) => ConduitT text binary m ()+encodeUtf8C = CC.encodeUtf8+{-# INLINE encodeUtf8C #-}++-- | Decode a stream of binary data as UTF8.+--+-- @since 1.3.0+decodeUtf8C :: MonadThrow m => ConduitT ByteString Text m ()+decodeUtf8C = CC.decodeUtf8+{-# INLINE decodeUtf8C #-}++-- | Decode a stream of binary data as UTF8, replacing any invalid bytes with+-- the Unicode replacement character.+--+-- @since 1.3.0+decodeUtf8LenientC :: Monad m => ConduitT ByteString Text m ()+decodeUtf8LenientC = CC.decodeUtf8Lenient+{-# INLINE decodeUtf8LenientC #-}++-- | Stream in the entirety of a single line.+--+-- Like @takeExactly@, this will consume the entirety of the line regardless of+-- the behavior of the inner Conduit.+--+-- @since 1.3.0+lineC :: (Monad m, Seq.IsSequence seq, Element seq ~ Char)+ => ConduitT seq o m r+ -> ConduitT seq o m r+lineC = CC.line+{-# INLINE lineC #-}++-- | Same as 'line', but operates on ASCII/binary data.+--+-- @since 1.3.0+lineAsciiC :: (Monad m, Seq.IsSequence seq, Element seq ~ Word8)+ => ConduitT seq o m r+ -> ConduitT seq o m r+lineAsciiC = CC.lineAscii+{-# INLINE lineAsciiC #-}++-- | Insert a newline character after each incoming chunk of data.+--+-- @since 1.3.0+unlinesC :: (Monad m, Seq.IsSequence seq, Element seq ~ Char) => ConduitT seq seq m ()+unlinesC = CC.unlines+{-# INLINE unlinesC #-}++-- | Same as 'unlines', but operates on ASCII/binary data.+--+-- @since 1.3.0+unlinesAsciiC :: (Monad m, Seq.IsSequence seq, Element seq ~ Word8) => ConduitT seq seq m ()+unlinesAsciiC = CC.unlinesAscii+{-# INLINE unlinesAsciiC #-}++-- | Convert a stream of arbitrarily-chunked textual data into a stream of data+-- where each chunk represents a single line. Note that, if you have+-- unknown/untrusted input, this function is /unsafe/, since it would allow an+-- attacker to form lines of massive length and exhaust memory.+--+-- @since 1.3.0+linesUnboundedC :: (Monad m, Seq.IsSequence seq, Element seq ~ Char)+ => ConduitT seq seq m ()+linesUnboundedC = CC.linesUnbounded+{-# INLINE linesUnboundedC #-}++-- | Same as 'linesUnbounded', but for ASCII/binary data.+--+-- @since 1.3.0+linesUnboundedAsciiC :: (Monad m, Seq.IsSequence seq, Element seq ~ Word8)+ => ConduitT seq seq m ()+linesUnboundedAsciiC = CC.linesUnboundedAscii+{-# INLINE linesUnboundedAsciiC #-}++-- | Generally speaking, yielding values from inside a Conduit requires+-- some allocation for constructors. This can introduce an overhead,+-- similar to the overhead needed to represent a list of values instead of+-- a vector. This overhead is even more severe when talking about unboxed+-- values.+--+-- This combinator allows you to overcome this overhead, and efficiently+-- fill up vectors. It takes two parameters. The first is the size of each+-- mutable vector to be allocated. The second is a function. The function+-- takes an argument which will yield the next value into a mutable+-- vector.+--+-- Under the surface, this function uses a number of tricks to get high+-- performance. For more information on both usage and implementation,+-- please see:+-- <https://www.fpcomplete.com/user/snoyberg/library-documentation/vectorbuilder>+--+-- @since 1.3.0+vectorBuilderC :: (PrimMonad m, V.Vector v e, PrimMonad n, PrimState m ~ PrimState n)+ => Int -- ^ size+ -> ((e -> n ()) -> ConduitT i Void m r)+ -> ConduitT i (v e) m r+vectorBuilderC = CC.vectorBuilder+{-# INLINE vectorBuilderC #-}
+ src/Data/Conduit/Internal.hs view
@@ -0,0 +1,20 @@+{-# LANGUAGE Safe #-}+{-# OPTIONS_HADDOCK not-home #-}+module Data.Conduit.Internal+ ( -- * Pipe+ module Data.Conduit.Internal.Pipe+ -- * Conduit+ , module Data.Conduit.Internal.Conduit+ -- * Fusion (highly experimental!!!)+ , module Data.Conduit.Internal.Fusion+ ) where++import Data.Conduit.Internal.Conduit hiding (await,+ awaitForever, bracketP,+ leftover, mapInput, mapInputM,+ mapOutput, mapOutputMaybe,+ transPipe,+ yield, yieldM,+ unconsM, unconsEitherM)+import Data.Conduit.Internal.Pipe+import Data.Conduit.Internal.Fusion
+ src/Data/Conduit/Internal/Conduit.hs view
@@ -0,0 +1,1333 @@+{-# OPTIONS_HADDOCK not-home #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE TypeFamilies #-}+module Data.Conduit.Internal.Conduit+ ( -- ** Types+ ConduitT (..)+ , ConduitM+ , Source+ , Producer+ , Sink+ , Consumer+ , Conduit+ , Flush (..)+ -- *** Newtype wrappers+ , ZipSource (..)+ , ZipSink (..)+ , ZipConduit (..)+ -- ** Sealed+ , SealedConduitT (..)+ , sealConduitT+ , unsealConduitT+ -- ** Primitives+ , await+ , awaitForever+ , yield+ , yieldM+ , leftover+ , runConduit+ , runConduitPure+ , runConduitRes+ , fuse+ , connect+ , unconsM+ , unconsEitherM+ -- ** Composition+ , connectResume+ , connectResumeConduit+ , fuseLeftovers+ , fuseReturnLeftovers+ , ($$+)+ , ($$++)+ , ($$+-)+ , ($=+)+ , (=$$+)+ , (=$$++)+ , (=$$+-)+ , ($$)+ , ($=)+ , (=$)+ , (=$=)+ , (.|)+ -- ** Generalizing+ , sourceToPipe+ , sinkToPipe+ , conduitToPipe+ , toProducer+ , toConsumer+ -- ** Cleanup+ , bracketP+ -- ** Exceptions+ , catchC+ , handleC+ , tryC+ -- ** Utilities+ , Data.Conduit.Internal.Conduit.transPipe+ , Data.Conduit.Internal.Conduit.mapOutput+ , Data.Conduit.Internal.Conduit.mapOutputMaybe+ , Data.Conduit.Internal.Conduit.mapInput+ , Data.Conduit.Internal.Conduit.mapInputM+ , zipSinks+ , zipSources+ , zipSourcesApp+ , zipConduitApp+ , mergeSource+ , passthroughSink+ , sourceToList+ , fuseBoth+ , fuseBothMaybe+ , fuseUpstream+ , sequenceSources+ , sequenceSinks+ , sequenceConduits+ ) where++import Control.Applicative (Applicative (..))+import Control.Exception (Exception)+import qualified Control.Exception as E (catch)+import Control.Monad (liftM, liftM2, ap)+import Control.Monad.Fail(MonadFail(..))+import Control.Monad.Error.Class(MonadError(..))+import Control.Monad.Reader.Class(MonadReader(..))+import Control.Monad.RWS.Class(MonadRWS())+import Control.Monad.Writer.Class(MonadWriter(..), censor)+import Control.Monad.State.Class(MonadState(..))+import Control.Monad.Trans.Class (MonadTrans (lift))+import Control.Monad.IO.Unlift (MonadIO (liftIO), MonadUnliftIO, withRunInIO)+import Control.Monad.Primitive (PrimMonad, PrimState, primitive)+import Data.Functor.Identity (Identity, runIdentity)+import Data.Void (Void, absurd)+import Data.Monoid (Monoid (mappend, mempty))+import Data.Semigroup (Semigroup ((<>)))+import Control.Monad.Trans.Resource+import Data.Conduit.Internal.Pipe hiding (yield, mapOutput, leftover, yieldM, await, awaitForever, bracketP, unconsM, unconsEitherM)+import qualified Data.Conduit.Internal.Pipe as CI+import Control.Monad (forever)+import Data.Traversable (Traversable (..))++-- | Core datatype of the conduit package. This type represents a general+-- component which can consume a stream of input values @i@, produce a stream+-- of output values @o@, perform actions in the @m@ monad, and produce a final+-- result @r@. The type synonyms provided here are simply wrappers around this+-- type.+--+-- Since 1.3.0+newtype ConduitT i o m r = ConduitT+ { unConduitT :: forall b.+ (r -> Pipe i i o () m b) -> Pipe i i o () m b+ }++-- | In order to provide for efficient monadic composition, the+-- @ConduitT@ type is implemented internally using a technique known+-- as the codensity transform. This allows for cheap appending, but+-- makes one case much more expensive: partially running a @ConduitT@+-- and that capturing the new state.+--+-- This data type is the same as @ConduitT@, but does not use the+-- codensity transform technique.+--+-- @since 1.3.0+newtype SealedConduitT i o m r = SealedConduitT (Pipe i i o () m r)++-- | Same as 'ConduitT', for backwards compat+type ConduitM = ConduitT++instance Functor (ConduitT i o m) where+ fmap f (ConduitT c) = ConduitT $ \rest -> c (rest . f)++instance Applicative (ConduitT i o m) where+ pure x = ConduitT ($ x)+ {-# INLINE pure #-}+ (<*>) = ap+ {-# INLINE (<*>) #-}+ x *> y = x >>= \_ -> y+ {-# INLINE (*>) #-}++instance Monad (ConduitT i o m) where+ return = pure+ ConduitT f >>= g = ConduitT $ \h -> f $ \a -> unConduitT (g a) h++-- | @since 1.3.1+instance MonadFail m => MonadFail (ConduitT i o m) where+ fail = lift . Control.Monad.Fail.fail++instance MonadThrow m => MonadThrow (ConduitT i o m) where+ throwM = lift . throwM++instance MonadIO m => MonadIO (ConduitT i o m) where+ liftIO = lift . liftIO+ {-# INLINE liftIO #-}++instance MonadReader r m => MonadReader r (ConduitT i o m) where+ ask = lift ask+ {-# INLINE ask #-}++ local f (ConduitT c0) = ConduitT $ \rest ->+ let go (HaveOutput p o) = HaveOutput (go p) o+ go (NeedInput p c) = NeedInput (\i -> go (p i)) (\u -> go (c u))+ go (Done x) = rest x+ go (PipeM mp) = PipeM (liftM go $ local f mp)+ go (Leftover p i) = Leftover (go p) i+ in go (c0 Done)++#ifndef MIN_VERSION_mtl+#define MIN_VERSION_mtl(x, y, z) 0+#endif++instance MonadWriter w m => MonadWriter w (ConduitT i o m) where+#if MIN_VERSION_mtl(2, 1, 0)+ writer = lift . writer+#endif+ tell = lift . tell++ listen (ConduitT c0) = ConduitT $ \rest ->+ let go front (HaveOutput p o) = HaveOutput (go front p) o+ go front (NeedInput p c) = NeedInput (\i -> go front (p i)) (\u -> go front (c u))+ go front (Done x) = rest (x, front)+ go front (PipeM mp) = PipeM $ do+ (p,w) <- listen mp+ return $ go (front `mappend` w) p+ go front (Leftover p i) = Leftover (go front p) i+ in go mempty (c0 Done)++ pass (ConduitT c0) = ConduitT $ \rest ->+ let go front (HaveOutput p o) = HaveOutput (go front p) o+ go front (NeedInput p c) = NeedInput (\i -> go front (p i)) (\u -> go front (c u))+ go front (PipeM mp) = PipeM $ do+ (p,w) <- censor (const mempty) (listen mp)+ return $ go (front `mappend` w) p+ go front (Done (x,f)) = PipeM $ do+ tell (f front)+ return $ rest x+ go front (Leftover p i) = Leftover (go front p) i+ in go mempty (c0 Done)++instance MonadState s m => MonadState s (ConduitT i o m) where+ get = lift get+ put = lift . put+#if MIN_VERSION_mtl(2, 1, 0)+ state = lift . state+#endif++instance MonadRWS r w s m => MonadRWS r w s (ConduitT i o m)++instance MonadError e m => MonadError e (ConduitT i o m) where+ throwError = lift . throwError+ catchError (ConduitT c0) f = ConduitT $ \rest ->+ let go (HaveOutput p o) = HaveOutput (go p) o+ go (NeedInput p c) = NeedInput (\i -> go (p i)) (\u -> go (c u))+ go (Done x) = rest x+ go (PipeM mp) =+ PipeM $ catchError (liftM go mp) $ \e -> do+ return $ unConduitT (f e) rest+ go (Leftover p i) = Leftover (go p) i+ in go (c0 Done)++instance MonadTrans (ConduitT i o) where+ lift mr = ConduitT $ \rest -> PipeM (liftM rest mr)+ {-# INLINE [1] lift #-}++instance MonadResource m => MonadResource (ConduitT i o m) where+ liftResourceT = lift . liftResourceT+ {-# INLINE liftResourceT #-}++instance Monad m => Semigroup (ConduitT i o m ()) where+ (<>) = (>>)+ {-# INLINE (<>) #-}++instance Monad m => Monoid (ConduitT i o m ()) where+ mempty = return ()+ {-# INLINE mempty #-}+#if !(MIN_VERSION_base(4,11,0))+ mappend = (<>)+ {-# INLINE mappend #-}+#endif++instance PrimMonad m => PrimMonad (ConduitT i o m) where+ type PrimState (ConduitT i o m) = PrimState m+ primitive = lift . primitive++-- | Provides a stream of output values, without consuming any input or+-- producing a final result.+--+-- Since 0.5.0+type Source m o = ConduitT () o m ()+{-# DEPRECATED Source "Use ConduitT directly" #-}++-- | A component which produces a stream of output values, regardless of the+-- input stream. A @Producer@ is a generalization of a @Source@, and can be+-- used as either a @Source@ or a @Conduit@.+--+-- Since 1.0.0+type Producer m o = forall i. ConduitT i o m ()+{-# DEPRECATED Producer "Use ConduitT directly" #-}++-- | Consumes a stream of input values and produces a final result, without+-- producing any output.+--+-- > type Sink i m r = ConduitT i Void m r+--+-- Since 0.5.0+type Sink i = ConduitT i Void+{-# DEPRECATED Sink "Use ConduitT directly" #-}++-- | A component which consumes a stream of input values and produces a final+-- result, regardless of the output stream. A @Consumer@ is a generalization of+-- a @Sink@, and can be used as either a @Sink@ or a @Conduit@.+--+-- Since 1.0.0+type Consumer i m r = forall o. ConduitT i o m r+{-# DEPRECATED Consumer "Use ConduitT directly" #-}++-- | Consumes a stream of input values and produces a stream of output values,+-- without producing a final result.+--+-- Since 0.5.0+type Conduit i m o = ConduitT i o m ()+{-# DEPRECATED Conduit "Use ConduitT directly" #-}++sealConduitT :: ConduitT i o m r -> SealedConduitT i o m r+sealConduitT (ConduitT f) = SealedConduitT (f Done)++unsealConduitT :: Monad m => SealedConduitT i o m r -> ConduitT i o m r+unsealConduitT (SealedConduitT f) = ConduitT (f >>=)++-- | Connect a @Source@ to a @Sink@ until the latter closes. Returns both the+-- most recent state of the @Source@ and the result of the @Sink@.+--+-- Since 0.5.0+connectResume :: Monad m+ => SealedConduitT () a m ()+ -> ConduitT a Void m r+ -> m (SealedConduitT () a m (), r)+connectResume (SealedConduitT left0) (ConduitT right0) =+ goRight left0 (right0 Done)+ where+ goRight left right =+ case right of+ HaveOutput _ o -> absurd o+ NeedInput rp rc -> goLeft rp rc left+ Done r2 -> return (SealedConduitT left, r2)+ PipeM mp -> mp >>= goRight left+ Leftover p i -> goRight (HaveOutput left i) p++ goLeft rp rc left =+ case left of+ HaveOutput left' o -> goRight left' (rp o)+ NeedInput _ lc -> recurse (lc ())+ Done () -> goRight (Done ()) (rc ())+ PipeM mp -> mp >>= recurse+ Leftover p () -> recurse p+ where+ recurse = goLeft rp rc++sourceToPipe :: Monad m => ConduitT () o m () -> Pipe l i o u m ()+sourceToPipe (ConduitT k) =+ go $ k Done+ where+ go (HaveOutput p o) = HaveOutput (go p) o+ go (NeedInput _ c) = go $ c ()+ go (Done ()) = Done ()+ go (PipeM mp) = PipeM (liftM go mp)+ go (Leftover p ()) = go p++sinkToPipe :: Monad m => ConduitT i Void m r -> Pipe l i o u m r+sinkToPipe (ConduitT k) =+ go $ injectLeftovers $ k Done+ where+ go (HaveOutput _ o) = absurd o+ go (NeedInput p c) = NeedInput (go . p) (const $ go $ c ())+ go (Done r) = Done r+ go (PipeM mp) = PipeM (liftM go mp)+ go (Leftover _ l) = absurd l++conduitToPipe :: Monad m => ConduitT i o m () -> Pipe l i o u m ()+conduitToPipe (ConduitT k) =+ go $ injectLeftovers $ k Done+ where+ go (HaveOutput p o) = HaveOutput (go p) o+ go (NeedInput p c) = NeedInput (go . p) (const $ go $ c ())+ go (Done ()) = Done ()+ go (PipeM mp) = PipeM (liftM go mp)+ go (Leftover _ l) = absurd l++-- | Generalize a 'Source' to a 'Producer'.+--+-- Since 1.0.0+toProducer :: Monad m => ConduitT () a m () -> ConduitT i a m ()+toProducer (ConduitT c0) = ConduitT $ \rest -> let+ go (HaveOutput p o) = HaveOutput (go p) o+ go (NeedInput _ c) = go (c ())+ go (Done r) = rest r+ go (PipeM mp) = PipeM (liftM go mp)+ go (Leftover p ()) = go p+ in go (c0 Done)++-- | Generalize a 'Sink' to a 'Consumer'.+--+-- Since 1.0.0+toConsumer :: Monad m => ConduitT a Void m b -> ConduitT a o m b+toConsumer (ConduitT c0) = ConduitT $ \rest -> let+ go (HaveOutput _ o) = absurd o+ go (NeedInput p c) = NeedInput (go . p) (go . c)+ go (Done r) = rest r+ go (PipeM mp) = PipeM (liftM go mp)+ go (Leftover p l) = Leftover (go p) l+ in go (c0 Done)++-- | Catch all exceptions thrown by the current component of the pipeline.+--+-- Note: this will /not/ catch exceptions thrown by other components! For+-- example, if an exception is thrown in a @Source@ feeding to a @Sink@, and+-- the @Sink@ uses @catchC@, the exception will /not/ be caught.+--+-- Due to this behavior (as well as lack of async exception safety), you+-- should not try to implement combinators such as @onException@ in terms of this+-- primitive function.+--+-- Note also that the exception handling will /not/ be applied to any+-- finalizers generated by this conduit.+--+-- Since 1.0.11+catchC :: (MonadUnliftIO m, Exception e)+ => ConduitT i o m r+ -> (e -> ConduitT i o m r)+ -> ConduitT i o m r+catchC (ConduitT p0) onErr = ConduitT $ \rest -> let+ go (Done r) = rest r+ go (PipeM mp) = PipeM $ withRunInIO $ \ run ->+ run (liftM go mp) `E.catch` \ e ->+ return $ onErr e `unConduitT` rest+ go (Leftover p i) = Leftover (go p) i+ go (NeedInput x y) = NeedInput (go . x) (go . y)+ go (HaveOutput p o) = HaveOutput (go p) o+ in go (p0 Done)+{-# INLINE catchC #-}++-- | The same as @flip catchC@.+--+-- Since 1.0.11+handleC :: (MonadUnliftIO m, Exception e)+ => (e -> ConduitT i o m r)+ -> ConduitT i o m r+ -> ConduitT i o m r+handleC = flip catchC+{-# INLINE handleC #-}++-- | A version of @try@ for use within a pipeline. See the comments in @catchC@+-- for more details.+--+-- Since 1.0.11+tryC :: (MonadUnliftIO m, Exception e)+ => ConduitT i o m r+ -> ConduitT i o m (Either e r)+tryC c = fmap Right c `catchC` (return . Left)+{-# INLINE tryC #-}++-- | Combines two sinks. The new sink will complete when both input sinks have+-- completed.+--+-- Any leftovers are discarded.+--+-- Since 0.4.1+zipSinks :: Monad m => ConduitT i Void m r -> ConduitT i Void m r' -> ConduitT i Void m (r, r')+zipSinks (ConduitT x0) (ConduitT y0) = ConduitT $ \rest -> let+ Leftover _ i >< _ = absurd i+ _ >< Leftover _ i = absurd i+ HaveOutput _ o >< _ = absurd o+ _ >< HaveOutput _ o = absurd o++ PipeM mx >< y = PipeM (liftM (>< y) mx)+ x >< PipeM my = PipeM (liftM (x ><) my)+ Done x >< Done y = rest (x, y)+ NeedInput px cx >< NeedInput py cy = NeedInput (\i -> px i >< py i) (\() -> cx () >< cy ())+ NeedInput px cx >< y@Done{} = NeedInput (\i -> px i >< y) (\u -> cx u >< y)+ x@Done{} >< NeedInput py cy = NeedInput (\i -> x >< py i) (\u -> x >< cy u)+ in injectLeftovers (x0 Done) >< injectLeftovers (y0 Done)++-- | Combines two sources. The new source will stop producing once either+-- source has been exhausted.+--+-- Since 1.0.13+zipSources :: Monad m => ConduitT () a m () -> ConduitT () b m () -> ConduitT () (a, b) m ()+zipSources (ConduitT left0) (ConduitT right0) = ConduitT $ \rest -> let+ go (Leftover left ()) right = go left right+ go left (Leftover right ()) = go left right+ go (Done ()) (Done ()) = rest ()+ go (Done ()) (HaveOutput _ _) = rest ()+ go (HaveOutput _ _) (Done ()) = rest ()+ go (Done ()) (PipeM _) = rest ()+ go (PipeM _) (Done ()) = rest ()+ go (PipeM mx) (PipeM my) = PipeM (liftM2 go mx my)+ go (PipeM mx) y@HaveOutput{} = PipeM (liftM (\x -> go x y) mx)+ go x@HaveOutput{} (PipeM my) = PipeM (liftM (go x) my)+ go (HaveOutput srcx x) (HaveOutput srcy y) = HaveOutput (go srcx srcy) (x, y)+ go (NeedInput _ c) right = go (c ()) right+ go left (NeedInput _ c) = go left (c ())+ in go (left0 Done) (right0 Done)++-- | Combines two sources. The new source will stop producing once either+-- source has been exhausted.+--+-- Since 1.0.13+zipSourcesApp :: Monad m => ConduitT () (a -> b) m () -> ConduitT () a m () -> ConduitT () b m ()+zipSourcesApp (ConduitT left0) (ConduitT right0) = ConduitT $ \rest -> let+ go (Leftover left ()) right = go left right+ go left (Leftover right ()) = go left right+ go (Done ()) (Done ()) = rest ()+ go (Done ()) (HaveOutput _ _) = rest ()+ go (HaveOutput _ _) (Done ()) = rest ()+ go (Done ()) (PipeM _) = rest ()+ go (PipeM _) (Done ()) = rest ()+ go (PipeM mx) (PipeM my) = PipeM (liftM2 go mx my)+ go (PipeM mx) y@HaveOutput{} = PipeM (liftM (\x -> go x y) mx)+ go x@HaveOutput{} (PipeM my) = PipeM (liftM (go x) my)+ go (HaveOutput srcx x) (HaveOutput srcy y) = HaveOutput (go srcx srcy) (x y)+ go (NeedInput _ c) right = go (c ()) right+ go left (NeedInput _ c) = go left (c ())+ in go (left0 Done) (right0 Done)++-- |+--+-- Since 1.0.17+zipConduitApp+ :: Monad m+ => ConduitT i o m (x -> y)+ -> ConduitT i o m x+ -> ConduitT i o m y+zipConduitApp (ConduitT left0) (ConduitT right0) = ConduitT $ \rest -> let+ go (Done f) (Done x) = rest (f x)+ go (PipeM mx) y = PipeM (flip go y `liftM` mx)+ go x (PipeM my) = PipeM (go x `liftM` my)+ go (HaveOutput x o) y = HaveOutput (go x y) o+ go x (HaveOutput y o) = HaveOutput (go x y) o+ go (Leftover _ i) _ = absurd i+ go _ (Leftover _ i) = absurd i+ go (NeedInput px cx) (NeedInput py cy) = NeedInput+ (\i -> go (px i) (py i))+ (\u -> go (cx u) (cy u))+ go (NeedInput px cx) (Done y) = NeedInput+ (\i -> go (px i) (Done y))+ (\u -> go (cx u) (Done y))+ go (Done x) (NeedInput py cy) = NeedInput+ (\i -> go (Done x) (py i))+ (\u -> go (Done x) (cy u))+ in go (injectLeftovers $ left0 Done) (injectLeftovers $ right0 Done)++-- | Same as normal fusion (e.g. @=$=@), except instead of discarding leftovers+-- from the downstream component, return them.+--+-- Since 1.0.17+fuseReturnLeftovers :: Monad m+ => ConduitT a b m ()+ -> ConduitT b c m r+ -> ConduitT a c m (r, [b])+fuseReturnLeftovers (ConduitT left0) (ConduitT right0) = ConduitT $ \rest -> let+ goRight bs left right =+ case right of+ HaveOutput p o -> HaveOutput (recurse p) o+ NeedInput rp rc ->+ case bs of+ [] -> goLeft rp rc left+ b:bs' -> goRight bs' left (rp b)+ Done r2 -> rest (r2, bs)+ PipeM mp -> PipeM (liftM recurse mp)+ Leftover p b -> goRight (b:bs) left p+ where+ recurse = goRight bs left++ goLeft rp rc left =+ case left of+ HaveOutput left' o -> goRight [] left' (rp o)+ NeedInput left' lc -> NeedInput (recurse . left') (recurse . lc)+ Done r1 -> goRight [] (Done r1) (rc r1)+ PipeM mp -> PipeM (liftM recurse mp)+ Leftover left' i -> Leftover (recurse left') i+ where+ recurse = goLeft rp rc+ in goRight [] (left0 Done) (right0 Done)++-- | Similar to @fuseReturnLeftovers@, but use the provided function to convert+-- downstream leftovers to upstream leftovers.+--+-- Since 1.0.17+fuseLeftovers+ :: Monad m+ => ([b] -> [a])+ -> ConduitT a b m ()+ -> ConduitT b c m r+ -> ConduitT a c m r+fuseLeftovers f left right = do+ (r, bs) <- fuseReturnLeftovers left right+ mapM_ leftover $ reverse $ f bs+ return r++-- | Connect a 'Conduit' to a sink and return the output of the sink+-- together with a new 'Conduit'.+--+-- Since 1.0.17+connectResumeConduit+ :: Monad m+ => SealedConduitT i o m ()+ -> ConduitT o Void m r+ -> ConduitT i Void m (SealedConduitT i o m (), r)+connectResumeConduit (SealedConduitT left0) (ConduitT right0) = ConduitT $ \rest -> let+ goRight left right =+ case right of+ HaveOutput _ o -> absurd o+ NeedInput rp rc -> goLeft rp rc left+ Done r2 -> rest (SealedConduitT left, r2)+ PipeM mp -> PipeM (liftM (goRight left) mp)+ Leftover p i -> goRight (HaveOutput left i) p++ goLeft rp rc left =+ case left of+ HaveOutput left' o -> goRight left' (rp o)+ NeedInput left' lc -> NeedInput (recurse . left') (recurse . lc)+ Done () -> goRight (Done ()) (rc ())+ PipeM mp -> PipeM (liftM recurse mp)+ Leftover left' i -> Leftover (recurse left') i -- recurse p+ where+ recurse = goLeft rp rc+ in goRight left0 (right0 Done)++-- | Merge a @Source@ into a @Conduit@.+-- The new conduit will stop processing once either source or upstream have been exhausted.+mergeSource+ :: Monad m+ => ConduitT () i m ()+ -> ConduitT a (i, a) m ()+mergeSource = loop . sealConduitT+ where+ loop :: Monad m => SealedConduitT () i m () -> ConduitT a (i, a) m ()+ loop src0 = await >>= maybe (return ()) go+ where+ go a = do+ (src1, mi) <- lift $ src0 $$++ await+ case mi of+ Nothing -> leftover a+ Just i -> yield (i, a) >> loop src1+++-- | Turn a @Sink@ into a @Conduit@ in the following way:+--+-- * All input passed to the @Sink@ is yielded downstream.+--+-- * When the @Sink@ finishes processing, the result is passed to the provided to the finalizer function.+--+-- Note that the @Sink@ will stop receiving input as soon as the downstream it+-- is connected to shuts down.+--+-- An example usage would be to write the result of a @Sink@ to some mutable+-- variable while allowing other processing to continue.+--+-- Since 1.1.0+passthroughSink :: Monad m+ => ConduitT i Void m r+ -> (r -> m ()) -- ^ finalizer+ -> ConduitT i i m ()+passthroughSink (ConduitT sink0) final = ConduitT $ \rest -> let+ -- A bit of explanation is in order, this function is+ -- non-obvious. The purpose of go is to keep track of the sink+ -- we're passing values to, and then yield values downstream. The+ -- third argument to go is the current state of that sink. That's+ -- relatively straightforward.+ --+ -- The second value is the leftover buffer. These are values that+ -- the sink itself has called leftover on, and must be provided+ -- back to the sink the next time it awaits. _However_, these+ -- values should _not_ be reyielded downstream: we have already+ -- yielded them downstream ourself, and it is the responsibility+ -- of the functions wrapping around passthroughSink to handle the+ -- leftovers from downstream.+ --+ -- The trickiest bit is the first argument, which is a solution to+ -- bug https://github.com/snoyberg/conduit/issues/304. The issue+ -- is that, once we get a value, we need to provide it to both the+ -- inner sink _and_ yield it downstream. The obvious thing to do+ -- is yield first and then recursively call go. Unfortunately,+ -- this doesn't work in all cases: if the downstream component+ -- never calls await again, our yield call will never return, and+ -- our sink will not get the last value. This results is confusing+ -- behavior where the sink and downstream component receive a+ -- different number of values.+ --+ -- Solution: keep a buffer of the next value to yield downstream,+ -- and only yield it downstream in one of two cases: our sink is+ -- asking for another value, or our sink is done. This way, we+ -- ensure that, in all cases, we pass exactly the same number of+ -- values to the inner sink as to downstream.++ go mbuf _ (Done r) = do+ maybe (return ()) CI.yield mbuf+ lift $ final r+ unConduitT (awaitForever yield) rest+ go mbuf is (Leftover sink i) = go mbuf (i:is) sink+ go _ _ (HaveOutput _ o) = absurd o+ go mbuf is (PipeM mx) = do+ x <- lift mx+ go mbuf is x+ go mbuf (i:is) (NeedInput next _) = go mbuf is (next i)+ go mbuf [] (NeedInput next done) = do+ maybe (return ()) CI.yield mbuf+ mx <- CI.await+ case mx of+ Nothing -> go Nothing [] (done ())+ Just x -> go (Just x) [] (next x)+ in go Nothing [] (sink0 Done)++-- | Convert a @Source@ into a list. The basic functionality can be explained as:+--+-- > sourceToList src = src $$ Data.Conduit.List.consume+--+-- However, @sourceToList@ is able to produce its results lazily, which cannot+-- be done when running a conduit pipeline in general. Unlike the+-- @Data.Conduit.Lazy@ module (in conduit-extra), this function performs no+-- unsafe I\/O operations, and therefore can only be as lazy as the+-- underlying monad.+--+-- Since 1.2.6+sourceToList :: Monad m => ConduitT () a m () -> m [a]+sourceToList (ConduitT k) =+ go $ k Done+ where+ go (Done _) = return []+ go (HaveOutput src x) = liftM (x:) (go src)+ go (PipeM msrc) = msrc >>= go+ go (NeedInput _ c) = go (c ())+ go (Leftover p _) = go p++-- Define fixity of all our operators+infixr 0 $$+infixl 1 $=+infixr 2 =$+infixr 2 =$=+infixr 0 $$++infixr 0 $$+++infixr 0 $$+-+infixl 1 $=++infixr 2 .|++-- | Equivalent to using 'runConduit' and '.|' together.+--+-- Since 1.2.3+connect :: Monad m+ => ConduitT () a m ()+ -> ConduitT a Void m r+ -> m r+connect = ($$)++-- | Split a conduit into head and tail.+--+-- Note that you have to 'sealConduitT' it first.+--+-- Since 1.3.3+unconsM :: Monad m+ => SealedConduitT () o m ()+ -> m (Maybe (o, SealedConduitT () o m ()))+unconsM (SealedConduitT p) = go p+ where+ -- This function is the same as @Pipe.unconsM@ but it ignores leftovers.+ go (HaveOutput p o) = pure $ Just (o, SealedConduitT p)+ go (NeedInput _ c) = go $ c ()+ go (Done ()) = pure Nothing+ go (PipeM mp) = mp >>= go+ go (Leftover p ()) = go p++-- | Split a conduit into head and tail or return its result if it is done.+--+-- Note that you have to 'sealConduitT' it first.+--+-- Since 1.3.3+unconsEitherM :: Monad m+ => SealedConduitT () o m r+ -> m (Either r (o, SealedConduitT () o m r))+unconsEitherM (SealedConduitT p) = go p+ where+ -- This function is the same as @Pipe.unconsEitherM@ but it ignores leftovers.+ go (HaveOutput p o) = pure $ Right (o, SealedConduitT p)+ go (NeedInput _ c) = go $ c ()+ go (Done r) = pure $ Left r+ go (PipeM mp) = mp >>= go+ go (Leftover p ()) = go p++-- | Named function synonym for '.|'+--+-- Equivalent to '.|' and '=$='. However, the latter is+-- deprecated and will be removed in a future version.+--+-- Since 1.2.3+fuse :: Monad m => ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r+fuse = (=$=)++-- | Combine two @Conduit@s together into a new @Conduit@ (aka 'fuse').+--+-- Output from the upstream (left) conduit will be fed into the+-- downstream (right) conduit. Processing will terminate when+-- downstream (right) returns.+-- Leftover data returned from the right @Conduit@ will be discarded.+--+-- Equivalent to 'fuse' and '=$=', however the latter is deprecated and will+-- be removed in a future version.+--+-- Note that, while this operator looks like categorical composition+-- (from "Control.Category"), there are a few reasons it's different:+--+-- * The position of the type parameters to 'ConduitT' do not+-- match. We would need to change @ConduitT i o m r@ to @ConduitT r+-- m i o@, which would preclude a 'Monad' or 'MonadTrans' instance.+--+-- * The result value from upstream and downstream are allowed to+-- differ between upstream and downstream. In other words, we would+-- need the type signature here to look like @ConduitT a b m r ->+-- ConduitT b c m r -> ConduitT a c m r@.+--+-- * Due to leftovers, we do not have a left identity in Conduit. This+-- can be achieved with the underlying @Pipe@ datatype, but this is+-- not generally recommended. See <https://stackoverflow.com/a/15263700>.+--+-- @since 1.2.8+(.|) :: Monad m+ => ConduitT a b m () -- ^ upstream+ -> ConduitT b c m r -- ^ downstream+ -> ConduitT a c m r+(.|) = fuse+{-# INLINE (.|) #-}++-- | The connect operator, which pulls data from a source and pushes to a sink.+-- If you would like to keep the @Source@ open to be used for other+-- operations, use the connect-and-resume operator '$$+'.+--+-- Since 0.4.0+($$) :: Monad m => Source m a -> Sink a m b -> m b+src $$ sink = do+ (rsrc, res) <- src $$+ sink+ rsrc $$+- return ()+ return res+{-# INLINE [1] ($$) #-}+{-# DEPRECATED ($$) "Use runConduit and .|" #-}++-- | A synonym for '=$=' for backwards compatibility.+--+-- Since 0.4.0+($=) :: Monad m => Conduit a m b -> ConduitT b c m r -> ConduitT a c m r+($=) = (=$=)+{-# INLINE [0] ($=) #-}+{-# RULES "conduit: $= is =$=" ($=) = (=$=) #-}+{-# DEPRECATED ($=) "Use .|" #-}++-- | A synonym for '=$=' for backwards compatibility.+--+-- Since 0.4.0+(=$) :: Monad m => Conduit a m b -> ConduitT b c m r -> ConduitT a c m r+(=$) = (=$=)+{-# INLINE [0] (=$) #-}+{-# RULES "conduit: =$ is =$=" (=$) = (=$=) #-}+{-# DEPRECATED (=$) "Use .|" #-}++-- | Deprecated fusion operator.+--+-- Since 0.4.0+(=$=) :: Monad m => Conduit a m b -> ConduitT b c m r -> ConduitT a c m r+ConduitT left0 =$= ConduitT right0 = ConduitT $ \rest ->+ let goRight left right =+ case right of+ HaveOutput p o -> HaveOutput (recurse p) o+ NeedInput rp rc -> goLeft rp rc left+ Done r2 -> rest r2+ PipeM mp -> PipeM (liftM recurse mp)+ Leftover right' i -> goRight (HaveOutput left i) right'+ where+ recurse = goRight left++ goLeft rp rc left =+ case left of+ HaveOutput left' o -> goRight left' (rp o)+ NeedInput left' lc -> NeedInput (recurse . left') (recurse . lc)+ Done r1 -> goRight (Done r1) (rc r1)+ PipeM mp -> PipeM (liftM recurse mp)+ Leftover left' i -> Leftover (recurse left') i+ where+ recurse = goLeft rp rc+ in goRight (left0 Done) (right0 Done)+{-# INLINE [1] (=$=) #-}+{-# DEPRECATED (=$=) "Use .|" #-}++-- | Wait for a single input value from upstream. If no data is available,+-- returns @Nothing@. Once @await@ returns @Nothing@, subsequent calls will+-- also return @Nothing@.+--+-- Since 0.5.0+await :: Monad m => ConduitT i o m (Maybe i)+await = ConduitT $ \f -> NeedInput (f . Just) (const $ f Nothing)+{-# INLINE [0] await #-}++await' :: Monad m+ => ConduitT i o m r+ -> (i -> ConduitT i o m r)+ -> ConduitT i o m r+await' f g = ConduitT $ \rest -> NeedInput+ (\i -> unConduitT (g i) rest)+ (const $ unConduitT f rest)+{-# INLINE await' #-}+{-# RULES "conduit: await >>= maybe" forall x y. await >>= maybe x y = await' x y #-}++-- | Send a value downstream to the next component to consume. If the+-- downstream component terminates, this call will never return control.+--+-- Since 0.5.0+yield :: Monad m+ => o -- ^ output value+ -> ConduitT i o m ()+yield o = ConduitT $ \rest -> HaveOutput (rest ()) o+{-# INLINE yield #-}++-- | Send a monadic value downstream for the next component to consume.+--+-- @since 1.2.7+yieldM :: Monad m => m o -> ConduitT i o m ()+yieldM mo = lift mo >>= yield+{-# INLINE yieldM #-}++ -- FIXME rule won't fire, see FIXME in .Pipe; "mapM_ yield" mapM_ yield = ConduitT . sourceList++-- | Provide a single piece of leftover input to be consumed by the next+-- component in the current monadic binding.+--+-- /Note/: it is highly encouraged to only return leftover values from input+-- already consumed from upstream.+--+-- @since 0.5.0+leftover :: i -> ConduitT i o m ()+leftover i = ConduitT $ \rest -> Leftover (rest ()) i+{-# INLINE leftover #-}++-- | Run a pipeline until processing completes.+--+-- Since 1.2.1+runConduit :: Monad m => ConduitT () Void m r -> m r+runConduit (ConduitT p) = runPipe $ injectLeftovers $ p Done+{-# INLINE [0] runConduit #-}++-- | Bracket a conduit computation between allocation and release of a+-- resource. Two guarantees are given about resource finalization:+--+-- 1. It will be /prompt/. The finalization will be run as early as possible.+--+-- 2. It is exception safe. Due to usage of @resourcet@, the finalization will+-- be run in the event of any exceptions.+--+-- Since 0.5.0+bracketP :: MonadResource m++ => IO a+ -- ^ computation to run first (\"acquire resource\")+ -> (a -> IO ())+ -- ^ computation to run last (\"release resource\")+ -> (a -> ConduitT i o m r)+ -- ^ computation to run in-between+ -> ConduitT i o m r+ -- returns the value from the in-between computation+bracketP alloc free inside = ConduitT $ \rest -> do+ (key, seed) <- allocate alloc free+ unConduitT (inside seed) $ \res -> do+ release key+ rest res++-- | Wait for input forever, calling the given inner component for each piece of+-- new input.+--+-- This function is provided as a convenience for the common pattern of+-- @await@ing input, checking if it's @Just@ and then looping.+--+-- Since 0.5.0+awaitForever :: Monad m => (i -> ConduitT i o m r) -> ConduitT i o m ()+awaitForever f = ConduitT $ \rest ->+ let go = NeedInput (\i -> unConduitT (f i) (const go)) rest+ in go++-- | Transform the monad that a @ConduitT@ lives in.+--+-- Note that the monad transforming function will be run multiple times,+-- resulting in unintuitive behavior in some cases. For a fuller treatment,+-- please see:+--+-- <https://github.com/snoyberg/conduit/wiki/Dealing-with-monad-transformers>+--+-- Since 0.4.0+transPipe :: Monad m => (forall a. m a -> n a) -> ConduitT i o m r -> ConduitT i o n r+transPipe f (ConduitT c0) = ConduitT $ \rest -> let+ go (HaveOutput p o) = HaveOutput (go p) o+ go (NeedInput p c) = NeedInput (go . p) (go . c)+ go (Done r) = rest r+ go (PipeM mp) =+ PipeM (f $ liftM go $ collapse mp)+ where+ -- Combine a series of monadic actions into a single action. Since we+ -- throw away side effects between different actions, an arbitrary break+ -- between actions will lead to a violation of the monad transformer laws.+ -- Example available at:+ --+ -- http://hpaste.org/75520+ collapse mpipe = do+ pipe' <- mpipe+ case pipe' of+ PipeM mpipe' -> collapse mpipe'+ _ -> return pipe'+ go (Leftover p i) = Leftover (go p) i+ in go (c0 Done)++-- | Apply a function to all the output values of a @ConduitT@.+--+-- This mimics the behavior of `fmap` for a `Source` and `Conduit` in pre-0.4+-- days. It can also be simulated by fusing with the @map@ conduit from+-- "Data.Conduit.List".+--+-- Since 0.4.1+mapOutput :: Monad m => (o1 -> o2) -> ConduitT i o1 m r -> ConduitT i o2 m r+mapOutput f (ConduitT c0) = ConduitT $ \rest -> let+ go (HaveOutput p o) = HaveOutput (go p) (f o)+ go (NeedInput p c) = NeedInput (go . p) (go . c)+ go (Done r) = rest r+ go (PipeM mp) = PipeM (liftM (go) mp)+ go (Leftover p i) = Leftover (go p) i+ in go (c0 Done)++-- | Same as 'mapOutput', but use a function that returns @Maybe@ values.+--+-- Since 0.5.0+mapOutputMaybe :: Monad m => (o1 -> Maybe o2) -> ConduitT i o1 m r -> ConduitT i o2 m r+mapOutputMaybe f (ConduitT c0) = ConduitT $ \rest -> let+ go (HaveOutput p o) = maybe id (\o' p' -> HaveOutput p' o') (f o) (go p)+ go (NeedInput p c) = NeedInput (go . p) (go . c)+ go (Done r) = rest r+ go (PipeM mp) = PipeM (liftM (go) mp)+ go (Leftover p i) = Leftover (go p) i+ in go (c0 Done)++-- | Apply a function to all the input values of a @ConduitT@.+--+-- Since 0.5.0+mapInput :: Monad m+ => (i1 -> i2) -- ^ map initial input to new input+ -> (i2 -> Maybe i1) -- ^ map new leftovers to initial leftovers+ -> ConduitT i2 o m r+ -> ConduitT i1 o m r+mapInput f f' (ConduitT c0) = ConduitT $ \rest -> let+ go (HaveOutput p o) = HaveOutput (go p) o+ go (NeedInput p c) = NeedInput (go . p . f) (go . c)+ go (Done r) = rest r+ go (PipeM mp) = PipeM $ liftM go mp+ go (Leftover p i) = maybe id (flip Leftover) (f' i) (go p)+ in go (c0 Done)++-- | Apply a monadic action to all the input values of a @ConduitT@.+--+-- Since 1.3.2+mapInputM :: Monad m+ => (i1 -> m i2) -- ^ map initial input to new input+ -> (i2 -> m (Maybe i1)) -- ^ map new leftovers to initial leftovers+ -> ConduitT i2 o m r+ -> ConduitT i1 o m r+mapInputM f f' (ConduitT c0) = ConduitT $ \rest -> let+ go (HaveOutput p o) = HaveOutput (go p) o+ go (NeedInput p c) = NeedInput (\i -> PipeM $ go . p <$> f i) (go . c)+ go (Done r) = rest r+ go (PipeM mp) = PipeM $ fmap go mp+ go (Leftover p i) = PipeM $ (\x -> maybe id (flip Leftover) x (go p)) <$> f' i+ in go (c0 Done)++-- | The connect-and-resume operator. This does not close the @Source@, but+-- instead returns it to be used again. This allows a @Source@ to be used+-- incrementally in a large program, without forcing the entire program to live+-- in the @Sink@ monad.+--+-- Mnemonic: connect + do more.+--+-- Since 0.5.0+($$+) :: Monad m => ConduitT () a m () -> ConduitT a Void m b -> m (SealedConduitT () a m (), b)+src $$+ sink = connectResume (sealConduitT src) sink+{-# INLINE ($$+) #-}++-- | Continue processing after usage of @$$+@.+--+-- Since 0.5.0+($$++) :: Monad m => SealedConduitT () a m () -> ConduitT a Void m b -> m (SealedConduitT () a m (), b)+($$++) = connectResume+{-# INLINE ($$++) #-}++-- | Same as @$$++@ and @connectResume@, but doesn't include the+-- updated @SealedConduitT@.+--+-- /NOTE/ In previous versions, this would cause finalizers to+-- run. Since version 1.3.0, there are no finalizers in conduit.+--+-- Since 0.5.0+($$+-) :: Monad m => SealedConduitT () a m () -> ConduitT a Void m b -> m b+rsrc $$+- sink = do+ (_, res) <- connectResume rsrc sink+ return res+{-# INLINE ($$+-) #-}++-- | Left fusion for a sealed source.+--+-- Since 1.0.16+($=+) :: Monad m => SealedConduitT () a m () -> ConduitT a b m () -> SealedConduitT () b m ()+SealedConduitT src $=+ ConduitT sink = SealedConduitT (src `pipeL` sink Done)++-- | Provide for a stream of data that can be flushed.+--+-- A number of @Conduit@s (e.g., zlib compression) need the ability to flush+-- the stream at some point. This provides a single wrapper datatype to be used+-- in all such circumstances.+--+-- Since 0.3.0+data Flush a = Chunk a | Flush+ deriving (Show, Eq, Ord)+instance Functor Flush where+ fmap _ Flush = Flush+ fmap f (Chunk a) = Chunk (f a)++-- | A wrapper for defining an 'Applicative' instance for 'Source's which allows+-- to combine sources together, generalizing 'zipSources'. A combined source+-- will take input yielded from each of its @Source@s until any of them stop+-- producing output.+--+-- Since 1.0.13+newtype ZipSource m o = ZipSource { getZipSource :: ConduitT () o m () }++instance Monad m => Functor (ZipSource m) where+ fmap f = ZipSource . mapOutput f . getZipSource+instance Monad m => Applicative (ZipSource m) where+ pure = ZipSource . forever . yield+ (ZipSource f) <*> (ZipSource x) = ZipSource $ zipSourcesApp f x++-- | Coalesce all values yielded by all of the @Source@s.+--+-- Implemented on top of @ZipSource@ and as such, it exhibits the same+-- short-circuiting behavior as @ZipSource@. See that data type for more+-- details. If you want to create a source that yields *all* values from+-- multiple sources, use `sequence_`.+--+-- Since 1.0.13+sequenceSources :: (Traversable f, Monad m) => f (ConduitT () o m ()) -> ConduitT () (f o) m ()+sequenceSources = getZipSource . sequenceA . fmap ZipSource++-- | A wrapper for defining an 'Applicative' instance for 'Sink's which allows+-- to combine sinks together, generalizing 'zipSinks'. A combined sink+-- distributes the input to all its participants and when all finish, produces+-- the result. This allows to define functions like+--+-- @+-- sequenceSinks :: (Monad m)+-- => [ConduitT i Void m r] -> ConduitT i Void m [r]+-- sequenceSinks = getZipSink . sequenceA . fmap ZipSink+-- @+--+-- Note that the standard 'Applicative' instance for conduits works+-- differently. It feeds one sink with input until it finishes, then switches+-- to another, etc., and at the end combines their results.+--+-- This newtype is in fact a type constrained version of 'ZipConduit', and has+-- the same behavior. It's presented as a separate type since (1) it+-- historically predates @ZipConduit@, and (2) the type constraining can make+-- your code clearer (and thereby make your error messages more easily+-- understood).+--+-- Since 1.0.13+newtype ZipSink i m r = ZipSink { getZipSink :: ConduitT i Void m r }++instance Monad m => Functor (ZipSink i m) where+ fmap f (ZipSink x) = ZipSink (liftM f x)+instance Monad m => Applicative (ZipSink i m) where+ pure = ZipSink . return+ (ZipSink f) <*> (ZipSink x) =+ ZipSink $ liftM (uncurry ($)) $ zipSinks f x++-- | Send incoming values to all of the @Sink@ providing, and ultimately+-- coalesce together all return values.+--+-- Implemented on top of @ZipSink@, see that data type for more details.+--+-- Since 1.0.13+sequenceSinks :: (Traversable f, Monad m) => f (ConduitT i Void m r) -> ConduitT i Void m (f r)+sequenceSinks = getZipSink . sequenceA . fmap ZipSink++-- | The connect-and-resume operator. This does not close the @Conduit@, but+-- instead returns it to be used again. This allows a @Conduit@ to be used+-- incrementally in a large program, without forcing the entire program to live+-- in the @Sink@ monad.+--+-- Leftover data returned from the @Sink@ will be discarded.+--+-- Mnemonic: connect + do more.+--+-- Since 1.0.17+(=$$+) :: Monad m+ => ConduitT a b m ()+ -> ConduitT b Void m r+ -> ConduitT a Void m (SealedConduitT a b m (), r)+(=$$+) conduit = connectResumeConduit (sealConduitT conduit)+{-# INLINE (=$$+) #-}++-- | Continue processing after usage of '=$$+'. Connect a 'SealedConduitT' to+-- a sink and return the output of the sink together with a new+-- 'SealedConduitT'.+--+-- Since 1.0.17+(=$$++) :: Monad m => SealedConduitT i o m () -> ConduitT o Void m r -> ConduitT i Void m (SealedConduitT i o m (), r)+(=$$++) = connectResumeConduit+{-# INLINE (=$$++) #-}++-- | Same as @=$$++@, but doesn't include the updated+-- @SealedConduitT@.+--+-- /NOTE/ In previous versions, this would cause finalizers to+-- run. Since version 1.3.0, there are no finalizers in conduit.+--+-- Since 1.0.17+(=$$+-) :: Monad m => SealedConduitT i o m () -> ConduitT o Void m r -> ConduitT i Void m r+rsrc =$$+- sink = do+ (_, res) <- connectResumeConduit rsrc sink+ return res+{-# INLINE (=$$+-) #-}+++infixr 0 =$$++infixr 0 =$$+++infixr 0 =$$+-++-- | Provides an alternative @Applicative@ instance for @ConduitT@. In this instance,+-- every incoming value is provided to all @ConduitT@s, and output is coalesced together.+-- Leftovers from individual @ConduitT@s will be used within that component, and then discarded+-- at the end of their computation. Output and finalizers will both be handled in a left-biased manner.+--+-- As an example, take the following program:+--+-- @+-- main :: IO ()+-- main = do+-- let src = mapM_ yield [1..3 :: Int]+-- conduit1 = CL.map (+1)+-- conduit2 = CL.concatMap (replicate 2)+-- conduit = getZipConduit $ ZipConduit conduit1 <* ZipConduit conduit2+-- sink = CL.mapM_ print+-- src $$ conduit =$ sink+-- @+--+-- It will produce the output: 2, 1, 1, 3, 2, 2, 4, 3, 3+--+-- Since 1.0.17+newtype ZipConduit i o m r = ZipConduit { getZipConduit :: ConduitT i o m r }+ deriving Functor+instance Monad m => Applicative (ZipConduit i o m) where+ pure = ZipConduit . pure+ ZipConduit left <*> ZipConduit right = ZipConduit (zipConduitApp left right)++-- | Provide identical input to all of the @Conduit@s and combine their outputs+-- into a single stream.+--+-- Implemented on top of @ZipConduit@, see that data type for more details.+--+-- Since 1.0.17+sequenceConduits :: (Traversable f, Monad m) => f (ConduitT i o m r) -> ConduitT i o m (f r)+sequenceConduits = getZipConduit . sequenceA . fmap ZipConduit++-- | Fuse two @ConduitT@s together, and provide the return value of both. Note+-- that this will force the entire upstream @ConduitT@ to be run to produce the+-- result value, even if the downstream terminates early.+--+-- Since 1.1.5+fuseBoth :: Monad m => ConduitT a b m r1 -> ConduitT b c m r2 -> ConduitT a c m (r1, r2)+fuseBoth (ConduitT up) (ConduitT down) =+ ConduitT (pipeL (up Done) (withUpstream $ generalizeUpstream $ down Done) >>=)+{-# INLINE fuseBoth #-}++-- | Like 'fuseBoth', but does not force consumption of the @Producer@.+-- In the case that the @Producer@ terminates, the result value is+-- provided as a @Just@ value. If it does not terminate, then a+-- @Nothing@ value is returned.+--+-- One thing to note here is that "termination" here only occurs if the+-- @Producer@ actually yields a @Nothing@ value. For example, with the+-- @Producer@ @mapM_ yield [1..5]@, if five values are requested, the+-- @Producer@ has not yet terminated. Termination only occurs when the+-- sixth value is awaited for and the @Producer@ signals termination.+--+-- Since 1.2.4+fuseBothMaybe+ :: Monad m+ => ConduitT a b m r1+ -> ConduitT b c m r2+ -> ConduitT a c m (Maybe r1, r2)+fuseBothMaybe (ConduitT up) (ConduitT down) =+ ConduitT (pipeL (up Done) (go Nothing $ down Done) >>=)+ where+ go mup (Done r) = Done (mup, r)+ go mup (PipeM mp) = PipeM $ liftM (go mup) mp+ go mup (HaveOutput p o) = HaveOutput (go mup p) o+ go _ (NeedInput p c) = NeedInput+ (\i -> go Nothing (p i))+ (\u -> go (Just u) (c ()))+ go mup (Leftover p i) = Leftover (go mup p) i+{-# INLINABLE fuseBothMaybe #-}++-- | Same as @fuseBoth@, but ignore the return value from the downstream+-- @Conduit@. Same caveats of forced consumption apply.+--+-- Since 1.1.5+fuseUpstream :: Monad m => ConduitT a b m r -> ConduitT b c m () -> ConduitT a c m r+fuseUpstream up down = fmap fst (fuseBoth up down)+{-# INLINE fuseUpstream #-}++-- Rewrite rules++{- FIXME+{-# RULES "conduit: ConduitT: lift x >>= f" forall m f. lift m >>= f = ConduitT (PipeM (liftM (unConduitT . f) m)) #-}+{-# RULES "conduit: ConduitT: lift x >> f" forall m f. lift m >> f = ConduitT (PipeM (liftM (\_ -> unConduitT f) m)) #-}++{-# RULES "conduit: ConduitT: liftIO x >>= f" forall m (f :: MonadIO m => a -> ConduitT i o m r). liftIO m >>= f = ConduitT (PipeM (liftM (unConduitT . f) (liftIO m))) #-}+{-# RULES "conduit: ConduitT: liftIO x >> f" forall m (f :: MonadIO m => ConduitT i o m r). liftIO m >> f = ConduitT (PipeM (liftM (\_ -> unConduitT f) (liftIO m))) #-}++{-# RULES "conduit: ConduitT: liftBase x >>= f" forall m (f :: MonadBase b m => a -> ConduitT i o m r). liftBase m >>= f = ConduitT (PipeM (liftM (unConduitT . f) (liftBase m))) #-}+{-# RULES "conduit: ConduitT: liftBase x >> f" forall m (f :: MonadBase b m => ConduitT i o m r). liftBase m >> f = ConduitT (PipeM (liftM (\_ -> unConduitT f) (liftBase m))) #-}++{-# RULES+ "yield o >> p" forall o (p :: ConduitT i o m r). yield o >> p = ConduitT (HaveOutput (unConduitT p) o)+ ; "when yield next" forall b o p. when b (yield o) >> p =+ if b then ConduitT (HaveOutput (unConduitT p) o) else p+ ; "unless yield next" forall b o p. unless b (yield o) >> p =+ if b then p else ConduitT (HaveOutput (unConduitT p) o)+ ; "lift m >>= yield" forall m. lift m >>= yield = yieldM m+ #-}+{-# RULES "conduit: leftover l >> p" forall l (p :: ConduitT i o m r). leftover l >> p =+ ConduitT (Leftover (unConduitT p) l) #-}+ -}++-- | Run a pure pipeline until processing completes, i.e. a pipeline+-- with @Identity@ as the base monad. This is equivalient to+-- @runIdentity . runConduit@.+--+-- @since 1.2.8+runConduitPure :: ConduitT () Void Identity r -> r+runConduitPure = runIdentity . runConduit+{-# INLINE runConduitPure #-}++-- | Run a pipeline which acquires resources with @ResourceT@, and+-- then run the @ResourceT@ transformer. This is equivalent to+-- @runResourceT . runConduit@.+--+-- @since 1.2.8+runConduitRes :: MonadUnliftIO m+ => ConduitT () Void (ResourceT m) r+ -> m r+runConduitRes = runResourceT . runConduit+{-# INLINE runConduitRes #-}
+ src/Data/Conduit/Internal/Fusion.hs view
@@ -0,0 +1,286 @@+{-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE ScopedTypeVariables #-}+module Data.Conduit.Internal.Fusion+ ( -- ** Types+ Step (..)+ , Stream (..)+ , ConduitWithStream+ , StreamConduitT+ , StreamConduit+ , StreamSource+ , StreamProducer+ , StreamSink+ , StreamConsumer+ -- ** Functions+ , streamConduit+ , streamSource+ , streamSourcePure+ , unstream+ ) where++import Data.Conduit.Internal.Conduit+import Data.Conduit.Internal.Pipe (Pipe (..))+import Data.Functor.Identity (Identity (runIdentity))+import Data.Void (Void, absurd)+import Control.Monad.Trans.Resource (runResourceT)++-- | This is the same as stream fusion\'s Step. Constructors are renamed to+-- avoid confusion with conduit names.+data Step s o r+ = Emit s o+ | Skip s+ | Stop r+ deriving Functor++data Stream m o r = forall s. Stream+ (s -> m (Step s o r))+ (m s)++data ConduitWithStream i o m r = ConduitWithStream+ (ConduitT i o m r)+ (StreamConduitT i o m r)++type StreamConduitT i o m r = Stream m i () -> Stream m o r++type StreamConduit i m o = StreamConduitT i o m ()++type StreamSource m o = StreamConduitT () o m ()++type StreamProducer m o = forall i. StreamConduitT i o m ()++type StreamSink i m r = StreamConduitT i Void m r++type StreamConsumer i m r = forall o. StreamConduitT i o m r++unstream :: ConduitWithStream i o m r -> ConduitT i o m r+unstream (ConduitWithStream c _) = c+{-# INLINE [0] unstream #-}++fuseStream :: Monad m+ => ConduitWithStream a b m ()+ -> ConduitWithStream b c m r+ -> ConduitWithStream a c m r+fuseStream (ConduitWithStream a x) (ConduitWithStream b y) =+ ConduitWithStream (a .| b) (y . x)+{-# INLINE fuseStream #-}++{-# RULES "conduit: fuseStream (.|)" forall left right.+ unstream left .| unstream right = unstream (fuseStream left right)+ #-}+{-# RULES "conduit: fuseStream (fuse)" forall left right.+ fuse (unstream left) (unstream right) = unstream (fuseStream left right)+ #-}+{-# RULES "conduit: fuseStream (=$=)" forall left right.+ unstream left =$= unstream right = unstream (fuseStream left right)+ #-}++runStream :: Monad m+ => ConduitWithStream () Void m r+ -> m r+runStream (ConduitWithStream _ f) =+ run $ f $ Stream emptyStep (return ())+ where+ emptyStep _ = return $ Stop ()+ run (Stream step ms0) =+ ms0 >>= loop+ where+ loop s = do+ res <- step s+ case res of+ Stop r -> return r+ Skip s' -> loop s'+ Emit _ o -> absurd o+{-# INLINE runStream #-}++{-# RULES "conduit: runStream" forall stream.+ runConduit (unstream stream) = runStream stream+ #-}+{-# RULES "conduit: runStream (pure)" forall stream.+ runConduitPure (unstream stream) = runIdentity (runStream stream)+ #-}+{-# RULES "conduit: runStream (ResourceT)" forall stream.+ runConduitRes (unstream stream) = runResourceT (runStream stream)+ #-}++connectStream :: Monad m+ => ConduitWithStream () i m ()+ -> ConduitWithStream i Void m r+ -> m r+connectStream (ConduitWithStream _ stream) (ConduitWithStream _ f) =+ run $ f $ stream $ Stream emptyStep (return ())+ where+ emptyStep _ = return $ Stop ()+ run (Stream step ms0) =+ ms0 >>= loop+ where+ loop s = do+ res <- step s+ case res of+ Stop r -> return r+ Skip s' -> loop s'+ Emit _ o -> absurd o+{-# INLINE connectStream #-}++{-# RULES "conduit: connectStream ($$)" forall left right.+ unstream left $$ unstream right = connectStream left right+ #-}++connectStream1 :: Monad m+ => ConduitWithStream () i m ()+ -> ConduitT i Void m r+ -> m r+connectStream1 (ConduitWithStream _ fstream) (ConduitT sink0) =+ case fstream $ Stream (const $ return $ Stop ()) (return ()) of+ Stream step ms0 ->+ let loop _ (Done r) _ = return r+ loop ls (PipeM mp) s = mp >>= flip (loop ls) s+ loop ls (Leftover p l) s = loop (l:ls) p s+ loop _ (HaveOutput _ o) _ = absurd o+ loop (l:ls) (NeedInput p _) s = loop ls (p l) s+ loop [] (NeedInput p c) s = do+ res <- step s+ case res of+ Stop () -> loop [] (c ()) s+ Skip s' -> loop [] (NeedInput p c) s'+ Emit s' i -> loop [] (p i) s'+ in ms0 >>= loop [] (sink0 Done)+{-# INLINE connectStream1 #-}++{-# RULES "conduit: connectStream1 ($$)" forall left right.+ unstream left $$ right = connectStream1 left right+ #-}++{-# RULES "conduit: connectStream1 (runConduit/.|)" forall left right.+ runConduit (unstream left .| right) = connectStream1 left right+ #-}+{-# RULES "conduit: connectStream1 (runConduit/=$=)" forall left right.+ runConduit (unstream left =$= right) = connectStream1 left right+ #-}+{-# RULES "conduit: connectStream1 (runConduit/fuse)" forall left right.+ runConduit (fuse (unstream left) right) = connectStream1 left right+ #-}++{-# RULES "conduit: connectStream1 (runConduitPure/.|)" forall left right.+ runConduitPure (unstream left .| right) = runIdentity (connectStream1 left right)+ #-}+{-# RULES "conduit: connectStream1 (runConduitPure/=$=)" forall left right.+ runConduitPure (unstream left =$= right) = runIdentity (connectStream1 left right)+ #-}+{-# RULES "conduit: connectStream1 (runConduitPure/fuse)" forall left right.+ runConduitPure (fuse (unstream left) right) = runIdentity (connectStream1 left right)+ #-}++{-# RULES "conduit: connectStream1 (runConduitRes/.|)" forall left right.+ runConduitRes (unstream left .| right) = runResourceT (connectStream1 left right)+ #-}+{-# RULES "conduit: connectStream1 (runConduitRes/=$=)" forall left right.+ runConduitRes (unstream left =$= right) = runResourceT (connectStream1 left right)+ #-}+{-# RULES "conduit: connectStream1 (runConduitRes/fuse)" forall left right.+ runConduitRes (fuse (unstream left) right) = runResourceT (connectStream1 left right)+ #-}++connectStream2 :: forall i m r. Monad m+ => ConduitT () i m ()+ -> ConduitWithStream i Void m r+ -> m r+connectStream2 (ConduitT src0) (ConduitWithStream _ fstream) =+ run $ fstream $ Stream step' $ return (src0 Done)+ where+ step' :: Pipe () () i () m () -> m (Step (Pipe () () i () m ()) i ())+ step' (Done ()) = return $ Stop ()+ step' (HaveOutput pipe o) = return $ Emit pipe o+ step' (NeedInput _ c) = return $ Skip $ c ()+ step' (PipeM mp) = Skip <$> mp+ step' (Leftover p ()) = return $ Skip p+ {-# INLINE step' #-}++ run (Stream step ms0) =+ ms0 >>= loop+ where+ loop s = do+ res <- step s+ case res of+ Stop r -> return r+ Emit _ o -> absurd o+ Skip s' -> loop s'+{-# INLINE connectStream2 #-}++{-# RULES "conduit: connectStream2 ($$)" forall left right.+ left $$ unstream right = connectStream2 left right+ #-}++{-# RULES "conduit: connectStream2 (runConduit/.|)" forall left right.+ runConduit (left .| unstream right) = connectStream2 left right+ #-}+{-# RULES "conduit: connectStream2 (runConduit/fuse)" forall left right.+ runConduit (fuse left (unstream right)) = connectStream2 left right+ #-}+{-# RULES "conduit: connectStream2 (runConduit/=$=)" forall left right.+ runConduit (left =$= unstream right) = connectStream2 left right+ #-}++{-# RULES "conduit: connectStream2 (runConduitPure/.|)" forall left right.+ runConduitPure (left .| unstream right) = runIdentity (connectStream2 left right)+ #-}+{-# RULES "conduit: connectStream2 (runConduitPure/fuse)" forall left right.+ runConduitPure (fuse left (unstream right)) = runIdentity (connectStream2 left right)+ #-}+{-# RULES "conduit: connectStream2 (runConduitPure/=$=)" forall left right.+ runConduitPure (left =$= unstream right) = runIdentity (connectStream2 left right)+ #-}++{-# RULES "conduit: connectStream2 (runConduitRes/.|)" forall left right.+ runConduitRes (left .| unstream right) = runResourceT (connectStream2 left right)+ #-}+{-# RULES "conduit: connectStream2 (runConduitRes/fuse)" forall left right.+ runConduitRes (fuse left (unstream right)) = runResourceT (connectStream2 left right)+ #-}+{-# RULES "conduit: connectStream2 (runConduitRes/=$=)" forall left right.+ runConduitRes (left =$= unstream right) = runResourceT (connectStream2 left right)+ #-}++streamConduit :: ConduitT i o m r+ -> (Stream m i () -> Stream m o r)+ -> ConduitWithStream i o m r+streamConduit = ConduitWithStream+{-# INLINE CONLIKE streamConduit #-}++streamSource+ :: Monad m+ => Stream m o ()+ -> ConduitWithStream i o m ()+streamSource str@(Stream step ms0) =+ ConduitWithStream con (const str)+ where+ con = ConduitT $ \rest -> PipeM $ do+ s0 <- ms0+ let loop s = do+ res <- step s+ case res of+ Stop () -> return $ rest ()+ Emit s' o -> return $ HaveOutput (PipeM $ loop s') o+ Skip s' -> loop s'+ loop s0+{-# INLINE streamSource #-}++streamSourcePure+ :: Monad m+ => Stream Identity o ()+ -> ConduitWithStream i o m ()+streamSourcePure (Stream step ms0) =+ ConduitWithStream con (const $ Stream (return . runIdentity . step) (return s0))+ where+ s0 = runIdentity ms0+ con = ConduitT $ \rest ->+ let loop s =+ case runIdentity $ step s of+ Stop () -> rest ()+ Emit s' o -> HaveOutput (loop s') o+ Skip s' -> loop s'+ in loop s0+{-# INLINE streamSourcePure #-}
+ src/Data/Conduit/Internal/List/Stream.hs view
@@ -0,0 +1,502 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE Trustworthy #-}+module Data.Conduit.Internal.List.Stream where++import Control.Monad (liftM)+import Data.Conduit.Internal.Fusion+import qualified Data.Foldable as F++--FIXME: Should streamSource / streamSourcePure be used for sources?++unfoldS :: Monad m+ => (b -> Maybe (a, b))+ -> b+ -> StreamProducer m a+unfoldS f s0 _ =+ Stream step (return s0)+ where+ step s = return $+ case f s of+ Nothing -> Stop ()+ Just (x, s') -> Emit s' x+{-# INLINE unfoldS #-}++unfoldEitherS :: Monad m+ => (b -> Either r (a, b))+ -> b+ -> StreamConduitT i a m r+unfoldEitherS f s0 _ =+ Stream step (return s0)+ where+ step s = return $+ case f s of+ Left r -> Stop r+ Right (x, s') -> Emit s' x+{-# INLINE unfoldEitherS #-}++unfoldMS :: Monad m+ => (b -> m (Maybe (a, b)))+ -> b+ -> StreamProducer m a+unfoldMS f s0 _ =+ Stream step (return s0)+ where+ step s = do+ ms' <- f s+ return $ case ms' of+ Nothing -> Stop ()+ Just (x, s') -> Emit s' x+{-# INLINE unfoldMS #-}++unfoldEitherMS :: Monad m+ => (b -> m (Either r (a, b)))+ -> b+ -> StreamConduitT i a m r+unfoldEitherMS f s0 _ =+ Stream step (return s0)+ where+ step s = do+ ms' <- f s+ return $ case ms' of+ Left r -> Stop r+ Right (x, s') -> Emit s' x+{-# INLINE unfoldEitherMS #-}+sourceListS :: Monad m => [a] -> StreamProducer m a+sourceListS xs0 _ =+ Stream (return . step) (return xs0)+ where+ step [] = Stop ()+ step (x:xs) = Emit xs x+{-# INLINE sourceListS #-}++enumFromToS :: (Enum a, Prelude.Ord a, Monad m)+ => a+ -> a+ -> StreamProducer m a+enumFromToS x0 y _ =+ Stream step (return x0)+ where+ step x = return $ if x Prelude.> y+ then Stop ()+ else Emit (Prelude.succ x) x+{-# INLINE [0] enumFromToS #-}++enumFromToS_int :: (Prelude.Integral a, Monad m)+ => a+ -> a+ -> StreamProducer m a+enumFromToS_int x0 y _ = x0 `seq` y `seq` Stream step (return x0)+ where+ step x | x <= y = return $ Emit (x Prelude.+ 1) x+ | otherwise = return $ Stop ()+{-# INLINE enumFromToS_int #-}++{-# RULES "conduit: enumFromTo<Int>" forall f t.+ enumFromToS f t = enumFromToS_int f t :: Monad m => StreamProducer m Int+ #-}++iterateS :: Monad m => (a -> a) -> a -> StreamProducer m a+iterateS f x0 _ =+ Stream (return . step) (return x0)+ where+ step x = Emit x' x+ where+ x' = f x+{-# INLINE iterateS #-}++replicateS :: Monad m => Int -> a -> StreamProducer m a+replicateS cnt0 a _ =+ Stream step (return cnt0)+ where+ step cnt+ | cnt <= 0 = return $ Stop ()+ | otherwise = return $ Emit (cnt - 1) a+{-# INLINE replicateS #-}++replicateMS :: Monad m => Int -> m a -> StreamProducer m a+replicateMS cnt0 ma _ =+ Stream step (return cnt0)+ where+ step cnt+ | cnt <= 0 = return $ Stop ()+ | otherwise = Emit (cnt - 1) `liftM` ma+{-# INLINE replicateMS #-}++foldS :: Monad m => (b -> a -> b) -> b -> StreamConsumer a m b+foldS f b0 (Stream step ms0) =+ Stream step' (liftM (b0, ) ms0)+ where+ step' (!b, s) = do+ res <- step s+ return $ case res of+ Stop () -> Stop b+ Skip s' -> Skip (b, s')+ Emit s' a -> Skip (f b a, s')+{-# INLINE foldS #-}++foldMS :: Monad m => (b -> a -> m b) -> b -> StreamConsumer a m b+foldMS f b0 (Stream step ms0) =+ Stream step' (liftM (b0, ) ms0)+ where+ step' (!b, s) = do+ res <- step s+ case res of+ Stop () -> return $ Stop b+ Skip s' -> return $ Skip (b, s')+ Emit s' a -> do+ b' <- f b a+ return $ Skip (b', s')+{-# INLINE foldMS #-}++mapM_S :: Monad m+ => (a -> m ())+ -> StreamConsumer a m ()+mapM_S f (Stream step ms0) =+ Stream step' ms0+ where+ step' s = do+ res <- step s+ case res of+ Stop () -> return $ Stop ()+ Skip s' -> return $ Skip s'+ Emit s' x -> f x >> return (Skip s')+{-# INLINE [1] mapM_S #-}++dropS :: Monad m+ => Int+ -> StreamConsumer a m ()+dropS n0 (Stream step ms0) =+ Stream step' (liftM (, n0) ms0)+ where+ step' (_, n) | n <= 0 = return $ Stop ()+ step' (s, n) = do+ res <- step s+ return $ case res of+ Stop () -> Stop ()+ Skip s' -> Skip (s', n)+ Emit s' _ -> Skip (s', n - 1)+{-# INLINE dropS #-}++takeS :: Monad m+ => Int+ -> StreamConsumer a m [a]+takeS n0 (Stream step s0) =+ Stream step' (liftM (id, n0,) s0)+ where+ step' (output, n, _) | n <= 0 = return $ Stop (output [])+ step' (output, n, s) = do+ res <- step s+ return $ case res of+ Stop () -> Stop (output [])+ Skip s' -> Skip (output, n, s')+ Emit s' x -> Skip (output . (x:), n - 1, s')+{-# INLINE takeS #-}++headS :: Monad m => StreamConsumer a m (Maybe a)+headS (Stream step s0) =+ Stream step' s0+ where+ step' s = do+ res <- step s+ return $ case res of+ Stop () -> Stop Nothing+ Skip s' -> Skip s'+ Emit _ x -> Stop (Just x)+{-# INLINE headS #-}++mapS :: Monad m => (a -> b) -> StreamConduit a m b+mapS f (Stream step ms0) =+ Stream step' ms0+ where+ step' s = do+ res <- step s+ return $ case res of+ Stop r -> Stop r+ Emit s' a -> Emit s' (f a)+ Skip s' -> Skip s'+{-# INLINE mapS #-}++mapMS :: Monad m => (a -> m b) -> StreamConduit a m b+mapMS f (Stream step ms0) =+ Stream step' ms0+ where+ step' s = do+ res <- step s+ case res of+ Stop r -> return $ Stop r+ Emit s' a -> Emit s' `liftM` f a+ Skip s' -> return $ Skip s'+{-# INLINE mapMS #-}++iterMS :: Monad m => (a -> m ()) -> StreamConduit a m a+iterMS f (Stream step ms0) =+ Stream step' ms0+ where+ step' s = do+ res <- step s+ case res of+ Stop () -> return $ Stop ()+ Skip s' -> return $ Skip s'+ Emit s' x -> f x >> return (Emit s' x)+{-# INLINE iterMS #-}++mapMaybeS :: Monad m => (a -> Maybe b) -> StreamConduit a m b+mapMaybeS f (Stream step ms0) =+ Stream step' ms0+ where+ step' s = do+ res <- step s+ return $ case res of+ Stop () -> Stop ()+ Skip s' -> Skip s'+ Emit s' x ->+ case f x of+ Just y -> Emit s' y+ Nothing -> Skip s'+{-# INLINE mapMaybeS #-}++mapMaybeMS :: Monad m => (a -> m (Maybe b)) -> StreamConduit a m b+mapMaybeMS f (Stream step ms0) =+ Stream step' ms0+ where+ step' s = do+ res <- step s+ case res of+ Stop () -> return $ Stop ()+ Skip s' -> return $ Skip s'+ Emit s' x -> do+ my <- f x+ case my of+ Just y -> return $ Emit s' y+ Nothing -> return $ Skip s'+{-# INLINE mapMaybeMS #-}++catMaybesS :: Monad m => StreamConduit (Maybe a) m a+catMaybesS (Stream step ms0) =+ Stream step' ms0+ where+ step' s = do+ res <- step s+ return $ case res of+ Stop () -> Stop ()+ Skip s' -> Skip s'+ Emit s' Nothing -> Skip s'+ Emit s' (Just x) -> Emit s' x+{-# INLINE catMaybesS #-}++concatS :: (Monad m, F.Foldable f) => StreamConduit (f a) m a+concatS (Stream step ms0) =+ Stream step' (liftM ([], ) ms0)+ where+ step' ([], s) = do+ res <- step s+ return $ case res of+ Stop () -> Stop ()+ Skip s' -> Skip ([], s')+ Emit s' x -> Skip (F.toList x, s')+ step' ((x:xs), s) = return (Emit (xs, s) x)+{-# INLINE concatS #-}++concatMapS :: Monad m => (a -> [b]) -> StreamConduit a m b+concatMapS f (Stream step ms0) =+ Stream step' (liftM ([], ) ms0)+ where+ step' ([], s) = do+ res <- step s+ return $ case res of+ Stop () -> Stop ()+ Skip s' -> Skip ([], s')+ Emit s' x -> Skip (f x, s')+ step' ((x:xs), s) = return (Emit (xs, s) x)+{-# INLINE concatMapS #-}++concatMapMS :: Monad m => (a -> m [b]) -> StreamConduit a m b+concatMapMS f (Stream step ms0) =+ Stream step' (liftM ([], ) ms0)+ where+ step' ([], s) = do+ res <- step s+ case res of+ Stop () -> return $ Stop ()+ Skip s' -> return $ Skip ([], s')+ Emit s' x -> do+ xs <- f x+ return $ Skip (xs, s')+ step' ((x:xs), s) = return (Emit (xs, s) x)+{-# INLINE concatMapMS #-}++concatMapAccumS :: Monad m => (a -> accum -> (accum, [b])) -> accum -> StreamConduit a m b+concatMapAccumS f initial (Stream step ms0) =+ Stream step' (liftM (initial, [], ) ms0)+ where+ step' (accum, [], s) = do+ res <- step s+ return $ case res of+ Stop () -> Stop ()+ Skip s' -> Skip (accum, [], s')+ Emit s' x ->+ let (accum', xs) = f x accum+ in Skip (accum', xs, s')+ step' (accum, (x:xs), s) = return (Emit (accum, xs, s) x)+{-# INLINE concatMapAccumS #-}++mapAccumS :: Monad m => (a -> s -> (s, b)) -> s -> StreamConduitT a b m s+mapAccumS f initial (Stream step ms0) =+ Stream step' (liftM (initial, ) ms0)+ where+ step' (accum, s) = do+ res <- step s+ return $ case res of+ Stop () -> Stop accum+ Skip s' -> Skip (accum, s')+ Emit s' x ->+ let (accum', r) = f x accum+ in Emit (accum', s') r+{-# INLINE mapAccumS #-}++mapAccumMS :: Monad m => (a -> s -> m (s, b)) -> s -> StreamConduitT a b m s+mapAccumMS f initial (Stream step ms0) =+ Stream step' (liftM (initial, ) ms0)+ where+ step' (accum, s) = do+ res <- step s+ case res of+ Stop () -> return $ Stop accum+ Skip s' -> return $ Skip (accum, s')+ Emit s' x -> do+ (accum', r) <- f x accum+ return $ Emit (accum', s') r+{-# INLINE mapAccumMS #-}++concatMapAccumMS :: Monad m => (a -> accum -> m (accum, [b])) -> accum -> StreamConduit a m b+concatMapAccumMS f initial (Stream step ms0) =+ Stream step' (liftM (initial, [], ) ms0)+ where+ step' (accum, [], s) = do+ res <- step s+ case res of+ Stop () -> return $ Stop ()+ Skip s' -> return $ Skip (accum, [], s')+ Emit s' x -> do+ (accum', xs) <- f x accum+ return $ Skip (accum', xs, s')+ step' (accum, (x:xs), s) = return (Emit (accum, xs, s) x)+{-# INLINE concatMapAccumMS #-}++mapFoldableS :: (Monad m, F.Foldable f) => (a -> f b) -> StreamConduit a m b+mapFoldableS f (Stream step ms0) =+ Stream step' (liftM ([], ) ms0)+ where+ step' ([], s) = do+ res <- step s+ return $ case res of+ Stop () -> Stop ()+ Skip s' -> Skip ([], s')+ Emit s' x -> Skip (F.toList (f x), s')+ step' ((x:xs), s) = return (Emit (xs, s) x)+{-# INLINE mapFoldableS #-}++mapFoldableMS :: (Monad m, F.Foldable f) => (a -> m (f b)) -> StreamConduit a m b+mapFoldableMS f (Stream step ms0) =+ Stream step' (liftM ([], ) ms0)+ where+ step' ([], s) = do+ res <- step s+ case res of+ Stop () -> return $ Stop ()+ Skip s' -> return $ Skip ([], s')+ Emit s' x -> do+ y <- f x+ return $ Skip (F.toList y, s')+ step' ((x:xs), s) = return (Emit (xs, s) x)+{-# INLINE mapFoldableMS #-}++consumeS :: Monad m => StreamConsumer a m [a]+consumeS (Stream step ms0) =+ Stream step' (liftM (id,) ms0)+ where+ step' (front, s) = do+ res <- step s+ return $ case res of+ Stop () -> Stop (front [])+ Skip s' -> Skip (front, s')+ Emit s' a -> Skip (front . (a:), s')+{-# INLINE consumeS #-}++groupByS :: Monad m => (a -> a -> Bool) -> StreamConduit a m [a]+groupByS f = mapS (Prelude.uncurry (:)) . groupBy1S id f+{-# INLINE groupByS #-}++groupOn1S :: (Monad m, Eq b) => (a -> b) -> StreamConduit a m (a, [a])+groupOn1S f = groupBy1S f (==)+{-# INLINE groupOn1S #-}++data GroupByState a b s+ = GBStart s+ | GBLoop ([a] -> [a]) a b s+ | GBDone++groupBy1S :: Monad m => (a -> b) -> (b -> b -> Bool) -> StreamConduit a m (a, [a])+groupBy1S f eq (Stream step ms0) =+ Stream step' (liftM GBStart ms0)+ where+ step' (GBStart s) = do+ res <- step s+ return $ case res of+ Stop () -> Stop ()+ Skip s' -> Skip (GBStart s')+ Emit s' x0 -> Skip (GBLoop id x0 (f x0) s')+ step' (GBLoop rest x0 fx0 s) = do+ res <- step s+ return $ case res of+ Stop () -> Emit GBDone (x0, rest [])+ Skip s' -> Skip (GBLoop rest x0 fx0 s')+ Emit s' x+ | fx0 `eq` f x -> Skip (GBLoop (rest . (x:)) x0 fx0 s')+ | otherwise -> Emit (GBLoop id x (f x) s') (x0, rest [])+ step' GBDone = return $ Stop ()+{-# INLINE groupBy1S #-}++isolateS :: Monad m => Int -> StreamConduit a m a+isolateS count (Stream step ms0) =+ Stream step' (liftM (count,) ms0)+ where+ step' (n, _) | n <= 0 = return $ Stop ()+ step' (n, s) = do+ res <- step s+ return $ case res of+ Stop () -> Stop ()+ Skip s' -> Skip (n, s')+ Emit s' x -> Emit (n - 1, s') x+{-# INLINE isolateS #-}++filterS :: Monad m => (a -> Bool) -> StreamConduit a m a+filterS f (Stream step ms0) =+ Stream step' ms0+ where+ step' s = do+ res <- step s+ return $ case res of+ Stop () -> Stop ()+ Skip s' -> Skip s'+ Emit s' x+ | f x -> Emit s' x+ | otherwise -> Skip s'++sinkNullS :: Monad m => StreamConsumer a m ()+sinkNullS (Stream step ms0) =+ Stream step' ms0+ where+ step' s = do+ res <- step s+ return $ case res of+ Stop () -> Stop ()+ Skip s' -> Skip s'+ Emit s' _ -> Skip s'+{-# INLINE sinkNullS #-}++sourceNullS :: Monad m => StreamProducer m a+sourceNullS _ = Stream (\_ -> return (Stop ())) (return ())+{-# INLINE sourceNullS #-}
+ src/Data/Conduit/Internal/Pipe.hs view
@@ -0,0 +1,619 @@+{-# OPTIONS_HADDOCK not-home #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE TypeFamilies #-}+module Data.Conduit.Internal.Pipe+ ( -- ** Types+ Pipe (..)+ -- ** Primitives+ , await+ , awaitE+ , awaitForever+ , yield+ , yieldM+ , leftover+ , unconsM+ , unconsEitherM+ -- ** Finalization+ , bracketP+ -- ** Composition+ , idP+ , pipe+ , pipeL+ , runPipe+ , injectLeftovers+ , (>+>)+ , (<+<)+ -- ** Exceptions+ , catchP+ , handleP+ , tryP+ -- ** Utilities+ , transPipe+ , mapOutput+ , mapOutputMaybe+ , mapInput+ , sourceList+ , withUpstream+ , Data.Conduit.Internal.Pipe.enumFromTo+ , generalizeUpstream+ ) where++import Control.Applicative (Applicative (..))+import Control.Monad ((>=>), liftM, ap)+import Control.Monad.Error.Class(MonadError(..))+import Control.Monad.Reader.Class(MonadReader(..))+import Control.Monad.RWS.Class(MonadRWS())+import Control.Monad.Writer.Class(MonadWriter(..))+import Control.Monad.State.Class(MonadState(..))+import Control.Monad.Trans.Class (MonadTrans (lift))+import Control.Monad.IO.Unlift (MonadIO (liftIO), MonadUnliftIO, withRunInIO)+import Control.Monad.Primitive (PrimMonad, PrimState, primitive)+import Data.Void (Void, absurd)+import Data.Monoid (Monoid (mappend, mempty))+import Data.Semigroup (Semigroup ((<>)))+import Control.Monad.Trans.Resource+import qualified GHC.Exts+import qualified Control.Exception as E++-- | The underlying datatype for all the types in this package. In has six+-- type parameters:+--+-- * /l/ is the type of values that may be left over from this @Pipe@. A @Pipe@+-- with no leftovers would use @Void@ here, and one with leftovers would use+-- the same type as the /i/ parameter. Leftovers are automatically provided to+-- the next @Pipe@ in the monadic chain.+--+-- * /i/ is the type of values for this @Pipe@'s input stream.+--+-- * /o/ is the type of values for this @Pipe@'s output stream.+--+-- * /u/ is the result type from the upstream @Pipe@.+--+-- * /m/ is the underlying monad.+--+-- * /r/ is the result type.+--+-- A basic intuition is that every @Pipe@ produces a stream of output values+-- (/o/), and eventually indicates that this stream is terminated by sending a+-- result (/r/). On the receiving end of a @Pipe@, these become the /i/ and /u/+-- parameters.+--+-- Since 0.5.0+data Pipe l i o u m r =+ -- | Provide new output to be sent downstream. This constructor has two+ -- fields: the next @Pipe@ to be used and the output value.+ HaveOutput (Pipe l i o u m r) o+ -- | Request more input from upstream. The first field takes a new input+ -- value and provides a new @Pipe@. The second takes an upstream result+ -- value, which indicates that upstream is producing no more results.+ | NeedInput (i -> Pipe l i o u m r) (u -> Pipe l i o u m r)+ -- | Processing with this @Pipe@ is complete, providing the final result.+ | Done r+ -- | Require running of a monadic action to get the next @Pipe@.+ | PipeM (m (Pipe l i o u m r))+ -- | Return leftover input, which should be provided to future operations.+ | Leftover (Pipe l i o u m r) l++instance Monad m => Functor (Pipe l i o u m) where+ fmap = liftM+ {-# INLINE fmap #-}++instance Monad m => Applicative (Pipe l i o u m) where+ pure = Done+ {-# INLINE pure #-}+ (<*>) = ap+ {-# INLINE (<*>) #-}++instance Monad m => Monad (Pipe l i o u m) where+ return = pure+ {-# INLINE return #-}++ HaveOutput p o >>= fp = HaveOutput (p >>= fp) o+ NeedInput p c >>= fp = NeedInput (p >=> fp) (c >=> fp)+ Done x >>= fp = fp x+ PipeM mp >>= fp = PipeM ((>>= fp) `liftM` mp)+ Leftover p i >>= fp = Leftover (p >>= fp) i++instance MonadTrans (Pipe l i o u) where+ lift mr = PipeM (Done `liftM` mr)+ {-# INLINE [1] lift #-}++instance MonadIO m => MonadIO (Pipe l i o u m) where+ liftIO = lift . liftIO+ {-# INLINE liftIO #-}++instance MonadThrow m => MonadThrow (Pipe l i o u m) where+ throwM = lift . throwM+ {-# INLINE throwM #-}+++instance Monad m => Semigroup (Pipe l i o u m ()) where+ (<>) = (>>)+ {-# INLINE (<>) #-}++instance Monad m => Monoid (Pipe l i o u m ()) where+ mempty = return ()+ {-# INLINE mempty #-}+#if !(MIN_VERSION_base(4,11,0))+ mappend = (<>)+ {-# INLINE mappend #-}+#endif++instance PrimMonad m => PrimMonad (Pipe l i o u m) where+ type PrimState (Pipe l i o u m) = PrimState m+ primitive = lift . primitive++instance MonadResource m => MonadResource (Pipe l i o u m) where+ liftResourceT = lift . liftResourceT+ {-# INLINE liftResourceT #-}++instance MonadReader r m => MonadReader r (Pipe l i o u m) where+ ask = lift ask+ {-# INLINE ask #-}+ local f (HaveOutput p o) = HaveOutput (local f p) o+ local f (NeedInput p c) = NeedInput (\i -> local f (p i)) (\u -> local f (c u))+ local _ (Done x) = Done x+ local f (PipeM mp) = PipeM (liftM (local f) $ local f mp)+ local f (Leftover p i) = Leftover (local f p) i++-- Provided for doctest+#ifndef MIN_VERSION_mtl+#define MIN_VERSION_mtl(x, y, z) 0+#endif++instance MonadWriter w m => MonadWriter w (Pipe l i o u m) where+#if MIN_VERSION_mtl(2, 1, 0)+ writer = lift . writer+#endif++ tell = lift . tell++ listen (HaveOutput p o) = HaveOutput (listen p) o+ listen (NeedInput p c) = NeedInput (\i -> listen (p i)) (\u -> listen (c u))+ listen (Done x) = Done (x,mempty)+ listen (PipeM mp) =+ PipeM $+ do (p,w) <- listen mp+ return $ do (x,w') <- listen p+ return (x, w `mappend` w')+ listen (Leftover p i) = Leftover (listen p) i++ pass (HaveOutput p o) = HaveOutput (pass p) o+ pass (NeedInput p c) = NeedInput (\i -> pass (p i)) (\u -> pass (c u))+ pass (PipeM mp) = PipeM $ mp >>= (return . pass)+ pass (Done (x,_)) = Done x+ pass (Leftover p i) = Leftover (pass p) i++instance MonadState s m => MonadState s (Pipe l i o u m) where+ get = lift get+ put = lift . put+#if MIN_VERSION_mtl(2, 1, 0)+ state = lift . state+#endif++instance MonadRWS r w s m => MonadRWS r w s (Pipe l i o u m)++instance MonadError e m => MonadError e (Pipe l i o u m) where+ throwError = lift . throwError+ catchError (HaveOutput p o) f = HaveOutput (catchError p f) o+ catchError (NeedInput p c) f = NeedInput (\i -> catchError (p i) f) (\u -> catchError (c u) f)+ catchError (Done x) _ = Done x+ catchError (PipeM mp) f =+ PipeM $ catchError (liftM (flip catchError f) mp) (\e -> return (f e))+ catchError (Leftover p i) f = Leftover (catchError p f) i++-- | Wait for a single input value from upstream.+--+-- Since 0.5.0+await :: Pipe l i o u m (Maybe i)+await = NeedInput (Done . Just) (\_ -> Done Nothing)+{-# RULES "conduit: CI.await >>= maybe" forall x y. await >>= maybe x y = NeedInput y (const x) #-}+{-# INLINE [1] await #-}++-- | This is similar to @await@, but will return the upstream result value as+-- @Left@ if available.+--+-- Since 0.5.0+awaitE :: Pipe l i o u m (Either u i)+awaitE = NeedInput (Done . Right) (Done . Left)+{-# RULES "conduit: awaitE >>= either" forall x y. awaitE >>= either x y = NeedInput y x #-}+{-# INLINE [1] awaitE #-}++-- | Wait for input forever, calling the given inner @Pipe@ for each piece of+-- new input. Returns the upstream result type.+--+-- Since 0.5.0+awaitForever :: Monad m => (i -> Pipe l i o r m r') -> Pipe l i o r m r+awaitForever inner =+ self+ where+ self = awaitE >>= either return (\i -> inner i >> self)+{-# INLINE [1] awaitForever #-}++-- | Send a single output value downstream. If the downstream @Pipe@+-- terminates, this @Pipe@ will terminate as well.+--+-- Since 0.5.0+yield :: Monad m+ => o -- ^ output value+ -> Pipe l i o u m ()+yield = HaveOutput (Done ())+{-# INLINE [1] yield #-}++yieldM :: Monad m => m o -> Pipe l i o u m ()+yieldM = PipeM . liftM (HaveOutput (Done ()))+{-# INLINE [1] yieldM #-}++{-# RULES+ "CI.yield o >> p" forall o (p :: Pipe l i o u m r). yield o >> p = HaveOutput p o+ #-}++ -- Rule does not fire due to inlining of lift+ -- ; "lift m >>= CI.yield" forall m. lift m >>= yield = yieldM m++ -- FIXME: Too much inlining on mapM_, can't enforce; "mapM_ CI.yield" mapM_ yield = sourceList+ -- Maybe we can get a rewrite rule on foldr instead? Need a benchmark to back this up.++-- | Provide a single piece of leftover input to be consumed by the next pipe+-- in the current monadic binding.+--+-- /Note/: it is highly encouraged to only return leftover values from input+-- already consumed from upstream.+--+-- Since 0.5.0+leftover :: l -> Pipe l i o u m ()+leftover = Leftover (Done ())+{-# INLINE [1] leftover #-}+{-# RULES "conduit: leftover l >> p" forall l (p :: Pipe l i o u m r). leftover l >> p = Leftover p l #-}++-- | Split a pipe into head and tail.+--+-- Since 1.3.3+unconsM :: Monad m+ => Pipe Void () o () m ()+ -> m (Maybe (o, Pipe Void () o () m ()))+unconsM = go+ where+ go (HaveOutput p o) = pure $ Just (o, p)+ go (NeedInput _ c) = go $ c ()+ go (Done ()) = pure Nothing+ go (PipeM mp) = mp >>= go+ go (Leftover _ i) = absurd i++-- | Split a pipe into head and tail or return its result if it is done.+--+-- Since 1.3.3+unconsEitherM :: Monad m+ => Pipe Void () o () m r+ -> m (Either r (o, Pipe Void () o () m r))+unconsEitherM = go+ where+ go (HaveOutput p o) = pure $ Right (o, p)+ go (NeedInput _ c) = go $ c ()+ go (Done r) = pure $ Left r+ go (PipeM mp) = mp >>= go+ go (Leftover _ i) = absurd i++-- | Bracket a pipe computation between allocation and release of a resource.+-- We guarantee, via the @MonadResource@ context, that the resource+-- finalization is exception safe. However, it will not necessarily be+-- /prompt/, in that running a finalizer may wait until the @ResourceT@ block+-- exits.+--+-- Since 0.5.0+bracketP :: MonadResource m+ => IO a+ -- ^ computation to run first (\"acquire resource\")+ -> (a -> IO ())+ -- ^ computation to run last (\"release resource\")+ -> (a -> Pipe l i o u m r)+ -- ^ computation to run in-between+ -> Pipe l i o u m r+ -- returns the value from the in-between computation+bracketP alloc free inside = do+ (key, seed) <- allocate alloc free+ res <- inside seed+ release key+ return res++-- | The identity @Pipe@.+--+-- Since 0.5.0+idP :: Monad m => Pipe l a a r m r+idP = NeedInput (HaveOutput idP) Done++-- | Compose a left and right pipe together into a complete pipe.+--+-- Since 0.5.0+pipe :: Monad m => Pipe l a b r0 m r1 -> Pipe Void b c r1 m r2 -> Pipe l a c r0 m r2+pipe =+ goRight+ where+ goRight left right =+ case right of+ HaveOutput p o -> HaveOutput (recurse p) o+ NeedInput rp rc -> goLeft rp rc left+ Done r2 -> Done r2+ PipeM mp -> PipeM (liftM recurse mp)+ Leftover _ i -> absurd i+ where+ recurse = goRight left++ goLeft rp rc left =+ case left of+ HaveOutput left' o -> goRight left' (rp o)+ NeedInput left' lc -> NeedInput (recurse . left') (recurse . lc)+ Done r1 -> goRight (Done r1) (rc r1)+ PipeM mp -> PipeM (liftM recurse mp)+ Leftover left' i -> Leftover (recurse left') i+ where+ recurse = goLeft rp rc++-- | Same as 'pipe', but automatically applies 'injectLeftovers' to the right @Pipe@.+--+-- Since 0.5.0+pipeL :: Monad m => Pipe l a b r0 m r1 -> Pipe b b c r1 m r2 -> Pipe l a c r0 m r2+-- Note: The following should be equivalent to the simpler:+--+-- pipeL l r = l `pipe` injectLeftovers r+--+-- However, this version tested as being significantly more efficient.+pipeL =+ goRight+ where+ goRight left right =+ case right of+ HaveOutput p o -> HaveOutput (recurse p) o+ NeedInput rp rc -> goLeft rp rc left+ Done r2 -> Done r2+ PipeM mp -> PipeM (liftM recurse mp)+ Leftover right' i -> goRight (HaveOutput left i) right'+ where+ recurse = goRight left++ goLeft rp rc left =+ case left of+ HaveOutput left' o -> goRight left' (rp o)+ NeedInput left' lc -> NeedInput (recurse . left') (recurse . lc)+ Done r1 -> goRight (Done r1) (rc r1)+ PipeM mp -> PipeM (liftM recurse mp)+ Leftover left' i -> Leftover (recurse left') i+ where+ recurse = goLeft rp rc++-- | Run a pipeline until processing completes.+--+-- Since 0.5.0+runPipe :: Monad m => Pipe Void () Void () m r -> m r+runPipe (HaveOutput _ o) = absurd o+runPipe (NeedInput _ c) = runPipe (c ())+runPipe (Done r) = return r+runPipe (PipeM mp) = mp >>= runPipe+runPipe (Leftover _ i) = absurd i++-- | Transforms a @Pipe@ that provides leftovers to one which does not,+-- allowing it to be composed.+--+-- This function will provide any leftover values within this @Pipe@ to any+-- calls to @await@. If there are more leftover values than are demanded, the+-- remainder are discarded.+--+-- Since 0.5.0+injectLeftovers :: Monad m => Pipe i i o u m r -> Pipe l i o u m r+injectLeftovers =+ go []+ where+ go ls (HaveOutput p o) = HaveOutput (go ls p) o+ go (l:ls) (NeedInput p _) = go ls $ p l+ go [] (NeedInput p c) = NeedInput (go [] . p) (go [] . c)+ go _ (Done r) = Done r+ go ls (PipeM mp) = PipeM (liftM (go ls) mp)+ go ls (Leftover p l) = go (l:ls) p++-- | Transform the monad that a @Pipe@ lives in.+--+-- Note that the monad transforming function will be run multiple times,+-- resulting in unintuitive behavior in some cases. For a fuller treatment,+-- please see:+--+-- <https://github.com/snoyberg/conduit/wiki/Dealing-with-monad-transformers>+--+-- This function is just a synonym for 'hoist'.+--+-- Since 0.4.0+transPipe :: Monad m => (forall a. m a -> n a) -> Pipe l i o u m r -> Pipe l i o u n r+transPipe f (HaveOutput p o) = HaveOutput (transPipe f p) o+transPipe f (NeedInput p c) = NeedInput (transPipe f . p) (transPipe f . c)+transPipe _ (Done r) = Done r+transPipe f (PipeM mp) =+ PipeM (f $ liftM (transPipe f) $ collapse mp)+ where+ -- Combine a series of monadic actions into a single action. Since we+ -- throw away side effects between different actions, an arbitrary break+ -- between actions will lead to a violation of the monad transformer laws.+ -- Example available at:+ --+ -- http://hpaste.org/75520+ collapse mpipe = do+ pipe' <- mpipe+ case pipe' of+ PipeM mpipe' -> collapse mpipe'+ _ -> return pipe'+transPipe f (Leftover p i) = Leftover (transPipe f p) i++-- | Apply a function to all the output values of a @Pipe@.+--+-- This mimics the behavior of `fmap` for a `Source` and `Conduit` in pre-0.4+-- days.+--+-- Since 0.4.1+mapOutput :: Monad m => (o1 -> o2) -> Pipe l i o1 u m r -> Pipe l i o2 u m r+mapOutput f =+ go+ where+ go (HaveOutput p o) = HaveOutput (go p) (f o)+ go (NeedInput p c) = NeedInput (go . p) (go . c)+ go (Done r) = Done r+ go (PipeM mp) = PipeM (liftM (go) mp)+ go (Leftover p i) = Leftover (go p) i+{-# INLINE mapOutput #-}++-- | Same as 'mapOutput', but use a function that returns @Maybe@ values.+--+-- Since 0.5.0+mapOutputMaybe :: Monad m => (o1 -> Maybe o2) -> Pipe l i o1 u m r -> Pipe l i o2 u m r+mapOutputMaybe f =+ go+ where+ go (HaveOutput p o) = maybe id (\o' p' -> HaveOutput p' o') (f o) (go p)+ go (NeedInput p c) = NeedInput (go . p) (go . c)+ go (Done r) = Done r+ go (PipeM mp) = PipeM (liftM (go) mp)+ go (Leftover p i) = Leftover (go p) i+{-# INLINE mapOutputMaybe #-}++-- | Apply a function to all the input values of a @Pipe@.+--+-- Since 0.5.0+mapInput :: Monad m+ => (i1 -> i2) -- ^ map initial input to new input+ -> (l2 -> Maybe l1) -- ^ map new leftovers to initial leftovers+ -> Pipe l2 i2 o u m r+ -> Pipe l1 i1 o u m r+mapInput f f' (HaveOutput p o) = HaveOutput (mapInput f f' p) o+mapInput f f' (NeedInput p c) = NeedInput (mapInput f f' . p . f) (mapInput f f' . c)+mapInput _ _ (Done r) = Done r+mapInput f f' (PipeM mp) = PipeM (liftM (mapInput f f') mp)+mapInput f f' (Leftover p i) = maybe id (flip Leftover) (f' i) $ mapInput f f' p++enumFromTo :: (Enum o, Eq o, Monad m)+ => o+ -> o+ -> Pipe l i o u m ()+enumFromTo start stop =+ loop start+ where+ loop i+ | i == stop = HaveOutput (Done ()) i+ | otherwise = HaveOutput (loop (succ i)) i+{-# INLINE enumFromTo #-}++-- | Convert a list into a source.+--+-- Since 0.3.0+sourceList :: Monad m => [a] -> Pipe l i a u m ()+sourceList =+ go+ where+ go [] = Done ()+ go (o:os) = HaveOutput (go os) o+{-# INLINE [1] sourceList #-}++-- | The equivalent of @GHC.Exts.build@ for @Pipe@.+--+-- Since 0.4.2+build :: Monad m => (forall b. (o -> b -> b) -> b -> b) -> Pipe l i o u m ()+build g = g (\o p -> HaveOutput p o) (return ())++{-# RULES+ "sourceList/build" forall (f :: (forall b. (a -> b -> b) -> b -> b)). sourceList (GHC.Exts.build f) = build f #-}++-- | Returns a tuple of the upstream and downstream results. Note that this+-- will force consumption of the entire input stream.+--+-- Since 0.5.0+withUpstream :: Monad m+ => Pipe l i o u m r+ -> Pipe l i o u m (u, r)+withUpstream down =+ down >>= go+ where+ go r =+ loop+ where+ loop = awaitE >>= either (\u -> return (u, r)) (\_ -> loop)++infixr 9 <+<+infixl 9 >+>++-- | Fuse together two @Pipe@s, connecting the output from the left to the+-- input of the right.+--+-- Notice that the /leftover/ parameter for the @Pipe@s must be @Void@. This+-- ensures that there is no accidental data loss of leftovers during fusion. If+-- you have a @Pipe@ with leftovers, you must first call 'injectLeftovers'.+--+-- Since 0.5.0+(>+>) :: Monad m => Pipe l a b r0 m r1 -> Pipe Void b c r1 m r2 -> Pipe l a c r0 m r2+(>+>) = pipe+{-# INLINE (>+>) #-}++-- | Same as '>+>', but reverse the order of the arguments.+--+-- Since 0.5.0+(<+<) :: Monad m => Pipe Void b c r1 m r2 -> Pipe l a b r0 m r1 -> Pipe l a c r0 m r2+(<+<) = flip pipe+{-# INLINE (<+<) #-}++-- | See 'catchC' for more details.+--+-- Since 1.0.11+catchP :: (MonadUnliftIO m, E.Exception e)+ => Pipe l i o u m r+ -> (e -> Pipe l i o u m r)+ -> Pipe l i o u m r+catchP p0 onErr =+ go p0+ where+ go (Done r) = Done r+ go (PipeM mp) = PipeM $ withRunInIO $ \run ->+ E.catch (run (liftM go mp)) (return . onErr)+ go (Leftover p i) = Leftover (go p) i+ go (NeedInput x y) = NeedInput (go . x) (go . y)+ go (HaveOutput p o) = HaveOutput (go p) o+{-# INLINABLE catchP #-}++-- | The same as @flip catchP@.+--+-- Since 1.0.11+handleP :: (MonadUnliftIO m, E.Exception e)+ => (e -> Pipe l i o u m r)+ -> Pipe l i o u m r+ -> Pipe l i o u m r+handleP = flip catchP+{-# INLINE handleP #-}++-- | See 'tryC' for more details.+--+-- Since 1.0.11+tryP :: (MonadUnliftIO m, E.Exception e)+ => Pipe l i o u m r+ -> Pipe l i o u m (Either e r)+tryP p = (fmap Right p) `catchP` (return . Left)+{-# INLINABLE tryP #-}++-- | Generalize the upstream return value for a @Pipe@ from unit to any type.+--+-- Since 1.1.5+generalizeUpstream :: Monad m => Pipe l i o () m r -> Pipe l i o u m r+generalizeUpstream =+ go+ where+ go (HaveOutput p o) = HaveOutput (go p) o+ go (NeedInput x y) = NeedInput (go . x) (\_ -> go (y ()))+ go (Done r) = Done r+ go (PipeM mp) = PipeM (liftM go mp)+ go (Leftover p l) = Leftover (go p) l+{-# INLINE generalizeUpstream #-}++{- Rules don't fire due to inlining of lift+{-# RULES "conduit: Pipe: lift x >>= f" forall m f. lift m >>= f = PipeM (liftM f m) #-}+{-# RULES "conduit: Pipe: lift x >> f" forall m f. lift m >> f = PipeM (liftM (\_ -> f) m) #-}+-}
+ src/Data/Conduit/Lift.hs view
@@ -0,0 +1,518 @@+{-# LANGUAGE RankNTypes #-}+-- | Allow monad transformers to be run\/eval\/exec in a section of conduit+-- rather then needing to run across the whole conduit. The circumvents many+-- of the problems with breaking the monad transformer laws. For more+-- information, see the announcement blog post:+-- <http://www.yesodweb.com/blog/2014/01/conduit-transformer-exception>+--+-- This module was added in conduit 1.0.11.+module Data.Conduit.Lift (+ -- * ExceptT+ exceptC,+ runExceptC,+ catchExceptC,++ -- * CatchC+ runCatchC,+ catchCatchC,++ -- * MaybeT+ maybeC,+ runMaybeC,++ -- * ReaderT+ readerC,+ runReaderC,++ -- * StateT, lazy+ stateLC,+ runStateLC,+ evalStateLC,+ execStateLC,++ -- ** Strict+ stateC,+ runStateC,+ evalStateC,+ execStateC,++ -- * WriterT, lazy+ writerLC,+ runWriterLC,+ execWriterLC,++ -- ** Strict+ writerC,+ runWriterC,+ execWriterC,++ -- * RWST, lazy+ rwsLC,+ runRWSLC,+ evalRWSLC,+ execRWSLC,++ -- ** Strict+ rwsC,+ runRWSC,+ evalRWSC,+ execRWSC+ ) where++import Data.Conduit+import Data.Conduit.Internal (ConduitT (..), Pipe (..))++import Control.Monad.Trans.Class (MonadTrans(..))++import Data.Monoid (Monoid(..))+++import qualified Control.Monad.Trans.Except as Ex+import qualified Control.Monad.Trans.Maybe as M+import qualified Control.Monad.Trans.Reader as R++import qualified Control.Monad.Trans.State.Strict as SS+import qualified Control.Monad.Trans.Writer.Strict as WS+import qualified Control.Monad.Trans.RWS.Strict as RWSS++import qualified Control.Monad.Trans.State.Lazy as SL+import qualified Control.Monad.Trans.Writer.Lazy as WL+import qualified Control.Monad.Trans.RWS.Lazy as RWSL++import Control.Monad.Catch.Pure (CatchT (runCatchT))+import Control.Exception (SomeException)++-- | Wrap the base monad in 'Ex.ExceptT'+--+-- Since 1.2.12+exceptC+ :: Monad m =>+ ConduitT i o m (Either e a) -> ConduitT i o (Ex.ExceptT e m) a+exceptC p = do+ x <- transPipe lift p+ lift $ Ex.ExceptT (return x)++-- | Run 'Ex.ExceptT' in the base monad+--+-- Since 1.2.12+runExceptC+ :: Monad m =>+ ConduitT i o (Ex.ExceptT e m) r -> ConduitT i o m (Either e r)+runExceptC (ConduitT c0) =+ ConduitT $ \rest ->+ let go (Done r) = rest (Right r)+ go (PipeM mp) = PipeM $ do+ eres <- Ex.runExceptT mp+ return $ case eres of+ Left e -> rest $ Left e+ Right p -> go p+ go (Leftover p i) = Leftover (go p) i+ go (HaveOutput p o) = HaveOutput (go p) o+ go (NeedInput x y) = NeedInput (go . x) (go . y)+ in go (c0 Done)+{-# INLINABLE runExceptC #-}++-- | Catch an error in the base monad+--+-- Since 1.2.12+catchExceptC+ :: Monad m =>+ ConduitT i o (Ex.ExceptT e m) r+ -> (e -> ConduitT i o (Ex.ExceptT e m) r)+ -> ConduitT i o (Ex.ExceptT e m) r+catchExceptC c0 h =+ ConduitT $ \rest ->+ let go (Done r) = rest r+ go (PipeM mp) = PipeM $ do+ eres <- lift $ Ex.runExceptT mp+ return $ case eres of+ Left e -> unConduitT (h e) rest+ Right p -> go p+ go (Leftover p i) = Leftover (go p) i+ go (HaveOutput p o) = HaveOutput (go p) o+ go (NeedInput x y) = NeedInput (go . x) (go . y)+ in go $ unConduitT c0 Done+ where+{-# INLINABLE catchExceptC #-}++-- | Run 'CatchT' in the base monad+--+-- Since 1.1.0+runCatchC+ :: Monad m =>+ ConduitT i o (CatchT m) r -> ConduitT i o m (Either SomeException r)+runCatchC c0 =+ ConduitT $ \rest ->+ let go (Done r) = rest (Right r)+ go (PipeM mp) = PipeM $ do+ eres <- runCatchT mp+ return $ case eres of+ Left e -> rest $ Left e+ Right p -> go p+ go (Leftover p i) = Leftover (go p) i+ go (HaveOutput p o) = HaveOutput (go p) o+ go (NeedInput x y) = NeedInput (go . x) (go . y)+ in go $ unConduitT c0 Done+{-# INLINABLE runCatchC #-}++-- | Catch an exception in the base monad+--+-- Since 1.1.0+catchCatchC+ :: Monad m+ => ConduitT i o (CatchT m) r+ -> (SomeException -> ConduitT i o (CatchT m) r)+ -> ConduitT i o (CatchT m) r+catchCatchC (ConduitT c0) h =+ ConduitT $ \rest ->+ let go (Done r) = rest r+ go (PipeM mp) = PipeM $ do+ eres <- lift $ runCatchT mp+ return $ case eres of+ Left e -> unConduitT (h e) rest+ Right p -> go p+ go (Leftover p i) = Leftover (go p) i+ go (HaveOutput p o) = HaveOutput (go p) o+ go (NeedInput x y) = NeedInput (go . x) (go . y)+ in go (c0 Done)+{-# INLINABLE catchCatchC #-}++-- | Wrap the base monad in 'M.MaybeT'+--+-- Since 1.0.11+maybeC+ :: Monad m =>+ ConduitT i o m (Maybe a) -> ConduitT i o (M.MaybeT m) a+maybeC p = do+ x <- transPipe lift p+ lift $ M.MaybeT (return x)+{-# INLINABLE maybeC #-}++-- | Run 'M.MaybeT' in the base monad+--+-- Since 1.0.11+runMaybeC+ :: Monad m =>+ ConduitT i o (M.MaybeT m) r -> ConduitT i o m (Maybe r)+runMaybeC (ConduitT c0) =+ ConduitT $ \rest ->+ let go (Done r) = rest (Just r)+ go (PipeM mp) = PipeM $ do+ mres <- M.runMaybeT mp+ return $ case mres of+ Nothing -> rest Nothing+ Just p -> go p+ go (Leftover p i) = Leftover (go p) i+ go (HaveOutput p o) = HaveOutput (go p) o+ go (NeedInput x y) = NeedInput (go . x) (go . y)+ in go (c0 Done)+{-# INLINABLE runMaybeC #-}++-- | Wrap the base monad in 'R.ReaderT'+--+-- Since 1.0.11+readerC+ :: Monad m =>+ (r -> ConduitT i o m a) -> ConduitT i o (R.ReaderT r m) a+readerC k = do+ i <- lift R.ask+ transPipe lift (k i)+{-# INLINABLE readerC #-}++-- | Run 'R.ReaderT' in the base monad+--+-- Since 1.0.11+runReaderC+ :: Monad m =>+ r -> ConduitT i o (R.ReaderT r m) res -> ConduitT i o m res+runReaderC r = transPipe (`R.runReaderT` r)+{-# INLINABLE runReaderC #-}+++-- | Wrap the base monad in 'SL.StateT'+--+-- Since 1.0.11+stateLC+ :: Monad m =>+ (s -> ConduitT i o m (a, s)) -> ConduitT i o (SL.StateT s m) a+stateLC k = do+ s <- lift SL.get+ (r, s') <- transPipe lift (k s)+ lift (SL.put s')+ return r+{-# INLINABLE stateLC #-}++thread :: Monad m+ => (r -> s -> res)+ -> (forall a. t m a -> s -> m (a, s))+ -> s+ -> ConduitT i o (t m) r+ -> ConduitT i o m res+thread toRes runM s0 (ConduitT c0) =+ ConduitT $ \rest ->+ let go s (Done r) = rest (toRes r s)+ go s (PipeM mp) = PipeM $ do+ (p, s') <- runM mp s+ return $ go s' p+ go s (Leftover p i) = Leftover (go s p) i+ go s (NeedInput x y) = NeedInput (go s . x) (go s . y)+ go s (HaveOutput p o) = HaveOutput (go s p) o+ in go s0 (c0 Done)+{-# INLINABLE thread #-}++-- | Run 'SL.StateT' in the base monad+--+-- Since 1.0.11+runStateLC+ :: Monad m =>+ s -> ConduitT i o (SL.StateT s m) r -> ConduitT i o m (r, s)+runStateLC = thread (,) SL.runStateT+{-# INLINABLE runStateLC #-}++-- | Evaluate 'SL.StateT' in the base monad+--+-- Since 1.0.11+evalStateLC+ :: Monad m =>+ s -> ConduitT i o (SL.StateT s m) r -> ConduitT i o m r+evalStateLC s p = fmap fst $ runStateLC s p+{-# INLINABLE evalStateLC #-}++-- | Execute 'SL.StateT' in the base monad+--+-- Since 1.0.11+execStateLC+ :: Monad m =>+ s -> ConduitT i o (SL.StateT s m) r -> ConduitT i o m s+execStateLC s p = fmap snd $ runStateLC s p+{-# INLINABLE execStateLC #-}+++-- | Wrap the base monad in 'SS.StateT'+--+-- Since 1.0.11+stateC+ :: Monad m =>+ (s -> ConduitT i o m (a, s)) -> ConduitT i o (SS.StateT s m) a+stateC k = do+ s <- lift SS.get+ (r, s') <- transPipe lift (k s)+ lift (SS.put s')+ return r+{-# INLINABLE stateC #-}++-- | Run 'SS.StateT' in the base monad+--+-- Since 1.0.11+runStateC+ :: Monad m =>+ s -> ConduitT i o (SS.StateT s m) r -> ConduitT i o m (r, s)+runStateC = thread (,) SS.runStateT+{-# INLINABLE runStateC #-}++-- | Evaluate 'SS.StateT' in the base monad+--+-- Since 1.0.11+evalStateC+ :: Monad m =>+ s -> ConduitT i o (SS.StateT s m) r -> ConduitT i o m r+evalStateC s p = fmap fst $ runStateC s p+{-# INLINABLE evalStateC #-}++-- | Execute 'SS.StateT' in the base monad+--+-- Since 1.0.11+execStateC+ :: Monad m =>+ s -> ConduitT i o (SS.StateT s m) r -> ConduitT i o m s+execStateC s p = fmap snd $ runStateC s p+{-# INLINABLE execStateC #-}+++-- | Wrap the base monad in 'WL.WriterT'+--+-- Since 1.0.11+writerLC+ :: (Monad m, Monoid w) =>+ ConduitT i o m (b, w) -> ConduitT i o (WL.WriterT w m) b+writerLC p = do+ (r, w) <- transPipe lift p+ lift $ WL.tell w+ return r+{-# INLINABLE writerLC #-}++-- | Run 'WL.WriterT' in the base monad+--+-- Since 1.0.11+runWriterLC+ :: (Monad m, Monoid w) =>+ ConduitT i o (WL.WriterT w m) r -> ConduitT i o m (r, w)+runWriterLC = thread (,) run mempty+ where+ run m w = do+ (a, w') <- WL.runWriterT m+ return (a, w `mappend` w')+{-# INLINABLE runWriterLC #-}++-- | Execute 'WL.WriterT' in the base monad+--+-- Since 1.0.11+execWriterLC+ :: (Monad m, Monoid w) =>+ ConduitT i o (WL.WriterT w m) r -> ConduitT i o m w+execWriterLC p = fmap snd $ runWriterLC p+{-# INLINABLE execWriterLC #-}+++-- | Wrap the base monad in 'WS.WriterT'+--+-- Since 1.0.11+writerC+ :: (Monad m, Monoid w) =>+ ConduitT i o m (b, w) -> ConduitT i o (WS.WriterT w m) b+writerC p = do+ (r, w) <- transPipe lift p+ lift $ WS.tell w+ return r+{-# INLINABLE writerC #-}++-- | Run 'WS.WriterT' in the base monad+--+-- Since 1.0.11+runWriterC+ :: (Monad m, Monoid w) =>+ ConduitT i o (WS.WriterT w m) r -> ConduitT i o m (r, w)+runWriterC = thread (,) run mempty+ where+ run m w = do+ (a, w') <- WS.runWriterT m+ return (a, w `mappend` w')+{-# INLINABLE runWriterC #-}++-- | Execute 'WS.WriterT' in the base monad+--+-- Since 1.0.11+execWriterC+ :: (Monad m, Monoid w) =>+ ConduitT i o (WS.WriterT w m) r -> ConduitT i o m w+execWriterC p = fmap snd $ runWriterC p+{-# INLINABLE execWriterC #-}+++-- | Wrap the base monad in 'RWSL.RWST'+--+-- Since 1.0.11+rwsLC+ :: (Monad m, Monoid w) =>+ (r -> s -> ConduitT i o m (a, s, w)) -> ConduitT i o (RWSL.RWST r w s m) a+rwsLC k = do+ i <- lift RWSL.ask+ s <- lift RWSL.get+ (r, s', w) <- transPipe lift (k i s)+ lift $ do+ RWSL.put s'+ RWSL.tell w+ return r+{-# INLINABLE rwsLC #-}++-- | Run 'RWSL.RWST' in the base monad+--+-- Since 1.0.11+runRWSLC+ :: (Monad m, Monoid w) =>+ r+ -> s+ -> ConduitT i o (RWSL.RWST r w s m) res+ -> ConduitT i o m (res, s, w)+runRWSLC r s0 = thread toRes run (s0, mempty)+ where+ toRes a (s, w) = (a, s, w)+ run m (s, w) = do+ (res, s', w') <- RWSL.runRWST m r s+ return (res, (s', w `mappend` w'))+{-# INLINABLE runRWSLC #-}++-- | Evaluate 'RWSL.RWST' in the base monad+--+-- Since 1.0.11+evalRWSLC+ :: (Monad m, Monoid w) =>+ r+ -> s+ -> ConduitT i o (RWSL.RWST r w s m) res+ -> ConduitT i o m (res, w)+evalRWSLC i s p = fmap f $ runRWSLC i s p+ where f x = let (r, _, w) = x in (r, w)+{-# INLINABLE evalRWSLC #-}++-- | Execute 'RWSL.RWST' in the base monad+--+-- Since 1.0.11+execRWSLC+ :: (Monad m, Monoid w) =>+ r+ -> s+ -> ConduitT i o (RWSL.RWST r w s m) res+ -> ConduitT i o m (s, w)+execRWSLC i s p = fmap f $ runRWSLC i s p+ where f x = let (_, s2, w2) = x in (s2, w2)+{-# INLINABLE execRWSLC #-}++-- | Wrap the base monad in 'RWSS.RWST'+--+-- Since 1.0.11+rwsC+ :: (Monad m, Monoid w) =>+ (r -> s -> ConduitT i o m (a, s, w)) -> ConduitT i o (RWSS.RWST r w s m) a+rwsC k = do+ i <- lift RWSS.ask+ s <- lift RWSS.get+ (r, s', w) <- transPipe lift (k i s)+ lift $ do+ RWSS.put s'+ RWSS.tell w+ return r+{-# INLINABLE rwsC #-}++-- | Run 'RWSS.RWST' in the base monad+--+-- Since 1.0.11+runRWSC+ :: (Monad m, Monoid w) =>+ r+ -> s+ -> ConduitT i o (RWSS.RWST r w s m) res+ -> ConduitT i o m (res, s, w)+runRWSC r s0 = thread toRes run (s0, mempty)+ where+ toRes a (s, w) = (a, s, w)+ run m (s, w) = do+ (res, s', w') <- RWSS.runRWST m r s+ return (res, (s', w `mappend` w'))+{-# INLINABLE runRWSC #-}++-- | Evaluate 'RWSS.RWST' in the base monad+--+-- Since 1.0.11+evalRWSC+ :: (Monad m, Monoid w) =>+ r+ -> s+ -> ConduitT i o (RWSS.RWST r w s m) res+ -> ConduitT i o m (res, w)+evalRWSC i s p = fmap f $ runRWSC i s p+ where f x = let (r, _, w) = x in (r, w)+{-# INLINABLE evalRWSC #-}++-- | Execute 'RWSS.RWST' in the base monad+--+-- Since 1.0.11+execRWSC+ :: (Monad m, Monoid w) =>+ r+ -> s+ -> ConduitT i o (RWSS.RWST r w s m) res+ -> ConduitT i o m (s, w)+execRWSC i s p = fmap f $ runRWSC i s p+ where f x = let (_, s2, w2) = x in (s2, w2)+{-# INLINABLE execRWSC #-}
+ src/Data/Conduit/List.hs view
@@ -0,0 +1,883 @@+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE Trustworthy #-}+-- | /NOTE/ It is recommended to start using "Data.Conduit.Combinators" instead+-- of this module.+--+-- Higher-level functions to interact with the elements of a stream. Most of+-- these are based on list functions.+--+-- Note that these functions all deal with individual elements of a stream as a+-- sort of \"black box\", where there is no introspection of the contained+-- elements. Values such as @ByteString@ and @Text@ will likely need to be+-- treated specially to deal with their contents properly (@Word8@ and @Char@,+-- respectively). See the @Data.Conduit.Binary@ and @Data.Conduit.Text@+-- modules in the @conduit-extra@ package.+module Data.Conduit.List+ ( -- * Sources+ sourceList+ , sourceNull+ , unfold+ , unfoldEither+ , unfoldM+ , unfoldEitherM+ , enumFromTo+ , iterate+ , replicate+ , replicateM+ -- * Sinks+ -- ** Pure+ , fold+ , foldMap+ , uncons+ , unconsEither+ , take+ , drop+ , head+ , peek+ , consume+ , sinkNull+ -- ** Monadic+ , foldMapM+ , foldM+ , unconsM+ , unconsEitherM+ , mapM_+ -- * Conduits+ -- ** Pure+ , map+ , mapMaybe+ , mapFoldable+ , catMaybes+ , concat+ , concatMap+ , concatMapAccum+ , scanl+ , scan+ , mapAccum+ , chunksOf+ , groupBy+ , groupOn1+#if MIN_VERSION_base(4,9,0)+ , groupOn+#endif+ , isolate+ , filter+ -- ** Monadic+ , mapM+ , iterM+ , scanlM+ , scanM+ , mapAccumM+ , mapMaybeM+ , mapFoldableM+ , concatMapM+ , concatMapAccumM+ -- * Misc+ , sequence+ ) where++import qualified Prelude+import Prelude+ ( ($), return, (==), (-), Int+ , (.), id, Maybe (..), Monad+ , Either (..)+ , Bool (..)+ , (>>)+ , (>>=)+ , seq+ , otherwise+ , Enum, Eq+ , maybe+ , (<=)+ , (>)+ , error+ , (++)+ , show+ )+import Data.Monoid (Monoid, mempty, mappend)+import qualified Data.Foldable as F+#if MIN_VERSION_base(4,9,0)+import Data.List.NonEmpty (NonEmpty ((:|)))+#endif+import Data.Conduit+import Data.Conduit.Internal.Conduit (unconsM, unconsEitherM)+import Data.Conduit.Internal.Fusion+import Data.Conduit.Internal.List.Stream+import qualified Data.Conduit.Internal as CI+import Data.Functor.Identity (Identity (runIdentity))+import Control.Monad (when, (<=<), liftM, void)+import Control.Monad.Trans.Class (lift)++-- Defines INLINE_RULE0, INLINE_RULE, STREAMING0, and STREAMING.+#include "fusion-macros.h"++-- | Generate a source from a seed value.+--+-- Subject to fusion+--+-- Since 0.4.2+unfold, unfoldC :: Monad m+ => (b -> Maybe (a, b))+ -> b+ -> ConduitT i a m ()+unfoldC f =+ go+ where+ go seed =+ case f seed of+ Just (a, seed') -> yield a >> go seed'+ Nothing -> return ()+{-# INLINE unfoldC #-}+STREAMING(unfold, unfoldC, unfoldS, f x)++-- | Generate a source from a seed value with a return value.+--+-- Subject to fusion+--+-- @since 1.2.11+unfoldEither, unfoldEitherC :: Monad m+ => (b -> Either r (a, b))+ -> b+ -> ConduitT i a m r+unfoldEitherC f =+ go+ where+ go seed =+ case f seed of+ Right (a, seed') -> yield a >> go seed'+ Left r -> return r+{-# INLINE unfoldEitherC #-}+STREAMING(unfoldEither, unfoldEitherC, unfoldEitherS, f x)++-- | A monadic unfold.+--+-- Subject to fusion+--+-- Since 1.1.2+unfoldM, unfoldMC :: Monad m+ => (b -> m (Maybe (a, b)))+ -> b+ -> ConduitT i a m ()+unfoldMC f =+ go+ where+ go seed = do+ mres <- lift $ f seed+ case mres of+ Just (a, seed') -> yield a >> go seed'+ Nothing -> return ()+STREAMING(unfoldM, unfoldMC, unfoldMS, f seed)++-- | A monadic unfoldEither.+--+-- Subject to fusion+--+-- @since 1.2.11+unfoldEitherM, unfoldEitherMC :: Monad m+ => (b -> m (Either r (a, b)))+ -> b+ -> ConduitT i a m r+unfoldEitherMC f =+ go+ where+ go seed = do+ mres <- lift $ f seed+ case mres of+ Right (a, seed') -> yield a >> go seed'+ Left r -> return r+STREAMING(unfoldEitherM, unfoldEitherMC, unfoldEitherMS, f seed)++-- | Split a pure conduit into head and tail.+-- This is equivalent to @runIdentity . unconsM@.+--+-- Note that you have to 'sealConduitT' it first.+--+-- Since 1.3.3+uncons :: SealedConduitT () o Identity ()+ -> Maybe (o, SealedConduitT () o Identity ())+uncons = runIdentity . unconsM++-- | Split a pure conduit into head and tail or return its result if it is done.+-- This is equivalent to @runIdentity . unconsEitherM@.+--+-- Note that you have to 'sealConduitT' it first.+--+-- Since 1.3.3+unconsEither :: SealedConduitT () o Identity r+ -> Either r (o, SealedConduitT () o Identity r)+unconsEither = runIdentity . unconsEitherM++-- | Yield the values from the list.+--+-- Subject to fusion+sourceList, sourceListC :: Monad m => [a] -> ConduitT i a m ()+sourceListC = Prelude.mapM_ yield+{-# INLINE sourceListC #-}+STREAMING(sourceList, sourceListC, sourceListS, xs)++-- | Enumerate from a value to a final value, inclusive, via 'succ'.+--+-- This is generally more efficient than using @Prelude@\'s @enumFromTo@ and+-- combining with @sourceList@ since this avoids any intermediate data+-- structures.+--+-- Subject to fusion+--+-- Since 0.4.2+enumFromTo, enumFromToC :: (Enum a, Prelude.Ord a, Monad m)+ => a+ -> a+ -> ConduitT i a m ()+enumFromToC x0 y =+ loop x0+ where+ loop x+ | x Prelude.> y = return ()+ | otherwise = yield x >> loop (Prelude.succ x)+{-# INLINE enumFromToC #-}+STREAMING(enumFromTo, enumFromToC, enumFromToS, x0 y)++-- | Produces an infinite stream of repeated applications of f to x.+--+-- Subject to fusion+--+iterate, iterateC :: Monad m => (a -> a) -> a -> ConduitT i a m ()+iterateC f =+ go+ where+ go a = yield a >> go (f a)+{-# INLINE iterateC #-}+STREAMING(iterate, iterateC, iterateS, f a)++-- | Replicate a single value the given number of times.+--+-- Subject to fusion+--+-- Since 1.2.0+replicate, replicateC :: Monad m => Int -> a -> ConduitT i a m ()+replicateC cnt0 a =+ loop cnt0+ where+ loop i+ | i <= 0 = return ()+ | otherwise = yield a >> loop (i - 1)+{-# INLINE replicateC #-}+STREAMING(replicate, replicateC, replicateS, cnt0 a)++-- | Replicate a monadic value the given number of times.+--+-- Subject to fusion+--+-- Since 1.2.0+replicateM, replicateMC :: Monad m => Int -> m a -> ConduitT i a m ()+replicateMC cnt0 ma =+ loop cnt0+ where+ loop i+ | i <= 0 = return ()+ | otherwise = lift ma >>= yield >> loop (i - 1)+{-# INLINE replicateMC #-}+STREAMING(replicateM, replicateMC, replicateMS, cnt0 ma)++-- | A strict left fold.+--+-- Subject to fusion+--+-- Since 0.3.0+fold, foldC :: Monad m+ => (b -> a -> b)+ -> b+ -> ConduitT a o m b+foldC f =+ loop+ where+ loop !accum = await >>= maybe (return accum) (loop . f accum)+{-# INLINE foldC #-}+STREAMING(fold, foldC, foldS, f accum)++-- | A monadic strict left fold.+--+-- Subject to fusion+--+-- Since 0.3.0+foldM, foldMC :: Monad m+ => (b -> a -> m b)+ -> b+ -> ConduitT a o m b+foldMC f =+ loop+ where+ loop accum = do+ await >>= maybe (return accum) go+ where+ go a = do+ accum' <- lift $ f accum a+ accum' `seq` loop accum'+{-# INLINE foldMC #-}+STREAMING(foldM, foldMC, foldMS, f accum)++-----------------------------------------------------------------+-- These are for cases where- for whatever reason- stream fusion cannot be+-- applied.+connectFold :: Monad m => ConduitT () a m () -> (b -> a -> b) -> b -> m b+connectFold (CI.ConduitT src0) f =+ go (src0 CI.Done)+ where+ go (CI.Done ()) b = return b+ go (CI.HaveOutput src a) b = go src Prelude.$! f b a+ go (CI.NeedInput _ c) b = go (c ()) b+ go (CI.Leftover src ()) b = go src b+ go (CI.PipeM msrc) b = do+ src <- msrc+ go src b+{-# INLINE connectFold #-}+{-# RULES "conduit: $$ fold" forall src f b. runConduit (src .| fold f b) = connectFold src f b #-}++connectFoldM :: Monad m => ConduitT () a m () -> (b -> a -> m b) -> b -> m b+connectFoldM (CI.ConduitT src0) f =+ go (src0 CI.Done)+ where+ go (CI.Done ()) b = return b+ go (CI.HaveOutput src a) b = do+ !b' <- f b a+ go src b'+ go (CI.NeedInput _ c) b = go (c ()) b+ go (CI.Leftover src ()) b = go src b+ go (CI.PipeM msrc) b = do+ src <- msrc+ go src b+{-# INLINE connectFoldM #-}+{-# RULES "conduit: $$ foldM" forall src f b. runConduit (src .| foldM f b) = connectFoldM src f b #-}+-----------------------------------------------------------------++-- | A monoidal strict left fold.+--+-- Subject to fusion+--+-- Since 0.5.3+foldMap :: (Monad m, Monoid b)+ => (a -> b)+ -> ConduitT a o m b+INLINE_RULE(foldMap, f, let combiner accum = mappend accum . f in fold combiner mempty)++-- | A monoidal strict left fold in a Monad.+--+-- Since 1.0.8+foldMapM :: (Monad m, Monoid b)+ => (a -> m b)+ -> ConduitT a o m b+INLINE_RULE(foldMapM, f, let combiner accum = liftM (mappend accum) . f in foldM combiner mempty)++-- | Apply the action to all values in the stream.+--+-- Subject to fusion+--+-- Since 0.3.0+mapM_, mapM_C :: Monad m+ => (a -> m ())+ -> ConduitT a o m ()+mapM_C f = awaitForever $ lift . f+{-# INLINE mapM_C #-}+STREAMING(mapM_, mapM_C, mapM_S, f)++srcMapM_ :: Monad m => ConduitT () a m () -> (a -> m ()) -> m ()+srcMapM_ (CI.ConduitT src) f =+ go (src CI.Done)+ where+ go (CI.Done ()) = return ()+ go (CI.PipeM mp) = mp >>= go+ go (CI.Leftover p ()) = go p+ go (CI.HaveOutput p o) = f o >> go p+ go (CI.NeedInput _ c) = go (c ())+{-# INLINE srcMapM_ #-}+{-# RULES "conduit: connect to mapM_" [2] forall f src. runConduit (src .| mapM_ f) = srcMapM_ src f #-}++-- | Ignore a certain number of values in the stream. This function is+-- semantically equivalent to:+--+-- > drop i = take i >> return ()+--+-- However, @drop@ is more efficient as it does not need to hold values in+-- memory.+--+-- Subject to fusion+--+-- Since 0.3.0+drop, dropC :: Monad m+ => Int+ -> ConduitT a o m ()+dropC =+ loop+ where+ loop i | i <= 0 = return ()+ loop count = await >>= maybe (return ()) (\_ -> loop (count - 1))+{-# INLINE dropC #-}+STREAMING(drop, dropC, dropS, i)++-- | Take some values from the stream and return as a list. If you want to+-- instead create a conduit that pipes data to another sink, see 'isolate'.+-- This function is semantically equivalent to:+--+-- > take i = isolate i =$ consume+--+-- Subject to fusion+--+-- Since 0.3.0+take, takeC :: Monad m+ => Int+ -> ConduitT a o m [a]+takeC =+ loop id+ where+ loop front count | count <= 0 = return $ front []+ loop front count = await >>= maybe+ (return $ front [])+ (\x -> loop (front . (x:)) (count - 1))+{-# INLINE takeC #-}+STREAMING(take, takeC, takeS, i)++-- | Take a single value from the stream, if available.+--+-- Subject to fusion+--+-- Since 0.3.0+head, headC :: Monad m => ConduitT a o m (Maybe a)+headC = await+{-# INLINE headC #-}+STREAMING0(head, headC, headS)++-- | Look at the next value in the stream, if available. This function will not+-- change the state of the stream.+--+-- Since 0.3.0+peek :: Monad m => ConduitT a o m (Maybe a)+peek = await >>= maybe (return Nothing) (\x -> leftover x >> return (Just x))++-- | Apply a transformation to all values in a stream.+--+-- Subject to fusion+--+-- Since 0.3.0+map, mapC :: Monad m => (a -> b) -> ConduitT a b m ()+mapC f = awaitForever $ yield . f+{-# INLINE mapC #-}+STREAMING(map, mapC, mapS, f)++-- Since a Source never has any leftovers, fusion rules on it are safe.+{-+{-# RULES "conduit: source/map fusion .|" forall f src. src .| map f = mapFuseRight src f #-}++mapFuseRight :: Monad m => ConduitT () a m () -> (a -> b) -> ConduitT () b m ()+mapFuseRight src f = CIC.mapOutput f src+{-# INLINE mapFuseRight #-}+-}++{-++It might be nice to include these rewrite rules, but they may have subtle+differences based on leftovers.++{-# RULES "conduit: map-to-mapOutput pipeL" forall f src. pipeL src (map f) = mapOutput f src #-}+{-# RULES "conduit: map-to-mapOutput $=" forall f src. src $= (map f) = mapOutput f src #-}+{-# RULES "conduit: map-to-mapOutput pipe" forall f src. pipe src (map f) = mapOutput f src #-}+{-# RULES "conduit: map-to-mapOutput >+>" forall f src. src >+> (map f) = mapOutput f src #-}++{-# RULES "conduit: map-to-mapInput pipeL" forall f sink. pipeL (map f) sink = mapInput f (Prelude.const Prelude.Nothing) sink #-}+{-# RULES "conduit: map-to-mapInput =$" forall f sink. map f =$ sink = mapInput f (Prelude.const Prelude.Nothing) sink #-}+{-# RULES "conduit: map-to-mapInput pipe" forall f sink. pipe (map f) sink = mapInput f (Prelude.const Prelude.Nothing) sink #-}+{-# RULES "conduit: map-to-mapInput >+>" forall f sink. map f >+> sink = mapInput f (Prelude.const Prelude.Nothing) sink #-}++{-# RULES "conduit: map-to-mapOutput .|" forall f con. con .| map f = mapOutput f con #-}+{-# RULES "conduit: map-to-mapInput .|" forall f con. map f .| con = mapInput f (Prelude.const Prelude.Nothing) con #-}++{-# INLINE [1] map #-}++-}++-- | Apply a monadic transformation to all values in a stream.+--+-- If you do not need the transformed values, and instead just want the monadic+-- side-effects of running the action, see 'mapM_'.+--+-- Subject to fusion+--+-- Since 0.3.0+mapM, mapMC :: Monad m => (a -> m b) -> ConduitT a b m ()+mapMC f = awaitForever $ \a -> lift (f a) >>= yield+{-# INLINE mapMC #-}+STREAMING(mapM, mapMC, mapMS, f)++-- | Apply a monadic action on all values in a stream.+--+-- This @Conduit@ can be used to perform a monadic side-effect for every+-- value, whilst passing the value through the @Conduit@ as-is.+--+-- > iterM f = mapM (\a -> f a >>= \() -> return a)+--+-- Subject to fusion+--+-- Since 0.5.6+iterM, iterMC :: Monad m => (a -> m ()) -> ConduitT a a m ()+iterMC f = awaitForever $ \a -> lift (f a) >> yield a+{-# INLINE iterMC #-}+STREAMING(iterM, iterMC, iterMS, f)++-- | Apply a transformation that may fail to all values in a stream, discarding+-- the failures.+--+-- Subject to fusion+--+-- Since 0.5.1+mapMaybe, mapMaybeC :: Monad m => (a -> Maybe b) -> ConduitT a b m ()+mapMaybeC f = awaitForever $ maybe (return ()) yield . f+{-# INLINE mapMaybeC #-}+STREAMING(mapMaybe, mapMaybeC, mapMaybeS, f)++-- | Apply a monadic transformation that may fail to all values in a stream,+-- discarding the failures.+--+-- Subject to fusion+--+-- Since 0.5.1+mapMaybeM, mapMaybeMC :: Monad m => (a -> m (Maybe b)) -> ConduitT a b m ()+mapMaybeMC f = awaitForever $ maybe (return ()) yield <=< lift . f+{-# INLINE mapMaybeMC #-}+STREAMING(mapMaybeM, mapMaybeMC, mapMaybeMS, f)++-- | Filter the @Just@ values from a stream, discarding the @Nothing@ values.+--+-- Subject to fusion+--+-- Since 0.5.1+catMaybes, catMaybesC :: Monad m => ConduitT (Maybe a) a m ()+catMaybesC = awaitForever $ maybe (return ()) yield+{-# INLINE catMaybesC #-}+STREAMING0(catMaybes, catMaybesC, catMaybesS)++-- | Generalization of 'catMaybes'. It puts all values from+-- 'F.Foldable' into stream.+--+-- Subject to fusion+--+-- Since 1.0.6+concat, concatC :: (Monad m, F.Foldable f) => ConduitT (f a) a m ()+concatC = awaitForever $ F.mapM_ yield+{-# INLINE concatC #-}+STREAMING0(concat, concatC, concatS)++-- | Apply a transformation to all values in a stream, concatenating the output+-- values.+--+-- Subject to fusion+--+-- Since 0.3.0+concatMap, concatMapC :: Monad m => (a -> [b]) -> ConduitT a b m ()+concatMapC f = awaitForever $ sourceList . f+{-# INLINE concatMapC #-}+STREAMING(concatMap, concatMapC, concatMapS, f)++-- | Apply a monadic transformation to all values in a stream, concatenating+-- the output values.+--+-- Subject to fusion+--+-- Since 0.3.0+concatMapM, concatMapMC :: Monad m => (a -> m [b]) -> ConduitT a b m ()+concatMapMC f = awaitForever $ sourceList <=< lift . f+{-# INLINE concatMapMC #-}+STREAMING(concatMapM, concatMapMC, concatMapMS, f)++-- | 'concatMap' with a strict accumulator.+--+-- Subject to fusion+--+-- Since 0.3.0+concatMapAccum, concatMapAccumC :: Monad m => (a -> accum -> (accum, [b])) -> accum -> ConduitT a b m ()+concatMapAccumC f x0 = void (mapAccum f x0) .| concat+{-# INLINE concatMapAccumC #-}+STREAMING(concatMapAccum, concatMapAccumC, concatMapAccumS, f x0)++-- | Deprecated synonym for @mapAccum@+--+-- Since 1.0.6+scanl :: Monad m => (a -> s -> (s, b)) -> s -> ConduitT a b m ()+scanl f s = void $ mapAccum f s+{-# DEPRECATED scanl "Use mapAccum instead" #-}++-- | Deprecated synonym for @mapAccumM@+--+-- Since 1.0.6+scanlM :: Monad m => (a -> s -> m (s, b)) -> s -> ConduitT a b m ()+scanlM f s = void $ mapAccumM f s+{-# DEPRECATED scanlM "Use mapAccumM instead" #-}++-- | Analog of @mapAccumL@ for lists. Note that in contrast to @mapAccumL@, the function argument+-- takes the accumulator as its second argument, not its first argument, and the accumulated value+-- is strict.+--+-- Subject to fusion+--+-- Since 1.1.1+mapAccum, mapAccumC :: Monad m => (a -> s -> (s, b)) -> s -> ConduitT a b m s+mapAccumC f =+ loop+ where+ loop !s = await >>= maybe (return s) go+ where+ go a = case f a s of+ (s', b) -> yield b >> loop s'+STREAMING(mapAccum, mapAccumC, mapAccumS, f s)++-- | Monadic `mapAccum`.+--+-- Subject to fusion+--+-- Since 1.1.1+mapAccumM, mapAccumMC :: Monad m => (a -> s -> m (s, b)) -> s -> ConduitT a b m s+mapAccumMC f =+ loop+ where+ loop !s = await >>= maybe (return s) go+ where+ go a = do (s', b) <- lift $ f a s+ yield b+ loop s'+{-# INLINE mapAccumMC #-}+STREAMING(mapAccumM, mapAccumMC, mapAccumMS, f s)++-- | Analog of 'Prelude.scanl' for lists.+--+-- Subject to fusion+--+-- Since 1.1.1+scan :: Monad m => (a -> b -> b) -> b -> ConduitT a b m b+INLINE_RULE(scan, f, mapAccum (\a b -> let r = f a b in (r, r)))++-- | Monadic @scanl@.+--+-- Subject to fusion+--+-- Since 1.1.1+scanM :: Monad m => (a -> b -> m b) -> b -> ConduitT a b m b+INLINE_RULE(scanM, f, mapAccumM (\a b -> f a b >>= \r -> return (r, r)))++-- | 'concatMapM' with a strict accumulator.+--+-- Subject to fusion+--+-- Since 0.3.0+concatMapAccumM, concatMapAccumMC :: Monad m => (a -> accum -> m (accum, [b])) -> accum -> ConduitT a b m ()+concatMapAccumMC f x0 = void (mapAccumM f x0) .| concat+{-# INLINE concatMapAccumMC #-}+STREAMING(concatMapAccumM, concatMapAccumMC, concatMapAccumMS, f x0)++-- | Generalization of 'mapMaybe' and 'concatMap'. It applies function+-- to all values in a stream and send values inside resulting+-- 'Foldable' downstream.+--+-- Subject to fusion+--+-- Since 1.0.6+mapFoldable, mapFoldableC :: (Monad m, F.Foldable f) => (a -> f b) -> ConduitT a b m ()+mapFoldableC f = awaitForever $ F.mapM_ yield . f+{-# INLINE mapFoldableC #-}+STREAMING(mapFoldable, mapFoldableC, mapFoldableS, f)++-- | Monadic variant of 'mapFoldable'.+--+-- Subject to fusion+--+-- Since 1.0.6+mapFoldableM, mapFoldableMC :: (Monad m, F.Foldable f) => (a -> m (f b)) -> ConduitT a b m ()+mapFoldableMC f = awaitForever $ F.mapM_ yield <=< lift . f+{-# INLINE mapFoldableMC #-}+STREAMING(mapFoldableM, mapFoldableMC, mapFoldableMS, f)++-- | Consume all values from the stream and return as a list. Note that this+-- will pull all values into memory.+--+-- Subject to fusion+--+-- Since 0.3.0+consume, consumeC :: Monad m => ConduitT a o m [a]+consumeC =+ loop id+ where+ loop front = await >>= maybe (return $ front []) (\x -> loop $ front . (x:))+{-# INLINE consumeC #-}+STREAMING0(consume, consumeC, consumeS)++-- | Group a stream into chunks of a given size. The last chunk may contain+-- fewer than n elements.+--+-- Subject to fusion+--+-- Since 1.2.9+chunksOf :: Monad m => Int -> ConduitT a [a] m ()+chunksOf n = if n > 0 then loop n id else error $ "chunksOf size must be positive (given " ++ show n ++ ")"+ where+ loop 0 rest = yield (rest []) >> loop n id+ loop count rest = await >>= \ma -> case ma of+ Nothing -> case rest [] of+ [] -> return ()+ nonempty -> yield nonempty+ Just a -> loop (count - 1) (rest . (a :))++-- | Grouping input according to an equality function.+--+-- Subject to fusion+--+-- Since 0.3.0+groupBy, groupByC :: Monad m => (a -> a -> Bool) -> ConduitT a [a] m ()+groupByC f =+ start+ where+ start = await >>= maybe (return ()) (loop id)++ loop rest x =+ await >>= maybe (yield (x : rest [])) go+ where+ go y+ | f x y = loop (rest . (y:)) x+ | otherwise = yield (x : rest []) >> loop id y+STREAMING(groupBy, groupByC, groupByS, f)++-- | 'groupOn1' is similar to @groupBy id@+--+-- returns a pair, indicating there are always 1 or more items in the grouping.+-- This is designed to be converted into a NonEmpty structure+-- but it avoids a dependency on another package+--+-- > import Data.List.NonEmpty+-- >+-- > groupOn1 :: (Monad m, Eq b) => (a -> b) -> Conduit a m (NonEmpty a)+-- > groupOn1 f = CL.groupOn1 f .| CL.map (uncurry (:|))+--+-- Subject to fusion+--+-- Since 1.1.7+groupOn1, groupOn1C :: (Monad m, Eq b)+ => (a -> b)+ -> ConduitT a (a, [a]) m ()+groupOn1C f =+ start+ where+ start = await >>= maybe (return ()) (loop id)++ loop rest x =+ await >>= maybe (yield (x, rest [])) go+ where+ go y+ | f x == f y = loop (rest . (y:)) x+ | otherwise = yield (x, rest []) >> loop id y+STREAMING(groupOn1, groupOn1C, groupOn1S, f)++#if MIN_VERSION_base(4,9,0)+-- | Like 'groupOn1', but returning a 'NonEmpty' structure.+--+-- @since 1.3.5+groupOn :: (Monad m, Eq b)+ => (a -> b)+ -> ConduitT a (NonEmpty a) m ()+groupOn f = groupOn1 f .| map (Prelude.uncurry (:|))+#endif++-- | Ensure that the inner sink consumes no more than the given number of+-- values. Note this this does /not/ ensure that the sink consumes all of those+-- values. To get the latter behavior, combine with 'sinkNull', e.g.:+--+-- > src $$ do+-- > x <- isolate count =$ do+-- > x <- someSink+-- > sinkNull+-- > return x+-- > someOtherSink+-- > ...+--+-- Subject to fusion+--+-- Since 0.3.0+isolate, isolateC :: Monad m => Int -> ConduitT a a m ()+isolateC =+ loop+ where+ loop count | count <= 0 = return ()+ loop count = await >>= maybe (return ()) (\x -> yield x >> loop (count - 1))+STREAMING(isolate, isolateC, isolateS, count)++-- | Keep only values in the stream passing a given predicate.+--+-- Subject to fusion+--+-- Since 0.3.0+filter, filterC :: Monad m => (a -> Bool) -> ConduitT a a m ()+filterC f = awaitForever $ \i -> when (f i) (yield i)+STREAMING(filter, filterC, filterS, f)++filterFuseRight+ :: Monad m+ => ConduitT i o m ()+ -> (o -> Bool)+ -> ConduitT i o m ()+filterFuseRight (CI.ConduitT src) f = CI.ConduitT $ \rest -> let+ go (CI.Done ()) = rest ()+ go (CI.PipeM mp) = CI.PipeM (liftM go mp)+ go (CI.Leftover p i) = CI.Leftover (go p) i+ go (CI.HaveOutput p o)+ | f o = CI.HaveOutput (go p) o+ | otherwise = go p+ go (CI.NeedInput p c) = CI.NeedInput (go . p) (go . c)+ in go (src CI.Done)+-- Intermediate finalizers are dropped, but this is acceptable: the next+-- yielded value would be demanded by downstream in any event, and that new+-- finalizer will always override the existing finalizer.+{-# RULES "conduit: source/filter fusion .|" forall f src. src .| filter f = filterFuseRight src f #-}+{-# INLINE filterFuseRight #-}++-- | Ignore the remainder of values in the source. Particularly useful when+-- combined with 'isolate'.+--+-- Subject to fusion+--+-- Since 0.3.0+sinkNull, sinkNullC :: Monad m => ConduitT i o m ()+sinkNullC = awaitForever $ \_ -> return ()+{-# INLINE sinkNullC #-}+STREAMING0(sinkNull, sinkNullC, sinkNullS)++srcSinkNull :: Monad m => ConduitT () o m () -> m ()+srcSinkNull (CI.ConduitT src) =+ go (src CI.Done)+ where+ go (CI.Done ()) = return ()+ go (CI.PipeM mp) = mp >>= go+ go (CI.Leftover p ()) = go p+ go (CI.HaveOutput p _) = go p+ go (CI.NeedInput _ c) = go (c ())+{-# INLINE srcSinkNull #-}+{-# RULES "conduit: connect to sinkNull" forall src. runConduit (src .| sinkNull) = srcSinkNull src #-}++-- | A source that outputs no values. Note that this is just a type-restricted+-- synonym for 'mempty'.+--+-- Subject to fusion+--+-- Since 0.3.0+sourceNull, sourceNullC :: Monad m => ConduitT i o m ()+sourceNullC = return ()+{-# INLINE sourceNullC #-}+STREAMING0(sourceNull, sourceNullC, sourceNullS)++-- | Run a @Pipe@ repeatedly, and output its result value downstream. Stops+-- when no more input is available from upstream.+--+-- Since 0.5.0+sequence :: Monad m+ => ConduitT i o m o -- ^ @Pipe@ to run repeatedly+ -> ConduitT i o m ()+sequence sink =+ self+ where+ self = awaitForever $ \i -> leftover i >> sink >>= yield
+ src/Data/Streaming/FileRead.hs view
@@ -0,0 +1,37 @@+{-# LANGUAGE CPP #-}+-- | The standard @openFile@ call on Windows causing problematic file locking+-- in some cases. This module provides a cross-platform file reading API+-- without the file locking problems on Windows.+--+-- This module /always/ opens files in binary mode.+--+-- @readChunk@ will return an empty @ByteString@ on EOF.+module Data.Streaming.FileRead+ ( ReadHandle+ , openFile+ , closeFile+ , readChunk+ ) where++#if WINDOWS++import System.Win32File++#else++import qualified System.IO as IO+import qualified Data.ByteString as S+import Data.ByteString.Lazy.Internal (defaultChunkSize)++newtype ReadHandle = ReadHandle IO.Handle++openFile :: FilePath -> IO ReadHandle+openFile fp = ReadHandle `fmap` IO.openBinaryFile fp IO.ReadMode++closeFile :: ReadHandle -> IO ()+closeFile (ReadHandle h) = IO.hClose h++readChunk :: ReadHandle -> IO S.ByteString+readChunk (ReadHandle h) = S.hGetSome h defaultChunkSize++#endif
+ src/Data/Streaming/Filesystem.hs view
@@ -0,0 +1,100 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE ScopedTypeVariables #-}+-- | Streaming functions for interacting with the filesystem.+module Data.Streaming.Filesystem+ ( DirStream+ , openDirStream+ , readDirStream+ , closeDirStream+ , FileType (..)+ , getFileType+ ) where++import Data.Typeable (Typeable)++#if WINDOWS++import qualified System.Win32 as Win32+import System.FilePath ((</>))+import Data.IORef (IORef, newIORef, readIORef, writeIORef)+import System.Directory (doesFileExist, doesDirectoryExist)++data DirStream = DirStream !Win32.HANDLE !Win32.FindData !(IORef Bool)+ deriving Typeable++openDirStream :: FilePath -> IO DirStream+openDirStream fp = do+ (h, fdat) <- Win32.findFirstFile $ fp </> "*"+ imore <- newIORef True -- always at least two records, "." and ".."+ return $! DirStream h fdat imore++closeDirStream :: DirStream -> IO ()+closeDirStream (DirStream h _ _) = Win32.findClose h++readDirStream :: DirStream -> IO (Maybe FilePath)+readDirStream ds@(DirStream h fdat imore) = do+ more <- readIORef imore+ if more+ then do+ filename <- Win32.getFindDataFileName fdat+ Win32.findNextFile h fdat >>= writeIORef imore+ if filename == "." || filename == ".."+ then readDirStream ds+ else return $ Just filename+ else return Nothing++isSymlink :: FilePath -> IO Bool+isSymlink _ = return False++getFileType :: FilePath -> IO FileType+getFileType fp = do+ isFile <- doesFileExist fp+ if isFile+ then return FTFile+ else do+ isDir <- doesDirectoryExist fp+ return $ if isDir then FTDirectory else FTOther++#else++import System.Posix.Directory (DirStream, openDirStream, closeDirStream)+import qualified System.Posix.Directory as Posix+import qualified System.Posix.Files as PosixF+import Control.Exception (try, IOException)++readDirStream :: DirStream -> IO (Maybe FilePath)+readDirStream ds = do+ fp <- Posix.readDirStream ds+ case fp of+ "" -> return Nothing+ "." -> readDirStream ds+ ".." -> readDirStream ds+ _ -> return $ Just fp++getFileType :: FilePath -> IO FileType+getFileType fp = do+ s <- PosixF.getSymbolicLinkStatus fp+ case () of+ ()+ | PosixF.isRegularFile s -> return FTFile+ | PosixF.isDirectory s -> return FTDirectory+ | PosixF.isSymbolicLink s -> do+ es' <- try $ PosixF.getFileStatus fp+ case es' of+ Left (_ :: IOException) -> return FTOther+ Right s'+ | PosixF.isRegularFile s' -> return FTFileSym+ | PosixF.isDirectory s' -> return FTDirectorySym+ | otherwise -> return FTOther+ | otherwise -> return FTOther++#endif++data FileType+ = FTFile+ | FTFileSym -- ^ symlink to file+ | FTDirectory+ | FTDirectorySym -- ^ symlink to a directory+ | FTOther+ deriving (Show, Read, Eq, Ord, Typeable)
+ src/System/Win32File.hsc view
@@ -0,0 +1,100 @@+{-# LANGUAGE ForeignFunctionInterface #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+module System.Win32File+ ( openFile+ , readChunk+ , closeFile+ , ReadHandle+ ) where++import Foreign.C.String (CString)+import Foreign.Ptr (castPtr)+import Foreign.Marshal.Alloc (mallocBytes, free)+import Foreign.ForeignPtr (ForeignPtr, withForeignPtr)+#if __GLASGOW_HASKELL__ >= 704+import Foreign.C.Types (CInt (..))+#else+import Foreign.C.Types (CInt)+#endif+import Foreign.C.Error (throwErrnoIfMinus1Retry)+import Foreign.Ptr (Ptr)+import Data.Bits (Bits, (.|.))+import qualified Data.ByteString as S+import qualified Data.ByteString.Unsafe as BU+import qualified Data.ByteString.Internal as BI+import Data.Text (pack)+import Data.Text.Encoding (encodeUtf16LE)+import Data.Word (Word8)+import Prelude hiding (read)+import GHC.ForeignPtr (mallocPlainForeignPtrBytes)+import Data.ByteString.Lazy.Internal (defaultChunkSize)+++#include <fcntl.h>+#include <share.h>+#include <sys/stat.h>+#include <errno.h>++newtype OFlag = OFlag CInt+ deriving (Num, Bits, Show, Eq)++#{enum OFlag, OFlag+ , oBinary = _O_BINARY+ , oRdonly = _O_RDONLY+ , oWronly = _O_WRONLY+ , oCreat = _O_CREAT+ }++newtype SHFlag = SHFlag CInt+ deriving (Num, Bits, Show, Eq)++#{enum SHFlag, SHFlag+ , shDenyno = _SH_DENYNO+ }++newtype PMode = PMode CInt+ deriving (Num, Bits, Show, Eq)++#{enum PMode, PMode+ , pIread = _S_IREAD+ , pIwrite = _S_IWRITE+ }++foreign import ccall "_wsopen"+ c_wsopen :: CString -> OFlag -> SHFlag -> PMode -> IO CInt++foreign import ccall "_read"+ c_read :: ReadHandle -> Ptr Word8 -> CInt -> IO CInt++foreign import ccall "_write"+ c_write :: ReadHandle -> Ptr Word8 -> CInt -> IO CInt++foreign import ccall "_close"+ closeFile :: ReadHandle -> IO ()++newtype ReadHandle = ReadHandle CInt++openFile :: FilePath -> IO ReadHandle+openFile fp = do+ -- need to append a null char+ -- note that useAsCString is not sufficient, as we need to have two+ -- null octets to account for UTF16 encoding+ let bs = encodeUtf16LE $ pack $ fp ++ "\0"+ h <- BU.unsafeUseAsCString bs $ \str ->+ throwErrnoIfMinus1Retry "Data.Streaming.FileRead.openFile" $+ c_wsopen+ str+ (oBinary .|. oRdonly)+ shDenyno+ pIread+ return $ ReadHandle h++readChunk :: ReadHandle -> IO S.ByteString+readChunk fd = do+ fp <- mallocPlainForeignPtrBytes defaultChunkSize+ withForeignPtr fp $ \p -> do+ len <- throwErrnoIfMinus1Retry "System.Win32File.read" $ c_read fd p+ (fromIntegral defaultChunkSize)+ if len == 0+ then return $! S.empty+ else return $! BI.PS fp 0 (fromIntegral len)
test/Data/Conduit/Extra/ZipConduitSpec.hs view
@@ -2,7 +2,7 @@ import Test.Hspec import Data.Conduit import qualified Data.Conduit.List as CL-import Control.Applicative ((<*))+import Control.Applicative ((<*), pure) spec :: Spec spec = describe "Data.Conduit.Extra.ZipConduit" $ do@@ -12,7 +12,7 @@ conduit2 = CL.concatMap (replicate 2) conduit = getZipConduit $ ZipConduit conduit1 <* ZipConduit conduit2 sink = CL.consume- res <- src $$ conduit =$ sink+ res <- runConduit $ src .| conduit .| sink res `shouldBe` [2, 1, 1, 3, 2, 2, 4, 3, 3] it "sequenceConduits" $ do let src = mapM_ yield [1..3 :: Int]@@ -22,5 +22,13 @@ x <- sequenceConduits [conduit1, conduit2] yield $ length x + 10 sink = CL.consume- res <- src $$ conduit =$ sink+ res <- runConduit $ src .| conduit .| sink res `shouldBe` [2, 1, 1, 3, 2, 2, 4, 3, 3, 12]+ it "ZipConduitMonad" $ do+ let src = mapM_ yield [1..3 :: Int]+ conduit1 = CL.mapM (pure . (+1))+ conduit2 = CL.map id+ conduit = getZipConduit $ ZipConduit conduit1 <* ZipConduit conduit2+ sink = CL.consume+ res <- runConduit $ src .| conduit .| sink+ res `shouldBe` [2, 1, 3, 2, 4, 3]
+ test/Data/Conduit/StreamSpec.hs view
@@ -0,0 +1,602 @@+{-# LANGUAGE ViewPatterns #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE CPP #-}+module Data.Conduit.StreamSpec where++import Control.Applicative+import qualified Control.Monad+import Control.Monad (MonadPlus(..), liftM)+import Control.Monad.Identity (Identity, runIdentity)+import Control.Monad.State (StateT(..), get, put)+import Data.Conduit+import Data.Conduit.Internal.Fusion+import Data.Conduit.Internal.List.Stream+import Data.Conduit.List+import qualified Data.Foldable as F+import Data.Function (on)+import qualified Data.List+import qualified Data.Maybe+import Data.Monoid (Monoid(..))+import Data.Semigroup (Semigroup(..))+import Prelude+ ((.), ($), (>>=), (=<<), return, (==), Int, id, Maybe(..), Monad,+ Eq, Show, String, Functor, fst, snd)+import qualified Prelude+import qualified Safe+import Test.Hspec+import Test.QuickCheck++spec :: Spec+spec = describe "Comparing list function to" $ do+ qit "unfold" $+ \(getBlind -> f, initial :: Int) ->+ unfold f initial `checkInfiniteProducer`+ (Data.List.unfoldr f initial :: [Int])+ qit "unfoldS" $+ \(getBlind -> f, initial :: Int) ->+ unfoldS f initial `checkInfiniteStreamProducer`+ (Data.List.unfoldr f initial :: [Int])+ qit "unfoldM" $+ \(getBlind -> f, initial :: Int) ->+ unfoldM f initial `checkInfiniteProducerM`+ (unfoldrM f initial :: M [Int])+ qit "unfoldMS" $+ \(getBlind -> f, initial :: Int) ->+ unfoldMS f initial `checkInfiniteStreamProducerM`+ (unfoldrM f initial :: M [Int])+ qit "sourceList" $+ \(xs :: [Int]) ->+ sourceList xs `checkProducer` xs+ qit "sourceListS" $+ \(xs :: [Int]) ->+ sourceListS xs `checkStreamProducer` xs+ qit "enumFromTo" $+ \(fr :: Small Int, to :: Small Int) ->+ enumFromTo fr to `checkProducer`+ Prelude.enumFromTo fr to+ qit "enumFromToS" $+ \(fr :: Small Int, to :: Small Int) ->+ enumFromToS fr to `checkStreamProducer`+ Prelude.enumFromTo fr to+ qit "enumFromToS_int" $+ \(getSmall -> fr :: Int, getSmall -> to :: Int) ->+ enumFromToS_int fr to `checkStreamProducer`+ Prelude.enumFromTo fr to+ qit "iterate" $+ \(getBlind -> f, initial :: Int) ->+ iterate f initial `checkInfiniteProducer`+ Prelude.iterate f initial+ qit "iterateS" $+ \(getBlind -> f, initial :: Int) ->+ iterateS f initial `checkInfiniteStreamProducer`+ Prelude.iterate f initial+ qit "replicate" $+ \(getSmall -> n, getSmall -> x) ->+ replicate n x `checkProducer`+ (Prelude.replicate n x :: [Int])+ qit "replicateS" $+ \(getSmall -> n, getSmall -> x) ->+ replicateS n x `checkStreamProducer`+ (Prelude.replicate n x :: [Int])+ qit "replicateM" $+ \(getSmall -> n, getBlind -> f) ->+ replicateM n f `checkProducerM`+ (Control.Monad.replicateM n f :: M [Int])+ qit "replicateMS" $+ \(getSmall -> n, getBlind -> f) ->+ replicateMS n f `checkStreamProducerM`+ (Control.Monad.replicateM n f :: M [Int])+ qit "fold" $+ \(getBlind -> f, initial :: Int) ->+ fold f initial `checkConsumer`+ Data.List.foldl' f initial+ qit "foldS" $+ \(getBlind -> f, initial :: Int) ->+ foldS f initial `checkStreamConsumer`+ Data.List.foldl' f initial+ qit "foldM" $+ \(getBlind -> f, initial :: Int) ->+ foldM f initial `checkConsumerM`+ (Control.Monad.foldM f initial :: [Int] -> M Int)+ qit "foldMS" $+ \(getBlind -> f, initial :: Int) ->+ foldMS f initial `checkStreamConsumerM`+ (Control.Monad.foldM f initial :: [Int] -> M Int)+ qit "foldMap" $+ \(getBlind -> (f :: Int -> Sum Int)) ->+ foldMap f `checkConsumer`+ F.foldMap f+ qit "mapM_" $+ \(getBlind -> (f :: Int -> M ())) ->+ mapM_ f `checkConsumerM`+ Prelude.mapM_ f+ qit "mapM_S" $+ \(getBlind -> (f :: Int -> M ())) ->+ mapM_S f `checkStreamConsumerM`+ Prelude.mapM_ f+ qit "take" $+ \(getSmall -> n) ->+ take n `checkConsumer`+ Prelude.take n+ qit "takeS" $+ \(getSmall -> n) ->+ takeS n `checkStreamConsumer`+ Prelude.take n+ qit "head" $+ \() ->+ head `checkConsumer`+ Safe.headMay+ qit "headS" $+ \() ->+ headS `checkStreamConsumer`+ Safe.headMay+ qit "peek" $+ \() ->+ peek `checkConsumer`+ Safe.headMay+ qit "map" $+ \(getBlind -> (f :: Int -> Int)) ->+ map f `checkConduit`+ Prelude.map f+ qit "mapS" $+ \(getBlind -> (f :: Int -> Int)) ->+ mapS f `checkStreamConduit`+ Prelude.map f+ qit "mapM" $+ \(getBlind -> (f :: Int -> M Int)) ->+ mapM f `checkConduitT`+ Prelude.mapM f+ qit "mapMS" $+ \(getBlind -> (f :: Int -> M Int)) ->+ mapMS f `checkStreamConduitT`+ Prelude.mapM f+ qit "iterM" $+ \(getBlind -> (f :: Int -> M ())) ->+ iterM f `checkConduitT`+ iterML f+ qit "iterMS" $+ \(getBlind -> (f :: Int -> M ())) ->+ iterMS f `checkStreamConduitT`+ iterML f+ qit "mapMaybe" $+ \(getBlind -> (f :: Int -> Maybe Int)) ->+ mapMaybe f `checkConduit`+ Data.Maybe.mapMaybe f+ qit "mapMaybeS" $+ \(getBlind -> (f :: Int -> Maybe Int)) ->+ mapMaybeS f `checkStreamConduit`+ Data.Maybe.mapMaybe f+ qit "mapMaybeM" $+ \(getBlind -> (f :: Int -> M (Maybe Int))) ->+ mapMaybeM f `checkConduitT`+ mapMaybeML f+ qit "mapMaybeMS" $+ \(getBlind -> (f :: Int -> M (Maybe Int))) ->+ mapMaybeMS f `checkStreamConduitT`+ mapMaybeML f+ qit "catMaybes" $+ \() ->+ catMaybes `checkConduit`+ (Data.Maybe.catMaybes :: [Maybe Int] -> [Int])+ qit "catMaybesS" $+ \() ->+ catMaybesS `checkStreamConduit`+ (Data.Maybe.catMaybes :: [Maybe Int] -> [Int])+ qit "concat" $+ \() ->+ concat `checkConduit`+ (Prelude.concat :: [[Int]] -> [Int])+ qit "concatS" $+ \() ->+ concatS `checkStreamConduit`+ (Prelude.concat :: [[Int]] -> [Int])+ qit "concatMap" $+ \(getBlind -> f) ->+ concatMap f `checkConduit`+ (Prelude.concatMap f :: [Int] -> [Int])+ qit "concatMapS" $+ \(getBlind -> f) ->+ concatMapS f `checkStreamConduit`+ (Prelude.concatMap f :: [Int] -> [Int])+ qit "concatMapM" $+ \(getBlind -> (f :: Int -> M [Int])) ->+ concatMapM f `checkConduitT`+ concatMapML f+ qit "concatMapMS" $+ \(getBlind -> (f :: Int -> M [Int])) ->+ concatMapMS f `checkStreamConduitT`+ concatMapML f+ qit "concatMapAccum" $+ \(getBlind -> (f :: Int -> Int -> (Int, [Int])), initial :: Int) ->+ concatMapAccum f initial `checkConduit`+ concatMapAccumL f initial+ qit "concatMapAccumS" $+ \(getBlind -> (f :: Int -> Int -> (Int, [Int])), initial :: Int) ->+ concatMapAccumS f initial `checkStreamConduit`+ concatMapAccumL f initial+ {-qit "mapAccum" $+ \(getBlind -> (f :: Int -> Int -> (Int, [Int])), initial :: Int) ->+ mapAccum f initial `checkConduitResult`+ mapAccumL f initial-}+ qit "mapAccumS" $+ \(getBlind -> (f :: Int -> Int -> (Int, [Int])), initial :: Int) ->+ mapAccumS f initial `checkStreamConduitResult`+ mapAccumL f initial+ {-qit "mapAccumM" $+ \(getBlind -> (f :: Int -> Int -> M (Int, [Int])), initial :: Int) ->+ mapAccumM f initial `checkConduitResultM`+ mapAccumML f initial-}+ qit "mapAccumMS" $+ \(getBlind -> (f :: Int -> Int -> M (Int, [Int])), initial :: Int) ->+ mapAccumMS f initial `checkStreamConduitResultM`+ mapAccumML f initial+ {-qit "scan" $+ \(getBlind -> (f :: Int -> Int -> Int), initial :: Int) ->+ scan f initial `checkConduitResult`+ scanL f initial-}+ {-qit "scanM" $+ \(getBlind -> (f :: Int -> Int -> M Int), initial :: Int) ->+ scanM f initial `checkConduitResultM`+ scanML f initial-}+ qit "mapFoldable" $+ \(getBlind -> (f :: Int -> [Int])) ->+ mapFoldable f `checkConduit`+ mapFoldableL f+ qit "mapFoldableS" $+ \(getBlind -> (f :: Int -> [Int])) ->+ mapFoldableS f `checkStreamConduit`+ mapFoldableL f+ qit "mapFoldableM" $+ \(getBlind -> (f :: Int -> M [Int])) ->+ mapFoldableM f `checkConduitT`+ mapFoldableML f+ qit "mapFoldableMS" $+ \(getBlind -> (f :: Int -> M [Int])) ->+ mapFoldableMS f `checkStreamConduitT`+ mapFoldableML f+ qit "consume" $+ \() ->+ consume `checkConsumer`+ id+ qit "consumeS" $+ \() ->+ consumeS `checkStreamConsumer`+ id+ qit "groupBy" $+ \(getBlind -> f) ->+ groupBy f `checkConduit`+ (Data.List.groupBy f :: [Int] -> [[Int]])+ qit "groupByS" $+ \(getBlind -> f) ->+ groupByS f `checkStreamConduit`+ (Data.List.groupBy f :: [Int] -> [[Int]])+ qit "groupOn1" $+ \(getBlind -> (f :: Int -> Int)) ->+ groupOn1 f `checkConduit`+ groupOn1L f+ qit "groupOn1S" $+ \(getBlind -> (f :: Int -> Int)) ->+ groupOn1S f `checkStreamConduit`+ groupOn1L f+ qit "isolate" $+ \n ->+ isolate n `checkConduit`+ (Data.List.take n :: [Int] -> [Int])+ qit "isolateS" $+ \n ->+ isolateS n `checkStreamConduit`+ (Data.List.take n :: [Int] -> [Int])+ qit "filter" $+ \(getBlind -> f) ->+ filter f `checkConduit`+ (Data.List.filter f :: [Int] -> [Int])+ qit "filterS" $+ \(getBlind -> f) ->+ filterS f `checkStreamConduit`+ (Data.List.filter f :: [Int] -> [Int])+ qit "sourceNull" $+ \() ->+ sourceNull `checkProducer`+ ([] :: [Int])+ qit "sourceNullS" $+ \() ->+ sourceNullS `checkStreamProducer`+ ([] :: [Int])++qit :: (Arbitrary a, Testable prop, Show a)+ => String -> (a -> prop) -> Spec+qit n f = it n $ property $ forAll arbitrary f++--------------------------------------------------------------------------------+-- Quickcheck utilities for pure conduits / streams++checkProducer :: (Show a, Eq a) => ConduitT () a Identity () -> [a] -> Property+checkProducer c l = checkProducerM' runIdentity c (return l)++checkStreamProducer :: (Show a, Eq a) => StreamConduitT () a Identity () -> [a] -> Property+checkStreamProducer s l = checkStreamProducerM' runIdentity s (return l)++checkInfiniteProducer :: (Show a, Eq a) => ConduitT () a Identity () -> [a] -> Property+checkInfiniteProducer c l = checkInfiniteProducerM' runIdentity c (return l)++checkInfiniteStreamProducer :: (Show a, Eq a) => StreamConduitT () a Identity () -> [a] -> Property+checkInfiniteStreamProducer s l = checkInfiniteStreamProducerM' runIdentity s (return l)++checkConsumer :: (Show b, Eq b) => ConduitT Int Void Identity b -> ([Int] -> b) -> Property+checkConsumer c l = checkConsumerM' runIdentity c (return . l)++checkStreamConsumer :: (Show b, Eq b) => StreamConsumer Int Identity b -> ([Int] -> b) -> Property+checkStreamConsumer c l = checkStreamConsumerM' runIdentity c (return . l)++checkConduit :: (Show a, Arbitrary a, Show b, Eq b) => ConduitT a b Identity () -> ([a] -> [b]) -> Property+checkConduit c l = checkConduitT' runIdentity c (return . l)++checkStreamConduit :: (Show a, Arbitrary a, Show b, Eq b) => StreamConduitT a b Identity () -> ([a] -> [b]) -> Property+checkStreamConduit c l = checkStreamConduitT' runIdentity c (return . l)++-- checkConduitResult :: (Show a, Arbitrary a, Show b, Eq b, Show r, Eq r) => ConduitT a b Identity r -> ([a] -> ([b], r)) -> Property+-- checkConduitResult c l = checkConduitResultM' runIdentity c (return . l)++checkStreamConduitResult :: (Show a, Arbitrary a, Show b, Eq b, Show r, Eq r) => StreamConduitT a b Identity r -> ([a] -> ([b], r)) -> Property+checkStreamConduitResult c l = checkStreamConduitResultM' runIdentity c (return . l)++--------------------------------------------------------------------------------+-- Quickcheck utilities for conduits / streams in the M monad.++checkProducerM :: (Show a, Eq a) => ConduitT () a M () -> M [a] -> Property+checkProducerM = checkProducerM' runM++checkStreamProducerM :: (Show a, Eq a) => StreamSource M a -> M [a] -> Property+checkStreamProducerM = checkStreamProducerM' runM++checkInfiniteProducerM :: (Show a, Eq a) => ConduitT () a M () -> M [a] -> Property+checkInfiniteProducerM = checkInfiniteProducerM' (fst . runM)++checkInfiniteStreamProducerM :: (Show a, Eq a) => StreamSource M a -> M [a] -> Property+checkInfiniteStreamProducerM = checkInfiniteStreamProducerM' (fst . runM)++checkConsumerM :: (Show b, Eq b) => ConduitT Int Void M b -> ([Int] -> M b) -> Property+checkConsumerM = checkConsumerM' runM++checkStreamConsumerM :: (Show b, Eq b) => StreamConsumer Int M b -> ([Int] -> M b) -> Property+checkStreamConsumerM = checkStreamConsumerM' runM++checkConduitT :: (Show a, Arbitrary a, Show b, Eq b) => ConduitT a b M () -> ([a] -> M [b]) -> Property+checkConduitT = checkConduitT' runM++checkStreamConduitT :: (Show a, Arbitrary a, Show b, Eq b) => StreamConduit a M b -> ([a] -> M [b]) -> Property+checkStreamConduitT = checkStreamConduitT' runM++-- checkConduitResultM :: (Show a, Arbitrary a, Show b, Eq b, Show r, Eq r) => ConduitT a b M r -> ([a] -> M ([b], r)) -> Property+-- checkConduitResultM = checkConduitResultM' runM++checkStreamConduitResultM :: (Show a, Arbitrary a, Show b, Eq b, Show r, Eq r) => StreamConduitT a b M r -> ([a] -> M ([b], r)) -> Property+checkStreamConduitResultM = checkStreamConduitResultM' runM++--------------------------------------------------------------------------------+-- Quickcheck utilities for monadic streams / conduits+-- These are polymorphic in which Monad is used.++checkProducerM' :: (Show a, Monad m, Show b, Eq b)+ => (m [a] -> b)+ -> ConduitT () a m ()+ -> m [a]+ -> Property+checkProducerM' f c l =+ f (runConduit (preventFusion c .| consume))+ ===+ f l++checkStreamProducerM' :: (Show a, Monad m, Show b, Eq b)+ => (m [a] -> b)+ -> StreamSource m a+ -> m [a]+ -> Property+checkStreamProducerM' f s l =+ f (liftM fst $ evalStream $ s emptyStream)+ ===+ f l++checkInfiniteProducerM' :: (Show a, Monad m, Show b, Eq b)+ => (m [a] -> b)+ -> ConduitT () a m ()+ -> m [a]+ -> Property+checkInfiniteProducerM' f s l =+ checkProducerM' f+ (preventFusion s .| isolate 10)+ (liftM (Prelude.take 10) l)++checkInfiniteStreamProducerM' :: (Show a, Monad m, Show b, Eq b)+ => (m [a] -> b)+ -> StreamSource m a+ -> m [a]+ -> Property+checkInfiniteStreamProducerM' f s l =+ f (liftM snd $ evalStream $ takeS 10 $ s emptyStream)+ ===+ f (liftM (Prelude.take 10) l)++checkConsumerM' :: (Show a, Monad m, Show b, Eq b)+ => (m a -> b)+ -> ConduitT Int Void m a+ -> ([Int] -> m a)+ -> Property+checkConsumerM' f c l = forAll arbitrary $ \xs ->+ f (runConduit (sourceList xs .| preventFusion c))+ ===+ f (l xs)++checkStreamConsumerM' :: (Show a, Monad m, Show b, Eq b)+ => (m a -> b)+ -> StreamConsumer Int m a+ -> ([Int] -> m a)+ -> Property+checkStreamConsumerM' f s l = forAll arbitrary $ \xs ->+ f (liftM snd $ evalStream $ s $ sourceListS xs emptyStream)+ ===+ f (l xs)++checkConduitT' :: (Show a, Arbitrary a, Monad m, Show c, Eq c)+ => (m [b] -> c)+ -> ConduitT a b m ()+ -> ([a] -> m [b])+ -> Property+checkConduitT' f c l = forAll arbitrary $ \xs ->+ f (runConduit (sourceList xs .| preventFusion c .| consume))+ ===+ f (l xs)++checkStreamConduitT' :: (Show a, Arbitrary a, Monad m, Show c, Eq c)+ => (m [b] -> c)+ -> StreamConduit a m b+ -> ([a] -> m [b])+ -> Property+checkStreamConduitT' f s l = forAll arbitrary $ \xs ->+ f (liftM fst $ evalStream $ s $ sourceListS xs emptyStream)+ ===+ f (l xs)++-- TODO: Fixing this would allow comparing conduit consumers against+-- their list versions.+--+-- checkConduitResultM' :: (Show a, Arbitrary a, Monad m, Show c, Eq c)+-- => (m ([b], r) -> c)+-- -> ConduitT a b m r+-- -> ([a] -> m ([b], r))+-- -> Property+-- checkConduitResultM' f c l = FIXME forAll arbitrary $ \xs ->+-- f (sourceList xs .| preventFusion c $$ consume)+-- ===+-- f (l xs)++checkStreamConduitResultM' :: (Show a, Arbitrary a, Monad m, Show c, Eq c)+ => (m ([b], r) -> c)+ -> StreamConduitT a b m r+ -> ([a] -> m ([b], r))+ -> Property+checkStreamConduitResultM' f s l = forAll arbitrary $ \xs ->+ f (evalStream $ s $ sourceListS xs emptyStream)+ ===+ f (l xs)++emptyStream :: Monad m => Stream m () ()+emptyStream = Stream (\_ -> return $ Stop ()) (return ())++evalStream :: Monad m => Stream m o r -> m ([o], r)+evalStream (Stream step s0) = go =<< s0+ where+ go s = do+ res <- step s+ case res of+ Stop r -> return ([], r)+ Skip s' -> go s'+ Emit s' x -> liftM (\(l, r) -> (x:l, r)) (go s')++--------------------------------------------------------------------------------+-- Misc utilities++-- Prefer this to creating an orphan instance for Data.Monoid.Sum:++newtype Sum a = Sum a+ deriving (Eq, Show, Arbitrary)++instance Prelude.Num a => Semigroup (Sum a) where+ Sum x <> Sum y = Sum $ x Prelude.+ y++instance Prelude.Num a => Monoid (Sum a) where+ mempty = Sum 0+#if !(MIN_VERSION_base(4,11,0))+ mappend = (<>)+#endif++preventFusion :: a -> a+preventFusion = id+{-# INLINE [0] preventFusion #-}++newtype M a = M (StateT Int Identity a)+ deriving (Functor, Applicative, Monad)++instance Arbitrary a => Arbitrary (M a) where+ arbitrary = do+ f <- arbitrary+ return $ do+ s <- M get+ let (x, s') = f s+ M (put s')+ return x++runM :: M a -> (a, Int)+runM (M m) = runIdentity $ runStateT m 0++--------------------------------------------------------------------------------+-- List versions of some functions++iterML :: Monad m => (a -> m ()) -> [a] -> m [a]+iterML f = Prelude.mapM (\a -> f a >>= \() -> return a)++mapMaybeML :: Monad m => (a -> m (Maybe b)) -> [a] -> m [b]+mapMaybeML f = liftM Data.Maybe.catMaybes . Prelude.mapM f++concatMapML :: Monad m => (a -> m [b]) -> [a] -> m [b]+concatMapML f = liftM Prelude.concat . Prelude.mapM f++concatMapAccumL :: (a -> s -> (s, [b])) -> s -> [a] -> [b]+concatMapAccumL f acc0 =+ runIdentity . concatMapAccumML (\a acc -> return $ f a acc) acc0++mapAccumL :: (a -> s -> (s, b)) -> s -> [a] -> ([b], s)+mapAccumL f acc0 =+ runIdentity . mapAccumML (\a acc -> return $ f a acc) acc0++concatMapAccumML :: Monad m => (a -> s -> m (s, [b])) -> s -> [a] -> m [b]+concatMapAccumML f acc0 =+ liftM (Prelude.concat . fst) . mapAccumML f acc0++scanL :: (a -> b -> b) -> b -> [a] -> ([b], b)+scanL f = mapAccumL (\a b -> let r = f a b in (r, r))++scanML :: Monad m => (a -> b -> m b) -> b -> [a] -> m ([b], b)+scanML f = mapAccumML (\a b -> f a b >>= \r -> return (r, r))++mapFoldableL :: F.Foldable f => (a -> f b) -> [a] -> [b]+mapFoldableL f = runIdentity . mapFoldableML (return . f)++mapFoldableML :: (Monad m, F.Foldable f) => (a -> m (f b)) -> [a] -> m [b]+mapFoldableML f = concatMapML (liftM F.toList . f)++groupOn1L :: Eq b => (a -> b) -> [a] -> [(a, [a])]+groupOn1L f =+ Data.List.map (\(x:xs) -> (x, xs)) . Data.List.groupBy ((==) `on` f)++mapAccumML :: Monad m => (a -> s -> m (s, b)) -> s -> [a] -> m ([b], s)+mapAccumML f s0 = go s0+ where+ go s [] = return ([], s)+ go s (x:xs) = do+ (s', r) <- f x s+ liftM (\(l, o) -> (r:l, o)) $ go s' xs++--------------------------------------------------------------------------------+-- Utilities taken from monad-loops package++-- http://hackage.haskell.org/package/monad-loops++-- |See 'Data.List.unfoldr'. This is a monad-friendly version of that.+unfoldrM :: (Monad m) => (a -> m (Maybe (b,a))) -> a -> m [b]+unfoldrM = unfoldrM'++-- |See 'Data.List.unfoldr'. This is a monad-friendly version of that, with a+-- twist. Rather than returning a list, it returns any MonadPlus type of your+-- choice.+unfoldrM' :: (Monad m, MonadPlus f) => (a -> m (Maybe (b,a))) -> a -> m (f b)+unfoldrM' f = go+ where go z = do+ x <- f z+ case x of+ Nothing -> return mzero+ Just (x', z') -> do+ xs <- go z'+ return (return x' `mplus` xs)
+ test/Spec.hs view
@@ -0,0 +1,664 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ViewPatterns #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# OPTIONS_GHC -fno-warn-type-defaults #-}+module Spec (spec) where++import Conduit+import Prelude hiding (FilePath)+import Data.Maybe (listToMaybe)+import Data.Conduit.Combinators (slidingWindow, chunksOfE, chunksOfExactlyE)+import Data.List (intersperse, sort, find, mapAccumL)+import Safe (tailSafe)+import System.FilePath (takeExtension, (</>))+import Test.Hspec+import Test.Hspec.QuickCheck+import qualified Data.Text as T+import qualified Data.Text.Lazy as TL+import qualified Data.Text.Lazy.Encoding as TL+import Data.IORef+import qualified Data.Vector as V+import qualified Data.Vector.Unboxed as VU+import qualified Data.Vector.Storable as VS+import Control.Monad (liftM)+import Control.Monad.ST (runST)+import Control.Monad.Trans.Writer+import qualified System.IO as IO+#if ! MIN_VERSION_base(4,8,0)+import Data.Monoid (Monoid (..))+import Control.Applicative ((<$>), (<*>))+#endif+#if MIN_VERSION_mono_traversable(1,0,0)+import Data.Sequences (LazySequence (..), Utf8 (..))+#else+import Data.Sequences.Lazy+import Data.Textual.Encoding+#endif+import qualified Data.NonNull as NN+import GHC.IO.Handle (hDuplicateTo)+import qualified Data.ByteString as S+import Data.ByteString.Builder (byteString, toLazyByteString)+import qualified Data.ByteString.Char8 as S8+import qualified Data.ByteString.Lazy.Char8 as L8+import qualified StreamSpec+import UnliftIO.Exception (pureTry)++spec :: Spec+spec = do+ describe "yieldMany" $ do+ it "list" $+ runConduitPure (yieldMany [1..10] .| sinkList)+ `shouldBe` [1..10]+ it "Text" $+ runConduitPure (yieldMany ("Hello World" :: T.Text) .| sinkList)+ `shouldBe` "Hello World"+ it "unfold" $+ let f 11 = Nothing+ f i = Just (show i, i + 1)+ in runConduitPure (unfoldC f 1 .| sinkList)+ `shouldBe` map show [1..10]+ it "enumFromTo" $+ runConduitPure (enumFromToC 1 10 .| sinkList) `shouldBe` [1..10]+ it "iterate" $+ let f i = i + 1+ src = iterateC f seed+ seed = 1+ count = 10+ res = runConduitPure $ src .| takeC count .| sinkList+ in res `shouldBe` take count (iterate f seed)+ it "repeat" $+ let src = repeatC seed+ seed = 1+ count = 10+ res = runConduitPure $ src .| takeC count .| sinkList+ in res `shouldBe` take count (repeat seed)+ it "replicate" $+ let src = replicateC count seed+ seed = 1+ count = 10+ res = runConduitPure $ src .| sinkList+ in res `shouldBe` replicate count seed+ it "sourceLazy" $+ let tss = ["foo", "bar", "baz"]+ tl = TL.fromChunks tss+ res = runConduitPure $ sourceLazy tl .| sinkList+ in res `shouldBe` tss+ it "repeatM" $+ let src = repeatMC (return seed)+ seed = 1+ count = 10+ res = runConduitPure $ src .| takeC count .| sinkList+ in res `shouldBe` take count (repeat seed)+ it "repeatWhileM" $ do+ ref <- newIORef 0+ let f = atomicModifyIORef ref $ \i -> (succ i, succ i)+ src = repeatWhileMC f (< 11)+ res <- runConduit $ src .| sinkList+ res `shouldBe` [1..10]+ it "replicateM" $ do+ ref <- newIORef 0+ let f = atomicModifyIORef ref $ \i -> (succ i, succ i)+ src = replicateMC 10 f+ res <- runConduit $ src .| sinkList+ res `shouldBe` [1..10]+ it "sourceFile" $ do+ let contents = concat $ replicate 10000 $ "this is some content\n"+ fp = "tmp"+ writeFile fp contents+ res <- runConduitRes $ sourceFile fp .| sinkLazy+ nocrBL res `shouldBe` TL.encodeUtf8 (TL.pack contents)+ it "sourceHandle" $ do+ let contents = concat $ replicate 10000 $ "this is some content\n"+ fp = "tmp"+ writeFile fp contents+ res <- IO.withBinaryFile "tmp" IO.ReadMode $ \h ->+ runConduit $ sourceHandle h .| sinkLazy+ nocrBL res `shouldBe` TL.encodeUtf8 (TL.pack contents)+ it "sourceIOHandle" $ do+ let contents = concat $ replicate 10000 $ "this is some content\n"+ fp = "tmp"+ writeFile fp contents+ let open = IO.openBinaryFile "tmp" IO.ReadMode+ res <- runConduitRes $ sourceIOHandle open .| sinkLazy+ nocrBL res `shouldBe` TL.encodeUtf8 (TL.pack contents)+ prop "stdin" $ \(S.pack -> content) -> do+ S.writeFile "tmp" content+ IO.withBinaryFile "tmp" IO.ReadMode $ \h -> do+ hDuplicateTo h IO.stdin+ x <- runConduit $ stdinC .| foldC+ x `shouldBe` content+ let hasExtension' ext fp = takeExtension fp == ext+ it "sourceDirectory" $ do+ res <- runConduitRes+ $ sourceDirectory "test" .| filterC (not . hasExtension' ".swp") .| sinkList+ sort res `shouldBe`+ [ "test" </> "Data"+ , "test" </> "Spec.hs"+ , "test" </> "StreamSpec.hs"+ , "test" </> "doctests.hs"+ , "test" </> "main.hs"+ , "test" </> "subdir"+ ]+ it "sourceDirectoryDeep" $ do+ res1 <- runConduitRes+ $ sourceDirectoryDeep False "test" .| filterC (not . hasExtension' ".swp") .| sinkList+ res2 <- runConduitRes+ $ sourceDirectoryDeep True "test" .| filterC (not . hasExtension' ".swp") .| sinkList+ sort res1 `shouldBe`+ [ "test" </> "Data" </> "Conduit" </> "Extra" </> "ZipConduitSpec.hs"+ , "test" </> "Data" </> "Conduit" </> "StreamSpec.hs"+ , "test" </> "Spec.hs"+ , "test" </> "StreamSpec.hs"+ , "test" </> "doctests.hs"+ , "test" </> "main.hs"+ , "test" </> "subdir" </> "dummyfile.txt"+ ]+ sort res1 `shouldBe` sort res2+ prop "drop" $ \(T.pack -> input) count ->+ runConduitPure (yieldMany input .| (dropC count >>= \() -> sinkList))+ `shouldBe` T.unpack (T.drop count input)+ prop "dropE" $ \(T.pack -> input) ->+ runConduitPure (yield input .| (dropCE 5 >>= \() -> foldC))+ `shouldBe` T.drop 5 input+ prop "dropWhile" $ \(T.pack -> input) sep ->+ runConduitPure (yieldMany input .| (dropWhileC (<= sep) >>= \() -> sinkList))+ `shouldBe` T.unpack (T.dropWhile (<= sep) input)+ prop "dropWhileE" $ \(T.pack -> input) sep ->+ runConduitPure (yield input .| (dropWhileCE (<= sep) >>= \() -> foldC))+ `shouldBe` T.dropWhile (<= sep) input+ it "fold" $+ let list = [[1..10], [11..20]]+ src = yieldMany list+ res = runConduitPure $ src .| foldC+ in res `shouldBe` concat list+ it "foldE" $+ let list = [[1..10], [11..20]]+ src = yieldMany $ Identity list+ res = runConduitPure $ src .| foldCE+ in res `shouldBe` concat list+ it "foldl" $+ let res = runConduitPure $ yieldMany [1..10] .| foldlC (+) 0+ in res `shouldBe` sum [1..10]+ it "foldlE" $+ let res = runConduitPure $ yield [1..10] .| foldlCE (+) 0+ in res `shouldBe` sum [1..10]+ it "foldMap" $+ let src = yieldMany [1..10]+ res = runConduitPure $ src .| foldMapC return+ in res `shouldBe` [1..10]+ it "foldMapE" $+ let src = yield [1..10]+ res = runConduitPure $ src .| foldMapCE return+ in res `shouldBe` [1..10]+ prop "all" $ \ (input :: [Int]) -> runConduitPure (yieldMany input .| allC even) `shouldBe` all evenInt input+ prop "allE" $ \ (input :: [Int]) -> runConduitPure (yield input .| allCE even) `shouldBe` all evenInt input+ prop "any" $ \ (input :: [Int]) -> runConduitPure (yieldMany input .| anyC even) `shouldBe` any evenInt input+ prop "anyE" $ \ (input :: [Int]) -> runConduitPure (yield input .| anyCE even) `shouldBe` any evenInt input+ prop "and" $ \ (input :: [Bool]) -> runConduitPure (yieldMany input .| andC) `shouldBe` and input+ prop "andE" $ \ (input :: [Bool]) -> runConduitPure (yield input .| andCE) `shouldBe` and input+ prop "or" $ \ (input :: [Bool]) -> runConduitPure (yieldMany input .| orC) `shouldBe` or input+ prop "orE" $ \ (input :: [Bool]) -> runConduitPure (yield input .| orCE) `shouldBe` or input+ prop "elem" $ \x xs -> runConduitPure (yieldMany xs .| elemC x) `shouldBe` elemInt x xs+ prop "elemE" $ \x xs -> runConduitPure (yield xs .| elemCE x) `shouldBe` elemInt x xs+ prop "notElem" $ \x xs -> runConduitPure (yieldMany xs .| notElemC x) `shouldBe` notElemInt x xs+ prop "notElemE" $ \x xs -> runConduitPure (yield xs .| notElemCE x) `shouldBe` notElemInt x xs+ prop "sinkVector regular" $ \xs -> do+ res <- runConduit $ yieldMany xs .| sinkVector+ res `shouldBe` V.fromList (xs :: [Int])+ prop "sinkVector unboxed" $ \xs -> do+ res <- runConduit $ yieldMany xs .| sinkVector+ res `shouldBe` VU.fromList (xs :: [Int])+ prop "sinkVector storable" $ \xs -> do+ res <- runConduit $ yieldMany xs .| sinkVector+ res `shouldBe` VS.fromList (xs :: [Int])+ prop "sinkVectorN regular" $ \xs' -> do+ let maxSize = 20+ xs = take maxSize xs'+ res <- runConduit $ yieldMany xs' .| sinkVectorN maxSize+ res `shouldBe` V.fromList (xs :: [Int])+ prop "sinkVectorN unboxed" $ \xs' -> do+ let maxSize = 20+ xs = take maxSize xs'+ res <- runConduit $ yieldMany xs' .| sinkVectorN maxSize+ res `shouldBe` VU.fromList (xs :: [Int])+ prop "sinkVectorN storable" $ \xs' -> do+ let maxSize = 20+ xs = take maxSize xs'+ res <- runConduit $ yieldMany xs' .| sinkVectorN maxSize+ res `shouldBe` VS.fromList (xs :: [Int])+ prop "sinkBuilder" $ \(map S.pack -> inputs) ->+ let builder = runConduitPure $ yieldMany inputs .| foldMapC byteString+ ltext = toLazyByteString builder+ in ltext `shouldBe` fromChunks inputs+ prop "sinkLazyBuilder" $ \(map S.pack -> inputs) ->+ let lbs = runConduitPure (yieldMany (map byteString inputs) .| sinkLazyBuilder)+ in lbs `shouldBe` fromChunks inputs+ prop "sinkNull" $ \xs toSkip -> do+ res <- runConduit $ yieldMany xs .| do+ takeC toSkip .| sinkNull+ sinkList+ res `shouldBe` drop toSkip (xs :: [Int])+ prop "awaitNonNull" $ \xs ->+ fmap NN.toNullable (runConduitPure $ yieldMany xs .| awaitNonNull)+ `shouldBe` listToMaybe (filter (not . null) (xs :: [[Int]]))+ prop "headE" $ \ (xs :: [[Int]]) ->+ runConduitPure (yieldMany xs .| ((,) <$> headCE <*> foldC))+ `shouldBe` (listToMaybe $ concat xs, drop 1 $ concat xs)+ prop "peek" $ \xs ->+ runConduitPure (yieldMany xs .| ((,) <$> peekC <*> sinkList))+ `shouldBe` (listToMaybe xs, xs :: [Int])+ prop "peekE" $ \ (xs :: [[Int]]) ->+ runConduitPure (yieldMany xs .| ((,) <$> peekCE <*> foldC))+ `shouldBe` (listToMaybe $ concat xs, concat xs)+ prop "last" $ \xs ->+ runConduitPure (yieldMany xs .| lastC)+ `shouldBe` listToMaybe (reverse (xs :: [Int]))+ prop "lastE" $ \ (xs :: [[Int]]) ->+ runConduitPure (yieldMany xs .| lastCE)+ `shouldBe` listToMaybe (reverse (concat xs))+ prop "length" $ \xs ->+ runConduitPure (yieldMany xs .| lengthC)+ `shouldBe` length (xs :: [Int])+ prop "lengthE" $ \ (xs :: [[Int]]) ->+ runConduitPure (yieldMany xs .| lengthCE)+ `shouldBe` length (concat xs)+ prop "lengthIf" $ \x xs ->+ runConduitPure (yieldMany xs .| lengthIfC (< x))+ `shouldBe` length (filter (< x) xs :: [Int])+ prop "lengthIfE" $ \x (xs :: [[Int]]) ->+ runConduitPure (yieldMany xs .| lengthIfCE (< x))+ `shouldBe` length (filter (< x) (concat xs))+ prop "maximum" $ \xs ->+ runConduitPure (yieldMany xs .| maximumC)+ `shouldBe` (if null (xs :: [Int]) then Nothing else Just (maximum xs))+ prop "maximumE" $ \ (xs :: [[Int]]) ->+ runConduitPure (yieldMany xs .| maximumCE)+ `shouldBe` (if null (concat xs) then Nothing else Just (maximum $ concat xs))+ prop "minimum" $ \xs ->+ runConduitPure (yieldMany xs .| minimumC)+ `shouldBe` (if null (xs :: [Int]) then Nothing else Just (minimum xs))+ prop "minimumE" $ \ (xs :: [[Int]]) ->+ runConduitPure (yieldMany xs .| minimumCE)+ `shouldBe` (if null (concat xs) then Nothing else Just (minimum $ concat xs))+ prop "null" $ \xs ->+ runConduitPure (yieldMany xs .| nullC)+ `shouldBe` null (xs :: [Int])+ prop "nullE" $ \ (xs :: [[Int]]) ->+ runConduitPure (yieldMany xs .| ((,) <$> nullCE <*> foldC))+ `shouldBe` (null (concat xs), concat xs)+ prop "sum" $ \xs ->+ runConduitPure (yieldMany xs .| sumC)+ `shouldBe` sum (xs :: [Int])+ prop "sumE" $ \ (xs :: [[Int]]) ->+ runConduitPure (yieldMany xs .| sumCE)+ `shouldBe` sum (concat xs)+ prop "product" $ \xs ->+ runConduitPure (yieldMany xs .| productC)+ `shouldBe` product (xs :: [Int])+ prop "productE" $ \ (xs :: [[Int]]) ->+ runConduitPure (yieldMany xs .| productCE)+ `shouldBe` product (concat xs)+ prop "find" $ \x xs ->+ runConduitPure (yieldMany xs .| findC (< x))+ `shouldBe` find (< x) (xs :: [Int])+ prop "mapM_" $ \xs ->+ let res = execWriter $ runConduit $ yieldMany xs .| mapM_C (tell . return)+ in res `shouldBe` (xs :: [Int])+ prop "mapM_E" $ \xs ->+ let res = execWriter $ runConduit $ yield xs .| mapM_CE (tell . return)+ in res `shouldBe` (xs :: [Int])+ prop "foldM" $ \ (xs :: [Int]) -> do+ res <- runConduit $ yieldMany xs .| foldMC addM 0+ res `shouldBe` sum xs+ prop "foldME" $ \ (xs :: [Int]) -> do+ res <- runConduit $ yield xs .| foldMCE addM 0+ res `shouldBe` sum xs+ it "foldMapM" $+ let src = yieldMany [1..10]+ res = runConduitPure $ src .| foldMapMC (return . return)+ in res `shouldBe` [1..10]+ it "foldMapME" $+ let src = yield [1..10]+ res = runConduitPure $ src .| foldMapMCE (return . return)+ in res `shouldBe` [1..10]+ it "sinkFile" $ do+ let contents = mconcat $ replicate 1000 $ "this is some content\n"+ fp = "tmp"+ runConduitRes $ yield contents .| sinkFile fp+ res <- S.readFile fp+ res `shouldBe` contents+ it "sinkHandle" $ do+ let contents = mconcat $ replicate 1000 $ "this is some content\n"+ fp = "tmp"+ IO.withBinaryFile "tmp" IO.WriteMode $ \h -> runConduit $ yield contents .| sinkHandle h+ res <- S.readFile fp+ res `shouldBe` contents+ it "sinkIOHandle" $ do+ let contents = mconcat $ replicate 1000 $ "this is some content\n"+ fp = "tmp"+ open = IO.openBinaryFile "tmp" IO.WriteMode+ runConduitRes $ yield contents .| sinkIOHandle open+ res <- S.readFile fp+ res `shouldBe` contents+ prop "map" $ \input ->+ runConduitPure (yieldMany input .| mapC succChar .| sinkList)+ `shouldBe` map succChar input+ prop "mapE" $ \(map V.fromList -> inputs) ->+ runConduitPure (yieldMany inputs .| mapCE succChar .| foldC)+ `shouldBe` V.map succChar (V.concat inputs)+ prop "omapE" $ \(map T.pack -> inputs) ->+ runConduitPure (yieldMany inputs .| omapCE succChar .| foldC)+ `shouldBe` T.map succChar (T.concat inputs)+ prop "concatMap" $ \ (input :: [Int]) ->+ runConduitPure (yieldMany input .| concatMapC showInt .| sinkList)+ `shouldBe` concatMap showInt input+ prop "concatMapE" $ \ (input :: [Int]) ->+ runConduitPure (yield input .| concatMapCE showInt .| foldC)+ `shouldBe` concatMap showInt input+ prop "take" $ \(T.pack -> input) count ->+ runConduitPure (yieldMany input .| (takeC count >>= \() -> mempty) .| sinkList)+ `shouldBe` T.unpack (T.take count input)+ prop "takeE" $ \(T.pack -> input) count ->+ runConduitPure (yield input .| (takeCE count >>= \() -> mempty) .| foldC)+ `shouldBe` T.take count input+ prop "takeWhile" $ \(T.pack -> input) sep ->+ runConduitPure (yieldMany input .| do+ x <- (takeWhileC (<= sep) >>= \() -> mempty) .| sinkList+ y <- sinkList+ return (x, y))+ `shouldBe` span (<= sep) (T.unpack input)+ prop "takeWhileE" $ \(T.pack -> input) sep ->+ runConduitPure (yield input .| do+ x <- (takeWhileCE (<= sep) >>= \() -> mempty) .| foldC+ y <- foldC+ return (x, y))+ `shouldBe` T.span (<= sep) input+ it "takeExactly" $+ let src = yieldMany [1..10]+ sink = do+ x <- takeExactlyC 5 $ return 1+ y <- sinkList+ return (x, y)+ res = runConduitPure $ src .| sink+ in res `shouldBe` (1, [6..10])+ it "takeExactlyE" $+ let src = yield ("Hello World" :: T.Text)+ sink = do+ takeExactlyCE 5 (mempty :: ConduitT T.Text Void Identity ())+ y <- sinkLazy+ return y+ res = runConduitPure $ src .| sink+ in res `shouldBe` " World"+ it "takeExactlyE Vector" $ do+ let src = yield (V.fromList $ T.unpack "Hello World")+ sink = do+ x <- takeExactlyCE 5 $ return 1+ y <- foldC+ return (x, y)+ res <- runConduit $ src .| sink+ res `shouldBe` (1, V.fromList $ T.unpack " World")+ it "takeExactlyE 2" $+ let src = yield ("Hello World" :: T.Text)+ sink = do+ x <- takeExactlyCE 5 $ return 1+ y <- sinkLazy+ return (x, y)+ res = runConduitPure $ src .| sink+ -- FIXME type signature on next line is necessary in GHC 7.6.3 to+ -- avoid a crash:+ --+ -- test: internal error: ARR_WORDS object entered!+ -- (GHC version 7.6.3 for x86_64_unknown_linux)+ -- Please report this as a GHC bug: http://www.haskell.org/ghc/reportabug+ -- Aborted (core dumped)+ --+ -- Report upstream when packages are released+ in res `shouldBe` (1, " World" :: TL.Text)+ prop "concat" $ \input ->+ runConduitPure (yield (T.pack input) .| concatC .| sinkList)+ `shouldBe` input+ prop "filter" $ \input ->+ runConduitPure (yieldMany input .| filterC evenInt .| sinkList)+ `shouldBe` filter evenInt input+ prop "filterE" $ \input ->+ runConduitPure (yield input .| filterCE evenInt .| foldC)+ `shouldBe` filter evenInt input+ prop "mapWhile" $ \input (min 20 -> highest) ->+ let f i | i < highest = Just (i + 2 :: Int)+ | otherwise = Nothing+ res = runConduitPure $ yieldMany input .| do+ x <- (mapWhileC f >>= \() -> mempty) .| sinkList+ y <- sinkList+ return (x, y)+ (taken, dropped) = span (< highest) input+ in res `shouldBe` (map (+ 2) taken, dropped)+ prop "conduitVector" $ \(take 200 -> input) size' -> do+ let size = min 30 $ succ $ abs size'+ res <- runConduit $ yieldMany input .| conduitVector size .| sinkList+ res `shouldSatisfy` all (\v -> V.length v <= size)+ drop 1 (reverse res) `shouldSatisfy` all (\v -> V.length v == size)+ V.concat res `shouldBe` V.fromList (input :: [Int])+ prop "scanl" $ \input seed ->+ let f a b = a + b :: Int+ res = runConduitPure $ yieldMany input .| scanlC f seed .| sinkList+ in res `shouldBe` scanl f seed input+ prop "mapAccumWhile" $ \input (min 20 -> highest) ->+ let f i accum | i < highest = Right (i + accum, 2 * i :: Int)+ | otherwise = Left accum+ res = runConduitPure $ yieldMany input .| do+ (s, x) <- fuseBoth (mapAccumWhileC f 0) sinkList+ y <- sinkList+ return (s, x, y)+ (taken, dropped) = span (< highest) input+ in res `shouldBe` (sum taken, map (* 2) taken, tailSafe dropped)+ prop "concatMapAccum" $ \(input :: [Int]) ->+ let f a accum = (a + accum, [a, accum])+ res = runConduitPure $ yieldMany input .| concatMapAccumC f 0 .| sinkList+ expected = concat $ snd $ mapAccumL (flip f) 0 input+ in res `shouldBe` expected+ prop "intersperse" $ \xs x ->+ runConduitPure (yieldMany xs .| intersperseC x .| sinkList)+ `shouldBe` intersperse (x :: Int) xs+ prop "mapM" $ \input ->+ runConduitPure (yieldMany input .| mapMC (return . succChar) .| sinkList)+ `shouldBe` map succChar input+ prop "mapME" $ \(map V.fromList -> inputs) ->+ runConduitPure (yieldMany inputs .| mapMCE (return . succChar) .| foldC)+ `shouldBe` V.map succChar (V.concat inputs)+ prop "omapME" $ \(map T.pack -> inputs) ->+ runConduitPure (yieldMany inputs .| omapMCE (return . succChar) .| foldC)+ `shouldBe` T.map succChar (T.concat inputs)+ prop "concatMapM" $ \ (input :: [Int]) ->+ runConduitPure (yieldMany input .| concatMapMC (return . showInt) .| sinkList)+ `shouldBe` concatMap showInt input+ prop "filterM" $ \input ->+ runConduitPure (yieldMany input .| filterMC (return . evenInt) .| sinkList)+ `shouldBe` filter evenInt input+ prop "filterME" $ \input ->+ runConduitPure (yield input .| filterMCE (return . evenInt) .| foldC)+ `shouldBe` filter evenInt input+ prop "iterM" $ \input -> do+ (x, y) <- runWriterT $ runConduit $ yieldMany input .| iterMC (tell . return) .| sinkList+ x `shouldBe` (input :: [Int])+ y `shouldBe` input+ prop "scanlM" $ \input seed ->+ let f a b = a + b :: Int+ fm a b = return $ a + b+ res = runConduitPure $ yieldMany input .| scanlMC fm seed .| sinkList+ in res `shouldBe` scanl f seed input+ prop "mapAccumWhileM" $ \input (min 20 -> highest) ->+ let f i accum | i < highest = Right (i + accum, 2 * i :: Int)+ | otherwise = Left accum+ res = runConduitPure $ yieldMany input .| do+ (s, x) <- fuseBoth (mapAccumWhileMC ((return.).f) 0) sinkList+ y <- sinkList+ return (s, x, y)+ (taken, dropped) = span (< highest) input+ in res `shouldBe` (sum taken, map (* 2) taken, tailSafe dropped)+ prop "concatMapAccumM" $ \(input :: [Int]) ->+ let f a accum = (a + accum, [a, accum])+ res = runConduitPure $ yieldMany input .| concatMapAccumMC ((return.).f) 0 .| sinkList+ expected = concat $ snd $ mapAccumL (flip f) 0 input+ in res `shouldBe` expected+ prop "encode UTF8" $ \(map T.pack -> inputs) -> do+ let expected = encodeUtf8 $ fromChunks inputs+ actual <- runConduit+ $ yieldMany inputs+ .| encodeUtf8C+ .| sinkLazy+ actual `shouldBe` expected+ prop "encode/decode UTF8" $ \(map T.pack -> inputs) (min 50 . max 1 . abs -> chunkSize) -> do+ let expected = fromChunks inputs+ actual <- runConduit+ $ yieldMany inputs+ .| encodeUtf8C+ .| concatC+ .| conduitVector chunkSize+ .| mapC (S.pack . V.toList)+ .| decodeUtf8C+ .| sinkLazy+ actual `shouldBe` expected+ it "invalid UTF8 is an exception" $+ case runConduit $ yield "\129" .| decodeUtf8C .| sinkLazy of+ Left _ -> return () :: IO ()+ Right x -> error $ "this should have failed, got: " ++ show x+ prop "encode/decode UTF8 lenient" $ \(map T.pack -> inputs) (min 50 . max 1 . abs -> chunkSize) -> do+ let expected = fromChunks inputs+ actual <- runConduit+ $ yieldMany inputs+ .| encodeUtf8C+ .| concatC+ .| conduitVector chunkSize+ .| mapC (S.pack . V.toList)+ .| decodeUtf8LenientC+ .| sinkLazy+ actual `shouldBe` expected+ prop "line" $ \(map T.pack -> input) size ->+ let src = yieldMany input+ sink = do+ x <- lineC $ takeCE size .| foldC+ y <- foldC+ return (x, y)+ res = runConduitPure $ src .| sink+ expected =+ let (x, y) = T.break (== '\n') (T.concat input)+ in (T.take size x, T.drop 1 y)+ in res `shouldBe` expected+ prop "lineAscii" $ \(map S.pack -> input) size ->+ let src = yieldMany input+ sink = do+ x <- lineAsciiC $ takeCE size .| foldC+ y <- foldC+ return (x, y)+ res = runConduitPure $ src .| sink+ expected =+ let (x, y) = S.break (== 10) (S.concat input)+ in (S.take size x, S.drop 1 y)+ in res `shouldBe` expected+ prop "unlines" $ \(map T.pack -> input) ->+ runConduitPure (yieldMany input .| unlinesC .| foldC)+ `shouldBe` T.unlines input+ prop "unlinesAscii" $ \(map S.pack -> input) ->+ runConduitPure (yieldMany input .| unlinesAsciiC .| foldC)+ `shouldBe` S8.unlines input+ prop "linesUnbounded" $ \(map T.pack -> input) ->+ runConduitPure (yieldMany input .| (linesUnboundedC >>= \() -> mempty) .| sinkList)+ `shouldBe` T.lines (T.concat input)+ prop "linesUnboundedAscii" $ \(map S.pack -> input) ->+ runConduitPure (yieldMany input .| (linesUnboundedAsciiC >>= \() -> mempty) .| sinkList)+ `shouldBe` S8.lines (S.concat input)+ it "slidingWindow 0" $+ let res = runConduitPure $ yieldMany [1..5] .| slidingWindow 0 .| sinkList+ in res `shouldBe` [[1],[2],[3],[4],[5]]+ it "slidingWindow 1" $+ let res = runConduitPure $ yieldMany [1..5] .| slidingWindow 1 .| sinkList+ in res `shouldBe` [[1],[2],[3],[4],[5]]+ it "slidingWindow 2" $+ let res = runConduitPure $ yieldMany [1..5] .| slidingWindow 2 .| sinkList+ in res `shouldBe` [[1,2],[2,3],[3,4],[4,5]]+ it "slidingWindow 3" $+ let res = runConduitPure $ yieldMany [1..5] .| slidingWindow 3 .| sinkList+ in res `shouldBe` [[1,2,3],[2,3,4],[3,4,5]]+ it "slidingWindow 4" $+ let res = runConduitPure $ yieldMany [1..5] .| slidingWindow 4 .| sinkList+ in res `shouldBe` [[1,2,3,4],[2,3,4,5]]+ it "slidingWindow 5" $+ let res = runConduitPure $ yieldMany [1..5] .| slidingWindow 5 .| sinkList+ in res `shouldBe` [[1,2,3,4,5]]+ it "slidingWindow 6" $+ let res = runConduitPure $ yieldMany [1..5] .| slidingWindow 6 .| sinkList+ in res `shouldBe` [[1,2,3,4,5]]+ it "chunksOfE 1" $+ let res = runConduitPure $ yieldMany [[1,2], [3,4], [5,6]] .| chunksOfE 3 .| sinkList+ in res `shouldBe` [[1,2,3], [4,5,6]]+ it "chunksOfE 2 (last smaller)" $+ let res = runConduitPure $ yieldMany [[1,2], [3,4], [5,6,7]] .| chunksOfE 3 .| sinkList+ in res `shouldBe` [[1,2,3], [4,5,6], [7]]+ it "chunksOfE (ByteString)" $+ let res = runConduitPure $ yieldMany [S8.pack "01234", "56789ab", "cdef", "h"] .| chunksOfE 4 .| sinkList+ in res `shouldBe` ["0123", "4567", "89ab", "cdef", "h"]+ it "chunksOfExactlyE 1" $+ let res = runConduitPure $ yieldMany [[1,2], [3,4], [5,6]] .| chunksOfExactlyE 3 .| sinkList+ in res `shouldBe` [[1,2,3], [4,5,6]]+ it "chunksOfExactlyE 2 (last smaller; thus not yielded)" $+ let res = runConduitPure $ yieldMany [[1,2], [3,4], [5,6,7]] .| chunksOfExactlyE 3 .| sinkList+ in res `shouldBe` [[1,2,3], [4,5,6]]+ prop "vectorBuilder" $ \(values :: [[Int]]) ((+1) . (`mod` 30) . abs -> size) -> do+ let res = runST $ runConduit+ $ yieldMany values+ .| vectorBuilderC size mapM_CE+ .| sinkList+ expected =+ loop $ concat values+ where+ loop [] = []+ loop x =+ VU.fromList y : loop z+ where+ (y, z) = splitAt size x+ res `shouldBe` expected+ prop "mapAccumS" $ \input ->+ let ints = [1..]+ f a s = liftM (:s) $ mapC (* a) .| takeC a .| sinkList+ res = reverse $ runConduitPure $ yieldMany input+ .| mapAccumS f [] (yieldMany ints)+ expected = loop input ints+ where loop [] _ = []+ loop (a:as) xs = let (y, ys) = Prelude.splitAt a xs+ in map (* a) y : loop as ys+ in res `shouldBe` expected+ prop "peekForever" $ \(strs' :: [String]) -> do+ let strs = filter (not . null) strs'+ res1 <- runConduit $ yieldMany strs .| linesUnboundedC .| sinkList+ res2 <- runConduit $ yieldMany strs .| peekForever (lineC $ foldC >>= yield) .| sinkList+ res2 `shouldBe` res1+ prop "peekForeverE" $ \(strs :: [String]) -> do+ res1 <- runConduit $ yieldMany strs .| linesUnboundedC .| sinkList+ res2 <- runConduit $ yieldMany strs .| peekForeverE (lineC $ foldC >>= yield) .| sinkList+ res2 `shouldBe` res1+ StreamSpec.spec++evenInt :: Int -> Bool+evenInt = even++elemInt :: Int -> [Int] -> Bool+elemInt = elem++notElemInt :: Int -> [Int] -> Bool+notElemInt = notElem++addM :: Monad m => Int -> Int -> m Int+addM x y = return (x + y)++succChar :: Char -> Char+succChar c =+ case pureTry (succ c) of+ Left _ -> 'X' -- QuickCheck may generate characters out of range+ Right x -> x++showInt :: Int -> String+showInt = Prelude.show++nocrBL :: L8.ByteString -> L8.ByteString+nocrBL = L8.filter (/= '\r')
+ test/StreamSpec.hs view
@@ -0,0 +1,512 @@+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ViewPatterns #-}+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE CPP #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+module StreamSpec where++import Control.Arrow (first)+import Control.Applicative+import qualified Control.Monad+import Control.Monad (liftM)+import Control.Monad.Identity (Identity, runIdentity)+import Control.Monad.State (StateT(..), get, put)+import Data.Conduit+import Data.Conduit.Combinators+import Data.Conduit.Combinators.Stream+import Data.Conduit.Internal.Fusion+import Data.Conduit.Internal.List.Stream (takeS, sourceListS, mapS)+import qualified Data.List+import Data.MonoTraversable+import Data.Monoid (Monoid(..))+import qualified Data.NonNull as NonNull+import Data.Sequence (Seq)+import qualified Data.Sequences as Seq+import Data.Vector (Vector)+import qualified Prelude+import Prelude+ ((.), ($), (>>=), (=<<), return, id, Maybe(..), Either(..), Monad,+ Bool(..), Int, Eq, Show, String, Functor, fst, snd, either)+import qualified Safe+import qualified System.IO as IO+import System.IO.Unsafe+import Test.Hspec+import Test.QuickCheck+import Data.Semigroup (Semigroup (..))++spec :: Spec+spec = do+ describe "Comparing list function to" $ do+ qit "yieldMany" $+ \(mono :: Seq Int) ->+ yieldMany mono `checkProducer`+ otoList mono+ qit "sourceListS" $+ \(mono :: Seq Int) ->+ yieldManyS mono `checkStreamProducer`+ otoList mono+ qit "repeatM" $+ \(getBlind -> (f :: M Int)) ->+ repeatM f `checkInfiniteProducerM`+ repeatML f+ qit "repeatMS" $+ \(getBlind -> (f :: M Int)) ->+ repeatMS f `checkInfiniteStreamProducerM`+ repeatML f+ qit "repeatWhileM" $+ \(getBlind -> (f :: M Int), getBlind -> g) ->+ repeatWhileM f g `checkInfiniteProducerM`+ repeatWhileML f g+ qit "repeatWhileMS" $+ \(getBlind -> (f :: M Int), getBlind -> g) ->+ repeatWhileMS f g `checkInfiniteStreamProducerM`+ repeatWhileML f g+ qit "foldl1" $+ \(getBlind -> f) ->+ foldl1 f `checkConsumer`+ foldl1L f+ qit "foldl1S" $+ \(getBlind -> f) ->+ foldl1S f `checkStreamConsumer`+ foldl1L f+ qit "all" $+ \(getBlind -> f) ->+ all f `checkConsumer`+ Prelude.all f+ qit "allS" $+ \(getBlind -> f) ->+ allS f `checkStreamConsumer`+ Prelude.all f+ qit "any" $+ \(getBlind -> f) ->+ any f `checkConsumer`+ Prelude.any f+ qit "anyS" $+ \(getBlind -> f) ->+ anyS f `checkStreamConsumer`+ Prelude.any f+ qit "last" $+ \() ->+ last `checkConsumer`+ Safe.lastMay+ qit "lastS" $+ \() ->+ lastS `checkStreamConsumer`+ Safe.lastMay+ qit "lastE" $+ \(getBlind -> f) ->+ let g x = Seq.replicate (Prelude.abs (getSmall (f x))) x :: Seq Int+ in (map g .| lastE) `checkConsumer`+ (lastEL . Prelude.map g :: [Int] -> Maybe Int)+ qit "lastES" $+ \(getBlind -> f) ->+ let g x = Seq.replicate (Prelude.abs (getSmall (f x))) x :: Seq Int+ in (lastES . mapS g) `checkStreamConsumer`+ (lastEL . Prelude.map g :: [Int] -> Maybe Int)+ qit "find" $+ \(getBlind -> f) ->+ find f `checkConsumer`+ Data.List.find f+ qit "findS" $+ \(getBlind -> f) ->+ findS f `checkStreamConsumer`+ Data.List.find f+ qit "concatMap" $+ \(getBlind -> (f :: Int -> Seq Int)) ->+ concatMap f `checkConduit`+ concatMapL f+ qit "concatMapS" $+ \(getBlind -> (f :: Int -> Seq Int)) ->+ concatMapS f `checkStreamConduit`+ concatMapL f+ qit "concatMapM" $+ \(getBlind -> (f :: Int -> M (Seq Int))) ->+ concatMapM f `checkConduitT`+ concatMapML f+ qit "concatMapMS" $+ \(getBlind -> (f :: Int -> M (Seq Int))) ->+ concatMapMS f `checkStreamConduitT`+ concatMapML f+ qit "concat" $+ \() ->+ concat `checkConduit`+ (concatL :: [Seq Int] -> [Int])+ qit "concatS" $+ \() ->+ concatS `checkStreamConduit`+ (concatL :: [Seq Int] -> [Int])+ qit "scanl" $+ \(getBlind -> (f :: Int -> Int -> Int), initial) ->+ scanl f initial `checkConduit`+ Prelude.scanl f initial+ qit "scanlS" $+ \(getBlind -> (f :: Int -> Int -> Int), initial) ->+ scanlS f initial `checkStreamConduit`+ Prelude.scanl f initial+ qit "scanlM" $+ \(getBlind -> (f :: Int -> Int -> M Int), initial) ->+ scanlM f initial `checkConduitT`+ scanlML f initial+ qit "scanlMS" $+ \(getBlind -> (f :: Int -> Int -> M Int), initial) ->+ scanlMS f initial `checkStreamConduitT`+ scanlML f initial+ qit "mapAccumWhileS" $+ \(getBlind -> ( f :: Int -> [Int] -> Either [Int] ([Int], Int))+ , initial :: [Int]) ->+ mapAccumWhileS f initial `checkStreamConduitResult`+ mapAccumWhileL f initial+ qit "mapAccumWhileMS" $+ \(getBlind -> ( f :: Int -> [Int] -> M (Either [Int] ([Int], Int)))+ , initial :: [Int]) ->+ mapAccumWhileMS f initial `checkStreamConduitResultM`+ mapAccumWhileML f initial+ qit "intersperse" $+ \(sep :: Int) ->+ intersperse sep `checkConduit`+ Data.List.intersperse sep+ qit "intersperseS" $+ \(sep :: Int) ->+ intersperseS sep `checkStreamConduit`+ Data.List.intersperse sep+ qit "filterM" $+ \(getBlind -> (f :: Int -> M Bool)) ->+ filterM f `checkConduitT`+ Control.Monad.filterM f+ qit "filterMS" $+ \(getBlind -> (f :: Int -> M Bool)) ->+ filterMS f `checkStreamConduitT`+ Control.Monad.filterM f+ describe "comparing normal conduit function to" $ do+ qit "slidingWindowS" $+ \(getSmall -> n) ->+ slidingWindowS n `checkStreamConduit`+ (\xs -> runConduitPure $+ yieldMany xs .| preventFusion (slidingWindow n) .| sinkList+ :: [Seq Int])+ qit "splitOnUnboundedES" $+ \(getBlind -> (f :: Int -> Bool)) ->+ splitOnUnboundedES f `checkStreamConduit`+ (\xs -> runConduitPure $+ yieldMany xs .| preventFusion (splitOnUnboundedE f) .| sinkList+ :: [Seq Int])+ qit "sinkVectorS" $+ \() -> checkStreamConsumerM'+ unsafePerformIO+ (sinkVectorS :: forall o. StreamConduitT Int o IO.IO (Vector Int))+ (\xs -> runConduit $ yieldMany xs .| preventFusion sinkVector)+ qit "sinkVectorNS" $+ \(getSmall . getNonNegative -> n) -> checkStreamConsumerM'+ unsafePerformIO+ (sinkVectorNS n :: forall o. StreamConduitT Int o IO.IO (Vector Int))+ (\xs -> runConduit $ yieldMany xs .| preventFusion (sinkVectorN n))++#if !MIN_VERSION_QuickCheck(2,8,2)+instance Arbitrary a => Arbitrary (Seq a) where+ arbitrary = Seq.fromList <$> arbitrary+#endif++repeatML :: Monad m => m a -> m [a]+repeatML = Prelude.sequence . Prelude.repeat++repeatWhileML :: Monad m => m a -> (a -> Bool) -> m [a]+repeatWhileML m f = go+ where+ go = do+ x <- m+ if f x+ then liftM (x:) go+ else return []++foldl1L :: (a -> a -> a) -> [a] -> Maybe a+foldl1L _ [] = Nothing+foldl1L f xs = Just $ Prelude.foldl1 f xs++lastEL :: Seq.IsSequence seq+ => [seq] -> Maybe (Element seq)+lastEL = Prelude.foldl go Nothing+ where+ go _ (NonNull.fromNullable -> Just l) = Just (NonNull.last l)+ go mlast _ = mlast++concatMapL :: MonoFoldable mono+ => (a -> mono) -> [a] -> [Element mono]+concatMapL f = Prelude.concatMap (otoList . f)++concatMapML :: (Monad m, MonoFoldable mono)+ => (a -> m mono) -> [a] -> m [Element mono]+concatMapML f = liftM (Prelude.concatMap otoList) . Prelude.mapM f++concatL :: MonoFoldable mono+ => [mono] -> [Element mono]+concatL = Prelude.concatMap otoList++scanlML :: Monad m => (a -> b -> m a) -> a -> [b] -> m [a]+scanlML f = go+ where+ go l [] = return [l]+ go l (r:rs) = do+ l' <- f l r+ liftM (l:) (go l' rs)++mapAccumWhileL :: (a -> s -> Either s (s, b)) -> s -> [a] -> ([b], s)+mapAccumWhileL f = (runIdentity.) . mapAccumWhileML ((return.) . f)++mapAccumWhileML :: Monad m =>+ (a -> s -> m (Either s (s, b))) -> s -> [a] -> m ([b], s)+mapAccumWhileML f = go+ where go s [] = return ([], s)+ go s (a:as) = f a s >>= either+ (return . ([], ))+ (\(s', b) -> liftM (first (b:)) $ go s' as)++--FIXME: the following code is directly copied from the conduit test+--suite. How to share this code??++qit :: (Arbitrary a, Testable prop, Show a)+ => String -> (a -> prop) -> Spec+qit n f = it n $ property $ forAll arbitrary f++--------------------------------------------------------------------------------+-- Quickcheck utilities for pure conduits / streams++checkProducer :: (Show a, Eq a) => ConduitT () a Identity () -> [a] -> Property+checkProducer c l = checkProducerM' runIdentity c (return l)++checkStreamProducer :: (Show a, Eq a) => StreamSource Identity a -> [a] -> Property+checkStreamProducer s l = checkStreamProducerM' runIdentity s (return l)++checkInfiniteProducer :: (Show a, Eq a) => ConduitT () a Identity () -> [a] -> Property+checkInfiniteProducer c l = checkInfiniteProducerM' runIdentity c (return l)++checkInfiniteStreamProducer :: (Show a, Eq a) => StreamSource Identity a -> [a] -> Property+checkInfiniteStreamProducer s l = checkInfiniteStreamProducerM' runIdentity s (return l)++checkConsumer :: (Show b, Eq b) => ConduitT Int Void Identity b -> ([Int] -> b) -> Property+checkConsumer c l = checkConsumerM' runIdentity c (return . l)++checkStreamConsumer :: (Show b, Eq b) => StreamConduitT Int o Identity b -> ([Int] -> b) -> Property+checkStreamConsumer c l = checkStreamConsumerM' runIdentity c (return . l)++checkConduit :: (Show a, Arbitrary a, Show b, Eq b) => ConduitT a b Identity () -> ([a] -> [b]) -> Property+checkConduit c l = checkConduitT' runIdentity c (return . l)++checkStreamConduit :: (Show a, Arbitrary a, Show b, Eq b) => StreamConduit a Identity b -> ([a] -> [b]) -> Property+checkStreamConduit c l = checkStreamConduitT' runIdentity c (return . l)++-- checkConduitResult :: (Show a, Arbitrary a, Show b, Eq b, Show r, Eq r) => ConduitT a b Identity r -> ([a] -> ([b], r)) -> Property+-- checkConduitResult c l = checkConduitResultM' runIdentity c (return . l)++checkStreamConduitResult :: (Show a, Arbitrary a, Show b, Eq b, Show r, Eq r) => StreamConduitT a b Identity r -> ([a] -> ([b], r)) -> Property+checkStreamConduitResult c l = checkStreamConduitResultM' runIdentity c (return . l)++--------------------------------------------------------------------------------+-- Quickcheck utilities for conduits / streams in the M monad.++checkProducerM :: (Show a, Eq a) => ConduitT () a M () -> M [a] -> Property+checkProducerM = checkProducerM' runM++checkStreamProducerM :: (Show a, Eq a) => StreamSource M a -> M [a] -> Property+checkStreamProducerM = checkStreamProducerM' runM++checkInfiniteProducerM :: (Show a, Eq a) => ConduitT () a M () -> M [a] -> Property+checkInfiniteProducerM = checkInfiniteProducerM' (fst . runM)++checkInfiniteStreamProducerM :: (Show a, Eq a) => StreamSource M a -> M [a] -> Property+checkInfiniteStreamProducerM = checkInfiniteStreamProducerM' (fst . runM)++checkConsumerM :: (Show b, Eq b) => ConduitT Int Void M b -> ([Int] -> M b) -> Property+checkConsumerM = checkConsumerM' runM++checkStreamConsumerM :: (Show b, Eq b) => StreamConduitT Int o M b -> ([Int] -> M b) -> Property+checkStreamConsumerM = checkStreamConsumerM' runM++checkConduitT :: (Show a, Arbitrary a, Show b, Eq b) => ConduitT a b M () -> ([a] -> M [b]) -> Property+checkConduitT = checkConduitT' runM++checkStreamConduitT :: (Show a, Arbitrary a, Show b, Eq b) => StreamConduitT a b M () -> ([a] -> M [b]) -> Property+checkStreamConduitT = checkStreamConduitT' runM++-- checkConduitResultM :: (Show a, Arbitrary a, Show b, Eq b, Show r, Eq r) => ConduitT a b M r -> ([a] -> M ([b], r)) -> Property+-- checkConduitResultM = checkConduitResultM' runM++checkStreamConduitResultM :: (Show a, Arbitrary a, Show b, Eq b, Show r, Eq r) => StreamConduitT a b M r -> ([a] -> M ([b], r)) -> Property+checkStreamConduitResultM = checkStreamConduitResultM' runM++--------------------------------------------------------------------------------+-- Quickcheck utilities for monadic streams / conduits+-- These are polymorphic in which Monad is used.++checkProducerM' :: (Show a, Monad m, Show b, Eq b)+ => (m [a] -> b)+ -> ConduitT () a m ()+ -> m [a]+ -> Property+checkProducerM' f c l =+ f (runConduit $ preventFusion c .| sinkList)+ ===+ f l++checkStreamProducerM' :: (Show a, Monad m, Show b, Eq b)+ => (m [a] -> b)+ -> StreamConduitT () a m ()+ -> m [a]+ -> Property+checkStreamProducerM' f s l =+ f (liftM fst $ evalStream $ s emptyStream)+ ===+ f l++checkInfiniteProducerM' :: (Show a, Monad m, Show b, Eq b)+ => (m [a] -> b)+ -> ConduitT () a m ()+ -> m [a]+ -> Property+checkInfiniteProducerM' f s l =+ checkProducerM' f+ (preventFusion s .| take 10)+ (liftM (Prelude.take 10) l)++checkInfiniteStreamProducerM' :: (Show a, Monad m, Show b, Eq b)+ => (m [a] -> b)+ -> StreamConduitT () a m ()+ -> m [a]+ -> Property+checkInfiniteStreamProducerM' f s l =+ f (liftM snd $ evalStream $ takeS 10 $ s emptyStream)+ ===+ f (liftM (Prelude.take 10) l)++checkConsumerM' :: (Show a, Monad m, Show b, Eq b)+ => (m a -> b)+ -> ConduitT Int Void m a+ -> ([Int] -> m a)+ -> Property+checkConsumerM' f c l = forAll arbitrary $ \xs ->+ f (runConduit $ yieldMany xs .| preventFusion c)+ ===+ f (l xs)++checkStreamConsumerM' :: (Show a, Monad m, Show b, Eq b)+ => (m a -> b)+ -> StreamConduitT Int o m a+ -> ([Int] -> m a)+ -> Property+checkStreamConsumerM' f s l = forAll (arbitrary) $ \xs ->+ f (liftM snd $ evalStream $ s $ sourceListS xs emptyStream)+ ===+ f (l xs)++checkConduitT' :: (Show a, Arbitrary a, Monad m, Show c, Eq c)+ => (m [b] -> c)+ -> ConduitT a b m ()+ -> ([a] -> m [b])+ -> Property+checkConduitT' f c l = forAll arbitrary $ \xs ->+ f (runConduit $ yieldMany xs .| preventFusion c .| sinkList)+ ===+ f (l xs)++checkStreamConduitT' :: (Show a, Arbitrary a, Monad m, Show c, Eq c)+ => (m [b] -> c)+ -> StreamConduit a m b+ -> ([a] -> m [b])+ -> Property+checkStreamConduitT' f s l = forAll arbitrary $ \xs ->+ f (liftM fst $ evalStream $ s $ sourceListS xs emptyStream)+ ===+ f (l xs)++-- TODO: Fixing this would allow comparing conduit sinkListrs against+-- their list versions.+--+-- checkConduitResultM' :: (Show a, Arbitrary a, Monad m, Show c, Eq c)+-- => (m ([b], r) -> c)+-- -> ConduitT a b m r+-- -> ([a] -> m ([b], r))+-- -> Property+-- checkConduitResultM' f c l = FIXME forAll arbitrary $ \xs ->+-- f (runConduit $ yieldMany xs .| preventFusion c .| sinkList)+-- ===+-- f (l xs)++checkStreamConduitResultM' :: (Show a, Arbitrary a, Monad m, Show c, Eq c)+ => (m ([b], r) -> c)+ -> StreamConduitT a b m r+ -> ([a] -> m ([b], r))+ -> Property+checkStreamConduitResultM' f s l = forAll arbitrary $ \xs ->+ f (evalStream $ s $ sourceListS xs emptyStream)+ ===+ f (l xs)++emptyStream :: Monad m => Stream m () ()+emptyStream = Stream (\_ -> return $ Stop ()) (return ())++evalStream :: Monad m => Stream m o r -> m ([o], r)+evalStream (Stream step s0) = go =<< s0+ where+ go s = do+ res <- step s+ case res of+ Stop r -> return ([], r)+ Skip s' -> go s'+ Emit s' x -> liftM (\(l, r) -> (x:l, r)) (go s')++--------------------------------------------------------------------------------+-- Misc utilities++-- Prefer this to creating an orphan instance for Data.Monoid.Sum:++newtype Sum a = Sum a+ deriving (Eq, Show, Arbitrary)++instance Prelude.Num a => Semigroup (Sum a) where+ Sum x <> Sum y = Sum $ x Prelude.+ y+instance Prelude.Num a => Monoid (Sum a) where+ mempty = Sum 0+ mappend (Sum x) (Sum y) = Sum $ x Prelude.+ y++preventFusion :: a -> a+preventFusion = id+{-# INLINE [0] preventFusion #-}++newtype M a = M (StateT Int Identity a)+ deriving (Functor, Applicative, Monad)++instance Arbitrary a => Arbitrary (M a) where+ arbitrary = do+ f <- arbitrary+ return $ do+ s <- M get+ let (x, s') = f s+ M (put s')+ return x++runM :: M a -> (a, Int)+runM (M m) = runIdentity $ runStateT m 0++--------------------------------------------------------------------------------+-- Utilities from QuickCheck-2.7 (absent in earlier versions)++#if !MIN_VERSION_QuickCheck(2,7,0)+getBlind :: Blind a -> a+getBlind (Blind x) = x++-- | @Small x@: generates values of @x@ drawn from a small range.+-- The opposite of 'Large'.+newtype Small a = Small {getSmall :: a}+ deriving (Prelude.Ord, Prelude.Eq, Prelude.Enum, Prelude.Show, Prelude.Num)++instance Prelude.Integral a => Arbitrary (Small a) where+ arbitrary = Prelude.fmap Small arbitrarySizedIntegral+ shrink (Small x) = Prelude.map Small (shrinkIntegral x)++(===) :: (Show a, Eq a) => a -> a -> Property+x === y = whenFail+ (Prelude.fail $ Prelude.show x Prelude.++ " should match " Prelude.++ Prelude.show y)+ (x Prelude.== y)+#endif
+ test/doctests.hs view
@@ -0,0 +1,6 @@+module Main where++import Test.DocTest++main :: IO ()+main = doctest ["Data/Conduit.hs"]
test/main.hs view
@@ -1,68 +1,90 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE FlexibleInstances #-}+{-# OPTIONS_GHC -fno-warn-orphans #-} import Test.Hspec import Test.Hspec.QuickCheck (prop)+import Test.QuickCheck (getPositive) import Test.QuickCheck.Monadic (assert, monadicIO, run) +import Data.Conduit (runConduit, (.|), ConduitT, runConduitPure, runConduitRes) import qualified Data.Conduit as C import qualified Data.Conduit.Lift as C import qualified Data.Conduit.Internal as CI import qualified Data.Conduit.List as CL import Data.Typeable (Typeable)-import Control.Monad.Trans.Resource as C (runResourceT)+import Control.Exception (throw, evaluate)+import Control.Monad.Trans.Resource (runResourceT)+import Control.Monad.Trans.Maybe (MaybeT (MaybeT))+import Control.Monad.State.Strict (modify) import Data.Maybe (fromMaybe,catMaybes,fromJust) import qualified Data.List as DL+import qualified Data.List.Split as DLS (chunksOf) import Control.Monad.ST (runST) import Data.Monoid import qualified Data.IORef as I+import Data.Tuple (swap) import Control.Monad.Trans.Resource (allocate, resourceForkIO) import Control.Concurrent (threadDelay, killThread)-import Control.Monad.IO.Class (MonadIO, liftIO)+import Control.Monad.IO.Class (liftIO) import Control.Monad.Trans.Class (lift) import Control.Monad.Trans.Writer (execWriter, tell, runWriterT)-import Control.Monad.Trans.State (evalStateT, get, put, modify)-import Control.Monad.Trans.Maybe (MaybeT (..))-import Control.Applicative (pure, (<$>), (<*>))+import Control.Monad.Trans.State (evalStateT, get, put)+import qualified Control.Monad.Writer as W+import Control.Applicative (pure, (<$>), (<*>), liftA2) import qualified Control.Monad.Catch as Catch import Data.Functor.Identity (Identity,runIdentity) import Control.Monad (forever, void) import Data.Void (Void) import qualified Control.Concurrent.MVar as M-import Control.Monad.Error (catchError, throwError, Error)+import Control.Monad.Except (catchError, throwError) import qualified Data.Map as Map import qualified Data.Conduit.Extra.ZipConduitSpec as ZipConduit+import qualified Data.Conduit.StreamSpec as Stream+import qualified Spec (@=?) :: (Eq a, Show a) => a -> a -> IO () (@=?) = flip shouldBe -- Quickcheck property for testing equivalence of list processing -- functions and their conduit counterparts-equivToList :: Eq b => ([a] -> [b]) -> CI.Conduit a Identity b -> [a] -> Bool+equivToList :: Eq b => ([a] -> [b]) -> ConduitT a b Identity () -> [a] -> Bool equivToList f conduit xs =- f xs == runIdentity (CL.sourceList xs C.$$ conduit C.=$= CL.consume)+ f xs == runConduitPure (CL.sourceList xs .| conduit .| CL.consume) +-- | Check that two conduits produce the same outputs and return the same result.+bisimilarTo :: (Eq a, Eq r) => ConduitT () a Identity r -> ConduitT () a Identity r -> Bool+left `bisimilarTo` right =+ C.runConduitPure (toListRes left) == C.runConduitPure (toListRes right)+ where+ -- | Sink a conduit into a list and return it alongside the result.+ -- So it is, essentially, @sinkList@ plus result.+ toListRes :: Monad m => ConduitT () a m r -> ConduitT () Void m ([a], r)+ toListRes cond = swap <$> C.fuseBoth cond CL.consume + main :: IO () main = hspec $ do+ describe "Combinators" Spec.spec describe "data loss rules" $ do it "consumes the source to quickly" $ do- x <- runResourceT $ CL.sourceList [1..10 :: Int] C.$$ do- strings <- CL.map show C.=$ CL.take 5+ x <- runConduitRes $ CL.sourceList [1..10 :: Int] .| do+ strings <- CL.map show .| CL.take 5 liftIO $ putStr $ unlines strings CL.fold (+) 0 40 `shouldBe` x it "correctly consumes a chunked resource" $ do- x <- runResourceT $ (CL.sourceList [1..5 :: Int] `mappend` CL.sourceList [6..10]) C.$$ do- strings <- CL.map show C.=$ CL.take 5+ x <- runConduitRes $ (CL.sourceList [1..5 :: Int] `mappend` CL.sourceList [6..10]) .| do+ strings <- CL.map show .| CL.take 5 liftIO $ putStr $ unlines strings CL.fold (+) 0 40 `shouldBe` x describe "filter" $ do it "even" $ do- x <- runResourceT $ CL.sourceList [1..10] C.$$ CL.filter even C.=$ CL.consume+ x <- runConduitRes $ CL.sourceList [1..10] .| CL.filter even .| CL.consume x `shouldBe` filter even [1..10 :: Int] prop "concat" $ equivToList (concat :: [[Int]]->[Int]) CL.concat@@ -113,28 +135,28 @@ describe "sum" $ do it "works for 1..10" $ do- x <- runResourceT $ CL.sourceList [1..10] C.$$ CL.fold (+) (0 :: Int)+ x <- runConduitRes $ CL.sourceList [1..10] .| CL.fold (+) (0 :: Int) x `shouldBe` sum [1..10] prop "is idempotent" $ \list ->- (runST $ CL.sourceList list C.$$ CL.fold (+) (0 :: Int))+ (runST $ runConduit $ CL.sourceList list .| CL.fold (+) (0 :: Int)) == sum list describe "foldMap" $ do it "sums 1..10" $ do- Sum x <- CL.sourceList [1..(10 :: Int)] C.$$ CL.foldMap Sum+ Sum x <- runConduit $ CL.sourceList [1..(10 :: Int)] .| CL.foldMap Sum x `shouldBe` sum [1..10] it "preserves order" $ do- x <- CL.sourceList [[4],[2],[3],[1]] C.$$ CL.foldMap (++[(9 :: Int)])+ x <- runConduit $ CL.sourceList [[4],[2],[3],[1]] .| CL.foldMap (++[(9 :: Int)]) x `shouldBe` [4,9,2,9,3,9,1,9] describe "foldMapM" $ do it "sums 1..10" $ do- Sum x <- CL.sourceList [1..(10 :: Int)] C.$$ CL.foldMapM (return . Sum)+ Sum x <- runConduit $ CL.sourceList [1..(10 :: Int)] .| CL.foldMapM (return . Sum) x `shouldBe` sum [1..10] it "preserves order" $ do- x <- CL.sourceList [[4],[2],[3],[1]] C.$$ CL.foldMapM (return . (++[(9 :: Int)]))+ x <- runConduit $ CL.sourceList [[4],[2],[3],[1]] .| CL.foldMapM (return . (++[(9 :: Int)])) x `shouldBe` [4,9,2,9,3,9,1,9] describe "unfold" $ do@@ -142,7 +164,7 @@ let f 0 = Nothing f i = Just (show i, i - 1) seed = 10 :: Int- x <- CL.unfold f seed C.$$ CL.consume+ x <- runConduit $ CL.unfold f seed .| CL.consume let y = DL.unfoldr f seed x `shouldBe` y @@ -151,54 +173,76 @@ let f 0 = Nothing f i = Just (show i, i - 1) seed = 10 :: Int- x <- CL.unfoldM (return . f) seed C.$$ CL.consume+ x <- runConduit $ CL.unfoldM (return . f) seed .| CL.consume let y = DL.unfoldr f seed x `shouldBe` y + describe "uncons" $ do+ prop "folds to list" $ \xs ->+ let src = C.sealConduitT $ CL.sourceList xs in+ (xs :: [Int]) == DL.unfoldr CL.uncons src++ prop "works with unfold" $ \xs ->+ let src = CL.sourceList xs in+ CL.unfold CL.uncons (C.sealConduitT src) `bisimilarTo` (src :: ConduitT () Int Identity ())++ describe "unconsEither" $ do+ let+ eitherToMaybe :: Either l a -> Maybe a+ eitherToMaybe (Left _) = Nothing+ eitherToMaybe (Right a) = Just a+ prop "folds outputs to list" $ \xs ->+ let src = C.sealConduitT $ CL.sourceList xs in+ (xs :: [Int]) == DL.unfoldr (eitherToMaybe . CL.unconsEither) src++ prop "works with unfoldEither" $ \(xs, r) ->+ let src = CL.sourceList xs *> pure r in+ CL.unfoldEither CL.unconsEither (C.sealConduitT src) `bisimilarTo` (src :: ConduitT () Int Identity Int)+ describe "Monoid instance for Source" $ do it "mappend" $ do- x <- runResourceT $ (CL.sourceList [1..5 :: Int] `mappend` CL.sourceList [6..10]) C.$$ CL.fold (+) 0+ x <- runConduitRes $ (CL.sourceList [1..5 :: Int] `mappend` CL.sourceList [6..10]) .| CL.fold (+) 0 x `shouldBe` sum [1..10] it "mconcat" $ do- x <- runResourceT $ mconcat+ x <- runConduitRes $ mconcat [ CL.sourceList [1..5 :: Int] , CL.sourceList [6..10] , CL.sourceList [11..20]- ] C.$$ CL.fold (+) 0+ ] .| CL.fold (+) 0 x `shouldBe` sum [1..20] describe "zipping" $ do it "zipping two small lists" $ do- res <- runResourceT $ CI.zipSources (CL.sourceList [1..10]) (CL.sourceList [11..12]) C.$$ CL.consume+ res <- runConduitRes $ CI.zipSources (CL.sourceList [1..10]) (CL.sourceList [11..12]) .| CL.consume res @=? zip [1..10 :: Int] [11..12 :: Int] describe "zipping sinks" $ do it "take all" $ do- res <- runResourceT $ CL.sourceList [1..10] C.$$ CI.zipSinks CL.consume CL.consume+ res <- runConduitRes $ CL.sourceList [1..10] .| CI.zipSinks CL.consume CL.consume res @=? ([1..10 :: Int], [1..10 :: Int]) it "take fewer on left" $ do- res <- runResourceT $ CL.sourceList [1..10] C.$$ CI.zipSinks (CL.take 4) CL.consume+ res <- runConduitRes $ CL.sourceList [1..10] .| CI.zipSinks (CL.take 4) CL.consume res @=? ([1..4 :: Int], [1..10 :: Int]) it "take fewer on right" $ do- res <- runResourceT $ CL.sourceList [1..10] C.$$ CI.zipSinks CL.consume (CL.take 4)+ res <- runConduitRes $ CL.sourceList [1..10] .| CI.zipSinks CL.consume (CL.take 4) res @=? ([1..10 :: Int], [1..4 :: Int]) describe "Monad instance for Sink" $ do it "binding" $ do- x <- runResourceT $ CL.sourceList [1..10] C.$$ do+ x <- runConduitRes $ CL.sourceList [1..10] .| do _ <- CL.take 5 CL.fold (+) (0 :: Int) x `shouldBe` sum [6..10] describe "Applicative instance for Sink" $ do it "<$> and <*>" $ do- x <- runResourceT $ CL.sourceList [1..10] C.$$+ x <- runConduitRes $ CL.sourceList [1..10] .| (+) <$> pure 5 <*> CL.fold (+) (0 :: Int) x `shouldBe` sum [1..10] + 5 describe "resumable sources" $ do it "simple" $ do- (x, y, z) <- runResourceT $ do+ (x, y, z) <- runConduitRes $ do let src1 = CL.sourceList [1..10 :: Int] (src2, x) <- src1 C.$$+ CL.take 5 (src3, y) <- src2 C.$$++ CL.fold (+) 0@@ -210,121 +254,134 @@ describe "conduits" $ do it "map, left" $ do- x <- runResourceT $+ x <- runConduitRes $ CL.sourceList [1..10]- C.$= CL.map (* 2)- C.$$ CL.fold (+) 0+ .| CL.map (* 2)+ .| CL.fold (+) 0 x `shouldBe` 2 * sum [1..10 :: Int] it "map, left >+>" $ do- x <- runResourceT $- CI.ConduitM- (CI.unConduitM (CL.sourceList [1..10])- CI.>+> CI.injectLeftovers (CI.unConduitM $ CL.map (* 2)))- C.$$ CL.fold (+) 0+ x <- runConduitRes $+ CI.ConduitT+ ((CI.unConduitT (CL.sourceList [1..10]) CI.Done+ CI.>+> CI.injectLeftovers ((\c -> c `CI.unConduitT` CI.Done) $ CL.map (* 2))) >>=)+ .| CL.fold (+) 0 x `shouldBe` 2 * sum [1..10 :: Int] it "map, right" $ do- x <- runResourceT $+ x <- runConduitRes $ CL.sourceList [1..10]- C.$$ CL.map (* 2)- C.=$ CL.fold (+) 0+ .| CL.map (* 2)+ .| CL.fold (+) 0 x `shouldBe` 2 * sum [1..10 :: Int] + prop "chunksOf" $ \(positive, xs) ->+ let p = getPositive positive+ conduit = CL.sourceList xs .| CL.chunksOf p .| CL.consume+ in DLS.chunksOf p (xs :: [Int]) == runConduitPure conduit++ it "chunksOf (zero)" $+ let conduit = return () .| CL.chunksOf 0 .| CL.consume+ in evaluate (runConduitPure conduit) `shouldThrow` anyException++ it "chunksOf (negative)" $+ let conduit = return () .| CL.chunksOf (-5) .| CL.consume+ in evaluate (runConduitPure conduit) `shouldThrow` anyException+ it "groupBy" $ do let input = [1::Int, 1, 2, 3, 3, 3, 4, 5, 5]- x <- runResourceT $ CL.sourceList input- C.$$ CL.groupBy (==)- C.=$ CL.consume+ x <- runConduitRes $ CL.sourceList input+ .| CL.groupBy (==)+ .| CL.consume x `shouldBe` DL.groupBy (==) input it "groupBy (nondup begin/end)" $ do let input = [1::Int, 2, 3, 3, 3, 4, 5]- x <- runResourceT $ CL.sourceList input- C.$$ CL.groupBy (==)- C.=$ CL.consume+ x <- runConduitRes $ CL.sourceList input+ .| CL.groupBy (==)+ .| CL.consume x `shouldBe` DL.groupBy (==) input it "groupOn1" $ do let input = [1::Int, 1, 2, 3, 3, 3, 4, 5, 5]- x <- runResourceT $ CL.sourceList input- C.$$ CL.groupOn1 id- C.=$ CL.consume+ x <- runConduitRes $ CL.sourceList input+ .| CL.groupOn1 id+ .| CL.consume x `shouldBe` [(1,[1]), (2, []), (3,[3,3]), (4,[]), (5, [5])] it "groupOn1 (nondup begin/end)" $ do let input = [1::Int, 2, 3, 3, 3, 4, 5]- x <- runResourceT $ CL.sourceList input- C.$$ CL.groupOn1 id- C.=$ CL.consume+ x <- runConduitRes $ CL.sourceList input+ .| CL.groupOn1 id+ .| CL.consume x `shouldBe` [(1,[]), (2, []), (3,[3,3]), (4,[]), (5, [])] it "mapMaybe" $ do let input = [Just (1::Int), Nothing, Just 2, Nothing, Just 3]- x <- runResourceT $ CL.sourceList input- C.$$ CL.mapMaybe ((+2) <$>)- C.=$ CL.consume+ x <- runConduitRes $ CL.sourceList input+ .| CL.mapMaybe ((+2) <$>)+ .| CL.consume x `shouldBe` [3, 4, 5] it "mapMaybeM" $ do let input = [Just (1::Int), Nothing, Just 2, Nothing, Just 3]- x <- runResourceT $ CL.sourceList input- C.$$ CL.mapMaybeM (return . ((+2) <$>))- C.=$ CL.consume+ x <- runConduitRes $ CL.sourceList input+ .| CL.mapMaybeM (return . ((+2) <$>))+ .| CL.consume x `shouldBe` [3, 4, 5] it "catMaybes" $ do let input = [Just (1::Int), Nothing, Just 2, Nothing, Just 3]- x <- runResourceT $ CL.sourceList input- C.$$ CL.catMaybes- C.=$ CL.consume+ x <- runConduitRes $ CL.sourceList input+ .| CL.catMaybes+ .| CL.consume x `shouldBe` [1, 2, 3] it "concatMap" $ do let input = [1, 11, 21]- x <- runResourceT $ CL.sourceList input- C.$$ CL.concatMap (\i -> enumFromTo i (i + 9))- C.=$ CL.fold (+) (0 :: Int)+ x <- runConduitRes $ CL.sourceList input+ .| CL.concatMap (\i -> enumFromTo i (i + 9))+ .| CL.fold (+) (0 :: Int) x `shouldBe` sum [1..30] it "bind together" $ do- let conduit = CL.map (+ 5) C.=$= CL.map (* 2)- x <- runResourceT $ CL.sourceList [1..10] C.$= conduit C.$$ CL.fold (+) 0+ let conduit = CL.map (+ 5) .| CL.map (* 2)+ x <- runConduitRes $ CL.sourceList [1..10] .| conduit .| CL.fold (+) 0 x `shouldBe` sum (map (* 2) $ map (+ 5) [1..10 :: Int]) #if !FAST describe "isolate" $ do it "bound to resumable source" $ do- (x, y) <- runResourceT $ do+ (x, y) <- runConduitRes $ do let src1 = CL.sourceList [1..10 :: Int]- (src2, x) <- src1 C.$= CL.isolate 5 C.$$+ CL.consume+ (src2, x) <- src1 .| CL.isolate 5 C.$$+ CL.consume y <- src2 C.$$+- CL.consume return (x, y) x `shouldBe` [1..5] y `shouldBe` [] it "bound to sink, non-resumable" $ do- (x, y) <- runResourceT $ do- CL.sourceList [1..10 :: Int] C.$$ do- x <- CL.isolate 5 C.=$ CL.consume+ (x, y) <- runConduitRes $ do+ CL.sourceList [1..10 :: Int] .| do+ x <- CL.isolate 5 .| CL.consume y <- CL.consume return (x, y) x `shouldBe` [1..5] y `shouldBe` [6..10] it "bound to sink, resumable" $ do- (x, y) <- runResourceT $ do+ (x, y) <- runConduitRes $ do let src1 = CL.sourceList [1..10 :: Int]- (src2, x) <- src1 C.$$+ CL.isolate 5 C.=$ CL.consume+ (src2, x) <- src1 C.$$+ CL.isolate 5 .| CL.consume y <- src2 C.$$+- CL.consume return (x, y) x `shouldBe` [1..5] y `shouldBe` [6..10] it "consumes all data" $ do- x <- runResourceT $ CL.sourceList [1..10 :: Int] C.$$ do- CL.isolate 5 C.=$ CL.sinkNull+ x <- runConduitRes $ CL.sourceList [1..10 :: Int] .| do+ CL.isolate 5 .| CL.sinkNull CL.consume x `shouldBe` [6..10] @@ -336,9 +393,9 @@ Nothing -> return 0 Just a -> (+a) . fromMaybe 0 <$> CL.head - res <- runResourceT $ CL.sourceList [1..11 :: Int]- C.$= CL.sequence sumSink- C.$$ CL.consume+ res <- runConduitRes $ CL.sourceList [1..11 :: Int]+ .| CL.sequence sumSink+ .| CL.consume res `shouldBe` [3, 7, 11, 15, 19, 11] it "sink with unpull behaviour" $ do@@ -348,16 +405,16 @@ Nothing -> return 0 Just a -> (+a) . fromMaybe 0 <$> CL.peek - res <- runResourceT $ CL.sourceList [1..11 :: Int]- C.$= CL.sequence sumSink- C.$$ CL.consume+ res <- runConduitRes $ CL.sourceList [1..11 :: Int]+ .| CL.sequence sumSink+ .| CL.consume res `shouldBe` [3, 5, 7, 9, 11, 13, 15, 17, 19, 21, 11] #endif describe "peek" $ do it "works" $ do- (a, b) <- runResourceT $ CL.sourceList [1..10 :: Int] C.$$ do+ (a, b) <- runConduitRes $ CL.sourceList [1..10 :: Int] .| do a <- CL.peek b <- CL.consume return (a, b)@@ -365,51 +422,52 @@ describe "unbuffering" $ do it "works" $ do- x <- runResourceT $ do+ x <- runConduitRes $ do let src1 = CL.sourceList [1..10 :: Int] (src2, ()) <- src1 C.$$+ CL.drop 5 src2 C.$$+- CL.fold (+) 0 x `shouldBe` sum [6..10] describe "operators" $ do- it "only use =$=" $- runIdentity+ it "only use .|" $+ runConduitPure ( CL.sourceList [1..10 :: Int]- C.$$ CL.map (+ 1)- C.=$ CL.map (subtract 1)- C.=$ CL.mapM (return . (* 2))- C.=$ CL.map (`div` 2)- C.=$ CL.fold (+) 0+ .| CL.map (+ 1)+ .| CL.map (subtract 1)+ .| CL.mapM (return . (* 2))+ .| CL.map (`div` 2)+ .| CL.fold (+) 0 ) `shouldBe` sum [1..10] it "only use =$" $- runIdentity+ runConduitPure ( CL.sourceList [1..10 :: Int]- C.$$ CL.map (+ 1)- C.=$ CL.map (subtract 1)- C.=$ CL.map (* 2)- C.=$ CL.map (`div` 2)- C.=$ CL.fold (+) 0+ .| CL.map (+ 1)+ .| CL.map (subtract 1)+ .| CL.map (* 2)+ .| CL.map (`div` 2)+ .| CL.fold (+) 0 ) `shouldBe` sum [1..10] it "chain" $ do- x <- CL.sourceList [1..10 :: Int]- C.$= CL.map (+ 1)- C.$= CL.map (+ 1)- C.$= CL.map (+ 1)- C.$= CL.map (subtract 3)- C.$= CL.map (* 2)- C.$$ CL.map (`div` 2)- C.=$ CL.map (+ 1)- C.=$ CL.map (+ 1)- C.=$ CL.map (+ 1)- C.=$ CL.map (subtract 3)- C.=$ CL.fold (+) 0+ x <- runConduit+ $ CL.sourceList [1..10 :: Int]+ .| CL.map (+ 1)+ .| CL.map (+ 1)+ .| CL.map (+ 1)+ .| CL.map (subtract 3)+ .| CL.map (* 2)+ .| CL.map (`div` 2)+ .| CL.map (+ 1)+ .| CL.map (+ 1)+ .| CL.map (+ 1)+ .| CL.map (subtract 3)+ .| CL.fold (+) 0 x `shouldBe` sum [1..10] describe "termination" $ do it "terminates early" $ do let src = forever $ C.yield ()- x <- src C.$$ CL.head+ x <- runConduit $ src .| CL.head x `shouldBe` Just () it "bracket" $ do ref <- I.newIORef (0 :: Int)@@ -417,7 +475,7 @@ (I.modifyIORef ref (+ 1)) (\() -> I.modifyIORef ref (+ 2)) (\() -> forever $ C.yield (1 :: Int))- val <- C.runResourceT $ src C.$$ CL.isolate 10 C.=$ CL.fold (+) 0+ val <- runConduitRes $ src .| CL.isolate 10 .| CL.fold (+) 0 val `shouldBe` 10 i <- I.readIORef ref i `shouldBe` 3@@ -428,7 +486,7 @@ (\() -> I.modifyIORef ref (+ 2)) (\() -> forever $ C.yield (1 :: Int)) src' = CL.sourceList $ repeat 1- val <- C.runResourceT $ (src' >> src) C.$$ CL.isolate 10 C.=$ CL.fold (+) 0+ val <- runConduitRes $ (src' >> src) .| CL.isolate 10 .| CL.fold (+) 0 val `shouldBe` 10 i <- I.readIORef ref i `shouldBe` 0@@ -438,7 +496,7 @@ (I.modifyIORef ref (+ 1)) (\() -> I.modifyIORef ref (+ 2)) (\() -> forever $ C.yield (1 :: Int))- val <- C.runResourceT $ src C.$$ CL.isolate 10 C.=$ CL.fold (+) 0+ val <- runConduitRes $ src .| CL.isolate 10 .| CL.fold (+) 0 val `shouldBe` 10 i <- I.readIORef ref i `shouldBe` 3@@ -449,7 +507,7 @@ (\() -> I.modifyIORef ref (+ 2)) (\() -> forever $ C.yield (1 :: Int)) src' = CL.sourceList $ repeat 1- val <- C.runResourceT $ (src' >> src) C.$$ CL.isolate 10 C.=$ CL.fold (+) 0+ val <- runConduitRes $ (src' >> src) .| CL.isolate 10 .| CL.fold (+) 0 val `shouldBe` 10 i <- I.readIORef ref i `shouldBe` 0@@ -459,20 +517,20 @@ ref <- I.newIORef [] let add x = I.modifyIORef ref (x:) adder' = CI.NeedInput (\a -> liftIO (add a) >> adder') return- adder = CI.ConduitM adder'- residue x = CI.ConduitM $ CI.Leftover (CI.Done ()) x+ adder = CI.ConduitT (adder' >>=)+ residue x = CI.ConduitT $ \rest -> CI.Leftover (rest ()) x - _ <- C.yield 1 C.$$ adder+ _ <- runConduit $ C.yield 1 .| adder x <- I.readIORef ref x `shouldBe` [1 :: Int] I.writeIORef ref [] - _ <- C.yield 1 C.$$ (residue 2 >> residue 3) >> adder+ _ <- runConduit $ C.yield 1 .| ((residue 2 >> residue 3) >> adder) y <- I.readIORef ref y `shouldBe` [1, 2, 3] I.writeIORef ref [] - _ <- C.yield 1 C.$$ residue 2 >> (residue 3 >> adder)+ _ <- runConduit $ C.yield 1 .| (residue 2 >> (residue 3 >> adder)) z <- I.readIORef ref z `shouldBe` [1, 2, 3] I.writeIORef ref []@@ -482,18 +540,12 @@ let is = [1..10] ++ undefined src [] = return () src (x:xs) = C.yield x >> src xs- x <- src is C.$$ CL.take 10+ x <- runConduit $ src is .| CL.take 10 x `shouldBe` [1..10 :: Int] it' "yield terminates (2)" $ do let is = [1..10] ++ undefined- x <- mapM_ C.yield is C.$$ CL.take 10+ x <- runConduit $ mapM_ C.yield is .| CL.take 10 x `shouldBe` [1..10 :: Int]- it' "yieldOr finalizer called" $ do- iref <- I.newIORef (0 :: Int)- let src = mapM_ (\i -> C.yieldOr i $ I.writeIORef iref i) [1..]- src C.$$ CL.isolate 10 C.=$ CL.sinkNull- x <- I.readIORef iref- x `shouldBe` 10 describe "upstream results" $ do it' "works" $ do@@ -506,17 +558,17 @@ describe "input/output mapping" $ do it' "mapOutput" $ do- x <- C.mapOutput (+ 1) (CL.sourceList [1..10 :: Int]) C.$$ CL.fold (+) 0+ x <- runConduit $ C.mapOutput (+ 1) (CL.sourceList [1..10 :: Int]) .| CL.fold (+) 0 x `shouldBe` sum [2..11] it' "mapOutputMaybe" $ do- x <- C.mapOutputMaybe (\i -> if even i then Just i else Nothing) (CL.sourceList [1..10 :: Int]) C.$$ CL.fold (+) 0+ x <- runConduit $ C.mapOutputMaybe (\i -> if even i then Just i else Nothing) (CL.sourceList [1..10 :: Int]) .| CL.fold (+) 0 x `shouldBe` sum [2, 4..10] it' "mapInput" $ do- xyz <- (CL.sourceList $ map show [1..10 :: Int]) C.$$ do+ xyz <- runConduit $ (CL.sourceList $ map show [1..10 :: Int]) .| do (x, y) <- C.mapInput read (Just . show) $ ((do- x <- CL.isolate 5 C.=$ CL.fold (+) 0+ x <- CL.isolate 5 .| CL.fold (+) 0 y <- CL.peek- return (x :: Int, y :: Maybe Int)) :: C.Sink Int IO (Int, Maybe Int))+ return (x :: Int, y :: Maybe Int)) :: ConduitT Int Void IO (Int, Maybe Int)) z <- CL.consume return (x, y, concat z) @@ -524,12 +576,12 @@ describe "left/right identity" $ do it' "left identity" $ do- x <- CL.sourceList [1..10 :: Int] C.$$ CI.ConduitM CI.idP C.=$ CL.fold (+) 0- y <- CL.sourceList [1..10 :: Int] C.$$ CL.fold (+) 0+ x <- runConduit $ CL.sourceList [1..10 :: Int] .| CI.ConduitT (CI.idP >>=) .| CL.fold (+) 0+ y <- runConduit $ CL.sourceList [1..10 :: Int] .| CL.fold (+) 0 x `shouldBe` y it' "right identity" $ do- x <- CI.runPipe $ mapM_ CI.yield [1..10 :: Int] CI.>+> (CI.injectLeftovers $ CI.unConduitM $ CL.fold (+) 0) CI.>+> CI.idP- y <- CI.runPipe $ mapM_ CI.yield [1..10 :: Int] CI.>+> (CI.injectLeftovers $ CI.unConduitM $ CL.fold (+) 0)+ x <- CI.runPipe $ mapM_ CI.yield [1..10 :: Int] CI.>+> (CI.injectLeftovers $ (\c -> c `CI.unConduitT` CI.Done) $ CL.fold (+) 0) CI.>+> CI.idP+ y <- CI.runPipe $ mapM_ CI.yield [1..10 :: Int] CI.>+> (CI.injectLeftovers $ (\c -> c `CI.unConduitT` CI.Done) $ CL.fold (+) 0) x `shouldBe` y describe "generalizing" $ do@@ -558,108 +610,32 @@ describe "iterate" $ do it' "works" $ do- res <- CL.iterate (+ 1) (1 :: Int) C.$$ CL.isolate 10 C.=$ CL.fold (+) 0+ res <- runConduit $ CL.iterate (+ 1) (1 :: Int) .| CL.isolate 10 .| CL.fold (+) 0 res `shouldBe` sum [1..10] - describe "unwrapResumable" $ do- it' "works" $ do- ref <- I.newIORef (0 :: Int)- let src0 = do- C.yieldOr () $ I.writeIORef ref 1- C.yieldOr () $ I.writeIORef ref 2- C.yieldOr () $ I.writeIORef ref 3- (rsrc0, Just ()) <- src0 C.$$+ CL.head-- x0 <- I.readIORef ref- x0 `shouldBe` 0-- (_, final) <- C.unwrapResumable rsrc0-- x1 <- I.readIORef ref- x1 `shouldBe` 0-- final-- x2 <- I.readIORef ref- x2 `shouldBe` 1-- it' "isn't called twice" $ do- ref <- I.newIORef (0 :: Int)- let src0 = do- C.yieldOr () $ I.writeIORef ref 1- C.yieldOr () $ I.writeIORef ref 2- (rsrc0, Just ()) <- src0 C.$$+ CL.head-- x0 <- I.readIORef ref- x0 `shouldBe` 0-- (src1, final) <- C.unwrapResumable rsrc0-- x1 <- I.readIORef ref- x1 `shouldBe` 0-- Just () <- src1 C.$$ CL.head-- x2 <- I.readIORef ref- x2 `shouldBe` 2-- final-- x3 <- I.readIORef ref- x3 `shouldBe` 2-- it' "source isn't used" $ do- ref <- I.newIORef (0 :: Int)- let src0 = do- C.yieldOr () $ I.writeIORef ref 1- C.yieldOr () $ I.writeIORef ref 2- (rsrc0, Just ()) <- src0 C.$$+ CL.head-- x0 <- I.readIORef ref- x0 `shouldBe` 0-- (src1, final) <- C.unwrapResumable rsrc0-- x1 <- I.readIORef ref- x1 `shouldBe` 0-- () <- src1 C.$$ return ()+ prop "replicate" $ \cnt' -> do+ let cnt = min cnt' 100+ res <- runConduit $ CL.replicate cnt () .| CL.consume+ res `shouldBe` replicate cnt () - x2 <- I.readIORef ref- x2 `shouldBe` 0+ prop "replicateM" $ \cnt' -> do+ ref <- I.newIORef 0+ let cnt = min cnt' 100+ res <- runConduit $ CL.replicateM cnt (I.modifyIORef ref (+ 1)) .| CL.consume+ res `shouldBe` replicate cnt () - final+ ref' <- I.readIORef ref+ ref' `shouldBe` (if cnt' <= 0 then 0 else cnt) - x3 <- I.readIORef ref- x3 `shouldBe` 1 describe "injectLeftovers" $ do it "works" $ do let src = mapM_ CI.yield [1..10 :: Int]- conduit = CI.injectLeftovers $ CI.unConduitM $ C.awaitForever $ \i -> do+ conduit = CI.injectLeftovers $ (\c -> c `CI.unConduitT` CI.Done) $ C.awaitForever $ \i -> do js <- CL.take 2 mapM_ C.leftover $ reverse js C.yield i- res <- CI.ConduitM (src CI.>+> CI.injectLeftovers conduit) C.$$ CL.consume+ res <- runConduit $ CI.ConduitT ((src CI.>+> CI.injectLeftovers conduit) >>=) .| CL.consume res `shouldBe` [1..10]- describe "up-upstream finalizers" $ do- it "pipe" $ do- let p1 = CI.await >>= maybe (return ()) CI.yield- p2 = idMsg "p2-final"- p3 = idMsg "p3-final"- idMsg msg = CI.addCleanup (const $ tell [msg]) $ CI.awaitForever CI.yield- printer = CI.awaitForever $ lift . tell . return . show- src = mapM_ CI.yield [1 :: Int ..]- let run' p = execWriter $ CI.runPipe $ printer CI.<+< p CI.<+< src- run' (p1 CI.<+< (p2 CI.<+< p3)) `shouldBe` run' ((p1 CI.<+< p2) CI.<+< p3)- it "conduit" $ do- let p1 = C.await >>= maybe (return ()) C.yield- p2 = idMsg "p2-final"- p3 = idMsg "p3-final"- idMsg msg = C.addCleanup (const $ tell [msg]) $ C.awaitForever C.yield- printer = C.awaitForever $ lift . tell . return . show- src = CL.sourceList [1 :: Int ..]- let run' p = execWriter $ src C.$$ p C.=$ printer- run' ((p3 C.=$= p2) C.=$= p1) `shouldBe` run' (p3 C.=$= (p2 C.=$= p1)) describe "monad transformer laws" $ do it "transPipe" $ do let source = CL.sourceList $ replicate 10 ()@@ -676,15 +652,15 @@ lift $ get >>= lift . tell' C.yield i - x <- runWriterT $ source C.$$ C.transPipe (`evalStateT` 1) replaceNum1 C.=$ CL.consume- y <- runWriterT $ source C.$$ C.transPipe (`evalStateT` 1) replaceNum2 C.=$ CL.consume+ x <- runWriterT $ runConduit $ source .| C.transPipe (`evalStateT` 1) replaceNum1 .| CL.consume+ y <- runWriterT $ runConduit $ source .| C.transPipe (`evalStateT` 1) replaceNum2 .| CL.consume x `shouldBe` y describe "iterM" $ do prop "behavior" $ \l -> monadicIO $ do let counter ref = CL.iterM (const $ liftIO $ M.modifyMVar_ ref (\i -> return $! i + 1)) v <- run $ do ref <- M.newMVar 0- CL.sourceList l C.$= counter ref C.$$ CL.mapM_ (const $ return ())+ runConduit $ CL.sourceList l .| counter ref .| CL.mapM_ (const $ return ()) M.readMVar ref assert $ v == length (l :: [Int])@@ -692,7 +668,7 @@ let runTest h = run $ do ref <- M.newMVar (0 :: Int) let f = action ref- s <- CL.sourceList (l :: [Int]) C.$= h f C.$$ CL.fold (+) 0+ s <- runConduit $ CL.sourceList (l :: [Int]) .| h f .| CL.fold (+) 0 c <- M.readMVar ref return (c, s)@@ -706,20 +682,42 @@ describe "generalizing" $ do it "works" $ do- let src :: Int -> C.Source IO Int+ let src :: Int -> ConduitT () Int IO () src i = CL.sourceList [1..i]- sink :: C.Sink Int IO Int+ sink :: ConduitT Int Void IO Int sink = CL.fold (+) 0- res <- C.yield 10 C.$$ C.awaitForever (C.toProducer . src) C.=$ (C.toConsumer sink >>= C.yield) C.=$ C.await+ res <- runConduit $ C.yield 10 .| C.awaitForever (C.toProducer . src) .| (C.toConsumer sink >>= C.yield) .| C.await res `shouldBe` Just (sum [1..10]) + describe "mergeSource" $ do+ it "works" $ do+ let src :: ConduitT () String IO ()+ src = CL.sourceList ["A", "B", "C"]+ withIndex :: ConduitT String (Integer, String) IO ()+ withIndex = CI.mergeSource (CL.sourceList [1..])+ output <- runConduit $ src .| withIndex .| CL.consume+ output `shouldBe` [(1, "A"), (2, "B"), (3, "C")]+ it "does stop processing when the source exhausted" $ do+ let src :: ConduitT () Integer IO ()+ src = CL.sourceList [1..]+ withShortAlphaIndex :: ConduitT Integer (String, Integer) IO ()+ withShortAlphaIndex = CI.mergeSource (CL.sourceList ["A", "B", "C"])+ output <- runConduit $ src .| withShortAlphaIndex .| CL.consume+ output `shouldBe` [("A", 1), ("B", 2), ("C", 3)]+ it "does not drop upstream items" $ do+ let num = CL.sourceList [1 .. 10 :: Int]+ let chr = CL.sourceList ['a' .. 'c']+ (output, remainder) <- runConduit $ num .| liftA2 (,) (CI.mergeSource chr .| CL.consume) CL.consume+ output `shouldBe` [('a', 1), ('b', 2), ('c', 3)]+ remainder `shouldBe` [4 .. 10]+ describe "passthroughSink" $ do it "works" $ do ref <- I.newIORef (-1) let sink = CL.fold (+) (0 :: Int) conduit = C.passthroughSink sink (I.writeIORef ref) input = [1..10]- output <- mapM_ C.yield input C.$$ conduit C.=$ CL.consume+ output <- runConduit $ mapM_ C.yield input .| conduit .| CL.consume output `shouldBe` input x <- I.readIORef ref x `shouldBe` sum input@@ -728,10 +726,19 @@ let sink = CL.fold (+) (0 :: Int) conduit = C.passthroughSink sink (I.writeIORef ref) input = [undefined]- mapM_ C.yield input C.$$ conduit C.=$ return ()+ runConduit $ mapM_ C.yield input .| conduit .| return () x <- I.readIORef ref x `shouldBe` (-1) + it "handles the last input correctly #304" $ do+ ref <- I.newIORef (-1 :: Int)+ let sink = CL.mapM_ (I.writeIORef ref)+ conduit = C.passthroughSink sink (const (return ()))+ res <- runConduit $ mapM_ C.yield [1..] .| conduit .| CL.take 5+ res `shouldBe` [1..5]+ x <- I.readIORef ref+ x `shouldBe` 5+ describe "mtl instances" $ do it "ErrorT" $ do let src = flip catchError (const $ C.yield 4) $ do@@ -744,125 +751,32 @@ lift $ return () C.yield 3 lift $ return ()- (src C.$$ CL.consume) `shouldBe` Right [1, 2, 4 :: Int]-- describe "finalizers" $ do- it "promptness" $ do- imsgs <- I.newIORef []- let add x = liftIO $ do- msgs <- I.readIORef imsgs- I.writeIORef imsgs $ msgs ++ [x]- src' = C.bracketP- (add "acquire")- (const $ add "release")- (const $ C.addCleanup (const $ add "inside") (mapM_ C.yield [1..5]))- src = do- src' C.$= CL.isolate 4- add "computation"- sink = CL.mapM (\x -> add (show x) >> return x) C.=$ CL.consume-- res <- C.runResourceT $ src C.$$ sink-- msgs <- I.readIORef imsgs- -- FIXME this would be better msgs `shouldBe` words "acquire 1 2 3 4 inside release computation"- msgs `shouldBe` words "acquire 1 2 3 4 release inside computation"-- res `shouldBe` [1..4 :: Int]-- it "left associative" $ do- imsgs <- I.newIORef []- let add x = liftIO $ do- msgs <- I.readIORef imsgs- I.writeIORef imsgs $ msgs ++ [x]- p1 = C.bracketP (add "start1") (const $ add "stop1") (const $ add "inside1" >> C.yield ())- p2 = C.bracketP (add "start2") (const $ add "stop2") (const $ add "inside2" >> C.await >>= maybe (return ()) C.yield)- p3 = C.bracketP (add "start3") (const $ add "stop3") (const $ add "inside3" >> C.await)-- res <- C.runResourceT $ (p1 C.$= p2) C.$$ p3- res `shouldBe` Just ()-- msgs <- I.readIORef imsgs- msgs `shouldBe` words "start3 inside3 start2 inside2 start1 inside1 stop3 stop2 stop1"-- it "right associative" $ do- imsgs <- I.newIORef []- let add x = liftIO $ do- msgs <- I.readIORef imsgs- I.writeIORef imsgs $ msgs ++ [x]- p1 = C.bracketP (add "start1") (const $ add "stop1") (const $ add "inside1" >> C.yield ())- p2 = C.bracketP (add "start2") (const $ add "stop2") (const $ add "inside2" >> C.await >>= maybe (return ()) C.yield)- p3 = C.bracketP (add "start3") (const $ add "stop3") (const $ add "inside3" >> C.await)-- res <- C.runResourceT $ p1 C.$$ (p2 C.=$ p3)- res `shouldBe` Just ()-- msgs <- I.readIORef imsgs- msgs `shouldBe` words "start3 inside3 start2 inside2 start1 inside1 stop3 stop2 stop1"-- describe "dan burton's associative tests" $ do- let tellLn = tell . (++ "\n")- finallyP fin = CI.addCleanup (const fin)- printer = CI.awaitForever $ lift . tellLn . show- idMsg msg = finallyP (tellLn msg) CI.idP- takeP 0 = return ()- takeP n = CI.awaitE >>= \ex -> case ex of- Left _u -> return ()- Right i -> CI.yield i >> takeP (pred n)-- testPipe p = execWriter $ runPipe $ printer <+< p <+< CI.sourceList ([1..] :: [Int])-- p1 = takeP (1 :: Int)- p2 = idMsg "foo"- p3 = idMsg "bar"-- (<+<) = (CI.<+<)- runPipe = CI.runPipe-- test1L = testPipe $ (p1 <+< p2) <+< p3- test1R = testPipe $ p1 <+< (p2 <+< p3)-- _test2L = testPipe $ (p2 <+< p1) <+< p3- _test2R = testPipe $ p2 <+< (p1 <+< p3)-- test3L = testPipe $ (p2 <+< p3) <+< p1- test3R = testPipe $ p2 <+< (p3 <+< p1)-- verify testL testR p1' p2' p3'- | testL == testR = return () :: IO ()- | otherwise = error $ unlines- [ "FAILURE"- , ""- , "(" ++ p1' ++ " <+< " ++ p2' ++ ") <+< " ++ p3'- , "------------------"- , testL- , ""- , p1' ++ " <+< (" ++ p2' ++ " <+< " ++ p3' ++ ")"- , "------------------"- , testR- ]-- it "test1" $ verify test1L test1R "p1" "p2" "p3"- -- FIXME this is broken it "test2" $ verify test2L test2R "p2" "p1" "p3"- it "test3" $ verify test3L test3R "p2" "p3" "p1"+ runConduit (src .| CL.consume) `shouldBe` Right [1, 2, 4 :: Int]+ describe "WriterT" $+ it "pass" $+ let writer = W.pass $ do+ W.tell [1 :: Int]+ pure ((), (2:))+ in execWriter (runConduit writer) `shouldBe` [2, 1] describe "Data.Conduit.Lift" $ do it "execStateC" $ do let sink = C.execStateLC 0 $ CL.mapM_ $ modify . (+) src = mapM_ C.yield [1..10 :: Int]- res <- src C.$$ sink+ res <- runConduit $ src .| sink res `shouldBe` sum [1..10] it "execWriterC" $ do let sink = C.execWriterLC $ CL.mapM_ $ tell . return src = mapM_ C.yield [1..10 :: Int]- res <- src C.$$ sink+ res <- runConduit $ src .| sink res `shouldBe` [1..10] - it "runErrorC" $ do- let sink = C.runErrorC $ do- x <- C.catchErrorC (lift $ throwError "foo") return+ it "runExceptC" $ do+ let sink = C.runExceptC $ do+ x <- C.catchExceptC (lift $ throwError "foo") return return $ x ++ "bar"- res <- return () C.$$ sink+ res <- runConduit $ return () .| sink res `shouldBe` Right ("foobar" :: String) it "runMaybeC" $ do@@ -871,7 +785,7 @@ () <- lift $ MaybeT $ return Nothing C.yield 2 sink = CL.consume- res <- src C.$$ sink+ res <- runConduit $ src .| sink res `shouldBe` [1 :: Int] describe "sequenceSources" $ do@@ -884,7 +798,7 @@ , (2, src2) , (3, src3) ]- res <- srcs C.$$ CL.consume+ res <- runConduit $ srcs .| CL.consume res `shouldBe` [ Map.fromList [(1, 1), (2, 3), (3, 2)] , Map.fromList [(1, 2), (2, 2), (3, 2)]@@ -892,8 +806,8 @@ ] describe "zipSink" $ do it "zip equal-sized" $ do- x <- runResourceT $- CL.sourceList [1..100] C.$$+ x <- runConduitRes $+ CL.sourceList [1..100] .| C.sequenceSinks [ CL.fold (+) 0, (`mod` 101) <$> CL.fold (*) 1 ] x `shouldBe` [5050, 100 :: Integer]@@ -902,21 +816,42 @@ let sink = C.getZipSink $ (*) <$> C.ZipSink (CL.fold (+) 0) <*> C.ZipSink (Data.Maybe.fromJust <$> C.await)- x <- C.runResourceT $ CL.sourceList [100,99..1] C.$$ sink+ x <- runConduitRes $ CL.sourceList [100,99..1] .| sink x `shouldBe` (505000 :: Integer) describe "upstream results" $ do it "fuseBoth" $ do let upstream = do C.yield ("hello" :: String)- CL.isolate 5 C.=$= CL.fold (+) 0+ CL.isolate 5 .| CL.fold (+) 0 downstream = C.fuseBoth upstream CL.consume- res <- CL.sourceList [1..10 :: Int] C.$$ do+ res <- runConduit $ CL.sourceList [1..10 :: Int] .| do (x, y) <- downstream z <- CL.consume return (x, y, z) res `shouldBe` (sum [1..5], ["hello"], [6..10]) + it "fuseBothMaybe with no result" $ do+ let src = mapM_ C.yield [1 :: Int ..]+ sink = CL.isolate 5 .| CL.fold (+) 0+ (mup, down) <- runConduit $ C.fuseBothMaybe src sink+ mup `shouldBe` (Nothing :: Maybe ())+ down `shouldBe` sum [1..5]++ it "fuseBothMaybe with result" $ do+ let src = mapM_ C.yield [1 :: Int .. 5]+ sink = CL.isolate 6 .| CL.fold (+) 0+ (mup, down) <- runConduit $ C.fuseBothMaybe src sink+ mup `shouldBe` Just ()+ down `shouldBe` sum [1..5]++ it "fuseBothMaybe with almost result" $ do+ let src = mapM_ C.yield [1 :: Int .. 5]+ sink = CL.isolate 5 .| CL.fold (+) 0+ (mup, down) <- runConduit $ C.fuseBothMaybe src sink+ mup `shouldBe` (Nothing :: Maybe ())+ down `shouldBe` sum [1..5]+ describe "catching exceptions" $ do it "works" $ do let src = do@@ -924,16 +859,25 @@ () <- Catch.throwM DummyError C.yield 2 src' = do- Catch.catch src (\DummyError -> C.yield (3 :: Int))- res <- src' C.$$ CL.consume+ CI.catchC src (\DummyError -> C.yield (3 :: Int))+ res <- runConduit $ src' .| CL.consume res `shouldBe` [1, 3] + describe "sourceToList" $ do+ it "works lazily in Identity" $ do+ let src = C.yield 1 >> C.yield 2 >> throw DummyError+ let res = runIdentity $ C.sourceToList src+ take 2 res `shouldBe` [1, 2 :: Int]+ it "is not lazy in IO" $ do+ let src = C.yield 1 >> C.yield (2 :: Int) >> throw DummyError+ C.sourceToList src `shouldThrow` (==DummyError)+ ZipConduit.spec+ Stream.spec it' :: String -> IO () -> Spec it' = it data DummyError = DummyError deriving (Show, Eq, Typeable)-instance Error DummyError instance Catch.Exception DummyError
+ test/subdir/dummyfile.txt view