conduit 1.2.13.1 → 1.3.6.1
raw patch · 34 files changed
Files
- ChangeLog.md +77/−2
- Data/Conduit.hs +0/−154
- Data/Conduit/Internal.hs +0/−17
- Data/Conduit/Internal/Conduit.hs +0/−1325
- Data/Conduit/Internal/Fusion.hs +0/−213
- Data/Conduit/Internal/List/Stream.hs +0/−502
- Data/Conduit/Internal/Pipe.hs +0/−648
- Data/Conduit/Lift.hs +0/−630
- Data/Conduit/List.hs +0/−837
- benchmarks/optimize-201408.hs +25/−41
- benchmarks/unfused.hs +30/−33
- conduit.cabal +50/−23
- 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 +3/−3
- test/Data/Conduit/StreamSpec.hs +45/−45
- test/Spec.hs +664/−0
- test/StreamSpec.hs +512/−0
- test/doctests.hs +6/−0
- test/main.hs +234/−459
- test/subdir/dummyfile.txt +0/−0
ChangeLog.md view
@@ -1,6 +1,81 @@-## 1.2.13.1+# ChangeLog for conduit -* Remove the `Safe` language pragma [#353](https://github.com/snoyberg/conduit/issues/353)+## 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
− Data/Conduit.hs
@@ -1,154 +0,0 @@-{-# 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- Source- , Conduit- , Sink- , ConduitM- -- ** Connect/fuse operators- , (.|)- , ($$)- , ($=)- , (=$)- , (=$=)- , connect- , fuse-- -- *** Fuse with upstream results- , fuseBoth- , fuseBothMaybe- , fuseUpstream-- -- ** Primitives- , await- , yield- , yieldM- , leftover- , runConduit- , runConduitPure- , runConduitRes-- -- ** Finalization- , bracketP- , addCleanup- , yieldOr-- -- ** Exception handling- , catchC- , handleC- , tryC-- -- * Generalized conduit types- , Producer- , Consumer- , toProducer- , toConsumer-- -- * Utility functions- , awaitForever- , transPipe- , mapOutput- , mapOutputMaybe- , mapInput- , mergeSource- , passthroughSink- , sourceToList-- -- * 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 Data.Conduit.Internal.Conduit-import Data.Void (Void)-import Data.Functor.Identity (Identity, runIdentity)-import Control.Monad.Trans.Resource (ResourceT, runResourceT)-import Control.Monad.Trans.Control (MonadBaseControl)---- | Named function synonym for '$$'.------ Since 1.2.3-connect :: Monad m => Source m a -> Sink a m b -> m b-connect = ($$)---- | Named function synonym for '=$='.------ Since 1.2.3-fuse :: Monad m => Conduit a m b -> ConduitM b c m r -> ConduitM a c m r-fuse = (=$=)--infixr 2 .|--- | 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.------ @since 1.2.8-(.|) :: Monad m- => ConduitM a b m () -- ^ upstream- -> ConduitM b c m r -- ^ downstream- -> ConduitM a c m r-(.|) = fuse-{-# INLINE (.|) #-}---- | 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 :: ConduitM () 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 :: MonadBaseControl IO m- => ConduitM () Void (ResourceT m) r- -> m r-runConduitRes = runResourceT . runConduit-{-# INLINE runConduitRes #-}
− Data/Conduit/Internal.hs
@@ -1,17 +0,0 @@-{-# 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 (addCleanup, await,- awaitForever, bracketP,- leftover, mapInput, mapOutput,- mapOutputMaybe, transPipe,- yield, yieldM, yieldOr)-import Data.Conduit.Internal.Pipe-import Data.Conduit.Internal.Fusion
− Data/Conduit/Internal/Conduit.hs
@@ -1,1325 +0,0 @@-{-# 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- ConduitM (..)- , Source- , Producer- , Sink- , Consumer- , Conduit- , ResumableSource (..)- , ResumableConduit (..)- , Flush (..)- -- *** Newtype wrappers- , ZipSource (..)- , ZipSink (..)- , ZipConduit (..)- -- ** Primitives- , await- , awaitForever- , yield- , yieldM- , yieldOr- , leftover- , runConduit- -- ** Composition- , connectResume- , connectResumeConduit- , fuseLeftovers- , fuseReturnLeftovers- , ($$+)- , ($$++)- , ($$+-)- , ($=+)- , (=$$+)- , (=$$++)- , (=$$+-)- , ($$)- , ($=)- , (=$)- , (=$=)- -- ** Generalizing- , sourceToPipe- , sinkToPipe- , conduitToPipe- , toProducer- , toConsumer- -- ** Cleanup- , bracketP- , addCleanup- -- ** 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.closeResumableSource- , unwrapResumable- , unwrapResumableConduit- , newResumableSource- , newResumableConduit- , zipSinks- , zipSources- , zipSourcesApp- , zipConduitApp- , mergeSource- , passthroughSink- , sourceToList- , fuseBoth- , fuseBothMaybe- , fuseUpstream- , sequenceSources- , sequenceSinks- , sequenceConduits- ) where--import Prelude hiding (catch)-import Control.Applicative (Applicative (..))-import Control.Exception.Lifted as E (Exception)-import qualified Control.Exception.Lifted as E (catch)-import Control.Monad (liftM, when, liftM2, 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(..), censor)-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 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 Data.IORef as I-import Control.Monad.Morph (MFunctor (..))-import Data.Conduit.Internal.Pipe hiding (yield, mapOutput, leftover, yieldM, yieldOr, await, awaitForever, addCleanup, bracketP)-import qualified Data.Conduit.Internal.Pipe as CI-import Control.Monad (forever)-import Data.Traversable (Traversable (..))-import Control.Monad.Catch (MonadCatch, catch)---- | 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 :: forall b.- (r -> Pipe i i o () m b) -> Pipe i i o () m b- }--instance Functor (ConduitM i o m) where- fmap f (ConduitM c) = ConduitM $ \rest -> c (rest . f)--instance Applicative (ConduitM i o m) where- pure x = ConduitM ($ x)- {-# INLINE pure #-}- (<*>) = ap- {-# INLINE (<*>) #-}--instance Monad (ConduitM i o m) where- return = pure- ConduitM f >>= g = ConduitM $ \h -> f $ \a -> unConduitM (g a) h--instance MonadThrow m => MonadThrow (ConduitM i o m) where- throwM = lift . throwM--instance MFunctor (ConduitM i o) where- hoist f (ConduitM c0) = ConduitM $ \rest -> let- go (HaveOutput p c o) = HaveOutput (go p) (f c) 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)--instance MonadCatch m => MonadCatch (ConduitM i o m) where- catch (ConduitM p0) onErr = ConduitM $ \rest -> let- go (Done r) = rest r- go (PipeM mp) = PipeM $ catch (liftM go mp) (return . flip unConduitM rest . 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- in go (p0 Done)--instance MonadIO m => MonadIO (ConduitM i o m) where- liftIO = lift . liftIO- {-# INLINE liftIO #-}--instance MonadReader r m => MonadReader r (ConduitM i o m) where- ask = lift ask- {-# INLINE ask #-}-- local f (ConduitM c0) = ConduitM $ \rest ->- let go (HaveOutput p c o) = HaveOutput (go p) c 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 (ConduitM i o m) where-#if MIN_VERSION_mtl(2, 1, 0)- writer = lift . writer-#endif- tell = lift . tell-- listen (ConduitM c0) = ConduitM $ \rest ->- let go front (HaveOutput p c o) = HaveOutput (go front p) c 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 (ConduitM c0) = ConduitM $ \rest ->- let go front (HaveOutput p c o) = HaveOutput (go front p) c 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 (ConduitM 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 (ConduitM i o m)--instance MonadError e m => MonadError e (ConduitM i o m) where- throwError = lift . throwError- catchError (ConduitM c0) f = ConduitM $ \rest ->- let go (HaveOutput p c o) = HaveOutput (go p) c 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 $ unConduitM (f e) rest- go (Leftover p i) = Leftover (go p) i- in go (c0 Done)--instance MonadBase base m => MonadBase base (ConduitM i o m) where- liftBase = lift . liftBase- {-# INLINE liftBase #-}--instance MonadTrans (ConduitM i o) where- lift mr = ConduitM $ \rest -> PipeM (liftM rest mr)- {-# INLINE [1] lift #-}--instance MonadResource m => MonadResource (ConduitM i o m) where- liftResourceT = lift . liftResourceT- {-# INLINE liftResourceT #-}--instance Monad m => Semigroup (ConduitM i o m ()) where- (<>) = (>>)- {-# INLINE (<>) #-}--instance Monad m => Monoid (ConduitM i o m ()) where- mempty = return ()- {-# INLINE mempty #-}-#if !(MIN_VERSION_base(4,11,0))- mappend = (<>)- {-# INLINE mappend #-}-#endif--instance PrimMonad m => PrimMonad (ConduitM i o m) where- type PrimState (ConduitM 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 = 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 (Pipe () () o () m ()) (m ())---- | Since 1.0.13-instance MFunctor ResumableSource where- hoist nat (ResumableSource src m) = ResumableSource (hoist nat src) (nat m)---- | 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 left0 leftFinal0) (ConduitM right0) =- goRight leftFinal0 left0 (right0 Done)- where- goRight leftFinal left right =- case right of- HaveOutput _ _ o -> absurd o- NeedInput rp rc -> goLeft rp rc leftFinal left- Done r2 -> return (ResumableSource 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--sourceToPipe :: Monad m => Source m o -> Pipe l i o u m ()-sourceToPipe =- go . flip unConduitM Done- 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 . flip unConduitM 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 => Conduit i m o -> Pipe l i o u m ()-conduitToPipe =- go . injectLeftovers . flip unConduitM Done- 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---- | 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) >> (ConduitM (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 (ConduitM s) = ResumableSource (s Done) (return ())---- | Generalize a 'Source' to a 'Producer'.------ Since 1.0.0-toProducer :: Monad m => Source m a -> Producer m a-toProducer (ConduitM c0) = ConduitM $ \rest -> let- go (HaveOutput p c o) = HaveOutput (go p) c 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 => Sink a m b -> Consumer a m b-toConsumer (ConduitM c0) = ConduitM $ \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 :: (MonadBaseControl IO m, Exception e)- => ConduitM i o m r- -> (e -> ConduitM i o m r)- -> ConduitM i o m r-catchC (ConduitM p0) onErr = ConduitM $ \rest -> let- go (Done r) = rest r- go (PipeM mp) = PipeM $ E.catch (liftM go mp)- (return . flip unConduitM rest . 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- in go (p0 Done)-{-# 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 c0) = ConduitM $ \rest -> let- go (Done r) = rest (Right r)- go (PipeM mp) = PipeM $ E.catch (liftM go mp) (return . rest . 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- in go (c0 Done)-{-# 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 $ \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 => Source m a -> Source m b -> Source m (a, b)-zipSources (ConduitM left0) (ConduitM right0) = ConduitM $ \rest -> let- go (Leftover left ()) right = go left right- go left (Leftover right ()) = go left right- go (Done ()) (Done ()) = rest ()- go (Done ()) (HaveOutput _ close _) = PipeM (close >> return (rest ()))- go (HaveOutput _ close _) (Done ()) = PipeM (close >> return (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 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 ())- 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 => Source m (a -> b) -> Source m a -> Source m b-zipSourcesApp (ConduitM left0) (ConduitM right0) = ConduitM $ \rest -> let- go (Leftover left ()) right = go left right- go left (Leftover right ()) = go left right- go (Done ()) (Done ()) = rest ()- go (Done ()) (HaveOutput _ close _) = PipeM (close >> return (rest ()))- go (HaveOutput _ close _) (Done ()) = PipeM (close >> return (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 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 ())- in go (left0 Done) (right0 Done)---- |------ 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 $ \rest -> let- go _ _ (Done f) (Done x) = rest (f x)- 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 _ 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 (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))- in go (return ()) (return ()) (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- => ConduitM a b m ()- -> ConduitM b c m r- -> ConduitM a c m (r, [b])-fuseReturnLeftovers (ConduitM left0) (ConduitM right0) = ConduitM $ \rest -> let- 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 (rest (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- in goRight (return ()) [] (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])- -> ConduitM a b m ()- -> ConduitM b c m r- -> ConduitM a c m r-fuseLeftovers f left right = do- (r, bs) <- fuseReturnLeftovers left right- 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 (Pipe i i o () m ()) (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 left0 leftFinal0) (ConduitM right0) = ConduitM $ \rest -> let- goRight leftFinal left right =- case right of- HaveOutput _ _ o -> absurd o- NeedInput rp rc -> goLeft rp rc leftFinal left- Done r2 -> rest (ResumableConduit 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- in goRight leftFinal0 left0 (right0 Done)---- | 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 (ConduitM ((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 (ConduitM c) = ResumableConduit (c Done) (return ())----- | Merge a @Source@ into a @Conduit@.--- The new conduit will stop processing once either source or upstream have been exhausted.-mergeSource- :: Monad m- => Source m i- -> Conduit a m (i, a)-mergeSource = loop . newResumableSource- where- loop :: Monad m => ResumableSource m i -> Conduit a m (i, a)- loop src0 = await >>= maybe (lift $ closeResumableSource src0) go- where- go a = do- (src1, mi) <- lift $ src0 $$++ await- case mi of- Nothing -> lift $ closeResumableSource src1- 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- => Sink i m r- -> (r -> m ()) -- ^ finalizer- -> Conduit i m i-passthroughSink (ConduitM sink0) final = ConduitM $ \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- unConduitM (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 lazily as the--- underlying monad.------ Since 1.2.6-sourceToList :: Monad m => Source m a -> m [a]-sourceToList =- go . flip unConduitM 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 $=+---- | 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] ($$) #-}---- | A synonym for '=$=' for backwards compatibility.------ Since 0.4.0-($=) :: Monad m => Conduit a m b -> ConduitM b c m r -> ConduitM a c m r-($=) = (=$=)-{-# INLINE [0] ($=) #-}-{-# RULES "conduit: $= is =$=" ($=) = (=$=) #-}---- | A synonym for '=$=' for backwards compatibility.------ Since 0.4.0-(=$) :: Monad m => Conduit a m b -> ConduitM b c m r -> ConduitM a c m r-(=$) = (=$=)-{-# INLINE [0] (=$) #-}-{-# RULES "conduit: =$ is =$=" (=$) = (=$=) #-}---- | 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 left0 =$= ConduitM right0 = ConduitM $ \rest ->- let 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 (rest 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- in goRight (return ()) (left0 Done) (right0 Done)- where-{-# INLINE [1] (=$=) #-}---- | 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 => Consumer i m (Maybe i)-await = ConduitM $ \f -> NeedInput (f . Just) (const $ f Nothing)-{-# INLINE [0] await #-}--await' :: Monad m- => ConduitM i o m r- -> (i -> ConduitM i o m r)- -> ConduitM i o m r-await' f g = ConduitM $ \rest -> NeedInput- (\i -> unConduitM (g i) rest)- (const $ unConduitM 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. 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 o = yieldOr o (return ())-{-# INLINE yield #-}---- | Send a monadic value downstream for the next component to consume.------ @since 1.2.7-yieldM :: Monad m => m o -> ConduitM i o m ()-yieldM mo = lift mo >>= yield-{-# INLINE yieldM #-}-- -- FIXME rule won't fire, see FIXME in .Pipe; "mapM_ yield" mapM_ yield = ConduitM . 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 -> ConduitM i o m ()-leftover i = ConduitM $ \rest -> Leftover (rest ()) i-{-# INLINE leftover #-}---- | Run a pipeline until processing completes.------ Since 1.2.1-runConduit :: Monad m => ConduitM () Void m r -> m r-runConduit (ConduitM 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 -> ConduitM i o m r)- -- ^ computation to run in-between- -> ConduitM i o m r- -- returns the value from the in-between computation-bracketP alloc free inside = ConduitM $ \rest -> PipeM $ do- (key, seed) <- allocate alloc free- return $ unConduitM (addCleanup (const $ release key) (inside seed)) rest---- | 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 cleanup (ConduitM c0) = ConduitM $ \rest -> let- go (Done r) = PipeM (cleanup True >> return (rest r))- go (HaveOutput src close x) = HaveOutput- (go src)- (cleanup False >> close)- x- go (PipeM msrc) = PipeM (liftM (go) msrc)- go (NeedInput p c) = NeedInput- (go . p)- (go . c)- go (Leftover p i) = Leftover (go p) i- in go (c0 Done)---- | 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 $ \rest -> HaveOutput (rest ()) m o-{-# INLINE yieldOr #-}---- | 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 -> ConduitM i o m r) -> ConduitM i o m ()-awaitForever f = ConduitM $ \rest ->- let go = NeedInput (\i -> unConduitM (f i) (const go)) rest- in go---- | 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 c0) = ConduitM $ \rest -> let- go (HaveOutput p c o) = HaveOutput (go p) c (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) -> ConduitM i o1 m r -> ConduitM i o2 m r-mapOutputMaybe f (ConduitM c0) = ConduitM $ \rest -> let- go (HaveOutput p c o) = maybe id (\o' p' -> HaveOutput p' c 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 @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 f' (ConduitM c0) = ConduitM $ \rest -> let- go (HaveOutput p c o) = HaveOutput (go p) c 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)---- | 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)-ConduitM src $$+ sink =- connectResume (ResumableSource (src Done) (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 $=+ ConduitM sink =- ResumableSource (src `pipeL` sink Done) 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@ 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 (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.------ 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 :: 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)-(=$$+) (ConduitM conduit) = connectResumeConduit (ResumableConduit (conduit Done) (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 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- => ConduitM a b m r1- -> ConduitM b c m r2- -> ConduitM a c m (Maybe r1, r2)-fuseBothMaybe (ConduitM up) (ConduitM down) =- ConduitM (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 c o) = HaveOutput (go mup p) c 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 => ConduitM a b m r -> Conduit b m c -> ConduitM a c m r-fuseUpstream up down = fmap fst (fuseBoth up down)-{-# INLINE fuseUpstream #-}---- Rewrite rules--{- FIXME-{-# RULES "conduit: ConduitM: lift x >>= f" forall m f. lift m >>= f = ConduitM (PipeM (liftM (unConduitM . f) m)) #-}-{-# RULES "conduit: ConduitM: lift x >> f" forall m f. lift m >> f = ConduitM (PipeM (liftM (\_ -> unConduitM f) m)) #-}--{-# RULES "conduit: ConduitM: liftIO x >>= f" forall m (f :: MonadIO m => a -> ConduitM i o m r). liftIO m >>= f = ConduitM (PipeM (liftM (unConduitM . f) (liftIO m))) #-}-{-# RULES "conduit: ConduitM: liftIO x >> f" forall m (f :: MonadIO m => ConduitM i o m r). liftIO m >> f = ConduitM (PipeM (liftM (\_ -> unConduitM f) (liftIO m))) #-}--{-# RULES "conduit: ConduitM: liftBase x >>= f" forall m (f :: MonadBase b m => a -> ConduitM i o m r). liftBase m >>= f = ConduitM (PipeM (liftM (unConduitM . f) (liftBase m))) #-}-{-# RULES "conduit: ConduitM: liftBase x >> f" forall m (f :: MonadBase b m => ConduitM i o m r). liftBase m >> f = ConduitM (PipeM (liftM (\_ -> unConduitM f) (liftBase m))) #-}--{-# RULES- "yield o >> p" forall o (p :: ConduitM i o m r). yield o >> p = ConduitM (HaveOutput (unConduitM p) (return ()) o)- ; "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- #-}-{-# RULES "conduit: leftover l >> p" forall l (p :: ConduitM i o m r). leftover l >> p =- ConduitM (Leftover (unConduitM p) l) #-}- -}
− Data/Conduit/Internal/Fusion.hs
@@ -1,213 +0,0 @@-{-# LANGUAGE ExistentialQuantification #-}-{-# LANGUAGE RankNTypes #-}-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE DeriveFunctor #-}-{-# LANGUAGE Trustworthy #-}-module Data.Conduit.Internal.Fusion- ( -- ** Types- Step (..)- , Stream (..)- , ConduitWithStream- , StreamConduitM- , 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)---- | 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- (ConduitM i o m r)- (StreamConduitM i o m r)--type StreamConduitM i o m r = Stream m i () -> Stream m o r--type StreamConduit i m o = StreamConduitM i o m ()--type StreamSource m o = StreamConduitM () o m ()--type StreamProducer m o = forall i. StreamConduitM i o m ()--type StreamSink i m r = StreamConduitM i Void m r--type StreamConsumer i m r = forall o. StreamConduitM i o m r--unstream :: ConduitWithStream i o m r -> ConduitM 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)- #-}--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- #-}--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 ()- -> ConduitM i Void m r- -> m r-connectStream1 (ConduitWithStream _ fstream) (ConduitM 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- #-}--{---Not only will this rule not fire reliably, but due to finalizers, it can change-behavior unless implemented very carefully. Odds are that the careful-implementation won't be any faster, so leaving this commented out for now.--connectStream2 :: Monad m- => ConduitM () i m ()- -> ConduitWithStream i Void m r- -> m r-connectStream2 (ConduitM src0) (ConduitWithStream _ fstream) =- run $ fstream $ Stream step' $ return (return (), src0 Done)- where- step' (_, Done ()) = return $ Stop ()- {-# 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- #-}--}--streamConduit :: ConduitM 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 = ConduitM $ \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') (return ()) 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 = ConduitM $ \rest ->- let loop s =- case runIdentity $ step s of- Stop () -> rest ()- Emit s' o -> HaveOutput (loop s') (return ()) o- Skip s' -> loop s'- in loop s0-{-# INLINE streamSourcePure #-}
− Data/Conduit/Internal/List/Stream.hs
@@ -1,502 +0,0 @@-{-# 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- -> StreamConduitM 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- -> StreamConduitM 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 -> StreamConduitM 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 -> StreamConduitM 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 #-}
− Data/Conduit/Internal/Pipe.hs
@@ -1,648 +0,0 @@-{-# 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- , yieldOr- , leftover- -- ** Finalization- , bracketP- , addCleanup- -- ** 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.Exception.Lifted as E (Exception, catch)-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.Class (MonadIO (liftIO))-import Control.Monad.Base (MonadBase (liftBase))-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 Control.Monad.Morph (MFunctor (..))-import qualified Control.Monad.Catch as Catch---- | 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- {-# 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 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- {-# INLINE liftBase #-}--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 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 #-}--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 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 (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 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---- | 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 ()) (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- ; "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- #-}- -- 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 #-}---- | Bracket a pipe 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 -> 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 =- 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---- | 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) (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 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 #-}---- | 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 (<+<) #-}---- | 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 #-}---- | 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 #-}--{-# 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) #-}
− Data/Conduit/Lift.hs
@@ -1,630 +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 (- -- * ExceptT- exceptC,- runExceptC,- catchExceptC,-- -- * 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.Except as Ex-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---- | Wrap the base monad in 'Ex.ExceptT'------ Since 1.2.12-exceptC- :: (Monad m, Monad (t (Ex.ExceptT e m)), MonadTrans t, MFunctor t) =>- t m (Either e b) -> t (Ex.ExceptT e m) b-exceptC p = do- x <- hoist lift p- lift $ Ex.ExceptT (return x)---- | Run 'Ex.ExceptT' in the base monad------ Since 1.2.12-runExceptC- :: Monad m =>- ConduitM i o (Ex.ExceptT e m) r -> ConduitM i o m (Either e r)-runExceptC (ConduitM c0) =- ConduitM $ \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 f o) = HaveOutput (go p) (Ex.runExceptT f >> return ()) 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 =>- ConduitM i o (Ex.ExceptT e m) r- -> (e -> ConduitM i o (Ex.ExceptT e m) r)- -> ConduitM i o (Ex.ExceptT e m) r-catchExceptC c0 h =- ConduitM $ \rest ->- let go (Done r) = rest r- go (PipeM mp) = PipeM $ do- eres <- lift $ Ex.runExceptT mp- return $ case eres of- Left e -> unConduitM (h e) rest- 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)- in go $ unConduitM c0 Done- where-{-# INLINABLE catchExceptC #-}---- | Wrap the base monad in 'E.ErrorT'------ 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 c0) =- ConduitM $ \rest ->- let go (Done r) = rest (Right r)- go (PipeM mp) = PipeM $ do- eres <- E.runErrorT 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 f o) = HaveOutput (go p) (E.runErrorT f >> return ()) o- go (NeedInput x y) = NeedInput (go . x) (go . y)- in go (c0 Done)-{-# 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 $ \rest ->- let go (Done r) = rest r- go (PipeM mp) = PipeM $ do- eres <- lift $ E.runErrorT mp- return $ case eres of- Left e -> unConduitM (h e) rest- 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)- in go $ unConduitM c0 Done- where-{-# 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 c0 =- ConduitM $ \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 f o) = HaveOutput (go p) (runCatchT f >> return ()) o- go (NeedInput x y) = NeedInput (go . x) (go . y)- in go $ unConduitM c0 Done-{-# 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 (ConduitM c0) h =- ConduitM $ \rest ->- let go (Done r) = rest r- go (PipeM mp) = PipeM $ do- eres <- lift $ runCatchT mp- return $ case eres of- Left e -> unConduitM (h e) rest- 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)- in go (c0 Done)-{-# 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 c0) =- ConduitM $ \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 c o) = HaveOutput (go p) (M.runMaybeT c >> return ()) 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, 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 c0) =- ConduitM $ \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 f o) = HaveOutput (go s p) (runM f s >> return ()) o- in go s0 (c0 Done)-{-# 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,837 +0,0 @@-{-# LANGUAGE RankNTypes #-}-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE CPP #-}-{-# LANGUAGE Trustworthy #-}--- | Higher-level functions to interact with the elements of a stream. Most of--- these are based on list functions.------ For many purposes, it's recommended to use the conduit-combinators library,--- which provides a more complete set of 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- , unfoldEither- , unfoldM- , unfoldEitherM- , enumFromTo- , iterate- , replicate- , replicateM- -- * 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- , chunksOf- , 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- , Either (..)- , Bool (..)- , (>>)- , (>>=)- , seq- , otherwise- , Enum, Eq- , maybe- , (<=)- , (>)- )-import Data.Monoid (Monoid, mempty, mappend)-import qualified Data.Foldable as F-import Data.Conduit-import Data.Conduit.Internal.Fusion-import Data.Conduit.Internal.List.Stream-import qualified Data.Conduit.Internal as CI-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- -> Producer m a-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- -> ConduitM 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- -> Producer m a-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- -> ConduitM 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)---- | Yield the values from the list.------ Subject to fusion-sourceList, sourceListC :: Monad m => [a] -> Producer m a-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- -> Producer m a-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 -> Producer m a-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 -> Producer m a-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 -> Producer m a-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- -> Consumer a 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- -> Consumer a 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 => Source m a -> (b -> a -> b) -> b -> m b-connectFold (CI.ConduitM 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. src $$ fold f b = connectFold src f b #-}--connectFoldM :: Monad m => Source m a -> (b -> a -> m b) -> b -> m b-connectFoldM (CI.ConduitM 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. 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)- -> Consumer a 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)- -> Consumer a 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 ())- -> Consumer a m ()-mapM_C f = awaitForever $ lift . f-{-# INLINE mapM_C #-}-STREAMING(mapM_, mapM_C, mapM_S, f)--srcMapM_ :: Monad m => Source m a -> (a -> m ()) -> m ()-srcMapM_ (CI.ConduitM 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. 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- -> Consumer a 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- -> Consumer a 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 => Consumer a 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 => 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.------ Subject to fusion------ Since 0.3.0-map, mapC :: Monad m => (a -> b) -> Conduit a m b-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 => Source m a -> (a -> b) -> Source m b-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) -> Conduit a m b-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 ()) -> Conduit a m a-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) -> Conduit a m b-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)) -> Conduit a m b-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 => Conduit (Maybe a) m a-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) => Conduit (f a) m a-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]) -> Conduit a m b-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]) -> Conduit a m b-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 -> Conduit a m b-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 -> 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. 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 -> ConduitM 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 -> ConduitM 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 -> ConduitM 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 -> ConduitM 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 -> Conduit a m b-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) -> Conduit a m b-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)) -> Conduit a m b-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 => Consumer a 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 -> Conduit a m [a]-chunksOf n =- start- where- start = await >>= maybe (return ()) (\x -> loop n (x:))-- loop !count rest =- await >>= maybe (yield (rest [])) go- where- go y- | count > 1 = loop (count - 1) (rest . (y:))- | otherwise = yield (rest []) >> loop n (y:)---- | Grouping input according to an equality function.------ Subject to fusion------ Since 0.3.0-groupBy, groupByC :: Monad m => (a -> a -> Bool) -> Conduit a m [a]-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)- -> Conduit a m (a, [a])-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)---- | 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 -> Conduit a m a-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) -> Conduit a m a-filterC f = awaitForever $ \i -> when (f i) (yield i)-STREAMING(filter, filterC, filterS, f)--filterFuseRight :: Monad m => Source m a -> (a -> Bool) -> Source m a-filterFuseRight (CI.ConduitM src) f = CI.ConduitM $ \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 c o)- | f o = CI.HaveOutput (go p) c 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 => Consumer a m ()-sinkNullC = awaitForever $ \_ -> return ()-{-# INLINE sinkNullC #-}-STREAMING0(sinkNull, sinkNullC, sinkNullS)--srcSinkNull :: Monad m => Source m a -> m ()-srcSinkNull (CI.ConduitM 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. 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 => Producer m a-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- => Consumer i m o -- ^ @Pipe@ to run repeatedly- -> Conduit i m o-sequence sink =- self- where- self = awaitForever $ \i -> leftover i >> sink >>= yield
benchmarks/optimize-201408.hs view
@@ -9,16 +9,12 @@ import Control.DeepSeq import Control.Monad (foldM) import Control.Monad (when, liftM)-import Control.Monad.Codensity (lowerCodensity)-import Control.Monad.IO.Class (MonadIO, liftIO)-import Control.Monad.Trans.Class (lift)-import Criterion.Main+import Control.Monad.IO.Class (liftIO)+import Gauge.Main import Data.Conduit-import Data.Conduit.Internal (ConduitM (..), Pipe (..)) import qualified Data.Conduit.Internal as CI import qualified Data.Conduit.List as CL import qualified Data.Foldable as F-import Data.Functor.Identity (runIdentity) import Data.IORef import Data.List (foldl') import Data.Monoid (mempty)@@ -96,15 +92,15 @@ , TBPure "unboxed vectors" upper0 expected $ \upper -> VU.foldl' (+) 0 (VU.enumFromTo 1 upper) , TBPure "conduit, pure, fold" upper0 expected- $ \upper -> runIdentity $ CL.enumFromTo 1 upper $$ CL.fold (+) 0+ $ \upper -> runConduitPure $ CL.enumFromTo 1 upper .| CL.fold (+) 0 , TBPure "conduit, pure, foldM" upper0 expected- $ \upper -> runIdentity $ CL.enumFromTo 1 upper $$ CL.foldM plusM 0+ $ \upper -> runConduitPure $ CL.enumFromTo 1 upper .| CL.foldM plusM 0 , TBIO "conduit, IO, fold" expected $ do upper <- readIORef upperRef- CL.enumFromTo 1 upper $$ CL.fold (+) 0+ runConduit $ CL.enumFromTo 1 upper .| CL.fold (+) 0 , TBIO "conduit, IO, foldM" expected $ do upper <- readIORef upperRef- CL.enumFromTo 1 upper $$ CL.foldM plusM 0+ runConduit $ CL.enumFromTo 1 upper .| CL.foldM plusM 0 ] where upper0 = 10000 :: Int@@ -126,26 +122,11 @@ $ VU.map (+ 1) $ VU.map (* 2) $ VU.enumFromTo 1 upper- , TBPure "conduit, connect1" upper0 expected $ \upper -> runIdentity- $ CL.enumFromTo 1 upper- $$ CL.map (* 2)- =$= CL.map (+ 1)- =$= CL.fold (+) 0- , TBPure "conduit, connect2" upper0 expected $ \upper -> runIdentity- $ CL.enumFromTo 1 upper- =$= CL.map (* 2)- $$ CL.map (+ 1)- =$= CL.fold (+) 0- , TBPure "conduit, connect3" upper0 expected $ \upper -> runIdentity- $ CL.enumFromTo 1 upper- =$= CL.map (* 2)- =$= CL.map (+ 1)- $$ CL.fold (+) 0- , TBPure "conduit, inner fuse" upper0 expected $ \upper -> runIdentity+ , TBPure "conduit, connect1" upper0 expected $ \upper -> runConduitPure $ CL.enumFromTo 1 upper- =$= (CL.map (* 2)- =$= CL.map (+ 1))- $$ CL.fold (+) 0+ .| CL.map (* 2)+ .| CL.map (+ 1)+ .| CL.fold (+) 0 ] where upper0 = 10000 :: Int@@ -157,8 +138,9 @@ monteCarloTB = return $ TBGroup "monte carlo" [ TBIOTest "conduit" closeEnough $ do gen <- MWC.createSystemRandom- successes <- CL.replicateM count (MWC.uniform gen)- $$ CL.fold (\t (x, y) ->+ 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)@@ -290,9 +272,10 @@ swConduitSeq window upperRef t0 f final = do upper <- readIORef upperRef - t <- CL.enumFromTo 1 upper- $= slidingWindowC window- $$ CL.fold f t0+ t <- runConduit+ $ CL.enumFromTo 1 upper+ .| slidingWindowC window+ .| CL.fold f t0 return $! final t swConduitVector :: V.Vector v Int@@ -305,19 +288,20 @@ swConduitVector window upperRef t0 f final = do upper <- readIORef upperRef - t <- CL.enumFromTo 1 upper- $= slidingVectorC window- $$ CL.fold f t0+ t <- runConduit+ $ CL.enumFromTo 1 upper+ .| slidingVectorC window+ .| CL.fold f t0 return $! final t -slidingWindowC :: Monad m => Int -> Conduit a m (Seq.Seq a)+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 -> Conduit a m (Seq.Seq a)+slidingWindowCC :: Monad m => Int -> ConduitT a (Seq.Seq a) m () slidingWindowCC sz = go sz mempty where@@ -356,14 +340,14 @@ in CI.Emit (Right (s', st')) st' {-# INLINE slidingWindowS #-} -slidingVectorC :: V.Vector v a => Int -> Conduit a IO (v a)+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 -> Conduit a IO (v a)+slidingVectorCC :: V.Vector v a => Int -> ConduitT a (v a) IO () slidingVectorCC sz = do mv <- newBuf mv2 <- newBuf
benchmarks/unfused.hs view
@@ -2,12 +2,10 @@ -- Compare low-level, fused, unfused, and partially fused import Data.Conduit import qualified Data.Conduit.List as CL-import Data.Conduit.Internal (Step (..), Stream (..), unstream, StreamConduit (..))-import Criterion.Main-import Data.Functor.Identity (runIdentity)+import Gauge.Main -- | unfused-enumFromToC :: (Eq a, Monad m, Enum a) => a -> a -> Producer m a+enumFromToC :: (Eq a, Monad m, Enum a) => a -> a -> ConduitT i a m () enumFromToC x0 y = loop x0 where@@ -17,12 +15,12 @@ {-# INLINE enumFromToC #-} -- | unfused-mapC :: Monad m => (a -> b) -> Conduit a m b+mapC :: Monad m => (a -> b) -> ConduitT a b m () mapC f = awaitForever $ yield . f {-# INLINE mapC #-} -- | unfused-foldC :: Monad m => (b -> a -> b) -> b -> Consumer a m b+foldC :: Monad m => (b -> a -> b) -> b -> ConduitT a o m b foldC f = loop where@@ -37,44 +35,43 @@ | otherwise = loop (x + 1) (t + ((x * 2) + 1)) in loop 1 0 , bench "completely fused" $ flip whnf upper0 $ \upper ->- runIdentity+ runConduitPure $ CL.enumFromTo 1 upper- $$ CL.map (* 2)- =$ CL.map (+ 1)- =$ CL.fold (+) 0+ .| CL.map (* 2)+ .| CL.map (+ 1)+ .| CL.fold (+) 0 , bench "runConduit, completely fused" $ flip whnf upper0 $ \upper ->- runIdentity- $ runConduit- $ CL.enumFromTo 1 upper- =$= CL.map (* 2)- =$= CL.map (+ 1)- =$= CL.fold (+) 0+ runConduitPure+ $ CL.enumFromTo 1 upper+ .| CL.map (* 2)+ .| CL.map (+ 1)+ .| CL.fold (+) 0 , bench "completely unfused" $ flip whnf upper0 $ \upper ->- runIdentity+ runConduitPure $ enumFromToC 1 upper- $$ mapC (* 2)- =$ mapC (+ 1)- =$ foldC (+) 0+ .| mapC (* 2)+ .| mapC (+ 1)+ .| foldC (+) 0 , bench "beginning fusion" $ flip whnf upper0 $ \upper ->- runIdentity- $ (CL.enumFromTo 1 upper $= CL.map (* 2))- $$ mapC (+ 1)- =$ foldC (+) 0+ runConduitPure+ $ (CL.enumFromTo 1 upper .| CL.map (* 2))+ .| mapC (+ 1)+ .| foldC (+) 0 , bench "middle fusion" $ flip whnf upper0 $ \upper ->- runIdentity+ runConduitPure $ enumFromToC 1 upper- $$ (CL.map (* 2) =$= CL.map (+ 1))- =$ foldC (+) 0+ .| (CL.map (* 2) .| CL.map (+ 1))+ .| foldC (+) 0 , bench "ending fusion" $ flip whnf upper0 $ \upper ->- runIdentity+ runConduitPure $ enumFromToC 1 upper- $= mapC (* 2)- $$ (CL.map (+ 1) =$ CL.fold (+) 0)+ .| mapC (* 2)+ .| (CL.map (+ 1) .| CL.fold (+) 0) , bench "performance of CL.enumFromTo without fusion" $ flip whnf upper0 $ \upper ->- runIdentity+ runConduitPure $ CL.enumFromTo 1 upper- $= mapC (* 2)- $$ (CL.map (+ 1) =$ CL.fold (+) 0)+ .| mapC (* 2)+ .| (CL.map (+ 1) .| CL.fold (+) 0) ] where upper0 = 100000 :: Int
conduit.cabal view
@@ -1,5 +1,5 @@ Name: conduit-Version: 1.2.13.1+Version: 1.3.6.1 Synopsis: Streaming data processing library. description: `conduit` is a solution to the streaming data problem, allowing for production,@@ -17,45 +17,64 @@ 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+ , 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 Data.Conduit.Internal.Fusion Data.Conduit.Internal.List.Stream+ Data.Conduit.Combinators.Stream+ Conduit other-modules: Data.Conduit.Internal.Pipe Data.Conduit.Internal.Conduit- Build-depends: base >= 4.5 && < 5- , resourcet >= 1.1 && < 1.2- , exceptions >= 0.6- , lifted-base >= 0.1- , transformers-base >= 0.4.1 && < 0.5- , transformers >= 0.2.2- , transformers-compat >= 0.3+ 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- , mmorph- , monad-control , primitive- if !impl(ghc>=7.9)- build-depends: void >= 0.5.5- if !impl(ghc>=7.11)- build-depends: semigroups >= 0.16+ , unliftio-core+ , exceptions+ , mono-traversable >= 1.0.7+ , vector+ , bytestring+ , text+ , filepath+ , directory++ if os(windows)+ build-depends: Win32+ other-modules: System.Win32File+ cpp-options: -DWINDOWS+ else+ build-depends: unix+ ghc-options: -Wall include-dirs: . -test-suite test+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@@ -69,12 +88,19 @@ , exceptions >= 0.6 , safe , split >= 0.2.0.0- if !impl(ghc>=7.9)- build-depends: void- if !impl(ghc>=7.11)- build-depends: semigroups >= 0.16+ , 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@@ -94,6 +120,7 @@ -- 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@@ -104,17 +131,17 @@ , transformers , hspec , mwc-random- , criterion- , kan-extensions+ , 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- , criterion+ , gauge , transformers main-is: unfused.hs ghc-options: -Wall -O2 -rtsopts
+ 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
@@ -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,7 +22,7 @@ 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]@@ -30,5 +30,5 @@ conduit2 = CL.map id conduit = getZipConduit $ ZipConduit conduit1 <* ZipConduit conduit2 sink = CL.consume- res <- src $$ conduit =$ sink+ res <- runConduit $ src .| conduit .| sink res `shouldBe` [2, 1, 3, 2, 4, 3]
test/Data/Conduit/StreamSpec.hs view
@@ -146,19 +146,19 @@ Prelude.map f qit "mapM" $ \(getBlind -> (f :: Int -> M Int)) ->- mapM f `checkConduitM`+ mapM f `checkConduitT` Prelude.mapM f qit "mapMS" $ \(getBlind -> (f :: Int -> M Int)) ->- mapMS f `checkStreamConduitM`+ mapMS f `checkStreamConduitT` Prelude.mapM f qit "iterM" $ \(getBlind -> (f :: Int -> M ())) ->- iterM f `checkConduitM`+ iterM f `checkConduitT` iterML f qit "iterMS" $ \(getBlind -> (f :: Int -> M ())) ->- iterMS f `checkStreamConduitM`+ iterMS f `checkStreamConduitT` iterML f qit "mapMaybe" $ \(getBlind -> (f :: Int -> Maybe Int)) ->@@ -170,11 +170,11 @@ Data.Maybe.mapMaybe f qit "mapMaybeM" $ \(getBlind -> (f :: Int -> M (Maybe Int))) ->- mapMaybeM f `checkConduitM`+ mapMaybeM f `checkConduitT` mapMaybeML f qit "mapMaybeMS" $ \(getBlind -> (f :: Int -> M (Maybe Int))) ->- mapMaybeMS f `checkStreamConduitM`+ mapMaybeMS f `checkStreamConduitT` mapMaybeML f qit "catMaybes" $ \() ->@@ -202,11 +202,11 @@ (Prelude.concatMap f :: [Int] -> [Int]) qit "concatMapM" $ \(getBlind -> (f :: Int -> M [Int])) ->- concatMapM f `checkConduitM`+ concatMapM f `checkConduitT` concatMapML f qit "concatMapMS" $ \(getBlind -> (f :: Int -> M [Int])) ->- concatMapMS f `checkStreamConduitM`+ concatMapMS f `checkStreamConduitT` concatMapML f qit "concatMapAccum" $ \(getBlind -> (f :: Int -> Int -> (Int, [Int])), initial :: Int) ->@@ -250,11 +250,11 @@ mapFoldableL f qit "mapFoldableM" $ \(getBlind -> (f :: Int -> M [Int])) ->- mapFoldableM f `checkConduitM`+ mapFoldableM f `checkConduitT` mapFoldableML f qit "mapFoldableMS" $ \(getBlind -> (f :: Int -> M [Int])) ->- mapFoldableMS f `checkStreamConduitM`+ mapFoldableMS f `checkStreamConduitT` mapFoldableML f qit "consume" $ \() ->@@ -312,67 +312,67 @@ -------------------------------------------------------------------------------- -- Quickcheck utilities for pure conduits / streams -checkProducer :: (Show a, Eq a) => Source Identity a -> [a] -> Property+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 :: (Show a, Eq a) => StreamConduitT () a Identity () -> [a] -> Property checkStreamProducer s l = checkStreamProducerM' runIdentity s (return l) -checkInfiniteProducer :: (Show a, Eq a) => Source Identity a -> [a] -> Property+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 :: (Show a, Eq a) => StreamConduitT () a Identity () -> [a] -> Property checkInfiniteStreamProducer s l = checkInfiniteStreamProducerM' runIdentity s (return l) -checkConsumer :: (Show b, Eq b) => Consumer Int Identity b -> ([Int] -> b) -> Property+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) => Conduit a Identity b -> ([a] -> [b]) -> Property-checkConduit c l = checkConduitM' 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 = checkStreamConduitM' 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) => ConduitM a b Identity r -> ([a] -> ([b], r)) -> Property+-- 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) => StreamConduitM a b Identity r -> ([a] -> ([b], r)) -> Property+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) => Source M a -> M [a] -> Property+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) => Source M a -> M [a] -> Property+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) => Consumer Int M b -> ([Int] -> M b) -> Property+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 -checkConduitM :: (Show a, Arbitrary a, Show b, Eq b) => Conduit a M b -> ([a] -> M [b]) -> Property-checkConduitM = checkConduitM' runM+checkConduitT :: (Show a, Arbitrary a, Show b, Eq b) => ConduitT a b M () -> ([a] -> M [b]) -> Property+checkConduitT = checkConduitT' runM -checkStreamConduitM :: (Show a, Arbitrary a, Show b, Eq b) => StreamConduit a M b -> ([a] -> M [b]) -> Property-checkStreamConduitM = checkStreamConduitM' 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) => ConduitM a b M r -> ([a] -> M ([b], r)) -> Property+-- 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) => StreamConduitM a b M r -> ([a] -> M ([b], r)) -> Property+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 --------------------------------------------------------------------------------@@ -381,11 +381,11 @@ checkProducerM' :: (Show a, Monad m, Show b, Eq b) => (m [a] -> b)- -> Source m a+ -> ConduitT () a m () -> m [a] -> Property checkProducerM' f c l =- f (preventFusion c $$ consume)+ f (runConduit (preventFusion c .| consume)) === f l @@ -401,12 +401,12 @@ checkInfiniteProducerM' :: (Show a, Monad m, Show b, Eq b) => (m [a] -> b)- -> Source m a+ -> ConduitT () a m () -> m [a] -> Property checkInfiniteProducerM' f s l = checkProducerM' f- (preventFusion s $= isolate 10)+ (preventFusion s .| isolate 10) (liftM (Prelude.take 10) l) checkInfiniteStreamProducerM' :: (Show a, Monad m, Show b, Eq b)@@ -421,11 +421,11 @@ checkConsumerM' :: (Show a, Monad m, Show b, Eq b) => (m a -> b)- -> Consumer Int m a+ -> ConduitT Int Void m a -> ([Int] -> m a) -> Property checkConsumerM' f c l = forAll arbitrary $ \xs ->- f (sourceList xs $$ preventFusion c)+ f (runConduit (sourceList xs .| preventFusion c)) === f (l xs) @@ -439,22 +439,22 @@ === f (l xs) -checkConduitM' :: (Show a, Arbitrary a, Monad m, Show c, Eq c)+checkConduitT' :: (Show a, Arbitrary a, Monad m, Show c, Eq c) => (m [b] -> c)- -> Conduit a m b+ -> ConduitT a b m () -> ([a] -> m [b]) -> Property-checkConduitM' f c l = forAll arbitrary $ \xs ->- f (sourceList xs $= preventFusion c $$ consume)+checkConduitT' f c l = forAll arbitrary $ \xs ->+ f (runConduit (sourceList xs .| preventFusion c .| consume)) === f (l xs) -checkStreamConduitM' :: (Show a, Arbitrary a, Monad m, Show c, Eq c)+checkStreamConduitT' :: (Show a, Arbitrary a, Monad m, Show c, Eq c) => (m [b] -> c) -> StreamConduit a m b -> ([a] -> m [b]) -> Property-checkStreamConduitM' f s l = forAll arbitrary $ \xs ->+checkStreamConduitT' f s l = forAll arbitrary $ \xs -> f (liftM fst $ evalStream $ s $ sourceListS xs emptyStream) === f (l xs)@@ -464,17 +464,17 @@ -- -- checkConduitResultM' :: (Show a, Arbitrary a, Monad m, Show c, Eq c) -- => (m ([b], r) -> c)--- -> ConduitM a b m r+-- -> 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 (sourceList xs .| preventFusion c $$ consume) -- === -- f (l xs) checkStreamConduitResultM' :: (Show a, Arbitrary a, Monad m, Show c, Eq c) => (m ([b], r) -> c)- -> StreamConduitM a b m r+ -> StreamConduitT a b m r -> ([a] -> m ([b], r)) -> Property checkStreamConduitResultM' f s l = forAll arbitrary $ \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
@@ -5,70 +5,86 @@ {-# 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.Exception (throw)-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.Monad.Trans.State (evalStateT, get, put) import qualified Control.Monad.Writer as W-import Control.Applicative (pure, (<$>), (<*>))+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@@ -119,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@@ -148,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 @@ -157,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@@ -216,127 +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.Done- CI.>+> CI.injectLeftovers (flip CI.unConduitM CI.Done $ 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" $ equivToList- (DLS.chunksOf 5 :: [Int]->[[Int]]) (CL.chunksOf 5)+ 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 - prop "chunksOf (negative)" $ equivToList- (map (:[]) :: [Int]->[[Int]]) (CL.chunksOf (-5))+ 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] @@ -348,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@@ -360,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)@@ -377,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)@@ -429,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@@ -440,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@@ -450,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@@ -461,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@@ -471,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 $ \rest -> CI.Leftover (rest ()) 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 []@@ -494,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@@ -518,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) @@ -536,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 $ flip CI.unConduitM CI.Done $ CL.fold (+) 0) CI.>+> CI.idP- y <- CI.runPipe $ mapM_ CI.yield [1..10 :: Int] CI.>+> (CI.injectLeftovers $ flip CI.unConduitM CI.Done $ 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@@ -570,122 +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] prop "replicate" $ \cnt' -> do let cnt = min cnt' 100- res <- CL.replicate cnt () C.$$ CL.consume+ res <- runConduit $ CL.replicate cnt () .| CL.consume res `shouldBe` replicate cnt () prop "replicateM" $ \cnt' -> do ref <- I.newIORef 0 let cnt = min cnt' 100- res <- CL.replicateM cnt (I.modifyIORef ref (+ 1)) C.$$ CL.consume+ res <- runConduit $ CL.replicateM cnt (I.modifyIORef ref (+ 1)) .| CL.consume res `shouldBe` replicate cnt () ref' <- I.readIORef ref ref' `shouldBe` (if cnt' <= 0 then 0 else cnt) - 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 ()-- x2 <- I.readIORef ref- x2 `shouldBe` 0-- final-- x3 <- I.readIORef ref- x3 `shouldBe` 1 describe "injectLeftovers" $ do it "works" $ do let src = mapM_ CI.yield [1..10 :: Int]- conduit = CI.injectLeftovers $ flip CI.unConduitM CI.Done $ 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 ()@@ -702,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])@@ -718,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)@@ -732,109 +682,34 @@ 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 :: C.Source IO String+ let src :: ConduitT () String IO () src = CL.sourceList ["A", "B", "C"]- withIndex :: C.Conduit String IO (Integer, String)+ withIndex :: ConduitT String (Integer, String) IO () withIndex = CI.mergeSource (CL.sourceList [1..])- output <- src C.$= withIndex C.$$ CL.consume+ 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 :: C.Source IO Integer+ let src :: ConduitT () Integer IO () src = CL.sourceList [1..]- withShortAlphaIndex :: C.Conduit Integer IO (String, Integer)+ withShortAlphaIndex :: ConduitT Integer (String, Integer) IO () withShortAlphaIndex = CI.mergeSource (CL.sourceList ["A", "B", "C"])- output <- src C.$= withShortAlphaIndex C.$$ CL.consume- output `shouldBe` [("A", 1), ("B", 2), ("C", 3)]-- let modFlag ref cur next = do- prev <- I.atomicModifyIORef ref $ (,) next- prev `shouldBe` cur- flagShouldBe ref expect = do- cur <- I.readIORef ref- cur `shouldBe` expect- it "properly run the finalizer - When the main Conduit is fully consumed" $ do- called <- I.newIORef ("RawC" :: String)- let src :: MonadIO m => C.Source m String- src = CL.sourceList ["A", "B", "C"]- withIndex :: MonadIO m => C.Conduit String m (Integer, String)- withIndex = C.addCleanup (\f -> liftIO $ modFlag called "AllocC-3" ("FinalC:" ++ show f)) . CI.mergeSource $ do- liftIO $ modFlag called "RawC" "AllocC-1"- C.yield 1- liftIO $ modFlag called "AllocC-1" "AllocC-2"- C.yield 2- liftIO $ modFlag called "AllocC-2" "AllocC-3"- C.yield 3- liftIO $ modFlag called "AllocC-3" "AllocC-4"- C.yield 4- output <- src C.$= withIndex C.$$ CL.consume- output `shouldBe` [(1, "A"), (2, "B"), (3, "C")]- called `flagShouldBe` "FinalC:True"- it "properly run the finalizer - When the branch Source is fully consumed" $ do- called <- I.newIORef ("RawS" :: String)- let src :: MonadIO m => C.Source m Integer- src = CL.sourceList [1..]- withIndex :: MonadIO m => C.Conduit Integer m (String, Integer)- withIndex = C.addCleanup (\f -> liftIO $ modFlag called "AllocS-C" ("FinalS:" ++ show f)) . CI.mergeSource $ do- liftIO $ modFlag called "RawS" "AllocS-A"- C.yield "A"- liftIO $ modFlag called "AllocS-A" "AllocS-B"- C.yield "B"- liftIO $ modFlag called "AllocS-B" "AllocS-C"- C.yield "C"- output <- src C.$= withIndex C.$$ CL.consume+ output <- runConduit $ src .| withShortAlphaIndex .| CL.consume output `shouldBe` [("A", 1), ("B", 2), ("C", 3)]- called `flagShouldBe` "FinalS:True"- it "properly DO NOT run the finalizer - When nothing consumed" $ do- called <- I.newIORef ("Raw0" :: String)- let src :: MonadIO m => C.Source m String- src = CL.sourceList ["A", "B", "C"]- withIndex :: MonadIO m => C.Conduit String m (Integer, String)- withIndex = C.addCleanup (\f -> liftIO $ modFlag called "WONT CALLED" ("Final0:" ++ show f)) . CI.mergeSource $ do- liftIO $ modFlag called "Raw0" "Alloc0-1"- C.yield 1- output <- src C.$= withIndex C.$$ return ()- output `shouldBe` ()- called `flagShouldBe` "Raw0"- it "properly run the finalizer - When only one item consumed" $ do- called <- I.newIORef ("Raw1" :: String)- let src :: MonadIO m => C.Source m Integer- src = CL.sourceList [1..]- withIndex :: MonadIO m => C.Conduit Integer m (String, Integer)- withIndex = C.addCleanup (\f -> liftIO $ modFlag called "Alloc1-A" ("Final1:" ++ show f)) . CI.mergeSource $ do- liftIO $ modFlag called "Raw1" "Alloc1-A"- C.yield "A"- liftIO $ modFlag called "Alloc1-A" "Alloc1-B"- C.yield "B"- liftIO $ modFlag called "Alloc1-B" "Alloc1-C"- C.yield "C"- output <- src C.$= withIndex C.$= CL.isolate 1 C.$$ CL.consume- output `shouldBe` [("A", 1)]- called `flagShouldBe` "Final1:False"-- it "handles finalizers" $ do- ref <- I.newIORef (0 :: Int)- let src1 = C.addCleanup- (const $ I.modifyIORef ref (+1))- (mapM_ C.yield [1 :: Int ..])- src2 = mapM_ C.yield ("hi" :: String)- res1 <- src1 C.$$ C.mergeSource src2 C.=$ CL.consume- res1 `shouldBe` [('h', 1), ('i', 2)]- i1 <- I.readIORef ref- i1 `shouldBe` 1-- res2 <- src2 C.$$ C.mergeSource src1 C.=$ CL.consume- res2 `shouldBe` [(1, 'h'), (2, 'i')]- i2 <- I.readIORef ref- i2 `shouldBe` 2+ 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@@ -842,7 +717,7 @@ 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@@ -851,7 +726,7 @@ 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) @@ -859,7 +734,7 @@ ref <- I.newIORef (-1 :: Int) let sink = CL.mapM_ (I.writeIORef ref) conduit = C.passthroughSink sink (const (return ()))- res <- mapM_ C.yield [1..] C.$$ conduit C.=$ CL.take 5+ res <- runConduit $ mapM_ C.yield [1..] .| conduit .| CL.take 5 res `shouldBe` [1..5] x <- I.readIORef ref x `shouldBe` 5@@ -876,131 +751,32 @@ lift $ return () C.yield 3 lift $ return ()- (src C.$$ CL.consume) `shouldBe` Right [1, 2, 4 :: Int]+ 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 (C.runConduit writer) `shouldBe` [2, 1]-- 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"+ 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@@ -1009,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@@ -1022,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)]@@ -1030,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]@@ -1040,16 +816,16 @@ 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)@@ -1057,22 +833,22 @@ it "fuseBothMaybe with no result" $ do let src = mapM_ C.yield [1 :: Int ..]- sink = CL.isolate 5 C.=$= CL.fold (+) 0- (mup, down) <- C.runConduit $ C.fuseBothMaybe src sink+ 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 C.=$= CL.fold (+) 0- (mup, down) <- C.runConduit $ C.fuseBothMaybe src sink+ 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 C.=$= CL.fold (+) 0- (mup, down) <- C.runConduit $ C.fuseBothMaybe src sink+ sink = CL.isolate 5 .| CL.fold (+) 0+ (mup, down) <- runConduit $ C.fuseBothMaybe src sink mup `shouldBe` (Nothing :: Maybe ()) down `shouldBe` sum [1..5] @@ -1083,8 +859,8 @@ () <- 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@@ -1104,5 +880,4 @@ data DummyError = DummyError deriving (Show, Eq, Typeable)-instance Error DummyError instance Catch.Exception DummyError
+ test/subdir/dummyfile.txt view