packages feed

conduit 0.2.2 → 1.3.6.1

raw patch · 44 files changed

Files

+ ChangeLog.md view
@@ -0,0 +1,181 @@+# ChangeLog for conduit++## 1.3.6.1++* Forward compatibility with `-Wnoncanonical-monad-instances` becoming an error++## 1.3.6++* Avoid dropping upstream items in `mergeSource` [#513](https://github.com/snoyberg/conduit/pull/513)++## 1.3.5++* Add `groupOn`++## 1.3.4.3++* Fix space leak in `*>` [#496](https://github.com/snoyberg/conduit/issues/496) [#497](https://github.com/snoyberg/conduit/pull/497)++## 1.3.4.2++* Fix GHC 9.2 build [#473](https://github.com/snoyberg/conduit/pull/473)++## 1.3.4.1++* Library and tests compile and run with GHC 9.0.1 [#455](https://github.com/snoyberg/conduit/pull/455)++## 1.3.4++* Add `foldWhile` [#453](https://github.com/snoyberg/conduit/issues/453) [#456](https://github.com/snoyberg/conduit/pull/456).++## 1.3.3++* Add `uncons`, `unconsM`, `unconsEither`, `unconsEitherM`.++## 1.3.2.1++* Fix isChunksForExactlyE [#445](https://github.com/snoyberg/conduit/issues/445) [#446](https://github.com/snoyberg/conduit/pull/446)++## 1.3.2++* Add `mapInputM` [#435](https://github.com/snoyberg/conduit/pull/435)++## 1.3.1.2++* More eagerly emit groups in `chunksOf` [#427](https://github.com/snoyberg/conduit/pull/427)++## 1.3.1.1++* Use lower-case imports (better for cross-compilation) [#408](https://github.com/snoyberg/conduit/pull/408)++## 1.3.1++* Add `MonadFail` instance for `ConduitT`.++## 1.3.0.3++* Improve fusion framework rewrite rules++## 1.3.0.2++* Replace `ReadMode` with `WriteMode` in `withSinkFile`++## 1.3.0.1++* Test suite compatibility with GHC 8.4.1 [#358](https://github.com/snoyberg/conduit/issues/358)++## 1.3.0++* Drop monad-control and exceptions in favor of unliftio+* Drop mmorph dependency+* Deprecate old type synonyms and operators+* Drop finalizers from the library entirely+    * Much simpler+    * Less guarantees about prompt finalization+    * No more `yieldOr`, `addCleanup`+    * Replace the `Resumable` types with `SealedConduitT`+* Add the `Conduit` and `Data.Conduit.Combinators` modules, stolen from+  `conduit-combinators`++## 1.2.13++* Add `Semigroup` instances [#345](https://github.com/snoyberg/conduit/pull/345)++## 1.2.12.1++* Fix `pass` in `ConduitM` `MonadWriter` instance++## 1.2.12++* Add `exceptC`, `runExceptC` and `catchExceptC` to `Data.Conduit.Lift`++## 1.2.11++* Add `unfoldEither` and `unfoldEitherM` to `Data.Conduit.List`++## 1.2.10++* Add `PrimMonad` instances for `ConduitM` and `Pipe`+  [#306](https://github.com/snoyberg/conduit/pull/306)++## 1.2.9.1++* Ensure downstream and inner sink receive same inputs in+  `passthroughSink`+  [#304](https://github.com/snoyberg/conduit/issues/304)++## 1.2.9++* `chunksOf` [#296](https://github.com/snoyberg/conduit/pull/296)++## 1.2.8++* Implement+  [the reskinning idea](http://www.snoyman.com/blog/2016/09/proposed-conduit-reskin):+    * `.|`+    * `runConduitPure`+    * `runConduitRes`++## 1.2.7++* Expose yieldM for ConduitM [#270](https://github.com/snoyberg/conduit/pull/270)++## 1.2.6.6++* Fix test suite compilation on older GHCs++## 1.2.6.5++* In zipConduitApp, left bias not respected mixing monadic and non-monadic conduits [#263](https://github.com/snoyberg/conduit/pull/263)++## 1.2.6.4++* Fix benchmark by adding a type signature++## 1.2.6.3++* Doc updates++## 1.2.6.2++* resourcet cannot be built with GHC 8 [#242](https://github.com/snoyberg/conduit/issues/242)+* Remove upper bound on transformers [#253](https://github.com/snoyberg/conduit/issues/253)++## 1.2.6++* `sourceToList`+* Canonicalise Monad instances [#237](https://github.com/snoyberg/conduit/pull/237)++## 1.2.5++* mapAccum and mapAccumM should be strict in their state [#218](https://github.com/snoyberg/conduit/issues/218)++## 1.2.4.1++* Some documentation improvements++## 1.2.4++* [fuseBothMaybe](https://github.com/snoyberg/conduit/issues/199)++__1.2.3__ Expose `connect` and `fuse` as synonyms for `$$` and `=$=`, respectively.++__1.2.2__ Lots more stream fusion.++__1.2__ Two performance optimizations added. (1) A stream fusion framework. This is a non-breaking change. (2) Codensity transform applied to the `ConduitM` datatype. This only affects users importing the `.Internal` module. Both changes are thoroughly described in the following to blog posts: [Speeding up conduit](https://www.fpcomplete.com/blog/2014/08/iap-speeding-up-conduit), and [conduit stream fusion](https://www.fpcomplete.com/blog/2014/08/conduit-stream-fusion).++__1.1__ Refactoring into conduit and conduit-extra packages. Core functionality is now in conduit, whereas most common helper modules (including Text, Binary, Zlib, etc) are in conduit-extra. To upgrade to this version, there should only be import list and conduit file changes necessary.++__1.0__ Simplified the user-facing interface back to the Source, Sink, and Conduit types, with Producer and Consumer for generic code. Error messages have been simplified, and optional leftovers and upstream terminators have been removed from the external API. Some long-deprecated functions were finally removed.++__0.5__ The internals of the package are now separated to the .Internal module, leaving only the higher-level interface in the advertised API. Internally, switched to a `Leftover` constructor and slightly tweaked the finalization semantics.++__0.4__ Inspired by the design of the pipes package: we now have a single unified type underlying `Source`, `Sink`, and `Conduit`. This type is named `Pipe`. There are type synonyms provided for the other three types. Additionally, `BufferedSource` is no longer provided. Instead, the connect-and-resume operator, `$$+`, can be used for the same purpose.++__0.3__ ResourceT has been greatly simplified, specialized for IO, and moved into a separate package. Instead of hard-coding ResourceT into the conduit datatypes, they can now live around any monad. The Conduit datatype has been enhanced to better allow generation of streaming output. The SourceResult, SinkResult, and ConduitResult datatypes have been removed entirely.++__0.2__ Instead of storing state in mutable variables, we now use CPS. A `Source` returns the next `Source`, and likewise for `Sink`s and `Conduit`s. Not only does this take better advantage of GHC\'s optimizations (about a 20% speedup), but it allows some operations to have a reduction in algorithmic complexity from exponential to linear. This also allowed us to remove the `Prepared` set of types. Also, the `State` functions (e.g., `sinkState`) use better constructors for return types, avoiding the need for a dummy state on completion.++__0.1__ `BufferedSource` is now an abstract type, and has a much more efficient internal representation. The result was a 41% speedup on microbenchmarks (note: do not expect speedups anywhere near that in real usage). In general, we are moving towards `BufferedSource` being a specific tool used internally as needed, but using `Source` for all external APIs.++__0.0__ Initial release.
− Control/Monad/Trans/Resource.hs 
@@ -1,558 +0,0 @@-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE UndecidableInstances #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE RankNTypes #-}-{-# LANGUAGE CPP #-}-{-# LANGUAGE DeriveDataTypeable #-}--- | Allocate resources which are guaranteed to be released.------ For more information, see <http://www.yesodweb.com/blog/2011/12/resourcet>.------ One point to note: all register cleanup actions live in the base monad, not--- the main monad. This allows both more efficient code, and for monads to be--- transformed.-module Control.Monad.Trans.Resource-    ( -- * Data types-      ResourceT-    , ReleaseKey-      -- * Unwrap-    , runResourceT-      -- * Resource allocation-    , with-    , withIO-    , register-    , release-      -- * Use references-    , readRef-    , writeRef-    , newRef-      -- * Special actions-    , resourceForkIO-      -- * Monad transformation-    , transResourceT-      -- * A specific Exception transformer-    , ExceptionT (..)-    , runExceptionT_-      -- * Type class/associated types-    , Resource (..)-    , ResourceUnsafeIO (..)-    , ResourceIO-    , ResourceBaseIO (..)-    , ResourceThrow (..)-      -- ** Low-level-    , HasRef (..)-    , InvalidAccess (..)-    , resourceActive-    ) where--import Data.Typeable-import Data.IntMap (IntMap)-import qualified Data.IntMap as IntMap-import Control.Exception (SomeException, throw, Exception)-import Control.Monad.Trans.Control-    ( MonadTransControl (..), MonadBaseControl (..)-    , ComposeSt, defaultLiftBaseWith, defaultRestoreM-    , liftBaseDiscard-    )-import qualified Data.IORef as I-import Control.Monad.Base (MonadBase, liftBase)-import Control.Applicative (Applicative (..))-import Control.Monad.Trans.Class (MonadTrans (..))-import Control.Monad.IO.Class (MonadIO (..))-import Control.Monad (liftM)-import qualified Control.Exception as E-import Control.Monad.ST (ST, unsafeIOToST)-import qualified Control.Monad.ST.Lazy as Lazy-import qualified Data.STRef as S-import qualified Data.STRef.Lazy as SL-import Data.Monoid (Monoid)-import qualified Control.Exception.Lifted as L--import Control.Monad.Trans.Identity ( IdentityT)-import Control.Monad.Trans.List     ( ListT    )-import Control.Monad.Trans.Maybe    ( MaybeT   )-import Control.Monad.Trans.Error    ( ErrorT, Error)-import Control.Monad.Trans.Reader   ( ReaderT  )-import Control.Monad.Trans.State    ( StateT   )-import Control.Monad.Trans.Writer   ( WriterT  )-import Control.Monad.Trans.RWS      ( RWST     )--import Data.Word (Word)--import qualified Control.Monad.Trans.RWS.Strict    as Strict ( RWST   )-import qualified Control.Monad.Trans.State.Strict  as Strict ( StateT )-import qualified Control.Monad.Trans.Writer.Strict as Strict ( WriterT )-import Control.Concurrent (ThreadId, forkIO)---- | Create a new reference.-newRef :: Resource m => a -> ResourceT m (Ref (Base m) a)-newRef = lift . resourceLiftBase . newRef'-{-# INLINE newRef #-}---- | Read a value from a reference.-readRef :: Resource m => Ref (Base m) a -> ResourceT m a-readRef = lift . resourceLiftBase . readRef'-{-# INLINE readRef #-}---- | Write a value to a reference.-writeRef :: Resource m => Ref (Base m) a -> a -> ResourceT m ()-writeRef r = lift . resourceLiftBase . writeRef' r-{-# INLINE writeRef #-}---- | A base monad which provides mutable references and some exception-safe way--- of interacting with them. For monads which cannot handle exceptions (e.g.,--- 'ST'), exceptions may be ignored. However, in such cases, scarce resources--- should /not/ be allocated in those monads, as exceptions may cause the--- cleanup functions to not run.------ The instance for 'IO', however, is fully exception-safe.------ Minimal complete definition: @Ref@, @newRef'@, @readRef'@ and @writeRef'@.-class Monad m => HasRef m where-    type Ref m :: * -> *-    newRef' :: a -> m (Ref m a)-    readRef' :: Ref m a -> m a-    writeRef' :: Ref m a -> a -> m ()--    -- | For monads supporting multi-threaded access (e.g., @IO@), this much be-    -- an atomic modification.-    atomicModifyRef' :: Ref m a -> (a -> (a, b)) -> m b-    atomicModifyRef' sa f = do-        a0 <- readRef' sa-        let (a, b) = f a0-        writeRef' sa a-        return b--    mask :: ((forall a. m a -> m a) -> m b) -> m b-    mask f = f id--    mask_ :: m a -> m a-    mask_ = mask . const--    try :: m a -> m (Either SomeException a)-    try = liftM Right--instance HasRef IO where-    type Ref IO = I.IORef-    newRef' = I.newIORef-    {-# INLINE newRef' #-}-    atomicModifyRef' = I.atomicModifyIORef-    {-# INLINE atomicModifyRef' #-}-    readRef' = I.readIORef-    {-# INLINE readRef' #-}-    writeRef' = I.writeIORef-    {-# INLINE writeRef' #-}-    mask = E.mask-    {-# INLINE mask #-}-    mask_ = E.mask_-    {-# INLINE mask_ #-}-    try = E.try-    {-# INLINE try #-}--instance HasRef (ST s) where-    type Ref (ST s) = S.STRef s-    newRef' = S.newSTRef-    readRef' = S.readSTRef-    writeRef' = S.writeSTRef--instance HasRef (Lazy.ST s) where-    type Ref (Lazy.ST s) = SL.STRef s-    newRef' = SL.newSTRef-    readRef' = SL.readSTRef-    writeRef' = SL.writeSTRef---- | A 'Monad' with a base that has mutable references, and allows some way to--- run base actions and clean up properly.-class (HasRef (Base m), Monad m) => Resource m where-    -- | The base monad for the current monad stack. This will usually be @IO@-    -- or @ST@.-    type Base m :: * -> *--    -- | Run some action in the @Base@ monad. This function corresponds to-    -- 'liftBase', but due to various type issues, we need to have our own-    -- version here.-    resourceLiftBase :: Base m a -> m a--    -- | Guarantee that some initialization and cleanup code is called before-    -- and after some action. Note that the initialization and cleanup lives in-    -- the base monad, while the body is in the top monad.-    resourceBracket_ :: Base m () -- ^ init-                     -> Base m () -- ^ cleanup-                     -> m c       -- ^ body-                     -> m c--instance Resource IO where-    type Base IO = IO-    resourceLiftBase = id-    resourceBracket_ = E.bracket_--instance Resource (ST s) where-    type Base (ST s) = ST s-    resourceLiftBase = id-    resourceBracket_ ma mb mc = do-        ma-        c <- mc-        mb-        return c--instance Resource (Lazy.ST s) where-    type Base (Lazy.ST s) = Lazy.ST s-    resourceLiftBase = id-    resourceBracket_ ma mb mc = do-        ma-        c <- mc-        mb-        return c--instance (MonadTransControl t, Resource m, Monad (t m))-        => Resource (t m) where-    type Base (t m) = Base m--    resourceLiftBase = lift . resourceLiftBase-    resourceBracket_ a b c =-        control' $ \run -> resourceBracket_ a b (run c)-      where-        control' f = liftWith f >>= restoreT . return---- | A 'Resource' based on some monad which allows running of some 'IO'--- actions, via unsafe calls. This applies to 'IO' and 'ST', for instance.-class Resource m => ResourceUnsafeIO m where-    unsafeFromIO :: IO a -> m a--instance ResourceUnsafeIO IO where-    unsafeFromIO = id--instance ResourceUnsafeIO (ST s) where-    unsafeFromIO = unsafeIOToST--instance ResourceUnsafeIO (Lazy.ST s) where-    unsafeFromIO = Lazy.unsafeIOToST--instance (MonadTransControl t, ResourceUnsafeIO m, Monad (t m)) => ResourceUnsafeIO (t m) where-    unsafeFromIO = lift . unsafeFromIO---- | A helper class for 'ResourceIO', stating that the base monad provides @IO@--- actions.-class ResourceBaseIO m where-    safeFromIOBase :: IO a -> m a--instance ResourceBaseIO IO where-    safeFromIOBase = id---- | A 'Resource' which can safely run 'IO' calls.-class (ResourceBaseIO (Base m), ResourceUnsafeIO m, ResourceThrow m,-       MonadIO m, MonadBaseControl IO m)-        => ResourceIO m--instance ResourceIO IO--instance (MonadTransControl t, ResourceIO m, Monad (t m), ResourceThrow (t m),-          MonadBaseControl IO (t m), MonadIO (t m))-        => ResourceIO (t m)---- | A lookup key for a specific release action. This value is returned by--- 'register', 'with' and 'withIO', and is passed to 'release'.-newtype ReleaseKey = ReleaseKey Int-    deriving Typeable--type RefCount = Word-type NextKey = Int--data ReleaseMap base =-    ReleaseMap !NextKey !RefCount !(IntMap (base ()))-  | ReleaseMapClosed---- | The Resource transformer. This transformer keeps track of all registered--- actions, and calls them upon exit (via 'runResourceT'). Actions may be--- registered via 'register', or resources may be allocated atomically via--- 'with' or 'withIO'. The with functions correspond closely to @bracket@.------ Releasing may be performed before exit via the 'release' function. This is a--- highly recommended optimization, as it will ensure that scarce resources are--- freed early. Note that calling @release@ will deregister the action, so that--- a release action will only ever be called once.-newtype ResourceT m a =-    ResourceT (Ref (Base m) (ReleaseMap (Base m)) -> m a)--instance Typeable1 m => Typeable1 (ResourceT m) where-    typeOf1 = goType undefined-      where-        goType :: Typeable1 m => m a -> ResourceT m a -> TypeRep-        goType m _ =-            mkTyConApp-                (mkTyCon "Control.Monad.Trans.Resource.ResourceT")-                [ typeOf1 m-                ]---- | Perform some allocation, and automatically register a cleanup action.------ If you are performing an @IO@ action, it will likely be easier to use the--- 'withIO' function, which handles types more cleanly.-with :: Resource m-     => Base m a -- ^ allocate-     -> (a -> Base m ()) -- ^ free resource-     -> ResourceT m (ReleaseKey, a)-with acquire rel = ResourceT $ \istate -> resourceLiftBase $ mask $ \restore -> do-    a <- restore acquire-    key <- register' istate $ rel a-    return (key, a)---- | Same as 'with', but explicitly uses @IO@ as a base.-withIO :: ResourceIO m-       => IO a -- ^ allocate-       -> (a -> IO ()) -- ^ free resource-       -> ResourceT m (ReleaseKey, a)-withIO acquire rel = ResourceT $ \istate -> resourceLiftBase $ mask $ \restore -> do-    a <- restore $ safeFromIOBase acquire-    key <- register' istate $ safeFromIOBase $ safeFromIOBase $ rel a-    return (key, a)---- | Register some action that will be called precisely once, either when--- 'runResourceT' is called, or when the 'ReleaseKey' is passed to 'release'.-register :: Resource m-         => Base m ()-         -> ResourceT m ReleaseKey-register rel = ResourceT $ \istate -> resourceLiftBase $ register' istate rel--register' :: HasRef base-          => Ref base (ReleaseMap base)-          -> base ()-          -> base ReleaseKey-register' istate rel = atomicModifyRef' istate $ \rm ->-    case rm of-        ReleaseMap key rf m ->-            ( ReleaseMap (key + 1) rf (IntMap.insert key rel m)-            , ReleaseKey key-            )-        ReleaseMapClosed -> throw $ InvalidAccess "register'"--data InvalidAccess = InvalidAccess { functionName :: String }-    deriving Typeable--instance Show InvalidAccess where-    show (InvalidAccess f) = concat-        [ "Control.Monad.Trans.Resource."-        , f-        , ": The mutable state is being accessed after cleanup. Please contact the maintainers."-        ]--instance Exception InvalidAccess---- | Call a release action early, and deregister it from the list of cleanup--- actions to be performed.-release :: Resource m-        => ReleaseKey-        -> ResourceT m ()-release rk = ResourceT $ \istate -> resourceLiftBase $ release' istate rk--release' :: HasRef base-         => Ref base (ReleaseMap base)-         -> ReleaseKey-         -> base ()-release' istate (ReleaseKey key) = mask $ \restore -> do-    maction <- atomicModifyRef' istate lookupAction-    maybe (return ()) restore maction-  where-    lookupAction rm@(ReleaseMap next rf m) =-        case IntMap.lookup key m of-            Nothing -> (rm, Nothing)-            Just action ->-                ( ReleaseMap next rf $ IntMap.delete key m-                , Just action-                )-    lookupAction ReleaseMapClosed = throw $ InvalidAccess "release'"--stateAlloc :: HasRef m => Ref m (ReleaseMap m) -> m ()-stateAlloc istate = do-    atomicModifyRef' istate $ \rm ->-        case rm of-            ReleaseMap nk rf m ->-                (ReleaseMap nk (rf + 1) m, ())-            ReleaseMapClosed -> throw $ InvalidAccess "stateAlloc"--stateCleanup :: HasRef m => Ref m (ReleaseMap m) -> m ()-stateCleanup istate = mask_ $ do-    mm <- atomicModifyRef' istate $ \rm ->-        case rm of-            ReleaseMap nk rf m ->-                let rf' = rf - 1-                 in if rf' == minBound-                        then (ReleaseMapClosed, Just m)-                        else (ReleaseMap nk rf' m, Nothing)-            ReleaseMapClosed -> throw $ InvalidAccess "stateCleanup"-    case mm of-        Just m ->-            mapM_ (\x -> try x >> return ()) $ IntMap.elems m-        Nothing -> return ()---- | Unwrap a 'ResourceT' transformer, and call all registered release actions.------ Note that there is some reference counting involved due to 'resourceForkIO'.--- If multiple threads are sharing the same collection of resources, only the--- last call to @runResourceT@ will deallocate the resources.-runResourceT :: Resource m => ResourceT m a -> m a-runResourceT (ResourceT r) = do-    istate <- resourceLiftBase $ newRef'-        $ ReleaseMap minBound minBound IntMap.empty-    resourceBracket_-        (stateAlloc istate)-        (stateCleanup istate)-        (r istate)---- | Transform the monad a @ResourceT@ lives in. This is most often used to--- strip or add new transformers to a stack, e.g. to run a @ReaderT@. Note that--- the original and new monad must both have the same 'Base' monad.-transResourceT :: (Base m ~ Base n)-               => (m a -> n b)-               -> ResourceT m a-               -> ResourceT n b-transResourceT f (ResourceT mx) = ResourceT (\r -> f (mx r))---------- All of our monad et al instances-instance Monad m => Functor (ResourceT m) where-    fmap f (ResourceT m) = ResourceT $ \r -> liftM f (m r)--instance Monad m => Applicative (ResourceT m) where-    pure = ResourceT . const . return-    ResourceT mf <*> ResourceT ma = ResourceT $ \r -> do-        f <- mf r-        a <- ma r-        return $ f a--instance Monad m => Monad (ResourceT m) where-    return = pure-    ResourceT ma >>= f =-        ResourceT $ \r -> ma r >>= flip un r . f-      where-        un (ResourceT x) = x--instance MonadTrans ResourceT where-    lift = ResourceT . const--instance MonadIO m => MonadIO (ResourceT m) where-    liftIO = lift . liftIO--instance MonadBase b m => MonadBase b (ResourceT m) where-    liftBase = lift . liftBase--{--instance MonadTransControl ResourceT where-    newtype StT ResourceT a = StReader {unStReader :: a}-    liftWith f = ResourceT $ \r -> f $ \(ResourceT t) -> liftM StReader $ t r-    restoreT = ResourceT . const . liftM unStReader-    {-# INLINE liftWith #-}-    {-# INLINE restoreT #-}--}--instance MonadBaseControl b m => MonadBaseControl b (ResourceT m) where-     newtype StM (ResourceT m) a = StMT (StM m a)-     liftBaseWith f = ResourceT $ \reader ->-         liftBaseWith $ \runInBase ->-             f $ liftM StMT . runInBase . (\(ResourceT r) -> r reader)-     restoreM (StMT base) = ResourceT $ const $ restoreM base---- | The express purpose of this transformer is to allow the 'ST' monad to--- catch exceptions via the 'ResourceThrow' typeclass.-newtype ExceptionT m a = ExceptionT { runExceptionT :: m (Either SomeException a) }---- | Same as 'runExceptionT', but immediately 'E.throw' any exception returned.-runExceptionT_ :: Monad m => ExceptionT m a -> m a-runExceptionT_ = liftM (either E.throw id) . runExceptionT--instance Monad m => Functor (ExceptionT m) where-    fmap f = ExceptionT . (liftM . fmap) f . runExceptionT-instance Monad m => Applicative (ExceptionT m) where-    pure = ExceptionT . return . Right-    ExceptionT mf <*> ExceptionT ma = ExceptionT $ do-        ef <- mf-        case ef of-            Left e -> return (Left e)-            Right f -> do-                ea <- ma-                case ea of-                    Left e -> return (Left e)-                    Right x -> return (Right (f x))-instance Monad m => Monad (ExceptionT m) where-    return = pure-    ExceptionT ma >>= f = ExceptionT $ do-        ea <- ma-        case ea of-            Left e -> return (Left e)-            Right a -> runExceptionT (f a)-instance MonadBase b m => MonadBase b (ExceptionT m) where-    liftBase = lift . liftBase-instance MonadTrans ExceptionT where-    lift = ExceptionT . liftM Right-instance MonadTransControl ExceptionT where-    newtype StT ExceptionT a = StExc { unStExc :: Either SomeException a }-    liftWith f = ExceptionT $ liftM return $ f $ liftM StExc . runExceptionT-    restoreT = ExceptionT . liftM unStExc-instance MonadBaseControl b m => MonadBaseControl b (ExceptionT m) where-    newtype StM (ExceptionT m) a = StE { unStE :: ComposeSt ExceptionT m a }-    liftBaseWith = defaultLiftBaseWith StE-    restoreM = defaultRestoreM unStE-instance (Resource m, MonadBaseControl (Base m) m)-        => ResourceThrow (ExceptionT m) where-    resourceThrow = ExceptionT . return . Left . E.toException---- | A 'Resource' which can throw exceptions. Note that this does not work in a--- vanilla @ST@ monad. Instead, you should use the 'ExceptionT' transformer on--- top of @ST@.-class Resource m => ResourceThrow m where-    resourceThrow :: E.Exception e => e -> m a--instance ResourceThrow IO where-    resourceThrow = E.throwIO--#define GO(T) instance (ResourceThrow m) => ResourceThrow (T m) where resourceThrow = lift . resourceThrow-#define GOX(X, T) instance (X, ResourceThrow m) => ResourceThrow (T m) where resourceThrow = lift . resourceThrow-GO(IdentityT)-GO(ListT)-GO(MaybeT)-GOX(Error e, ErrorT e)-GO(ReaderT r)-GO(StateT s)-GOX(Monoid w, WriterT w)-GOX(Monoid w, RWST r w s)-GOX(Monoid w, Strict.RWST r w s)-GO(Strict.StateT s)-GOX(Monoid w, Strict.WriterT w)-#undef GO-#undef GOX---- | Introduce a reference-counting scheme to allow a resource context to be--- shared by multiple threads. Once the last thread exits, all remaining--- resources will be released.------ Note that abuse of this function will greatly delay the deallocation of--- registered resources. This function should be used with care. A general--- guideline:------ If you are allocating a resource that should be shared by multiple threads,--- and will be held for a long time, you should allocate it at the beginning of--- a new @ResourceT@ block and then call @resourceForkIO@ from there.-resourceForkIO :: ResourceIO m => ResourceT m () -> ResourceT m ThreadId-resourceForkIO (ResourceT f) = ResourceT $ \r -> L.mask $ \restore ->-    -- We need to make sure the counter is incremented before this call-    -- returns. Otherwise, the parent thread may call runResourceT before-    -- the child thread increments, and all resources will be freed-    -- before the child gets called.-    resourceBracket_-        (stateAlloc r)-        (return ())-        (liftBaseDiscard forkIO $ resourceBracket_-            (return ())-            (stateCleanup r)-            (restore $ f r))---- | Determine if the current @ResourceT@ is still active. This is necessary--- for such cases as lazy I\/O, where an unevaluated thunk may still refer to a--- closed @ResourceT@.-resourceActive :: Resource m => ResourceT m Bool-resourceActive = ResourceT $ \rmMap -> do-    rm <- resourceLiftBase $ readRef' rmMap-    case rm of-        ReleaseMapClosed -> return False-        _ -> return True
− Data/Conduit.hs 
@@ -1,510 +0,0 @@-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE UndecidableInstances #-}-{-# LANGUAGE DeriveDataTypeable #-}--- | The main module, exporting types, utility functions, and fuse and connect--- operators.-module Data.Conduit-    ( -- * Types-      -- | The three core types to this package are 'Source' (the data-      -- producer), 'Sink' (the data consumer), and 'Conduit' (the data-      -- transformer). For all three types, a result will provide the next-      -- value to be used. For example, the @Open@ constructor includes a new-      -- @Source@ in it. This leads to the main invariant for all conduit code:-      -- these three types may /never/ be reused.  While some specific values-      -- may work fine with reuse, the result is generally unpredictable and-      -- should no be relied upon.-      ---      -- The user-facing API provided by the connect and fuse operators-      -- automatically addresses the low level details of pulling, pushing, and-      -- closing, and there should rarely be need to perform these actions in-      -- user code.--      -- ** Source-      module Data.Conduit.Types.Source-      -- *** Buffering-    , BufferedSource-    , bufferSource-    , unbufferSource-    , bsourceClose-      -- *** Unifying-    , IsSource-      -- ** Sink-    , module Data.Conduit.Types.Sink-      -- ** Conduit-    , module Data.Conduit.Types.Conduit-    , -- * Connect/fuse operators-      ($$)-    , ($=)-    , (=$)-    , (=$=)-      -- * Utility functions-      -- ** Source-    , module Data.Conduit.Util.Source-      -- ** Sink-    , module Data.Conduit.Util.Sink-      -- ** Conduit-    , module Data.Conduit.Util.Conduit-      -- * Flushing-    , Flush (..)-      -- * Convenience re-exports-    , ResourceT-    , Resource (..)-    , ResourceIO-    , ResourceUnsafeIO-    , runResourceT-    , ResourceThrow (..)-    ) where--import Control.Applicative ((<$>))-import Control.Monad (liftM)-import Control.Monad.Trans.Resource-import Data.Conduit.Types.Source-import Data.Conduit.Util.Source-import Data.Conduit.Types.Sink-import Data.Conduit.Util.Sink-import Data.Conduit.Types.Conduit-import Data.Conduit.Util.Conduit---- $typeOverview--infixr 0 $$---- | The connect operator, which pulls data from a source and pushes to a sink.--- There are three ways this process can terminate:------ 1. In the case of a @SinkNoData@ constructor, the source is not opened at--- all, and the output value is returned immediately.------ 2. The sink returns @Done@. If the input was a @BufferedSource@, any--- leftover input is put in the buffer. For a normal @Source@, the leftover--- value is discarded, and the source is closed.------ 3. The source return @Closed@, in which case the sink is closed.------ Note that this function will automatically close any @Source@s, but will not--- close any @BufferedSource@s, allowing them to be reused.------ Since 0.2.0-($$) :: (IsSource src, Resource m) => src m a -> Sink a m b -> ResourceT m b-($$) = connect-{-# INLINE ($$) #-}---- | A typeclass allowing us to unify operators for 'Source' and--- 'BufferedSource'.------ Since 0.2.0-class IsSource src where-    connect :: Resource m => src m a -> Sink a m b -> ResourceT m b-    fuseLeft :: Resource m => src m a -> Conduit a m b -> Source m b--instance IsSource Source where-    connect = normalConnect-    {-# INLINE connect #-}-    fuseLeft = normalFuseLeft-    {-# INLINE fuseLeft #-}--instance IsSource BufferedSource where-    connect = bufferedConnect-    {-# INLINE connect #-}-    fuseLeft = bufferedFuseLeft-    {-# INLINE fuseLeft #-}--normalConnect :: Resource m => Source m a -> Sink a m b -> ResourceT m b-normalConnect _ (SinkNoData output) = return output-normalConnect src0 (SinkLift msink) = msink >>= normalConnect src0-normalConnect src0 (SinkData push0 close0) =-    connect' src0 push0 close0-  where-    connect' src push close = do-        res <- sourcePull src-        case res of-            Closed -> do-                res' <- close-                return res'-            Open src' a -> do-                mres <- push a-                case mres of-                    Done _leftover res' -> do-                        sourceClose src'-                        return res'-                    Processing push' close' -> connect' src' push' close'--data FuseLeftState src conduit output =-    FLClosed [output]-  | FLOpen src conduit [output]--infixl 1 $=---- | Left fuse, combining a source and a conduit together into a new source.------ Note that any @Source@ passed in will be automatically closed, while a--- @BufferedSource@ will be left open.------ Since 0.2.0-($=) :: (IsSource src, Resource m)-     => src m a-     -> Conduit a m b-     -> Source m b-($=) = fuseLeft-{-# INLINE ($=) #-}--normalFuseLeft :: Resource m => Source m a -> Conduit a m b -> Source m b-normalFuseLeft src0 conduit0 = Source-    { sourcePull = pull $ FLOpen src0 conduit0 []-    , sourceClose = return ()-    }-  where-    mkSrc state = Source (pull state) (close state)-    pull state' =-        case state' of-            FLClosed [] -> return Closed-            FLClosed (x:xs) -> return $ Open-                (mkSrc (FLClosed xs))-                x-            FLOpen src conduit (x:xs) -> return $ Open-                (mkSrc (FLOpen src conduit xs))-                x-            FLOpen src conduit [] -> do-                mres <- sourcePull src-                case mres of-                    Closed -> do-                        res <- conduitClose conduit-                        case res of-                            [] -> return Closed-                            x:xs -> return $ Open-                                (mkSrc (FLClosed xs))-                                x-                    Open src'' input -> do-                        res' <- conduitPush conduit input-                        case res' of-                            Producing conduit' [] ->-                                pull $ FLOpen src'' conduit' []-                            Producing conduit' (x:xs) -> return $ Open-                                (mkSrc (FLOpen src'' conduit' xs))-                                x-                            Finished _leftover output -> do-                                sourceClose src''-                                case output of-                                    [] -> return Closed-                                    x:xs -> return $ Open-                                        (mkSrc (FLClosed xs))-                                        x-    close state = do-        -- See comment on bufferedFuseLeft for why we need to have the-        -- following check-        case state of-            FLClosed _ -> return ()-            FLOpen src' (Conduit _ closeC) _ -> do-                _ignored <- closeC-                sourceClose src'--infixr 0 =$---- | Right fuse, combining a conduit and a sink together into a new sink.------ Since 0.2.0-(=$) :: Resource m => Conduit a m b -> Sink b m c -> Sink a m c-_ =$ SinkNoData res = SinkNoData res-conduit =$ SinkLift msink = SinkLift (liftM (conduit =$) msink)-conduitOrig =$ SinkData pushI0 closeI0 = SinkData-    { sinkPush = push pushI0 closeI0 conduitOrig-    , sinkClose = close pushI0 closeI0 conduitOrig-    }-  where-    push pushI closeI conduit0 cinput = do-        res <- conduitPush conduit0 cinput-        case res of-            Producing conduit' sinput -> do-                let loop p c [] = return (Processing (push p c conduit') (close p c conduit'))-                    loop p _ (i:is) = do-                        mres <- p i-                        case mres of-                            Processing p' c' -> loop p' c' is-                            Done _sleftover res' -> do-                                _ <- conduitClose conduit'-                                return $ Done Nothing res'-                loop pushI closeI sinput-            Finished cleftover sinput -> do-                let loop _ c [] = c-                    loop p _ (i:is) = do-                        mres <- p i-                        case mres of-                            Processing p' c' -> loop p' c' is-                            Done _sleftover res' -> return res'-                res' <- loop pushI closeI sinput-                return $ Done cleftover res'-    close pushI closeI conduit = do-        sinput <- conduitClose conduit-        let loop _ c [] = c-            loop p _ (i:is) = do-                mres <- p i-                case mres of-                    Processing p' c' -> loop p' c' is-                    Done _sleftover res' -> return res'-        loop pushI closeI sinput--infixr 0 =$=---- | Middle fuse, combining two conduits together into a new conduit.------ Since 0.2.0-(=$=) :: Resource m => Conduit a m b -> Conduit b m c -> Conduit a m c-outerOrig =$= innerOrig = Conduit-    (pushF outerOrig innerOrig)-    (closeF outerOrig innerOrig)-  where-    pushF outer0 inner0 inputO = do-        res <- conduitPush outer0 inputO-        case res of-            Producing outer inputI -> do-                let loop inner [] front = return $ Producing-                        (Conduit (pushF outer inner) (closeF outer inner))-                        (front [])-                    loop inner (i:is) front = do-                        resI <- conduitPush inner i-                        case resI of-                            Producing conduit c -> loop-                                conduit-                                is-                                (front . (c ++))-                            Finished _leftover c -> do-                                _ <- conduitClose outer-                                return $ Finished Nothing $ front c-                loop inner0 inputI id-            Finished leftoverO inputI -> do-                c <- conduitPushClose inner0 inputI-                return $ Finished leftoverO c-    closeF outer inner = do-        b <- conduitClose outer-        c <- conduitPushClose inner b-        return c---- | Push some data to a conduit, then close it if necessary.-conduitPushClose :: Monad m => Conduit a m b -> [a] -> ResourceT m [b]-conduitPushClose c [] = conduitClose c-conduitPushClose c (input:rest) = do-    res <- conduitPush c input-    case res of-        Finished _ b -> return b-        Producing conduit b -> do-            b' <- conduitPushClose conduit rest-            return $ b ++ b'---- | When actually interacting with @Source@s, we sometimes want to be able to--- buffer the output, in case any intermediate steps return leftover data. A--- @BufferedSource@ allows for such buffering.------ A @BufferedSource@, unlike a @Source@, is resumable, meaning it can be--- passed to multiple @Sink@s without restarting. Therefore, a @BufferedSource@--- relaxes the main invariant of this package: the same value may be used--- multiple times.------ The intention of a @BufferedSource@ is to be used internally by an--- application or library, not to be part of its user-facing API. For example,--- the Warp webserver uses a @BufferedSource@ internally for parsing the--- request headers, but then passes a normal @Source@ to the web application--- for reading the request body.------ One caveat: while the types will allow you to use the buffered source in--- multiple threads, there is no guarantee that all @BufferedSource@s will--- handle this correctly.------ Since 0.2.0-data BufferedSource m a = BufferedSource (Ref (Base m) (BSState m a))--data BSState m a =-    ClosedEmpty-  | OpenEmpty (Source m a)-  | ClosedFull a-  | OpenFull (Source m a) a---- | Places the given @Source@ and a buffer into a mutable variable. Note that--- you should manually call 'bsourceClose' when the 'BufferedSource' is no--- longer in use.------ Since 0.2.0-bufferSource :: Resource m => Source m a -> ResourceT m (BufferedSource m a)-bufferSource src = BufferedSource <$> newRef (OpenEmpty src)---- | Turn a 'BufferedSource' into a 'Source'. Note that in general this will--- mean your original 'BufferedSource' will be closed. Additionally, all--- leftover data from usage of the returned @Source@ will be discarded. In--- other words: this is a no-going-back move.------ Note: @bufferSource@ . @unbufferSource@ is /not/ the identity function.------ Since 0.2.0-unbufferSource :: Resource m-               => BufferedSource m a-               -> Source m a-unbufferSource (BufferedSource bs) = Source-    { sourcePull = msrc >>= sourcePull-    , sourceClose = msrc >>= sourceClose-    }-  where-    msrc = do-        buf <- readRef bs-        case buf of-            OpenEmpty src -> return src-            OpenFull src a -> return Source-                { sourcePull = return $ Open src a-                , sourceClose = sourceClose src-                }-            ClosedEmpty -> return Source-                -- Note: we could put some invariant checking in here if we wanted-                { sourcePull = return Closed-                , sourceClose = return ()-                }-            ClosedFull a -> return Source-                { sourcePull = return $ Open-                    (Source (return Closed) (return ()))-                    a-                , sourceClose = return ()-                }--bufferedConnect :: Resource m => BufferedSource m a -> Sink a m b -> ResourceT m b-bufferedConnect _ (SinkNoData output) = return output-bufferedConnect bsrc (SinkLift msink) = msink >>= bufferedConnect bsrc-bufferedConnect (BufferedSource bs) (SinkData push0 close0) = do-    bsState <- readRef bs-    case bsState of-        ClosedEmpty -> close0-        OpenEmpty src -> connect' src push0 close0-        ClosedFull a -> do-            res <- push0 a-            case res of-                Done mleftover res' -> do-                    writeRef bs $ maybe ClosedEmpty ClosedFull mleftover-                    return res'-                Processing _ close' -> do-                    writeRef bs ClosedEmpty-                    close'-        OpenFull src a -> push0 a >>= onRes src-  where-    connect' src push close = do-        res <- sourcePull src-        case res of-            Closed -> do-                writeRef bs ClosedEmpty-                res' <- close-                return res'-            Open src' a -> push a >>= onRes src'-    onRes src (Done mleftover res) = do-        writeRef bs $ maybe (OpenEmpty src) (OpenFull src) mleftover-        return res-    onRes src (Processing push close) = connect' src push close--bufferedFuseLeft-    :: Resource m-    => BufferedSource m a-    -> Conduit a m b-    -> Source m b-bufferedFuseLeft bsrc conduit0 = Source-    { sourcePull = pullF $ FLOpen () conduit0 [] -- still open, no buffer-    , sourceClose = return ()-    }-  where-    mkSrc state = Source-        (pullF state)-        (closeF state)-    pullF state' =-        case state' of-            FLClosed [] -> return Closed-            FLClosed (x:xs) -> return $ Open-                (mkSrc (FLClosed xs))-                x-            FLOpen () conduit (x:xs) -> return $ Open-                (mkSrc (FLOpen () conduit xs))-                x-            FLOpen () conduit [] -> do-                mres <- bsourcePull bsrc-                case mres of-                    Nothing -> do-                        res <- conduitClose conduit-                        case res of-                            [] -> return Closed-                            x:xs -> return $ Open-                                (mkSrc (FLClosed xs))-                                x-                    Just input -> do-                        res' <- conduitPush conduit input-                        case res' of-                            Producing conduit' [] ->-                                pullF (FLOpen () conduit' [])-                            Producing conduit' (x:xs) -> return $ Open-                                (mkSrc (FLOpen () conduit' xs))-                                x-                            Finished leftover output -> do-                                bsourceUnpull bsrc leftover-                                case output of-                                    [] -> return Closed-                                    x:xs -> return $ Open-                                        (mkSrc (FLClosed xs))-                                        x-    closeF state = do-        -- Normally we don't have to worry about double closing, as the-        -- invariant of a source is that close is never called twice. However,-        -- here, if the Conduit returned Finished with some data, the overall-        -- Source will return an Open while the Conduit will be Closed.-        -- Therefore, we have to do a check.-        case state of-            FLClosed _ -> return ()-            FLOpen () (Conduit _ close) _ -> do-                _ignored <- close-                return ()--bsourcePull :: Resource m => BufferedSource m a -> ResourceT m (Maybe a)-bsourcePull (BufferedSource bs) = do-    buf <- readRef bs-    case buf of-        OpenEmpty src -> do-            res <- sourcePull src-            case res of-                Open src' a -> do-                    writeRef bs $ OpenEmpty src'-                    return $ Just a-                Closed -> writeRef bs ClosedEmpty >> return Nothing-        ClosedEmpty -> return Nothing-        OpenFull src a -> do-            writeRef bs (OpenEmpty src)-            return $ Just a-        ClosedFull a -> do-            writeRef bs ClosedEmpty-            return $ Just a--bsourceUnpull :: Resource m => BufferedSource m a -> Maybe a -> ResourceT m ()-bsourceUnpull _ Nothing = return ()-bsourceUnpull (BufferedSource ref) (Just a) = do-    buf <- readRef ref-    case buf of-        OpenEmpty src -> writeRef ref (OpenFull src a)-        ClosedEmpty -> writeRef ref (ClosedFull a)-        _ -> error $ "Invariant violated: bsourceUnpull called on full data"---- | Close the underlying 'Source' for the given 'BufferedSource'. Note--- that this function can safely be called multiple times, as it will first--- check if the 'Source' was previously closed.------ Since 0.2.0-bsourceClose :: Resource m => BufferedSource m a -> ResourceT m ()-bsourceClose (BufferedSource ref) = do-    buf <- readRef ref-    case buf of-        OpenEmpty src -> sourceClose src-        OpenFull src _ -> sourceClose src-        ClosedEmpty -> return ()-        ClosedFull _ -> 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.2.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)
− Data/Conduit/Binary.hs 
@@ -1,302 +0,0 @@-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE CPP #-}--- | Functions for interacting with bytes.-module Data.Conduit.Binary-    ( sourceFile-    , sourceHandle-    , sourceIOHandle-    , sourceFileRange-    , sinkFile-    , sinkHandle-    , sinkIOHandle-    , conduitFile-    , isolate-    , openFile-    , head-    , takeWhile-    , dropWhile-    , take-    , Data.Conduit.Binary.lines-    ) where--import Prelude hiding (head, take, takeWhile, dropWhile)-import qualified Data.ByteString as S-import qualified Data.ByteString.Lazy as L-import Data.Conduit-import qualified Data.Conduit.List as CL-import Control.Exception (assert)-import Control.Monad (liftM)-import Control.Monad.IO.Class (liftIO)-import qualified System.IO as IO-import Control.Monad.Trans.Resource (withIO, release)-import Data.Word (Word8)-#if CABAL_OS_WINDOWS-import qualified System.Win32File as F-#elif NO_HANDLES-import qualified System.PosixFile as F-#endif---- | Open a file 'IO.Handle' safely by automatically registering a release--- action.------ While you are not required to call @hClose@ on the resulting handle, you--- should do so as early as possible to free scarce resources.------ Since 0.2.0-openFile :: ResourceIO m-         => FilePath-         -> IO.IOMode-         -> ResourceT m IO.Handle-openFile fp mode = fmap snd $ withIO (IO.openBinaryFile fp mode) IO.hClose---- | Stream the contents of a file as binary data.------ Since 0.2.0-sourceFile :: ResourceIO m-           => FilePath-           -> Source m S.ByteString-sourceFile fp =-#if CABAL_OS_WINDOWS || NO_HANDLES-    sourceIO (F.openRead fp)-             F.close-             (liftIO . F.read)-#else-    sourceIOHandle (IO.openBinaryFile fp IO.ReadMode)-#endif---- | 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 0.2.0-sourceHandle :: ResourceIO m-             => IO.Handle-             -> Source m S.ByteString-sourceHandle h =-    src-  where-    src = Source pull close--    pull = do-        bs <- liftIO (S.hGetSome h 4096)-        if S.null bs-            then return Closed-            else return $ Open src bs--    close = return ()---- | 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 0.2.0-sourceIOHandle :: ResourceIO m-               => IO IO.Handle-               -> Source m S.ByteString-sourceIOHandle alloc = sourceIO alloc IO.hClose-    (\handle -> do-        bs <- liftIO (S.hGetSome handle 4096)-        if S.null bs-            then return IOClosed-            else return $ IOOpen bs)---- | Stream all incoming data to the given 'IO.Handle'. Note that this function--- will /not/ automatically close the @Handle@ when processing completes.------ Since 0.2.0-sinkHandle :: ResourceIO m-           => IO.Handle-           -> Sink S.ByteString m ()-sinkHandle h =-    SinkData push close-  where-    push input = liftIO (S.hPut h input) >> return (Processing push close)-    close = return ()---- | 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 0.2.0-sinkIOHandle :: ResourceIO m-             => IO IO.Handle-             -> Sink S.ByteString m ()-sinkIOHandle alloc = sinkIO alloc IO.hClose-    (\handle bs -> liftIO (S.hPut handle bs) >> return IOProcessing)-    (const $ return ())---- | Stream the contents of a file as binary data, starting from a certain--- offset and only consuming up to a certain number of bytes.------ Since 0.2.0-sourceFileRange :: ResourceIO m-                => FilePath-                -> Maybe Integer -- ^ Offset-                -> Maybe Integer -- ^ Maximum count-                -> Source m S.ByteString-sourceFileRange fp offset count = Source-    { sourcePull = do-        (key, handle) <- withIO (IO.openBinaryFile fp IO.ReadMode) IO.hClose-        case offset of-            Nothing -> return ()-            Just off -> liftIO $ IO.hSeek handle IO.AbsoluteSeek off-        case count of-            Nothing -> pullUnlimited handle key-            Just c -> pullLimited c handle key-    , sourceClose = return ()-    }-  where-    pullUnlimited handle key = do-        bs <- liftIO $ S.hGetSome handle 4096-        if S.null bs-            then do-                release key-                return Closed-            else do-                let src = Source-                        { sourcePull = pullUnlimited handle key-                        , sourceClose = release key-                        }-                return $ Open src bs--    pullLimited c0 handle key = do-        let c = fromInteger c0-        bs <- liftIO $ S.hGetSome handle (min c 4096)-        let c' = c - S.length bs-        assert (c' >= 0) $-            if S.null bs-                then do-                    release key-                    return Closed-                else do-                    let src = Source-                            { sourcePull = pullLimited (toInteger c') handle key-                            , sourceClose = release key-                            }-                    return $ Open src bs---- | Stream all incoming data to the given file.------ Since 0.2.0-sinkFile :: ResourceIO m-         => FilePath-         -> Sink S.ByteString m ()-sinkFile fp = sinkIOHandle (IO.openBinaryFile fp IO.WriteMode)---- | Stream the contents of the input to a file, and also send it along the--- pipeline. Similar in concept to the Unix command @tee@.------ Since 0.2.0-conduitFile :: ResourceIO m-            => FilePath-            -> Conduit S.ByteString m S.ByteString-conduitFile fp = conduitIO-    (IO.openBinaryFile fp IO.WriteMode)-    IO.hClose-    (\handle bs -> do-        liftIO $ S.hPut handle bs-        return $ IOProducing [bs])-    (const $ return [])---- | Ensure that only up to the given number of bytes are consume by the inner--- sink. Note that this does /not/ ensure that all of those bytes are in fact--- consumed.------ Since 0.2.0-isolate :: Resource m-        => Int-        -> Conduit S.ByteString m S.ByteString-isolate count0 = conduitState-    count0-    push-    close-  where-    push 0 bs = return $ StateFinished (Just bs) []-    push count bs = do-        let (a, b) = S.splitAt count bs-        let count' = count - S.length a-        return $-            if count' == 0-                then StateFinished (if S.null b then Nothing else Just b) (if S.null a then [] else [a])-                else assert (S.null b) $ StateProducing count' [a]-    close _ = return []---- | Return the next byte from the stream, if available.------ Since 0.2.0-head :: Resource m => Sink S.ByteString m (Maybe Word8)-head =-    SinkData push close-  where-    push bs =-        case S.uncons bs of-            Nothing -> return $ Processing push close-            Just (w, bs') -> do-                let lo = if S.null bs' then Nothing else Just bs'-                return $ Done lo (Just w)-    close = return Nothing---- | Return all bytes while the predicate returns @True@.------ Since 0.2.0-takeWhile :: Resource m => (Word8 -> Bool) -> Conduit S.ByteString m S.ByteString-takeWhile p =-    conduit-  where-    conduit = Conduit push close-    push bs = do-        let (x, y) = S.span p bs-        return $-            if S.null y-                then Producing conduit [x]-                else Finished (Just y) (if S.null x then [] else [x])-    close = return []---- | Ignore all bytes while the predicate returns @True@.------ Since 0.2.0-dropWhile :: Resource m => (Word8 -> Bool) -> Sink S.ByteString m ()-dropWhile p =-    SinkData push close-  where-    push bs = do-        let bs' = S.dropWhile p bs-        return $-            if S.null bs'-                then Processing push close-                else Done (Just bs') ()-    close = return ()---- | Take the given number of bytes, if available.------ Since 0.2.0-take :: Resource m => Int -> Sink S.ByteString m L.ByteString-take n = L.fromChunks `liftM` (isolate n =$ CL.consume)---- | Split the input bytes into lines. In other words, split on the LF byte--- (10), and strip it from the output.------ Since 0.2.0-lines :: Resource m => Conduit S.ByteString m S.ByteString-lines =-    conduitState id push close-  where-    push front bs' = return $ StateProducing leftover ls-      where-        bs = front bs'-        (leftover, ls) = getLines id bs--    getLines front bs-        | S.null bs = (id, front [])-        | S.null y = (S.append x, front [])-        | otherwise = getLines (front . (x:)) (S.drop 1 y)-      where-        (x, y) = S.breakByte 10 bs--    close front-        | S.null bs = return []-        | otherwise = return [bs]-      where-        bs = front S.empty
− Data/Conduit/Lazy.hs 
@@ -1,32 +0,0 @@-{-# LANGUAGE FlexibleContexts #-}--- | Use lazy I\/O for consuming the contents of a source. Warning: All normal--- warnings of lazy I\/O apply. However, if you consume the content within the--- ResourceT, you should be safe.-module Data.Conduit.Lazy-    ( lazyConsume-    ) where--import Data.Conduit-import System.IO.Unsafe (unsafeInterleaveIO)-import Control.Monad.Trans.Control (MonadBaseControl, liftBaseOp_)-import Control.Monad.Trans.Resource (resourceActive)---- | Use lazy I\/O to consume all elements from a @Source@.------ Since 0.2.0-lazyConsume :: (Resource m, MonadBaseControl IO m) => Source m a -> ResourceT m [a]-lazyConsume src0 = do-    go src0-  where--    go src = liftBaseOp_ unsafeInterleaveIO $ do-        ra <- resourceActive-        if ra-            then do-                res <- sourcePull src-                case res of-                    Closed -> return []-                    Open src' x -> do-                        y <- go src'-                        return $ x : y-            else return []
− Data/Conduit/List.hs 
@@ -1,342 +0,0 @@-{-# LANGUAGE FlexibleContexts #-}--- | Higher-level functions to interact with the elements of a stream. Most of--- these are based on list functions.------ Note that these functions all deal with individual elements of a stream as a--- sort of \"black box\", where there is no introspection of the contained--- elements. Values such as @ByteString@ and @Text@ will likely need to be--- treated specially to deal with their contents properly (@Word8@ and @Char@,--- respectively). See the "Data.Conduit.Binary" and "Data.Conduit.Text"--- modules.-module Data.Conduit.List-    ( -- * Sources-      sourceList-    , sourceNull-      -- * Sinks-      -- ** Pure-    , fold-    , take-    , drop-    , head-    , zip-    , peek-    , consume-    , sinkNull-      -- ** Monadic-    , foldM-    , mapM_-      -- Conduits-      -- ** Pure-    , map-    , concatMap-    , concatMapAccum-    , groupBy-    , isolate-    , filter-      -- ** Monadic-    , mapM-    , concatMapM-    , concatMapAccumM-    ) where--import Prelude-    ( ($), return, (==), (-), Int-    , (.), id, Maybe (..), fmap, Monad-    , Bool (..)-    , (>>)-    )-import qualified Prelude-import Data.Conduit-import Control.Monad.Trans.Class (lift)-import Data.Monoid (mempty)---- | A strict left fold.------ Since 0.2.0-fold :: Resource m-     => (b -> a -> b)-     -> b-     -> Sink a m b-fold f accum0 = sinkState-    accum0-    (\accum input -> return (StateProcessing $ f accum input))-    return---- | A monadic strict left fold.------ Since 0.2.0-foldM :: Resource m-      => (b -> a -> m b)-      -> b-      -> Sink a m b-foldM f accum0 = sinkState-    accum0-    (\accum input -> do-        accum' <- lift $ f accum input-        return $ StateProcessing accum'-    )-    return---- | Apply the action to all values in the stream.------ Since 0.2.0-mapM_ :: Resource m-      => (a -> m ())-      -> Sink a m ()-mapM_ f =-    SinkData push close-  where-    push input = lift (f input) >> return (Processing push close)-    close = return ()---- | Convert a list into a source.------ Since 0.2.0-sourceList :: Resource m => [a] -> Source m a-sourceList l0 =-    sourceState l0 go-  where-    go [] = return StateClosed-    go (x:xs) = return $ StateOpen xs x---- | Ignore a certain number of values in the stream. This function is--- semantically equivalent to:------ > drop i = take i >> return ()------ However, @drop@ is more efficient as it does not need to hold values in--- memory.------ Since 0.2.0-drop :: Resource m-     => Int-     -> Sink a m ()-drop count0 = sinkState-    count0-    push-    close-  where-    push 0 x = return $ StateDone (Just x) ()-    push count _ = do-        let count' = count - 1-        return $ if count' == 0-            then StateDone Nothing ()-            else StateProcessing count'-    close _ = return ()---- | Take some values from the stream and return as a list. If you want to--- instead create a conduit that pipes data to another sink, see 'isolate'.--- This function is semantically equivalent to:------ > take i = isolate i =$ consume------ Since 0.2.0-take :: Resource m-     => Int-     -> Sink a m [a]-take count0 = sinkState-    (count0, id)-    push-    close-  where-    push (0, front) x = return (StateDone (Just x) (front []))-    push (count, front) x = do-        let count' = count - 1-            front' = front . (x:)-        return $ if count' == 0-                    then StateDone Nothing (front' [])-                    else StateProcessing (count', front')-    close (_, front) = return $ front []---- | Take a single value from the stream, if available.------ Since 0.2.0-head :: Resource m => Sink a m (Maybe a)-head =-    SinkData push close-  where-    push x = return $ Done Nothing (Just x)-    close = return Nothing---- | Look at the next value in the stream, if available. This function will not--- change the state of the stream.------ Since 0.2.0-peek :: Resource m => Sink a m (Maybe a)-peek =-    SinkData push close-  where-    push x = return $ Done (Just x) (Just x)-    close = return Nothing---- | Apply a transformation to all values in a stream.------ Since 0.2.0-map :: Monad m => (a -> b) -> Conduit a m b-map f =-    conduit-  where-    conduit = Conduit push close-    push = return . Producing conduit . return . f-    close = return []---- | Apply a monadic transformation to all values in a stream.------ If you do not need the transformed values, and instead just want the monadic--- side-effects of running the action, see 'mapM_'.------ Since 0.2.0-mapM :: Monad m => (a -> m b) -> Conduit a m b-mapM f =-    conduit-  where-    conduit = Conduit push close-    push = fmap (Producing conduit . return) . lift . f-    close = return []---- | Apply a transformation to all values in a stream, concatenating the output--- values.------ Since 0.2.0-concatMap :: Monad m => (a -> [b]) -> Conduit a m b-concatMap f =-    conduit-  where-    conduit = Conduit push close-    push = return . Producing conduit . f-    close = return []---- | Apply a monadic transformation to all values in a stream, concatenating--- the output values.------ Since 0.2.0-concatMapM :: Monad m => (a -> m [b]) -> Conduit a m b-concatMapM f =-    conduit-  where-    conduit = Conduit push close-    push = fmap (Producing conduit) . lift . f-    close = return []---- | 'concatMap' with an accumulator.------ Since 0.2.0-concatMapAccum :: Resource m => (a -> accum -> (accum, [b])) -> accum -> Conduit a m b-concatMapAccum f accum = conduitState accum push close-  where-    push state input = let (state', result) = f input state-                       in return $ StateProducing state' result-    close _ = return []---- | 'concatMapM' with an accumulator.------ Since 0.2.0-concatMapAccumM :: Resource m => (a -> accum -> m (accum, [b])) -> accum -> Conduit a m b-concatMapAccumM f accum = conduitState accum push close-  where-    push state input = do (state', result) <- lift (f input state)-                          return $ StateProducing state' result-    close _ = return []---- | Consume all values from the stream and return as a list. Note that this--- will pull all values into memory. For a lazy variant, see--- "Data.Conduit.Lazy".------ Since 0.2.0-consume :: Resource m => Sink a m [a]-consume = sinkState-    id-    (\front input -> return (StateProcessing $ front . (input :)))-    (\front -> return $ front [])---- | Grouping input according to an equality function.------ Since 0.2.0-groupBy :: Resource m => (a -> a -> Bool) -> Conduit a m [a]-groupBy f = conduitState-    []-    push-    close-  where-    push []      v = return $ StateProducing [v] []-    push s@(x:_) v =-      if f x v then-        return $ StateProducing (v:s) []-      else-        return $ StateProducing [v] [s]-    close s = return [s]---- | Ensure that the inner sink consumes no more than the given number of--- values. Note this this does /not/ ensure that the sink consumes all of those--- values. To get the latter behavior, combine with 'sinkNull', e.g.:------ > src $$ do--- >     x <- isolate count =$ do--- >         x <- someSink--- >         sinkNull--- >         return x--- >     someOtherSink--- >     ...------ Since 0.2.0-isolate :: Resource m => Int -> Conduit a m a-isolate count0 = conduitState-    count0-    push-    close-  where-    close _ = return []-    push count x = do-        if count == 0-            then return $ StateFinished (Just x) []-            else do-                let count' = count - 1-                return $ if count' == 0-                    then StateFinished Nothing [x]-                    else StateProducing count' [x]---- | Keep only values in the stream passing a given predicate.------ Since 0.2.0-filter :: Resource m => (a -> Bool) -> Conduit a m a-filter f =-    conduit-  where-    conduit = Conduit push close-    push = return . Producing conduit . Prelude.filter f . return-    close = return []---- | Ignore the remainder of values in the source. Particularly useful when--- combined with 'isolate'.------ Since 0.2.0-sinkNull :: Resource m => Sink a m ()-sinkNull =-    SinkData push close-  where-    push _ = return $ Processing push close-    close = return ()---- | A source that returns nothing. Note that this is just a type-restricted--- synonym for 'mempty'.------ Since 0.2.0-sourceNull :: Resource m => Source m a-sourceNull = mempty---- | Combines two sources. The new source will stop producing once either---   source has been exhausted.------ Since 0.2.2-zip :: Resource m => Source m a -> Source m b -> Source m (a, b)-zip sa sb = Source pull close-    where-        pull = do ra <- sourcePull sa-                  case ra of-                    Closed -> return Closed-                    Open ra' a -> do rb <- sourcePull sb-                                     case rb of-                                        Closed -> return Closed-                                        Open rb' b -> return $ Open (zip ra' rb') (a, b)-        close = sourceClose sa >> sourceClose sb-
− Data/Conduit/Text.hs 
@@ -1,317 +0,0 @@-{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE FlexibleContexts #-}--- |--- Copyright: 2011 Michael Snoyman, 2010-2011 John Millikin--- License: MIT------ Handle streams of text.------ Parts of this code were taken from enumerator and adapted for conduits.-module Data.Conduit.Text-    (--    -- * Text codecs-      Codec-    , encode-    , decode-    , utf8-    , utf16_le-    , utf16_be-    , utf32_le-    , utf32_be-    , ascii-    , iso8859_1--    ) where--import qualified Prelude-import           Prelude hiding (head, drop, takeWhile, lines, zip, zip3, zipWith, zipWith3)--import           Control.Arrow (first)-import qualified Control.Exception as Exc-import           Control.Monad.Trans.Class (lift)-import           Data.Bits ((.&.), (.|.), shiftL)-import qualified Data.ByteString as B-import qualified Data.ByteString.Char8 as B8-import           Data.Char (ord)-import           Data.Maybe (catMaybes)-import qualified Data.Text as T-import qualified Data.Text.Encoding as TE-import           Data.Word (Word8, Word16)-import           System.IO.Unsafe (unsafePerformIO)-import           Data.Typeable (Typeable)--import qualified Data.Conduit as C-import qualified Data.Conduit.List as CL-import Control.Monad.Trans.Resource (ResourceThrow (..))---- | A specific character encoding.------ Since 0.2.0-data Codec = Codec-    { codecName :: T.Text-    , codecEncode-        :: T.Text-        -> (B.ByteString, Maybe (TextException, T.Text))-    , codecDecode-        :: B.ByteString-        -> (T.Text, Either-            (TextException, B.ByteString)-            B.ByteString)-    }--instance Show Codec where-    showsPrec d c = showParen (d > 10) $-        showString "Codec " . shows (codecName c)---- | Convert text into bytes, using the provided codec. If the codec is--- not capable of representing an input character, an exception will be thrown.------ Since 0.2.0-encode :: ResourceThrow m => Codec -> C.Conduit T.Text m B.ByteString-encode codec = CL.mapM $ \t -> do-    let (bs, mexc) = codecEncode codec t-    maybe (return bs) (resourceThrow . fst) mexc----- | Convert bytes into text, using the provided codec. If the codec is--- not capable of decoding an input byte sequence, an exception will be thrown.------ Since 0.2.0-decode :: ResourceThrow m => Codec -> C.Conduit B.ByteString m T.Text-decode codec = C.conduitState-    Nothing-    push-    close-  where-    push mb input = do-        (mb', ts) <- go' mb input-        return $ C.StateProducing mb' ts-    close mb =-        case mb of-            Nothing -> return []-            Just b-                | B.null b -> error "Data.Conduit.Text.decode: Received a null chunk"-                | otherwise -> lift $ resourceThrow $ DecodeException codec (B.head b)--    go' mb input = do -- FIXME This can be simplified significantly since input is now only a single BS-        let bss = maybe id (:) mb [input]-        either (lift . resourceThrow) return $ go bss id--    go [] front = Right (Nothing, front [])-    go (x:xs) front-        | B.null x = go xs front-    go (x:xs) front =-        case extra of-            Left (exc, _) -> Left exc-            Right bs-                | B.null bs -> go xs front'-                | otherwise ->-                    case xs of-                        y:ys -> go (B.append bs y:ys) front'-                        [] -> Right (Just bs, front' [])-      where-        (text, extra) = codecDecode codec x-        front' = front . (text:)---- |--- Since 0.2.0-data TextException = DecodeException Codec Word8-                   | EncodeException Codec Char-    deriving (Show, Typeable)-instance Exc.Exception TextException--byteSplits :: B.ByteString-           -> [(B.ByteString, B.ByteString)]-byteSplits bytes = loop (B.length bytes) where-    loop 0 = [(B.empty, bytes)]-    loop n = B.splitAt n bytes : loop (n - 1)--splitSlowly :: (B.ByteString -> T.Text)-            -> B.ByteString-            -> (T.Text, Either-                (TextException, B.ByteString)-                B.ByteString)-splitSlowly dec bytes = valid where-    valid = firstValid (Prelude.map decFirst splits)-    splits = byteSplits bytes-    firstValid = Prelude.head . catMaybes-    tryDec = tryEvaluate . dec--    decFirst (a, b) = case tryDec a of-        Left _ -> Nothing-        Right text -> Just (text, case tryDec b of-            Left exc -> Left (exc, b)--            -- this case shouldn't occur, since splitSlowly-            -- is only called when parsing failed somewhere-            Right _ -> Right B.empty)---- |--- Since 0.2.0-utf8 :: Codec-utf8 = Codec name enc dec where-    name = T.pack "UTF-8"-    enc text = (TE.encodeUtf8 text, Nothing)-    dec bytes = case splitQuickly bytes of-        Just (text, extra) -> (text, Right extra)-        Nothing -> splitSlowly TE.decodeUtf8 bytes--    splitQuickly bytes = loop 0 >>= maybeDecode where-        required x0-            | x0 .&. 0x80 == 0x00 = 1-            | x0 .&. 0xE0 == 0xC0 = 2-            | x0 .&. 0xF0 == 0xE0 = 3-            | x0 .&. 0xF8 == 0xF0 = 4--            -- Invalid input; let Text figure it out-            | otherwise           = 0--        maxN = B.length bytes--        loop n | n == maxN = Just (TE.decodeUtf8 bytes, B.empty)-        loop n = let-            req = required (B.index bytes n)-            tooLong = first TE.decodeUtf8 (B.splitAt n bytes)-            decodeMore = loop $! n + req-            in if req == 0-                then Nothing-                else if n + req > maxN-                    then Just tooLong-                    else decodeMore---- |--- Since 0.2.0-utf16_le :: Codec-utf16_le = Codec name enc dec where-    name = T.pack "UTF-16-LE"-    enc text = (TE.encodeUtf16LE text, Nothing)-    dec bytes = case splitQuickly bytes of-        Just (text, extra) -> (text, Right extra)-        Nothing -> splitSlowly TE.decodeUtf16LE bytes--    splitQuickly bytes = maybeDecode (loop 0) where-        maxN = B.length bytes--        loop n |  n      == maxN = decodeAll-               | (n + 1) == maxN = decodeTo n-        loop n = let-            req = utf16Required-                (B.index bytes n)-                (B.index bytes (n + 1))-            decodeMore = loop $! n + req-            in if n + req > maxN-                then decodeTo n-                else decodeMore--        decodeTo n = first TE.decodeUtf16LE (B.splitAt n bytes)-        decodeAll = (TE.decodeUtf16LE bytes, B.empty)---- |--- Since 0.2.0-utf16_be :: Codec-utf16_be = Codec name enc dec where-    name = T.pack "UTF-16-BE"-    enc text = (TE.encodeUtf16BE text, Nothing)-    dec bytes = case splitQuickly bytes of-        Just (text, extra) -> (text, Right extra)-        Nothing -> splitSlowly TE.decodeUtf16BE bytes--    splitQuickly bytes = maybeDecode (loop 0) where-        maxN = B.length bytes--        loop n |  n      == maxN = decodeAll-               | (n + 1) == maxN = decodeTo n-        loop n = let-            req = utf16Required-                (B.index bytes (n + 1))-                (B.index bytes n)-            decodeMore = loop $! n + req-            in if n + req > maxN-                then decodeTo n-                else decodeMore--        decodeTo n = first TE.decodeUtf16BE (B.splitAt n bytes)-        decodeAll = (TE.decodeUtf16BE bytes, B.empty)--utf16Required :: Word8 -> Word8 -> Int-utf16Required x0 x1 = required where-    required = if x >= 0xD800 && x <= 0xDBFF-        then 4-        else 2-    x :: Word16-    x = (fromIntegral x1 `shiftL` 8) .|. fromIntegral x0---- |--- Since 0.2.0-utf32_le :: Codec-utf32_le = Codec name enc dec where-    name = T.pack "UTF-32-LE"-    enc text = (TE.encodeUtf32LE text, Nothing)-    dec bs = case utf32SplitBytes TE.decodeUtf32LE bs of-        Just (text, extra) -> (text, Right extra)-        Nothing -> splitSlowly TE.decodeUtf32LE bs---- |--- Since 0.2.0-utf32_be :: Codec-utf32_be = Codec name enc dec where-    name = T.pack "UTF-32-BE"-    enc text = (TE.encodeUtf32BE text, Nothing)-    dec bs = case utf32SplitBytes TE.decodeUtf32BE bs of-        Just (text, extra) -> (text, Right extra)-        Nothing -> splitSlowly TE.decodeUtf32BE bs--utf32SplitBytes :: (B.ByteString -> T.Text)-                -> B.ByteString-                -> Maybe (T.Text, B.ByteString)-utf32SplitBytes dec bytes = split where-    split = maybeDecode (dec toDecode, extra)-    len = B.length bytes-    lenExtra = mod len 4--    lenToDecode = len - lenExtra-    (toDecode, extra) = if lenExtra == 0-        then (bytes, B.empty)-        else B.splitAt lenToDecode bytes---- |--- Since 0.2.0-ascii :: Codec-ascii = Codec name enc dec where-    name = T.pack "ASCII"-    enc text = (bytes, extra) where-        (safe, unsafe) = T.span (\c -> ord c <= 0x7F) text-        bytes = B8.pack (T.unpack safe)-        extra = if T.null unsafe-            then Nothing-            else Just (EncodeException ascii (T.head unsafe), unsafe)--    dec bytes = (text, extra) where-        (safe, unsafe) = B.span (<= 0x7F) bytes-        text = T.pack (B8.unpack safe)-        extra = if B.null unsafe-            then Right B.empty-            else Left (DecodeException ascii (B.head unsafe), unsafe)---- |--- Since 0.2.0-iso8859_1 :: Codec-iso8859_1 = Codec name enc dec where-    name = T.pack "ISO-8859-1"-    enc text = (bytes, extra) where-        (safe, unsafe) = T.span (\c -> ord c <= 0xFF) text-        bytes = B8.pack (T.unpack safe)-        extra = if T.null unsafe-            then Nothing-            else Just (EncodeException iso8859_1 (T.head unsafe), unsafe)--    dec bytes = (T.pack (B8.unpack bytes), Right B.empty)--tryEvaluate :: a -> Either TextException a-tryEvaluate = unsafePerformIO . Exc.try . Exc.evaluate--maybeDecode:: (a, b) -> Maybe (a, b)-maybeDecode (a, b) = case tryEvaluate a of-    Left _ -> Nothing-    Right _ -> Just (a, b)
− Data/Conduit/Types/Conduit.hs 
@@ -1,49 +0,0 @@--- | Defines the types for a conduit, which is a transformer of data. A conduit--- is almost always connected either left (to a source) or right (to a sink).-module Data.Conduit.Types.Conduit-    ( ConduitResult (..)-    , Conduit (..)-    , ConduitPush-    , ConduitClose-    ) where--import Control.Monad.Trans.Resource (ResourceT)-import Control.Monad (liftM)---- | The value of the @conduitPush@ record.-type ConduitPush input m output = input -> ResourceT m (ConduitResult input m output)---- | The value of the @conduitClose@ record.-type ConduitClose m output = ResourceT m [output]---- | When data is pushed to a @Conduit@, it may either indicate that it is--- still producing output and provide some, or indicate that it is finished--- producing output, in which case it returns optional leftover input and some--- final output.------ The @Producing@ constructor provides a new @Conduit@ to be used in place of--- the previous one.------ Since 0.2.0-data ConduitResult input m output =-    Producing (Conduit input m output) [output]-  | Finished (Maybe input) [output]--instance Monad m => Functor (ConduitResult input m) where-    fmap f (Producing c o) = Producing (fmap f c) (fmap f o)-    fmap f (Finished i o) = Finished i (fmap f o)---- | A conduit has two operations: it can receive new input (a push), and can--- be closed.------ Since 0.2.0-data Conduit input m output = Conduit-    { conduitPush :: ConduitPush input m output-    , conduitClose :: ConduitClose m output-    }--instance Monad m => Functor (Conduit input m) where-    fmap f c = c-        { conduitPush = liftM (fmap f) . conduitPush c-        , conduitClose = liftM (fmap f) (conduitClose c)-        }
− Data/Conduit/Types/Sink.hs 
@@ -1,148 +0,0 @@-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE UndecidableInstances #-}--- | Defines the types for a sink, which is a consumer of data.-module Data.Conduit.Types.Sink-    ( SinkResult (..)-    , Sink (..)-    , SinkPush-    , SinkClose-    ) where--import Control.Monad.Trans.Resource-import Control.Monad.Trans.Class (MonadTrans (lift))-import Control.Monad.IO.Class (MonadIO (liftIO))-import Control.Monad (liftM, ap)-import Control.Applicative (Applicative (..))-import Control.Monad.Base (MonadBase (liftBase))---- | The value of the @sinkPush@ record.-type SinkPush input m output = input -> ResourceT m (SinkResult input m output)---- | The value of the @sinkClose@ record.-type SinkClose m output = ResourceT m output---- | A @Sink@ ultimately returns a single output value. Each time data is--- pushed to it, a @Sink@ may indicate that it is still processing data, or--- that it is done, in which case it returns some optional leftover input and--- an output value.------ The @Processing@ constructors provides updated push and close functions to--- be used in place of the original @Sink@.------ Since 0.2.0-data SinkResult input m output =-    Processing (SinkPush input m output) (SinkClose m output)-  | Done (Maybe input) output-instance Monad m => Functor (SinkResult input m) where-    fmap f (Processing push close) = Processing ((fmap . fmap . fmap) f push) (fmap f close)-    fmap f (Done input output) = Done input (f output)--{--Note to my future self, and anyone else who reads my code: It's tempting to-change `Sink` to look like:--    newtype Sink input m output = Sink { runSink :: ResourceT m (SinkResult input m output) }--If you start implementing this, eventually you'll realize that you will have to-enforce an invariant to make it all work: a `SinkResult` can't return leftovers-unless data was pushed to it.--The idea is that, with the actual definition of `Sink`, it's impossible to get-a `SinkResult` without first pushing in some input. Therefore, it's always-valid at the type level to return leftovers. In this simplified `Sink`, it-would be possible to have code that looks like:--    sink1 = Sink $ return $ Done (Just "foo") ()-    fsink2 () = Sink $ return $ Done (Just "bar") ()-    sink1 >>= fsink2--Now we'd have to coalesce "foo" and "bar" together (e.g., require `Monoid`),-throw away data, or throw an exception.--So the current three-constructor approach to `Sink` may not be as pretty, but-it enforce the invariants much better.--}---- | In general, a sink will consume data and eventually produce an output when--- it has consumed \"enough\" data. There are two caveats to that statement:------ * Some sinks do not actually require any data to produce an output. This is--- included with a sink in order to allow for a 'Monad' instance.------ * Some sinks will consume all available data and only produce a result at--- the \"end\" of a data stream (e.g., @sum@).------ To allow for the first caveat, we have the 'SinkNoData' constructor. For the--- second, the 'SinkData' constructor has two records: one for receiving more--- input, and the other to indicate the end of a stream. Note that, at the end--- of a stream, some output is required. If a specific 'Sink' implementation--- cannot always produce output, this should be indicated in its return value,--- using something like a 'Maybe' or 'Either'.------ A @Sink@ should clean up any resources it has allocated when it returns a--- value, whether that be via @sinkPush@ or @sinkClose@.------ Since 0.2.0-data Sink input m output =-    SinkNoData output-  | SinkData-        { sinkPush :: SinkPush input m output-        , sinkClose :: SinkClose m output-        }-  -- | This constructor is provided to allow us to create an efficient-  -- @MonadTrans@ instance.-  | SinkLift (ResourceT m (Sink input m output))--instance Monad m => Functor (Sink input m) where-    fmap f (SinkNoData x) = SinkNoData (f x)-    fmap f (SinkData p c) = SinkData-        { sinkPush = liftM (fmap f) . p-        , sinkClose = liftM f c-        }-    fmap f (SinkLift msink) = SinkLift (liftM (fmap f) msink)--instance Resource m => Applicative (Sink input m) where-    pure = return-    (<*>) = ap--instance Resource m => Monad (Sink input m) where-    return = SinkNoData-    SinkNoData x >>= f = f x-    SinkLift mx >>= f = SinkLift $ do-        x <- mx-        return $ x >>= f-    SinkData push0 close0 >>= f =-        SinkData (push push0) (close close0)-      where-        push push' input = do-            res <- push' input-            case res of-                Done lo output -> pushHelper lo (f output)-                Processing push'' close'' ->-                    return $ Processing (push push'') (close close'')--        pushHelper lo (SinkNoData y) = return $ Done lo y-        pushHelper (Just l) (SinkData pushF _) = pushF l-        pushHelper Nothing (SinkData pushF closeF) =-            return (Processing pushF closeF)-        pushHelper lo (SinkLift msink) = msink >>= pushHelper lo--        close close' = do-            output <- close'-            closeHelper (f output)--        closeHelper (SinkNoData y) = return y-        closeHelper (SinkData _ closeF) = closeF-        closeHelper (SinkLift msink) = msink >>= closeHelper--instance (Resource m, Base m ~ base, Applicative base) => MonadBase base (Sink input m) where-    liftBase = lift . resourceLiftBase--instance MonadTrans (Sink input) where-    lift = SinkLift . liftM SinkNoData . lift--instance (Resource m, MonadIO m) => MonadIO (Sink input m) where-    liftIO = lift . liftIO
− Data/Conduit/Types/Source.hs 
@@ -1,71 +0,0 @@-{-# LANGUAGE FlexibleContexts #-}--- | Defines the types for a source, which is a producer of data.-module Data.Conduit.Types.Source-    ( SourceResult (..)-    , Source (..)-    ) where--import Control.Monad.Trans.Resource-import Data.Monoid (Monoid (..))-import Control.Monad (liftM)---- | Result of pulling from a source. Either a new piece of data (@Open@), or--- indicates that the source is now @Closed@.------ The @Open@ constructor returns both a new value, as well as a new @Source@,--- which should be used in place of the previous @Source@.------ Since 0.2.0-data SourceResult m a = Open (Source m a) a | Closed--instance Monad m => Functor (SourceResult m) where-    fmap f (Open p a) = Open (fmap f p) (f a)-    fmap _ Closed = Closed---- | A @Source@ has two operations on it: pull some data, and close the--- @Source@. Since @Source@ is built on top of 'ResourceT', all acquired--- resources should be automatically released anyway. Closing a @Source@ early--- is merely an optimization to free scarce resources as soon as possible.------ A @Source@ is should free any resources it allocated when either--- @sourceClose@ is called or a @Closed@ is returned. However, based on the--- usage of @ResourceT@, this is simply an optimization.------ Since 0.2.0-data Source m a = Source-    { sourcePull :: ResourceT m (SourceResult m a)-    , sourceClose :: ResourceT m ()-    }--instance Monad m => Functor (Source m) where-    fmap f src = src-        { sourcePull = liftM (fmap f) (sourcePull src)-        }--instance Resource m => Monoid (Source m a) where-    mempty = Source-        { sourcePull = return Closed-        , sourceClose = return ()-        }-    mappend a b = mconcat [a, b]-    mconcat [] = mempty-    mconcat (next0:rest0) =-        src next0 rest0-      where-        src next rest = Source (pull next rest) (close next rest)--        pull current rest = do-            res <- sourcePull current-            case res of-                -- end of the current Source-                Closed -> do-                    case rest of-                        -- ... and open the next one-                        a:as -> pull a as-                        -- no more source, return an EOF-                        [] -> return Closed-                Open current' val -> return (Open (src current' rest) val)-        close current _rest = do-            -- we only need to close the current Source, since they are opened-            -- one at a time-            sourceClose current
− Data/Conduit/Util/Conduit.hs 
@@ -1,246 +0,0 @@-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE RankNTypes #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE CPP #-}--- | Utilities for constructing and covnerting conduits. Please see--- "Data.Conduit.Types.Conduit" for more information on the base types.-module Data.Conduit.Util.Conduit-    ( conduitState-    , ConduitStateResult (..)-    , conduitIO-    , ConduitIOResult (..)-    , transConduit-      -- *** Sequencing-    , SequencedSink-    , sequenceSink-    , sequence-    , SequencedSinkResponse (..)-    ) where--import Prelude hiding (sequence)-import Control.Monad.Trans.Resource-import Control.Monad.Trans.Class-import Data.Conduit.Types.Conduit-import Data.Conduit.Types.Sink---- | A helper type for @conduitState@, indicating the result of being pushed--- to.  It can either indicate that processing is done, or to continue with the--- updated state.------ Since 0.2.0-data ConduitStateResult state input output =-    StateFinished (Maybe input) [output]-  | StateProducing state [output]--instance Functor (ConduitStateResult state input) where-    fmap f (StateFinished a b) = StateFinished a (map f b)-    fmap f (StateProducing a b) = StateProducing a (map f b)---- | Construct a 'Conduit' with some stateful functions. This function addresses--- threading the state value for you.------ Since 0.2.0-conduitState-    :: Resource m-    => state -- ^ initial state-    -> (state -> input -> ResourceT m (ConduitStateResult state input output)) -- ^ Push function.-    -> (state -> ResourceT m [output]) -- ^ Close function. The state need not be returned, since it will not be used again.-    -> Conduit input m output-conduitState state0 push0 close0 =-    Conduit (push state0) (close0 state0)-  where-    push state input = do-        res <- state `seq` push0 state input-        return $ case res of-            StateFinished a b -> Finished a b-            StateProducing state' output -> Producing-                (Conduit (push state') (close0 state'))-                output---- | A helper type for @conduitIO@, indicating the result of being pushed to.--- It can either indicate that processing is done, or to continue.------ Since 0.2.0-data ConduitIOResult input output =-    IOFinished (Maybe input) [output]-  | IOProducing [output]--instance Functor (ConduitIOResult input) where-    fmap f (IOFinished a b) = IOFinished a (map f b)-    fmap f (IOProducing b) = IOProducing (map f b)---- | Construct a 'Conduit'.------ Since 0.2.0-conduitIO :: ResourceIO m-           => IO state -- ^ resource and/or state allocation-           -> (state -> IO ()) -- ^ resource and/or state cleanup-           -> (state -> input -> m (ConduitIOResult input output)) -- ^ Push function. Note that this need not explicitly perform any cleanup.-           -> (state -> m [output]) -- ^ Close function. Note that this need not explicitly perform any cleanup.-           -> Conduit input m output-conduitIO alloc cleanup push0 close0 = Conduit-    { conduitPush = \input -> do-        (key, state) <- withIO alloc cleanup-        push key state input-    , conduitClose = do-        (key, state) <- withIO alloc cleanup-        close key state-    }-  where-    push key state input = do-        res <- lift $ push0 state input-        case res of-            IOProducing output -> return $ Producing-                (Conduit (push key state) (close key state))-                output-            IOFinished a b -> do-                release key-                return $ Finished a b-    close key state = do-        output <- lift $ close0 state-        release key-        return output---- | Transform the monad a 'Conduit' lives in.------ See @transSource@ for more information.------ Since 0.2.0-transConduit :: (Monad m, Base m ~ Base n)-             => (forall a. m a -> n a)-             -> Conduit input m output-             -> Conduit input n output-transConduit f c = c-    { conduitPush = transResourceT f . fmap (transConduitPush f) . conduitPush c-    , conduitClose = transResourceT f (conduitClose c)-    }--transConduitPush :: (Base m ~ Base n, Monad m)-              => (forall a. m a -> n a)-              -> ConduitResult input m output-              -> ConduitResult input n output-transConduitPush _ (Finished a b) = Finished a b-transConduitPush f (Producing conduit output) = Producing-    (transConduit f conduit)-    output---- | Return value from a 'SequencedSink'.------ Since 0.2.0-data SequencedSinkResponse state input m output =-    Emit state [output] -- ^ Set a new state, and emit some new output.-  | Stop -- ^ End the conduit.-  | StartConduit (Conduit input m output) -- ^ Pass control to a new conduit.---- | Helper type for constructing a @Conduit@ based on @Sink@s. This allows you--- to write higher-level code that takes advantage of existing conduits and--- sinks, and leverages a sink's monadic interface.------ Since 0.2.0-type SequencedSink state input m output =-    state -> Sink input m (SequencedSinkResponse state input m output)--data SCState state input m output =-    SCNewState state-  | SCConduit (Conduit input m output)-  | SCSink (input -> ResourceT m (SinkResult input m (SequencedSinkResponse state input m output)))-           (ResourceT m (SequencedSinkResponse state input m output))---- | Convert a 'SequencedSink' into a 'Conduit'.------ Since 0.2.0-sequenceSink-    :: Resource m-    => state -- ^ initial state-    -> SequencedSink state input m output-    -> Conduit input m output-sequenceSink state0 fsink = conduitState-    (SCNewState state0)-    (scPush id fsink)-    scClose--goRes :: Resource m-      => SequencedSinkResponse state input m output-      -> Maybe input-      -> ([output] -> [output])-      -> SequencedSink state input m output-      -> ResourceT m (ConduitStateResult (SCState state input m output) input output)-goRes (Emit state output) (Just input) front fsink =-    scPush (front . (output++)) fsink (SCNewState state) input-goRes (Emit state output) Nothing front _ =-    return $ StateProducing (SCNewState state) $ front output-goRes Stop minput front _ =-    return $ StateFinished minput $ front []-goRes (StartConduit c) Nothing front _ =-    return $ StateProducing (SCConduit c) $ front []-goRes (StartConduit c) (Just input) front fsink =-    scPush front fsink (SCConduit c) input--scPush :: Resource m-     => ([output] -> [output])-     -> SequencedSink state input m output-     -> SCState state input m output-     -> input-     -> ResourceT m (ConduitStateResult (SCState state input m output) input output)-scPush front fsink (SCNewState state) input =-    go (fsink state)-  where-    go (SinkData push' close') = scPush front fsink (SCSink push' close') input-    go (SinkNoData res) = goRes res (Just input) front fsink-    go (SinkLift msink) = msink >>= go-scPush front _ (SCConduit conduit) input = do-    res <- conduitPush conduit input-    return $ case res of-        Producing c x -> StateProducing (SCConduit c) $ front x-        Finished x y -> StateFinished x $ front y-scPush front fsink (SCSink push _) input = do-    mres <- push input-    case mres of-        Done minput res -> goRes res minput front fsink-        Processing push' close' -> return (StateProducing (SCSink push' close') $ front [])--scClose :: Monad m => SCState state inptu m output -> ResourceT m [output]-scClose (SCNewState _) = return []-scClose (SCConduit conduit) = conduitClose conduit-scClose (SCSink _ close) = do-    res <- close-    case res of-        Emit _ os -> return os-        Stop -> return []-        StartConduit c -> conduitClose c---- | Specialised version of 'sequenceSink'------ Note that this function will return an infinite stream if provided a--- @SinkNoData@ constructor. In other words, you probably don\'t want to do--- @sequence . return@.------ Since 0.2.1-sequence :: Resource m => Sink input m output -> Conduit input m output-sequence (SinkData spush sclose) = Conduit (push spush) (close sclose)-  where-    push spush' input = do-        res <- spush' input-        case res of-            Processing spush'' sclose'' ->-                return $ Producing (Conduit (push spush'') (close sclose'')) []-            Done Nothing output ->-                return $ Producing (Conduit (push spush) (close sclose)) [output]-            Done (Just input') output -> do-                res' <- push spush input'-                case res' of-                    Producing conduit' output' ->-                        return $ Producing conduit' (output:output')-                    Finished _ _ -> error "impossible [sequence]"-    close sclose' = fmap (:[]) sclose'--sequence (SinkNoData output) = Conduit-    { conduitPush = \input -> return $ Finished (Just input) (repeat output)-    , conduitClose = return $ repeat output-    }-sequence (SinkLift msink) = Conduit-    { conduitPush = \input -> do-        sink <- msink-        conduitPush (sequence sink) input-    , conduitClose = return []-    }
− Data/Conduit/Util/Sink.hs 
@@ -1,109 +0,0 @@-{-# LANGUAGE RankNTypes #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE CPP #-}--- | Utilities for constructing 'Sink's. Please see "Data.Conduit.Types.Sink"--- for more information on the base types.-module Data.Conduit.Util.Sink-    ( sinkState-    , SinkStateResult (..)-    , sinkIO-    , SinkIOResult (..)-    , transSink-    ) where--import Control.Monad.Trans.Resource-import Control.Monad.Trans.Class (lift)-import Data.Conduit.Types.Sink-import Control.Monad (liftM)---- | A helper type for @sinkState@, indicating the result of being pushed to.--- It can either indicate that processing is done, or to continue with the--- updated state.------ Since 0.2.0-data SinkStateResult state input output =-    StateDone (Maybe input) output-  | StateProcessing state---- | Construct a 'Sink' with some stateful functions. This function addresses--- threading the state value for you.------ Since 0.2.0-sinkState-    :: Resource m-    => state -- ^ initial state-    -> (state -> input -> ResourceT m (SinkStateResult state input output)) -- ^ push-    -> (state -> ResourceT m output) -- ^ Close. Note that the state is not returned, as it is not needed.-    -> Sink input m output-sinkState state0 push0 close0 =-    SinkData (push state0) (close0 state0)-  where-    push state input = do-        res <- state `seq` push0 state input-        case res of-            StateProcessing state' -> return $ Processing (push state') (close0 state')-            StateDone mleftover output -> return $ Done mleftover output---- | A helper type for @sinkIO@, indicating the result of being pushed to. It--- can either indicate that processing is done, or to continue.------ Since 0.2.0-data SinkIOResult input output = IODone (Maybe input) output | IOProcessing---- | Construct a 'Sink'. Note that your push and close functions need not--- explicitly perform any cleanup.------ Since 0.2.0-sinkIO :: ResourceIO m-        => IO state -- ^ resource and/or state allocation-        -> (state -> IO ()) -- ^ resource and/or state cleanup-        -> (state -> input -> m (SinkIOResult input output)) -- ^ push-        -> (state -> m output) -- ^ close-        -> Sink input m output-sinkIO alloc cleanup push0 close0 = SinkData-    { sinkPush = \input -> do-        (key, state) <- withIO alloc cleanup-        push key state input-    , sinkClose = do-        (key, state) <- withIO alloc cleanup-        close key state-    }-  where-    push key state input = do-        res <- lift $ push0 state input-        case res of-            IODone a b -> do-                release key-                return $ Done a b-            IOProcessing -> return $ Processing-                (push key state)-                (close key state)-    close key state = do-        res <- lift $ close0 state-        release key-        return res---- | Transform the monad a 'Sink' lives in.------ See @transSource@ for more information.------ Since 0.2.0-transSink :: (Base m ~ Base n, Monad m)-          => (forall a. m a -> n a)-          -> Sink input m output-          -> Sink input n output-transSink _ (SinkNoData x) = SinkNoData x-transSink f (SinkLift msink) = SinkLift (transResourceT f (liftM (transSink f) msink))-transSink f (SinkData push close) = SinkData-    (transResourceT f . fmap (transSinkPush f) . push)-    (transResourceT f close)--transSinkPush :: (Base m ~ Base n, Monad m)-              => (forall a. m a -> n a)-              -> SinkResult input m output-              -> SinkResult input n output-transSinkPush _ (Done a b) = Done a b-transSinkPush f (Processing push close) = Processing-    (transResourceT f . fmap (transSinkPush f) . push)-    (transResourceT f close)
− Data/Conduit/Util/Source.hs 
@@ -1,122 +0,0 @@-{-# LANGUAGE RankNTypes #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE CPP #-}--- | Utilities for constructing and converting 'Source', 'Source' and--- 'BSource' types. Please see "Data.Conduit.Types.Source" for more information--- on the base types.-module Data.Conduit.Util.Source-    ( sourceState-    , sourceStateIO-    , SourceStateResult (..)-    , sourceIO-    , SourceIOResult (..)-    , transSource-    ) where--import Control.Monad.Trans.Resource-import Control.Monad.Trans.Class (lift)-import Data.Conduit.Types.Source---- | The return value when pulling in the @sourceState@ function. Either--- indicates no more data, or the next value and an updated state.------ Since 0.2.0-data SourceStateResult state output = StateOpen state output | StateClosed---- | Construct a 'Source' with some stateful functions. This function addresses--- threading the state value for you.------ Since 0.2.0-sourceState-    :: Resource m-    => state -- ^ Initial state-    -> (state -> ResourceT m (SourceStateResult state output)) -- ^ Pull function-    -> Source m output-sourceState state0 pull0 =-    src state0-  where-    src state = Source (pull state) close--    pull state = do-        res <- pull0 state-        return $ case res of-            StateOpen state' val -> Open (src state') val-            StateClosed -> Closed--    close = return ()---- | The return value when pulling in the @sourceIO@ function. Either indicates--- no more data, or the next value.-data SourceIOResult output = IOOpen output | IOClosed---- | Construct a 'Source' based on some IO actions for alloc/release.------ Since 0.2.0-sourceIO :: ResourceIO m-          => IO state -- ^ resource and/or state allocation-          -> (state -> IO ()) -- ^ resource and/or state cleanup-          -> (state -> m (SourceIOResult output)) -- ^ Pull function. Note that this need not explicitly perform any cleanup.-          -> Source m output-sourceIO alloc cleanup pull0 =-    Source-        { sourcePull = do-            (key, state) <- withIO alloc cleanup-            pull key state-        , sourceClose = return ()-        }-  where-    src key state = Source (pull key state) (release key)--    pull key state = do-        res <- lift $ pull0 state-        case res of-            IOClosed -> do-                release key-                return Closed-            IOOpen val -> return $ Open (src key state) val---- | A combination of 'sourceIO' and 'sourceState'.------ Since 0.2.1-sourceStateIO :: ResourceIO m-              => IO state -- ^ resource and/or state allocation-              -> (state -> IO ()) -- ^ resource and/or state cleanup-              -> (state -> m (SourceStateResult state output)) -- ^ Pull function. Note that this need not explicitly perform any cleanup.-              -> Source m output-sourceStateIO alloc cleanup pull0 =-    Source-        { sourcePull = do-            (key, state) <- withIO alloc cleanup-            pull key state-        , sourceClose = return ()-        }-  where-    src key state = Source (pull key state) (release key)--    pull key state = do-        res <- lift $ pull0 state-        case res of-            StateClosed -> do-                release key-                return Closed-            StateOpen state' val -> return $ Open (src key state') val---- | Transform the monad a 'Source' lives in.------ Note that this will /not/ thread the individual monads together, meaning--- side effects will be lost. This function is most useful for transformers--- only providing context and not producing side-effects, such as @ReaderT@.------ Since 0.2.0-transSource :: (Base m ~ Base n, Monad m)-            => (forall a. m a -> n a)-            -> Source m output-            -> Source n output-transSource f c = c-    { sourcePull = transResourceT f (fmap go2 $ sourcePull c)-    , sourceClose = transResourceT f (sourceClose c)-    }-  where-    go2 (Open p a) = Open (transSource f p) a-    go2 Closed = Closed
LICENSE view
@@ -1,30 +1,20 @@-Copyright (c)2011, Michael Snoyman--All rights reserved.--Redistribution and use in source and binary forms, with or without-modification, are permitted provided that the following conditions are met:--    * Redistributions of source code must retain the above copyright-      notice, this list of conditions and the following disclaimer.+Copyright (c) 2012 Michael Snoyman, http://www.yesodweb.com/ -    * Redistributions in binary form must reproduce the above-      copyright notice, this list of conditions and the following-      disclaimer in the documentation and/or other materials provided-      with the distribution.+Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions: -    * Neither the name of Michael Snoyman nor the names of other-      contributors may be used to endorse or promote products derived-      from this software without specific prior written permission.+The above copyright notice and this permission notice shall be+included in all copies or substantial portions of the Software. -THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS-"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT-LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR-A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT-OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,-SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT-LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,-DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY-THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT-(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE-OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND+NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE+LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION+OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION+WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+ README.md view
@@ -0,0 +1,9 @@+## conduit++`conduit` is a solution to the streaming data problem, allowing for production,+transformation, and consumption of streams of data in constant memory. It is an+alternative to lazy I\/O which guarantees deterministic resource handling.++For more information about conduit in general, and how this package in+particular fits into the ecosystem, see [the conduit+homepage](https://github.com/snoyberg/conduit#readme).
− System/PosixFile.hsc 
@@ -1,57 +0,0 @@-{-# LANGUAGE ForeignFunctionInterface #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-module System.PosixFile-    ( openRead-    , read-    , close-    ) where--import Foreign.C.String (CString, withCString)-import Foreign.Marshal.Alloc (mallocBytes, free)-import Foreign.C.Types (CInt)-import Foreign.C.Error (throwErrno)-import Foreign.Ptr (Ptr)-import Data.Bits (Bits)-import Data.Word (Word8)-import qualified Data.ByteString as S-import qualified Data.ByteString.Unsafe as BU-import Prelude hiding (read)-import Data.Conduit.Util.Source (SourceIOResult (..))--#include <fcntl.h>--newtype Flag = Flag CInt-    deriving (Num, Bits, Show, Eq)--#{enum Flag, Flag-    , oRdonly = O_RDONLY-    }--foreign import ccall "open"-    c_open :: CString -> Flag -> IO CInt--foreign import ccall "read"-    c_read :: FD -> Ptr Word8 -> CInt -> IO CInt--foreign import ccall "close"-    close :: FD -> IO ()--newtype FD = FD CInt--openRead :: FilePath -> IO FD-openRead fp = do-    h <- withCString fp $ \str -> c_open str oRdonly-    if h < 0-        then throwErrno $ "Could not open file: " ++ fp-        else return $ FD h--read :: FD -> IO (SourceIOResult S.ByteString)-read fd = do-    cstr <- mallocBytes 4096-    len <- c_read fd cstr 4096-    if len == 0-        then free cstr >> return IOClosed-        else fmap IOOpen $ BU.unsafePackCStringFinalizer-                cstr-                (fromIntegral len)-                (free cstr)
− System/Win32File.hsc 
@@ -1,89 +0,0 @@-{-# LANGUAGE ForeignFunctionInterface #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-module System.Win32File-    ( openRead-    , read-    , close-    ) where--import Foreign.C.String (CString)-import Foreign.Marshal.Alloc (mallocBytes, free)-import Foreign.C.Types (CInt)-import Foreign.C.Error (throwErrno)-import Foreign.Ptr (Ptr)-import Data.Bits (Bits, (.|.))-import qualified Data.ByteString as S-import qualified Data.ByteString.Unsafe as BU-import Data.Text (pack)-import Data.Text.Encoding (encodeUtf16LE)-import Data.Word (Word8)-import Prelude hiding (read)-import Data.Conduit (SourceIOResult (..))--#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-    }--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-    }--foreign import ccall "_wsopen"-    c_wsopen :: CString -> OFlag -> SHFlag -> PMode -> IO CInt--foreign import ccall "_read"-    c_read :: FD -> Ptr Word8 -> CInt -> IO CInt--foreign import ccall "_close"-    close :: FD -> IO ()--newtype FD = FD CInt--openRead :: FilePath -> IO FD-openRead 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 ->-            c_wsopen-                str-                (oBinary .|. oRdonly)-                shDenyno-                pIread-    if h < 0-        then throwErrno $ "Could not open file: " ++ fp-        else return $ FD h--read :: FD -> IO (SourceIOResult S.ByteString)-read fd = do-    cstr <- mallocBytes 4096-    len <- c_read fd cstr 4096-    if len == 0-        then do-            free cstr-            return IOClosed-        else do-            fmap IOOpen $ BU.unsafePackCStringFinalizer-                cstr-                (fromIntegral len)-                (free cstr)
+ benchmarks/optimize-201408.hs view
@@ -0,0 +1,412 @@+{-# LANGUAGE BangPatterns              #-}+{-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE FlexibleContexts          #-}+{-# LANGUAGE MultiParamTypeClasses     #-}+{-# LANGUAGE TupleSections             #-}+{-# LANGUAGE RankNTypes                #-}+-- Collection of three benchmarks: a simple integral sum, monte carlo analysis,+-- and sliding vector.+import           Control.DeepSeq+import           Control.Monad               (foldM)+import           Control.Monad               (when, liftM)+import           Control.Monad.IO.Class      (liftIO)+import           Gauge.Main+import           Data.Conduit+import qualified Data.Conduit.Internal       as CI+import qualified Data.Conduit.List           as CL+import qualified Data.Foldable               as F+import           Data.IORef+import           Data.List                   (foldl')+import           Data.Monoid                 (mempty)+import qualified Data.Sequence               as Seq+import qualified Data.Vector                 as VB+import qualified Data.Vector.Generic         as V+import qualified Data.Vector.Generic.Mutable as VM+import qualified Data.Vector.Unboxed         as VU+import           System.Environment          (withArgs)+import qualified System.Random.MWC           as MWC+import           Test.Hspec++data TestBench = TBGroup String [TestBench]+               | TBBench Benchmark+               | forall a b. (Eq b, Show b) => TBPure String a b (a -> b)+               | forall a. (Eq a, Show a) => TBIO String a (IO a)+               | forall a. (Eq a, Show a) => TBIOTest String (a -> IO ()) (IO a)+               | forall a. (Eq a, Show a) => TBIOBench String a (IO a) (IO ())++toSpec :: TestBench -> Spec+toSpec (TBGroup name tbs) = describe name $ mapM_ toSpec tbs+toSpec (TBBench _) = return ()+toSpec (TBPure name a b f) = it name $ f a `shouldBe` b+toSpec (TBIO name a f) = it name $ f >>= (`shouldBe` a)+toSpec (TBIOTest name spec f) = it name $ f >>= spec+toSpec (TBIOBench name a f _) = it name $ f >>= (`shouldBe` a)++toBench :: TestBench -> Benchmark+toBench (TBGroup name tbs) = bgroup name $ map toBench tbs+toBench (TBBench b) = b+toBench (TBPure name a _ f) = bench name $ whnf f a+toBench (TBIO name _ f) = bench name $ whnfIO f+toBench (TBIOTest name _ f) = bench name $ whnfIO f+toBench (TBIOBench name _ _ f) = bench name $ whnfIO f++runTestBench :: [TestBench] -> IO ()+runTestBench tbs = do+    withArgs [] $ hspec $ mapM_ toSpec tbs+    defaultMain $ map toBench tbs++main :: IO ()+main = runTestBench =<< sequence+    [ sumTB+    , mapSumTB+    , monteCarloTB+    , fmap (TBGroup "sliding window") $ sequence+        [ slidingWindow 10+        , slidingWindow 30+        , slidingWindow 100+        , slidingWindow 1000+        ]+    ]++-----------------------------------------------------------------------++sumTB :: IO TestBench+sumTB = do+    upperRef <- newIORef upper0+    return $ TBGroup "sum"+        [ TBPure "Data.List.foldl'" upper0 expected+            $ \upper -> foldl' (+) 0 [1..upper]+        , TBIO "Control.Monad.foldM" expected $ do+            upper <- readIORef upperRef+            foldM plusM 0 [1..upper]+        , TBPure "low level" upper0 expected $ \upper ->+            let go x !t+                    | x > upper = t+                    | otherwise = go (x + 1) (t + x)+             in go 1 0+        , TBIO "boxed vectors, I/O" expected $ do+            upper <- readIORef upperRef+            VB.foldM' plusM 0 $ VB.enumFromTo 1 upper+        , TBPure "boxed vectors" upper0 expected+            $ \upper -> VB.foldl' (+) 0 (VB.enumFromTo 1 upper)+        , TBPure "unboxed vectors" upper0 expected+            $ \upper -> VU.foldl' (+) 0 (VU.enumFromTo 1 upper)+        , TBPure "conduit, pure, fold" upper0 expected+            $ \upper -> runConduitPure $ CL.enumFromTo 1 upper .| CL.fold (+) 0+        , TBPure "conduit, pure, foldM" upper0 expected+            $ \upper -> runConduitPure $ CL.enumFromTo 1 upper .| CL.foldM plusM 0+        , TBIO "conduit, IO, fold" expected $ do+            upper <- readIORef upperRef+            runConduit $ CL.enumFromTo 1 upper .| CL.fold (+) 0+        , TBIO "conduit, IO, foldM" expected $ do+            upper <- readIORef upperRef+            runConduit $ CL.enumFromTo 1 upper .| CL.foldM plusM 0+        ]+  where+    upper0 = 10000 :: Int+    expected = sum [1..upper0]++    plusM x y = return $! x + y++-----------------------------------------------------------------------++mapSumTB :: IO TestBench+mapSumTB = return $ TBGroup "map + sum"+    [ TBPure "boxed vectors" upper0 expected+        $ \upper -> VB.foldl' (+) 0+                  $ VB.map (+ 1)+                  $ VB.map (* 2)+                  $ VB.enumFromTo 1 upper+    , TBPure "unboxed vectors" upper0 expected+        $ \upper -> VU.foldl' (+) 0+                  $ VU.map (+ 1)+                  $ VU.map (* 2)+                  $ VU.enumFromTo 1 upper+    , TBPure "conduit, connect1" upper0 expected $ \upper -> runConduitPure+        $ CL.enumFromTo 1 upper+       .| CL.map (* 2)+       .| CL.map (+ 1)+       .| CL.fold (+) 0+    ]+  where+    upper0 = 10000 :: Int+    expected = sum $ map (+ 1) $ map (* 2) [1..upper0]++-----------------------------------------------------------------------++monteCarloTB :: IO TestBench+monteCarloTB = return $ TBGroup "monte carlo"+    [ TBIOTest "conduit" closeEnough $ do+        gen <- MWC.createSystemRandom+        successes <- runConduit+                   $ CL.replicateM count (MWC.uniform gen)+                  .| CL.fold (\t (x, y) ->+                                if (x*x + y*(y :: Double) < 1)+                                    then t + 1+                                    else t)+                        (0 :: Int)+        return $ fromIntegral successes / fromIntegral count * 4+    , TBIOTest "low level" closeEnough $ do+        gen <- MWC.createSystemRandom+        let go :: Int -> Int -> IO Double+            go 0 !t = return $! fromIntegral t / fromIntegral count * 4+            go i !t = do+                (x, y) <- MWC.uniform gen+                let t'+                        | x*x + y*(y :: Double) < 1 = t + 1+                        | otherwise = t+                go (i - 1) t'+        go count (0 :: Int)+    ]+  where+    count = 100000 :: Int++    closeEnough x+        | abs (x - 3.14159 :: Double) < 0.2 = return ()+        | otherwise = error $ "Monte carlo analysis too inaccurate: " ++ show x++-----------------------------------------------------------------------++slidingWindow :: Int -> IO TestBench+slidingWindow window = do+    upperRef <- newIORef upper0+    return $ TBGroup (show window)+        [ TBIOBench "low level, Seq" expected+            (swLowLevelSeq window upperRef id (\x y -> x . (F.toList y:)) ($ []))+            (swLowLevelSeq window upperRef () (\() y -> rnf y) id)+        , TBIOBench "conduit, Seq" expected+            (swConduitSeq window upperRef id (\x y -> x . (F.toList y:)) ($ []))+            (swConduitSeq window upperRef () (\() y -> rnf y) id)+        {- https://ghc.haskell.org/trac/ghc/ticket/9446+        , TBIOBench "low level, boxed Vector" expected+            (swLowLevelVector window upperRef id (\x y -> x . (VB.toList y:)) ($ []))+            (swLowLevelVector window upperRef () (\() y -> rnf (y :: VB.Vector Int)) id)+            -}+        , TBBench $ bench "low level, boxed Vector" $ whnfIO $+            swLowLevelVector window upperRef () (\() y -> rnf (y :: VB.Vector Int)) id++        {- https://ghc.haskell.org/trac/ghc/ticket/9446+        , TBIOBench "conduit, boxed Vector" expected+            (swConduitVector window upperRef id (\x y -> x . (VB.toList y:)) ($ []))+            (swConduitVector window upperRef () (\() y -> rnf (y :: VB.Vector Int)) id)+        -}++        , TBBench $ bench "conduit, boxed Vector" $ whnfIO $+            swConduitVector window upperRef () (\() y -> rnf (y :: VB.Vector Int)) id+++        , TBIOBench "low level, unboxed Vector" expected+            (swLowLevelVector window upperRef id (\x y -> x . (VU.toList y:)) ($ []))+            (swLowLevelVector window upperRef () (\() y -> rnf (y :: VU.Vector Int)) id)+        , TBIOBench "conduit, unboxed Vector" expected+            (swConduitVector window upperRef id (\x y -> x . (VU.toList y:)) ($ []))+            (swConduitVector window upperRef () (\() y -> rnf (y :: VU.Vector Int)) id)+        ]+  where+    upper0 = 10000+    expected =+        loop [1..upper0]+      where+        loop input+            | length x == window = x : loop y+            | otherwise = []+          where+            x = take window input+            y = drop 1 input++swLowLevelSeq :: Int -> IORef Int -> t -> (t -> Seq.Seq Int -> t) -> (t -> t') -> IO t'+swLowLevelSeq window upperRef t0 f final = do+    upper <- readIORef upperRef++    let phase1 i !s+            | i > window = phase2 i s t0+            | otherwise = phase1 (i + 1) (s Seq.|> i)++        phase2 i !s !t+            | i > upper = t'+            | otherwise = phase2 (i + 1) s' t'+          where+            t' = f t s+            s' = Seq.drop 1 s Seq.|> i++    return $! final $! phase1 1 mempty++swLowLevelVector :: V.Vector v Int+                 => Int+                 -> IORef Int+                 -> t+                 -> (t -> v Int -> t)+                 -> (t -> t')+                 -> IO t'+swLowLevelVector window upperRef t0 f final = do+    upper <- readIORef upperRef++    let go !i !t _ _ _ | i > upper = return $! final $! t+        go !i !t !end _mv mv2 | end == bufSz  = newBuf >>= go i t sz mv2+        go !i !t !end mv mv2 = do+            VM.unsafeWrite mv end i+            when (end > sz) $ VM.unsafeWrite mv2 (end - sz) i+            let end' = end + 1+            t' <-+                if end' < sz+                    then return t+                    else do+                        v <- V.unsafeFreeze $ VM.unsafeSlice (end' - sz) sz mv+                        return $! f t v+            go (i + 1) t' end' mv mv2++    mv <- newBuf+    mv2 <- newBuf+    go 1 t0 0 mv mv2+  where+    sz = window+    bufSz = 2 * window+    newBuf = VM.new bufSz++swConduitSeq :: Int+             -> IORef Int+             -> t+             -> (t -> Seq.Seq Int -> t)+             -> (t -> t')+             -> IO t'+swConduitSeq window upperRef t0 f final = do+    upper <- readIORef upperRef++    t <- runConduit+       $ CL.enumFromTo 1 upper+      .| slidingWindowC window+      .| CL.fold f t0+    return $! final t++swConduitVector :: V.Vector v Int+                => Int+                -> IORef Int+                -> t+                -> (t -> v Int -> t)+                -> (t -> t')+                -> IO t'+swConduitVector window upperRef t0 f final = do+    upper <- readIORef upperRef++    t <- runConduit+       $ CL.enumFromTo 1 upper+      .| slidingVectorC window+      .| CL.fold f t0+    return $! final t++slidingWindowC :: Monad m => Int -> ConduitT a (Seq.Seq a) m ()+slidingWindowC = slidingWindowCC+{-# INLINE [0] slidingWindowC #-}+{-# RULES "unstream slidingWindowC"+    forall i. slidingWindowC i = CI.unstream (CI.streamConduit (slidingWindowCC i) (slidingWindowS i))+  #-}++slidingWindowCC :: Monad m => Int -> ConduitT a (Seq.Seq a) m ()+slidingWindowCC sz =+    go sz mempty+  where+    goContinue st = await >>=+                    maybe (return ())+                          (\x -> do+                             let st' = st Seq.|> x+                             yield st' >> goContinue (Seq.drop 1 st')+                          )+    go 0 st = yield st >> goContinue (Seq.drop 1 st)+    go !n st = CL.head >>= \m ->+               case m of+                 Nothing | n < sz -> yield st+                         | otherwise -> return ()+                 Just x -> go (n-1) (st Seq.|> x)+{-# INLINE slidingWindowCC #-}++slidingWindowS :: Monad m => Int -> CI.Stream m a () -> CI.Stream m (Seq.Seq a) ()+slidingWindowS sz (CI.Stream step ms0) =+    CI.Stream step' $ liftM (\s -> Left (s, sz, mempty)) ms0+  where+    step' (Left (s, 0, st)) = return $ CI.Emit (Right (s, st)) st+    step' (Left (s, i, st)) = do+        res <- step s+        return $ case res of+            CI.Stop () -> CI.Stop ()+            CI.Skip s' -> CI.Skip $ Left (s', i, st)+            CI.Emit s' a -> CI.Skip $ Left (s', i - 1, st Seq.|> a)+    step' (Right (s, st)) = do+        res <- step s+        return $ case res of+            CI.Stop () -> CI.Stop ()+            CI.Skip s' -> CI.Skip $ Right (s', st)+            CI.Emit s' a ->+                let st' = Seq.drop 1 st Seq.|> a+                 in CI.Emit (Right (s', st')) st'+{-# INLINE slidingWindowS #-}++slidingVectorC :: V.Vector v a => Int -> ConduitT a (v a) IO ()+slidingVectorC = slidingVectorCC+{-# INLINE [0] slidingVectorC #-}+{-# RULES "unstream slidingVectorC"+    forall i. slidingVectorC i = CI.unstream (CI.streamConduit (slidingVectorCC i) (slidingVectorS i))+  #-}++slidingVectorCC :: V.Vector v a => Int -> ConduitT a (v a) IO ()+slidingVectorCC sz = do+    mv <- newBuf+    mv2 <- newBuf+    go 0 mv mv2+  where+    bufSz = 2 * sz+    newBuf = liftIO (VM.new bufSz)++    go !end _mv mv2 | end == bufSz  = newBuf >>= go sz mv2+    go !end mv mv2 = do+      mx <- await+      case mx of+        Nothing -> when (end > 0 && end < sz) $ do+          v <- liftIO $ V.unsafeFreeze $ VM.take end mv+          yield v+        Just x -> do+          liftIO $ do+            VM.unsafeWrite mv end x+            when (end > sz) $ VM.unsafeWrite mv2 (end - sz) x+          let end' = end + 1+          when (end' >= sz) $ do+            v <- liftIO $ V.unsafeFreeze $ VM.unsafeSlice (end' - sz) sz mv+            yield v+          go end' mv mv2++slidingVectorS :: V.Vector v a => Int -> CI.Stream IO a () -> CI.Stream IO (v a) ()+slidingVectorS sz (CI.Stream step ms0) =+    CI.Stream step' ms1+  where+    bufSz = 2 * sz+    newBuf = liftIO (VM.new bufSz)++    ms1 = do+        s <- ms0+        mv <- newBuf+        mv2 <- newBuf+        return (s, 0, mv, mv2)++    step' (_, -1, _, _) = return $ CI.Stop ()+    step' (s, end, _mv, mv2) | end == bufSz = do+        mv3 <- newBuf+        return $ CI.Skip (s, sz, mv2, mv3)+    step' (s, end, mv, mv2) = do+        res <- step s+        case res of+            CI.Stop ()+                | end > 0 && end < sz -> do+                    v <- liftIO $ V.unsafeFreeze $ VM.take end mv+                    return $ CI.Emit (s, -1, mv, mv2) v+                | otherwise -> return $ CI.Stop ()+            CI.Skip s' -> return $ CI.Skip (s', end, mv, mv2)+            CI.Emit s' x -> liftIO $ do+                VM.unsafeWrite mv end x+                when (end > sz) $ VM.unsafeWrite mv2 (end - sz) x+                let end' = end + 1+                    state = (s', end', mv, mv2)+                if end' >= sz+                    then do+                        v <- V.unsafeFreeze $ VM.unsafeSlice (end' - sz) sz mv+                        return $ CI.Emit state v+                    else return $ CI.Skip state+{-# INLINE slidingVectorS #-}
+ benchmarks/unfused.hs view
@@ -0,0 +1,77 @@+{-# LANGUAGE RankNTypes, BangPatterns #-}+-- Compare low-level, fused, unfused, and partially fused+import Data.Conduit+import qualified Data.Conduit.List as CL+import Gauge.Main++-- | unfused+enumFromToC :: (Eq a, Monad m, Enum a) => a -> a -> ConduitT i a m ()+enumFromToC x0 y =+    loop x0+  where+    loop x+        | x == y = yield x+        | otherwise = yield x >> loop (succ x)+{-# INLINE enumFromToC #-}++-- | unfused+mapC :: Monad m => (a -> b) -> ConduitT a b m ()+mapC f = awaitForever $ yield . f+{-# INLINE mapC #-}++-- | unfused+foldC :: Monad m => (b -> a -> b) -> b -> ConduitT a o m b+foldC f =+    loop+  where+    loop !b = await >>= maybe (return b) (loop . f b)+{-# INLINE foldC #-}++main :: IO ()+main = defaultMain+    [ bench "low level" $ flip whnf upper0 $ \upper ->+        let loop x t+                | x > upper = t+                | otherwise = loop (x + 1) (t + ((x * 2) + 1))+         in loop 1 0+    , bench "completely fused" $ flip whnf upper0 $ \upper ->+              runConduitPure+            $ CL.enumFromTo 1 upper+           .| CL.map (* 2)+           .| CL.map (+ 1)+           .| CL.fold (+) 0+    , bench "runConduit, completely fused" $ flip whnf upper0 $ \upper ->+             runConduitPure+           $ CL.enumFromTo 1 upper+          .| CL.map (* 2)+          .| CL.map (+ 1)+          .| CL.fold (+) 0+    , bench "completely unfused" $ flip whnf upper0 $ \upper ->+              runConduitPure+            $ enumFromToC 1 upper+           .| mapC (* 2)+           .| mapC (+ 1)+           .| foldC (+) 0+    , bench "beginning fusion" $ flip whnf upper0 $ \upper ->+              runConduitPure+            $ (CL.enumFromTo 1 upper .| CL.map (* 2))+           .| mapC (+ 1)+           .| foldC (+) 0+    , bench "middle fusion" $ flip whnf upper0 $ \upper ->+              runConduitPure+            $ enumFromToC 1 upper+           .| (CL.map (* 2) .| CL.map (+ 1))+           .| foldC (+) 0+    , bench "ending fusion" $ flip whnf upper0 $ \upper ->+              runConduitPure+            $ enumFromToC 1 upper+           .| mapC (* 2)+           .| (CL.map (+ 1) .| CL.fold (+) 0)+    , bench "performance of CL.enumFromTo without fusion" $ flip whnf upper0 $ \upper ->+              runConduitPure+            $ CL.enumFromTo 1 upper+           .| mapC (* 2)+           .| (CL.map (+ 1) .| CL.fold (+) 0)+    ]+  where+    upper0 = 100000 :: Int
conduit.cabal view
@@ -1,78 +1,150 @@ Name:                conduit-Version:             0.2.2+Version:             1.3.6.1 Synopsis:            Streaming data processing library.-Description:-	Conduits are an approach to the streaming data problem. It is meant as an alternative to enumerators\/iterators, hoping to address the same issues with different trade-offs based on real-world experience with enumerators. For more information, see <http://www.yesodweb.com/book/conduit>.-	.-	Release history:-	.-    [0.2] Instead of storing state in mutable variables, we now use CPS. A @Source@ returns the next @Source@, and likewise for @Sink@s and @Conduit@s. Not only does this take better advantage of GHC\'s optimizations (about a 20% speedup), but it allows some operations to have a reduction in algorithmic complexity from exponential to linear. This also allowed us to remove the @Prepared@ set of types. Also, the @State@ functions (e.g., @sinkState@) use better constructors for return types, avoiding the need for a dummy state on completion.+description:+    `conduit` is a solution to the streaming data problem, allowing for production,+    transformation, and consumption of streams of data in constant memory. It is an+    alternative to lazy I\/O which guarantees deterministic resource handling.     .-	[0.1] @BufferedSource@ is now an abstract type, and has a much more efficient internal representation. The result was a 41% speedup on microbenchmarks (note: do not expect speedups anywhere near that in real usage). In general, we are moving towards @BufferedSource@ being a specific tool used internally as needed, but using @Source@ for all external APIs.-	.-	[0.0] Initial release.-License:             BSD3+    For more information about conduit in general, and how this package in+    particular fits into the ecosystem, see [the conduit+    homepage](https://github.com/snoyberg/conduit#readme).+    .+    Hackage documentation generation is not reliable. For up to date documentation, please see: <http://www.stackage.org/package/conduit>.+License:             MIT License-file:        LICENSE Author:              Michael Snoyman Maintainer:          michael@snoyman.com Category:            Data, Conduit Build-type:          Simple-Cabal-version:       >=1.8+Cabal-version:       >=1.10 Homepage:            http://github.com/snoyberg/conduit-extra-source-files:  test/main.hs, test/random--flag debug-    default: True-    description: Turn on some runtime check to ensure invariants are respected.--flag nohandles+extra-source-files:  test/main.hs+                   , test/doctests.hs+                   , test/subdir/dummyfile.txt+                   , README.md+                   , ChangeLog.md+                   , fusion-macros.h  Library-  if os(windows)-      cpp-options: -DCABAL_OS_WINDOWS-      other-modules: System.Win32File-  else-      other-modules: System.PosixFile-  if flag(nohandles)-      cpp-options: -DNO_HANDLES+  default-language:    Haskell2010+  hs-source-dirs:      src   Exposed-modules:     Data.Conduit-                       Data.Conduit.Binary-                       Data.Conduit.Text+                       Data.Conduit.Combinators                        Data.Conduit.List-                       Data.Conduit.Lazy-                       Control.Monad.Trans.Resource-  Other-modules:       Data.Conduit.Types.Source-                       Data.Conduit.Types.Sink-                       Data.Conduit.Types.Conduit-                       Data.Conduit.Util.Source-                       Data.Conduit.Util.Sink-                       Data.Conduit.Util.Conduit-  Build-depends:       base                     >= 4.3          && < 5-                     , lifted-base              >= 0.1          && < 0.2-                     , transformers-base        >= 0.4.1        && < 0.5-                     , monad-control            >= 0.3.1        && < 0.4-                     , containers-                     , transformers             >= 0.2.2        && < 0.3-                     , bytestring               >= 0.9-                     , text                     >= 0.11-  ghc-options:     -Wall-  if flag(debug)-    cpp-options: -DDEBUG+                       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+                       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+                     , primitive+                     , unliftio-core+                     , exceptions+                     , mono-traversable         >= 1.0.7+                     , vector+                     , bytestring+                     , text+                     , filepath+                     , directory -test-suite test+  if os(windows)+    build-depends:     Win32+    other-modules:     System.Win32File+    cpp-options:       -DWINDOWS+  else+    build-depends:     unix++  ghc-options:         -Wall+  include-dirs:        .++test-suite conduit-test+    default-language:    Haskell2010     hs-source-dirs: test     main-is: main.hs+    other-modules: Data.Conduit.Extra.ZipConduitSpec+                 , Data.Conduit.StreamSpec+                 , Spec+                 , StreamSpec     type: exitcode-stdio-1.0     cpp-options:   -DTEST     build-depends:   conduit                    , base-                   , hspec >= 0.9.1-                   , HUnit-                   , QuickCheck-                   , bytestring+                   , hspec >= 1.3+                   , QuickCheck >= 2.7                    , transformers+                   , mtl+                   , resourcet+                   , containers+                   , exceptions >= 0.6+                   , safe+                   , split >= 0.2.0.0+                   , mono-traversable                    , text+                   , vector+                   , directory+                   , bytestring+                   , silently+                   , filepath+                   , unliftio >= 0.2.4.0     ghc-options:     -Wall++    if os(windows)+      cpp-options:     -DWINDOWS++--test-suite doctests+--    hs-source-dirs: test+--    main-is: doctests.hs+--    type: exitcode-stdio-1.0+--    ghc-options: -threaded+--    build-depends: base, directory, doctest >= 0.8++-- benchmark utf8-memory-usage+--     type: exitcode-stdio-1.0+--     hs-source-dirs: benchmarks+--     build-depends:  base+--                   , text-stream-decode+--                   , bytestring+--                   , text+--                   , conduit+--     main-is:        utf8-memory-usage.hs+--     ghc-options:    -Wall -O2 -with-rtsopts=-s++benchmark optimize-201408+    default-language:    Haskell2010+    type: exitcode-stdio-1.0+    hs-source-dirs: benchmarks+    build-depends:  base+                  , conduit+                  , vector+                  , deepseq+                  , containers+                  , transformers+                  , hspec+                  , mwc-random+                  , gauge+    main-is:        optimize-201408.hs+    ghc-options:    -Wall -O2 -rtsopts++benchmark unfused+    default-language:    Haskell2010+    type: exitcode-stdio-1.0+    hs-source-dirs: benchmarks+    build-depends:  base+                  , conduit+                  , gauge+                  , transformers+    main-is:        unfused.hs+    ghc-options:    -Wall -O2 -rtsopts  source-repository head   type:     git
+ fusion-macros.h view
@@ -0,0 +1,23 @@+#define INLINE_RULE0(new,old)             ;\+    new = old                            ;\+    {-# INLINE [0] new #-}               ;\+    {-# RULES "inline new" new = old #-}++#define INLINE_RULE(new,vars,body)                           ;\+    new vars = body                                         ;\+    {-# INLINE [0] new #-}                                  ;\+    {-# RULES "inline new" forall vars. new vars = body #-}++#define STREAMING0(name, nameC, nameS)                   ;\+    name = nameC                                         ;\+    {-# INLINE [0] name #-}                              ;\+    {-# RULES "unstream name"                             \+      name = unstream (streamConduit nameC nameS)         \+      #-}++#define STREAMING(name, nameC, nameS, vars)                             ;\+    name = nameC                                                        ;\+    {-# INLINE [0] name #-}                                             ;\+    {-# RULES "unstream name" forall vars.                              \+      name vars = unstream (streamConduit (nameC vars) (nameS vars))    \+      #-}
+ src/Conduit.hs view
@@ -0,0 +1,43 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE FlexibleContexts #-}+-- | Your intended one-stop-shop for conduit functionality.+-- This re-exports functions from many commonly used modules.+-- When there is a conflict with standard functions, functions+-- in this module are disambiguated by adding a trailing C+-- (or for chunked functions, replacing a trailing E with CE).+-- This means that the Conduit module can be imported unqualified+-- without causing naming conflicts.+--+-- For more information on the naming scheme and intended usages of the+-- combinators, please see the "Data.Conduit.Combinators" documentation.+module Conduit+    ( -- * Core conduit library+      module Data.Conduit+    , module Data.Conduit.Lift+      -- * Commonly used combinators+    , module Data.Conduit.Combinators.Unqualified+      -- * Monadic lifting+    , MonadIO (..)+    , MonadTrans (..)+    , MonadThrow (..)+    , MonadUnliftIO (..)+    , PrimMonad (..)+      -- * ResourceT+    , MonadResource+    , ResourceT+    , runResourceT+      -- * Acquire+    , module Data.Acquire+      -- * Pure pipelines+    , Identity (..)+    ) where++import Data.Conduit+import Control.Monad.IO.Unlift (MonadIO (..), MonadUnliftIO (..))+import Control.Monad.Trans.Class (MonadTrans (..))+import Control.Monad.Primitive (PrimMonad (..), PrimState)+import Data.Conduit.Lift+import Data.Conduit.Combinators.Unqualified+import Data.Functor.Identity (Identity (..))+import Control.Monad.Trans.Resource (MonadResource, MonadThrow (..), runResourceT, ResourceT)+import Data.Acquire hiding (with)
+ src/Data/Conduit.hs view
@@ -0,0 +1,107 @@+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE FlexibleContexts #-}+-- | If this is your first time with conduit, you should probably start with+-- the tutorial:+-- <https://github.com/snoyberg/conduit#readme>.+module Data.Conduit+    ( -- * Core interface+      -- ** Types+      ConduitT+      -- *** Deprecated+    , Source+    , Conduit+    , Sink+    , ConduitM+      -- ** Connect/fuse operators+    , (.|)+    , connect+    , fuse+      -- *** Deprecated+    , ($$)+    , ($=)+    , (=$)+    , (=$=)++      -- *** Fuse with upstream results+    , fuseBoth+    , fuseBothMaybe+    , fuseUpstream++      -- ** Primitives+    , await+    , yield+    , yieldM+    , leftover+    , runConduit+    , runConduitPure+    , runConduitRes++      -- ** Finalization+    , bracketP++      -- ** Exception handling+    , catchC+    , handleC+    , tryC++      -- * Generalized conduit types+    , Producer+    , Consumer+    , toProducer+    , toConsumer++      -- * Utility functions+    , awaitForever+    , transPipe+    , mapOutput+    , mapOutputMaybe+    , mapInput+    , mapInputM+    , mergeSource+    , passthroughSink+    , sourceToList++      -- * Connect-and-resume+    , SealedConduitT+    , sealConduitT+    , unsealConduitT+    , ($$+)+    , ($$++)+    , ($$+-)+    , ($=+)++      -- ** For @Conduit@s+    , (=$$+)+    , (=$$++)+    , (=$$+-)++      -- * Fusion with leftovers+    , fuseLeftovers+    , fuseReturnLeftovers++      -- * Flushing+    , Flush (..)++      -- * Newtype wrappers+      -- ** ZipSource+    , ZipSource (..)+    , sequenceSources++      -- ** ZipSink+    , ZipSink (..)+    , sequenceSinks++      -- ** ZipConduit+    , ZipConduit (..)+    , sequenceConduits++      -- * Convenience reexports+    , Void -- FIXME consider instead relaxing type of runConduit+    ) where++import Data.Conduit.Internal.Conduit+import Data.Void (Void)+import Data.Functor.Identity (Identity, runIdentity)+import Control.Monad.Trans.Resource (ResourceT, runResourceT)+import Control.Monad.IO.Unlift (MonadUnliftIO)
+ src/Data/Conduit/Combinators.hs view
@@ -0,0 +1,2556 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE MultiParamTypeClasses     #-}+{-# LANGUAGE NoImplicitPrelude         #-}+{-# LANGUAGE NoMonomorphismRestriction #-}+{-# LANGUAGE BangPatterns #-}+-- | This module is meant as a replacement for Data.Conduit.List.+-- That module follows a naming scheme which was originally inspired+-- by its enumerator roots. This module is meant to introduce a naming+-- scheme which encourages conduit best practices.+--+-- There are two versions of functions in this module. Those with a trailing+-- E work in the individual elements of a chunk of data, e.g., the bytes of+-- a ByteString, the Chars of a Text, or the Ints of a Vector Int. Those+-- without a trailing E work on unchunked streams.+--+-- FIXME: discuss overall naming, usage of mono-traversable, etc+--+-- Mention take (Conduit) vs drop (Consumer)+module Data.Conduit.Combinators+    ( -- * Producers+      -- ** Pure+      yieldMany+    , unfold+    , enumFromTo+    , iterate+    , repeat+    , replicate+    , sourceLazy++      -- ** Monadic+    , repeatM+    , repeatWhileM+    , replicateM++      -- ** I\/O+    , sourceFile+    , sourceFileBS+    , sourceHandle+    , sourceHandleUnsafe+    , sourceIOHandle+    , stdin+    , withSourceFile++      -- ** Filesystem+    , sourceDirectory+    , sourceDirectoryDeep++      -- * Consumers+      -- ** Pure+    , drop+    , dropE+    , dropWhile+    , dropWhileE+    , fold+    , foldE+    , foldl+    , foldl1+    , foldlE+    , foldMap+    , foldMapE+    , foldWhile+    , all+    , allE+    , any+    , anyE+    , and+    , andE+    , or+    , orE+    , asum+    , elem+    , elemE+    , notElem+    , notElemE+    , sinkLazy+    , sinkList+    , sinkVector+    , sinkVectorN+    , sinkLazyBuilder+    , sinkNull+    , awaitNonNull+    , head+    , headDef+    , headE+    , peek+    , peekE+    , last+    , lastDef+    , lastE+    , length+    , lengthE+    , lengthIf+    , lengthIfE+    , maximum+    , maximumE+    , minimum+    , minimumE+    , null+    , nullE+    , sum+    , sumE+    , product+    , productE+    , find++      -- ** Monadic+    , mapM_+    , mapM_E+    , foldM+    , foldME+    , foldMapM+    , foldMapME++      -- ** I\/O+    , sinkFile+    , sinkFileCautious+    , sinkTempFile+    , sinkSystemTempFile+    , sinkFileBS+    , sinkHandle+    , sinkIOHandle+    , print+    , stdout+    , stderr+    , withSinkFile+    , withSinkFileBuilder+    , withSinkFileCautious+    , sinkHandleBuilder+    , sinkHandleFlush++      -- * Transformers+      -- ** Pure+    , map+    , mapE+    , omapE+    , concatMap+    , concatMapE+    , take+    , takeE+    , takeWhile+    , takeWhileE+    , takeExactly+    , takeExactlyE+    , concat+    , filter+    , filterE+    , mapWhile+    , conduitVector+    , scanl+    , mapAccumWhile+    , concatMapAccum+    , intersperse+    , slidingWindow+    , chunksOfE+    , chunksOfExactlyE++      -- ** Monadic+    , mapM+    , mapME+    , omapME+    , concatMapM+    , filterM+    , filterME+    , iterM+    , scanlM+    , mapAccumWhileM+    , concatMapAccumM++      -- ** Textual+    , encodeUtf8+    , decodeUtf8+    , decodeUtf8Lenient+    , line+    , lineAscii+    , unlines+    , unlinesAscii+    , takeExactlyUntilE+    , linesUnbounded+    , linesUnboundedAscii+    , splitOnUnboundedE++      -- ** Builders+    , builderToByteString+    , unsafeBuilderToByteString+    , builderToByteStringWith+    , builderToByteStringFlush+    , builderToByteStringWithFlush+    , BufferAllocStrategy+    , allNewBuffersStrategy+    , reuseBufferStrategy++      -- * Special+    , vectorBuilder+    , mapAccumS+    , peekForever+    , peekForeverE+    ) where++-- BEGIN IMPORTS++import           Data.ByteString.Builder     (Builder, toLazyByteString, hPutBuilder)+import qualified Data.ByteString.Builder.Internal as BB (flush)+import qualified Data.ByteString.Builder.Extra as BB (runBuilder, Next(Done, More, Chunk))+import qualified Data.NonNull as NonNull+import qualified Data.Traversable+import qualified Data.ByteString as S+import qualified Data.ByteString.Lazy as BL+import           Data.ByteString.Lazy.Internal (defaultChunkSize)+import           Control.Applicative         (Alternative(..), (<$>))+import           Control.Exception           (catch, throwIO, finally, bracket, try, evaluate)+import           Control.Category            (Category (..))+import           Control.Monad               (unless, when, (>=>), liftM, forever)+import           Control.Monad.IO.Unlift     (MonadIO (..), MonadUnliftIO, withRunInIO)+import           Control.Monad.Primitive     (PrimMonad, PrimState, unsafePrimToPrim)+import           Control.Monad.Trans.Class   (lift)+import           Control.Monad.Trans.Resource (MonadResource, MonadThrow, allocate, throwM)+import           Data.Conduit+import           Data.Conduit.Internal       (ConduitT (..), Pipe (..))+import qualified Data.Conduit.List           as CL+import           Data.IORef+import           Data.Maybe                  (fromMaybe, isNothing, isJust)+import           Data.Monoid                 (Monoid (..))+import           Data.MonoTraversable+import qualified Data.Sequences              as Seq+import qualified Data.Vector.Generic         as V+import qualified Data.Vector.Generic.Mutable as VM+import           Data.Void                   (absurd)+import           Prelude                     (Bool (..), Eq (..), Int,+                                              Maybe (..), Either (..), Monad (..), Num (..),+                                              Ord (..), fromIntegral, maybe, either,+                                              ($), Functor (..), Enum, seq, Show, Char,+                                              otherwise, Either (..), not,+                                              ($!), succ, FilePath, IO, String)+import Data.Word (Word8)+import qualified Prelude+import qualified System.IO                   as IO+import           System.IO.Error             (isDoesNotExistError)+import           System.IO.Unsafe            (unsafePerformIO)+import Data.ByteString (ByteString)+import Data.Text (Text)+import qualified Data.Text as T+import qualified Data.Text.Encoding as TE+import qualified Data.Text.Encoding.Error as TEE+import Data.Conduit.Combinators.Stream+import Data.Conduit.Internal.Fusion+import           Data.Primitive.MutVar       (MutVar, newMutVar, readMutVar,+                                              writeMutVar)+import qualified Data.Streaming.FileRead as FR+import qualified Data.Streaming.Filesystem as F+import           GHC.ForeignPtr (mallocPlainForeignPtrBytes, unsafeForeignPtrToPtr)+import           Foreign.ForeignPtr (touchForeignPtr, ForeignPtr)+import           Foreign.Ptr (Ptr, plusPtr, minusPtr)+import           Data.ByteString.Internal (ByteString (PS), mallocByteString)+import           System.FilePath ((</>), (<.>), takeDirectory, takeFileName)+import           System.Directory (renameFile, getTemporaryDirectory, removeFile)++import qualified Data.Sequences as DTE+import           Data.Sequences (LazySequence (..))++-- Defines INLINE_RULE0, INLINE_RULE, STREAMING0, and STREAMING.+#include "fusion-macros.h"++-- END IMPORTS++-- TODO:+--+--   * The functions sourceRandom* are based on, initReplicate and+--   initRepeat have specialized versions for when they're used with+--   ($$).  How does this interact with stream fusion?+--+--   * Is it possible to implement fusion for vectorBuilder?  Since it+--   takes a Sink yielding function as an input, the rewrite rule+--   would need to trigger when that parameter looks something like+--   (\x -> unstream (...)).  I don't see anything preventing doing+--   this, but it would be quite a bit of code.++-- NOTE: Fusion isn't possible for the following operations:+--+--   * Due to a lack of leftovers:+--     - dropE, dropWhile, dropWhileE+--     - headE+--     - peek, peekE+--     - null, nullE+--     - takeE, takeWhile, takeWhileE+--     - mapWhile+--     - codeWith+--     - line+--     - lineAscii+--+--   * Due to a use of leftover in a dependency:+--     - Due to "codeWith": encodeBase64, decodeBase64, encodeBase64URL, decodeBase64URL, decodeBase16+--     - due to "CT.decode": decodeUtf8, decodeUtf8Lenient+--+--   * Due to lack of resource cleanup (e.g. bracketP):+--     - sourceDirectory+--     - sourceDirectoryDeep+--     - sourceFile+--+--   * takeExactly / takeExactlyE - no monadic bind.  Another way to+--   look at this is that subsequent streams drive stream evaluation,+--   so there's no way for the conduit to guarantee a certain amount+--   of demand from the upstream.++-- | Yield each of the values contained by the given @MonoFoldable@.+--+-- This will work on many data structures, including lists, @ByteString@s, and @Vector@s.+--+-- Subject to fusion+--+-- @since 1.3.0+yieldMany, yieldManyC :: (Monad m, MonoFoldable mono)+                      => mono+                      -> ConduitT i (Element mono) m ()+yieldManyC = ofoldMap yield+{-# INLINE yieldManyC #-}+STREAMING(yieldMany, yieldManyC, yieldManyS, x)++-- | Generate a producer from a seed value.+--+-- Subject to fusion+--+-- @since 1.3.0+unfold :: Monad m+       => (b -> Maybe (a, b))+       -> b+       -> ConduitT i a m ()+INLINE_RULE(unfold, f x, CL.unfold f x)++-- | Enumerate from a value to a final value, inclusive, via 'succ'.+--+-- This is generally more efficient than using @Prelude@\'s @enumFromTo@ and+-- combining with @sourceList@ since this avoids any intermediate data+-- structures.+--+-- Subject to fusion+--+-- @since 1.3.0+enumFromTo :: (Monad m, Enum a, Ord a) => a -> a -> ConduitT i a m ()+INLINE_RULE(enumFromTo, f t, CL.enumFromTo f t)++-- | Produces an infinite stream of repeated applications of f to x.+--+-- Subject to fusion+--+-- @since 1.3.0+iterate :: Monad m => (a -> a) -> a -> ConduitT i a m ()+INLINE_RULE(iterate, f t, CL.iterate f t)++-- | Produce an infinite stream consisting entirely of the given value.+--+-- Subject to fusion+--+-- @since 1.3.0+repeat :: Monad m => a -> ConduitT i a m ()+INLINE_RULE(repeat, x, iterate id x)++-- | Produce a finite stream consisting of n copies of the given value.+--+-- Subject to fusion+--+-- @since 1.3.0+replicate :: Monad m+          => Int+          -> a+          -> ConduitT i a m ()+INLINE_RULE(replicate, n x, CL.replicate n x)++-- | Generate a producer by yielding each of the strict chunks in a @LazySequence@.+--+-- For more information, see 'toChunks'.+--+-- Subject to fusion+--+-- @since 1.3.0+sourceLazy :: (Monad m, LazySequence lazy strict)+           => lazy+           -> ConduitT i strict m ()+INLINE_RULE(sourceLazy, x, yieldMany (toChunks x))++-- | Repeatedly run the given action and yield all values it produces.+--+-- Subject to fusion+--+-- @since 1.3.0+repeatM, repeatMC :: Monad m+                  => m a+                  -> ConduitT i a m ()+repeatMC m = forever $ lift m >>= yield+{-# INLINE repeatMC #-}+STREAMING(repeatM, repeatMC, repeatMS, m)++-- | Repeatedly run the given action and yield all values it produces, until+-- the provided predicate returns @False@.+--+-- Subject to fusion+--+-- @since 1.3.0+repeatWhileM, repeatWhileMC :: Monad m+                            => m a+                            -> (a -> Bool)+                            -> ConduitT i a m ()+repeatWhileMC m f =+    loop+  where+    loop = do+        x <- lift m+        when (f x) $ yield x >> loop+STREAMING(repeatWhileM, repeatWhileMC, repeatWhileMS, m f)++-- | Perform the given action n times, yielding each result.+--+-- Subject to fusion+--+-- @since 1.3.0+replicateM :: Monad m+           => Int+           -> m a+           -> ConduitT i a m ()+INLINE_RULE(replicateM, n m, CL.replicateM n m)++-- | Stream the contents of a file as binary data.+--+-- @since 1.3.0+sourceFile :: MonadResource m+           => FilePath+           -> ConduitT i S.ByteString m ()+sourceFile fp =+    bracketP+        (FR.openFile fp)+         FR.closeFile+         loop+  where+    loop h = do+        bs <- liftIO $ FR.readChunk h+        unless (S.null bs) $ do+            yield bs+            loop h++-- | Stream the contents of a 'IO.Handle' as binary data. Note that this+-- function will /not/ automatically close the @Handle@ when processing+-- completes, since it did not acquire the @Handle@ in the first place.+--+-- @since 1.3.0+sourceHandle :: MonadIO m+             => IO.Handle+             -> ConduitT i S.ByteString m ()+sourceHandle h =+    loop+  where+    loop = do+        bs <- liftIO (S.hGetSome h defaultChunkSize)+        if S.null bs+            then return ()+            else yield bs >> loop++-- | Same as @sourceHandle@, but instead of allocating a new buffer for each+-- incoming chunk of data, reuses the same buffer. Therefore, the @ByteString@s+-- yielded by this function are not referentially transparent between two+-- different @yield@s.+--+-- This function will be slightly more efficient than @sourceHandle@ by+-- avoiding allocations and reducing garbage collections, but should only be+-- used if you can guarantee that you do not reuse a @ByteString@ (or any slice+-- thereof) between two calls to @await@.+--+-- @since 1.3.0+sourceHandleUnsafe :: MonadIO m => IO.Handle -> ConduitT i ByteString m ()+sourceHandleUnsafe handle = do+    fptr <- liftIO $ mallocPlainForeignPtrBytes defaultChunkSize+    let ptr = unsafeForeignPtrToPtr fptr+        loop = do+            count <- liftIO $ IO.hGetBuf handle ptr defaultChunkSize+            when (count > 0) $ do+                yield (PS fptr 0 count)+                loop++    loop++    liftIO $ touchForeignPtr fptr++-- | An alternative to 'sourceHandle'.+-- Instead of taking a pre-opened 'IO.Handle', it takes an action that opens+-- a 'IO.Handle' (in read mode), so that it can open it only when needed+-- and close it as soon as possible.+--+-- @since 1.3.0+sourceIOHandle :: MonadResource m+               => IO IO.Handle+               -> ConduitT i S.ByteString m ()+sourceIOHandle alloc = bracketP alloc IO.hClose sourceHandle++-- | Same as 'sourceFile'. The alternate name is a holdover from an older+-- version, when 'sourceFile' was more polymorphic than it is today.+--+-- @since 1.3.0+sourceFileBS :: MonadResource m => FilePath -> ConduitT i ByteString m ()+sourceFileBS = sourceFile+{-# INLINE sourceFileBS #-}++-- | @sourceHandle@ applied to @stdin@.+--+-- Subject to fusion+--+-- @since 1.3.0+stdin :: MonadIO m => ConduitT i ByteString m ()+INLINE_RULE0(stdin, sourceHandle IO.stdin)++-- | Stream all incoming data to the given file.+--+-- @since 1.3.0+sinkFile :: MonadResource m+         => FilePath+         -> ConduitT S.ByteString o m ()+sinkFile fp = sinkIOHandle (IO.openBinaryFile fp IO.WriteMode)++-- | Cautious version of 'sinkFile'. The idea here is to stream the+-- values to a temporary file in the same directory of the destination+-- file, and only on successfully writing the entire file, moves it+-- atomically to the destination path.+--+-- In the event of an exception occurring, the temporary file will be+-- deleted and no move will be made. If the application shuts down+-- without running exception handling (such as machine failure or a+-- SIGKILL), the temporary file will remain and the destination file+-- will be untouched.+--+-- @since 1.3.0+sinkFileCautious+  :: MonadResource m+  => FilePath+  -> ConduitM S.ByteString o m ()+sinkFileCautious fp =+    bracketP (cautiousAcquire fp) cautiousCleanup inner+  where+    inner (tmpFP, h) = do+        sinkHandle h+        liftIO $ do+            IO.hClose h+            renameFile tmpFP fp++-- | Like 'sinkFileCautious', but uses the @with@ pattern instead of+-- @MonadResource@.+--+-- @since 1.3.0+withSinkFileCautious+  :: (MonadUnliftIO m, MonadIO n)+  => FilePath+  -> (ConduitM S.ByteString o n () -> m a)+  -> m a+withSinkFileCautious fp inner =+  withRunInIO $ \run -> bracket+    (cautiousAcquire fp)+    cautiousCleanup+    (\(tmpFP, h) -> do+        a <- run $ inner $ sinkHandle h+        IO.hClose h+        renameFile tmpFP fp+        return a)++-- | Helper function for Cautious functions above, do not export!+cautiousAcquire :: FilePath -> IO (FilePath, IO.Handle)+cautiousAcquire fp = IO.openBinaryTempFile (takeDirectory fp) (takeFileName fp <.> "tmp")++-- | Helper function for Cautious functions above, do not export!+cautiousCleanup :: (FilePath, IO.Handle) -> IO ()+cautiousCleanup (tmpFP, h) = do+  IO.hClose h+  removeFile tmpFP `Control.Exception.catch` \e ->+    if isDoesNotExistError e+      then return ()+      else throwIO e++-- | Stream data into a temporary file in the given directory with the+-- given filename pattern, and return the temporary filename. The+-- temporary file will be automatically deleted when exiting the+-- active 'ResourceT' block, if it still exists.+--+-- @since 1.3.0+sinkTempFile :: MonadResource m+             => FilePath -- ^ temp directory+             -> String -- ^ filename pattern+             -> ConduitM ByteString o m FilePath+sinkTempFile tmpdir pattern = do+    (_releaseKey, (fp, h)) <- allocate+        (IO.openBinaryTempFile tmpdir pattern)+        (\(fp, h) -> IO.hClose h `finally` (removeFile fp `Control.Exception.catch` \e ->+            if isDoesNotExistError e+                then return ()+                else throwIO e))+    sinkHandle h+    liftIO $ IO.hClose h+    return fp++-- | Same as 'sinkTempFile', but will use the default temp file+-- directory for the system as the first argument.+--+-- @since 1.3.0+sinkSystemTempFile+    :: MonadResource m+    => String -- ^ filename pattern+    -> ConduitM ByteString o m FilePath+sinkSystemTempFile pattern = do+    dir <- liftIO getTemporaryDirectory+    sinkTempFile dir pattern++-- | Stream all incoming data to the given 'IO.Handle'. Note that this function+-- does /not/ flush and will /not/ close the @Handle@ when processing completes.+--+-- @since 1.3.0+sinkHandle :: MonadIO m+           => IO.Handle+           -> ConduitT S.ByteString o m ()+sinkHandle h = awaitForever (liftIO . S.hPut h)++-- | Stream incoming builders, executing them directly on the buffer of the+-- given 'IO.Handle'. Note that this function does /not/ automatically close the+-- @Handle@ when processing completes.+-- Pass 'Data.ByteString.Builder.Extra.flush' to flush the buffer.+--+-- @since 1.3.0+sinkHandleBuilder :: MonadIO m => IO.Handle -> ConduitM Builder o m ()+sinkHandleBuilder h = awaitForever (liftIO . hPutBuilder h)++-- | Stream incoming @Flush@es, executing them on @IO.Handle@+-- Note that this function does /not/ automatically close the @Handle@ when+-- processing completes+--+-- @since 1.3.0+sinkHandleFlush :: MonadIO m+                => IO.Handle+                -> ConduitM (Flush S.ByteString) o m ()+sinkHandleFlush h =+  awaitForever $ \mbs -> liftIO $+  case mbs of+    Chunk bs -> S.hPut h bs+    Flush -> IO.hFlush h++-- | An alternative to 'sinkHandle'.+-- Instead of taking a pre-opened 'IO.Handle', it takes an action that opens+-- a 'IO.Handle' (in write mode), so that it can open it only when needed+-- and close it as soon as possible.+--+-- @since 1.3.0+sinkIOHandle :: MonadResource m+             => IO IO.Handle+             -> ConduitT S.ByteString o m ()+sinkIOHandle alloc = bracketP alloc IO.hClose sinkHandle++-- | Like 'IO.withBinaryFile', but provides a source to read bytes from.+--+-- @since 1.3.0+withSourceFile+  :: (MonadUnliftIO m, MonadIO n)+  => FilePath+  -> (ConduitM i ByteString n () -> m a)+  -> m a+withSourceFile fp inner =+  withRunInIO $ \run ->+  IO.withBinaryFile fp IO.ReadMode $+  run . inner . sourceHandle++-- | Like 'IO.withBinaryFile', but provides a sink to write bytes to.+--+-- @since 1.3.0+withSinkFile+  :: (MonadUnliftIO m, MonadIO n)+  => FilePath+  -> (ConduitM ByteString o n () -> m a)+  -> m a+withSinkFile fp inner =+  withRunInIO $ \run ->+  IO.withBinaryFile fp IO.WriteMode $+  run . inner . sinkHandle++-- | Same as 'withSinkFile', but lets you use a 'BB.Builder'.+--+-- @since 1.3.0+withSinkFileBuilder+  :: (MonadUnliftIO m, MonadIO n)+  => FilePath+  -> (ConduitM Builder o n () -> m a)+  -> m a+withSinkFileBuilder fp inner =+  withRunInIO $ \run ->+  IO.withBinaryFile fp IO.WriteMode $ \h ->+  run $ inner $ CL.mapM_ (liftIO . hPutBuilder h)++-- | Stream the contents of the given directory, without traversing deeply.+--+-- This function will return /all/ of the contents of the directory, whether+-- they be files, directories, etc.+--+-- Note that the generated filepaths will be the complete path, not just the+-- filename. In other words, if you have a directory @foo@ containing files+-- @bar@ and @baz@, and you use @sourceDirectory@ on @foo@, the results will be+-- @foo/bar@ and @foo/baz@.+--+-- @since 1.3.0+sourceDirectory :: MonadResource m => FilePath -> ConduitT i FilePath m ()+sourceDirectory dir =+    bracketP (F.openDirStream dir) F.closeDirStream go+  where+    go ds =+        loop+      where+        loop = do+            mfp <- liftIO $ F.readDirStream ds+            case mfp of+                Nothing -> return ()+                Just fp -> do+                    yield $ dir </> fp+                    loop++-- | Deeply stream the contents of the given directory.+--+-- This works the same as @sourceDirectory@, but will not return directories at+-- all. This function also takes an extra parameter to indicate whether+-- symlinks will be followed.+--+-- @since 1.3.0+sourceDirectoryDeep :: MonadResource m+                    => Bool -- ^ Follow directory symlinks+                    -> FilePath -- ^ Root directory+                    -> ConduitT i FilePath m ()+sourceDirectoryDeep followSymlinks =+    start+  where+    start :: MonadResource m => FilePath -> ConduitT i FilePath m ()+    start dir = sourceDirectory dir .| awaitForever go++    go :: MonadResource m => FilePath -> ConduitT i FilePath m ()+    go fp = do+        ft <- liftIO $ F.getFileType fp+        case ft of+            F.FTFile -> yield fp+            F.FTFileSym -> yield fp+            F.FTDirectory -> start fp+            F.FTDirectorySym+                | followSymlinks -> start fp+                | otherwise -> return ()+            F.FTOther -> return ()++-- | Ignore a certain number of values in the stream.+--+-- Note: since this function doesn't produce anything, you probably want to+-- use it with ('>>') instead of directly plugging it into a pipeline:+--+-- >>> runConduit $ yieldMany [1..5] .| drop 2 .| sinkList+-- []+-- >>> runConduit $ yieldMany [1..5] .| (drop 2 >> sinkList)+-- [3,4,5]+--+-- @since 1.3.0+drop :: Monad m+     => Int+     -> ConduitT a o m ()+INLINE_RULE(drop, n, CL.drop n)++-- | Drop a certain number of elements from a chunked stream.+--+-- Note: you likely want to use it with monadic composition. See the docs+-- for 'drop'.+--+-- @since 1.3.0+dropE :: (Monad m, Seq.IsSequence seq)+      => Seq.Index seq+      -> ConduitT seq o m ()+dropE =+    loop+  where+    loop i = if i <= 0+        then return ()+        else await >>= maybe (return ()) (go i)++    go i sq = do+        unless (onull y) $ leftover y+        loop i'+      where+        (x, y) = Seq.splitAt i sq+        i' = i - fromIntegral (olength x)+{-# INLINEABLE dropE #-}++-- | Drop all values which match the given predicate.+--+-- Note: you likely want to use it with monadic composition. See the docs+-- for 'drop'.+--+-- @since 1.3.0+dropWhile :: Monad m+          => (a -> Bool)+          -> ConduitT a o m ()+dropWhile f =+    loop+  where+    loop = await >>= maybe (return ()) go+    go x = if f x then loop else leftover x+{-# INLINE dropWhile #-}++-- | Drop all elements in the chunked stream which match the given predicate.+--+-- Note: you likely want to use it with monadic composition. See the docs+-- for 'drop'.+--+-- @since 1.3.0+dropWhileE :: (Monad m, Seq.IsSequence seq)+           => (Element seq -> Bool)+           -> ConduitT seq o m ()+dropWhileE f =+    loop+  where+    loop = await >>= maybe (return ()) go++    go sq =+        if onull x then loop else leftover x+      where+        x = Seq.dropWhile f sq+{-# INLINE dropWhileE #-}++-- | Monoidally combine all values in the stream.+--+-- Subject to fusion+--+-- @since 1.3.0+fold :: (Monad m, Monoid a)+     => ConduitT a o m a+INLINE_RULE0(fold, CL.foldMap id)++-- | Monoidally combine all elements in the chunked stream.+--+-- Subject to fusion+--+-- @since 1.3.0+foldE :: (Monad m, MonoFoldable mono, Monoid (Element mono))+      => ConduitT mono o m (Element mono)+INLINE_RULE0(foldE, CL.fold (\accum mono -> accum `mappend` ofoldMap id mono) mempty)++-- | A strict left fold.+--+-- Subject to fusion+--+-- @since 1.3.0+foldl :: Monad m => (a -> b -> a) -> a -> ConduitT b o m a+INLINE_RULE(foldl, f x, CL.fold f x)++-- | A strict left fold on a chunked stream.+--+-- Subject to fusion+--+-- @since 1.3.0+foldlE :: (Monad m, MonoFoldable mono)+       => (a -> Element mono -> a)+       -> a+       -> ConduitT mono o m a+INLINE_RULE(foldlE, f x, CL.fold (ofoldlPrime f) x)++-- Work around CPP not supporting identifiers with primes...+ofoldlPrime :: MonoFoldable mono => (a -> Element mono -> a) -> a -> mono -> a+ofoldlPrime = ofoldl'++-- | Apply the provided mapping function and monoidal combine all values.+--+-- Subject to fusion+--+-- @since 1.3.0+foldMap :: (Monad m, Monoid b)+        => (a -> b)+        -> ConduitT a o m b+INLINE_RULE(foldMap, f, CL.foldMap f)++-- | Apply the provided mapping function and monoidal combine all elements of the chunked stream.+--+-- Subject to fusion+--+-- @since 1.3.0+foldMapE :: (Monad m, MonoFoldable mono, Monoid w)+         => (Element mono -> w)+         -> ConduitT mono o m w+INLINE_RULE(foldMapE, f, CL.foldMap (ofoldMap f))++-- | A strict left fold with no starting value.  Returns 'Nothing'+-- when the stream is empty.+--+-- Subject to fusion+foldl1, foldl1C :: Monad m => (a -> a -> a) -> ConduitT a o m (Maybe a)+foldl1C f =+    await >>= maybe (return Nothing) loop+  where+    loop !prev = await >>= maybe (return $ Just prev) (loop . f prev)+STREAMING(foldl1, foldl1C, foldl1S, f)++-- | A strict left fold on a chunked stream, with no starting value.+-- Returns 'Nothing' when the stream is empty.+--+-- Subject to fusion+--+-- @since 1.3.0+foldl1E :: (Monad m, MonoFoldable mono, a ~ Element mono)+        => (a -> a -> a)+        -> ConduitT mono o m (Maybe a)+INLINE_RULE(foldl1E, f, foldl (foldMaybeNull f) Nothing)++-- Helper for foldl1E+foldMaybeNull :: (MonoFoldable mono, e ~ Element mono)+              => (e -> e -> e)+              -> Maybe e+              -> mono+              -> Maybe e+foldMaybeNull f macc mono =+    case (macc, NonNull.fromNullable mono) of+        (Just acc, Just nn) -> Just $ ofoldl' f acc nn+        (Nothing, Just nn) -> Just $ NonNull.ofoldl1' f nn+        _ -> macc+{-# INLINE foldMaybeNull #-}++-- | Check that all values in the stream return True.+--+-- Subject to shortcut logic: at the first False, consumption of the stream+-- will stop.+--+-- Subject to fusion+--+-- @since 1.3.0+all, allC :: Monad m+          => (a -> Bool)+          -> ConduitT a o m Bool+allC f = fmap isNothing $ find (Prelude.not . f)+{-# INLINE allC #-}+STREAMING(all, allC, allS, f)++-- | Check that all elements in the chunked stream return True.+--+-- Subject to shortcut logic: at the first False, consumption of the stream+-- will stop.+--+-- Subject to fusion+--+-- @since 1.3.0+allE :: (Monad m, MonoFoldable mono)+     => (Element mono -> Bool)+     -> ConduitT mono o m Bool+INLINE_RULE(allE, f, all (oall f))++-- | Check that at least one value in the stream returns True.+--+-- Subject to shortcut logic: at the first True, consumption of the stream+-- will stop.+--+-- Subject to fusion+--+-- @since 1.3.0+any, anyC :: Monad m+          => (a -> Bool)+          -> ConduitT a o m Bool+anyC = fmap isJust . find+{-# INLINE anyC #-}+STREAMING(any, anyC, anyS, f)++-- | Check that at least one element in the chunked stream returns True.+--+-- Subject to shortcut logic: at the first True, consumption of the stream+-- will stop.+--+-- Subject to fusion+--+-- @since 1.3.0+anyE :: (Monad m, MonoFoldable mono)+     => (Element mono -> Bool)+     -> ConduitT mono o m Bool+INLINE_RULE(anyE, f, any (oany f))++-- | Are all values in the stream True?+--+-- Consumption stops once the first False is encountered.+--+-- Subject to fusion+--+-- @since 1.3.0+and :: Monad m => ConduitT Bool o m Bool+INLINE_RULE0(and, all id)++-- | Are all elements in the chunked stream True?+--+-- Consumption stops once the first False is encountered.+--+-- Subject to fusion+--+-- @since 1.3.0+andE :: (Monad m, MonoFoldable mono, Element mono ~ Bool)+     => ConduitT mono o m Bool+INLINE_RULE0(andE, allE id)++-- | Are any values in the stream True?+--+-- Consumption stops once the first True is encountered.+--+-- Subject to fusion+--+-- @since 1.3.0+or :: Monad m => ConduitT Bool o m Bool+INLINE_RULE0(or, any id)++-- | Are any elements in the chunked stream True?+--+-- Consumption stops once the first True is encountered.+--+-- Subject to fusion+--+-- @since 1.3.0+orE :: (Monad m, MonoFoldable mono, Element mono ~ Bool)+    => ConduitT mono o m Bool+INLINE_RULE0(orE, anyE id)++-- | 'Alternative'ly combine all values in the stream.+--+-- @since 1.3.0+asum :: (Monad m, Alternative f)+     => ConduitT (f a) o m (f a)+INLINE_RULE0(asum, foldl (<|>) empty)++-- | Are any values in the stream equal to the given value?+--+-- Stops consuming as soon as a match is found.+--+-- Subject to fusion+--+-- @since 1.3.0+elem :: (Monad m, Eq a) => a -> ConduitT a o m Bool+INLINE_RULE(elem, x, any (== x))++-- | Are any elements in the chunked stream equal to the given element?+--+-- Stops consuming as soon as a match is found.+--+-- Subject to fusion+--+-- @since 1.3.0+elemE :: (Monad m, Seq.IsSequence seq, Eq (Element seq))+      => Element seq+      -> ConduitT seq o m Bool+INLINE_RULE(elemE, f, any (oelem f))++-- | Are no values in the stream equal to the given value?+--+-- Stops consuming as soon as a match is found.+--+-- Subject to fusion+--+-- @since 1.3.0+notElem :: (Monad m, Eq a) => a -> ConduitT a o m Bool+INLINE_RULE(notElem, x, all (/= x))++-- | Are no elements in the chunked stream equal to the given element?+--+-- Stops consuming as soon as a match is found.+--+-- Subject to fusion+--+-- @since 1.3.0+notElemE :: (Monad m, Seq.IsSequence seq, Eq (Element seq))+         => Element seq+         -> ConduitT seq o m Bool+INLINE_RULE(notElemE, x, all (onotElem x))++-- | Consume all incoming strict chunks into a lazy sequence.+-- Note that the entirety of the sequence will be resident at memory.+--+-- This can be used to consume a stream of strict ByteStrings into a lazy+-- ByteString, for example.+--+-- Subject to fusion+--+-- @since 1.3.0+sinkLazy, sinkLazyC :: (Monad m, LazySequence lazy strict)+                    => ConduitT strict o m lazy+sinkLazyC = (fromChunks . ($ [])) <$> CL.fold (\front next -> front . (next:)) id+{-# INLINE sinkLazyC #-}+STREAMING0(sinkLazy, sinkLazyC, sinkLazyS)++-- | Consume all values from the stream and return as a list. Note that this+-- will pull all values into memory.+--+-- Subject to fusion+--+-- @since 1.3.0+sinkList :: Monad m => ConduitT a o m [a]+INLINE_RULE0(sinkList, CL.consume)++-- | Sink incoming values into a vector, growing the vector as necessary to fit+-- more elements.+--+-- Note that using this function is more memory efficient than @sinkList@ and+-- then converting to a @Vector@, as it avoids intermediate list constructors.+--+-- Subject to fusion+--+-- @since 1.3.0+sinkVector, sinkVectorC :: (V.Vector v a, PrimMonad m)+                        => ConduitT a o m (v a)+sinkVectorC = do+    let initSize = 10+    mv0 <- VM.new initSize+    let go maxSize i mv | i >= maxSize = do+            let newMax = maxSize * 2+            mv' <- VM.grow mv maxSize+            go newMax i mv'+        go maxSize i mv = do+            mx <- await+            case mx of+                Nothing -> V.slice 0 i <$> V.unsafeFreeze mv+                Just x -> do+                    VM.write mv i x+                    go maxSize (i + 1) mv+    go initSize 0 mv0+{-# INLINEABLE sinkVectorC #-}+STREAMING0(sinkVector, sinkVectorC, sinkVectorS)++-- | Sink incoming values into a vector, up until size @maxSize@.  Subsequent+-- values will be left in the stream. If there are less than @maxSize@ values+-- present, returns a @Vector@ of smaller size.+--+-- Note that using this function is more memory efficient than @sinkList@ and+-- then converting to a @Vector@, as it avoids intermediate list constructors.+--+-- Subject to fusion+--+-- @since 1.3.0+sinkVectorN, sinkVectorNC :: (V.Vector v a, PrimMonad m)+                          => Int -- ^ maximum allowed size+                          -> ConduitT a o m (v a)+sinkVectorNC maxSize = do+    mv <- VM.new maxSize+    let go i | i >= maxSize = V.unsafeFreeze mv+        go i = do+            mx <- await+            case mx of+                Nothing -> V.slice 0 i <$> V.unsafeFreeze mv+                Just x -> do+                    VM.write mv i x+                    go (i + 1)+    go 0+{-# INLINEABLE sinkVectorNC #-}+STREAMING(sinkVectorN, sinkVectorNC, sinkVectorNS, maxSize)++-- | Same as @sinkBuilder@, but afterwards convert the builder to its lazy+-- representation.+--+-- Alternatively, this could be considered an alternative to @sinkLazy@, with+-- the following differences:+--+-- * This function will allow multiple input types, not just the strict version+-- of the lazy structure.+--+-- * Some buffer copying may occur in this version.+--+-- Subject to fusion+--+-- @since 1.3.0+sinkLazyBuilder, sinkLazyBuilderC :: Monad m => ConduitT Builder o m BL.ByteString+sinkLazyBuilderC = fmap toLazyByteString fold+{-# INLINE sinkLazyBuilderC #-}+STREAMING0(sinkLazyBuilder, sinkLazyBuilderC, sinkLazyBuilderS)++-- | Consume and discard all remaining values in the stream.+--+-- Subject to fusion+--+-- @since 1.3.0+sinkNull :: Monad m => ConduitT a o m ()+INLINE_RULE0(sinkNull, CL.sinkNull)++-- | Same as @await@, but discards any leading 'onull' values.+--+-- @since 1.3.0+awaitNonNull :: (Monad m, MonoFoldable a) => ConduitT a o m (Maybe (NonNull.NonNull a))+awaitNonNull =+    go+  where+    go = await >>= maybe (return Nothing) go'++    go' = maybe go (return . Just) . NonNull.fromNullable+{-# INLINE awaitNonNull #-}++-- | Take a single value from the stream, if available.+--+-- @since 1.3.0+head :: Monad m => ConduitT a o m (Maybe a)+head = CL.head++-- | Same as 'head', but returns a default value if none are available from the stream.+--+-- @since 1.3.0+headDef :: Monad m => a -> ConduitT a o m a+headDef a = fromMaybe a <$> head++-- | Get the next element in the chunked stream.+--+-- @since 1.3.0+headE :: (Monad m, Seq.IsSequence seq) => ConduitT seq o m (Maybe (Element seq))+headE =+    loop+  where+    loop = await >>= maybe (return Nothing) go+    go x =+        case Seq.uncons x of+            Nothing -> loop+            Just (y, z) -> do+                unless (onull z) $ leftover z+                return $ Just y+{-# INLINE headE #-}++-- | View the next value in the stream without consuming it.+--+-- @since 1.3.0+peek :: Monad m => ConduitT a o m (Maybe a)+peek = CL.peek+{-# INLINE peek #-}++-- | View the next element in the chunked stream without consuming it.+--+-- @since 1.3.0+peekE :: (Monad m, MonoFoldable mono) => ConduitT mono o m (Maybe (Element mono))+peekE =+    loop+  where+    loop = await >>= maybe (return Nothing) go+    go x =+        case headMay x of+            Nothing -> loop+            Just y -> do+                leftover x+                return $ Just y+{-# INLINE peekE #-}++-- | Retrieve the last value in the stream, if present.+--+-- Subject to fusion+--+-- @since 1.3.0+last, lastC :: Monad m => ConduitT a o m (Maybe a)+lastC =+    await >>= maybe (return Nothing) loop+  where+    loop prev = await >>= maybe (return $ Just prev) loop+STREAMING0(last, lastC, lastS)++-- | Same as 'last', but returns a default value if none are available from the stream.+--+-- @since 1.3.0+lastDef :: Monad m => a -> ConduitT a o m a+lastDef a = fromMaybe a <$> last++-- | Retrieve the last element in the chunked stream, if present.+--+-- Subject to fusion+--+-- @since 1.3.0+lastE, lastEC :: (Monad m, Seq.IsSequence seq) => ConduitT seq o m (Maybe (Element seq))+lastEC =+    awaitNonNull >>= maybe (return Nothing) (loop . NonNull.last)+  where+    loop prev = awaitNonNull >>= maybe (return $ Just prev) (loop . NonNull.last)+STREAMING0(lastE, lastEC, lastES)++-- | Count how many values are in the stream.+--+-- Subject to fusion+--+-- @since 1.3.0+length :: (Monad m, Num len) => ConduitT a o m len+INLINE_RULE0(length, foldl (\x _ -> x + 1) 0)++-- | Count how many elements are in the chunked stream.+--+-- Subject to fusion+--+-- @since 1.3.0+lengthE :: (Monad m, Num len, MonoFoldable mono) => ConduitT mono o m len+INLINE_RULE0(lengthE, foldl (\x y -> x + fromIntegral (olength y)) 0)++-- | Count how many values in the stream pass the given predicate.+--+-- Subject to fusion+--+-- @since 1.3.0+lengthIf :: (Monad m, Num len) => (a -> Bool) -> ConduitT a o m len+INLINE_RULE(lengthIf, f, foldl (\cnt a -> if f a then (cnt + 1) else cnt) 0)++-- | Count how many elements in the chunked stream pass the given predicate.+--+-- Subject to fusion+--+-- @since 1.3.0+lengthIfE :: (Monad m, Num len, MonoFoldable mono)+          => (Element mono -> Bool) -> ConduitT mono o m len+INLINE_RULE(lengthIfE, f, foldlE (\cnt a -> if f a then (cnt + 1) else cnt) 0)++-- | Get the largest value in the stream, if present.+--+-- Subject to fusion+--+-- @since 1.3.0+maximum :: (Monad m, Ord a) => ConduitT a o m (Maybe a)+INLINE_RULE0(maximum, foldl1 max)++-- | Get the largest element in the chunked stream, if present.+--+-- Subject to fusion+--+-- @since 1.3.0+maximumE :: (Monad m, Seq.IsSequence seq, Ord (Element seq)) => ConduitT seq o m (Maybe (Element seq))+INLINE_RULE0(maximumE, foldl1E max)++-- | Get the smallest value in the stream, if present.+--+-- Subject to fusion+--+-- @since 1.3.0+minimum :: (Monad m, Ord a) => ConduitT a o m (Maybe a)+INLINE_RULE0(minimum, foldl1 min)++-- | Get the smallest element in the chunked stream, if present.+--+-- Subject to fusion+--+-- @since 1.3.0+minimumE :: (Monad m, Seq.IsSequence seq, Ord (Element seq)) => ConduitT seq o m (Maybe (Element seq))+INLINE_RULE0(minimumE, foldl1E min)++-- | True if there are no values in the stream.+--+-- This function does not modify the stream.+--+-- @since 1.3.0+null :: Monad m => ConduitT a o m Bool+null = (maybe True (\_ -> False)) `fmap` peek+{-# INLINE null #-}++-- | True if there are no elements in the chunked stream.+--+-- This function may remove empty leading chunks from the stream, but otherwise+-- will not modify it.+--+-- @since 1.3.0+nullE :: (Monad m, MonoFoldable mono)+      => ConduitT mono o m Bool+nullE =+    go+  where+    go = await >>= maybe (return True) go'+    go' x = if onull x then go else leftover x >> return False+{-# INLINE nullE #-}++-- | Get the sum of all values in the stream.+--+-- Subject to fusion+--+-- @since 1.3.0+sum :: (Monad m, Num a) => ConduitT a o m a+INLINE_RULE0(sum, foldl (+) 0)++-- | Get the sum of all elements in the chunked stream.+--+-- Subject to fusion+--+-- @since 1.3.0+sumE :: (Monad m, MonoFoldable mono, Num (Element mono)) => ConduitT mono o m (Element mono)+INLINE_RULE0(sumE, foldlE (+) 0)++-- | Get the product of all values in the stream.+--+-- Subject to fusion+--+-- @since 1.3.0+product :: (Monad m, Num a) => ConduitT a o m a+INLINE_RULE0(product, foldl (*) 1)++-- | Get the product of all elements in the chunked stream.+--+-- Subject to fusion+--+-- @since 1.3.0+productE :: (Monad m, MonoFoldable mono, Num (Element mono)) => ConduitT mono o m (Element mono)+INLINE_RULE0(productE, foldlE (*) 1)++-- | Find the first matching value.+--+-- Subject to fusion+--+-- @since 1.3.0+find, findC :: Monad m => (a -> Bool) -> ConduitT a o m (Maybe a)+findC f =+    loop+  where+    loop = await >>= maybe (return Nothing) go+    go x = if f x then return (Just x) else loop+{-# INLINE findC #-}+STREAMING(find, findC, findS, f)++-- | Apply the action to all values in the stream.+--+-- Note: if you want to /pass/ the values instead of /consuming/ them, use+-- 'iterM' instead.+--+-- Subject to fusion+--+-- @since 1.3.0+mapM_ :: Monad m => (a -> m ()) -> ConduitT a o m ()+INLINE_RULE(mapM_, f, CL.mapM_ f)++-- | Apply the action to all elements in the chunked stream.+--+-- Note: the same caveat as with 'mapM_' applies. If you don't want to+-- consume the values, you can use 'iterM':+--+-- > iterM (omapM_ f)+--+-- Subject to fusion+--+-- @since 1.3.0+mapM_E :: (Monad m, MonoFoldable mono) => (Element mono -> m ()) -> ConduitT mono o m ()+INLINE_RULE(mapM_E, f, CL.mapM_ (omapM_ f))++-- | A monadic strict left fold.+--+-- Subject to fusion+--+-- @since 1.3.0+foldM :: Monad m => (a -> b -> m a) -> a -> ConduitT b o m a+INLINE_RULE(foldM, f x, CL.foldM f x)++-- | A monadic strict left fold on a chunked stream.+--+-- Subject to fusion+--+-- @since 1.3.0+foldME :: (Monad m, MonoFoldable mono)+       => (a -> Element mono -> m a)+       -> a+       -> ConduitT mono o m a+INLINE_RULE(foldME, f x, foldM (ofoldlM f) x)++-- | Apply the provided monadic mapping function and monoidal combine all values.+--+-- Subject to fusion+--+-- @since 1.3.0+foldMapM :: (Monad m, Monoid w) => (a -> m w) -> ConduitT a o m w+INLINE_RULE(foldMapM, f, CL.foldMapM f)++-- | Apply the provided monadic mapping function and monoidal combine all+-- elements in the chunked stream.+--+-- Subject to fusion+--+-- @since 1.3.0+foldMapME :: (Monad m, MonoFoldable mono, Monoid w)+          => (Element mono -> m w)+          -> ConduitT mono o m w+INLINE_RULE(foldMapME, f, CL.foldM (ofoldlM (\accum e -> mappend accum `liftM` f e)) mempty)++-- | 'sinkFile' specialized to 'ByteString' to help with type+-- inference.+--+-- @since 1.3.0+sinkFileBS :: MonadResource m => FilePath -> ConduitT ByteString o m ()+sinkFileBS = sinkFile+{-# INLINE sinkFileBS #-}++-- | Print all incoming values to stdout.+--+-- Subject to fusion+--+-- @since 1.3.0+print :: (Show a, MonadIO m) => ConduitT a o m ()+INLINE_RULE0(print, mapM_ (liftIO . Prelude.print))++-- | @sinkHandle@ applied to @stdout@.+--+-- Subject to fusion+--+-- @since 1.3.0+stdout :: MonadIO m => ConduitT ByteString o m ()+INLINE_RULE0(stdout, sinkHandle IO.stdout)++-- | @sinkHandle@ applied to @stderr@.+--+-- Subject to fusion+--+-- @since 1.3.0+stderr :: MonadIO m => ConduitT ByteString o m ()+INLINE_RULE0(stderr, sinkHandle IO.stderr)++-- | Apply a transformation to all values in a stream.+--+-- Subject to fusion+--+-- @since 1.3.0+map :: Monad m => (a -> b) -> ConduitT a b m ()+INLINE_RULE(map, f, CL.map f)++-- | Apply a transformation to all elements in a chunked stream.+--+-- Subject to fusion+--+-- @since 1.3.0+mapE :: (Monad m, Functor f) => (a -> b) -> ConduitT (f a) (f b) m ()+INLINE_RULE(mapE, f, CL.map (fmap f))++-- | Apply a monomorphic transformation to all elements in a chunked stream.+--+-- Unlike @mapE@, this will work on types like @ByteString@ and @Text@ which+-- are @MonoFunctor@ but not @Functor@.+--+-- Subject to fusion+--+-- @since 1.3.0+omapE :: (Monad m, MonoFunctor mono) => (Element mono -> Element mono) -> ConduitT mono mono m ()+INLINE_RULE(omapE, f, CL.map (omap f))++-- | Apply the function to each value in the stream, resulting in a foldable+-- value (e.g., a list). Then yield each of the individual values in that+-- foldable value separately.+--+-- Generalizes concatMap, mapMaybe, and mapFoldable.+--+-- Subject to fusion+--+-- @since 1.3.0+concatMap, concatMapC :: (Monad m, MonoFoldable mono)+                      => (a -> mono)+                      -> ConduitT a (Element mono) m ()+concatMapC f = awaitForever (yieldMany . f)+{-# INLINE concatMapC #-}+STREAMING(concatMap, concatMapC, concatMapS, f)++-- | Apply the function to each element in the chunked stream, resulting in a+-- foldable value (e.g., a list). Then yield each of the individual values in+-- that foldable value separately.+--+-- Generalizes concatMap, mapMaybe, and mapFoldable.+--+-- Subject to fusion+--+-- @since 1.3.0+concatMapE :: (Monad m, MonoFoldable mono, Monoid w)+           => (Element mono -> w)+           -> ConduitT mono w m ()+INLINE_RULE(concatMapE, f, CL.map (ofoldMap f))++-- | Stream up to n number of values downstream.+--+-- Note that, if downstream terminates early, not all values will be consumed.+-- If you want to force /exactly/ the given number of values to be consumed,+-- see 'takeExactly'.+--+-- Subject to fusion+--+-- @since 1.3.0+take :: Monad m => Int -> ConduitT a a m ()+INLINE_RULE(take, n, CL.isolate n)++-- | Stream up to n number of elements downstream in a chunked stream.+--+-- Note that, if downstream terminates early, not all values will be consumed.+-- If you want to force /exactly/ the given number of values to be consumed,+-- see 'takeExactlyE'.+--+-- @since 1.3.0+takeE :: (Monad m, Seq.IsSequence seq)+      => Seq.Index seq+      -> ConduitT seq seq m ()+takeE =+    loop+  where+    loop i = if i <= 0+        then return ()+        else await >>= maybe (return ()) (go i)++    go i sq = do+        unless (onull x) $ yield x+        unless (onull y) $ leftover y+        loop i'+      where+        (x, y) = Seq.splitAt i sq+        i' = i - fromIntegral (olength x)+{-# INLINEABLE takeE #-}++-- | Stream all values downstream that match the given predicate.+--+-- Same caveats regarding downstream termination apply as with 'take'.+--+-- @since 1.3.0+takeWhile :: Monad m+          => (a -> Bool)+          -> ConduitT a a m ()+takeWhile f =+    loop+  where+    loop = await >>= maybe (return ()) go+    go x = if f x+        then yield x >> loop+        else leftover x+{-# INLINE takeWhile #-}++-- | Stream all elements downstream that match the given predicate in a chunked stream.+--+-- Same caveats regarding downstream termination apply as with 'takeE'.+--+-- @since 1.3.0+takeWhileE :: (Monad m, Seq.IsSequence seq)+           => (Element seq -> Bool)+           -> ConduitT seq seq m ()+takeWhileE f =+    loop+  where+    loop = await >>= maybe (return ()) go++    go sq = do+        unless (onull x) $ yield x+        if onull y+            then loop+            else leftover y+      where+        (x, y) = Seq.span f sq+{-# INLINE takeWhileE #-}++-- | Consume precisely the given number of values and feed them downstream.+--+-- This function is in contrast to 'take', which will only consume up to the+-- given number of values, and will terminate early if downstream terminates+-- early. This function will discard any additional values in the stream if+-- they are unconsumed.+--+-- Note that this function takes a downstream @ConduitT@ as a parameter, as+-- opposed to working with normal fusion. For more information, see+-- <http://www.yesodweb.com/blog/2013/10/core-flaw-pipes-conduit>, the section+-- titled \"pipes and conduit: isolate\".+--+-- @since 1.3.0+takeExactly :: Monad m+            => Int+            -> ConduitT a b m r+            -> ConduitT a b m r+takeExactly count inner = take count .| do+    r <- inner+    CL.sinkNull+    return r++-- | Same as 'takeExactly', but for chunked streams.+--+-- @since 1.3.0+takeExactlyE :: (Monad m, Seq.IsSequence a)+             => Seq.Index a+             -> ConduitT a b m r+             -> ConduitT a b m r+takeExactlyE count inner = takeE count .| do+    r <- inner+    CL.sinkNull+    return r+{-# INLINE takeExactlyE #-}++-- | Flatten out a stream by yielding the values contained in an incoming+-- @MonoFoldable@ as individually yielded values.+--+-- Subject to fusion+--+-- @since 1.3.0+concat, concatC :: (Monad m, MonoFoldable mono)+                => ConduitT mono (Element mono) m ()+concatC = awaitForever yieldMany+STREAMING0(concat, concatC, concatS)++-- | Keep only values in the stream passing a given predicate.+--+-- Subject to fusion+--+-- @since 1.3.0+filter :: Monad m => (a -> Bool) -> ConduitT a a m ()+INLINE_RULE(filter, f, CL.filter f)++-- | Keep only elements in the chunked stream passing a given predicate.+--+-- Subject to fusion+--+-- @since 1.3.0+filterE :: (Seq.IsSequence seq, Monad m) => (Element seq -> Bool) -> ConduitT seq seq m ()+INLINE_RULE(filterE, f, CL.map (Seq.filter f))++-- | Map values as long as the result is @Just@.+--+-- @since 1.3.0+mapWhile :: Monad m => (a -> Maybe b) -> ConduitT a b m ()+mapWhile f =+    loop+  where+    loop = await >>= maybe (return ()) go+    go x =+        case f x of+            Just y -> yield y >> loop+            Nothing -> leftover x+{-# INLINE mapWhile #-}++-- | Break up a stream of values into vectors of size n. The final vector may+-- be smaller than n if the total number of values is not a strict multiple of+-- n. No empty vectors will be yielded.+--+-- @since 1.3.0+conduitVector :: (V.Vector v a, PrimMonad m)+              => Int -- ^ maximum allowed size+              -> ConduitT a (v a) m ()+conduitVector size =+    loop+  where+    loop = do+        v <- sinkVectorN size+        unless (V.null v) $ do+            yield v+            loop+{-# INLINE conduitVector #-}++-- | Analog of 'Prelude.scanl' for lists.+--+-- Subject to fusion+--+-- @since 1.3.0+scanl, scanlC :: Monad m => (a -> b -> a) -> a -> ConduitT b a m ()+scanlC f =+    loop+  where+    loop seed =+        await >>= maybe (yield seed) go+      where+        go b = do+            let seed' = f seed b+            seed' `seq` yield seed+            loop seed'+STREAMING(scanl, scanlC, scanlS, f x)++-- | 'mapWhile' with a break condition dependent on a strict accumulator.+-- Equivalently, 'CL.mapAccum' as long as the result is @Right@. Instead of+-- producing a leftover, the breaking input determines the resulting+-- accumulator via @Left@.+--+-- Subject to fusion+mapAccumWhile, mapAccumWhileC :: Monad m => (a -> s -> Either s (s, b)) -> s -> ConduitT a b m s+mapAccumWhileC f =+    loop+  where+    loop !s = await >>= maybe (return s) go+      where+        go a = either (return $!) (\(s', b) -> yield b >> loop s') $ f a s+{-# INLINE mapAccumWhileC #-}+STREAMING(mapAccumWhile, mapAccumWhileC, mapAccumWhileS, f s)+++-- | Specialized version of 'mapAccumWhile' that does not provide values downstream.+--+-- @since 1.3.4+foldWhile :: Monad m => (a -> s -> Either e s) -> s -> ConduitT a o m (Either e s)+foldWhile f = loop+  where+    loop !s = await >>= maybe (return $ Right s) go+      where+        go a = either (return . Left $!) loop $ f a s+{-# INLINE foldWhile #-}+++-- | 'concatMap' with an accumulator.+--+-- Subject to fusion+--+-- @since 1.3.0+concatMapAccum :: Monad m => (a -> accum -> (accum, [b])) -> accum -> ConduitT a b m ()+INLINE_RULE0(concatMapAccum, CL.concatMapAccum)++-- | Insert the given value between each two values in the stream.+--+-- Subject to fusion+--+-- @since 1.3.0+intersperse, intersperseC :: Monad m => a -> ConduitT a a m ()+intersperseC x =+    await >>= omapM_ go+  where+    go y = yield y >> concatMap (\z -> [x, z])+STREAMING(intersperse, intersperseC, intersperseS, x)++-- | Sliding window of values+-- 1,2,3,4,5 with window size 2 gives+-- [1,2],[2,3],[3,4],[4,5]+--+-- Best used with structures that support O(1) snoc.+--+-- Subject to fusion+--+-- @since 1.3.0+slidingWindow, slidingWindowC :: (Monad m, Seq.IsSequence seq, Element seq ~ a) => Int -> ConduitT a seq m ()+slidingWindowC sz = go (max 1 sz) mempty+    where goContinue st = await >>=+                          maybe (return ())+                                (\x -> do+                                   let st' = Seq.snoc st x+                                   yield st' >> goContinue (Seq.unsafeTail st')+                                )+          go 0 st = yield st >> goContinue (Seq.unsafeTail st)+          go !n st = CL.head >>= \m ->+                     case m of+                       Nothing -> yield st+                       Just x -> go (n-1) (Seq.snoc st x)+STREAMING(slidingWindow, slidingWindowC, slidingWindowS, sz)+++-- | Split input into chunk of size 'chunkSize'+--+-- The last element may be smaller than the 'chunkSize' (see also+-- 'chunksOfExactlyE' which will not yield this last element)+--+-- @since 1.3.0+chunksOfE :: (Monad m, Seq.IsSequence seq) => Seq.Index seq -> ConduitT seq seq m ()+chunksOfE chunkSize = chunksOfExactlyE chunkSize >> (await >>= maybe (return ()) yield)++-- | Split input into chunk of size 'chunkSize'+--+-- If the input does not split into chunks exactly, the remainder will be+-- leftover (see also 'chunksOfE')+--+-- @since 1.3.0+chunksOfExactlyE :: (Monad m, Seq.IsSequence seq) => Seq.Index seq -> ConduitT seq seq m ()+chunksOfExactlyE chunkSize = await >>= maybe (return ()) start+    where+        start b+            | onull b = chunksOfExactlyE chunkSize+            | Seq.lengthIndex b < chunkSize = continue (Seq.lengthIndex b) [b]+            | otherwise = let (first,rest) = Seq.splitAt chunkSize b in+                            yield first >> start rest+        continue !sofar bs = do+            next <- await+            case next of+                Nothing -> leftover (mconcat $ Prelude.reverse bs)+                Just next' ->+                    let !sofar' = Seq.lengthIndex next' + sofar+                        bs' = next':bs+                    in if sofar' < chunkSize+                            then continue sofar' bs'+                            else start (mconcat (Prelude.reverse bs'))++-- | Apply a monadic transformation to all values in a stream.+--+-- If you do not need the transformed values, and instead just want the monadic+-- side-effects of running the action, see 'mapM_'.+--+-- Subject to fusion+--+-- @since 1.3.0+mapM :: Monad m => (a -> m b) -> ConduitT a b m ()+INLINE_RULE(mapM, f, CL.mapM f)++-- | Apply a monadic transformation to all elements in a chunked stream.+--+-- Subject to fusion+--+-- @since 1.3.0+mapME :: (Monad m, Data.Traversable.Traversable f) => (a -> m b) -> ConduitT (f a) (f b) m ()+INLINE_RULE(mapME, f, CL.mapM (Data.Traversable.mapM f))++-- | Apply a monadic monomorphic transformation to all elements in a chunked stream.+--+-- Unlike @mapME@, this will work on types like @ByteString@ and @Text@ which+-- are @MonoFunctor@ but not @Functor@.+--+-- Subject to fusion+--+-- @since 1.3.0+omapME :: (Monad m, MonoTraversable mono)+       => (Element mono -> m (Element mono))+       -> ConduitT mono mono m ()+INLINE_RULE(omapME, f, CL.mapM (omapM f))++-- | Apply the monadic function to each value in the stream, resulting in a+-- foldable value (e.g., a list). Then yield each of the individual values in+-- that foldable value separately.+--+-- Generalizes concatMapM, mapMaybeM, and mapFoldableM.+--+-- Subject to fusion+--+-- @since 1.3.0+concatMapM, concatMapMC :: (Monad m, MonoFoldable mono)+                        => (a -> m mono)+                        -> ConduitT a (Element mono) m ()+concatMapMC f = awaitForever (lift . f >=> yieldMany)+STREAMING(concatMapM, concatMapMC, concatMapMS, f)++-- | Keep only values in the stream passing a given monadic predicate.+--+-- Subject to fusion+--+-- @since 1.3.0+filterM, filterMC :: Monad m+                  => (a -> m Bool)+                  -> ConduitT a a m ()+filterMC f =+    awaitForever go+  where+    go x = do+        b <- lift $ f x+        when b $ yield x+STREAMING(filterM, filterMC, filterMS, f)++-- | Keep only elements in the chunked stream passing a given monadic predicate.+--+-- Subject to fusion+--+-- @since 1.3.0+filterME :: (Monad m, Seq.IsSequence seq) => (Element seq -> m Bool) -> ConduitT seq seq m ()+INLINE_RULE(filterME, f, CL.mapM (Seq.filterM f))++-- | Apply a monadic action on all values in a stream.+--+-- This @Conduit@ can be used to perform a monadic side-effect for every+-- value, whilst passing the value through the @Conduit@ as-is.+--+-- > iterM f = mapM (\a -> f a >>= \() -> return a)+--+-- Subject to fusion+--+-- @since 1.3.0+iterM :: Monad m => (a -> m ()) -> ConduitT a a m ()+INLINE_RULE(iterM, f, CL.iterM f)++-- | Analog of 'Prelude.scanl' for lists, monadic.+--+-- Subject to fusion+--+-- @since 1.3.0+scanlM, scanlMC :: Monad m => (a -> b -> m a) -> a -> ConduitT b a m ()+scanlMC f =+    loop+  where+    loop seed =+        await >>= maybe (yield seed) go+      where+        go b = do+            seed' <- lift $ f seed b+            seed' `seq` yield seed+            loop seed'+STREAMING(scanlM, scanlMC, scanlMS, f x)++-- | Monadic `mapAccumWhile`.+--+-- Subject to fusion+mapAccumWhileM, mapAccumWhileMC :: Monad m => (a -> s -> m (Either s (s, b))) -> s -> ConduitT a b m s+mapAccumWhileMC f =+    loop+  where+    loop !s = await >>= maybe (return s) go+      where+        go a = lift (f a s) >>= either (return $!) (\(s', b) -> yield b >> loop s')+{-# INLINE mapAccumWhileMC #-}+STREAMING(mapAccumWhileM, mapAccumWhileMC, mapAccumWhileMS, f s)++-- | 'concatMapM' with an accumulator.+--+-- Subject to fusion+--+-- @since 1.3.0+concatMapAccumM :: Monad m => (a -> accum -> m (accum, [b])) -> accum -> ConduitT a b m ()+INLINE_RULE(concatMapAccumM, f x, CL.concatMapAccumM f x)++-- | Encode a stream of text as UTF8.+--+-- Subject to fusion+--+-- @since 1.3.0+encodeUtf8 :: (Monad m, DTE.Utf8 text binary) => ConduitT text binary m ()+INLINE_RULE0(encodeUtf8, map DTE.encodeUtf8)++-- | Decode a stream of binary data as UTF8.+--+-- @since 1.3.0+decodeUtf8 :: MonadThrow m => ConduitT ByteString Text m ()+decodeUtf8 =+    loop TE.streamDecodeUtf8+  where+    loop parse =+        await >>= maybe done go+      where+        parse' = unsafePerformIO . try . evaluate . parse+        done =+          case parse' mempty of+            Left e -> throwM (e :: TEE.UnicodeException)+            Right (TE.Some t bs _) -> do+              unless (T.null t) (yield t)+              unless (S.null bs) (yield $ T.replicate (S.length bs) (T.singleton '\xFFFD'))++        go bs = do+          case parse' bs of+            Left e -> do+              leftover bs+              throwM (e :: TEE.UnicodeException)+            Right (TE.Some t _ next) -> do+              unless (T.null t) (yield t)+              loop next++-- | Decode a stream of binary data as UTF8, replacing any invalid bytes with+-- the Unicode replacement character.+--+-- @since 1.3.0+decodeUtf8Lenient :: Monad m => ConduitT ByteString Text m ()+decodeUtf8Lenient =+    loop (TE.streamDecodeUtf8With TEE.lenientDecode)+  where+    loop parse =+        await >>= maybe done go+      where+        done = do+          let TE.Some t bs _ = parse mempty+          unless (T.null t) (yield t)+          unless (S.null bs) (yield $ T.replicate (S.length bs) (T.singleton '\xFFFD'))++        go bs = do+          let TE.Some t _ next = parse bs+          unless (T.null t) (yield t)+          loop next++-- | Stream in the entirety of a single line.+--+-- Like @takeExactly@, this will consume the entirety of the line regardless of+-- the behavior of the inner Conduit.+--+-- @since 1.3.0+line :: (Monad m, Seq.IsSequence seq, Element seq ~ Char)+     => ConduitT seq o m r+     -> ConduitT seq o m r+line = takeExactlyUntilE (== '\n')+{-# INLINE line #-}++-- | Same as 'line', but operates on ASCII/binary data.+--+-- @since 1.3.0+lineAscii :: (Monad m, Seq.IsSequence seq, Element seq ~ Word8)+          => ConduitT seq o m r+          -> ConduitT seq o m r+lineAscii = takeExactlyUntilE (== 10)+{-# INLINE lineAscii #-}++-- | Stream in the chunked input until an element matches a predicate.+--+-- Like @takeExactly@, this will consume the entirety of the prefix+-- regardless of the behavior of the inner Conduit.+takeExactlyUntilE :: (Monad m, Seq.IsSequence seq)+                  => (Element seq -> Bool)+                  -> ConduitT seq o m r+                  -> ConduitT seq o m r+takeExactlyUntilE f inner =+    loop .| do+        x <- inner+        sinkNull+        return x+  where+    loop = await >>= omapM_ go+    go t =+        if onull y+            then yield x >> loop+            else do+                unless (onull x) $ yield x+                let y' = Seq.drop 1 y+                unless (onull y') $ leftover y'+      where+        (x, y) = Seq.break f t+{-# INLINE takeExactlyUntilE #-}++-- | Insert a newline character after each incoming chunk of data.+--+-- Subject to fusion+--+-- @since 1.3.0+unlines :: (Monad m, Seq.IsSequence seq, Element seq ~ Char) => ConduitT seq seq m ()+INLINE_RULE0(unlines, concatMap (:[Seq.singleton '\n']))++-- | Same as 'unlines', but operates on ASCII/binary data.+--+-- Subject to fusion+--+-- @since 1.3.0+unlinesAscii :: (Monad m, Seq.IsSequence seq, Element seq ~ Word8) => ConduitT seq seq m ()+INLINE_RULE0(unlinesAscii, concatMap (:[Seq.singleton 10]))++-- | Split a stream of arbitrarily-chunked data, based on a predicate+-- on elements.  Elements that satisfy the predicate will cause chunks+-- to be split, and aren't included in these output chunks.  Note+-- that, if you have unknown or untrusted input, this function is+-- /unsafe/, since it would allow an attacker to form chunks of+-- massive length and exhaust memory.+splitOnUnboundedE, splitOnUnboundedEC :: (Monad m, Seq.IsSequence seq) => (Element seq -> Bool) -> ConduitT seq seq m ()+splitOnUnboundedEC f =+    start+  where+    start = await >>= maybe (return ()) (loop id)++    loop bldr t =+        if onull y+            then do+                mt <- await+                case mt of+                    Nothing -> let finalChunk = mconcat $ bldr [t]+                               in  unless (onull finalChunk) $ yield finalChunk+                    Just t' -> loop (bldr . (t:)) t'+            else yield (mconcat $ bldr [x]) >> loop id (Seq.drop 1 y)+      where+        (x, y) = Seq.break f t+STREAMING(splitOnUnboundedE, splitOnUnboundedEC, splitOnUnboundedES, f)++-- | Convert a stream of arbitrarily-chunked textual data into a stream of data+-- where each chunk represents a single line. Note that, if you have+-- unknown or untrusted input, this function is /unsafe/, since it would allow an+-- attacker to form lines of massive length and exhaust memory.+--+-- Subject to fusion+--+-- @since 1.3.0+linesUnbounded :: (Monad m, Seq.IsSequence seq, Element seq ~ Char)+               => ConduitT seq seq m ()+INLINE_RULE0(linesUnbounded, splitOnUnboundedE (== '\n'))++-- | Same as 'linesUnbounded', but for ASCII/binary data.+--+-- Subject to fusion+--+-- @since 1.3.0+linesUnboundedAscii :: (Monad m, Seq.IsSequence seq, Element seq ~ Word8)+                    => ConduitT seq seq m ()+INLINE_RULE0(linesUnboundedAscii, splitOnUnboundedE (== 10))++-- | Incrementally execute builders and pass on the filled chunks as+-- bytestrings.+--+-- @since 1.3.0+builderToByteString :: PrimMonad m => ConduitT Builder S.ByteString m ()+builderToByteString = builderToByteStringWith defaultStrategy+{-# INLINE builderToByteString #-}++-- | Same as 'builderToByteString', but input and output are wrapped in+-- 'Flush'.+--+-- @since 1.3.0+builderToByteStringFlush :: PrimMonad m+                         => ConduitT (Flush Builder) (Flush S.ByteString) m ()+builderToByteStringFlush = builderToByteStringWithFlush defaultStrategy+{-# INLINE builderToByteStringFlush #-}++-- | Incrementally execute builders on the given buffer and pass on the filled+-- chunks as bytestrings. Note that, if the given buffer is too small for the+-- execution of a build step, a larger one will be allocated.+--+-- WARNING: This conduit yields bytestrings that are NOT+-- referentially transparent. Their content will be overwritten as soon+-- as control is returned from the inner sink!+--+-- @since 1.3.0+unsafeBuilderToByteString :: PrimMonad m+                          => ConduitT Builder S.ByteString m ()+unsafeBuilderToByteString =+  builderToByteStringWith (reuseBufferStrategy (allocBuffer defaultChunkSize))+{-# INLINE unsafeBuilderToByteString #-}+++-- | A conduit that incrementally executes builders and passes on the+-- filled chunks as bytestrings to an inner sink.+--+-- INV: All bytestrings passed to the inner sink are non-empty.+--+-- @since 1.3.0+builderToByteStringWith :: PrimMonad m+                        => BufferAllocStrategy+                        -> ConduitT Builder S.ByteString m ()+builderToByteStringWith =+    bbhelper (liftM (fmap Chunk) await) yield'+  where+    yield' Flush = return ()+    yield' (Chunk bs) = yield bs+{-# INLINE builderToByteStringWith #-}++-- |+--+-- @since 1.3.0+builderToByteStringWithFlush+    :: PrimMonad m+    => BufferAllocStrategy+    -> ConduitT (Flush Builder) (Flush S.ByteString) m ()+builderToByteStringWithFlush = bbhelper await yield+{-# INLINE builderToByteStringWithFlush #-}++bbhelper+  :: PrimMonad m+  => m (Maybe (Flush Builder))+  -> (Flush S.ByteString -> m ())+  -> BufferAllocStrategy+  -> m ()+bbhelper await' yield' strat = do+    (recv, finish) <- unsafePrimToPrim $ newByteStringBuilderRecv strat+    let loop = await' >>= maybe finish' cont+        finish' = do+            mbs <- unsafePrimToPrim finish+            maybe (return ()) (yield' . Chunk) mbs+        cont fbuilder = do+            let builder =+                    case fbuilder of+                        Flush -> BB.flush+                        Chunk b -> b+            popper <- unsafePrimToPrim $ recv builder+            let cont' = do+                    bs <- unsafePrimToPrim popper+                    unless (S.null bs) $ do+                        yield' (Chunk bs)+                        cont'+            cont'+            case fbuilder of+                Flush -> yield' Flush+                Chunk _ -> return ()+            loop+    loop+{-# INLINE bbhelper #-}++-- | Provides a series of @ByteString@s until empty, at which point it provides+-- an empty @ByteString@.+--+-- @since 1.3.0+--+type BuilderPopper = IO S.ByteString++type BuilderRecv = Builder -> IO BuilderPopper++type BuilderFinish = IO (Maybe S.ByteString)++newByteStringBuilderRecv :: BufferAllocStrategy -> IO (BuilderRecv, BuilderFinish)+newByteStringBuilderRecv (ioBufInit, nextBuf) = do+    refBuf <- newIORef ioBufInit+    return (push refBuf, finish refBuf)+  where+    finish refBuf = do+        ioBuf <- readIORef refBuf+        buf <- ioBuf+        return $ unsafeFreezeNonEmptyBuffer buf++    push refBuf builder = do+        refWri <- newIORef $ Left $ BB.runBuilder builder+        return $ popper refBuf refWri++    popper refBuf refWri = do+        ioBuf <- readIORef refBuf+        ebWri <- readIORef refWri+        case ebWri of+            Left bWri -> do+                !buf@(Buffer _ _ op ope) <- ioBuf+                (bytes, next) <- bWri op (ope `minusPtr` op)+                let op' = op `plusPtr` bytes+                case next of+                    BB.Done -> do+                        writeIORef refBuf $ return $ updateEndOfSlice buf op'+                        return S.empty+                    BB.More minSize bWri' -> do+                        let buf' = updateEndOfSlice buf op'+                            {-# INLINE cont #-}+                            cont mbs = do+                                -- sequencing the computation of the next buffer+                                -- construction here ensures that the reference to the+                                -- foreign pointer `fp` is lost as soon as possible.+                                ioBuf' <- nextBuf minSize buf'+                                writeIORef refBuf ioBuf'+                                writeIORef refWri $ Left bWri'+                                case mbs of+                                    Just bs | not $ S.null bs -> return bs+                                    _ -> popper refBuf refWri+                        cont $ unsafeFreezeNonEmptyBuffer buf'+                    BB.Chunk bs bWri' -> do+                        let buf' = updateEndOfSlice buf op'+                        let yieldBS = do+                                nextBuf 1 buf' >>= writeIORef refBuf+                                writeIORef refWri $ Left bWri'+                                if S.null bs+                                    then popper refBuf refWri+                                    else return bs+                        case unsafeFreezeNonEmptyBuffer buf' of+                            Nothing -> yieldBS+                            Just bs' -> do+                                writeIORef refWri $ Right yieldBS+                                return bs'+            Right action -> action++-- | A buffer @Buffer fpbuf p0 op ope@ describes a buffer with the underlying+-- byte array @fpbuf..ope@, the currently written slice @p0..op@ and the free+-- space @op..ope@.+--+-- @since 1.3.0+data Buffer = Buffer {-# UNPACK #-} !(ForeignPtr Word8) -- underlying pinned array+                     {-# UNPACK #-} !(Ptr Word8)        -- beginning of slice+                     {-# UNPACK #-} !(Ptr Word8)        -- next free byte+                     {-# UNPACK #-} !(Ptr Word8)        -- first byte after buffer++-- | Convert the buffer to a bytestring. This operation is unsafe in the sense+-- that created bytestring shares the underlying byte array with the buffer.+-- Hence, depending on the later use of this buffer (e.g., if it gets reset and+-- filled again) referential transparency may be lost.+--+-- @since 1.3.0+--+{-# INLINE unsafeFreezeBuffer #-}+unsafeFreezeBuffer :: Buffer -> S.ByteString+unsafeFreezeBuffer (Buffer fpbuf p0 op _) =+    PS fpbuf (p0 `minusPtr` unsafeForeignPtrToPtr fpbuf) (op `minusPtr` p0)++-- | Convert a buffer to a non-empty bytestring. See 'unsafeFreezeBuffer' for+-- the explanation of why this operation may be unsafe.+--+-- @since 1.3.0+--+{-# INLINE unsafeFreezeNonEmptyBuffer #-}+unsafeFreezeNonEmptyBuffer :: Buffer -> Maybe S.ByteString+unsafeFreezeNonEmptyBuffer buf+  | sliceSize buf <= 0 = Nothing+  | otherwise          = Just $ unsafeFreezeBuffer buf++-- | Update the end of slice pointer.+--+-- @since 1.3.0+--+{-# INLINE updateEndOfSlice #-}+updateEndOfSlice :: Buffer    -- Old buffer+                 -> Ptr Word8 -- New end of slice+                 -> Buffer    -- Updated buffer+updateEndOfSlice (Buffer fpbuf p0 _ ope) op' = Buffer fpbuf p0 op' ope++-- | The size of the written slice in the buffer.+--+-- @since 1.3.0+--+sliceSize :: Buffer -> Int+sliceSize (Buffer _ p0 op _) = op `minusPtr` p0++-- | A buffer allocation strategy @(buf0, nextBuf)@ specifies the initial+-- buffer to use and how to compute a new buffer @nextBuf minSize buf@ with at+-- least size @minSize@ from a filled buffer @buf@. The double nesting of the+-- @IO@ monad helps to ensure that the reference to the filled buffer @buf@ is+-- lost as soon as possible, but the new buffer doesn't have to be allocated+-- too early.+--+-- @since 1.3.0+type BufferAllocStrategy = (IO Buffer, Int -> Buffer -> IO (IO Buffer))++-- | Safe default: allocate new buffers of default chunk size+--+-- @since 1.3.0+defaultStrategy :: BufferAllocStrategy+defaultStrategy = allNewBuffersStrategy defaultChunkSize++-- | The simplest buffer allocation strategy: whenever a buffer is requested,+-- allocate a new one that is big enough for the next build step to execute.+--+-- NOTE that this allocation strategy may spill quite some memory upon direct+-- insertion of a bytestring by the builder. Thats no problem for garbage+-- collection, but it may lead to unreasonably high memory consumption in+-- special circumstances.+--+-- @since 1.3.0+allNewBuffersStrategy :: Int                 -- Minimal buffer size.+                      -> BufferAllocStrategy+allNewBuffersStrategy bufSize =+    ( allocBuffer bufSize+    , \reqSize _ -> return (allocBuffer (max reqSize bufSize)) )++-- | An unsafe, but possibly more efficient buffer allocation strategy:+-- reuse the buffer, if it is big enough for the next build step to execute.+--+-- @since 1.3.0+reuseBufferStrategy :: IO Buffer+                    -> BufferAllocStrategy+reuseBufferStrategy buf0 =+    (buf0, tryReuseBuffer)+  where+    tryReuseBuffer reqSize buf+      | bufferSize buf >= reqSize = return $ return (reuseBuffer buf)+      | otherwise                 = return $ allocBuffer reqSize++-- | The size of the whole byte array underlying the buffer.+--+-- @since 1.3.0+--+bufferSize :: Buffer -> Int+bufferSize (Buffer fpbuf _ _ ope) =+    ope `minusPtr` unsafeForeignPtrToPtr fpbuf++-- | @allocBuffer size@ allocates a new buffer of size @size@.+--+-- @since 1.3.0+--+{-# INLINE allocBuffer #-}+allocBuffer :: Int -> IO Buffer+allocBuffer size = do+    fpbuf <- mallocByteString size+    let !pbuf = unsafeForeignPtrToPtr fpbuf+    return $! Buffer fpbuf pbuf pbuf (pbuf `plusPtr` size)++-- | Resets the beginning of the next slice and the next free byte such that+-- the whole buffer can be filled again.+--+-- @since 1.3.0+--+{-# INLINE reuseBuffer #-}+reuseBuffer :: Buffer -> Buffer+reuseBuffer (Buffer fpbuf _ _ ope) = Buffer fpbuf p0 p0 ope+  where+    p0 = unsafeForeignPtrToPtr fpbuf++-- | Generally speaking, yielding values from inside a Conduit requires+-- some allocation for constructors. This can introduce an overhead,+-- similar to the overhead needed to represent a list of values instead of+-- a vector. This overhead is even more severe when talking about unboxed+-- values.+--+-- This combinator allows you to overcome this overhead, and efficiently+-- fill up vectors. It takes two parameters. The first is the size of each+-- mutable vector to be allocated. The second is a function. The function+-- takes an argument which will yield the next value into a mutable+-- vector.+--+-- Under the surface, this function uses a number of tricks to get high+-- performance. For more information on both usage and implementation,+-- please see:+-- <https://www.schoolofhaskell.com/user/snoyberg/library-documentation/vectorbuilder>+--+-- @since 1.3.0+vectorBuilder :: (PrimMonad m, PrimMonad n, V.Vector v e, PrimState m ~ PrimState n)+              => Int -- ^ size+              -> ((e -> n ()) -> ConduitT i Void m r)+              -> ConduitT i (v e) m r+vectorBuilder size inner = do+    ref <- do+        mv <- VM.new size+        newMutVar $! S 0 mv id+    res <- onAwait (yieldS ref) (inner (addE ref))+    vs <- do+        S idx mv front <- readMutVar ref+        end <-+            if idx == 0+                then return []+                else do+                    v <- V.unsafeFreeze mv+                    return [V.unsafeTake idx v]+        return $ front end+    Prelude.mapM_ yield vs+    return res+{-# INLINE vectorBuilder #-}++data S s v e = S+    {-# UNPACK #-} !Int -- index+    !(V.Mutable v s e)+    ([v e] -> [v e])++onAwait :: Monad m+        => ConduitT i o m ()+        -> ConduitT i Void m r+        -> ConduitT i o m r+onAwait (ConduitT callback) (ConduitT sink0) = ConduitT $ \rest -> let+    go (Done r) = rest r+    go (HaveOutput _ o) = absurd o+    go (NeedInput f g) = callback $ \() -> NeedInput (go . f) (go . g)+    go (PipeM mp) = PipeM (liftM go mp)+    go (Leftover f i) = Leftover (go f) i+    in go (sink0 Done)+{-# INLINE onAwait #-}++yieldS :: PrimMonad m+       => MutVar (PrimState m) (S (PrimState m) v e)+       -> ConduitT i (v e) m ()+yieldS ref = do+    S idx mv front <- readMutVar ref+    Prelude.mapM_ yield (front [])+    writeMutVar ref $! S idx mv id+{-# INLINE yieldS #-}++addE :: (PrimMonad m, V.Vector v e)+     => MutVar (PrimState m) (S (PrimState m) v e)+     -> e+     -> m ()+addE ref e = do+    S idx mv front <- readMutVar ref+    VM.write mv idx e+    let idx' = succ idx+        size = VM.length mv+    if idx' >= size+        then do+            v <- V.unsafeFreeze mv+            let front' = front . (v:)+            mv' <- VM.new size+            writeMutVar ref $! S 0 mv' front'+        else writeMutVar ref $! S idx' mv front+{-# INLINE addE #-}++-- | Consume a source with a strict accumulator, in a way piecewise defined by+-- a controlling stream. The latter will be evaluated until it terminates.+--+-- >>> let f a s = liftM (:s) $ mapC (*a) =$ CL.take a+-- >>> reverse $ runIdentity $ yieldMany [0..3] $$ mapAccumS f [] (yieldMany [1..])+-- [[],[1],[4,6],[12,15,18]] :: [[Int]]+mapAccumS+  :: Monad m+  => (a -> s -> ConduitT b Void m s)+  -> s+  -> ConduitT () b m ()+  -> ConduitT a Void m s+mapAccumS f s xs = do+    (_, u) <- loop (sealConduitT xs, s)+    return u+    where loop r@(ys, !t) = await >>= maybe (return r) go+              where go a  = lift (ys $$++ f a t) >>= loop+{-# INLINE mapAccumS #-}++-- | Run a consuming conduit repeatedly, only stopping when there is no more+-- data available from upstream.+--+-- @since 1.3.0+peekForever :: Monad m => ConduitT i o m () -> ConduitT i o m ()+peekForever inner =+    loop+  where+    loop = do+        mx <- peek+        case mx of+            Nothing -> return ()+            Just _ -> inner >> loop++-- | Run a consuming conduit repeatedly, only stopping when there is no more+-- data available from upstream.+--+-- In contrast to 'peekForever', this function will ignore empty+-- chunks of data. So for example, if a stream of data contains an+-- empty @ByteString@, it is still treated as empty, and the consuming+-- function is not called.+--+-- @since 1.3.0+peekForeverE :: (Monad m, MonoFoldable i)+             => ConduitT i o m ()+             -> ConduitT i o m ()+peekForeverE inner =+    loop+  where+    loop = do+        mx <- peekE+        case mx of+            Nothing -> return ()+            Just _ -> inner >> loop
+ src/Data/Conduit/Combinators/Stream.hs view
@@ -0,0 +1,474 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE ViewPatterns #-}+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE TypeFamilies #-}+-- | These are stream fusion versions of some of the functions in+-- "Data.Conduit.Combinators".  Many functions don't have stream+-- versions here because instead they have @RULES@ which inline a+-- definition that fuses.+module Data.Conduit.Combinators.Stream+  ( yieldManyS+  , repeatMS+  , repeatWhileMS+  , foldl1S+  , allS+  , anyS+  , sinkLazyS+  , sinkVectorS+  , sinkVectorNS+  , sinkLazyBuilderS+  , lastS+  , lastES+  , findS+  , concatMapS+  , concatMapMS+  , concatS+  , scanlS+  , scanlMS+  , mapAccumWhileS+  , mapAccumWhileMS+  , intersperseS+  , slidingWindowS+  , filterMS+  , splitOnUnboundedES+  , initReplicateS+  , initRepeatS+  )+  where++-- BEGIN IMPORTS++import           Control.Monad (liftM)+import           Control.Monad.Primitive (PrimMonad)+import qualified Data.ByteString.Lazy as BL+import           Data.ByteString.Builder (Builder, toLazyByteString)+import           Data.Conduit.Internal.Fusion+import           Data.Conduit.Internal.List.Stream (foldS)+import           Data.Maybe (isNothing, isJust)+import           Data.MonoTraversable+#if ! MIN_VERSION_base(4,8,0)+import           Data.Monoid (Monoid (..))+#endif+import qualified Data.NonNull as NonNull+import qualified Data.Sequences as Seq+import qualified Data.Vector.Generic as V+import qualified Data.Vector.Generic.Mutable as VM+import           Prelude++#if MIN_VERSION_mono_traversable(1,0,0)+import           Data.Sequences (LazySequence (..))+#else+import           Data.Sequences.Lazy+#endif++-- END IMPORTS++yieldManyS :: (Monad m, MonoFoldable mono)+            => mono+            -> StreamProducer m (Element mono)+yieldManyS mono _ =+    Stream (return . step) (return (otoList mono))+  where+    step [] = Stop ()+    step (x:xs) = Emit xs x+{-# INLINE yieldManyS #-}++repeatMS :: Monad m+         => m a+         -> StreamProducer m a+repeatMS m _ =+    Stream step (return ())+  where+    step _ = liftM (Emit ()) m+{-# INLINE repeatMS #-}++repeatWhileMS :: Monad m+              => m a+              -> (a -> Bool)+              -> StreamProducer m a+repeatWhileMS m f _ =+    Stream step (return ())+  where+    step _ = do+        x <- m+        return $ if f x+            then Emit () x+            else Stop ()+{-# INLINE repeatWhileMS #-}++foldl1S :: Monad m+        => (a -> a -> a)+        -> StreamConsumer a m (Maybe a)+foldl1S f (Stream step ms0) =+    Stream step' (liftM (Nothing, ) ms0)+  where+    step' (mprev, s) = do+        res <- step s+        return $ case res of+            Stop () -> Stop mprev+            Skip s' -> Skip (mprev, s')+            Emit s' a -> Skip (Just $ maybe a (`f` a) mprev, s')+{-# INLINE foldl1S #-}++allS :: Monad m+     => (a -> Bool)+     -> StreamConsumer a m Bool+allS f = fmapS isNothing (findS (Prelude.not . f))+{-# INLINE allS #-}++anyS :: Monad m+     => (a -> Bool)+     -> StreamConsumer a m Bool+anyS f = fmapS isJust (findS f)+{-# INLINE anyS #-}++--TODO: use a definition like+-- fmapS (fromChunks . ($ [])) <$> CL.fold (\front next -> front . (next:)) id++sinkLazyS :: (Monad m, LazySequence lazy strict)+          => StreamConsumer strict m lazy+sinkLazyS = fmapS (fromChunks . ($ [])) $ foldS (\front next -> front . (next:)) id+{-# INLINE sinkLazyS #-}++sinkVectorS :: (V.Vector v a, PrimMonad m)+            => StreamConsumer a m (v a)+sinkVectorS (Stream step ms0) = do+    Stream step' $ do+        s0 <- ms0+        mv0 <- VM.new initSize+        return (initSize, 0, mv0, s0)+  where+    initSize = 10+    step' (maxSize, i, mv, s) = do+        res <- step s+        case res of+            Stop () -> liftM (Stop . V.slice 0 i) $ V.unsafeFreeze mv+            Skip s' -> return $ Skip (maxSize, i, mv, s')+            Emit s' x -> do+                VM.write mv i x+                let i' = i + 1+                if i' >= maxSize+                    then do+                        let newMax = maxSize * 2+                        mv' <- VM.grow mv maxSize+                        return $ Skip (newMax, i', mv', s')+                    else return $ Skip (maxSize, i', mv, s')+{-# INLINE sinkVectorS #-}++sinkVectorNS :: (V.Vector v a, PrimMonad m)+             => Int -- ^ maximum allowed size+             -> StreamConsumer a m (v a)+sinkVectorNS maxSize (Stream step ms0) = do+    Stream step' $ do+        s0 <- ms0+        mv0 <- VM.new maxSize+        return (0, mv0, s0)+  where+    step' (i, mv, _) | i >= maxSize = liftM Stop $ V.unsafeFreeze mv+    step' (i, mv, s) = do+        res <- step s+        case res of+            Stop () -> liftM (Stop . V.slice 0 i) $ V.unsafeFreeze mv+            Skip s' -> return $ Skip (i, mv, s')+            Emit s' x -> do+                VM.write mv i x+                let i' = i + 1+                return $ Skip (i', mv, s')+{-# INLINE sinkVectorNS #-}++sinkLazyBuilderS :: Monad m => StreamConsumer Builder m BL.ByteString+sinkLazyBuilderS = fmapS toLazyByteString (foldS mappend mempty)+{-# INLINE sinkLazyBuilderS #-}++lastS :: Monad m+      => StreamConsumer a m (Maybe a)+lastS (Stream step ms0) =+    Stream step' (liftM (Nothing,) ms0)+  where+    step' (mlast, s) = do+        res <- step s+        return $ case res of+            Stop () -> Stop mlast+            Skip s' -> Skip (mlast, s')+            Emit s' x -> Skip (Just x, s')+{-# INLINE lastS #-}++lastES :: (Monad m, Seq.IsSequence seq)+       => StreamConsumer seq m (Maybe (Element seq))+lastES (Stream step ms0) =+    Stream step' (liftM (Nothing, ) ms0)+  where+    step' (mlast, s) = do+        res <- step s+        return $ case res of+            Stop () -> Stop (fmap NonNull.last mlast)+            Skip s' -> Skip (mlast, s')+            Emit s' (NonNull.fromNullable -> mlast'@(Just _)) -> Skip (mlast', s')+            Emit s' _ -> Skip (mlast, s')+{-# INLINE lastES #-}++findS :: Monad m+      => (a -> Bool) -> StreamConsumer a m (Maybe a)+findS f (Stream step ms0) =+    Stream step' ms0+  where+    step' s = do+      res <- step s+      return $ case res of+          Stop () -> Stop Nothing+          Skip s' -> Skip s'+          Emit s' x ->+              if f x+                  then Stop (Just x)+                  else Skip s'+{-# INLINE findS #-}++concatMapS :: (Monad m, MonoFoldable mono)+           => (a -> mono)+           -> StreamConduit a m (Element mono)+concatMapS f (Stream step ms0) =+    Stream step' (liftM ([], ) ms0)+  where+    step' ([], s) = do+        res <- step s+        return $ case res of+            Stop () -> Stop ()+            Skip s' -> Skip ([], s')+            Emit s' x -> Skip (otoList (f x), s')+    step' ((x:xs), s) = return (Emit (xs, s) x)+{-# INLINE concatMapS #-}++concatMapMS :: (Monad m, MonoFoldable mono)+             => (a -> m mono)+             -> StreamConduit a m (Element mono)+concatMapMS f (Stream step ms0) =+    Stream step' (liftM ([], ) ms0)+  where+    step' ([], s) = do+        res <- step s+        case res of+            Stop () -> return $ Stop ()+            Skip s' -> return $ Skip ([], s')+            Emit s' x -> do+                o <- f x+                return $ Skip (otoList o, s')+    step' ((x:xs), s) = return (Emit (xs, s) x)+{-# INLINE concatMapMS #-}++concatS :: (Monad m, MonoFoldable mono)+         => StreamConduit mono m (Element mono)+concatS = concatMapS id+{-# INLINE concatS #-}++data ScanState a s+    = ScanEnded+    | ScanContinues a s++scanlS :: Monad m => (a -> b -> a) -> a -> StreamConduit b m a+scanlS f seed0 (Stream step ms0) =+    Stream step' (liftM (ScanContinues seed0) ms0)+  where+    step' ScanEnded = return $ Stop ()+    step' (ScanContinues seed s) = do+        res <- step s+        return $ case res of+            Stop () -> Emit ScanEnded seed+            Skip s' -> Skip (ScanContinues seed s')+            Emit s' x -> Emit (ScanContinues seed' s') seed+              where+                !seed' = f seed x+{-# INLINE scanlS #-}++scanlMS :: Monad m => (a -> b -> m a) -> a -> StreamConduit b m a+scanlMS f seed0 (Stream step ms0) =+    Stream step' (liftM (ScanContinues seed0) ms0)+  where+    step' ScanEnded = return $ Stop ()+    step' (ScanContinues seed s) = do+        res <- step s+        case res of+            Stop () -> return $ Emit ScanEnded seed+            Skip s' -> return $ Skip (ScanContinues seed s')+            Emit s' x -> do+                !seed' <- f seed x+                return $ Emit (ScanContinues seed' s') seed+{-# INLINE scanlMS #-}++mapAccumWhileS :: Monad m =>+    (a -> s -> Either s (s, b)) -> s -> StreamConduitT a b m s+mapAccumWhileS f initial (Stream step ms0) =+    Stream step' (liftM (initial, ) ms0)+  where+    step' (!accum, s) = do+        res <- step s+        return $ case res of+            Stop () -> Stop accum+            Skip s' -> Skip (accum, s')+            Emit s' x -> case f x accum of+                Right (!accum', r) -> Emit (accum', s') r+                Left   !accum'     -> Stop accum'+{-# INLINE mapAccumWhileS #-}++mapAccumWhileMS :: Monad m =>+    (a -> s -> m (Either s (s, b))) -> s -> StreamConduitT a b m s+mapAccumWhileMS f initial (Stream step ms0) =+    Stream step' (liftM (initial, ) ms0)+  where+    step' (!accum, s) = do+        res <- step s+        case res of+            Stop () -> return $ Stop accum+            Skip s' -> return $ Skip (accum, s')+            Emit s' x -> do+                lr <- f x accum+                return $ case lr of+                    Right (!accum', r) -> Emit (accum', s') r+                    Left   !accum'     -> Stop accum'+{-# INLINE mapAccumWhileMS #-}++data IntersperseState a s+    = IFirstValue s+    | IGotValue s a+    | IEmitValue s a++intersperseS :: Monad m => a -> StreamConduit a m a+intersperseS sep (Stream step ms0) =+    Stream step' (liftM IFirstValue ms0)+  where+    step' (IFirstValue s) = do+        res <- step s+        return $ case res of+            Stop () -> Stop ()+            Skip s' -> Skip (IFirstValue s')+            Emit s' x -> Emit (IGotValue s' x) x+    -- Emit the separator once we know it's not the end of the list.+    step' (IGotValue s x) = do+        res <- step s+        return $ case res of+            Stop () -> Stop ()+            Skip s' -> Skip (IGotValue s' x)+            Emit s' x' -> Emit (IEmitValue s' x') sep+    -- We emitted a separator, now emit the value that comes after.+    step' (IEmitValue s x) = return $ Emit (IGotValue s x) x+{-# INLINE intersperseS #-}++data SlidingWindowState seq s+    = SWInitial Int seq s+    | SWSliding seq s+    | SWEarlyExit++slidingWindowS :: (Monad m, Seq.IsSequence seq, Element seq ~ a) => Int -> StreamConduit a m seq+slidingWindowS sz (Stream step ms0) =+    Stream step' (liftM (SWInitial (max 1 sz) mempty) ms0)+  where+    step' (SWInitial n st s) = do+        res <- step s+        return $ case res of+            Stop () -> Emit SWEarlyExit st+            Skip s' -> Skip (SWInitial n st s')+            Emit s' x ->+                if n == 1+                    then Emit (SWSliding (Seq.unsafeTail st') s') st'+                    else Skip (SWInitial (n - 1) st' s')+              where+                st' = Seq.snoc st x+    -- After collecting the initial window, each upstream element+    -- causes an additional window to be yielded.+    step' (SWSliding st s) = do+        res <- step s+        return $ case res of+            Stop () -> Stop ()+            Skip s' -> Skip (SWSliding st s')+            Emit s' x -> Emit (SWSliding (Seq.unsafeTail st') s') st'+              where+                st' = Seq.snoc st x+    step' SWEarlyExit = return $ Stop ()++{-# INLINE slidingWindowS #-}++filterMS :: Monad m+         => (a -> m Bool)+         -> StreamConduit a m a+filterMS f (Stream step ms0) = do+    Stream step' ms0+  where+    step' s = do+        res <- step s+        case res of+            Stop () -> return $ Stop ()+            Skip s' -> return $ Skip s'+            Emit s' x -> do+                r <- f x+                return $+                    if r+                        then Emit s' x+                        else Skip s'+{-# INLINE filterMS #-}++data SplitState seq s+    = SplitDone+    -- When no element of seq passes the predicate.  This allows+    -- 'splitOnUnboundedES' to not run 'Seq.break' multiple times due+    -- to 'Skip's being sent by the upstream.+    | SplitNoSep seq s+    | SplitState seq s++splitOnUnboundedES :: (Monad m, Seq.IsSequence seq)+                   => (Element seq -> Bool) -> StreamConduit seq m seq+splitOnUnboundedES f (Stream step ms0) =+    Stream step' (liftM (SplitState mempty) ms0)+  where+    step' SplitDone = return $ Stop ()+    step' (SplitNoSep t s) = do+        res <- step s+        return $ case res of+            Stop () | not (onull t) -> Emit SplitDone t+                    | otherwise -> Stop ()+            Skip s' -> Skip (SplitNoSep t s')+            Emit s' t' -> Skip (SplitState (t `mappend` t') s')+    step' (SplitState t s) = do+        if onull y+            then do+                res <- step s+                return $ case res of+                    Stop () | not (onull t) -> Emit SplitDone t+                            | otherwise -> Stop ()+                    Skip s' -> Skip (SplitNoSep t s')+                    Emit s' t' -> Skip (SplitState (t `mappend` t') s')+            else return $ Emit (SplitState (Seq.drop 1 y) s) x+      where+        (x, y) = Seq.break f t+{-# INLINE splitOnUnboundedES #-}++-- | Streaming versions of @Data.Conduit.Combinators.Internal.initReplicate@+initReplicateS :: Monad m => m seed -> (seed -> m a) -> Int -> StreamProducer m a+initReplicateS mseed f cnt _ =+    Stream step (liftM (cnt, ) mseed)+  where+    step (ix, _) | ix <= 0 = return $ Stop ()+    step (ix, seed) = do+        x <- f seed+        return $ Emit (ix - 1, seed) x+{-# INLINE initReplicateS #-}++-- | Streaming versions of @Data.Conduit.Combinators.Internal.initRepeat@+initRepeatS :: Monad m => m seed -> (seed -> m a) -> StreamProducer m a+initRepeatS mseed f _ =+    Stream step mseed+  where+    step seed = do+        x <- f seed+        return $ Emit seed x+{-# INLINE initRepeatS #-}++-- | Utility function+fmapS :: Monad m+      => (a -> b)+      -> StreamConduitT i o m a+      -> StreamConduitT i o m b+fmapS f s inp =+    case s inp of+        Stream step ms0 -> Stream (fmap (liftM (fmap f)) step) ms0+{-# INLINE fmapS #-}
+ src/Data/Conduit/Combinators/Unqualified.hs view
@@ -0,0 +1,1206 @@+{-# OPTIONS_HADDOCK not-home #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE MultiParamTypeClasses     #-}+{-# LANGUAGE NoImplicitPrelude         #-}+{-# LANGUAGE NoMonomorphismRestriction #-}+module Data.Conduit.Combinators.Unqualified+    ( -- ** Producers+      -- *** Pure+      CC.yieldMany+    , unfoldC+    , enumFromToC+    , iterateC+    , repeatC+    , replicateC+    , CC.sourceLazy++      -- *** Monadic+    , repeatMC+    , repeatWhileMC+    , replicateMC++      -- *** I\/O+    , CC.sourceFile+    , CC.sourceFileBS+    , CC.sourceHandle+    , CC.sourceHandleUnsafe+    , CC.sourceIOHandle+    , stdinC+    , CC.withSourceFile++      -- *** Filesystem+    , CC.sourceDirectory+    , CC.sourceDirectoryDeep++      -- ** Consumers+      -- *** Pure+    , dropC+    , dropCE+    , dropWhileC+    , dropWhileCE+    , foldC+    , foldCE+    , foldlC+    , foldlCE+    , foldMapC+    , foldMapCE+    , allC+    , allCE+    , anyC+    , anyCE+    , andC+    , andCE+    , orC+    , orCE+    , asumC+    , elemC+    , elemCE+    , notElemC+    , notElemCE+    , CC.sinkLazy+    , CC.sinkList+    , CC.sinkVector+    , CC.sinkVectorN+    , CC.sinkLazyBuilder+    , CC.sinkNull+    , CC.awaitNonNull+    , headC+    , headDefC+    , headCE+    , peekC+    , peekCE+    , lastC+    , lastDefC+    , lastCE+    , lengthC+    , lengthCE+    , lengthIfC+    , lengthIfCE+    , maximumC+    , maximumCE+    , minimumC+    , minimumCE+    , nullC+    , nullCE+    , sumC+    , sumCE+    , productC+    , productCE+    , findC++      -- *** Monadic+    , mapM_C+    , mapM_CE+    , foldMC+    , foldMCE+    , foldMapMC+    , foldMapMCE++      -- *** I\/O+    , CC.sinkFile+    , CC.sinkFileCautious+    , CC.sinkTempFile+    , CC.sinkSystemTempFile+    , CC.sinkFileBS+    , CC.sinkHandle+    , CC.sinkIOHandle+    , printC+    , stdoutC+    , stderrC+    , CC.withSinkFile+    , CC.withSinkFileBuilder+    , CC.withSinkFileCautious+    , CC.sinkHandleBuilder+    , CC.sinkHandleFlush++      -- ** Transformers+      -- *** Pure+    , mapC+    , mapCE+    , omapCE+    , concatMapC+    , concatMapCE+    , takeC+    , takeCE+    , takeWhileC+    , takeWhileCE+    , takeExactlyC+    , takeExactlyCE+    , concatC+    , filterC+    , filterCE+    , mapWhileC+    , conduitVector+    , scanlC+    , mapAccumWhileC+    , concatMapAccumC+    , intersperseC+    , slidingWindowC+    , chunksOfCE+    , chunksOfExactlyCE++      -- *** Monadic+    , mapMC+    , mapMCE+    , omapMCE+    , concatMapMC+    , filterMC+    , filterMCE+    , iterMC+    , scanlMC+    , mapAccumWhileMC+    , concatMapAccumMC++      -- *** Textual+    , encodeUtf8C+    , decodeUtf8C+    , decodeUtf8LenientC+    , lineC+    , lineAsciiC+    , unlinesC+    , unlinesAsciiC+    , linesUnboundedC+    , linesUnboundedAsciiC++      -- ** Builders+    , CC.builderToByteString+    , CC.unsafeBuilderToByteString+    , CC.builderToByteStringWith+    , CC.builderToByteStringFlush+    , CC.builderToByteStringWithFlush+    , CC.BufferAllocStrategy+    , CC.allNewBuffersStrategy+    , CC.reuseBufferStrategy++      -- ** Special+    , vectorBuilderC+    , CC.mapAccumS+    , CC.peekForever+    , CC.peekForeverE+    ) where++-- BEGIN IMPORTS++import qualified Data.Conduit.Combinators as CC+-- BEGIN IMPORTS++import qualified Data.Traversable+import           Control.Applicative         (Alternative)+import           Control.Monad.IO.Class      (MonadIO (..))+import           Control.Monad.Primitive     (PrimMonad, PrimState)+import           Control.Monad.Trans.Resource (MonadThrow)+import           Data.Conduit+import           Data.Monoid                 (Monoid (..))+import           Data.MonoTraversable+import qualified Data.Sequences              as Seq+import qualified Data.Vector.Generic         as V+import           Prelude                     (Bool (..), Eq (..), Int,+                                              Maybe (..), Monad (..), Num (..),+                                              Ord (..), Functor (..), Either (..),+                                              Enum, Show, Char)+import Data.Word (Word8)+import Data.ByteString (ByteString)+import Data.Text (Text)++import qualified Data.Sequences as DTE+++-- END IMPORTS++-- | Generate a producer from a seed value.+--+-- @since 1.3.0+unfoldC :: Monad m+       => (b -> Maybe (a, b))+       -> b+       -> ConduitT i a m ()+unfoldC = CC.unfold+{-# INLINE unfoldC #-}++-- | Enumerate from a value to a final value, inclusive, via 'succ'.+--+-- This is generally more efficient than using @Prelude@\'s @enumFromTo@ and+-- combining with @sourceList@ since this avoids any intermediate data+-- structures.+--+-- @since 1.3.0+enumFromToC :: (Monad m, Enum a, Ord a) => a -> a -> ConduitT i a m ()+enumFromToC = CC.enumFromTo+{-# INLINE enumFromToC #-}++-- | Produces an infinite stream of repeated applications of f to x.+--+-- @since 1.3.0+iterateC :: Monad m => (a -> a) -> a -> ConduitT i a m ()+iterateC = CC.iterate+{-# INLINE iterateC #-}++-- | Produce an infinite stream consisting entirely of the given value.+--+-- @since 1.3.0+repeatC :: Monad m => a -> ConduitT i a m ()+repeatC = CC.repeat+{-# INLINE repeatC #-}++-- | Produce a finite stream consisting of n copies of the given value.+--+-- @since 1.3.0+replicateC :: Monad m+          => Int+          -> a+          -> ConduitT i a m ()+replicateC = CC.replicate+{-# INLINE replicateC #-}++-- | Repeatedly run the given action and yield all values it produces.+--+-- @since 1.3.0+repeatMC :: Monad m+        => m a+        -> ConduitT i a m ()+repeatMC = CC.repeatM+{-# INLINE repeatMC #-}++-- | Repeatedly run the given action and yield all values it produces, until+-- the provided predicate returns @False@.+--+-- @since 1.3.0+repeatWhileMC :: Monad m+             => m a+             -> (a -> Bool)+             -> ConduitT i a m ()+repeatWhileMC = CC.repeatWhileM+{-# INLINE repeatWhileMC #-}++-- | Perform the given action n times, yielding each result.+--+-- @since 1.3.0+replicateMC :: Monad m+           => Int+           -> m a+           -> ConduitT i a m ()+replicateMC = CC.replicateM+{-# INLINE replicateMC #-}++-- | @sourceHandle@ applied to @stdin@.+--+-- @since 1.3.0+stdinC :: MonadIO m => ConduitT i ByteString m ()+stdinC = CC.stdin+{-# INLINE stdinC #-}++-- | Ignore a certain number of values in the stream.+--+-- Note: since this function doesn't produce anything, you probably want to+-- use it with ('>>') instead of directly plugging it into a pipeline:+--+-- >>> runConduit $ yieldMany [1..5] .| dropC 2 .| sinkList+-- []+-- >>> runConduit $ yieldMany [1..5] .| (dropC 2 >> sinkList)+-- [3,4,5]+--+-- @since 1.3.0+dropC :: Monad m+     => Int+     -> ConduitT a o m ()+dropC = CC.drop+{-# INLINE dropC #-}++-- | Drop a certain number of elements from a chunked stream.+--+-- Note: you likely want to use it with monadic composition. See the docs+-- for 'dropC'.+--+-- @since 1.3.0+dropCE :: (Monad m, Seq.IsSequence seq)+      => Seq.Index seq+      -> ConduitT seq o m ()+dropCE = CC.dropE+{-# INLINE dropCE #-}++-- | Drop all values which match the given predicate.+--+-- Note: you likely want to use it with monadic composition. See the docs+-- for 'dropC'.+--+-- @since 1.3.0+dropWhileC :: Monad m+          => (a -> Bool)+          -> ConduitT a o m ()+dropWhileC = CC.dropWhile+{-# INLINE dropWhileC #-}++-- | Drop all elements in the chunked stream which match the given predicate.+--+-- Note: you likely want to use it with monadic composition. See the docs+-- for 'dropC'.+--+-- @since 1.3.0+dropWhileCE :: (Monad m, Seq.IsSequence seq)+           => (Element seq -> Bool)+           -> ConduitT seq o m ()+dropWhileCE = CC.dropWhileE+{-# INLINE dropWhileCE #-}++-- | Monoidally combine all values in the stream.+--+-- @since 1.3.0+foldC :: (Monad m, Monoid a)+     => ConduitT a o m a+foldC = CC.fold+{-# INLINE foldC #-}++-- | Monoidally combine all elements in the chunked stream.+--+-- @since 1.3.0+foldCE :: (Monad m, MonoFoldable mono, Monoid (Element mono))+      => ConduitT mono o m (Element mono)+foldCE = CC.foldE+{-# INLINE foldCE #-}++-- | A strict left fold.+--+-- @since 1.3.0+foldlC :: Monad m => (a -> b -> a) -> a -> ConduitT b o m a+foldlC = CC.foldl+{-# INLINE foldlC #-}++-- | A strict left fold on a chunked stream.+--+-- @since 1.3.0+foldlCE :: (Monad m, MonoFoldable mono)+       => (a -> Element mono -> a)+       -> a+       -> ConduitT mono o m a+foldlCE = CC.foldlE+{-# INLINE foldlCE #-}++-- | Apply the provided mapping function and monoidal combine all values.+--+-- @since 1.3.0+foldMapC :: (Monad m, Monoid b)+        => (a -> b)+        -> ConduitT a o m b+foldMapC = CC.foldMap+{-# INLINE foldMapC #-}++-- | Apply the provided mapping function and monoidal combine all elements of the chunked stream.+--+-- @since 1.3.0+foldMapCE :: (Monad m, MonoFoldable mono, Monoid w)+         => (Element mono -> w)+         -> ConduitT mono o m w+foldMapCE = CC.foldMapE+{-# INLINE foldMapCE #-}++-- | Check that all values in the stream return True.+--+-- Subject to shortcut logic: at the first False, consumption of the stream+-- will stop.+--+-- @since 1.3.0+allC :: Monad m+    => (a -> Bool)+    -> ConduitT a o m Bool+allC = CC.all+{-# INLINE allC #-}++-- | Check that all elements in the chunked stream return True.+--+-- Subject to shortcut logic: at the first False, consumption of the stream+-- will stop.+--+-- @since 1.3.0+allCE :: (Monad m, MonoFoldable mono)+     => (Element mono -> Bool)+     -> ConduitT mono o m Bool+allCE = CC.allE+{-# INLINE allCE #-}++-- | Check that at least one value in the stream returns True.+--+-- Subject to shortcut logic: at the first True, consumption of the stream+-- will stop.+--+-- @since 1.3.0+anyC :: Monad m+    => (a -> Bool)+    -> ConduitT a o m Bool+anyC = CC.any+{-# INLINE anyC #-}++-- | Check that at least one element in the chunked stream returns True.+--+-- Subject to shortcut logic: at the first True, consumption of the stream+-- will stop.+--+-- @since 1.3.0+anyCE :: (Monad m, MonoFoldable mono)+     => (Element mono -> Bool)+     -> ConduitT mono o m Bool+anyCE = CC.anyE+{-# INLINE anyCE #-}++-- | Are all values in the stream True?+--+-- Consumption stops once the first False is encountered.+--+-- @since 1.3.0+andC :: Monad m => ConduitT Bool o m Bool+andC = CC.and+{-# INLINE andC #-}++-- | Are all elements in the chunked stream True?+--+-- Consumption stops once the first False is encountered.+--+-- @since 1.3.0+andCE :: (Monad m, MonoFoldable mono, Element mono ~ Bool)+     => ConduitT mono o m Bool+andCE = CC.andE+{-# INLINE andCE #-}++-- | Are any values in the stream True?+--+-- Consumption stops once the first True is encountered.+--+-- @since 1.3.0+orC :: Monad m => ConduitT Bool o m Bool+orC = CC.or+{-# INLINE orC #-}++-- | Are any elements in the chunked stream True?+--+-- Consumption stops once the first True is encountered.+--+-- @since 1.3.0+orCE :: (Monad m, MonoFoldable mono, Element mono ~ Bool)+    => ConduitT mono o m Bool+orCE = CC.orE+{-# INLINE orCE #-}++-- | 'Alternative'ly combine all values in the stream.+--+-- @since 1.3.0+asumC :: (Monad m, Alternative f) => ConduitT (f a) o m (f a)+asumC = CC.asum++-- | Are any values in the stream equal to the given value?+--+-- Stops consuming as soon as a match is found.+--+-- @since 1.3.0+elemC :: (Monad m, Eq a) => a -> ConduitT a o m Bool+elemC = CC.elem+{-# INLINE elemC #-}++-- | Are any elements in the chunked stream equal to the given element?+--+-- Stops consuming as soon as a match is found.+--+-- @since 1.3.0+#if MIN_VERSION_mono_traversable(1,0,0)+elemCE :: (Monad m, Seq.IsSequence seq, Eq (Element seq))+#else+elemCE :: (Monad m, Seq.EqSequence seq)+#endif+      => Element seq+      -> ConduitT seq o m Bool+elemCE = CC.elemE+{-# INLINE elemCE #-}++-- | Are no values in the stream equal to the given value?+--+-- Stops consuming as soon as a match is found.+--+-- @since 1.3.0+notElemC :: (Monad m, Eq a) => a -> ConduitT a o m Bool+notElemC = CC.notElem+{-# INLINE notElemC #-}++-- | Are no elements in the chunked stream equal to the given element?+--+-- Stops consuming as soon as a match is found.+--+-- @since 1.3.0+#if MIN_VERSION_mono_traversable(1,0,0)+notElemCE :: (Monad m, Seq.IsSequence seq, Eq (Element seq))+#else+notElemCE :: (Monad m, Seq.EqSequence seq)+#endif+         => Element seq+         -> ConduitT seq o m Bool+notElemCE = CC.notElemE+{-# INLINE notElemCE #-}++-- | Take a single value from the stream, if available.+--+-- @since 1.3.0+headC :: Monad m => ConduitT a o m (Maybe a)+headC = CC.head++-- | Same as 'headC', but returns a default value if none are available from the stream.+--+-- @since 1.3.0+headDefC :: Monad m => a -> ConduitT a o m a+headDefC = CC.headDef++-- | Get the next element in the chunked stream.+--+-- @since 1.3.0+headCE :: (Monad m, Seq.IsSequence seq) => ConduitT seq o m (Maybe (Element seq))+headCE = CC.headE+{-# INLINE headCE #-}++-- | View the next value in the stream without consuming it.+--+-- @since 1.3.0+peekC :: Monad m => ConduitT a o m (Maybe a)+peekC = CC.peek+{-# INLINE peekC #-}++-- | View the next element in the chunked stream without consuming it.+--+-- @since 1.3.0+peekCE :: (Monad m, MonoFoldable mono) => ConduitT mono o m (Maybe (Element mono))+peekCE = CC.peekE+{-# INLINE peekCE #-}++-- | Retrieve the last value in the stream, if present.+--+-- @since 1.3.0+lastC :: Monad m => ConduitT a o m (Maybe a)+lastC = CC.last+{-# INLINE lastC #-}++-- | Same as 'lastC', but returns a default value if none are available from the stream.+--+-- @since 1.3.0+lastDefC :: Monad m => a -> ConduitT a o m a+lastDefC = CC.lastDef++-- | Retrieve the last element in the chunked stream, if present.+--+-- @since 1.3.0+lastCE :: (Monad m, Seq.IsSequence seq) => ConduitT seq o m (Maybe (Element seq))+lastCE = CC.lastE+{-# INLINE lastCE #-}++-- | Count how many values are in the stream.+--+-- @since 1.3.0+lengthC :: (Monad m, Num len) => ConduitT a o m len+lengthC = CC.length+{-# INLINE lengthC #-}++-- | Count how many elements are in the chunked stream.+--+-- @since 1.3.0+lengthCE :: (Monad m, Num len, MonoFoldable mono) => ConduitT mono o m len+lengthCE = CC.lengthE+{-# INLINE lengthCE #-}++-- | Count how many values in the stream pass the given predicate.+--+-- @since 1.3.0+lengthIfC :: (Monad m, Num len) => (a -> Bool) -> ConduitT a o m len+lengthIfC = CC.lengthIf+{-# INLINE lengthIfC #-}++-- | Count how many elements in the chunked stream pass the given predicate.+--+-- @since 1.3.0+lengthIfCE :: (Monad m, Num len, MonoFoldable mono)+          => (Element mono -> Bool) -> ConduitT mono o m len+lengthIfCE = CC.lengthIfE+{-# INLINE lengthIfCE #-}++-- | Get the largest value in the stream, if present.+--+-- @since 1.3.0+maximumC :: (Monad m, Ord a) => ConduitT a o m (Maybe a)+maximumC = CC.maximum+{-# INLINE maximumC #-}++-- | Get the largest element in the chunked stream, if present.+--+-- @since 1.3.0+#if MIN_VERSION_mono_traversable(1,0,0)+maximumCE :: (Monad m, Seq.IsSequence seq, Ord (Element seq)) => ConduitT seq o m (Maybe (Element seq))+#else+maximumCE :: (Monad m, Seq.OrdSequence seq) => ConduitT seq o m (Maybe (Element seq))+#endif+maximumCE = CC.maximumE+{-# INLINE maximumCE #-}++-- | Get the smallest value in the stream, if present.+--+-- @since 1.3.0+minimumC :: (Monad m, Ord a) => ConduitT a o m (Maybe a)+minimumC = CC.minimum+{-# INLINE minimumC #-}++-- | Get the smallest element in the chunked stream, if present.+--+-- @since 1.3.0+#if MIN_VERSION_mono_traversable(1,0,0)+minimumCE :: (Monad m, Seq.IsSequence seq, Ord (Element seq)) => ConduitT seq o m (Maybe (Element seq))+#else+minimumCE :: (Monad m, Seq.OrdSequence seq) => ConduitT seq o m (Maybe (Element seq))+#endif+minimumCE = CC.minimumE+{-# INLINE minimumCE #-}++-- | True if there are no values in the stream.+--+-- This function does not modify the stream.+--+-- @since 1.3.0+nullC :: Monad m => ConduitT a o m Bool+nullC = CC.null+{-# INLINE nullC #-}++-- | True if there are no elements in the chunked stream.+--+-- This function may remove empty leading chunks from the stream, but otherwise+-- will not modify it.+--+-- @since 1.3.0+nullCE :: (Monad m, MonoFoldable mono)+      => ConduitT mono o m Bool+nullCE = CC.nullE+{-# INLINE nullCE #-}++-- | Get the sum of all values in the stream.+--+-- @since 1.3.0+sumC :: (Monad m, Num a) => ConduitT a o m a+sumC = CC.sum+{-# INLINE sumC #-}++-- | Get the sum of all elements in the chunked stream.+--+-- @since 1.3.0+sumCE :: (Monad m, MonoFoldable mono, Num (Element mono)) => ConduitT mono o m (Element mono)+sumCE = CC.sumE+{-# INLINE sumCE #-}++-- | Get the product of all values in the stream.+--+-- @since 1.3.0+productC :: (Monad m, Num a) => ConduitT a o m a+productC = CC.product+{-# INLINE productC #-}++-- | Get the product of all elements in the chunked stream.+--+-- @since 1.3.0+productCE :: (Monad m, MonoFoldable mono, Num (Element mono)) => ConduitT mono o m (Element mono)+productCE = CC.productE+{-# INLINE productCE #-}++-- | Find the first matching value.+--+-- @since 1.3.0+findC :: Monad m => (a -> Bool) -> ConduitT a o m (Maybe a)+findC = CC.find+{-# INLINE findC #-}++-- | Apply the action to all values in the stream.+--+-- Note: if you want to /pass/ the values instead of /consuming/ them, use+-- 'iterM' instead.+--+-- @since 1.3.0+mapM_C :: Monad m => (a -> m ()) -> ConduitT a o m ()+mapM_C = CC.mapM_+{-# INLINE mapM_C #-}++-- | Apply the action to all elements in the chunked stream.+--+-- Note: the same caveat as with 'mapM_C' applies. If you don't want to+-- consume the values, you can use 'iterM':+--+-- > iterM (omapM_ f)+--+-- @since 1.3.0+mapM_CE :: (Monad m, MonoFoldable mono) => (Element mono -> m ()) -> ConduitT mono o m ()+mapM_CE = CC.mapM_E+{-# INLINE mapM_CE #-}++-- | A monadic strict left fold.+--+-- @since 1.3.0+foldMC :: Monad m => (a -> b -> m a) -> a -> ConduitT b o m a+foldMC = CC.foldM+{-# INLINE foldMC #-}++-- | A monadic strict left fold on a chunked stream.+--+-- @since 1.3.0+foldMCE :: (Monad m, MonoFoldable mono)+       => (a -> Element mono -> m a)+       -> a+       -> ConduitT mono o m a+foldMCE = CC.foldME+{-# INLINE foldMCE #-}++-- | Apply the provided monadic mapping function and monoidal combine all values.+--+-- @since 1.3.0+foldMapMC :: (Monad m, Monoid w) => (a -> m w) -> ConduitT a o m w+foldMapMC = CC.foldMapM+{-# INLINE foldMapMC #-}++-- | Apply the provided monadic mapping function and monoidal combine all+-- elements in the chunked stream.+--+-- @since 1.3.0+foldMapMCE :: (Monad m, MonoFoldable mono, Monoid w)+          => (Element mono -> m w)+          -> ConduitT mono o m w+foldMapMCE = CC.foldMapME+{-# INLINE foldMapMCE #-}++-- | Print all incoming values to stdout.+--+-- @since 1.3.0+printC :: (Show a, MonadIO m) => ConduitT a o m ()+printC = CC.print+{-# INLINE printC #-}++-- | @sinkHandle@ applied to @stdout@.+--+-- @since 1.3.0+stdoutC :: MonadIO m => ConduitT ByteString o m ()+stdoutC = CC.stdout+{-# INLINE stdoutC #-}++-- | @sinkHandle@ applied to @stderr@.+--+-- @since 1.3.0+stderrC :: MonadIO m => ConduitT ByteString o m ()+stderrC = CC.stderr+{-# INLINE stderrC #-}++-- | Apply a transformation to all values in a stream.+--+-- @since 1.3.0+mapC :: Monad m => (a -> b) -> ConduitT a b m ()+mapC = CC.map+{-# INLINE mapC #-}++-- | Apply a transformation to all elements in a chunked stream.+--+-- @since 1.3.0+mapCE :: (Monad m, Functor f) => (a -> b) -> ConduitT (f a) (f b) m ()+mapCE = CC.mapE+{-# INLINE mapCE #-}++-- | Apply a monomorphic transformation to all elements in a chunked stream.+--+-- Unlike @mapE@, this will work on types like @ByteString@ and @Text@ which+-- are @MonoFunctor@ but not @Functor@.+--+-- @since 1.3.0+omapCE :: (Monad m, MonoFunctor mono) => (Element mono -> Element mono) -> ConduitT mono mono m ()+omapCE = CC.omapE+{-# INLINE omapCE #-}++-- | Apply the function to each value in the stream, resulting in a foldable+-- value (e.g., a list). Then yield each of the individual values in that+-- foldable value separately.+--+-- Generalizes concatMap, mapMaybe, and mapFoldable.+--+-- @since 1.3.0+concatMapC :: (Monad m, MonoFoldable mono)+          => (a -> mono)+          -> ConduitT a (Element mono) m ()+concatMapC = CC.concatMap+{-# INLINE concatMapC #-}++-- | Apply the function to each element in the chunked stream, resulting in a+-- foldable value (e.g., a list). Then yield each of the individual values in+-- that foldable value separately.+--+-- Generalizes concatMap, mapMaybe, and mapFoldable.+--+-- @since 1.3.0+concatMapCE :: (Monad m, MonoFoldable mono, Monoid w)+           => (Element mono -> w)+           -> ConduitT mono w m ()+concatMapCE = CC.concatMapE+{-# INLINE concatMapCE #-}++-- | Stream up to n number of values downstream.+--+-- Note that, if downstream terminates early, not all values will be consumed.+-- If you want to force /exactly/ the given number of values to be consumed,+-- see 'takeExactly'.+--+-- @since 1.3.0+takeC :: Monad m => Int -> ConduitT a a m ()+takeC = CC.take+{-# INLINE takeC #-}++-- | Stream up to n number of elements downstream in a chunked stream.+--+-- Note that, if downstream terminates early, not all values will be consumed.+-- If you want to force /exactly/ the given number of values to be consumed,+-- see 'takeExactlyE'.+--+-- @since 1.3.0+takeCE :: (Monad m, Seq.IsSequence seq)+      => Seq.Index seq+      -> ConduitT seq seq m ()+takeCE = CC.takeE+{-# INLINE takeCE #-}++-- | Stream all values downstream that match the given predicate.+--+-- Same caveats regarding downstream termination apply as with 'take'.+--+-- @since 1.3.0+takeWhileC :: Monad m+          => (a -> Bool)+          -> ConduitT a a m ()+takeWhileC = CC.takeWhile+{-# INLINE takeWhileC #-}++-- | Stream all elements downstream that match the given predicate in a chunked stream.+--+-- Same caveats regarding downstream termination apply as with 'takeE'.+--+-- @since 1.3.0+takeWhileCE :: (Monad m, Seq.IsSequence seq)+           => (Element seq -> Bool)+           -> ConduitT seq seq m ()+takeWhileCE = CC.takeWhileE+{-# INLINE takeWhileCE #-}++-- | Consume precisely the given number of values and feed them downstream.+--+-- This function is in contrast to 'take', which will only consume up to the+-- given number of values, and will terminate early if downstream terminates+-- early. This function will discard any additional values in the stream if+-- they are unconsumed.+--+-- Note that this function takes a downstream @ConduitT@ as a parameter, as+-- opposed to working with normal fusion. For more information, see+-- <http://www.yesodweb.com/blog/2013/10/core-flaw-pipes-conduit>, the section+-- titled \"pipes and conduit: isolate\".+--+-- @since 1.3.0+takeExactlyC :: Monad m+            => Int+            -> ConduitT a b m r+            -> ConduitT a b m r+takeExactlyC = CC.takeExactly+{-# INLINE takeExactlyC #-}++-- | Same as 'takeExactly', but for chunked streams.+--+-- @since 1.3.0+takeExactlyCE :: (Monad m, Seq.IsSequence a)+             => Seq.Index a+             -> ConduitT a b m r+             -> ConduitT a b m r+takeExactlyCE = CC.takeExactlyE+{-# INLINE takeExactlyCE #-}++-- | Flatten out a stream by yielding the values contained in an incoming+-- @MonoFoldable@ as individually yielded values.+--+-- @since 1.3.0+concatC :: (Monad m, MonoFoldable mono)+       => ConduitT mono (Element mono) m ()+concatC = CC.concat+{-# INLINE concatC #-}++-- | Keep only values in the stream passing a given predicate.+--+-- @since 1.3.0+filterC :: Monad m => (a -> Bool) -> ConduitT a a m ()+filterC = CC.filter+{-# INLINE filterC #-}++-- | Keep only elements in the chunked stream passing a given predicate.+--+-- @since 1.3.0+filterCE :: (Seq.IsSequence seq, Monad m) => (Element seq -> Bool) -> ConduitT seq seq m ()+filterCE = CC.filterE+{-# INLINE filterCE #-}++-- | Map values as long as the result is @Just@.+--+-- @since 1.3.0+mapWhileC :: Monad m => (a -> Maybe b) -> ConduitT a b m ()+mapWhileC = CC.mapWhile+{-# INLINE mapWhileC #-}++-- | Break up a stream of values into vectors of size n. The final vector may+-- be smaller than n if the total number of values is not a strict multiple of+-- n. No empty vectors will be yielded.+--+-- @since 1.3.0+conduitVector :: (V.Vector v a, PrimMonad m)+              => Int -- ^ maximum allowed size+              -> ConduitT a (v a) m ()+conduitVector = CC.conduitVector+{-# INLINE conduitVector #-}++-- | Analog of 'Prelude.scanl' for lists.+--+-- @since 1.3.0+scanlC :: Monad m => (a -> b -> a) -> a -> ConduitT b a m ()+scanlC = CC.scanl+{-# INLINE scanlC #-}++-- | 'mapWhileC' with a break condition dependent on a strict accumulator.+-- Equivalently, 'CL.mapAccum' as long as the result is @Right@. Instead of+-- producing a leftover, the breaking input determines the resulting+-- accumulator via @Left@.+mapAccumWhileC :: Monad m =>+    (a -> s -> Either s (s, b)) -> s -> ConduitT a b m s+mapAccumWhileC = CC.mapAccumWhile+{-# INLINE mapAccumWhileC #-}++-- | 'concatMap' with an accumulator.+--+-- @since 1.3.0+concatMapAccumC :: Monad m => (a -> accum -> (accum, [b])) -> accum -> ConduitT a b m ()+concatMapAccumC = CC.concatMapAccum+{-# INLINE concatMapAccumC #-}++-- | Insert the given value between each two values in the stream.+--+-- @since 1.3.0+intersperseC :: Monad m => a -> ConduitT a a m ()+intersperseC = CC.intersperse+{-# INLINE intersperseC #-}++-- | Sliding window of values+-- 1,2,3,4,5 with window size 2 gives+-- [1,2],[2,3],[3,4],[4,5]+--+-- Best used with structures that support O(1) snoc.+--+-- @since 1.3.0+slidingWindowC :: (Monad m, Seq.IsSequence seq, Element seq ~ a) => Int -> ConduitT a seq m ()+slidingWindowC = CC.slidingWindow+{-# INLINE slidingWindowC #-}+++-- | Split input into chunk of size 'chunkSize'+--+-- The last element may be smaller than the 'chunkSize' (see also+-- 'chunksOfExactlyE' which will not yield this last element)+--+-- @since 1.3.0+chunksOfCE :: (Monad m, Seq.IsSequence seq) => Seq.Index seq -> ConduitT seq seq m ()+chunksOfCE = CC.chunksOfE+{-# INLINE chunksOfCE #-}++-- | Split input into chunk of size 'chunkSize'+--+-- If the input does not split into chunks exactly, the remainder will be+-- leftover (see also 'chunksOfE')+--+-- @since 1.3.0+chunksOfExactlyCE :: (Monad m, Seq.IsSequence seq) => Seq.Index seq -> ConduitT seq seq m ()+chunksOfExactlyCE = CC.chunksOfExactlyE+{-# INLINE chunksOfExactlyCE #-}++-- | Apply a monadic transformation to all values in a stream.+--+-- If you do not need the transformed values, and instead just want the monadic+-- side-effects of running the action, see 'mapM_'.+--+-- @since 1.3.0+mapMC :: Monad m => (a -> m b) -> ConduitT a b m ()+mapMC = CC.mapM+{-# INLINE mapMC #-}++-- | Apply a monadic transformation to all elements in a chunked stream.+--+-- @since 1.3.0+mapMCE :: (Monad m, Data.Traversable.Traversable f) => (a -> m b) -> ConduitT (f a) (f b) m ()+mapMCE = CC.mapME+{-# INLINE mapMCE #-}++-- | Apply a monadic monomorphic transformation to all elements in a chunked stream.+--+-- Unlike @mapME@, this will work on types like @ByteString@ and @Text@ which+-- are @MonoFunctor@ but not @Functor@.+--+-- @since 1.3.0+omapMCE :: (Monad m, MonoTraversable mono)+       => (Element mono -> m (Element mono))+       -> ConduitT mono mono m ()+omapMCE = CC.omapME+{-# INLINE omapMCE #-}++-- | Apply the monadic function to each value in the stream, resulting in a+-- foldable value (e.g., a list). Then yield each of the individual values in+-- that foldable value separately.+--+-- Generalizes concatMapM, mapMaybeM, and mapFoldableM.+--+-- @since 1.3.0+concatMapMC :: (Monad m, MonoFoldable mono)+           => (a -> m mono)+           -> ConduitT a (Element mono) m ()+concatMapMC = CC.concatMapM+{-# INLINE concatMapMC #-}++-- | Keep only values in the stream passing a given monadic predicate.+--+-- @since 1.3.0+filterMC :: Monad m+        => (a -> m Bool)+        -> ConduitT a a m ()+filterMC = CC.filterM+{-# INLINE filterMC #-}++-- | Keep only elements in the chunked stream passing a given monadic predicate.+--+-- @since 1.3.0+filterMCE :: (Monad m, Seq.IsSequence seq) => (Element seq -> m Bool) -> ConduitT seq seq m ()+filterMCE = CC.filterME+{-# INLINE filterMCE #-}++-- | Apply a monadic action on all values in a stream.+--+-- This @Conduit@ can be used to perform a monadic side-effect for every+-- value, whilst passing the value through the @Conduit@ as-is.+--+-- > iterM f = mapM (\a -> f a >>= \() -> return a)+--+-- @since 1.3.0+iterMC :: Monad m => (a -> m ()) -> ConduitT a a m ()+iterMC = CC.iterM+{-# INLINE iterMC #-}++-- | Analog of 'Prelude.scanl' for lists, monadic.+--+-- @since 1.3.0+scanlMC :: Monad m => (a -> b -> m a) -> a -> ConduitT b a m ()+scanlMC = CC.scanlM+{-# INLINE scanlMC #-}++-- | Monadic `mapAccumWhileC`.+mapAccumWhileMC :: Monad m => (a -> s -> m (Either s (s, b))) -> s -> ConduitT a b m s+mapAccumWhileMC = CC.mapAccumWhileM+{-# INLINE mapAccumWhileMC #-}++-- | 'concatMapM' with an accumulator.+--+-- @since 1.3.0+concatMapAccumMC :: Monad m => (a -> accum -> m (accum, [b])) -> accum -> ConduitT a b m ()+concatMapAccumMC = CC.concatMapAccumM+{-# INLINE concatMapAccumMC #-}++-- | Encode a stream of text as UTF8.+--+-- @since 1.3.0+encodeUtf8C :: (Monad m, DTE.Utf8 text binary) => ConduitT text binary m ()+encodeUtf8C = CC.encodeUtf8+{-# INLINE encodeUtf8C #-}++-- | Decode a stream of binary data as UTF8.+--+-- @since 1.3.0+decodeUtf8C :: MonadThrow m => ConduitT ByteString Text m ()+decodeUtf8C = CC.decodeUtf8+{-# INLINE decodeUtf8C #-}++-- | Decode a stream of binary data as UTF8, replacing any invalid bytes with+-- the Unicode replacement character.+--+-- @since 1.3.0+decodeUtf8LenientC :: Monad m => ConduitT ByteString Text m ()+decodeUtf8LenientC = CC.decodeUtf8Lenient+{-# INLINE decodeUtf8LenientC #-}++-- | Stream in the entirety of a single line.+--+-- Like @takeExactly@, this will consume the entirety of the line regardless of+-- the behavior of the inner Conduit.+--+-- @since 1.3.0+lineC :: (Monad m, Seq.IsSequence seq, Element seq ~ Char)+     => ConduitT seq o m r+     -> ConduitT seq o m r+lineC = CC.line+{-# INLINE lineC #-}++-- | Same as 'line', but operates on ASCII/binary data.+--+-- @since 1.3.0+lineAsciiC :: (Monad m, Seq.IsSequence seq, Element seq ~ Word8)+          => ConduitT seq o m r+          -> ConduitT seq o m r+lineAsciiC = CC.lineAscii+{-# INLINE lineAsciiC #-}++-- | Insert a newline character after each incoming chunk of data.+--+-- @since 1.3.0+unlinesC :: (Monad m, Seq.IsSequence seq, Element seq ~ Char) => ConduitT seq seq m ()+unlinesC = CC.unlines+{-# INLINE unlinesC #-}++-- | Same as 'unlines', but operates on ASCII/binary data.+--+-- @since 1.3.0+unlinesAsciiC :: (Monad m, Seq.IsSequence seq, Element seq ~ Word8) => ConduitT seq seq m ()+unlinesAsciiC = CC.unlinesAscii+{-# INLINE unlinesAsciiC #-}++-- | Convert a stream of arbitrarily-chunked textual data into a stream of data+-- where each chunk represents a single line. Note that, if you have+-- unknown/untrusted input, this function is /unsafe/, since it would allow an+-- attacker to form lines of massive length and exhaust memory.+--+-- @since 1.3.0+linesUnboundedC :: (Monad m, Seq.IsSequence seq, Element seq ~ Char)+               => ConduitT seq seq m ()+linesUnboundedC = CC.linesUnbounded+{-# INLINE linesUnboundedC #-}++-- | Same as 'linesUnbounded', but for ASCII/binary data.+--+-- @since 1.3.0+linesUnboundedAsciiC :: (Monad m, Seq.IsSequence seq, Element seq ~ Word8)+                    => ConduitT seq seq m ()+linesUnboundedAsciiC = CC.linesUnboundedAscii+{-# INLINE linesUnboundedAsciiC #-}++-- | Generally speaking, yielding values from inside a Conduit requires+-- some allocation for constructors. This can introduce an overhead,+-- similar to the overhead needed to represent a list of values instead of+-- a vector. This overhead is even more severe when talking about unboxed+-- values.+--+-- This combinator allows you to overcome this overhead, and efficiently+-- fill up vectors. It takes two parameters. The first is the size of each+-- mutable vector to be allocated. The second is a function. The function+-- takes an argument which will yield the next value into a mutable+-- vector.+--+-- Under the surface, this function uses a number of tricks to get high+-- performance. For more information on both usage and implementation,+-- please see:+-- <https://www.fpcomplete.com/user/snoyberg/library-documentation/vectorbuilder>+--+-- @since 1.3.0+vectorBuilderC :: (PrimMonad m, V.Vector v e, PrimMonad n, PrimState m ~ PrimState n)+              => Int -- ^ size+              -> ((e -> n ()) -> ConduitT i Void m r)+              -> ConduitT i (v e) m r+vectorBuilderC = CC.vectorBuilder+{-# INLINE vectorBuilderC #-}
+ src/Data/Conduit/Internal.hs view
@@ -0,0 +1,20 @@+{-# LANGUAGE Safe #-}+{-# OPTIONS_HADDOCK not-home #-}+module Data.Conduit.Internal+    ( -- * Pipe+      module Data.Conduit.Internal.Pipe+      -- * Conduit+    , module Data.Conduit.Internal.Conduit+      -- * Fusion (highly experimental!!!)+    , module Data.Conduit.Internal.Fusion+    ) where++import           Data.Conduit.Internal.Conduit hiding (await,+                                                awaitForever, bracketP,+                                                leftover, mapInput, mapInputM,+                                                mapOutput, mapOutputMaybe,+                                                transPipe,+                                                yield, yieldM,+                                                unconsM, unconsEitherM)+import           Data.Conduit.Internal.Pipe+import           Data.Conduit.Internal.Fusion
+ src/Data/Conduit/Internal/Conduit.hs view
@@ -0,0 +1,1333 @@+{-# OPTIONS_HADDOCK not-home #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE TypeFamilies #-}+module Data.Conduit.Internal.Conduit+    ( -- ** Types+      ConduitT (..)+    , ConduitM+    , Source+    , Producer+    , Sink+    , Consumer+    , Conduit+    , Flush (..)+      -- *** Newtype wrappers+    , ZipSource (..)+    , ZipSink (..)+    , ZipConduit (..)+      -- ** Sealed+    , SealedConduitT (..)+    , sealConduitT+    , unsealConduitT+      -- ** Primitives+    , await+    , awaitForever+    , yield+    , yieldM+    , leftover+    , runConduit+    , runConduitPure+    , runConduitRes+    , fuse+    , connect+    , unconsM+    , unconsEitherM+      -- ** Composition+    , connectResume+    , connectResumeConduit+    , fuseLeftovers+    , fuseReturnLeftovers+    , ($$+)+    , ($$++)+    , ($$+-)+    , ($=+)+    , (=$$+)+    , (=$$++)+    , (=$$+-)+    , ($$)+    , ($=)+    , (=$)+    , (=$=)+    , (.|)+      -- ** Generalizing+    , sourceToPipe+    , sinkToPipe+    , conduitToPipe+    , toProducer+    , toConsumer+      -- ** Cleanup+    , bracketP+      -- ** Exceptions+    , catchC+    , handleC+    , tryC+      -- ** Utilities+    , Data.Conduit.Internal.Conduit.transPipe+    , Data.Conduit.Internal.Conduit.mapOutput+    , Data.Conduit.Internal.Conduit.mapOutputMaybe+    , Data.Conduit.Internal.Conduit.mapInput+    , Data.Conduit.Internal.Conduit.mapInputM+    , zipSinks+    , zipSources+    , zipSourcesApp+    , zipConduitApp+    , mergeSource+    , passthroughSink+    , sourceToList+    , fuseBoth+    , fuseBothMaybe+    , fuseUpstream+    , sequenceSources+    , sequenceSinks+    , sequenceConduits+    ) where++import Control.Applicative (Applicative (..))+import Control.Exception (Exception)+import qualified Control.Exception as E (catch)+import Control.Monad (liftM, liftM2, ap)+import Control.Monad.Fail(MonadFail(..))+import Control.Monad.Error.Class(MonadError(..))+import Control.Monad.Reader.Class(MonadReader(..))+import Control.Monad.RWS.Class(MonadRWS())+import Control.Monad.Writer.Class(MonadWriter(..), censor)+import Control.Monad.State.Class(MonadState(..))+import Control.Monad.Trans.Class (MonadTrans (lift))+import Control.Monad.IO.Unlift (MonadIO (liftIO), MonadUnliftIO, withRunInIO)+import Control.Monad.Primitive (PrimMonad, PrimState, primitive)+import Data.Functor.Identity (Identity, runIdentity)+import Data.Void (Void, absurd)+import Data.Monoid (Monoid (mappend, mempty))+import Data.Semigroup (Semigroup ((<>)))+import Control.Monad.Trans.Resource+import Data.Conduit.Internal.Pipe hiding (yield, mapOutput, leftover, yieldM, await, awaitForever, bracketP, unconsM, unconsEitherM)+import qualified Data.Conduit.Internal.Pipe as CI+import Control.Monad (forever)+import Data.Traversable (Traversable (..))++-- | Core datatype of the conduit package. This type represents a general+-- component which can consume a stream of input values @i@, produce a stream+-- of output values @o@, perform actions in the @m@ monad, and produce a final+-- result @r@. The type synonyms provided here are simply wrappers around this+-- type.+--+-- Since 1.3.0+newtype ConduitT i o m r = ConduitT+    { unConduitT :: forall b.+                    (r -> Pipe i i o () m b) -> Pipe i i o () m b+    }++-- | In order to provide for efficient monadic composition, the+-- @ConduitT@ type is implemented internally using a technique known+-- as the codensity transform. This allows for cheap appending, but+-- makes one case much more expensive: partially running a @ConduitT@+-- and that capturing the new state.+--+-- This data type is the same as @ConduitT@, but does not use the+-- codensity transform technique.+--+-- @since 1.3.0+newtype SealedConduitT i o m r = SealedConduitT (Pipe i i o () m r)++-- | Same as 'ConduitT', for backwards compat+type ConduitM = ConduitT++instance Functor (ConduitT i o m) where+    fmap f (ConduitT c) = ConduitT $ \rest -> c (rest . f)++instance Applicative (ConduitT i o m) where+    pure x = ConduitT ($ x)+    {-# INLINE pure #-}+    (<*>) = ap+    {-# INLINE (<*>) #-}+    x *> y = x >>= \_ -> y+    {-# INLINE (*>) #-}++instance Monad (ConduitT i o m) where+    return = pure+    ConduitT f >>= g = ConduitT $ \h -> f $ \a -> unConduitT (g a) h++-- | @since 1.3.1+instance MonadFail m => MonadFail (ConduitT i o m) where+    fail = lift . Control.Monad.Fail.fail++instance MonadThrow m => MonadThrow (ConduitT i o m) where+    throwM = lift . throwM++instance MonadIO m => MonadIO (ConduitT i o m) where+    liftIO = lift . liftIO+    {-# INLINE liftIO #-}++instance MonadReader r m => MonadReader r (ConduitT i o m) where+    ask = lift ask+    {-# INLINE ask #-}++    local f (ConduitT c0) = ConduitT $ \rest ->+        let go (HaveOutput p o) = HaveOutput (go p) o+            go (NeedInput p c) = NeedInput (\i -> go (p i)) (\u -> go (c u))+            go (Done x) = rest x+            go (PipeM mp) = PipeM (liftM go $ local f mp)+            go (Leftover p i) = Leftover (go p) i+         in go (c0 Done)++#ifndef MIN_VERSION_mtl+#define MIN_VERSION_mtl(x, y, z) 0+#endif++instance MonadWriter w m => MonadWriter w (ConduitT i o m) where+#if MIN_VERSION_mtl(2, 1, 0)+    writer = lift . writer+#endif+    tell = lift . tell++    listen (ConduitT c0) = ConduitT $ \rest ->+        let go front (HaveOutput p o) = HaveOutput (go front p) o+            go front (NeedInput p c) = NeedInput (\i -> go front (p i)) (\u -> go front (c u))+            go front (Done x) = rest (x, front)+            go front (PipeM mp) = PipeM $ do+                (p,w) <- listen mp+                return $ go (front `mappend` w) p+            go front (Leftover p i) = Leftover (go front p) i+         in go mempty (c0 Done)++    pass (ConduitT c0) = ConduitT $ \rest ->+        let go front (HaveOutput p o) = HaveOutput (go front p) o+            go front (NeedInput p c) = NeedInput (\i -> go front (p i)) (\u -> go front (c u))+            go front (PipeM mp) = PipeM $ do+                (p,w) <- censor (const mempty) (listen mp)+                return $ go (front `mappend` w) p+            go front (Done (x,f)) = PipeM $ do+                tell (f front)+                return $ rest x+            go front (Leftover p i) = Leftover (go front p) i+         in go mempty (c0 Done)++instance MonadState s m => MonadState s (ConduitT i o m) where+    get = lift get+    put = lift . put+#if MIN_VERSION_mtl(2, 1, 0)+    state = lift . state+#endif++instance MonadRWS r w s m => MonadRWS r w s (ConduitT i o m)++instance MonadError e m => MonadError e (ConduitT i o m) where+    throwError = lift . throwError+    catchError (ConduitT c0) f = ConduitT $ \rest ->+        let go (HaveOutput p o) = HaveOutput (go p) o+            go (NeedInput p c) = NeedInput (\i -> go (p i)) (\u -> go (c u))+            go (Done x) = rest x+            go (PipeM mp) =+              PipeM $ catchError (liftM go mp) $ \e -> do+                return $ unConduitT (f e) rest+            go (Leftover p i) = Leftover (go p) i+         in go (c0 Done)++instance MonadTrans (ConduitT i o) where+    lift mr = ConduitT $ \rest -> PipeM (liftM rest mr)+    {-# INLINE [1] lift #-}++instance MonadResource m => MonadResource (ConduitT i o m) where+    liftResourceT = lift . liftResourceT+    {-# INLINE liftResourceT #-}++instance Monad m => Semigroup (ConduitT i o m ()) where+    (<>) = (>>)+    {-# INLINE (<>) #-}++instance Monad m => Monoid (ConduitT i o m ()) where+    mempty = return ()+    {-# INLINE mempty #-}+#if !(MIN_VERSION_base(4,11,0))+    mappend = (<>)+    {-# INLINE mappend #-}+#endif++instance PrimMonad m => PrimMonad (ConduitT i o m) where+  type PrimState (ConduitT i o m) = PrimState m+  primitive = lift . primitive++-- | Provides a stream of output values, without consuming any input or+-- producing a final result.+--+-- Since 0.5.0+type Source m o = ConduitT () o m ()+{-# DEPRECATED Source "Use ConduitT directly" #-}++-- | A component which produces a stream of output values, regardless of the+-- input stream. A @Producer@ is a generalization of a @Source@, and can be+-- used as either a @Source@ or a @Conduit@.+--+-- Since 1.0.0+type Producer m o = forall i. ConduitT i o m ()+{-# DEPRECATED Producer "Use ConduitT directly" #-}++-- | Consumes a stream of input values and produces a final result, without+-- producing any output.+--+-- > type Sink i m r = ConduitT i Void m r+--+-- Since 0.5.0+type Sink i = ConduitT i Void+{-# DEPRECATED Sink "Use ConduitT directly" #-}++-- | A component which consumes a stream of input values and produces a final+-- result, regardless of the output stream. A @Consumer@ is a generalization of+-- a @Sink@, and can be used as either a @Sink@ or a @Conduit@.+--+-- Since 1.0.0+type Consumer i m r = forall o. ConduitT i o m r+{-# DEPRECATED Consumer "Use ConduitT directly" #-}++-- | Consumes a stream of input values and produces a stream of output values,+-- without producing a final result.+--+-- Since 0.5.0+type Conduit i m o = ConduitT i o m ()+{-# DEPRECATED Conduit "Use ConduitT directly" #-}++sealConduitT :: ConduitT i o m r -> SealedConduitT i o m r+sealConduitT (ConduitT f) = SealedConduitT (f Done)++unsealConduitT :: Monad m => SealedConduitT i o m r -> ConduitT i o m r+unsealConduitT (SealedConduitT f) = ConduitT (f >>=)++-- | Connect a @Source@ to a @Sink@ until the latter closes. Returns both the+-- most recent state of the @Source@ and the result of the @Sink@.+--+-- Since 0.5.0+connectResume :: Monad m+              => SealedConduitT () a m ()+              -> ConduitT a Void m r+              -> m (SealedConduitT () a m (), r)+connectResume (SealedConduitT left0) (ConduitT right0) =+    goRight left0 (right0 Done)+  where+    goRight left right =+        case right of+            HaveOutput _ o   -> absurd o+            NeedInput rp rc  -> goLeft rp rc left+            Done r2          -> return (SealedConduitT left, r2)+            PipeM mp         -> mp >>= goRight left+            Leftover p i     -> goRight (HaveOutput left i) p++    goLeft rp rc left =+        case left of+            HaveOutput left' o            -> goRight left' (rp o)+            NeedInput _ lc                -> recurse (lc ())+            Done ()                       -> goRight (Done ()) (rc ())+            PipeM mp                      -> mp >>= recurse+            Leftover p ()                 -> recurse p+      where+        recurse = goLeft rp rc++sourceToPipe :: Monad m => ConduitT () o m () -> Pipe l i o u m ()+sourceToPipe (ConduitT k) =+    go $ k Done+  where+    go (HaveOutput p o) = HaveOutput (go p) o+    go (NeedInput _ c) = go $ c ()+    go (Done ()) = Done ()+    go (PipeM mp) = PipeM (liftM go mp)+    go (Leftover p ()) = go p++sinkToPipe :: Monad m => ConduitT i Void m r -> Pipe l i o u m r+sinkToPipe (ConduitT k) =+    go $ injectLeftovers $ k Done+  where+    go (HaveOutput _ o) = absurd o+    go (NeedInput p c) = NeedInput (go . p) (const $ go $ c ())+    go (Done r) = Done r+    go (PipeM mp) = PipeM (liftM go mp)+    go (Leftover _ l) = absurd l++conduitToPipe :: Monad m => ConduitT i o m () -> Pipe l i o u m ()+conduitToPipe (ConduitT k) =+    go $ injectLeftovers $ k Done+  where+    go (HaveOutput p o) = HaveOutput (go p) o+    go (NeedInput p c) = NeedInput (go . p) (const $ go $ c ())+    go (Done ()) = Done ()+    go (PipeM mp) = PipeM (liftM go mp)+    go (Leftover _ l) = absurd l++-- | Generalize a 'Source' to a 'Producer'.+--+-- Since 1.0.0+toProducer :: Monad m => ConduitT () a m () -> ConduitT i a m ()+toProducer (ConduitT c0) = ConduitT $ \rest -> let+    go (HaveOutput p o) = HaveOutput (go p) o+    go (NeedInput _ c) = go (c ())+    go (Done r) = rest r+    go (PipeM mp) = PipeM (liftM go mp)+    go (Leftover p ()) = go p+    in go (c0 Done)++-- | Generalize a 'Sink' to a 'Consumer'.+--+-- Since 1.0.0+toConsumer :: Monad m => ConduitT a Void m b -> ConduitT a o m b+toConsumer (ConduitT c0) = ConduitT $ \rest -> let+    go (HaveOutput _ o) = absurd o+    go (NeedInput p c) = NeedInput (go . p) (go . c)+    go (Done r) = rest r+    go (PipeM mp) = PipeM (liftM go mp)+    go (Leftover p l) = Leftover (go p) l+    in go (c0 Done)++-- | Catch all exceptions thrown by the current component of the pipeline.+--+-- Note: this will /not/ catch exceptions thrown by other components! For+-- example, if an exception is thrown in a @Source@ feeding to a @Sink@, and+-- the @Sink@ uses @catchC@, the exception will /not/ be caught.+--+-- Due to this behavior (as well as lack of async exception safety), you+-- should not try to implement combinators such as @onException@ in terms of this+-- primitive function.+--+-- Note also that the exception handling will /not/ be applied to any+-- finalizers generated by this conduit.+--+-- Since 1.0.11+catchC :: (MonadUnliftIO m, Exception e)+       => ConduitT i o m r+       -> (e -> ConduitT i o m r)+       -> ConduitT i o m r+catchC (ConduitT p0) onErr = ConduitT $ \rest -> let+    go (Done r) = rest r+    go (PipeM mp) = PipeM $ withRunInIO $ \ run ->+      run (liftM go mp) `E.catch` \ e ->+        return $ onErr e `unConduitT` rest+    go (Leftover p i) = Leftover (go p) i+    go (NeedInput x y) = NeedInput (go . x) (go . y)+    go (HaveOutput p o) = HaveOutput (go p) o+    in go (p0 Done)+{-# INLINE catchC #-}++-- | The same as @flip catchC@.+--+-- Since 1.0.11+handleC :: (MonadUnliftIO m, Exception e)+        => (e -> ConduitT i o m r)+        -> ConduitT i o m r+        -> ConduitT i o m r+handleC = flip catchC+{-# INLINE handleC #-}++-- | A version of @try@ for use within a pipeline. See the comments in @catchC@+-- for more details.+--+-- Since 1.0.11+tryC :: (MonadUnliftIO m, Exception e)+     => ConduitT i o m r+     -> ConduitT i o m (Either e r)+tryC c = fmap Right c `catchC` (return . Left)+{-# INLINE tryC #-}++-- | Combines two sinks. The new sink will complete when both input sinks have+--   completed.+--+-- Any leftovers are discarded.+--+-- Since 0.4.1+zipSinks :: Monad m => ConduitT i Void m r -> ConduitT i Void m r' -> ConduitT i Void m (r, r')+zipSinks (ConduitT x0) (ConduitT y0) = ConduitT $ \rest -> let+    Leftover _  i    >< _                = absurd i+    _                >< Leftover _  i    = absurd i+    HaveOutput _ o   >< _                = absurd o+    _                >< HaveOutput _ o   = absurd o++    PipeM mx         >< y                = PipeM (liftM (>< y) mx)+    x                >< PipeM my         = PipeM (liftM (x ><) my)+    Done x           >< Done y           = rest (x, y)+    NeedInput px cx  >< NeedInput py cy  = NeedInput (\i -> px i >< py i) (\() -> cx () >< cy ())+    NeedInput px cx  >< y@Done{}         = NeedInput (\i -> px i >< y)    (\u -> cx u >< y)+    x@Done{}         >< NeedInput py cy  = NeedInput (\i -> x >< py i)    (\u -> x >< cy u)+    in injectLeftovers (x0 Done) >< injectLeftovers (y0 Done)++-- | Combines two sources. The new source will stop producing once either+--   source has been exhausted.+--+-- Since 1.0.13+zipSources :: Monad m => ConduitT () a m () -> ConduitT () b m () -> ConduitT () (a, b) m ()+zipSources (ConduitT left0) (ConduitT right0) = ConduitT $ \rest -> let+    go (Leftover left ()) right = go left right+    go left (Leftover right ())  = go left right+    go (Done ()) (Done ()) = rest ()+    go (Done ()) (HaveOutput _ _) = rest ()+    go (HaveOutput _ _) (Done ()) = rest ()+    go (Done ()) (PipeM _) = rest ()+    go (PipeM _) (Done ()) = rest ()+    go (PipeM mx) (PipeM my) = PipeM (liftM2 go mx my)+    go (PipeM mx) y@HaveOutput{} = PipeM (liftM (\x -> go x y) mx)+    go x@HaveOutput{} (PipeM my) = PipeM (liftM (go x) my)+    go (HaveOutput srcx x) (HaveOutput srcy y) = HaveOutput (go srcx srcy) (x, y)+    go (NeedInput _ c) right = go (c ()) right+    go left (NeedInput _ c) = go left (c ())+    in go (left0 Done) (right0 Done)++-- | Combines two sources. The new source will stop producing once either+--   source has been exhausted.+--+-- Since 1.0.13+zipSourcesApp :: Monad m => ConduitT () (a -> b) m () -> ConduitT () a m () -> ConduitT () b m ()+zipSourcesApp (ConduitT left0) (ConduitT right0) = ConduitT $ \rest -> let+    go (Leftover left ()) right = go left right+    go left (Leftover right ())  = go left right+    go (Done ()) (Done ()) = rest ()+    go (Done ()) (HaveOutput _ _) = rest ()+    go (HaveOutput _ _) (Done ()) = rest ()+    go (Done ()) (PipeM _) = rest ()+    go (PipeM _) (Done ()) = rest ()+    go (PipeM mx) (PipeM my) = PipeM (liftM2 go mx my)+    go (PipeM mx) y@HaveOutput{} = PipeM (liftM (\x -> go x y) mx)+    go x@HaveOutput{} (PipeM my) = PipeM (liftM (go x) my)+    go (HaveOutput srcx x) (HaveOutput srcy y) = HaveOutput (go srcx srcy) (x y)+    go (NeedInput _ c) right = go (c ()) right+    go left (NeedInput _ c) = go left (c ())+    in go (left0 Done) (right0 Done)++-- |+--+-- Since 1.0.17+zipConduitApp+    :: Monad m+    => ConduitT i o m (x -> y)+    -> ConduitT i o m x+    -> ConduitT i o m y+zipConduitApp (ConduitT left0) (ConduitT right0) = ConduitT $ \rest -> let+    go (Done f) (Done x) = rest (f x)+    go (PipeM mx) y = PipeM (flip go y `liftM` mx)+    go x (PipeM my) = PipeM (go x `liftM` my)+    go (HaveOutput x o) y = HaveOutput (go x y) o+    go x (HaveOutput y o) = HaveOutput (go x y) o+    go (Leftover _ i) _ = absurd i+    go _ (Leftover _ i) = absurd i+    go (NeedInput px cx) (NeedInput py cy) = NeedInput+        (\i -> go (px i) (py i))+        (\u -> go (cx u) (cy u))+    go (NeedInput px cx) (Done y) = NeedInput+        (\i -> go (px i) (Done y))+        (\u -> go (cx u) (Done y))+    go (Done x) (NeedInput py cy) = NeedInput+        (\i -> go (Done x) (py i))+        (\u -> go (Done x) (cy u))+  in go (injectLeftovers $ left0 Done) (injectLeftovers $ right0 Done)++-- | Same as normal fusion (e.g. @=$=@), except instead of discarding leftovers+-- from the downstream component, return them.+--+-- Since 1.0.17+fuseReturnLeftovers :: Monad m+                    => ConduitT a b m ()+                    -> ConduitT b c m r+                    -> ConduitT a c m (r, [b])+fuseReturnLeftovers (ConduitT left0) (ConduitT right0) = ConduitT $ \rest -> let+    goRight bs left right =+        case right of+            HaveOutput p o -> HaveOutput (recurse p) o+            NeedInput rp rc  ->+                case bs of+                    [] -> goLeft rp rc left+                    b:bs' -> goRight bs' left (rp b)+            Done r2          -> rest (r2, bs)+            PipeM mp         -> PipeM (liftM recurse mp)+            Leftover p b     -> goRight (b:bs) left p+      where+        recurse = goRight bs left++    goLeft rp rc left =+        case left of+            HaveOutput left' o        -> goRight [] left' (rp o)+            NeedInput left' lc        -> NeedInput (recurse . left') (recurse . lc)+            Done r1                   -> goRight [] (Done r1) (rc r1)+            PipeM mp                  -> PipeM (liftM recurse mp)+            Leftover left' i          -> Leftover (recurse left') i+      where+        recurse = goLeft rp rc+    in goRight [] (left0 Done) (right0 Done)++-- | Similar to @fuseReturnLeftovers@, but use the provided function to convert+-- downstream leftovers to upstream leftovers.+--+-- Since 1.0.17+fuseLeftovers+    :: Monad m+    => ([b] -> [a])+    -> ConduitT a b m ()+    -> ConduitT b c m r+    -> ConduitT a c m r+fuseLeftovers f left right = do+    (r, bs) <- fuseReturnLeftovers left right+    mapM_ leftover $ reverse $ f bs+    return r++-- | Connect a 'Conduit' to a sink and return the output of the sink+-- together with a new 'Conduit'.+--+-- Since 1.0.17+connectResumeConduit+    :: Monad m+    => SealedConduitT i o m ()+    -> ConduitT o Void m r+    -> ConduitT i Void m (SealedConduitT i o m (), r)+connectResumeConduit (SealedConduitT left0) (ConduitT right0) = ConduitT $ \rest -> let+    goRight left right =+        case right of+            HaveOutput _ o -> absurd o+            NeedInput rp rc -> goLeft rp rc left+            Done r2 -> rest (SealedConduitT left, r2)+            PipeM mp -> PipeM (liftM (goRight left) mp)+            Leftover p i -> goRight (HaveOutput left i) p++    goLeft rp rc left =+        case left of+            HaveOutput left' o -> goRight left' (rp o)+            NeedInput left' lc -> NeedInput (recurse . left') (recurse . lc)+            Done () -> goRight (Done ()) (rc ())+            PipeM mp -> PipeM (liftM recurse mp)+            Leftover left' i -> Leftover (recurse left') i -- recurse p+      where+        recurse = goLeft rp rc+    in goRight left0 (right0 Done)++-- | Merge a @Source@ into a @Conduit@.+-- The new conduit will stop processing once either source or upstream have been exhausted.+mergeSource+  :: Monad m+  => ConduitT () i m ()+  -> ConduitT a (i, a) m ()+mergeSource = loop . sealConduitT+  where+    loop :: Monad m => SealedConduitT () i m () -> ConduitT a (i, a) m ()+    loop src0 = await >>= maybe (return ()) go+      where+        go a = do+          (src1, mi) <- lift $ src0 $$++ await+          case mi of+            Nothing -> leftover a+            Just i  -> yield (i, a) >> loop src1+++-- | Turn a @Sink@ into a @Conduit@ in the following way:+--+-- * All input passed to the @Sink@ is yielded downstream.+--+-- * When the @Sink@ finishes processing, the result is passed to the provided to the finalizer function.+--+-- Note that the @Sink@ will stop receiving input as soon as the downstream it+-- is connected to shuts down.+--+-- An example usage would be to write the result of a @Sink@ to some mutable+-- variable while allowing other processing to continue.+--+-- Since 1.1.0+passthroughSink :: Monad m+                => ConduitT i Void m r+                -> (r -> m ()) -- ^ finalizer+                -> ConduitT i i m ()+passthroughSink (ConduitT sink0) final = ConduitT $ \rest -> let+    -- A bit of explanation is in order, this function is+    -- non-obvious. The purpose of go is to keep track of the sink+    -- we're passing values to, and then yield values downstream. The+    -- third argument to go is the current state of that sink. That's+    -- relatively straightforward.+    --+    -- The second value is the leftover buffer. These are values that+    -- the sink itself has called leftover on, and must be provided+    -- back to the sink the next time it awaits. _However_, these+    -- values should _not_ be reyielded downstream: we have already+    -- yielded them downstream ourself, and it is the responsibility+    -- of the functions wrapping around passthroughSink to handle the+    -- leftovers from downstream.+    --+    -- The trickiest bit is the first argument, which is a solution to+    -- bug https://github.com/snoyberg/conduit/issues/304. The issue+    -- is that, once we get a value, we need to provide it to both the+    -- inner sink _and_ yield it downstream. The obvious thing to do+    -- is yield first and then recursively call go. Unfortunately,+    -- this doesn't work in all cases: if the downstream component+    -- never calls await again, our yield call will never return, and+    -- our sink will not get the last value. This results is confusing+    -- behavior where the sink and downstream component receive a+    -- different number of values.+    --+    -- Solution: keep a buffer of the next value to yield downstream,+    -- and only yield it downstream in one of two cases: our sink is+    -- asking for another value, or our sink is done. This way, we+    -- ensure that, in all cases, we pass exactly the same number of+    -- values to the inner sink as to downstream.++    go mbuf _ (Done r) = do+        maybe (return ()) CI.yield mbuf+        lift $ final r+        unConduitT (awaitForever yield) rest+    go mbuf is (Leftover sink i) = go mbuf (i:is) sink+    go _ _ (HaveOutput _ o) = absurd o+    go mbuf is (PipeM mx) = do+        x <- lift mx+        go mbuf is x+    go mbuf (i:is) (NeedInput next _) = go mbuf is (next i)+    go mbuf [] (NeedInput next done) = do+        maybe (return ()) CI.yield mbuf+        mx <- CI.await+        case mx of+            Nothing -> go Nothing [] (done ())+            Just x -> go (Just x) [] (next x)+    in go Nothing [] (sink0 Done)++-- | Convert a @Source@ into a list. The basic functionality can be explained as:+--+-- > sourceToList src = src $$ Data.Conduit.List.consume+--+-- However, @sourceToList@ is able to produce its results lazily, which cannot+-- be done when running a conduit pipeline in general. Unlike the+-- @Data.Conduit.Lazy@ module (in conduit-extra), this function performs no+-- unsafe I\/O operations, and therefore can only be as lazy as the+-- underlying monad.+--+-- Since 1.2.6+sourceToList :: Monad m => ConduitT () a m () -> m [a]+sourceToList (ConduitT k) =+    go $ k Done+  where+    go (Done _) = return []+    go (HaveOutput src x) = liftM (x:) (go src)+    go (PipeM msrc) = msrc >>= go+    go (NeedInput _ c) = go (c ())+    go (Leftover p _) = go p++-- Define fixity of all our operators+infixr 0 $$+infixl 1 $=+infixr 2 =$+infixr 2 =$=+infixr 0 $$++infixr 0 $$+++infixr 0 $$+-+infixl 1 $=++infixr 2 .|++-- | Equivalent to using 'runConduit' and '.|' together.+--+-- Since 1.2.3+connect :: Monad m+        => ConduitT () a m ()+        -> ConduitT a Void m r+        -> m r+connect = ($$)++-- | Split a conduit into head and tail.+--+-- Note that you have to 'sealConduitT' it first.+--+-- Since 1.3.3+unconsM :: Monad m+        => SealedConduitT () o m ()+        -> m (Maybe (o, SealedConduitT () o m ()))+unconsM (SealedConduitT p) = go p+  where+    -- This function is the same as @Pipe.unconsM@ but it ignores leftovers.+    go (HaveOutput p o) = pure $ Just (o, SealedConduitT p)+    go (NeedInput _ c) = go $ c ()+    go (Done ()) = pure Nothing+    go (PipeM mp) = mp >>= go+    go (Leftover p ()) = go p++-- | Split a conduit into head and tail or return its result if it is done.+--+-- Note that you have to 'sealConduitT' it first.+--+-- Since 1.3.3+unconsEitherM :: Monad m+              => SealedConduitT () o m r+              -> m (Either r (o, SealedConduitT () o m r))+unconsEitherM (SealedConduitT p) = go p+  where+    -- This function is the same as @Pipe.unconsEitherM@ but it ignores leftovers.+    go (HaveOutput p o) = pure $ Right (o, SealedConduitT p)+    go (NeedInput _ c) = go $ c ()+    go (Done r) = pure $ Left r+    go (PipeM mp) = mp >>= go+    go (Leftover p ()) = go p++-- | Named function synonym for '.|'+--+-- Equivalent to '.|' and '=$='. However, the latter is+-- deprecated and will be removed in a future version.+--+-- Since 1.2.3+fuse :: Monad m => ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r+fuse = (=$=)++-- | Combine two @Conduit@s together into a new @Conduit@ (aka 'fuse').+--+-- Output from the upstream (left) conduit will be fed into the+-- downstream (right) conduit. Processing will terminate when+-- downstream (right) returns.+-- Leftover data returned from the right @Conduit@ will be discarded.+--+-- Equivalent to 'fuse' and '=$=', however the latter is deprecated and will+-- be removed in a future version.+--+-- Note that, while this operator looks like categorical composition+-- (from "Control.Category"), there are a few reasons it's different:+--+-- * The position of the type parameters to 'ConduitT' do not+--   match. We would need to change @ConduitT i o m r@ to @ConduitT r+--   m i o@, which would preclude a 'Monad' or 'MonadTrans' instance.+--+-- * The result value from upstream and downstream are allowed to+--   differ between upstream and downstream. In other words, we would+--   need the type signature here to look like @ConduitT a b m r ->+--   ConduitT b c m r -> ConduitT a c m r@.+--+-- * Due to leftovers, we do not have a left identity in Conduit. This+--   can be achieved with the underlying @Pipe@ datatype, but this is+--   not generally recommended. See <https://stackoverflow.com/a/15263700>.+--+-- @since 1.2.8+(.|) :: Monad m+     => ConduitT a b m () -- ^ upstream+     -> ConduitT b c m r -- ^ downstream+     -> ConduitT a c m r+(.|) = fuse+{-# INLINE (.|) #-}++-- | The connect operator, which pulls data from a source and pushes to a sink.+-- If you would like to keep the @Source@ open to be used for other+-- operations, use the connect-and-resume operator '$$+'.+--+-- Since 0.4.0+($$) :: Monad m => Source m a -> Sink a m b -> m b+src $$ sink = do+    (rsrc, res) <- src $$+ sink+    rsrc $$+- return ()+    return res+{-# INLINE [1] ($$) #-}+{-# DEPRECATED ($$) "Use runConduit and .|" #-}++-- | A synonym for '=$=' for backwards compatibility.+--+-- Since 0.4.0+($=) :: Monad m => Conduit a m b -> ConduitT b c m r -> ConduitT a c m r+($=) = (=$=)+{-# INLINE [0] ($=) #-}+{-# RULES "conduit: $= is =$=" ($=) = (=$=) #-}+{-# DEPRECATED ($=) "Use .|" #-}++-- | A synonym for '=$=' for backwards compatibility.+--+-- Since 0.4.0+(=$) :: Monad m => Conduit a m b -> ConduitT b c m r -> ConduitT a c m r+(=$) = (=$=)+{-# INLINE [0] (=$) #-}+{-# RULES "conduit: =$ is =$=" (=$) = (=$=) #-}+{-# DEPRECATED (=$) "Use .|" #-}++-- | Deprecated fusion operator.+--+-- Since 0.4.0+(=$=) :: Monad m => Conduit a m b -> ConduitT b c m r -> ConduitT a c m r+ConduitT left0 =$= ConduitT right0 = ConduitT $ \rest ->+    let goRight left right =+            case right of+                HaveOutput p o    -> HaveOutput (recurse p) o+                NeedInput rp rc   -> goLeft rp rc left+                Done r2           -> rest r2+                PipeM mp          -> PipeM (liftM recurse mp)+                Leftover right' i -> goRight (HaveOutput left i) right'+          where+            recurse = goRight left++        goLeft rp rc left =+            case left of+                HaveOutput left' o        -> goRight left' (rp o)+                NeedInput left' lc        -> NeedInput (recurse . left') (recurse . lc)+                Done r1                   -> goRight (Done r1) (rc r1)+                PipeM mp                  -> PipeM (liftM recurse mp)+                Leftover left' i          -> Leftover (recurse left') i+          where+            recurse = goLeft rp rc+     in goRight (left0 Done) (right0 Done)+{-# INLINE [1] (=$=) #-}+{-# DEPRECATED (=$=) "Use .|" #-}++-- | Wait for a single input value from upstream. If no data is available,+-- returns @Nothing@. Once @await@ returns @Nothing@, subsequent calls will+-- also return @Nothing@.+--+-- Since 0.5.0+await :: Monad m => ConduitT i o m (Maybe i)+await = ConduitT $ \f -> NeedInput (f . Just) (const $ f Nothing)+{-# INLINE [0] await #-}++await' :: Monad m+       => ConduitT i o m r+       -> (i -> ConduitT i o m r)+       -> ConduitT i o m r+await' f g = ConduitT $ \rest -> NeedInput+    (\i -> unConduitT (g i) rest)+    (const $ unConduitT f rest)+{-# INLINE await' #-}+{-# RULES "conduit: await >>= maybe" forall x y. await >>= maybe x y = await' x y #-}++-- | Send a value downstream to the next component to consume. If the+-- downstream component terminates, this call will never return control.+--+-- Since 0.5.0+yield :: Monad m+      => o -- ^ output value+      -> ConduitT i o m ()+yield o = ConduitT $ \rest -> HaveOutput (rest ()) o+{-# INLINE yield #-}++-- | Send a monadic value downstream for the next component to consume.+--+-- @since 1.2.7+yieldM :: Monad m => m o -> ConduitT i o m ()+yieldM mo = lift mo >>= yield+{-# INLINE yieldM #-}++  -- FIXME rule won't fire, see FIXME in .Pipe; "mapM_ yield" mapM_ yield = ConduitT . sourceList++-- | Provide a single piece of leftover input to be consumed by the next+-- component in the current monadic binding.+--+-- /Note/: it is highly encouraged to only return leftover values from input+-- already consumed from upstream.+--+-- @since 0.5.0+leftover :: i -> ConduitT i o m ()+leftover i = ConduitT $ \rest -> Leftover (rest ()) i+{-# INLINE leftover #-}++-- | Run a pipeline until processing completes.+--+-- Since 1.2.1+runConduit :: Monad m => ConduitT () Void m r -> m r+runConduit (ConduitT p) = runPipe $ injectLeftovers $ p Done+{-# INLINE [0] runConduit #-}++-- | Bracket a conduit computation between allocation and release of a+-- resource. Two guarantees are given about resource finalization:+--+-- 1. It will be /prompt/. The finalization will be run as early as possible.+--+-- 2. It is exception safe. Due to usage of @resourcet@, the finalization will+-- be run in the event of any exceptions.+--+-- Since 0.5.0+bracketP :: MonadResource m++         => IO a+            -- ^ computation to run first (\"acquire resource\")+         -> (a -> IO ())+            -- ^ computation to run last (\"release resource\")+         -> (a -> ConduitT i o m r)+            -- ^ computation to run in-between+         -> ConduitT i o m r+            -- returns the value from the in-between computation+bracketP alloc free inside = ConduitT $ \rest -> do+  (key, seed) <- allocate alloc free+  unConduitT (inside seed) $ \res -> do+    release key+    rest res++-- | Wait for input forever, calling the given inner component for each piece of+-- new input.+--+-- This function is provided as a convenience for the common pattern of+-- @await@ing input, checking if it's @Just@ and then looping.+--+-- Since 0.5.0+awaitForever :: Monad m => (i -> ConduitT i o m r) -> ConduitT i o m ()+awaitForever f = ConduitT $ \rest ->+    let go = NeedInput (\i -> unConduitT (f i) (const go)) rest+     in go++-- | Transform the monad that a @ConduitT@ lives in.+--+-- Note that the monad transforming function will be run multiple times,+-- resulting in unintuitive behavior in some cases. For a fuller treatment,+-- please see:+--+-- <https://github.com/snoyberg/conduit/wiki/Dealing-with-monad-transformers>+--+-- Since 0.4.0+transPipe :: Monad m => (forall a. m a -> n a) -> ConduitT i o m r -> ConduitT i o n r+transPipe f (ConduitT c0) = ConduitT $ \rest -> let+        go (HaveOutput p o) = HaveOutput (go p) o+        go (NeedInput p c) = NeedInput (go . p) (go . c)+        go (Done r) = rest r+        go (PipeM mp) =+            PipeM (f $ liftM go $ collapse mp)+          where+            -- Combine a series of monadic actions into a single action.  Since we+            -- throw away side effects between different actions, an arbitrary break+            -- between actions will lead to a violation of the monad transformer laws.+            -- Example available at:+            --+            -- http://hpaste.org/75520+            collapse mpipe = do+                pipe' <- mpipe+                case pipe' of+                    PipeM mpipe' -> collapse mpipe'+                    _ -> return pipe'+        go (Leftover p i) = Leftover (go p) i+        in go (c0 Done)++-- | Apply a function to all the output values of a @ConduitT@.+--+-- This mimics the behavior of `fmap` for a `Source` and `Conduit` in pre-0.4+-- days. It can also be simulated by fusing with the @map@ conduit from+-- "Data.Conduit.List".+--+-- Since 0.4.1+mapOutput :: Monad m => (o1 -> o2) -> ConduitT i o1 m r -> ConduitT i o2 m r+mapOutput f (ConduitT c0) = ConduitT $ \rest -> let+    go (HaveOutput p o) = HaveOutput (go p) (f o)+    go (NeedInput p c) = NeedInput (go . p) (go . c)+    go (Done r) = rest r+    go (PipeM mp) = PipeM (liftM (go) mp)+    go (Leftover p i) = Leftover (go p) i+    in go (c0 Done)++-- | Same as 'mapOutput', but use a function that returns @Maybe@ values.+--+-- Since 0.5.0+mapOutputMaybe :: Monad m => (o1 -> Maybe o2) -> ConduitT i o1 m r -> ConduitT i o2 m r+mapOutputMaybe f (ConduitT c0) = ConduitT $ \rest -> let+    go (HaveOutput p o) = maybe id (\o' p' -> HaveOutput p' o') (f o) (go p)+    go (NeedInput p c) = NeedInput (go . p) (go . c)+    go (Done r) = rest r+    go (PipeM mp) = PipeM (liftM (go) mp)+    go (Leftover p i) = Leftover (go p) i+    in go (c0 Done)++-- | Apply a function to all the input values of a @ConduitT@.+--+-- Since 0.5.0+mapInput :: Monad m+         => (i1 -> i2) -- ^ map initial input to new input+         -> (i2 -> Maybe i1) -- ^ map new leftovers to initial leftovers+         -> ConduitT i2 o m r+         -> ConduitT i1 o m r+mapInput f f' (ConduitT c0) = ConduitT $ \rest -> let+    go (HaveOutput p o) = HaveOutput (go p) o+    go (NeedInput p c) = NeedInput (go . p . f) (go . c)+    go (Done r) = rest r+    go (PipeM mp) = PipeM $ liftM go mp+    go (Leftover p i) = maybe id (flip Leftover) (f' i) (go p)+    in go (c0 Done)++-- | Apply a monadic action to all the input values of a @ConduitT@.+--+-- Since 1.3.2+mapInputM :: Monad m+          => (i1 -> m i2) -- ^ map initial input to new input+          -> (i2 -> m (Maybe i1)) -- ^ map new leftovers to initial leftovers+          -> ConduitT i2 o m r+          -> ConduitT i1 o m r+mapInputM f f' (ConduitT c0) = ConduitT $ \rest -> let+    go (HaveOutput p o) = HaveOutput (go p) o+    go (NeedInput p c)  = NeedInput (\i -> PipeM $ go . p <$> f i) (go . c)+    go (Done r)         = rest r+    go (PipeM mp)       = PipeM $ fmap go mp+    go (Leftover p i)   = PipeM $ (\x -> maybe id (flip Leftover) x (go p)) <$> f' i+    in go (c0 Done)++-- | The connect-and-resume operator. This does not close the @Source@, but+-- instead returns it to be used again. This allows a @Source@ to be used+-- incrementally in a large program, without forcing the entire program to live+-- in the @Sink@ monad.+--+-- Mnemonic: connect + do more.+--+-- Since 0.5.0+($$+) :: Monad m => ConduitT () a m () -> ConduitT a Void m b -> m (SealedConduitT () a m (), b)+src $$+ sink = connectResume (sealConduitT src) sink+{-# INLINE ($$+) #-}++-- | Continue processing after usage of @$$+@.+--+-- Since 0.5.0+($$++) :: Monad m => SealedConduitT () a m () -> ConduitT a Void m b -> m (SealedConduitT () a m (), b)+($$++) = connectResume+{-# INLINE ($$++) #-}++-- | Same as @$$++@ and @connectResume@, but doesn't include the+-- updated @SealedConduitT@.+--+-- /NOTE/ In previous versions, this would cause finalizers to+-- run. Since version 1.3.0, there are no finalizers in conduit.+--+-- Since 0.5.0+($$+-) :: Monad m => SealedConduitT () a m () -> ConduitT a Void m b -> m b+rsrc $$+- sink = do+    (_, res) <- connectResume rsrc sink+    return res+{-# INLINE ($$+-) #-}++-- | Left fusion for a sealed source.+--+-- Since 1.0.16+($=+) :: Monad m => SealedConduitT () a m () -> ConduitT a b m () -> SealedConduitT () b m ()+SealedConduitT src $=+ ConduitT sink = SealedConduitT (src `pipeL` sink Done)++-- | Provide for a stream of data that can be flushed.+--+-- A number of @Conduit@s (e.g., zlib compression) need the ability to flush+-- the stream at some point. This provides a single wrapper datatype to be used+-- in all such circumstances.+--+-- Since 0.3.0+data Flush a = Chunk a | Flush+    deriving (Show, Eq, Ord)+instance Functor Flush where+    fmap _ Flush = Flush+    fmap f (Chunk a) = Chunk (f a)++-- | A wrapper for defining an 'Applicative' instance for 'Source's which allows+-- to combine sources together, generalizing 'zipSources'. A combined source+-- will take input yielded from each of its @Source@s until any of them stop+-- producing output.+--+-- Since 1.0.13+newtype ZipSource m o = ZipSource { getZipSource :: ConduitT () o m () }++instance Monad m => Functor (ZipSource m) where+    fmap f = ZipSource . mapOutput f . getZipSource+instance Monad m => Applicative (ZipSource m) where+    pure  = ZipSource . forever . yield+    (ZipSource f) <*> (ZipSource x) = ZipSource $ zipSourcesApp f x++-- | Coalesce all values yielded by all of the @Source@s.+--+-- Implemented on top of @ZipSource@ and as such, it exhibits the same+-- short-circuiting behavior as @ZipSource@. See that data type for more+-- details. If you want to create a source that yields *all* values from+-- multiple sources, use `sequence_`.+--+-- Since 1.0.13+sequenceSources :: (Traversable f, Monad m) => f (ConduitT () o m ()) -> ConduitT () (f o) m ()+sequenceSources = getZipSource . sequenceA . fmap ZipSource++-- | A wrapper for defining an 'Applicative' instance for 'Sink's which allows+-- to combine sinks together, generalizing 'zipSinks'. A combined sink+-- distributes the input to all its participants and when all finish, produces+-- the result. This allows to define functions like+--+-- @+-- sequenceSinks :: (Monad m)+--           => [ConduitT i Void m r] -> ConduitT i Void m [r]+-- sequenceSinks = getZipSink . sequenceA . fmap ZipSink+-- @+--+-- Note that the standard 'Applicative' instance for conduits works+-- differently. It feeds one sink with input until it finishes, then switches+-- to another, etc., and at the end combines their results.+--+-- This newtype is in fact a type constrained version of 'ZipConduit', and has+-- the same behavior. It's presented as a separate type since (1) it+-- historically predates @ZipConduit@, and (2) the type constraining can make+-- your code clearer (and thereby make your error messages more easily+-- understood).+--+-- Since 1.0.13+newtype ZipSink i m r = ZipSink { getZipSink :: ConduitT i Void m r }++instance Monad m => Functor (ZipSink i m) where+    fmap f (ZipSink x) = ZipSink (liftM f x)+instance Monad m => Applicative (ZipSink i m) where+    pure  = ZipSink . return+    (ZipSink f) <*> (ZipSink x) =+         ZipSink $ liftM (uncurry ($)) $ zipSinks f x++-- | Send incoming values to all of the @Sink@ providing, and ultimately+-- coalesce together all return values.+--+-- Implemented on top of @ZipSink@, see that data type for more details.+--+-- Since 1.0.13+sequenceSinks :: (Traversable f, Monad m) => f (ConduitT i Void m r) -> ConduitT i Void m (f r)+sequenceSinks = getZipSink . sequenceA . fmap ZipSink++-- | The connect-and-resume operator. This does not close the @Conduit@, but+-- instead returns it to be used again. This allows a @Conduit@ to be used+-- incrementally in a large program, without forcing the entire program to live+-- in the @Sink@ monad.+--+-- Leftover data returned from the @Sink@ will be discarded.+--+-- Mnemonic: connect + do more.+--+-- Since 1.0.17+(=$$+) :: Monad m+       => ConduitT a b m ()+       -> ConduitT b Void m r+       -> ConduitT a Void m (SealedConduitT a b m (), r)+(=$$+) conduit = connectResumeConduit (sealConduitT conduit)+{-# INLINE (=$$+) #-}++-- | Continue processing after usage of '=$$+'. Connect a 'SealedConduitT' to+-- a sink and return the output of the sink together with a new+-- 'SealedConduitT'.+--+-- Since 1.0.17+(=$$++) :: Monad m => SealedConduitT i o m () -> ConduitT o Void m r -> ConduitT i Void m (SealedConduitT i o m (), r)+(=$$++) = connectResumeConduit+{-# INLINE (=$$++) #-}++-- | Same as @=$$++@, but doesn't include the updated+-- @SealedConduitT@.+--+-- /NOTE/ In previous versions, this would cause finalizers to+-- run. Since version 1.3.0, there are no finalizers in conduit.+--+-- Since 1.0.17+(=$$+-) :: Monad m => SealedConduitT i o m () -> ConduitT o Void m r -> ConduitT i Void m r+rsrc =$$+- sink = do+    (_, res) <- connectResumeConduit rsrc sink+    return res+{-# INLINE (=$$+-) #-}+++infixr 0 =$$++infixr 0 =$$+++infixr 0 =$$+-++-- | Provides an alternative @Applicative@ instance for @ConduitT@. In this instance,+-- every incoming value is provided to all @ConduitT@s, and output is coalesced together.+-- Leftovers from individual @ConduitT@s will be used within that component, and then discarded+-- at the end of their computation. Output and finalizers will both be handled in a left-biased manner.+--+-- As an example, take the following program:+--+-- @+-- main :: IO ()+-- main = do+--     let src = mapM_ yield [1..3 :: Int]+--         conduit1 = CL.map (+1)+--         conduit2 = CL.concatMap (replicate 2)+--         conduit = getZipConduit $ ZipConduit conduit1 <* ZipConduit conduit2+--         sink = CL.mapM_ print+--     src $$ conduit =$ sink+-- @+--+-- It will produce the output: 2, 1, 1, 3, 2, 2, 4, 3, 3+--+-- Since 1.0.17+newtype ZipConduit i o m r = ZipConduit { getZipConduit :: ConduitT i o m r }+    deriving Functor+instance Monad m => Applicative (ZipConduit i o m) where+    pure = ZipConduit . pure+    ZipConduit left <*> ZipConduit right = ZipConduit (zipConduitApp left right)++-- | Provide identical input to all of the @Conduit@s and combine their outputs+-- into a single stream.+--+-- Implemented on top of @ZipConduit@, see that data type for more details.+--+-- Since 1.0.17+sequenceConduits :: (Traversable f, Monad m) => f (ConduitT i o m r) -> ConduitT i o m (f r)+sequenceConduits = getZipConduit . sequenceA . fmap ZipConduit++-- | Fuse two @ConduitT@s together, and provide the return value of both. Note+-- that this will force the entire upstream @ConduitT@ to be run to produce the+-- result value, even if the downstream terminates early.+--+-- Since 1.1.5+fuseBoth :: Monad m => ConduitT a b m r1 -> ConduitT b c m r2 -> ConduitT a c m (r1, r2)+fuseBoth (ConduitT up) (ConduitT down) =+    ConduitT (pipeL (up Done) (withUpstream $ generalizeUpstream $ down Done) >>=)+{-# INLINE fuseBoth #-}++-- | Like 'fuseBoth', but does not force consumption of the @Producer@.+-- In the case that the @Producer@ terminates, the result value is+-- provided as a @Just@ value. If it does not terminate, then a+-- @Nothing@ value is returned.+--+-- One thing to note here is that "termination" here only occurs if the+-- @Producer@ actually yields a @Nothing@ value. For example, with the+-- @Producer@ @mapM_ yield [1..5]@, if five values are requested, the+-- @Producer@ has not yet terminated. Termination only occurs when the+-- sixth value is awaited for and the @Producer@ signals termination.+--+-- Since 1.2.4+fuseBothMaybe+    :: Monad m+    => ConduitT a b m r1+    -> ConduitT b c m r2+    -> ConduitT a c m (Maybe r1, r2)+fuseBothMaybe (ConduitT up) (ConduitT down) =+    ConduitT (pipeL (up Done) (go Nothing $ down Done) >>=)+  where+    go mup (Done r) = Done (mup, r)+    go mup (PipeM mp) = PipeM $ liftM (go mup) mp+    go mup (HaveOutput p o) = HaveOutput (go mup p) o+    go _ (NeedInput p c) = NeedInput+        (\i -> go Nothing (p i))+        (\u -> go (Just u) (c ()))+    go mup (Leftover p i) = Leftover (go mup p) i+{-# INLINABLE fuseBothMaybe #-}++-- | Same as @fuseBoth@, but ignore the return value from the downstream+-- @Conduit@. Same caveats of forced consumption apply.+--+-- Since 1.1.5+fuseUpstream :: Monad m => ConduitT a b m r -> ConduitT b c m () -> ConduitT a c m r+fuseUpstream up down = fmap fst (fuseBoth up down)+{-# INLINE fuseUpstream #-}++-- Rewrite rules++{- FIXME+{-# RULES "conduit: ConduitT: lift x >>= f" forall m f. lift m >>= f = ConduitT (PipeM (liftM (unConduitT . f) m)) #-}+{-# RULES "conduit: ConduitT: lift x >> f" forall m f. lift m >> f = ConduitT (PipeM (liftM (\_ -> unConduitT f) m)) #-}++{-# RULES "conduit: ConduitT: liftIO x >>= f" forall m (f :: MonadIO m => a -> ConduitT i o m r). liftIO m >>= f = ConduitT (PipeM (liftM (unConduitT . f) (liftIO m))) #-}+{-# RULES "conduit: ConduitT: liftIO x >> f" forall m (f :: MonadIO m => ConduitT i o m r). liftIO m >> f = ConduitT (PipeM (liftM (\_ -> unConduitT f) (liftIO m))) #-}++{-# RULES "conduit: ConduitT: liftBase x >>= f" forall m (f :: MonadBase b m => a -> ConduitT i o m r). liftBase m >>= f = ConduitT (PipeM (liftM (unConduitT . f) (liftBase m))) #-}+{-# RULES "conduit: ConduitT: liftBase x >> f" forall m (f :: MonadBase b m => ConduitT i o m r). liftBase m >> f = ConduitT (PipeM (liftM (\_ -> unConduitT f) (liftBase m))) #-}++{-# RULES+    "yield o >> p" forall o (p :: ConduitT i o m r). yield o >> p = ConduitT (HaveOutput (unConduitT p) o)+  ; "when yield next" forall b o p. when b (yield o) >> p =+        if b then ConduitT (HaveOutput (unConduitT p) o) else p+  ; "unless yield next" forall b o p. unless b (yield o) >> p =+        if b then p else ConduitT (HaveOutput (unConduitT p) o)+  ; "lift m >>= yield" forall m. lift m >>= yield = yieldM m+   #-}+{-# RULES "conduit: leftover l >> p" forall l (p :: ConduitT i o m r). leftover l >> p =+    ConduitT (Leftover (unConduitT p) l) #-}+    -}++-- | Run a pure pipeline until processing completes, i.e. a pipeline+-- with @Identity@ as the base monad. This is equivalient to+-- @runIdentity . runConduit@.+--+-- @since 1.2.8+runConduitPure :: ConduitT () Void Identity r -> r+runConduitPure = runIdentity . runConduit+{-# INLINE runConduitPure #-}++-- | Run a pipeline which acquires resources with @ResourceT@, and+-- then run the @ResourceT@ transformer. This is equivalent to+-- @runResourceT . runConduit@.+--+-- @since 1.2.8+runConduitRes :: MonadUnliftIO m+              => ConduitT () Void (ResourceT m) r+              -> m r+runConduitRes = runResourceT . runConduit+{-# INLINE runConduitRes #-}
+ src/Data/Conduit/Internal/Fusion.hs view
@@ -0,0 +1,286 @@+{-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE ScopedTypeVariables #-}+module Data.Conduit.Internal.Fusion+    ( -- ** Types+      Step (..)+    , Stream (..)+    , ConduitWithStream+    , StreamConduitT+    , StreamConduit+    , StreamSource+    , StreamProducer+    , StreamSink+    , StreamConsumer+      -- ** Functions+    , streamConduit+    , streamSource+    , streamSourcePure+    , unstream+    ) where++import Data.Conduit.Internal.Conduit+import Data.Conduit.Internal.Pipe (Pipe (..))+import Data.Functor.Identity (Identity (runIdentity))+import Data.Void (Void, absurd)+import Control.Monad.Trans.Resource (runResourceT)++-- | This is the same as stream fusion\'s Step. Constructors are renamed to+-- avoid confusion with conduit names.+data Step s o r+    = Emit s o+    | Skip s+    | Stop r+    deriving Functor++data Stream m o r = forall s. Stream+    (s -> m (Step s o r))+    (m s)++data ConduitWithStream i o m r = ConduitWithStream+    (ConduitT i o m r)+    (StreamConduitT i o m r)++type StreamConduitT i o m r = Stream m i () -> Stream m o r++type StreamConduit i m o = StreamConduitT i o m ()++type StreamSource m o = StreamConduitT () o m ()++type StreamProducer m o = forall i. StreamConduitT i o m ()++type StreamSink i m r = StreamConduitT i Void m r++type StreamConsumer i m r = forall o. StreamConduitT i o m r++unstream :: ConduitWithStream i o m r -> ConduitT i o m r+unstream (ConduitWithStream c _) = c+{-# INLINE [0] unstream #-}++fuseStream :: Monad m+           => ConduitWithStream a b m ()+           -> ConduitWithStream b c m r+           -> ConduitWithStream a c m r+fuseStream (ConduitWithStream a x) (ConduitWithStream b y) =+  ConduitWithStream (a .| b) (y . x)+{-# INLINE fuseStream #-}++{-# RULES "conduit: fuseStream (.|)" forall left right.+        unstream left .| unstream right = unstream (fuseStream left right)+  #-}+{-# RULES "conduit: fuseStream (fuse)" forall left right.+        fuse (unstream left) (unstream right) = unstream (fuseStream left right)+  #-}+{-# RULES "conduit: fuseStream (=$=)" forall left right.+        unstream left =$= unstream right = unstream (fuseStream left right)+  #-}++runStream :: Monad m+          => ConduitWithStream () Void m r+          -> m r+runStream (ConduitWithStream _ f) =+    run $ f $ Stream emptyStep (return ())+  where+    emptyStep _ = return $ Stop ()+    run (Stream step ms0) =+        ms0 >>= loop+      where+        loop s = do+            res <- step s+            case res of+                Stop r -> return r+                Skip s' -> loop s'+                Emit _ o -> absurd o+{-# INLINE runStream #-}++{-# RULES "conduit: runStream" forall stream.+        runConduit (unstream stream) = runStream stream+  #-}+{-# RULES "conduit: runStream (pure)" forall stream.+        runConduitPure (unstream stream) = runIdentity (runStream stream)+  #-}+{-# RULES "conduit: runStream (ResourceT)" forall stream.+        runConduitRes (unstream stream) = runResourceT (runStream stream)+  #-}++connectStream :: Monad m+              => ConduitWithStream () i    m ()+              -> ConduitWithStream i  Void m r+              -> m r+connectStream (ConduitWithStream _ stream) (ConduitWithStream _ f) =+    run $ f $ stream $ Stream emptyStep (return ())+  where+    emptyStep _ = return $ Stop ()+    run (Stream step ms0) =+        ms0 >>= loop+      where+        loop s = do+            res <- step s+            case res of+                Stop r -> return r+                Skip s' -> loop s'+                Emit _ o -> absurd o+{-# INLINE connectStream #-}++{-# RULES "conduit: connectStream ($$)" forall left right.+        unstream left $$ unstream right = connectStream left right+  #-}++connectStream1 :: Monad m+               => ConduitWithStream () i    m ()+               -> ConduitT          i  Void m r+               -> m r+connectStream1 (ConduitWithStream _ fstream) (ConduitT sink0) =+    case fstream $ Stream (const $ return $ Stop ()) (return ()) of+        Stream step ms0 ->+            let loop _ (Done r) _ = return r+                loop ls (PipeM mp) s = mp >>= flip (loop ls) s+                loop ls (Leftover p l) s = loop (l:ls) p s+                loop _ (HaveOutput _ o) _ = absurd o+                loop (l:ls) (NeedInput p _) s = loop ls (p l) s+                loop [] (NeedInput p c) s = do+                    res <- step s+                    case res of+                        Stop () -> loop [] (c ()) s+                        Skip s' -> loop [] (NeedInput p c) s'+                        Emit s' i -> loop [] (p i) s'+             in ms0 >>= loop [] (sink0 Done)+{-# INLINE connectStream1 #-}++{-# RULES "conduit: connectStream1 ($$)" forall left right.+        unstream left $$ right = connectStream1 left right+  #-}++{-# RULES "conduit: connectStream1 (runConduit/.|)" forall left right.+        runConduit (unstream left .| right) = connectStream1 left right+  #-}+{-# RULES "conduit: connectStream1 (runConduit/=$=)" forall left right.+        runConduit (unstream left =$= right) = connectStream1 left right+  #-}+{-# RULES "conduit: connectStream1 (runConduit/fuse)" forall left right.+        runConduit (fuse (unstream left) right) = connectStream1 left right+  #-}++{-# RULES "conduit: connectStream1 (runConduitPure/.|)" forall left right.+        runConduitPure (unstream left .| right) = runIdentity (connectStream1 left right)+  #-}+{-# RULES "conduit: connectStream1 (runConduitPure/=$=)" forall left right.+        runConduitPure (unstream left =$= right) = runIdentity (connectStream1 left right)+  #-}+{-# RULES "conduit: connectStream1 (runConduitPure/fuse)" forall left right.+        runConduitPure (fuse (unstream left) right) = runIdentity (connectStream1 left right)+  #-}++{-# RULES "conduit: connectStream1 (runConduitRes/.|)" forall left right.+        runConduitRes (unstream left .| right) = runResourceT (connectStream1 left right)+  #-}+{-# RULES "conduit: connectStream1 (runConduitRes/=$=)" forall left right.+        runConduitRes (unstream left =$= right) = runResourceT (connectStream1 left right)+  #-}+{-# RULES "conduit: connectStream1 (runConduitRes/fuse)" forall left right.+        runConduitRes (fuse (unstream left) right) = runResourceT (connectStream1 left right)+  #-}++connectStream2 :: forall i m r. Monad m+               => ConduitT          () i    m ()+               -> ConduitWithStream i  Void m r+               -> m r+connectStream2 (ConduitT src0) (ConduitWithStream _ fstream) =+    run $ fstream $ Stream step' $ return (src0 Done)+  where+    step' :: Pipe () () i () m () -> m (Step (Pipe () () i () m ()) i ())+    step' (Done ()) = return $ Stop ()+    step' (HaveOutput pipe o) = return $ Emit pipe o+    step' (NeedInput _ c) = return $ Skip $ c ()+    step' (PipeM mp) = Skip <$> mp+    step' (Leftover p ()) = return $ Skip p+    {-# INLINE step' #-}++    run (Stream step ms0) =+        ms0 >>= loop+      where+        loop s = do+            res <- step s+            case res of+                Stop r -> return r+                Emit _ o -> absurd o+                Skip s' -> loop s'+{-# INLINE connectStream2 #-}++{-# RULES "conduit: connectStream2 ($$)" forall left right.+        left $$ unstream right = connectStream2 left right+  #-}++{-# RULES "conduit: connectStream2 (runConduit/.|)" forall left right.+        runConduit (left .| unstream right) = connectStream2 left right+  #-}+{-# RULES "conduit: connectStream2 (runConduit/fuse)" forall left right.+        runConduit (fuse left (unstream right)) = connectStream2 left right+  #-}+{-# RULES "conduit: connectStream2 (runConduit/=$=)" forall left right.+        runConduit (left =$= unstream right) = connectStream2 left right+  #-}++{-# RULES "conduit: connectStream2 (runConduitPure/.|)" forall left right.+        runConduitPure (left .| unstream right) = runIdentity (connectStream2 left right)+  #-}+{-# RULES "conduit: connectStream2 (runConduitPure/fuse)" forall left right.+        runConduitPure (fuse left (unstream right)) = runIdentity (connectStream2 left right)+  #-}+{-# RULES "conduit: connectStream2 (runConduitPure/=$=)" forall left right.+        runConduitPure (left =$= unstream right) = runIdentity (connectStream2 left right)+  #-}++{-# RULES "conduit: connectStream2 (runConduitRes/.|)" forall left right.+        runConduitRes (left .| unstream right) = runResourceT (connectStream2 left right)+  #-}+{-# RULES "conduit: connectStream2 (runConduitRes/fuse)" forall left right.+        runConduitRes (fuse left (unstream right)) = runResourceT (connectStream2 left right)+  #-}+{-# RULES "conduit: connectStream2 (runConduitRes/=$=)" forall left right.+        runConduitRes (left =$= unstream right) = runResourceT (connectStream2 left right)+  #-}++streamConduit :: ConduitT i o m r+              -> (Stream m i () -> Stream m o r)+              -> ConduitWithStream i o m r+streamConduit = ConduitWithStream+{-# INLINE CONLIKE streamConduit #-}++streamSource+    :: Monad m+    => Stream m o ()+    -> ConduitWithStream i o m ()+streamSource str@(Stream step ms0) =+    ConduitWithStream con (const str)+  where+    con = ConduitT $ \rest -> PipeM $ do+        s0 <- ms0+        let loop s = do+                res <- step s+                case res of+                    Stop () -> return $ rest ()+                    Emit s' o -> return $ HaveOutput (PipeM $ loop s') o+                    Skip s' -> loop s'+        loop s0+{-# INLINE streamSource #-}++streamSourcePure+    :: Monad m+    => Stream Identity o ()+    -> ConduitWithStream i o m ()+streamSourcePure (Stream step ms0) =+    ConduitWithStream con (const $ Stream (return . runIdentity . step) (return s0))+  where+    s0 = runIdentity ms0+    con = ConduitT $ \rest ->+        let loop s =+                case runIdentity $ step s of+                    Stop () -> rest ()+                    Emit s' o -> HaveOutput (loop s') o+                    Skip s' -> loop s'+         in loop s0+{-# INLINE streamSourcePure #-}
+ src/Data/Conduit/Internal/List/Stream.hs view
@@ -0,0 +1,502 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE Trustworthy #-}+module Data.Conduit.Internal.List.Stream where++import           Control.Monad (liftM)+import           Data.Conduit.Internal.Fusion+import qualified Data.Foldable as F++--FIXME: Should streamSource / streamSourcePure be used for sources?++unfoldS :: Monad m+        => (b -> Maybe (a, b))+        -> b+        -> StreamProducer m a+unfoldS f s0 _ =+    Stream step (return s0)+  where+    step s = return $+        case f s of+            Nothing -> Stop ()+            Just (x, s') -> Emit s' x+{-# INLINE unfoldS #-}++unfoldEitherS :: Monad m+              => (b -> Either r (a, b))+              -> b+              -> StreamConduitT i a m r+unfoldEitherS f s0 _ =+    Stream step (return s0)+  where+    step s = return $+        case f s of+            Left r        -> Stop r+            Right (x, s') -> Emit s' x+{-# INLINE unfoldEitherS #-}++unfoldMS :: Monad m+         => (b -> m (Maybe (a, b)))+         -> b+         -> StreamProducer m a+unfoldMS f s0 _ =+    Stream step (return s0)+  where+    step s = do+        ms' <- f s+        return $ case ms' of+            Nothing -> Stop ()+            Just (x, s') -> Emit s' x+{-# INLINE unfoldMS #-}++unfoldEitherMS :: Monad m+         => (b -> m (Either r (a, b)))+         -> b+         -> StreamConduitT i a m r+unfoldEitherMS f s0 _ =+    Stream step (return s0)+  where+    step s = do+        ms' <- f s+        return $ case ms' of+            Left r        -> Stop r+            Right (x, s') -> Emit s' x+{-# INLINE unfoldEitherMS #-}+sourceListS :: Monad m => [a] -> StreamProducer m a+sourceListS xs0 _ =+    Stream (return . step) (return xs0)+  where+    step [] = Stop ()+    step (x:xs) = Emit xs x+{-# INLINE sourceListS #-}++enumFromToS :: (Enum a, Prelude.Ord a, Monad m)+            => a+            -> a+            -> StreamProducer m a+enumFromToS x0 y _ =+    Stream step (return x0)+  where+    step x = return $ if x Prelude.> y+        then Stop ()+        else Emit (Prelude.succ x) x+{-# INLINE [0] enumFromToS #-}++enumFromToS_int :: (Prelude.Integral a, Monad m)+                => a+                -> a+                -> StreamProducer m a+enumFromToS_int x0 y _ = x0 `seq` y `seq` Stream step (return x0)+  where+    step x | x <= y    = return $ Emit (x Prelude.+ 1) x+           | otherwise = return $ Stop ()+{-# INLINE enumFromToS_int #-}++{-# RULES "conduit: enumFromTo<Int>" forall f t.+      enumFromToS f t = enumFromToS_int f t :: Monad m => StreamProducer m Int+  #-}++iterateS :: Monad m => (a -> a) -> a -> StreamProducer m a+iterateS f x0 _ =+    Stream (return . step) (return x0)+  where+    step x = Emit x' x+      where+        x' = f x+{-# INLINE iterateS #-}++replicateS :: Monad m => Int -> a -> StreamProducer m a+replicateS cnt0 a _ =+    Stream step (return cnt0)+  where+    step cnt+        | cnt <= 0  = return $ Stop ()+        | otherwise = return $ Emit (cnt - 1) a+{-# INLINE replicateS #-}++replicateMS :: Monad m => Int -> m a -> StreamProducer m a+replicateMS cnt0 ma _ =+    Stream step (return cnt0)+  where+    step cnt+        | cnt <= 0  = return $ Stop ()+        | otherwise = Emit (cnt - 1) `liftM` ma+{-# INLINE replicateMS #-}++foldS :: Monad m => (b -> a -> b) -> b -> StreamConsumer a m b+foldS f b0 (Stream step ms0) =+    Stream step' (liftM (b0, ) ms0)+  where+    step' (!b, s) = do+        res <- step s+        return $ case res of+            Stop () -> Stop b+            Skip s' -> Skip (b, s')+            Emit s' a -> Skip (f b a, s')+{-# INLINE foldS #-}++foldMS :: Monad m => (b -> a -> m b) -> b -> StreamConsumer a m b+foldMS f b0 (Stream step ms0) =+    Stream step' (liftM (b0, ) ms0)+  where+    step' (!b, s) = do+        res <- step s+        case res of+            Stop () -> return $ Stop b+            Skip s' -> return $ Skip (b, s')+            Emit s' a -> do+                b' <- f b a+                return $ Skip (b', s')+{-# INLINE foldMS #-}++mapM_S :: Monad m+       => (a -> m ())+       -> StreamConsumer a m ()+mapM_S f (Stream step ms0) =+    Stream step' ms0+  where+    step' s = do+        res <- step s+        case res of+          Stop () -> return $ Stop ()+          Skip s' -> return $ Skip s'+          Emit s' x -> f x >> return (Skip s')+{-# INLINE [1] mapM_S #-}++dropS :: Monad m+      => Int+      -> StreamConsumer a m ()+dropS n0 (Stream step ms0) =+    Stream step' (liftM (, n0) ms0)+  where+    step' (_, n) | n <= 0 = return $ Stop ()+    step' (s, n) = do+        res <- step s+        return $ case res of+            Stop () -> Stop ()+            Skip s' -> Skip (s', n)+            Emit s' _ -> Skip (s', n - 1)+{-# INLINE dropS #-}++takeS :: Monad m+      => Int+      -> StreamConsumer a m [a]+takeS n0 (Stream step s0) =+    Stream step' (liftM (id, n0,) s0)+  where+    step' (output, n, _) | n <= 0 = return $ Stop (output [])+    step' (output, n, s) = do+        res <- step s+        return $ case res of+            Stop () -> Stop (output [])+            Skip s' -> Skip (output, n, s')+            Emit s' x -> Skip (output . (x:), n - 1, s')+{-# INLINE takeS #-}++headS :: Monad m => StreamConsumer a m (Maybe a)+headS (Stream step s0) =+    Stream step' s0+  where+    step' s = do+        res <- step s+        return $ case res of+            Stop () -> Stop Nothing+            Skip s' -> Skip s'+            Emit _ x -> Stop (Just x)+{-# INLINE headS #-}++mapS :: Monad m => (a -> b) -> StreamConduit a m b+mapS f (Stream step ms0) =+    Stream step' ms0+  where+    step' s = do+        res <- step s+        return $ case res of+            Stop r -> Stop r+            Emit s' a -> Emit s' (f a)+            Skip s' -> Skip s'+{-# INLINE mapS #-}++mapMS :: Monad m => (a -> m b) -> StreamConduit a m b+mapMS f (Stream step ms0) =+    Stream step' ms0+  where+    step' s = do+        res <- step s+        case res of+            Stop r -> return $ Stop r+            Emit s' a -> Emit s' `liftM` f a+            Skip s' -> return $ Skip s'+{-# INLINE mapMS #-}++iterMS :: Monad m => (a -> m ()) -> StreamConduit a m a+iterMS f (Stream step ms0) =+    Stream step' ms0+  where+    step' s = do+        res <- step s+        case res of+            Stop () -> return $ Stop ()+            Skip s' -> return $ Skip s'+            Emit s' x -> f x >> return (Emit s' x)+{-# INLINE iterMS #-}++mapMaybeS :: Monad m => (a -> Maybe b) -> StreamConduit a m b+mapMaybeS f (Stream step ms0) =+    Stream step' ms0+  where+    step' s = do+        res <- step s+        return $ case res of+            Stop () -> Stop ()+            Skip s' -> Skip s'+            Emit s' x ->+                case f x of+                    Just y -> Emit s' y+                    Nothing -> Skip s'+{-# INLINE mapMaybeS #-}++mapMaybeMS :: Monad m => (a -> m (Maybe b)) -> StreamConduit a m b+mapMaybeMS f (Stream step ms0) =+    Stream step' ms0+  where+    step' s = do+        res <- step s+        case res of+            Stop () -> return $ Stop ()+            Skip s' -> return $ Skip s'+            Emit s' x -> do+                my <- f x+                case my of+                    Just y -> return $ Emit s' y+                    Nothing -> return $ Skip s'+{-# INLINE mapMaybeMS #-}++catMaybesS :: Monad m => StreamConduit (Maybe a) m a+catMaybesS (Stream step ms0) =+    Stream step' ms0+  where+    step' s = do+        res <- step s+        return $ case res of+            Stop () -> Stop ()+            Skip s' -> Skip s'+            Emit s' Nothing -> Skip s'+            Emit s' (Just x) -> Emit s' x+{-# INLINE catMaybesS #-}++concatS :: (Monad m, F.Foldable f) => StreamConduit (f a) m a+concatS (Stream step ms0) =+    Stream step' (liftM ([], ) ms0)+  where+    step' ([], s) = do+        res <- step s+        return $ case res of+            Stop () -> Stop ()+            Skip s' -> Skip ([], s')+            Emit s' x -> Skip (F.toList x, s')+    step' ((x:xs), s) = return (Emit (xs, s) x)+{-# INLINE concatS #-}++concatMapS :: Monad m => (a -> [b]) -> StreamConduit a m b+concatMapS f (Stream step ms0) =+    Stream step' (liftM ([], ) ms0)+  where+    step' ([], s) = do+        res <- step s+        return $ case res of+            Stop () -> Stop ()+            Skip s' -> Skip ([], s')+            Emit s' x -> Skip (f x, s')+    step' ((x:xs), s) = return (Emit (xs, s) x)+{-# INLINE concatMapS #-}++concatMapMS :: Monad m => (a -> m [b]) -> StreamConduit a m b+concatMapMS f (Stream step ms0) =+    Stream step' (liftM ([], ) ms0)+  where+    step' ([], s) = do+        res <- step s+        case res of+            Stop () -> return $ Stop ()+            Skip s' -> return $ Skip ([], s')+            Emit s' x -> do+                xs <- f x+                return $ Skip (xs, s')+    step' ((x:xs), s) = return (Emit (xs, s) x)+{-# INLINE concatMapMS #-}++concatMapAccumS :: Monad m => (a -> accum -> (accum, [b])) -> accum -> StreamConduit a m b+concatMapAccumS f  initial (Stream step ms0) =+    Stream step' (liftM (initial, [], ) ms0)+  where+    step' (accum, [], s) = do+        res <- step s+        return $ case res of+            Stop () -> Stop ()+            Skip s' -> Skip (accum, [], s')+            Emit s' x ->+                let (accum', xs) = f x accum+                in Skip (accum', xs, s')+    step' (accum, (x:xs), s) = return (Emit (accum, xs, s) x)+{-# INLINE concatMapAccumS #-}++mapAccumS :: Monad m => (a -> s -> (s, b)) -> s -> StreamConduitT a b m s+mapAccumS f initial (Stream step ms0) =+    Stream step' (liftM (initial, ) ms0)+  where+    step' (accum, s) = do+        res <- step s+        return $ case res of+            Stop () -> Stop accum+            Skip s' -> Skip (accum, s')+            Emit s' x ->+                let (accum', r) = f x accum+                in Emit (accum', s') r+{-# INLINE mapAccumS #-}++mapAccumMS :: Monad m => (a -> s -> m (s, b)) -> s -> StreamConduitT a b m s+mapAccumMS f initial (Stream step ms0) =+    Stream step' (liftM (initial, ) ms0)+  where+    step' (accum, s) = do+        res <- step s+        case res of+            Stop () -> return $ Stop accum+            Skip s' -> return $ Skip (accum, s')+            Emit s' x -> do+                (accum', r) <- f x accum+                return $ Emit (accum', s') r+{-# INLINE mapAccumMS #-}++concatMapAccumMS :: Monad m => (a -> accum -> m (accum, [b])) -> accum -> StreamConduit a m b+concatMapAccumMS f  initial (Stream step ms0) =+    Stream step' (liftM (initial, [], ) ms0)+  where+    step' (accum, [], s) = do+        res <- step s+        case res of+            Stop () -> return $ Stop ()+            Skip s' -> return $ Skip (accum, [], s')+            Emit s' x -> do+                (accum', xs) <- f x accum+                return $ Skip (accum', xs, s')+    step' (accum, (x:xs), s) = return (Emit (accum, xs, s) x)+{-# INLINE concatMapAccumMS #-}++mapFoldableS :: (Monad m, F.Foldable f) => (a -> f b) -> StreamConduit a m b+mapFoldableS f (Stream step ms0) =+    Stream step' (liftM ([], ) ms0)+  where+    step' ([], s) = do+        res <- step s+        return $ case res of+            Stop () -> Stop ()+            Skip s' -> Skip ([], s')+            Emit s' x -> Skip (F.toList (f x), s')+    step' ((x:xs), s) = return (Emit (xs, s) x)+{-# INLINE mapFoldableS #-}++mapFoldableMS :: (Monad m, F.Foldable f) => (a -> m (f b)) -> StreamConduit a m b+mapFoldableMS f (Stream step ms0) =+    Stream step' (liftM ([], ) ms0)+  where+    step' ([], s) = do+        res <- step s+        case res of+            Stop () -> return $ Stop ()+            Skip s' -> return $ Skip ([], s')+            Emit s' x -> do+                y <- f x+                return $ Skip (F.toList y, s')+    step' ((x:xs), s) = return (Emit (xs, s) x)+{-# INLINE mapFoldableMS #-}++consumeS :: Monad m => StreamConsumer a m [a]+consumeS (Stream step ms0) =+    Stream step' (liftM (id,) ms0)+  where+    step' (front, s) = do+        res <- step s+        return $ case res of+            Stop () -> Stop (front [])+            Skip s' -> Skip (front, s')+            Emit s' a -> Skip (front . (a:), s')+{-# INLINE consumeS #-}++groupByS :: Monad m => (a -> a -> Bool) -> StreamConduit a m [a]+groupByS f = mapS (Prelude.uncurry (:)) . groupBy1S id f+{-# INLINE groupByS #-}++groupOn1S :: (Monad m, Eq b) => (a -> b) -> StreamConduit a m (a, [a])+groupOn1S f = groupBy1S f (==)+{-# INLINE groupOn1S #-}++data GroupByState a b s+     = GBStart s+     | GBLoop ([a] -> [a]) a b s+     | GBDone++groupBy1S :: Monad m => (a -> b) -> (b -> b -> Bool) -> StreamConduit a m (a, [a])+groupBy1S f eq (Stream step ms0) =+    Stream step' (liftM GBStart ms0)+  where+    step' (GBStart s) = do+        res <- step s+        return $ case res of+            Stop () -> Stop ()+            Skip s' -> Skip (GBStart s')+            Emit s' x0 -> Skip (GBLoop id x0 (f x0) s')+    step' (GBLoop rest x0 fx0 s) = do+        res <- step s+        return $ case res of+            Stop () -> Emit GBDone (x0, rest [])+            Skip s' -> Skip (GBLoop rest x0 fx0 s')+            Emit s' x+                | fx0 `eq` f x -> Skip (GBLoop (rest . (x:)) x0 fx0 s')+                | otherwise -> Emit (GBLoop id x (f x) s') (x0, rest [])+    step' GBDone = return $ Stop ()+{-# INLINE groupBy1S #-}++isolateS :: Monad m => Int -> StreamConduit a m a+isolateS count (Stream step ms0) =+    Stream step' (liftM (count,) ms0)+  where+    step' (n, _) | n <= 0 = return $ Stop ()+    step' (n, s) = do+        res <- step s+        return $ case res of+            Stop () -> Stop ()+            Skip s' -> Skip (n, s')+            Emit s' x -> Emit (n - 1, s') x+{-# INLINE isolateS #-}++filterS :: Monad m => (a -> Bool) -> StreamConduit a m a+filterS f (Stream step ms0) =+    Stream step' ms0+  where+    step' s = do+        res <- step s+        return $ case res of+            Stop () -> Stop ()+            Skip s' -> Skip s'+            Emit s' x+                | f x -> Emit s' x+                | otherwise -> Skip s'++sinkNullS :: Monad m => StreamConsumer a m ()+sinkNullS (Stream step ms0) =+    Stream step' ms0+  where+    step' s = do+        res <- step s+        return $ case res of+            Stop () -> Stop ()+            Skip s' -> Skip s'+            Emit s' _ -> Skip s'+{-# INLINE sinkNullS #-}++sourceNullS :: Monad m => StreamProducer m a+sourceNullS _ = Stream (\_ -> return (Stop ())) (return ())+{-# INLINE sourceNullS #-}
+ src/Data/Conduit/Internal/Pipe.hs view
@@ -0,0 +1,619 @@+{-# OPTIONS_HADDOCK not-home #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE TypeFamilies #-}+module Data.Conduit.Internal.Pipe+    ( -- ** Types+      Pipe (..)+      -- ** Primitives+    , await+    , awaitE+    , awaitForever+    , yield+    , yieldM+    , leftover+    , unconsM+    , unconsEitherM+      -- ** Finalization+    , bracketP+      -- ** Composition+    , idP+    , pipe+    , pipeL+    , runPipe+    , injectLeftovers+    , (>+>)+    , (<+<)+      -- ** Exceptions+    , catchP+    , handleP+    , tryP+      -- ** Utilities+    , transPipe+    , mapOutput+    , mapOutputMaybe+    , mapInput+    , sourceList+    , withUpstream+    , Data.Conduit.Internal.Pipe.enumFromTo+    , generalizeUpstream+    ) where++import Control.Applicative (Applicative (..))+import Control.Monad ((>=>), liftM, ap)+import Control.Monad.Error.Class(MonadError(..))+import Control.Monad.Reader.Class(MonadReader(..))+import Control.Monad.RWS.Class(MonadRWS())+import Control.Monad.Writer.Class(MonadWriter(..))+import Control.Monad.State.Class(MonadState(..))+import Control.Monad.Trans.Class (MonadTrans (lift))+import Control.Monad.IO.Unlift (MonadIO (liftIO), MonadUnliftIO, withRunInIO)+import Control.Monad.Primitive (PrimMonad, PrimState, primitive)+import Data.Void (Void, absurd)+import Data.Monoid (Monoid (mappend, mempty))+import Data.Semigroup (Semigroup ((<>)))+import Control.Monad.Trans.Resource+import qualified GHC.Exts+import qualified Control.Exception as E++-- | The underlying datatype for all the types in this package.  In has six+-- type parameters:+--+-- * /l/ is the type of values that may be left over from this @Pipe@. A @Pipe@+-- with no leftovers would use @Void@ here, and one with leftovers would use+-- the same type as the /i/ parameter. Leftovers are automatically provided to+-- the next @Pipe@ in the monadic chain.+--+-- * /i/ is the type of values for this @Pipe@'s input stream.+--+-- * /o/ is the type of values for this @Pipe@'s output stream.+--+-- * /u/ is the result type from the upstream @Pipe@.+--+-- * /m/ is the underlying monad.+--+-- * /r/ is the result type.+--+-- A basic intuition is that every @Pipe@ produces a stream of output values+-- (/o/), and eventually indicates that this stream is terminated by sending a+-- result (/r/). On the receiving end of a @Pipe@, these become the /i/ and /u/+-- parameters.+--+-- Since 0.5.0+data Pipe l i o u m r =+    -- | Provide new output to be sent downstream. This constructor has two+    -- fields: the next @Pipe@ to be used and the output value.+    HaveOutput (Pipe l i o u m r) o+    -- | Request more input from upstream. The first field takes a new input+    -- value and provides a new @Pipe@. The second takes an upstream result+    -- value, which indicates that upstream is producing no more results.+  | NeedInput (i -> Pipe l i o u m r) (u -> Pipe l i o u m r)+    -- | Processing with this @Pipe@ is complete, providing the final result.+  | Done r+    -- | Require running of a monadic action to get the next @Pipe@.+  | PipeM (m (Pipe l i o u m r))+    -- | Return leftover input, which should be provided to future operations.+  | Leftover (Pipe l i o u m r) l++instance Monad m => Functor (Pipe l i o u m) where+    fmap = liftM+    {-# INLINE fmap #-}++instance Monad m => Applicative (Pipe l i o u m) where+    pure = Done+    {-# INLINE pure #-}+    (<*>) = ap+    {-# INLINE (<*>) #-}++instance Monad m => Monad (Pipe l i o u m) where+    return = pure+    {-# INLINE return #-}++    HaveOutput p o   >>= fp = HaveOutput (p >>= fp)            o+    NeedInput p c    >>= fp = NeedInput  (p >=> fp)            (c >=> fp)+    Done x           >>= fp = fp x+    PipeM mp         >>= fp = PipeM      ((>>= fp) `liftM` mp)+    Leftover p i     >>= fp = Leftover   (p >>= fp)            i++instance MonadTrans (Pipe l i o u) where+    lift mr = PipeM (Done `liftM` mr)+    {-# INLINE [1] lift #-}++instance MonadIO m => MonadIO (Pipe l i o u m) where+    liftIO = lift . liftIO+    {-# INLINE liftIO #-}++instance MonadThrow m => MonadThrow (Pipe l i o u m) where+    throwM = lift . throwM+    {-# INLINE throwM #-}+++instance Monad m => Semigroup (Pipe l i o u m ()) where+    (<>) = (>>)+    {-# INLINE (<>) #-}++instance Monad m => Monoid (Pipe l i o u m ()) where+    mempty = return ()+    {-# INLINE mempty #-}+#if !(MIN_VERSION_base(4,11,0))+    mappend = (<>)+    {-# INLINE mappend #-}+#endif++instance PrimMonad m => PrimMonad (Pipe l i o u m) where+  type PrimState (Pipe l i o u m) = PrimState m+  primitive = lift . primitive++instance MonadResource m => MonadResource (Pipe l i o u m) where+    liftResourceT = lift . liftResourceT+    {-# INLINE liftResourceT #-}++instance MonadReader r m => MonadReader r (Pipe l i o u m) where+    ask = lift ask+    {-# INLINE ask #-}+    local f (HaveOutput p o) = HaveOutput (local f p) o+    local f (NeedInput p c) = NeedInput (\i -> local f (p i)) (\u -> local f (c u))+    local _ (Done x) = Done x+    local f (PipeM mp) = PipeM (liftM (local f) $ local f mp)+    local f (Leftover p i) = Leftover (local f p) i++-- Provided for doctest+#ifndef MIN_VERSION_mtl+#define MIN_VERSION_mtl(x, y, z) 0+#endif++instance MonadWriter w m => MonadWriter w (Pipe l i o u m) where+#if MIN_VERSION_mtl(2, 1, 0)+    writer = lift . writer+#endif++    tell = lift . tell++    listen (HaveOutput p o) = HaveOutput (listen p) o+    listen (NeedInput p c) = NeedInput (\i -> listen (p i)) (\u -> listen (c u))+    listen (Done x) = Done (x,mempty)+    listen (PipeM mp) =+      PipeM $+      do (p,w) <- listen mp+         return $ do (x,w') <- listen p+                     return (x, w `mappend` w')+    listen (Leftover p i) = Leftover (listen p) i++    pass (HaveOutput p o) = HaveOutput (pass p) o+    pass (NeedInput p c) = NeedInput (\i -> pass (p i)) (\u -> pass (c u))+    pass (PipeM mp) = PipeM $ mp >>= (return . pass)+    pass (Done (x,_)) = Done x+    pass (Leftover p i) = Leftover (pass p) i++instance MonadState s m => MonadState s (Pipe l i o u m) where+    get = lift get+    put = lift . put+#if MIN_VERSION_mtl(2, 1, 0)+    state = lift . state+#endif++instance MonadRWS r w s m => MonadRWS r w s (Pipe l i o u m)++instance MonadError e m => MonadError e (Pipe l i o u m) where+    throwError = lift . throwError+    catchError (HaveOutput p o) f = HaveOutput (catchError p f) o+    catchError (NeedInput p c) f = NeedInput (\i -> catchError (p i) f) (\u -> catchError (c u) f)+    catchError (Done x) _ = Done x+    catchError (PipeM mp) f =+      PipeM $ catchError (liftM (flip catchError f) mp) (\e -> return (f e))+    catchError (Leftover p i) f = Leftover (catchError p f) i++-- | Wait for a single input value from upstream.+--+-- Since 0.5.0+await :: Pipe l i o u m (Maybe i)+await = NeedInput (Done . Just) (\_ -> Done Nothing)+{-# RULES "conduit: CI.await >>= maybe" forall x y. await >>= maybe x y = NeedInput y (const x) #-}+{-# INLINE [1] await #-}++-- | This is similar to @await@, but will return the upstream result value as+-- @Left@ if available.+--+-- Since 0.5.0+awaitE :: Pipe l i o u m (Either u i)+awaitE = NeedInput (Done . Right) (Done . Left)+{-# RULES "conduit: awaitE >>= either" forall x y. awaitE >>= either x y = NeedInput y x #-}+{-# INLINE [1] awaitE #-}++-- | Wait for input forever, calling the given inner @Pipe@ for each piece of+-- new input. Returns the upstream result type.+--+-- Since 0.5.0+awaitForever :: Monad m => (i -> Pipe l i o r m r') -> Pipe l i o r m r+awaitForever inner =+    self+  where+    self = awaitE >>= either return (\i -> inner i >> self)+{-# INLINE [1] awaitForever #-}++-- | Send a single output value downstream. If the downstream @Pipe@+-- terminates, this @Pipe@ will terminate as well.+--+-- Since 0.5.0+yield :: Monad m+      => o -- ^ output value+      -> Pipe l i o u m ()+yield = HaveOutput (Done ())+{-# INLINE [1] yield #-}++yieldM :: Monad m => m o -> Pipe l i o u m ()+yieldM = PipeM . liftM (HaveOutput (Done ()))+{-# INLINE [1] yieldM #-}++{-# RULES+    "CI.yield o >> p" forall o (p :: Pipe l i o u m r). yield o >> p = HaveOutput p o+  #-}++  -- Rule does not fire due to inlining of lift+  -- ; "lift m >>= CI.yield" forall m. lift m >>= yield = yieldM m++  -- FIXME: Too much inlining on mapM_, can't enforce; "mapM_ CI.yield" mapM_ yield = sourceList+  -- Maybe we can get a rewrite rule on foldr instead? Need a benchmark to back this up.++-- | Provide a single piece of leftover input to be consumed by the next pipe+-- in the current monadic binding.+--+-- /Note/: it is highly encouraged to only return leftover values from input+-- already consumed from upstream.+--+-- Since 0.5.0+leftover :: l -> Pipe l i o u m ()+leftover = Leftover (Done ())+{-# INLINE [1] leftover #-}+{-# RULES "conduit: leftover l >> p" forall l (p :: Pipe l i o u m r). leftover l >> p = Leftover p l #-}++-- | Split a pipe into head and tail.+--+-- Since 1.3.3+unconsM :: Monad m+        => Pipe Void () o () m ()+        -> m (Maybe (o, Pipe Void () o () m ()))+unconsM = go+  where+    go (HaveOutput p o) = pure $ Just (o, p)+    go (NeedInput _ c) = go $ c ()+    go (Done ()) = pure Nothing+    go (PipeM mp) = mp >>= go+    go (Leftover _ i) = absurd i++-- | Split a pipe into head and tail or return its result if it is done.+--+-- Since 1.3.3+unconsEitherM :: Monad m+              => Pipe Void () o () m r+              -> m (Either r (o, Pipe Void () o () m r))+unconsEitherM = go+  where+    go (HaveOutput p o) = pure $ Right (o, p)+    go (NeedInput _ c) = go $ c ()+    go (Done r) = pure $ Left r+    go (PipeM mp) = mp >>= go+    go (Leftover _ i) = absurd i++-- | Bracket a pipe computation between allocation and release of a resource.+-- We guarantee, via the @MonadResource@ context, that the resource+-- finalization is exception safe. However, it will not necessarily be+-- /prompt/, in that running a finalizer may wait until the @ResourceT@ block+-- exits.+--+-- Since 0.5.0+bracketP :: MonadResource m+         => IO a+            -- ^ computation to run first (\"acquire resource\")+         -> (a -> IO ())+            -- ^ computation to run last (\"release resource\")+         -> (a -> Pipe l i o u m r)+            -- ^ computation to run in-between+         -> Pipe l i o u m r+            -- returns the value from the in-between computation+bracketP alloc free inside = do+  (key, seed) <- allocate alloc free+  res <- inside seed+  release key+  return res++-- | The identity @Pipe@.+--+-- Since 0.5.0+idP :: Monad m => Pipe l a a r m r+idP = NeedInput (HaveOutput idP) Done++-- | Compose a left and right pipe together into a complete pipe.+--+-- Since 0.5.0+pipe :: Monad m => Pipe l a b r0 m r1 -> Pipe Void b c r1 m r2 -> Pipe l a c r0 m r2+pipe =+    goRight+  where+    goRight left right =+        case right of+            HaveOutput p o   -> HaveOutput (recurse p) o+            NeedInput rp rc  -> goLeft rp rc left+            Done r2          -> Done r2+            PipeM mp         -> PipeM (liftM recurse mp)+            Leftover _ i     -> absurd i+      where+        recurse = goRight left++    goLeft rp rc left =+        case left of+            HaveOutput left' o        -> goRight left' (rp o)+            NeedInput left' lc        -> NeedInput (recurse . left') (recurse . lc)+            Done r1                   -> goRight (Done r1) (rc r1)+            PipeM mp                  -> PipeM (liftM recurse mp)+            Leftover left' i          -> Leftover (recurse left') i+      where+        recurse = goLeft rp rc++-- | Same as 'pipe', but automatically applies 'injectLeftovers' to the right @Pipe@.+--+-- Since 0.5.0+pipeL :: Monad m => Pipe l a b r0 m r1 -> Pipe b b c r1 m r2 -> Pipe l a c r0 m r2+-- Note: The following should be equivalent to the simpler:+--+--     pipeL l r = l `pipe` injectLeftovers r+--+-- However, this version tested as being significantly more efficient.+pipeL =+    goRight+  where+    goRight left right =+        case right of+            HaveOutput p o    -> HaveOutput (recurse p) o+            NeedInput rp rc   -> goLeft rp rc left+            Done r2           -> Done r2+            PipeM mp          -> PipeM (liftM recurse mp)+            Leftover right' i -> goRight (HaveOutput left i) right'+      where+        recurse = goRight left++    goLeft rp rc left =+        case left of+            HaveOutput left' o        -> goRight left' (rp o)+            NeedInput left' lc        -> NeedInput (recurse . left') (recurse . lc)+            Done r1                   -> goRight (Done r1) (rc r1)+            PipeM mp                  -> PipeM (liftM recurse mp)+            Leftover left' i          -> Leftover (recurse left') i+      where+        recurse = goLeft rp rc++-- | Run a pipeline until processing completes.+--+-- Since 0.5.0+runPipe :: Monad m => Pipe Void () Void () m r -> m r+runPipe (HaveOutput _ o) = absurd o+runPipe (NeedInput _ c) = runPipe (c ())+runPipe (Done r) = return r+runPipe (PipeM mp) = mp >>= runPipe+runPipe (Leftover _ i) = absurd i++-- | Transforms a @Pipe@ that provides leftovers to one which does not,+-- allowing it to be composed.+--+-- This function will provide any leftover values within this @Pipe@ to any+-- calls to @await@. If there are more leftover values than are demanded, the+-- remainder are discarded.+--+-- Since 0.5.0+injectLeftovers :: Monad m => Pipe i i o u m r -> Pipe l i o u m r+injectLeftovers =+    go []+  where+    go ls (HaveOutput p o) = HaveOutput (go ls p) o+    go (l:ls) (NeedInput p _) = go ls $ p l+    go [] (NeedInput p c) = NeedInput (go [] . p) (go [] . c)+    go _ (Done r) = Done r+    go ls (PipeM mp) = PipeM (liftM (go ls) mp)+    go ls (Leftover p l) = go (l:ls) p++-- | Transform the monad that a @Pipe@ lives in.+--+-- Note that the monad transforming function will be run multiple times,+-- resulting in unintuitive behavior in some cases. For a fuller treatment,+-- please see:+--+-- <https://github.com/snoyberg/conduit/wiki/Dealing-with-monad-transformers>+--+-- This function is just a synonym for 'hoist'.+--+-- Since 0.4.0+transPipe :: Monad m => (forall a. m a -> n a) -> Pipe l i o u m r -> Pipe l i o u n r+transPipe f (HaveOutput p o) = HaveOutput (transPipe f p) o+transPipe f (NeedInput p c) = NeedInput (transPipe f . p) (transPipe f . c)+transPipe _ (Done r) = Done r+transPipe f (PipeM mp) =+    PipeM (f $ liftM (transPipe f) $ collapse mp)+  where+    -- Combine a series of monadic actions into a single action.  Since we+    -- throw away side effects between different actions, an arbitrary break+    -- between actions will lead to a violation of the monad transformer laws.+    -- Example available at:+    --+    -- http://hpaste.org/75520+    collapse mpipe = do+        pipe' <- mpipe+        case pipe' of+            PipeM mpipe' -> collapse mpipe'+            _ -> return pipe'+transPipe f (Leftover p i) = Leftover (transPipe f p) i++-- | Apply a function to all the output values of a @Pipe@.+--+-- This mimics the behavior of `fmap` for a `Source` and `Conduit` in pre-0.4+-- days.+--+-- Since 0.4.1+mapOutput :: Monad m => (o1 -> o2) -> Pipe l i o1 u m r -> Pipe l i o2 u m r+mapOutput f =+    go+  where+    go (HaveOutput p o) = HaveOutput (go p) (f o)+    go (NeedInput p c) = NeedInput (go . p) (go . c)+    go (Done r) = Done r+    go (PipeM mp) = PipeM (liftM (go) mp)+    go (Leftover p i) = Leftover (go p) i+{-# INLINE mapOutput #-}++-- | Same as 'mapOutput', but use a function that returns @Maybe@ values.+--+-- Since 0.5.0+mapOutputMaybe :: Monad m => (o1 -> Maybe o2) -> Pipe l i o1 u m r -> Pipe l i o2 u m r+mapOutputMaybe f =+    go+  where+    go (HaveOutput p o) = maybe id (\o' p' -> HaveOutput p' o') (f o) (go p)+    go (NeedInput p c) = NeedInput (go . p) (go . c)+    go (Done r) = Done r+    go (PipeM mp) = PipeM (liftM (go) mp)+    go (Leftover p i) = Leftover (go p) i+{-# INLINE mapOutputMaybe #-}++-- | Apply a function to all the input values of a @Pipe@.+--+-- Since 0.5.0+mapInput :: Monad m+         => (i1 -> i2) -- ^ map initial input to new input+         -> (l2 -> Maybe l1) -- ^ map new leftovers to initial leftovers+         -> Pipe l2 i2 o u m r+         -> Pipe l1 i1 o u m r+mapInput f f' (HaveOutput p o) = HaveOutput (mapInput f f' p) o+mapInput f f' (NeedInput p c)    = NeedInput (mapInput f f' . p . f) (mapInput f f' . c)+mapInput _ _  (Done r)           = Done r+mapInput f f' (PipeM mp)         = PipeM (liftM (mapInput f f') mp)+mapInput f f' (Leftover p i)     = maybe id (flip Leftover) (f' i) $ mapInput f f' p++enumFromTo :: (Enum o, Eq o, Monad m)+           => o+           -> o+           -> Pipe l i o u m ()+enumFromTo start stop =+    loop start+  where+    loop i+        | i == stop = HaveOutput (Done ()) i+        | otherwise = HaveOutput (loop (succ i)) i+{-# INLINE enumFromTo #-}++-- | Convert a list into a source.+--+-- Since 0.3.0+sourceList :: Monad m => [a] -> Pipe l i a u m ()+sourceList =+    go+  where+    go [] = Done ()+    go (o:os) = HaveOutput (go os) o+{-# INLINE [1] sourceList #-}++-- | The equivalent of @GHC.Exts.build@ for @Pipe@.+--+-- Since 0.4.2+build :: Monad m => (forall b. (o -> b -> b) -> b -> b) -> Pipe l i o u m ()+build g = g (\o p -> HaveOutput p o) (return ())++{-# RULES+    "sourceList/build" forall (f :: (forall b. (a -> b -> b) -> b -> b)). sourceList (GHC.Exts.build f) = build f #-}++-- | Returns a tuple of the upstream and downstream results. Note that this+-- will force consumption of the entire input stream.+--+-- Since 0.5.0+withUpstream :: Monad m+             => Pipe l i o u m r+             -> Pipe l i o u m (u, r)+withUpstream down =+    down >>= go+  where+    go r =+        loop+      where+        loop = awaitE >>= either (\u -> return (u, r)) (\_ -> loop)++infixr 9 <+<+infixl 9 >+>++-- | Fuse together two @Pipe@s, connecting the output from the left to the+-- input of the right.+--+-- Notice that the /leftover/ parameter for the @Pipe@s must be @Void@. This+-- ensures that there is no accidental data loss of leftovers during fusion. If+-- you have a @Pipe@ with leftovers, you must first call 'injectLeftovers'.+--+-- Since 0.5.0+(>+>) :: Monad m => Pipe l a b r0 m r1 -> Pipe Void b c r1 m r2 -> Pipe l a c r0 m r2+(>+>) = pipe+{-# INLINE (>+>) #-}++-- | Same as '>+>', but reverse the order of the arguments.+--+-- Since 0.5.0+(<+<) :: Monad m => Pipe Void b c r1 m r2 -> Pipe l a b r0 m r1 -> Pipe l a c r0 m r2+(<+<) = flip pipe+{-# INLINE (<+<) #-}++-- | See 'catchC' for more details.+--+-- Since 1.0.11+catchP :: (MonadUnliftIO m, E.Exception e)+       => Pipe l i o u m r+       -> (e -> Pipe l i o u m r)+       -> Pipe l i o u m r+catchP p0 onErr =+    go p0+  where+    go (Done r) = Done r+    go (PipeM mp) = PipeM $ withRunInIO $ \run ->+      E.catch (run (liftM go mp)) (return . onErr)+    go (Leftover p i) = Leftover (go p) i+    go (NeedInput x y) = NeedInput (go . x) (go . y)+    go (HaveOutput p o) = HaveOutput (go p) o+{-# INLINABLE catchP #-}++-- | The same as @flip catchP@.+--+-- Since 1.0.11+handleP :: (MonadUnliftIO m, E.Exception e)+        => (e -> Pipe l i o u m r)+        -> Pipe l i o u m r+        -> Pipe l i o u m r+handleP = flip catchP+{-# INLINE handleP #-}++-- | See 'tryC' for more details.+--+-- Since 1.0.11+tryP :: (MonadUnliftIO m, E.Exception e)+     => Pipe l i o u m r+     -> Pipe l i o u m (Either e r)+tryP p = (fmap Right p) `catchP` (return . Left)+{-# INLINABLE tryP #-}++-- | Generalize the upstream return value for a @Pipe@ from unit to any type.+--+-- Since 1.1.5+generalizeUpstream :: Monad m => Pipe l i o () m r -> Pipe l i o u m r+generalizeUpstream =+    go+  where+    go (HaveOutput p o) = HaveOutput (go p) o+    go (NeedInput x y) = NeedInput (go . x) (\_ -> go (y ()))+    go (Done r) = Done r+    go (PipeM mp) = PipeM (liftM go mp)+    go (Leftover p l) = Leftover (go p) l+{-# INLINE generalizeUpstream #-}++{- Rules don't fire due to inlining of lift+{-# RULES "conduit: Pipe: lift x >>= f" forall m f. lift m >>= f = PipeM (liftM f m) #-}+{-# RULES "conduit: Pipe: lift x >> f" forall m f. lift m >> f = PipeM (liftM (\_ -> f) m) #-}+-}
+ src/Data/Conduit/Lift.hs view
@@ -0,0 +1,518 @@+{-# LANGUAGE RankNTypes #-}+-- | Allow monad transformers to be run\/eval\/exec in a section of conduit+-- rather then needing to run across the whole conduit.  The circumvents many+-- of the problems with breaking the monad transformer laws.  For more+-- information, see the announcement blog post:+-- <http://www.yesodweb.com/blog/2014/01/conduit-transformer-exception>+--+-- This module was added in conduit 1.0.11.+module Data.Conduit.Lift (+    -- * ExceptT+    exceptC,+    runExceptC,+    catchExceptC,++    -- * CatchC+    runCatchC,+    catchCatchC,++    -- * MaybeT+    maybeC,+    runMaybeC,++    -- * ReaderT+    readerC,+    runReaderC,++    -- * StateT, lazy+    stateLC,+    runStateLC,+    evalStateLC,+    execStateLC,++    -- ** Strict+    stateC,+    runStateC,+    evalStateC,+    execStateC,++    -- * WriterT, lazy+    writerLC,+    runWriterLC,+    execWriterLC,++    -- ** Strict+    writerC,+    runWriterC,+    execWriterC,++    -- * RWST, lazy+    rwsLC,+    runRWSLC,+    evalRWSLC,+    execRWSLC,++    -- ** Strict+    rwsC,+    runRWSC,+    evalRWSC,+    execRWSC+    ) where++import Data.Conduit+import Data.Conduit.Internal (ConduitT (..), Pipe (..))++import Control.Monad.Trans.Class (MonadTrans(..))++import Data.Monoid (Monoid(..))+++import qualified Control.Monad.Trans.Except as Ex+import qualified Control.Monad.Trans.Maybe as M+import qualified Control.Monad.Trans.Reader as R++import qualified Control.Monad.Trans.State.Strict as SS+import qualified Control.Monad.Trans.Writer.Strict as WS+import qualified Control.Monad.Trans.RWS.Strict as RWSS++import qualified Control.Monad.Trans.State.Lazy as SL+import qualified Control.Monad.Trans.Writer.Lazy as WL+import qualified Control.Monad.Trans.RWS.Lazy as RWSL++import Control.Monad.Catch.Pure (CatchT (runCatchT))+import Control.Exception (SomeException)++-- | Wrap the base monad in 'Ex.ExceptT'+--+-- Since 1.2.12+exceptC+  :: Monad m =>+     ConduitT i o m (Either e a) -> ConduitT i o (Ex.ExceptT e m) a+exceptC p = do+    x <- transPipe lift p+    lift $ Ex.ExceptT (return x)++-- | Run 'Ex.ExceptT' in the base monad+--+-- Since 1.2.12+runExceptC+  :: Monad m =>+     ConduitT i o (Ex.ExceptT e m) r -> ConduitT i o m (Either e r)+runExceptC (ConduitT c0) =+    ConduitT $ \rest ->+        let go (Done r) = rest (Right r)+            go (PipeM mp) = PipeM $ do+                eres <- Ex.runExceptT mp+                return $ case eres of+                    Left e -> rest $ Left e+                    Right p -> go p+            go (Leftover p i) = Leftover (go p) i+            go (HaveOutput p o) = HaveOutput (go p) o+            go (NeedInput x y) = NeedInput (go . x) (go . y)+         in go (c0 Done)+{-# INLINABLE runExceptC #-}++-- | Catch an error in the base monad+--+-- Since 1.2.12+catchExceptC+  :: Monad m =>+     ConduitT i o (Ex.ExceptT e m) r+     -> (e -> ConduitT i o (Ex.ExceptT e m) r)+     -> ConduitT i o (Ex.ExceptT e m) r+catchExceptC c0 h =+    ConduitT $ \rest ->+        let go (Done r) = rest r+            go (PipeM mp) = PipeM $ do+                eres <- lift $ Ex.runExceptT mp+                return $ case eres of+                    Left e -> unConduitT (h e) rest+                    Right p -> go p+            go (Leftover p i) = Leftover (go p) i+            go (HaveOutput p o) = HaveOutput (go p) o+            go (NeedInput x y) = NeedInput (go . x) (go . y)+         in go $ unConduitT c0 Done+  where+{-# INLINABLE catchExceptC #-}++-- | Run 'CatchT' in the base monad+--+-- Since 1.1.0+runCatchC+  :: Monad m =>+     ConduitT i o (CatchT m) r -> ConduitT i o m (Either SomeException r)+runCatchC c0 =+    ConduitT $ \rest ->+        let go (Done r) = rest (Right r)+            go (PipeM mp) = PipeM $ do+                eres <- runCatchT mp+                return $ case eres of+                    Left e -> rest $ Left e+                    Right p -> go p+            go (Leftover p i) = Leftover (go p) i+            go (HaveOutput p o) = HaveOutput (go p) o+            go (NeedInput x y) = NeedInput (go . x) (go . y)+         in go $ unConduitT c0 Done+{-# INLINABLE runCatchC #-}++-- | Catch an exception in the base monad+--+-- Since 1.1.0+catchCatchC+  :: Monad m+  => ConduitT i o (CatchT m) r+  -> (SomeException -> ConduitT i o (CatchT m) r)+  -> ConduitT i o (CatchT m) r+catchCatchC (ConduitT c0) h =+    ConduitT $ \rest ->+        let go (Done r) = rest r+            go (PipeM mp) = PipeM $ do+                eres <- lift $ runCatchT mp+                return $ case eres of+                    Left e -> unConduitT (h e) rest+                    Right p -> go p+            go (Leftover p i) = Leftover (go p) i+            go (HaveOutput p o) = HaveOutput (go p) o+            go (NeedInput x y) = NeedInput (go . x) (go . y)+         in go (c0 Done)+{-# INLINABLE catchCatchC #-}++-- | Wrap the base monad in 'M.MaybeT'+--+-- Since 1.0.11+maybeC+  :: Monad m =>+     ConduitT i o m (Maybe a) -> ConduitT i o (M.MaybeT m) a+maybeC p = do+    x <- transPipe lift p+    lift $ M.MaybeT (return x)+{-# INLINABLE maybeC #-}++-- | Run 'M.MaybeT' in the base monad+--+-- Since 1.0.11+runMaybeC+  :: Monad m =>+     ConduitT i o (M.MaybeT m) r -> ConduitT i o m (Maybe r)+runMaybeC (ConduitT c0) =+    ConduitT $ \rest ->+        let go (Done r) = rest (Just r)+            go (PipeM mp) = PipeM $ do+                mres <- M.runMaybeT mp+                return $ case mres of+                    Nothing -> rest Nothing+                    Just p -> go p+            go (Leftover p i) = Leftover (go p) i+            go (HaveOutput p o) = HaveOutput (go p) o+            go (NeedInput x y) = NeedInput (go . x) (go . y)+         in go (c0 Done)+{-# INLINABLE runMaybeC #-}++-- | Wrap the base monad in 'R.ReaderT'+--+-- Since 1.0.11+readerC+  :: Monad m =>+     (r -> ConduitT i o m a) -> ConduitT i o (R.ReaderT r m) a+readerC k = do+    i <- lift R.ask+    transPipe lift (k i)+{-# INLINABLE readerC #-}++-- | Run 'R.ReaderT' in the base monad+--+-- Since 1.0.11+runReaderC+  :: Monad m =>+     r -> ConduitT i o (R.ReaderT r m) res -> ConduitT i o m res+runReaderC r = transPipe (`R.runReaderT` r)+{-# INLINABLE runReaderC #-}+++-- | Wrap the base monad in 'SL.StateT'+--+-- Since 1.0.11+stateLC+  :: Monad m =>+     (s -> ConduitT i o m (a, s)) -> ConduitT i o (SL.StateT s m) a+stateLC k = do+    s <- lift SL.get+    (r, s') <- transPipe lift (k s)+    lift (SL.put s')+    return r+{-# INLINABLE stateLC #-}++thread :: Monad m+       => (r -> s -> res)+       -> (forall a. t m a -> s -> m (a, s))+       -> s+       -> ConduitT i o (t m) r+       -> ConduitT i o m res+thread toRes runM s0 (ConduitT c0) =+    ConduitT $ \rest ->+        let go s (Done r) = rest (toRes r s)+            go s (PipeM mp) = PipeM $ do+                (p, s') <- runM mp s+                return $ go s' p+            go s (Leftover p i) = Leftover (go s p) i+            go s (NeedInput x y) = NeedInput (go s . x) (go s . y)+            go s (HaveOutput p o) = HaveOutput (go s p) o+         in go s0 (c0 Done)+{-# INLINABLE thread #-}++-- | Run 'SL.StateT' in the base monad+--+-- Since 1.0.11+runStateLC+  :: Monad m =>+     s -> ConduitT i o (SL.StateT s m) r -> ConduitT i o m (r, s)+runStateLC = thread (,) SL.runStateT+{-# INLINABLE runStateLC #-}++-- | Evaluate 'SL.StateT' in the base monad+--+-- Since 1.0.11+evalStateLC+  :: Monad m =>+     s -> ConduitT i o (SL.StateT s m) r -> ConduitT i o m r+evalStateLC s p = fmap fst $ runStateLC s p+{-# INLINABLE evalStateLC #-}++-- | Execute 'SL.StateT' in the base monad+--+-- Since 1.0.11+execStateLC+  :: Monad m =>+     s -> ConduitT i o (SL.StateT s m) r -> ConduitT i o m s+execStateLC s p = fmap snd $ runStateLC s p+{-# INLINABLE execStateLC #-}+++-- | Wrap the base monad in 'SS.StateT'+--+-- Since 1.0.11+stateC+  :: Monad m =>+     (s -> ConduitT i o m (a, s)) -> ConduitT i o (SS.StateT s m) a+stateC k = do+    s <- lift SS.get+    (r, s') <- transPipe lift (k s)+    lift (SS.put s')+    return r+{-# INLINABLE stateC #-}++-- | Run 'SS.StateT' in the base monad+--+-- Since 1.0.11+runStateC+  :: Monad m =>+     s -> ConduitT i o (SS.StateT s m) r -> ConduitT i o m (r, s)+runStateC = thread (,) SS.runStateT+{-# INLINABLE runStateC #-}++-- | Evaluate 'SS.StateT' in the base monad+--+-- Since 1.0.11+evalStateC+  :: Monad m =>+     s -> ConduitT i o (SS.StateT s m) r -> ConduitT i o m r+evalStateC s p = fmap fst $ runStateC s p+{-# INLINABLE evalStateC #-}++-- | Execute 'SS.StateT' in the base monad+--+-- Since 1.0.11+execStateC+  :: Monad m =>+     s -> ConduitT i o (SS.StateT s m) r -> ConduitT i o m s+execStateC s p = fmap snd $ runStateC s p+{-# INLINABLE execStateC #-}+++-- | Wrap the base monad in 'WL.WriterT'+--+-- Since 1.0.11+writerLC+  :: (Monad m, Monoid w) =>+     ConduitT i o m (b, w) -> ConduitT i o (WL.WriterT w m) b+writerLC p = do+    (r, w) <- transPipe lift p+    lift $ WL.tell w+    return r+{-# INLINABLE writerLC #-}++-- | Run 'WL.WriterT' in the base monad+--+-- Since 1.0.11+runWriterLC+  :: (Monad m, Monoid w) =>+     ConduitT i o (WL.WriterT w m) r -> ConduitT i o m (r, w)+runWriterLC = thread (,) run mempty+  where+    run m w = do+        (a, w') <- WL.runWriterT m+        return (a, w `mappend` w')+{-# INLINABLE runWriterLC #-}++-- | Execute 'WL.WriterT' in the base monad+--+-- Since 1.0.11+execWriterLC+  :: (Monad m, Monoid w) =>+     ConduitT i o (WL.WriterT w m) r -> ConduitT i o m w+execWriterLC p = fmap snd $ runWriterLC p+{-# INLINABLE execWriterLC #-}+++-- | Wrap the base monad in 'WS.WriterT'+--+-- Since 1.0.11+writerC+  :: (Monad m, Monoid w) =>+     ConduitT i o m (b, w) -> ConduitT i o (WS.WriterT w m) b+writerC p = do+    (r, w) <- transPipe lift p+    lift $ WS.tell w+    return r+{-# INLINABLE writerC #-}++-- | Run 'WS.WriterT' in the base monad+--+-- Since 1.0.11+runWriterC+  :: (Monad m, Monoid w) =>+     ConduitT i o (WS.WriterT w m) r -> ConduitT i o m (r, w)+runWriterC = thread (,) run mempty+  where+    run m w = do+        (a, w') <- WS.runWriterT m+        return (a, w `mappend` w')+{-# INLINABLE runWriterC #-}++-- | Execute 'WS.WriterT' in the base monad+--+-- Since 1.0.11+execWriterC+  :: (Monad m, Monoid w) =>+     ConduitT i o (WS.WriterT w m) r -> ConduitT i o m w+execWriterC p = fmap snd $ runWriterC p+{-# INLINABLE execWriterC #-}+++-- | Wrap the base monad in 'RWSL.RWST'+--+-- Since 1.0.11+rwsLC+  :: (Monad m, Monoid w) =>+     (r -> s -> ConduitT i o m (a, s, w)) -> ConduitT i o (RWSL.RWST r w s m) a+rwsLC k = do+    i <- lift RWSL.ask+    s <- lift RWSL.get+    (r, s', w) <- transPipe lift (k i s)+    lift $ do+        RWSL.put s'+        RWSL.tell w+    return r+{-# INLINABLE rwsLC #-}++-- | Run 'RWSL.RWST' in the base monad+--+-- Since 1.0.11+runRWSLC+  :: (Monad m, Monoid w) =>+     r+     -> s+     -> ConduitT i o (RWSL.RWST r w s m) res+     -> ConduitT i o m (res, s, w)+runRWSLC r s0 = thread toRes run (s0, mempty)+  where+    toRes a (s, w) = (a, s, w)+    run m (s, w) = do+        (res, s', w') <- RWSL.runRWST m r s+        return (res, (s', w `mappend` w'))+{-# INLINABLE runRWSLC #-}++-- | Evaluate 'RWSL.RWST' in the base monad+--+-- Since 1.0.11+evalRWSLC+  :: (Monad m, Monoid w) =>+     r+     -> s+     -> ConduitT i o (RWSL.RWST r w s m) res+     -> ConduitT i o m (res, w)+evalRWSLC i s p = fmap f $ runRWSLC i s p+  where f x = let (r, _, w) = x in (r, w)+{-# INLINABLE evalRWSLC #-}++-- | Execute 'RWSL.RWST' in the base monad+--+-- Since 1.0.11+execRWSLC+  :: (Monad m, Monoid w) =>+     r+     -> s+     -> ConduitT i o (RWSL.RWST r w s m) res+     -> ConduitT i o m (s, w)+execRWSLC i s p = fmap f $ runRWSLC i s p+  where f x = let (_, s2, w2) = x in (s2, w2)+{-# INLINABLE execRWSLC #-}++-- | Wrap the base monad in 'RWSS.RWST'+--+-- Since 1.0.11+rwsC+  :: (Monad m, Monoid w) =>+     (r -> s -> ConduitT i o m (a, s, w)) -> ConduitT i o (RWSS.RWST r w s m) a+rwsC k = do+    i <- lift RWSS.ask+    s <- lift RWSS.get+    (r, s', w) <- transPipe lift (k i s)+    lift $ do+        RWSS.put s'+        RWSS.tell w+    return r+{-# INLINABLE rwsC #-}++-- | Run 'RWSS.RWST' in the base monad+--+-- Since 1.0.11+runRWSC+  :: (Monad m, Monoid w) =>+     r+     -> s+     -> ConduitT i o (RWSS.RWST r w s m) res+     -> ConduitT i o m (res, s, w)+runRWSC r s0 = thread toRes run (s0, mempty)+  where+    toRes a (s, w) = (a, s, w)+    run m (s, w) = do+        (res, s', w') <- RWSS.runRWST m r s+        return (res, (s', w `mappend` w'))+{-# INLINABLE runRWSC #-}++-- | Evaluate 'RWSS.RWST' in the base monad+--+-- Since 1.0.11+evalRWSC+  :: (Monad m, Monoid w) =>+     r+     -> s+     -> ConduitT i o (RWSS.RWST r w s m) res+     -> ConduitT i o m (res, w)+evalRWSC i s p = fmap f $ runRWSC i s p+  where f x = let (r, _, w) = x in (r, w)+{-# INLINABLE evalRWSC #-}++-- | Execute 'RWSS.RWST' in the base monad+--+-- Since 1.0.11+execRWSC+  :: (Monad m, Monoid w) =>+     r+     -> s+     -> ConduitT i o (RWSS.RWST r w s m) res+     -> ConduitT i o m (s, w)+execRWSC i s p = fmap f $ runRWSC i s p+  where f x = let (_, s2, w2) = x in (s2, w2)+{-# INLINABLE execRWSC #-}
+ src/Data/Conduit/List.hs view
@@ -0,0 +1,883 @@+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE Trustworthy #-}+-- | /NOTE/ It is recommended to start using "Data.Conduit.Combinators" instead+-- of this module.+--+-- Higher-level functions to interact with the elements of a stream. Most of+-- these are based on list functions.+--+-- Note that these functions all deal with individual elements of a stream as a+-- sort of \"black box\", where there is no introspection of the contained+-- elements. Values such as @ByteString@ and @Text@ will likely need to be+-- treated specially to deal with their contents properly (@Word8@ and @Char@,+-- respectively). See the @Data.Conduit.Binary@ and @Data.Conduit.Text@+-- modules in the @conduit-extra@ package.+module Data.Conduit.List+    ( -- * Sources+      sourceList+    , sourceNull+    , unfold+    , unfoldEither+    , unfoldM+    , unfoldEitherM+    , enumFromTo+    , iterate+    , replicate+    , replicateM+      -- * Sinks+      -- ** Pure+    , fold+    , foldMap+    , uncons+    , unconsEither+    , take+    , drop+    , head+    , peek+    , consume+    , sinkNull+      -- ** Monadic+    , foldMapM+    , foldM+    , unconsM+    , unconsEitherM+    , mapM_+      -- * Conduits+      -- ** Pure+    , map+    , mapMaybe+    , mapFoldable+    , catMaybes+    , concat+    , concatMap+    , concatMapAccum+    , scanl+    , scan+    , mapAccum+    , chunksOf+    , groupBy+    , groupOn1+#if MIN_VERSION_base(4,9,0)+    , groupOn+#endif+    , isolate+    , filter+      -- ** Monadic+    , mapM+    , iterM+    , scanlM+    , scanM+    , mapAccumM+    , mapMaybeM+    , mapFoldableM+    , concatMapM+    , concatMapAccumM+      -- * Misc+    , sequence+    ) where++import qualified Prelude+import Prelude+    ( ($), return, (==), (-), Int+    , (.), id, Maybe (..), Monad+    , Either (..)+    , Bool (..)+    , (>>)+    , (>>=)+    , seq+    , otherwise+    , Enum, Eq+    , maybe+    , (<=)+    , (>)+    , error+    , (++)+    , show+    )+import Data.Monoid (Monoid, mempty, mappend)+import qualified Data.Foldable as F+#if MIN_VERSION_base(4,9,0)+import Data.List.NonEmpty (NonEmpty ((:|)))+#endif+import Data.Conduit+import Data.Conduit.Internal.Conduit (unconsM, unconsEitherM)+import Data.Conduit.Internal.Fusion+import Data.Conduit.Internal.List.Stream+import qualified Data.Conduit.Internal as CI+import Data.Functor.Identity (Identity (runIdentity))+import Control.Monad (when, (<=<), liftM, void)+import Control.Monad.Trans.Class (lift)++-- Defines INLINE_RULE0, INLINE_RULE, STREAMING0, and STREAMING.+#include "fusion-macros.h"++-- | Generate a source from a seed value.+--+-- Subject to fusion+--+-- Since 0.4.2+unfold, unfoldC :: Monad m+                => (b -> Maybe (a, b))+                -> b+                -> ConduitT i a m ()+unfoldC f =+    go+  where+    go seed =+        case f seed of+            Just (a, seed') -> yield a >> go seed'+            Nothing -> return ()+{-# INLINE unfoldC #-}+STREAMING(unfold, unfoldC, unfoldS, f x)++-- | Generate a source from a seed value with a return value.+--+-- Subject to fusion+--+-- @since 1.2.11+unfoldEither, unfoldEitherC :: Monad m+                            => (b -> Either r (a, b))+                            -> b+                            -> ConduitT i a m r+unfoldEitherC f =+    go+  where+    go seed =+        case f seed of+            Right (a, seed') -> yield a >> go seed'+            Left r -> return r+{-# INLINE unfoldEitherC #-}+STREAMING(unfoldEither, unfoldEitherC, unfoldEitherS, f x)++-- | A monadic unfold.+--+-- Subject to fusion+--+-- Since 1.1.2+unfoldM, unfoldMC :: Monad m+                  => (b -> m (Maybe (a, b)))+                  -> b+                  -> ConduitT i a m ()+unfoldMC f =+    go+  where+    go seed = do+        mres <- lift $ f seed+        case mres of+            Just (a, seed') -> yield a >> go seed'+            Nothing -> return ()+STREAMING(unfoldM, unfoldMC, unfoldMS, f seed)++-- | A monadic unfoldEither.+--+-- Subject to fusion+--+-- @since 1.2.11+unfoldEitherM, unfoldEitherMC :: Monad m+                              => (b -> m (Either r (a, b)))+                              -> b+                              -> ConduitT i a m r+unfoldEitherMC f =+    go+  where+    go seed = do+        mres <- lift $ f seed+        case mres of+            Right (a, seed') -> yield a >> go seed'+            Left r -> return r+STREAMING(unfoldEitherM, unfoldEitherMC, unfoldEitherMS, f seed)++-- | Split a pure conduit into head and tail.+-- This is equivalent to @runIdentity . unconsM@.+--+-- Note that you have to 'sealConduitT' it first.+--+-- Since 1.3.3+uncons :: SealedConduitT () o Identity ()+       -> Maybe (o, SealedConduitT () o Identity ())+uncons = runIdentity . unconsM++-- | Split a pure conduit into head and tail or return its result if it is done.+-- This is equivalent to @runIdentity . unconsEitherM@.+--+-- Note that you have to 'sealConduitT' it first.+--+-- Since 1.3.3+unconsEither :: SealedConduitT () o Identity r+             -> Either r (o, SealedConduitT () o Identity r)+unconsEither = runIdentity . unconsEitherM++-- | Yield the values from the list.+--+-- Subject to fusion+sourceList, sourceListC :: Monad m => [a] -> ConduitT i a m ()+sourceListC = Prelude.mapM_ yield+{-# INLINE sourceListC #-}+STREAMING(sourceList, sourceListC, sourceListS, xs)++-- | Enumerate from a value to a final value, inclusive, via 'succ'.+--+-- This is generally more efficient than using @Prelude@\'s @enumFromTo@ and+-- combining with @sourceList@ since this avoids any intermediate data+-- structures.+--+-- Subject to fusion+--+-- Since 0.4.2+enumFromTo, enumFromToC :: (Enum a, Prelude.Ord a, Monad m)+                        => a+                        -> a+                        -> ConduitT i a m ()+enumFromToC x0 y =+    loop x0+  where+    loop x+        | x Prelude.> y = return ()+        | otherwise = yield x >> loop (Prelude.succ x)+{-# INLINE enumFromToC #-}+STREAMING(enumFromTo, enumFromToC, enumFromToS, x0 y)++-- | Produces an infinite stream of repeated applications of f to x.+--+-- Subject to fusion+--+iterate, iterateC :: Monad m => (a -> a) -> a -> ConduitT i a m ()+iterateC f =+    go+  where+    go a = yield a >> go (f a)+{-# INLINE iterateC #-}+STREAMING(iterate, iterateC, iterateS, f a)++-- | Replicate a single value the given number of times.+--+-- Subject to fusion+--+-- Since 1.2.0+replicate, replicateC :: Monad m => Int -> a -> ConduitT i a m ()+replicateC cnt0 a =+    loop cnt0+  where+    loop i+        | i <= 0 = return ()+        | otherwise = yield a >> loop (i - 1)+{-# INLINE replicateC #-}+STREAMING(replicate, replicateC, replicateS, cnt0 a)++-- | Replicate a monadic value the given number of times.+--+-- Subject to fusion+--+-- Since 1.2.0+replicateM, replicateMC :: Monad m => Int -> m a -> ConduitT i a m ()+replicateMC cnt0 ma =+    loop cnt0+  where+    loop i+        | i <= 0 = return ()+        | otherwise = lift ma >>= yield >> loop (i - 1)+{-# INLINE replicateMC #-}+STREAMING(replicateM, replicateMC, replicateMS, cnt0 ma)++-- | A strict left fold.+--+-- Subject to fusion+--+-- Since 0.3.0+fold, foldC :: Monad m+            => (b -> a -> b)+            -> b+            -> ConduitT a o m b+foldC f =+    loop+  where+    loop !accum = await >>= maybe (return accum) (loop . f accum)+{-# INLINE foldC #-}+STREAMING(fold, foldC, foldS, f accum)++-- | A monadic strict left fold.+--+-- Subject to fusion+--+-- Since 0.3.0+foldM, foldMC :: Monad m+              => (b -> a -> m b)+              -> b+              -> ConduitT a o m b+foldMC f =+    loop+  where+    loop accum = do+        await >>= maybe (return accum) go+      where+        go a = do+            accum' <- lift $ f accum a+            accum' `seq` loop accum'+{-# INLINE foldMC #-}+STREAMING(foldM, foldMC, foldMS, f accum)++-----------------------------------------------------------------+-- These are for cases where- for whatever reason- stream fusion cannot be+-- applied.+connectFold :: Monad m => ConduitT () a m () -> (b -> a -> b) -> b -> m b+connectFold (CI.ConduitT src0) f =+    go (src0 CI.Done)+  where+    go (CI.Done ()) b = return b+    go (CI.HaveOutput src a) b = go src Prelude.$! f b a+    go (CI.NeedInput _ c) b = go (c ()) b+    go (CI.Leftover src ()) b = go src b+    go (CI.PipeM msrc) b = do+        src <- msrc+        go src b+{-# INLINE connectFold #-}+{-# RULES "conduit: $$ fold" forall src f b. runConduit (src .| fold f b) = connectFold src f b #-}++connectFoldM :: Monad m => ConduitT () a m () -> (b -> a -> m b) -> b -> m b+connectFoldM (CI.ConduitT src0) f =+    go (src0 CI.Done)+  where+    go (CI.Done ()) b = return b+    go (CI.HaveOutput src a) b = do+        !b' <- f b a+        go src b'+    go (CI.NeedInput _ c) b = go (c ()) b+    go (CI.Leftover src ()) b = go src b+    go (CI.PipeM msrc) b = do+        src <- msrc+        go src b+{-# INLINE connectFoldM #-}+{-# RULES "conduit: $$ foldM" forall src f b. runConduit (src .| foldM f b) = connectFoldM src f b #-}+-----------------------------------------------------------------++-- | A monoidal strict left fold.+--+-- Subject to fusion+--+-- Since 0.5.3+foldMap :: (Monad m, Monoid b)+        => (a -> b)+        -> ConduitT a o m b+INLINE_RULE(foldMap, f, let combiner accum = mappend accum . f in fold combiner mempty)++-- | A monoidal strict left fold in a Monad.+--+-- Since 1.0.8+foldMapM :: (Monad m, Monoid b)+        => (a -> m b)+        -> ConduitT a o m b+INLINE_RULE(foldMapM, f, let combiner accum = liftM (mappend accum) . f in foldM combiner mempty)++-- | Apply the action to all values in the stream.+--+-- Subject to fusion+--+-- Since 0.3.0+mapM_, mapM_C :: Monad m+              => (a -> m ())+              -> ConduitT a o m ()+mapM_C f = awaitForever $ lift . f+{-# INLINE mapM_C #-}+STREAMING(mapM_, mapM_C, mapM_S, f)++srcMapM_ :: Monad m => ConduitT () a m () -> (a -> m ()) -> m ()+srcMapM_ (CI.ConduitT src) f =+    go (src CI.Done)+  where+    go (CI.Done ()) = return ()+    go (CI.PipeM mp) = mp >>= go+    go (CI.Leftover p ()) = go p+    go (CI.HaveOutput p o) = f o >> go p+    go (CI.NeedInput _ c) = go (c ())+{-# INLINE srcMapM_ #-}+{-# RULES "conduit: connect to mapM_" [2] forall f src. runConduit (src .| mapM_ f) = srcMapM_ src f #-}++-- | Ignore a certain number of values in the stream. This function is+-- semantically equivalent to:+--+-- > drop i = take i >> return ()+--+-- However, @drop@ is more efficient as it does not need to hold values in+-- memory.+--+-- Subject to fusion+--+-- Since 0.3.0+drop, dropC :: Monad m+            => Int+            -> ConduitT a o m ()+dropC =+    loop+  where+    loop i | i <= 0 = return ()+    loop count = await >>= maybe (return ()) (\_ -> loop (count - 1))+{-# INLINE dropC #-}+STREAMING(drop, dropC, dropS, i)++-- | Take some values from the stream and return as a list. If you want to+-- instead create a conduit that pipes data to another sink, see 'isolate'.+-- This function is semantically equivalent to:+--+-- > take i = isolate i =$ consume+--+-- Subject to fusion+--+-- Since 0.3.0+take, takeC :: Monad m+            => Int+            -> ConduitT a o m [a]+takeC =+    loop id+  where+    loop front count | count <= 0 = return $ front []+    loop front count = await >>= maybe+        (return $ front [])+        (\x -> loop (front . (x:)) (count - 1))+{-# INLINE takeC #-}+STREAMING(take, takeC, takeS, i)++-- | Take a single value from the stream, if available.+--+-- Subject to fusion+--+-- Since 0.3.0+head, headC :: Monad m => ConduitT a o m (Maybe a)+headC = await+{-# INLINE headC #-}+STREAMING0(head, headC, headS)++-- | Look at the next value in the stream, if available. This function will not+-- change the state of the stream.+--+-- Since 0.3.0+peek :: Monad m => ConduitT a o m (Maybe a)+peek = await >>= maybe (return Nothing) (\x -> leftover x >> return (Just x))++-- | Apply a transformation to all values in a stream.+--+-- Subject to fusion+--+-- Since 0.3.0+map, mapC :: Monad m => (a -> b) -> ConduitT a b m ()+mapC f = awaitForever $ yield . f+{-# INLINE mapC #-}+STREAMING(map, mapC, mapS, f)++-- Since a Source never has any leftovers, fusion rules on it are safe.+{-+{-# RULES "conduit: source/map fusion .|" forall f src. src .| map f = mapFuseRight src f #-}++mapFuseRight :: Monad m => ConduitT () a m () -> (a -> b) -> ConduitT () b m ()+mapFuseRight src f = CIC.mapOutput f src+{-# INLINE mapFuseRight #-}+-}++{-++It might be nice to include these rewrite rules, but they may have subtle+differences based on leftovers.++{-# RULES "conduit: map-to-mapOutput pipeL" forall f src. pipeL src (map f) = mapOutput f src #-}+{-# RULES "conduit: map-to-mapOutput $=" forall f src. src $= (map f) = mapOutput f src #-}+{-# RULES "conduit: map-to-mapOutput pipe" forall f src. pipe src (map f) = mapOutput f src #-}+{-# RULES "conduit: map-to-mapOutput >+>" forall f src. src >+> (map f) = mapOutput f src #-}++{-# RULES "conduit: map-to-mapInput pipeL" forall f sink. pipeL (map f) sink = mapInput f (Prelude.const Prelude.Nothing) sink #-}+{-# RULES "conduit: map-to-mapInput =$" forall f sink. map f =$ sink = mapInput f (Prelude.const Prelude.Nothing) sink #-}+{-# RULES "conduit: map-to-mapInput pipe" forall f sink. pipe (map f) sink = mapInput f (Prelude.const Prelude.Nothing) sink #-}+{-# RULES "conduit: map-to-mapInput >+>" forall f sink. map f >+> sink = mapInput f (Prelude.const Prelude.Nothing) sink #-}++{-# RULES "conduit: map-to-mapOutput .|" forall f con. con .| map f = mapOutput f con #-}+{-# RULES "conduit: map-to-mapInput .|" forall f con. map f .| con = mapInput f (Prelude.const Prelude.Nothing) con #-}++{-# INLINE [1] map #-}++-}++-- | Apply a monadic transformation to all values in a stream.+--+-- If you do not need the transformed values, and instead just want the monadic+-- side-effects of running the action, see 'mapM_'.+--+-- Subject to fusion+--+-- Since 0.3.0+mapM, mapMC :: Monad m => (a -> m b) -> ConduitT a b m ()+mapMC f = awaitForever $ \a -> lift (f a) >>= yield+{-# INLINE mapMC #-}+STREAMING(mapM, mapMC, mapMS, f)++-- | Apply a monadic action on all values in a stream.+--+-- This @Conduit@ can be used to perform a monadic side-effect for every+-- value, whilst passing the value through the @Conduit@ as-is.+--+-- > iterM f = mapM (\a -> f a >>= \() -> return a)+--+-- Subject to fusion+--+-- Since 0.5.6+iterM, iterMC :: Monad m => (a -> m ()) -> ConduitT a a m ()+iterMC f = awaitForever $ \a -> lift (f a) >> yield a+{-# INLINE iterMC #-}+STREAMING(iterM, iterMC, iterMS, f)++-- | Apply a transformation that may fail to all values in a stream, discarding+-- the failures.+--+-- Subject to fusion+--+-- Since 0.5.1+mapMaybe, mapMaybeC :: Monad m => (a -> Maybe b) -> ConduitT a b m ()+mapMaybeC f = awaitForever $ maybe (return ()) yield . f+{-# INLINE mapMaybeC #-}+STREAMING(mapMaybe, mapMaybeC, mapMaybeS, f)++-- | Apply a monadic transformation that may fail to all values in a stream,+-- discarding the failures.+--+-- Subject to fusion+--+-- Since 0.5.1+mapMaybeM, mapMaybeMC :: Monad m => (a -> m (Maybe b)) -> ConduitT a b m ()+mapMaybeMC f = awaitForever $ maybe (return ()) yield <=< lift . f+{-# INLINE mapMaybeMC #-}+STREAMING(mapMaybeM, mapMaybeMC, mapMaybeMS, f)++-- | Filter the @Just@ values from a stream, discarding the @Nothing@  values.+--+-- Subject to fusion+--+-- Since 0.5.1+catMaybes, catMaybesC :: Monad m => ConduitT (Maybe a) a m ()+catMaybesC = awaitForever $ maybe (return ()) yield+{-# INLINE catMaybesC #-}+STREAMING0(catMaybes, catMaybesC, catMaybesS)++-- | Generalization of 'catMaybes'. It puts all values from+--   'F.Foldable' into stream.+--+-- Subject to fusion+--+-- Since 1.0.6+concat, concatC :: (Monad m, F.Foldable f) => ConduitT (f a) a m ()+concatC = awaitForever $ F.mapM_ yield+{-# INLINE concatC #-}+STREAMING0(concat, concatC, concatS)++-- | Apply a transformation to all values in a stream, concatenating the output+-- values.+--+-- Subject to fusion+--+-- Since 0.3.0+concatMap, concatMapC :: Monad m => (a -> [b]) -> ConduitT a b m ()+concatMapC f = awaitForever $ sourceList . f+{-# INLINE concatMapC #-}+STREAMING(concatMap, concatMapC, concatMapS, f)++-- | Apply a monadic transformation to all values in a stream, concatenating+-- the output values.+--+-- Subject to fusion+--+-- Since 0.3.0+concatMapM, concatMapMC :: Monad m => (a -> m [b]) -> ConduitT a b m ()+concatMapMC f = awaitForever $ sourceList <=< lift . f+{-# INLINE concatMapMC #-}+STREAMING(concatMapM, concatMapMC, concatMapMS, f)++-- | 'concatMap' with a strict accumulator.+--+-- Subject to fusion+--+-- Since 0.3.0+concatMapAccum, concatMapAccumC :: Monad m => (a -> accum -> (accum, [b])) -> accum -> ConduitT a b m ()+concatMapAccumC f x0 = void (mapAccum f x0) .| concat+{-# INLINE concatMapAccumC #-}+STREAMING(concatMapAccum, concatMapAccumC, concatMapAccumS, f x0)++-- | Deprecated synonym for @mapAccum@+--+-- Since 1.0.6+scanl :: Monad m => (a -> s -> (s, b)) -> s -> ConduitT a b m ()+scanl f s = void $ mapAccum f s+{-# DEPRECATED scanl "Use mapAccum instead" #-}++-- | Deprecated synonym for @mapAccumM@+--+-- Since 1.0.6+scanlM :: Monad m => (a -> s -> m (s, b)) -> s -> ConduitT a b m ()+scanlM f s = void $ mapAccumM f s+{-# DEPRECATED scanlM "Use mapAccumM instead" #-}++-- | Analog of @mapAccumL@ for lists. Note that in contrast to @mapAccumL@, the function argument+--   takes the accumulator as its second argument, not its first argument, and the accumulated value+--   is strict.+--+-- Subject to fusion+--+-- Since 1.1.1+mapAccum, mapAccumC :: Monad m => (a -> s -> (s, b)) -> s -> ConduitT a b m s+mapAccumC f =+    loop+  where+    loop !s = await >>= maybe (return s) go+      where+        go a = case f a s of+                 (s', b) -> yield b >> loop s'+STREAMING(mapAccum, mapAccumC, mapAccumS, f s)++-- | Monadic `mapAccum`.+--+-- Subject to fusion+--+-- Since 1.1.1+mapAccumM, mapAccumMC :: Monad m => (a -> s -> m (s, b)) -> s -> ConduitT a b m s+mapAccumMC f =+    loop+  where+    loop !s = await >>= maybe (return s) go+      where+        go a = do (s', b) <- lift $ f a s+                  yield b+                  loop s'+{-# INLINE mapAccumMC #-}+STREAMING(mapAccumM, mapAccumMC, mapAccumMS, f s)++-- | Analog of 'Prelude.scanl' for lists.+--+-- Subject to fusion+--+-- Since 1.1.1+scan :: Monad m => (a -> b -> b) -> b -> ConduitT a b m b+INLINE_RULE(scan, f, mapAccum (\a b -> let r = f a b in (r, r)))++-- | Monadic @scanl@.+--+-- Subject to fusion+--+-- Since 1.1.1+scanM :: Monad m => (a -> b -> m b) -> b -> ConduitT a b m b+INLINE_RULE(scanM, f, mapAccumM (\a b -> f a b >>= \r -> return (r, r)))++-- | 'concatMapM' with a strict accumulator.+--+-- Subject to fusion+--+-- Since 0.3.0+concatMapAccumM, concatMapAccumMC :: Monad m => (a -> accum -> m (accum, [b])) -> accum -> ConduitT a b m ()+concatMapAccumMC f x0 = void (mapAccumM f x0) .| concat+{-# INLINE concatMapAccumMC #-}+STREAMING(concatMapAccumM, concatMapAccumMC, concatMapAccumMS, f x0)++-- | Generalization of 'mapMaybe' and 'concatMap'. It applies function+-- to all values in a stream and send values inside resulting+-- 'Foldable' downstream.+--+-- Subject to fusion+--+-- Since 1.0.6+mapFoldable, mapFoldableC :: (Monad m, F.Foldable f) => (a -> f b) -> ConduitT a b m ()+mapFoldableC f = awaitForever $ F.mapM_ yield . f+{-# INLINE mapFoldableC #-}+STREAMING(mapFoldable, mapFoldableC, mapFoldableS, f)++-- | Monadic variant of 'mapFoldable'.+--+-- Subject to fusion+--+-- Since 1.0.6+mapFoldableM, mapFoldableMC :: (Monad m, F.Foldable f) => (a -> m (f b)) -> ConduitT a b m ()+mapFoldableMC f = awaitForever $ F.mapM_ yield <=< lift . f+{-# INLINE mapFoldableMC #-}+STREAMING(mapFoldableM, mapFoldableMC, mapFoldableMS, f)++-- | Consume all values from the stream and return as a list. Note that this+-- will pull all values into memory.+--+-- Subject to fusion+--+-- Since 0.3.0+consume, consumeC :: Monad m => ConduitT a o m [a]+consumeC =+    loop id+  where+    loop front = await >>= maybe (return $ front []) (\x -> loop $ front . (x:))+{-# INLINE consumeC #-}+STREAMING0(consume, consumeC, consumeS)++-- | Group a stream into chunks of a given size. The last chunk may contain+-- fewer than n elements.+--+-- Subject to fusion+--+-- Since 1.2.9+chunksOf :: Monad m => Int -> ConduitT a [a] m ()+chunksOf n = if n > 0 then loop n id else error $ "chunksOf size must be positive (given " ++ show n ++ ")"+  where+    loop 0 rest = yield (rest []) >> loop n id+    loop count rest = await >>= \ma -> case ma of+      Nothing -> case rest [] of+        [] -> return ()+        nonempty -> yield nonempty+      Just a -> loop (count - 1) (rest . (a :))++-- | Grouping input according to an equality function.+--+-- Subject to fusion+--+-- Since 0.3.0+groupBy, groupByC :: Monad m => (a -> a -> Bool) -> ConduitT a [a] m ()+groupByC f =+    start+  where+    start = await >>= maybe (return ()) (loop id)++    loop rest x =+        await >>= maybe (yield (x : rest [])) go+      where+        go y+            | f x y     = loop (rest . (y:)) x+            | otherwise = yield (x : rest []) >> loop id y+STREAMING(groupBy, groupByC, groupByS, f)++-- | 'groupOn1' is similar to @groupBy id@+--+-- returns a pair, indicating there are always 1 or more items in the grouping.+-- This is designed to be converted into a NonEmpty structure+-- but it avoids a dependency on another package+--+-- > import Data.List.NonEmpty+-- >+-- > groupOn1 :: (Monad m, Eq b) => (a -> b) -> Conduit a m (NonEmpty a)+-- > groupOn1 f = CL.groupOn1 f .| CL.map (uncurry (:|))+--+-- Subject to fusion+--+-- Since 1.1.7+groupOn1, groupOn1C :: (Monad m, Eq b)+                     => (a -> b)+                     -> ConduitT a (a, [a]) m ()+groupOn1C f =+    start+  where+    start = await >>= maybe (return ()) (loop id)++    loop rest x =+        await >>= maybe (yield (x, rest [])) go+      where+        go y+            | f x == f y = loop (rest . (y:)) x+            | otherwise  = yield (x, rest []) >> loop id y+STREAMING(groupOn1, groupOn1C, groupOn1S, f)++#if MIN_VERSION_base(4,9,0)+-- | Like 'groupOn1', but returning a 'NonEmpty' structure.+--+-- @since 1.3.5+groupOn :: (Monad m, Eq b)+        => (a -> b)+        -> ConduitT a (NonEmpty a) m ()+groupOn f = groupOn1 f .| map (Prelude.uncurry (:|))+#endif++-- | Ensure that the inner sink consumes no more than the given number of+-- values. Note this this does /not/ ensure that the sink consumes all of those+-- values. To get the latter behavior, combine with 'sinkNull', e.g.:+--+-- > src $$ do+-- >     x <- isolate count =$ do+-- >         x <- someSink+-- >         sinkNull+-- >         return x+-- >     someOtherSink+-- >     ...+--+-- Subject to fusion+--+-- Since 0.3.0+isolate, isolateC :: Monad m => Int -> ConduitT a a m ()+isolateC =+    loop+  where+    loop count | count <= 0 = return ()+    loop count = await >>= maybe (return ()) (\x -> yield x >> loop (count - 1))+STREAMING(isolate, isolateC, isolateS, count)++-- | Keep only values in the stream passing a given predicate.+--+-- Subject to fusion+--+-- Since 0.3.0+filter, filterC :: Monad m => (a -> Bool) -> ConduitT a a m ()+filterC f = awaitForever $ \i -> when (f i) (yield i)+STREAMING(filter, filterC, filterS, f)++filterFuseRight+  :: Monad m+  => ConduitT i o m ()+  -> (o -> Bool)+  -> ConduitT i o m ()+filterFuseRight (CI.ConduitT src) f = CI.ConduitT $ \rest -> let+    go (CI.Done ()) = rest ()+    go (CI.PipeM mp) = CI.PipeM (liftM go mp)+    go (CI.Leftover p i) = CI.Leftover (go p) i+    go (CI.HaveOutput p o)+        | f o = CI.HaveOutput (go p) o+        | otherwise = go p+    go (CI.NeedInput p c) = CI.NeedInput (go . p) (go . c)+    in go (src CI.Done)+-- Intermediate finalizers are dropped, but this is acceptable: the next+-- yielded value would be demanded by downstream in any event, and that new+-- finalizer will always override the existing finalizer.+{-# RULES "conduit: source/filter fusion .|" forall f src. src .| filter f = filterFuseRight src f #-}+{-# INLINE filterFuseRight #-}++-- | Ignore the remainder of values in the source. Particularly useful when+-- combined with 'isolate'.+--+-- Subject to fusion+--+-- Since 0.3.0+sinkNull, sinkNullC :: Monad m => ConduitT i o m ()+sinkNullC = awaitForever $ \_ -> return ()+{-# INLINE sinkNullC #-}+STREAMING0(sinkNull, sinkNullC, sinkNullS)++srcSinkNull :: Monad m => ConduitT () o m () -> m ()+srcSinkNull (CI.ConduitT src) =+    go (src CI.Done)+  where+    go (CI.Done ()) = return ()+    go (CI.PipeM mp) = mp >>= go+    go (CI.Leftover p ()) = go p+    go (CI.HaveOutput p _) = go p+    go (CI.NeedInput _ c) = go (c ())+{-# INLINE srcSinkNull #-}+{-# RULES "conduit: connect to sinkNull" forall src. runConduit (src .| sinkNull) = srcSinkNull src #-}++-- | A source that outputs no values. Note that this is just a type-restricted+-- synonym for 'mempty'.+--+-- Subject to fusion+--+-- Since 0.3.0+sourceNull, sourceNullC :: Monad m => ConduitT i o m ()+sourceNullC = return ()+{-# INLINE sourceNullC #-}+STREAMING0(sourceNull, sourceNullC, sourceNullS)++-- | Run a @Pipe@ repeatedly, and output its result value downstream. Stops+-- when no more input is available from upstream.+--+-- Since 0.5.0+sequence :: Monad m+         => ConduitT i o m o -- ^ @Pipe@ to run repeatedly+         -> ConduitT i o m ()+sequence sink =+    self+  where+    self = awaitForever $ \i -> leftover i >> sink >>= yield
+ src/Data/Streaming/FileRead.hs view
@@ -0,0 +1,37 @@+{-# LANGUAGE CPP #-}+-- | The standard @openFile@ call on Windows causing problematic file locking+-- in some cases. This module provides a cross-platform file reading API+-- without the file locking problems on Windows.+--+-- This module /always/ opens files in binary mode.+--+-- @readChunk@ will return an empty @ByteString@ on EOF.+module Data.Streaming.FileRead+    ( ReadHandle+    , openFile+    , closeFile+    , readChunk+    ) where++#if WINDOWS++import System.Win32File++#else++import qualified System.IO as IO+import qualified Data.ByteString as S+import Data.ByteString.Lazy.Internal (defaultChunkSize)++newtype ReadHandle = ReadHandle IO.Handle++openFile :: FilePath -> IO ReadHandle+openFile fp = ReadHandle `fmap` IO.openBinaryFile fp IO.ReadMode++closeFile :: ReadHandle -> IO ()+closeFile (ReadHandle h) = IO.hClose h++readChunk :: ReadHandle -> IO S.ByteString+readChunk (ReadHandle h) = S.hGetSome h defaultChunkSize++#endif
+ src/Data/Streaming/Filesystem.hs view
@@ -0,0 +1,100 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE ScopedTypeVariables #-}+-- | Streaming functions for interacting with the filesystem.+module Data.Streaming.Filesystem+    ( DirStream+    , openDirStream+    , readDirStream+    , closeDirStream+    , FileType (..)+    , getFileType+    ) where++import Data.Typeable (Typeable)++#if WINDOWS++import qualified System.Win32 as Win32+import System.FilePath ((</>))+import Data.IORef (IORef, newIORef, readIORef, writeIORef)+import System.Directory (doesFileExist, doesDirectoryExist)++data DirStream = DirStream !Win32.HANDLE !Win32.FindData !(IORef Bool)+    deriving Typeable++openDirStream :: FilePath -> IO DirStream+openDirStream fp = do+    (h, fdat) <- Win32.findFirstFile $ fp </> "*"+    imore <- newIORef True -- always at least two records, "." and ".."+    return $! DirStream h fdat imore++closeDirStream :: DirStream -> IO ()+closeDirStream (DirStream h _ _) = Win32.findClose h++readDirStream :: DirStream -> IO (Maybe FilePath)+readDirStream ds@(DirStream h fdat imore) = do+    more <- readIORef imore+    if more+        then do+            filename <- Win32.getFindDataFileName fdat+            Win32.findNextFile h fdat >>= writeIORef imore+            if filename == "." || filename == ".."+                then readDirStream ds+                else return $ Just filename+        else return Nothing++isSymlink :: FilePath -> IO Bool+isSymlink _ = return False++getFileType :: FilePath -> IO FileType+getFileType fp = do+    isFile <- doesFileExist fp+    if isFile+        then return FTFile+        else do+            isDir <- doesDirectoryExist fp+            return $ if isDir then FTDirectory else FTOther++#else++import System.Posix.Directory (DirStream, openDirStream, closeDirStream)+import qualified System.Posix.Directory as Posix+import qualified System.Posix.Files as PosixF+import Control.Exception (try, IOException)++readDirStream :: DirStream -> IO (Maybe FilePath)+readDirStream ds = do+    fp <- Posix.readDirStream ds+    case fp of+        "" -> return Nothing+        "." -> readDirStream ds+        ".." -> readDirStream ds+        _ -> return $ Just fp++getFileType :: FilePath -> IO FileType+getFileType fp = do+    s <- PosixF.getSymbolicLinkStatus fp+    case () of+        ()+            | PosixF.isRegularFile s -> return FTFile+            | PosixF.isDirectory s -> return FTDirectory+            | PosixF.isSymbolicLink s -> do+                es' <- try $ PosixF.getFileStatus fp+                case es' of+                    Left (_ :: IOException) -> return FTOther+                    Right s'+                        | PosixF.isRegularFile s' -> return FTFileSym+                        | PosixF.isDirectory s' -> return FTDirectorySym+                        | otherwise -> return FTOther+            | otherwise -> return FTOther++#endif++data FileType+    = FTFile+    | FTFileSym -- ^ symlink to file+    | FTDirectory+    | FTDirectorySym -- ^ symlink to a directory+    | FTOther+    deriving (Show, Read, Eq, Ord, Typeable)
+ src/System/Win32File.hsc view
@@ -0,0 +1,100 @@+{-# LANGUAGE ForeignFunctionInterface #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+module System.Win32File+    ( openFile+    , readChunk+    , closeFile+    , ReadHandle+    ) where++import Foreign.C.String (CString)+import Foreign.Ptr (castPtr)+import Foreign.Marshal.Alloc (mallocBytes, free)+import Foreign.ForeignPtr       (ForeignPtr, withForeignPtr)+#if __GLASGOW_HASKELL__ >= 704+import Foreign.C.Types (CInt (..))+#else+import Foreign.C.Types (CInt)+#endif+import Foreign.C.Error (throwErrnoIfMinus1Retry)+import Foreign.Ptr (Ptr)+import Data.Bits (Bits, (.|.))+import qualified Data.ByteString as S+import qualified Data.ByteString.Unsafe as BU+import qualified Data.ByteString.Internal as BI+import Data.Text (pack)+import Data.Text.Encoding (encodeUtf16LE)+import Data.Word (Word8)+import Prelude hiding (read)+import GHC.ForeignPtr           (mallocPlainForeignPtrBytes)+import Data.ByteString.Lazy.Internal (defaultChunkSize)+++#include <fcntl.h>+#include <share.h>+#include <sys/stat.h>+#include <errno.h>++newtype OFlag = OFlag CInt+    deriving (Num, Bits, Show, Eq)++#{enum OFlag, OFlag+    , oBinary = _O_BINARY+    , oRdonly = _O_RDONLY+    , oWronly = _O_WRONLY+    , oCreat  = _O_CREAT+    }++newtype SHFlag = SHFlag CInt+    deriving (Num, Bits, Show, Eq)++#{enum SHFlag, SHFlag+    , shDenyno = _SH_DENYNO+    }++newtype PMode = PMode CInt+    deriving (Num, Bits, Show, Eq)++#{enum PMode, PMode+    , pIread = _S_IREAD+    , pIwrite = _S_IWRITE+    }++foreign import ccall "_wsopen"+    c_wsopen :: CString -> OFlag -> SHFlag -> PMode -> IO CInt++foreign import ccall "_read"+    c_read :: ReadHandle -> Ptr Word8 -> CInt -> IO CInt++foreign import ccall "_write"+    c_write :: ReadHandle -> Ptr Word8 -> CInt -> IO CInt++foreign import ccall "_close"+    closeFile :: ReadHandle -> IO ()++newtype ReadHandle = ReadHandle CInt++openFile :: FilePath -> IO ReadHandle+openFile fp = do+    -- need to append a null char+    -- note that useAsCString is not sufficient, as we need to have two+    -- null octets to account for UTF16 encoding+    let bs = encodeUtf16LE $ pack $ fp ++ "\0"+    h <- BU.unsafeUseAsCString bs $ \str ->+            throwErrnoIfMinus1Retry "Data.Streaming.FileRead.openFile" $+            c_wsopen+                str+                (oBinary .|. oRdonly)+                shDenyno+                pIread+    return $ ReadHandle h++readChunk :: ReadHandle -> IO S.ByteString+readChunk fd = do+    fp <- mallocPlainForeignPtrBytes defaultChunkSize+    withForeignPtr fp $ \p -> do+        len <- throwErrnoIfMinus1Retry "System.Win32File.read" $ c_read fd p+            (fromIntegral defaultChunkSize)+        if len == 0+            then return $! S.empty+            else return $! BI.PS fp 0 (fromIntegral len)
+ test/Data/Conduit/Extra/ZipConduitSpec.hs view
@@ -0,0 +1,34 @@+module Data.Conduit.Extra.ZipConduitSpec (spec) where+import Test.Hspec+import Data.Conduit+import qualified Data.Conduit.List as CL+import Control.Applicative ((<*), pure)++spec :: Spec+spec = describe "Data.Conduit.Extra.ZipConduit" $ do+    it "ZipConduit" $ 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.consume+        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]+            conduit1 = CL.map (+1)+            conduit2 = CL.concatMap (replicate 2)+            conduit = do+                x <- sequenceConduits [conduit1, conduit2]+                yield $ length x + 10+            sink = CL.consume+        res <- runConduit $ src .| conduit .| sink+        res `shouldBe` [2, 1, 1, 3, 2, 2, 4, 3, 3, 12]+    it "ZipConduitMonad" $ do+        let src = mapM_ yield [1..3 :: Int]+            conduit1 = CL.mapM (pure . (+1))+            conduit2 = CL.map id+            conduit = getZipConduit $ ZipConduit conduit1 <* ZipConduit conduit2+            sink = CL.consume+        res <- runConduit $ src .| conduit .| sink+        res `shouldBe` [2, 1, 3, 2, 4, 3]
+ test/Data/Conduit/StreamSpec.hs view
@@ -0,0 +1,602 @@+{-# LANGUAGE ViewPatterns #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE CPP #-}+module Data.Conduit.StreamSpec where++import           Control.Applicative+import qualified Control.Monad+import           Control.Monad (MonadPlus(..), liftM)+import           Control.Monad.Identity (Identity, runIdentity)+import           Control.Monad.State (StateT(..), get, put)+import           Data.Conduit+import           Data.Conduit.Internal.Fusion+import           Data.Conduit.Internal.List.Stream+import           Data.Conduit.List+import qualified Data.Foldable as F+import           Data.Function (on)+import qualified Data.List+import qualified Data.Maybe+import           Data.Monoid (Monoid(..))+import           Data.Semigroup (Semigroup(..))+import           Prelude+    ((.), ($), (>>=), (=<<), return, (==), Int, id, Maybe(..), Monad,+     Eq, Show, String, Functor, fst, snd)+import qualified Prelude+import qualified Safe+import           Test.Hspec+import           Test.QuickCheck++spec :: Spec+spec = describe "Comparing list function to" $ do+    qit "unfold" $+        \(getBlind -> f, initial :: Int) ->+            unfold f initial `checkInfiniteProducer`+            (Data.List.unfoldr f initial :: [Int])+    qit "unfoldS" $+        \(getBlind -> f, initial :: Int) ->+            unfoldS f initial `checkInfiniteStreamProducer`+            (Data.List.unfoldr f initial :: [Int])+    qit "unfoldM" $+        \(getBlind -> f, initial :: Int) ->+            unfoldM f initial `checkInfiniteProducerM`+            (unfoldrM f initial :: M [Int])+    qit "unfoldMS" $+        \(getBlind -> f, initial :: Int) ->+            unfoldMS f initial `checkInfiniteStreamProducerM`+            (unfoldrM f initial :: M [Int])+    qit "sourceList" $+        \(xs :: [Int]) ->+            sourceList xs `checkProducer` xs+    qit "sourceListS" $+        \(xs :: [Int]) ->+            sourceListS xs `checkStreamProducer` xs+    qit "enumFromTo" $+        \(fr :: Small Int, to :: Small Int) ->+            enumFromTo fr to `checkProducer`+            Prelude.enumFromTo fr to+    qit "enumFromToS" $+        \(fr :: Small Int, to :: Small Int) ->+            enumFromToS fr to `checkStreamProducer`+            Prelude.enumFromTo fr to+    qit "enumFromToS_int" $+        \(getSmall -> fr :: Int, getSmall -> to :: Int) ->+            enumFromToS_int fr to `checkStreamProducer`+            Prelude.enumFromTo fr to+    qit "iterate" $+        \(getBlind -> f, initial :: Int) ->+            iterate f initial `checkInfiniteProducer`+            Prelude.iterate f initial+    qit "iterateS" $+        \(getBlind -> f, initial :: Int) ->+            iterateS f initial `checkInfiniteStreamProducer`+            Prelude.iterate f initial+    qit "replicate" $+        \(getSmall -> n, getSmall -> x) ->+            replicate n x `checkProducer`+            (Prelude.replicate n x :: [Int])+    qit "replicateS" $+        \(getSmall -> n, getSmall -> x) ->+            replicateS n x `checkStreamProducer`+            (Prelude.replicate n x :: [Int])+    qit "replicateM" $+        \(getSmall -> n, getBlind -> f) ->+            replicateM n f `checkProducerM`+            (Control.Monad.replicateM n f :: M [Int])+    qit "replicateMS" $+        \(getSmall -> n, getBlind -> f) ->+            replicateMS n f `checkStreamProducerM`+            (Control.Monad.replicateM n f :: M [Int])+    qit "fold" $+        \(getBlind -> f, initial :: Int) ->+            fold f initial `checkConsumer`+            Data.List.foldl' f initial+    qit "foldS" $+        \(getBlind -> f, initial :: Int) ->+            foldS f initial `checkStreamConsumer`+            Data.List.foldl' f initial+    qit "foldM" $+        \(getBlind -> f, initial :: Int) ->+            foldM f initial `checkConsumerM`+            (Control.Monad.foldM f initial :: [Int] -> M Int)+    qit "foldMS" $+        \(getBlind -> f, initial :: Int) ->+            foldMS f initial `checkStreamConsumerM`+            (Control.Monad.foldM f initial :: [Int] -> M Int)+    qit "foldMap" $+        \(getBlind -> (f :: Int -> Sum Int)) ->+            foldMap f `checkConsumer`+            F.foldMap f+    qit "mapM_" $+        \(getBlind -> (f :: Int -> M ())) ->+            mapM_ f `checkConsumerM`+            Prelude.mapM_ f+    qit "mapM_S" $+        \(getBlind -> (f :: Int -> M ())) ->+            mapM_S f `checkStreamConsumerM`+            Prelude.mapM_ f+    qit "take" $+        \(getSmall -> n) ->+            take n `checkConsumer`+            Prelude.take n+    qit "takeS" $+        \(getSmall -> n) ->+            takeS n `checkStreamConsumer`+            Prelude.take n+    qit "head" $+        \() ->+            head `checkConsumer`+            Safe.headMay+    qit "headS" $+        \() ->+            headS `checkStreamConsumer`+            Safe.headMay+    qit "peek" $+        \() ->+            peek `checkConsumer`+            Safe.headMay+    qit "map" $+        \(getBlind -> (f :: Int -> Int)) ->+            map f `checkConduit`+            Prelude.map f+    qit "mapS" $+        \(getBlind -> (f :: Int -> Int)) ->+            mapS f `checkStreamConduit`+            Prelude.map f+    qit "mapM" $+        \(getBlind -> (f :: Int -> M Int)) ->+            mapM f `checkConduitT`+            Prelude.mapM f+    qit "mapMS" $+        \(getBlind -> (f :: Int -> M Int)) ->+            mapMS f `checkStreamConduitT`+            Prelude.mapM f+    qit "iterM" $+        \(getBlind -> (f :: Int -> M ())) ->+            iterM f `checkConduitT`+            iterML f+    qit "iterMS" $+        \(getBlind -> (f :: Int -> M ())) ->+            iterMS f `checkStreamConduitT`+            iterML f+    qit "mapMaybe" $+        \(getBlind -> (f :: Int -> Maybe Int)) ->+            mapMaybe f `checkConduit`+            Data.Maybe.mapMaybe f+    qit "mapMaybeS" $+        \(getBlind -> (f :: Int -> Maybe Int)) ->+            mapMaybeS f `checkStreamConduit`+            Data.Maybe.mapMaybe f+    qit "mapMaybeM" $+        \(getBlind -> (f :: Int -> M (Maybe Int))) ->+            mapMaybeM f `checkConduitT`+            mapMaybeML f+    qit "mapMaybeMS" $+        \(getBlind -> (f :: Int -> M (Maybe Int))) ->+            mapMaybeMS f `checkStreamConduitT`+            mapMaybeML f+    qit "catMaybes" $+        \() ->+            catMaybes `checkConduit`+            (Data.Maybe.catMaybes :: [Maybe Int] -> [Int])+    qit "catMaybesS" $+        \() ->+            catMaybesS `checkStreamConduit`+            (Data.Maybe.catMaybes :: [Maybe Int] -> [Int])+    qit "concat" $+        \() ->+            concat `checkConduit`+            (Prelude.concat :: [[Int]] -> [Int])+    qit "concatS" $+        \() ->+            concatS `checkStreamConduit`+            (Prelude.concat :: [[Int]] -> [Int])+    qit "concatMap" $+        \(getBlind -> f) ->+            concatMap f `checkConduit`+            (Prelude.concatMap f :: [Int] -> [Int])+    qit "concatMapS" $+        \(getBlind -> f) ->+            concatMapS f `checkStreamConduit`+            (Prelude.concatMap f :: [Int] -> [Int])+    qit "concatMapM" $+        \(getBlind -> (f :: Int -> M [Int])) ->+            concatMapM f `checkConduitT`+            concatMapML f+    qit "concatMapMS" $+        \(getBlind -> (f :: Int -> M [Int])) ->+            concatMapMS f `checkStreamConduitT`+            concatMapML f+    qit "concatMapAccum" $+        \(getBlind -> (f :: Int -> Int -> (Int, [Int])), initial :: Int) ->+            concatMapAccum f initial `checkConduit`+            concatMapAccumL f initial+    qit "concatMapAccumS" $+        \(getBlind -> (f :: Int -> Int -> (Int, [Int])), initial :: Int) ->+            concatMapAccumS f initial `checkStreamConduit`+            concatMapAccumL f initial+    {-qit "mapAccum" $+        \(getBlind -> (f :: Int -> Int -> (Int, [Int])), initial :: Int) ->+            mapAccum f initial `checkConduitResult`+            mapAccumL f initial-}+    qit "mapAccumS" $+        \(getBlind -> (f :: Int -> Int -> (Int, [Int])), initial :: Int) ->+            mapAccumS f initial `checkStreamConduitResult`+            mapAccumL f initial+    {-qit "mapAccumM" $+        \(getBlind -> (f :: Int -> Int -> M (Int, [Int])), initial :: Int) ->+            mapAccumM f initial `checkConduitResultM`+            mapAccumML f initial-}+    qit "mapAccumMS" $+        \(getBlind -> (f :: Int -> Int -> M (Int, [Int])), initial :: Int) ->+            mapAccumMS f initial `checkStreamConduitResultM`+            mapAccumML f initial+    {-qit "scan" $+        \(getBlind -> (f :: Int -> Int -> Int), initial :: Int) ->+            scan f initial `checkConduitResult`+            scanL f initial-}+    {-qit "scanM" $+        \(getBlind -> (f :: Int -> Int -> M Int), initial :: Int) ->+            scanM f initial `checkConduitResultM`+            scanML f initial-}+    qit "mapFoldable" $+        \(getBlind -> (f :: Int -> [Int])) ->+            mapFoldable f `checkConduit`+            mapFoldableL f+    qit "mapFoldableS" $+        \(getBlind -> (f :: Int -> [Int])) ->+            mapFoldableS f `checkStreamConduit`+            mapFoldableL f+    qit "mapFoldableM" $+        \(getBlind -> (f :: Int -> M [Int])) ->+            mapFoldableM f `checkConduitT`+            mapFoldableML f+    qit "mapFoldableMS" $+        \(getBlind -> (f :: Int -> M [Int])) ->+            mapFoldableMS f `checkStreamConduitT`+            mapFoldableML f+    qit "consume" $+        \() ->+            consume `checkConsumer`+            id+    qit "consumeS" $+        \() ->+            consumeS `checkStreamConsumer`+            id+    qit "groupBy" $+        \(getBlind -> f) ->+            groupBy f `checkConduit`+            (Data.List.groupBy f :: [Int] -> [[Int]])+    qit "groupByS" $+        \(getBlind -> f) ->+            groupByS f `checkStreamConduit`+            (Data.List.groupBy f :: [Int] -> [[Int]])+    qit "groupOn1" $+        \(getBlind -> (f :: Int -> Int)) ->+            groupOn1 f `checkConduit`+            groupOn1L f+    qit "groupOn1S" $+        \(getBlind -> (f :: Int -> Int)) ->+            groupOn1S f `checkStreamConduit`+            groupOn1L f+    qit "isolate" $+        \n ->+            isolate n `checkConduit`+            (Data.List.take n :: [Int] -> [Int])+    qit "isolateS" $+        \n ->+            isolateS n `checkStreamConduit`+            (Data.List.take n :: [Int] -> [Int])+    qit "filter" $+        \(getBlind -> f) ->+            filter f `checkConduit`+            (Data.List.filter f :: [Int] -> [Int])+    qit "filterS" $+        \(getBlind -> f) ->+            filterS f `checkStreamConduit`+            (Data.List.filter f :: [Int] -> [Int])+    qit "sourceNull" $+        \() ->+            sourceNull `checkProducer`+            ([] :: [Int])+    qit "sourceNullS" $+        \() ->+            sourceNullS `checkStreamProducer`+            ([] :: [Int])++qit :: (Arbitrary a, Testable prop, Show a)+    => String -> (a -> prop) -> Spec+qit n f = it n $ property $ forAll arbitrary f++--------------------------------------------------------------------------------+-- Quickcheck utilities for pure conduits / streams++checkProducer :: (Show a, Eq a) => ConduitT () a Identity () -> [a] -> Property+checkProducer c l  = checkProducerM' runIdentity c (return l)++checkStreamProducer :: (Show a, Eq a) => StreamConduitT () a Identity () -> [a] -> Property+checkStreamProducer s l = checkStreamProducerM' runIdentity s (return l)++checkInfiniteProducer :: (Show a, Eq a) => ConduitT () a Identity () -> [a] -> Property+checkInfiniteProducer c l = checkInfiniteProducerM' runIdentity c (return l)++checkInfiniteStreamProducer :: (Show a, Eq a) => StreamConduitT () a Identity () -> [a] -> Property+checkInfiniteStreamProducer s l = checkInfiniteStreamProducerM' runIdentity s (return l)++checkConsumer :: (Show b, Eq b) => ConduitT Int Void Identity b -> ([Int] -> b) -> Property+checkConsumer c l = checkConsumerM' runIdentity c (return . l)++checkStreamConsumer :: (Show b, Eq b) => StreamConsumer Int Identity b -> ([Int] -> b) -> Property+checkStreamConsumer c l = checkStreamConsumerM' runIdentity c (return . l)++checkConduit :: (Show a, Arbitrary a, Show b, Eq b) => ConduitT a b Identity () -> ([a] -> [b]) -> Property+checkConduit c l = checkConduitT' runIdentity c (return . l)++checkStreamConduit :: (Show a, Arbitrary a, Show b, Eq b) => StreamConduitT a b Identity () -> ([a] -> [b]) -> Property+checkStreamConduit c l = checkStreamConduitT' runIdentity c (return . l)++-- checkConduitResult :: (Show a, Arbitrary a, Show b, Eq b, Show r, Eq r) => ConduitT a b Identity r -> ([a] -> ([b], r)) -> Property+-- checkConduitResult c l = checkConduitResultM' runIdentity c (return . l)++checkStreamConduitResult :: (Show a, Arbitrary a, Show b, Eq b, Show r, Eq r) => StreamConduitT a b Identity r -> ([a] -> ([b], r)) -> Property+checkStreamConduitResult c l = checkStreamConduitResultM' runIdentity c (return . l)++--------------------------------------------------------------------------------+-- Quickcheck utilities for conduits / streams in the M monad.++checkProducerM :: (Show a, Eq a) => ConduitT () a M () -> M [a] -> Property+checkProducerM = checkProducerM' runM++checkStreamProducerM :: (Show a, Eq a) => StreamSource M a -> M [a] -> Property+checkStreamProducerM = checkStreamProducerM' runM++checkInfiniteProducerM :: (Show a, Eq a) => ConduitT () a M () -> M [a] -> Property+checkInfiniteProducerM = checkInfiniteProducerM' (fst . runM)++checkInfiniteStreamProducerM :: (Show a, Eq a) => StreamSource M a -> M [a] -> Property+checkInfiniteStreamProducerM = checkInfiniteStreamProducerM' (fst . runM)++checkConsumerM :: (Show b, Eq b) => ConduitT Int Void M b -> ([Int] -> M b) -> Property+checkConsumerM  = checkConsumerM' runM++checkStreamConsumerM :: (Show b, Eq b) => StreamConsumer Int M b -> ([Int] -> M b) -> Property+checkStreamConsumerM  = checkStreamConsumerM' runM++checkConduitT :: (Show a, Arbitrary a, Show b, Eq b) => ConduitT a b M () -> ([a] -> M [b]) -> Property+checkConduitT = checkConduitT' runM++checkStreamConduitT :: (Show a, Arbitrary a, Show b, Eq b) => StreamConduit a M b -> ([a] -> M [b]) -> Property+checkStreamConduitT = checkStreamConduitT' runM++-- checkConduitResultM :: (Show a, Arbitrary a, Show b, Eq b, Show r, Eq r) => ConduitT a b M r -> ([a] -> M ([b], r)) -> Property+-- checkConduitResultM = checkConduitResultM' runM++checkStreamConduitResultM :: (Show a, Arbitrary a, Show b, Eq b, Show r, Eq r) => StreamConduitT a b M r -> ([a] -> M ([b], r)) -> Property+checkStreamConduitResultM = checkStreamConduitResultM' runM++--------------------------------------------------------------------------------+-- Quickcheck utilities for monadic streams / conduits+-- These are polymorphic in which Monad is used.++checkProducerM' :: (Show a, Monad m, Show b, Eq b)+                => (m [a] -> b)+                -> ConduitT () a m ()+                -> m [a]+                -> Property+checkProducerM' f c l =+    f (runConduit (preventFusion c .| consume))+    ===+    f l++checkStreamProducerM' :: (Show a, Monad m, Show b, Eq b)+                      => (m [a] -> b)+                      -> StreamSource m a+                      -> m [a]+                      -> Property+checkStreamProducerM' f s l =+    f (liftM fst $ evalStream $ s emptyStream)+    ===+    f l++checkInfiniteProducerM' :: (Show a, Monad m, Show b, Eq b)+                        => (m [a] -> b)+                        -> ConduitT () a m ()+                        -> m [a]+                        -> Property+checkInfiniteProducerM' f s l =+    checkProducerM' f+        (preventFusion s .| isolate 10)+        (liftM (Prelude.take 10) l)++checkInfiniteStreamProducerM' :: (Show a, Monad m, Show b, Eq b)+                              => (m [a] -> b)+                              -> StreamSource m a+                              -> m [a]+                              -> Property+checkInfiniteStreamProducerM' f s l =+    f (liftM snd $ evalStream $ takeS 10 $ s emptyStream)+    ===+    f (liftM (Prelude.take 10) l)++checkConsumerM' :: (Show a, Monad m, Show b, Eq b)+                => (m a -> b)+                -> ConduitT Int Void m a+                -> ([Int] -> m a)+                -> Property+checkConsumerM' f c l = forAll arbitrary $ \xs ->+    f (runConduit (sourceList xs .| preventFusion c))+    ===+    f (l xs)++checkStreamConsumerM' :: (Show a, Monad m, Show b, Eq b)+                      => (m a -> b)+                      -> StreamConsumer Int m a+                      -> ([Int] -> m a)+                      -> Property+checkStreamConsumerM' f s l = forAll arbitrary $ \xs ->+    f (liftM snd $ evalStream $ s $ sourceListS xs emptyStream)+    ===+    f (l xs)++checkConduitT' :: (Show a, Arbitrary a, Monad m, Show c, Eq c)+               => (m [b] -> c)+               -> ConduitT a b m ()+               -> ([a] -> m [b])+               -> Property+checkConduitT' f c l = forAll arbitrary $ \xs ->+    f (runConduit (sourceList xs .| preventFusion c .| consume))+    ===+    f (l xs)++checkStreamConduitT' :: (Show a, Arbitrary a, Monad m, Show c, Eq c)+                     =>  (m [b] -> c)+                     -> StreamConduit a m b+                     -> ([a] -> m [b])+                     -> Property+checkStreamConduitT' f s l = forAll arbitrary $ \xs ->+    f (liftM fst $ evalStream $ s $ sourceListS xs emptyStream)+    ===+    f (l xs)++-- TODO: Fixing this would allow comparing conduit consumers against+-- their list versions.+--+-- checkConduitResultM' :: (Show a, Arbitrary a, Monad m, Show c, Eq c)+--                      => (m ([b], r) -> c)+--                      -> ConduitT a b m r+--                      -> ([a] -> m ([b], r))+--                      -> Property+-- checkConduitResultM' f c l = FIXME forAll arbitrary $ \xs ->+--     f (sourceList xs .| preventFusion c $$ consume)+--     ===+--     f (l xs)++checkStreamConduitResultM' :: (Show a, Arbitrary a, Monad m, Show c, Eq c)+                           =>  (m ([b], r) -> c)+                           -> StreamConduitT a b m r+                           -> ([a] -> m ([b], r))+                           -> Property+checkStreamConduitResultM' f s l = forAll arbitrary $ \xs ->+    f (evalStream $ s $ sourceListS xs emptyStream)+    ===+    f (l xs)++emptyStream :: Monad m => Stream m () ()+emptyStream = Stream (\_ -> return $ Stop ()) (return ())++evalStream :: Monad m => Stream m o r -> m ([o], r)+evalStream (Stream step s0) = go =<< s0+  where+    go s = do+        res <- step s+        case res of+            Stop r -> return ([], r)+            Skip s' -> go s'+            Emit s' x -> liftM (\(l, r) -> (x:l, r)) (go s')++--------------------------------------------------------------------------------+-- Misc utilities++-- Prefer this to creating an orphan instance for Data.Monoid.Sum:++newtype Sum a = Sum a+  deriving (Eq, Show, Arbitrary)++instance Prelude.Num a => Semigroup (Sum a) where+  Sum x <> Sum y = Sum $ x Prelude.+ y++instance Prelude.Num a => Monoid (Sum a) where+  mempty = Sum 0+#if !(MIN_VERSION_base(4,11,0))+  mappend = (<>)+#endif++preventFusion :: a -> a+preventFusion = id+{-# INLINE [0] preventFusion #-}++newtype M a = M (StateT Int Identity a)+  deriving (Functor, Applicative, Monad)++instance Arbitrary a => Arbitrary (M a) where+    arbitrary = do+        f <- arbitrary+        return $ do+            s <- M get+            let (x, s') = f s+            M (put s')+            return x++runM :: M a -> (a, Int)+runM (M m) = runIdentity $ runStateT m 0++--------------------------------------------------------------------------------+-- List versions of some functions++iterML :: Monad m => (a -> m ()) -> [a] -> m [a]+iterML f = Prelude.mapM (\a -> f a >>= \() -> return a)++mapMaybeML :: Monad m => (a -> m (Maybe b)) -> [a] -> m [b]+mapMaybeML f = liftM Data.Maybe.catMaybes . Prelude.mapM f++concatMapML :: Monad m => (a -> m [b]) -> [a] -> m [b]+concatMapML f = liftM Prelude.concat . Prelude.mapM f++concatMapAccumL :: (a -> s -> (s, [b])) -> s -> [a] -> [b]+concatMapAccumL f acc0 =+    runIdentity . concatMapAccumML (\a acc -> return $ f a acc) acc0++mapAccumL :: (a -> s -> (s, b)) -> s -> [a] -> ([b], s)+mapAccumL f acc0 =+    runIdentity . mapAccumML (\a acc -> return $ f a acc) acc0++concatMapAccumML :: Monad m => (a -> s -> m (s, [b])) -> s -> [a] -> m [b]+concatMapAccumML f acc0 =+    liftM (Prelude.concat . fst) . mapAccumML f acc0++scanL :: (a -> b -> b) -> b -> [a] -> ([b], b)+scanL f = mapAccumL (\a b -> let r = f a b in (r, r))++scanML :: Monad m => (a -> b -> m b) -> b -> [a] -> m ([b], b)+scanML f = mapAccumML (\a b -> f a b >>= \r -> return (r, r))++mapFoldableL :: F.Foldable f => (a -> f b) -> [a] -> [b]+mapFoldableL f = runIdentity . mapFoldableML (return . f)++mapFoldableML :: (Monad m, F.Foldable f) => (a -> m (f b)) -> [a] -> m [b]+mapFoldableML f = concatMapML (liftM F.toList . f)++groupOn1L :: Eq b => (a -> b) -> [a] -> [(a, [a])]+groupOn1L f =+    Data.List.map (\(x:xs) -> (x, xs)) . Data.List.groupBy ((==) `on` f)++mapAccumML :: Monad m => (a -> s -> m (s, b)) -> s -> [a] -> m ([b], s)+mapAccumML f s0 = go s0+  where+    go s [] = return ([], s)+    go s (x:xs) = do+        (s', r) <- f x s+        liftM (\(l, o) -> (r:l, o)) $ go s' xs++--------------------------------------------------------------------------------+-- Utilities taken from monad-loops package++-- http://hackage.haskell.org/package/monad-loops++-- |See 'Data.List.unfoldr'.  This is a monad-friendly version of that.+unfoldrM :: (Monad m) => (a -> m (Maybe (b,a))) -> a -> m [b]+unfoldrM = unfoldrM'++-- |See 'Data.List.unfoldr'.  This is a monad-friendly version of that, with a+-- twist.  Rather than returning a list, it returns any MonadPlus type of your+-- choice.+unfoldrM' :: (Monad m, MonadPlus f) => (a -> m (Maybe (b,a))) -> a -> m (f b)+unfoldrM' f = go+    where go z = do+            x <- f z+            case x of+                Nothing         -> return mzero+                Just (x', z')   -> do+                        xs <- go z'+                        return (return x' `mplus` xs)
+ test/Spec.hs view
@@ -0,0 +1,664 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ViewPatterns #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# OPTIONS_GHC -fno-warn-type-defaults #-}+module Spec (spec) where++import Conduit+import Prelude hiding (FilePath)+import Data.Maybe (listToMaybe)+import Data.Conduit.Combinators (slidingWindow, chunksOfE, chunksOfExactlyE)+import Data.List (intersperse, sort, find, mapAccumL)+import Safe (tailSafe)+import System.FilePath (takeExtension, (</>))+import Test.Hspec+import Test.Hspec.QuickCheck+import qualified Data.Text as T+import qualified Data.Text.Lazy as TL+import qualified Data.Text.Lazy.Encoding as TL+import Data.IORef+import qualified Data.Vector as V+import qualified Data.Vector.Unboxed as VU+import qualified Data.Vector.Storable as VS+import Control.Monad (liftM)+import Control.Monad.ST (runST)+import Control.Monad.Trans.Writer+import qualified System.IO as IO+#if ! MIN_VERSION_base(4,8,0)+import Data.Monoid (Monoid (..))+import Control.Applicative ((<$>), (<*>))+#endif+#if MIN_VERSION_mono_traversable(1,0,0)+import Data.Sequences (LazySequence (..), Utf8 (..))+#else+import Data.Sequences.Lazy+import Data.Textual.Encoding+#endif+import qualified Data.NonNull as NN+import GHC.IO.Handle (hDuplicateTo)+import qualified Data.ByteString as S+import Data.ByteString.Builder (byteString, toLazyByteString)+import qualified Data.ByteString.Char8 as S8+import qualified Data.ByteString.Lazy.Char8 as L8+import qualified StreamSpec+import UnliftIO.Exception (pureTry)++spec :: Spec+spec = do+    describe "yieldMany" $ do+        it "list" $+            runConduitPure (yieldMany [1..10] .| sinkList)+            `shouldBe` [1..10]+        it "Text" $+            runConduitPure (yieldMany ("Hello World" :: T.Text) .| sinkList)+            `shouldBe` "Hello World"+    it "unfold" $+        let f 11 = Nothing+            f i = Just (show i, i + 1)+         in runConduitPure (unfoldC f 1 .| sinkList)+            `shouldBe` map show [1..10]+    it "enumFromTo" $+        runConduitPure (enumFromToC 1 10 .| sinkList) `shouldBe` [1..10]+    it "iterate" $+        let f i = i + 1+            src = iterateC f seed+            seed = 1+            count = 10+            res = runConduitPure $ src .| takeC count .| sinkList+         in res `shouldBe` take count (iterate f seed)+    it "repeat" $+        let src = repeatC seed+            seed = 1+            count = 10+            res = runConduitPure $ src .| takeC count .| sinkList+         in res `shouldBe` take count (repeat seed)+    it "replicate" $+        let src = replicateC count seed+            seed = 1+            count = 10+            res = runConduitPure $ src .| sinkList+         in res `shouldBe` replicate count seed+    it "sourceLazy" $+        let tss = ["foo", "bar", "baz"]+            tl = TL.fromChunks tss+            res = runConduitPure $ sourceLazy tl .| sinkList+         in res `shouldBe` tss+    it "repeatM" $+        let src = repeatMC (return seed)+            seed = 1+            count = 10+            res = runConduitPure $ src .| takeC count .| sinkList+         in res `shouldBe` take count (repeat seed)+    it "repeatWhileM" $ do+        ref <- newIORef 0+        let f = atomicModifyIORef ref $ \i -> (succ i, succ i)+            src = repeatWhileMC f (< 11)+        res <- runConduit $ src .| sinkList+        res `shouldBe` [1..10]+    it "replicateM" $ do+        ref <- newIORef 0+        let f = atomicModifyIORef ref $ \i -> (succ i, succ i)+            src = replicateMC 10 f+        res <- runConduit $ src .| sinkList+        res `shouldBe` [1..10]+    it "sourceFile" $ do+        let contents = concat $ replicate 10000 $ "this is some content\n"+            fp = "tmp"+        writeFile fp contents+        res <- runConduitRes $ sourceFile fp .| sinkLazy+        nocrBL res `shouldBe` TL.encodeUtf8 (TL.pack contents)+    it "sourceHandle" $ do+        let contents = concat $ replicate 10000 $ "this is some content\n"+            fp = "tmp"+        writeFile fp contents+        res <- IO.withBinaryFile "tmp" IO.ReadMode $ \h ->+          runConduit $ sourceHandle h .| sinkLazy+        nocrBL res `shouldBe` TL.encodeUtf8 (TL.pack contents)+    it "sourceIOHandle" $ do+        let contents = concat $ replicate 10000 $ "this is some content\n"+            fp = "tmp"+        writeFile fp contents+        let open = IO.openBinaryFile "tmp" IO.ReadMode+        res <- runConduitRes $ sourceIOHandle open .| sinkLazy+        nocrBL res `shouldBe` TL.encodeUtf8 (TL.pack contents)+    prop "stdin" $ \(S.pack -> content) -> do+        S.writeFile "tmp" content+        IO.withBinaryFile "tmp" IO.ReadMode $ \h -> do+            hDuplicateTo h IO.stdin+            x <- runConduit $ stdinC .| foldC+            x `shouldBe` content+    let hasExtension' ext fp = takeExtension fp == ext+    it "sourceDirectory" $ do+        res <- runConduitRes+             $ sourceDirectory "test" .| filterC (not . hasExtension' ".swp") .| sinkList+        sort res `shouldBe`+          [ "test" </> "Data"+          , "test" </> "Spec.hs"+          , "test" </> "StreamSpec.hs"+          , "test" </> "doctests.hs"+          , "test" </> "main.hs"+          , "test" </> "subdir"+          ]+    it "sourceDirectoryDeep" $ do+        res1 <- runConduitRes+              $ sourceDirectoryDeep False "test" .| filterC (not . hasExtension' ".swp") .| sinkList+        res2 <- runConduitRes+              $ sourceDirectoryDeep True "test" .| filterC (not . hasExtension' ".swp") .| sinkList+        sort res1 `shouldBe`+          [ "test" </> "Data" </> "Conduit" </> "Extra" </> "ZipConduitSpec.hs"+          , "test" </> "Data" </> "Conduit" </> "StreamSpec.hs"+          , "test" </> "Spec.hs"+          , "test" </> "StreamSpec.hs"+          , "test" </> "doctests.hs"+          , "test" </> "main.hs"+          , "test" </> "subdir" </> "dummyfile.txt"+          ]+        sort res1 `shouldBe` sort res2+    prop "drop" $ \(T.pack -> input) count ->+        runConduitPure (yieldMany input .| (dropC count >>= \() -> sinkList))+        `shouldBe` T.unpack (T.drop count input)+    prop "dropE" $ \(T.pack -> input) ->+        runConduitPure (yield input .| (dropCE 5 >>= \() -> foldC))+        `shouldBe` T.drop 5 input+    prop "dropWhile" $ \(T.pack -> input) sep ->+        runConduitPure (yieldMany input .| (dropWhileC (<= sep) >>= \() -> sinkList))+        `shouldBe` T.unpack (T.dropWhile (<= sep) input)+    prop "dropWhileE" $ \(T.pack -> input) sep ->+        runConduitPure (yield input .| (dropWhileCE (<= sep) >>= \() -> foldC))+        `shouldBe` T.dropWhile (<= sep) input+    it "fold" $+        let list = [[1..10], [11..20]]+            src = yieldMany list+            res = runConduitPure $ src .| foldC+         in res `shouldBe` concat list+    it "foldE" $+        let list = [[1..10], [11..20]]+            src = yieldMany $ Identity list+            res = runConduitPure $ src .| foldCE+         in res `shouldBe` concat list+    it "foldl" $+        let res = runConduitPure $ yieldMany [1..10] .| foldlC (+) 0+         in res `shouldBe` sum [1..10]+    it "foldlE" $+        let res = runConduitPure $ yield [1..10] .| foldlCE (+) 0+         in res `shouldBe` sum [1..10]+    it "foldMap" $+        let src = yieldMany [1..10]+            res = runConduitPure $ src .| foldMapC return+         in res `shouldBe` [1..10]+    it "foldMapE" $+        let src = yield [1..10]+            res = runConduitPure $ src .| foldMapCE return+         in res `shouldBe` [1..10]+    prop "all" $ \ (input :: [Int]) -> runConduitPure (yieldMany input .| allC even) `shouldBe` all evenInt input+    prop "allE" $ \ (input :: [Int]) -> runConduitPure (yield input .| allCE even) `shouldBe` all evenInt input+    prop "any" $ \ (input :: [Int]) -> runConduitPure (yieldMany input .| anyC even) `shouldBe` any evenInt input+    prop "anyE" $ \ (input :: [Int]) -> runConduitPure (yield input .| anyCE even) `shouldBe` any evenInt input+    prop "and" $ \ (input :: [Bool]) -> runConduitPure (yieldMany input .| andC) `shouldBe` and input+    prop "andE" $ \ (input :: [Bool]) -> runConduitPure (yield input .| andCE) `shouldBe` and input+    prop "or" $ \ (input :: [Bool]) -> runConduitPure (yieldMany input .| orC) `shouldBe` or input+    prop "orE" $ \ (input :: [Bool]) -> runConduitPure (yield input .| orCE) `shouldBe` or input+    prop "elem" $ \x xs -> runConduitPure (yieldMany xs .| elemC x) `shouldBe` elemInt x xs+    prop "elemE" $ \x xs -> runConduitPure (yield xs .| elemCE x) `shouldBe` elemInt x xs+    prop "notElem" $ \x xs -> runConduitPure (yieldMany xs .| notElemC x) `shouldBe` notElemInt x xs+    prop "notElemE" $ \x xs -> runConduitPure (yield xs .| notElemCE x) `shouldBe` notElemInt x xs+    prop "sinkVector regular" $ \xs -> do+        res <- runConduit $ yieldMany xs .| sinkVector+        res `shouldBe` V.fromList (xs :: [Int])+    prop "sinkVector unboxed" $ \xs -> do+        res <- runConduit $ yieldMany xs .| sinkVector+        res `shouldBe` VU.fromList (xs :: [Int])+    prop "sinkVector storable" $ \xs -> do+        res <- runConduit $ yieldMany xs .| sinkVector+        res `shouldBe` VS.fromList (xs :: [Int])+    prop "sinkVectorN regular" $ \xs' -> do+        let maxSize = 20+            xs = take maxSize xs'+        res <- runConduit $ yieldMany xs' .| sinkVectorN maxSize+        res `shouldBe` V.fromList (xs :: [Int])+    prop "sinkVectorN unboxed" $ \xs' -> do+        let maxSize = 20+            xs = take maxSize xs'+        res <- runConduit $ yieldMany xs' .| sinkVectorN maxSize+        res `shouldBe` VU.fromList (xs :: [Int])+    prop "sinkVectorN storable" $ \xs' -> do+        let maxSize = 20+            xs = take maxSize xs'+        res <- runConduit $ yieldMany xs' .| sinkVectorN maxSize+        res `shouldBe` VS.fromList (xs :: [Int])+    prop "sinkBuilder" $ \(map S.pack -> inputs) ->+        let builder = runConduitPure $ yieldMany inputs .| foldMapC byteString+            ltext = toLazyByteString builder+         in ltext `shouldBe` fromChunks inputs+    prop "sinkLazyBuilder" $ \(map S.pack -> inputs) ->+        let lbs = runConduitPure (yieldMany (map byteString inputs) .| sinkLazyBuilder)+         in lbs `shouldBe` fromChunks inputs+    prop "sinkNull" $ \xs toSkip -> do+        res <- runConduit $ yieldMany xs .| do+            takeC toSkip .| sinkNull+            sinkList+        res `shouldBe` drop toSkip (xs :: [Int])+    prop "awaitNonNull" $ \xs ->+        fmap NN.toNullable (runConduitPure $ yieldMany xs .| awaitNonNull)+        `shouldBe` listToMaybe (filter (not . null) (xs :: [[Int]]))+    prop "headE" $ \ (xs :: [[Int]]) ->+        runConduitPure (yieldMany xs .| ((,) <$> headCE <*> foldC))+        `shouldBe` (listToMaybe $ concat xs, drop 1 $ concat xs)+    prop "peek" $ \xs ->+        runConduitPure (yieldMany xs .| ((,) <$> peekC <*> sinkList))+        `shouldBe` (listToMaybe xs, xs :: [Int])+    prop "peekE" $ \ (xs :: [[Int]]) ->+        runConduitPure (yieldMany xs .| ((,) <$> peekCE <*> foldC))+        `shouldBe` (listToMaybe $ concat xs, concat xs)+    prop "last" $ \xs ->+        runConduitPure (yieldMany xs .| lastC)+        `shouldBe` listToMaybe (reverse (xs :: [Int]))+    prop "lastE" $ \ (xs :: [[Int]]) ->+        runConduitPure (yieldMany xs .| lastCE)+        `shouldBe` listToMaybe (reverse (concat xs))+    prop "length" $ \xs ->+        runConduitPure (yieldMany xs .| lengthC)+        `shouldBe` length (xs :: [Int])+    prop "lengthE" $ \ (xs :: [[Int]]) ->+        runConduitPure (yieldMany xs .| lengthCE)+        `shouldBe` length (concat xs)+    prop "lengthIf" $ \x xs ->+        runConduitPure (yieldMany xs .| lengthIfC (< x))+        `shouldBe` length (filter (< x) xs :: [Int])+    prop "lengthIfE" $ \x (xs :: [[Int]]) ->+        runConduitPure (yieldMany xs .| lengthIfCE (< x))+        `shouldBe` length (filter (< x) (concat xs))+    prop "maximum" $ \xs ->+        runConduitPure (yieldMany xs .| maximumC)+        `shouldBe` (if null (xs :: [Int]) then Nothing else Just (maximum xs))+    prop "maximumE" $ \ (xs :: [[Int]]) ->+        runConduitPure (yieldMany xs .| maximumCE)+        `shouldBe` (if null (concat xs) then Nothing else Just (maximum $ concat xs))+    prop "minimum" $ \xs ->+        runConduitPure (yieldMany xs .| minimumC)+        `shouldBe` (if null (xs :: [Int]) then Nothing else Just (minimum xs))+    prop "minimumE" $ \ (xs :: [[Int]]) ->+        runConduitPure (yieldMany xs .| minimumCE)+        `shouldBe` (if null (concat xs) then Nothing else Just (minimum $ concat xs))+    prop "null" $ \xs ->+        runConduitPure (yieldMany xs .| nullC)+        `shouldBe` null (xs :: [Int])+    prop "nullE" $ \ (xs :: [[Int]]) ->+        runConduitPure (yieldMany xs .| ((,) <$> nullCE <*> foldC))+        `shouldBe` (null (concat xs), concat xs)+    prop "sum" $ \xs ->+        runConduitPure (yieldMany xs .| sumC)+        `shouldBe` sum (xs :: [Int])+    prop "sumE" $ \ (xs :: [[Int]]) ->+        runConduitPure (yieldMany xs .| sumCE)+        `shouldBe` sum (concat xs)+    prop "product" $ \xs ->+        runConduitPure (yieldMany xs .| productC)+        `shouldBe` product (xs :: [Int])+    prop "productE" $ \ (xs :: [[Int]]) ->+        runConduitPure (yieldMany xs .| productCE)+        `shouldBe` product (concat xs)+    prop "find" $ \x xs ->+        runConduitPure (yieldMany xs .| findC (< x))+        `shouldBe` find (< x) (xs :: [Int])+    prop "mapM_" $ \xs ->+        let res = execWriter $ runConduit $ yieldMany xs .| mapM_C (tell . return)+         in res `shouldBe` (xs :: [Int])+    prop "mapM_E" $ \xs ->+        let res = execWriter $ runConduit $ yield xs .| mapM_CE (tell . return)+         in res `shouldBe` (xs :: [Int])+    prop "foldM" $ \ (xs :: [Int]) -> do+        res <- runConduit $ yieldMany xs .| foldMC addM 0+        res `shouldBe` sum xs+    prop "foldME" $ \ (xs :: [Int]) -> do+        res <- runConduit $ yield xs .| foldMCE addM 0+        res `shouldBe` sum xs+    it "foldMapM" $+        let src = yieldMany [1..10]+            res = runConduitPure $ src .| foldMapMC (return . return)+         in res `shouldBe` [1..10]+    it "foldMapME" $+        let src = yield [1..10]+            res = runConduitPure $ src .| foldMapMCE (return . return)+         in res `shouldBe` [1..10]+    it "sinkFile" $ do+        let contents = mconcat $ replicate 1000 $ "this is some content\n"+            fp = "tmp"+        runConduitRes $ yield contents .| sinkFile fp+        res <- S.readFile fp+        res `shouldBe` contents+    it "sinkHandle" $ do+        let contents = mconcat $ replicate 1000 $ "this is some content\n"+            fp = "tmp"+        IO.withBinaryFile "tmp" IO.WriteMode $ \h -> runConduit $ yield contents .| sinkHandle h+        res <- S.readFile fp+        res `shouldBe` contents+    it "sinkIOHandle" $ do+        let contents = mconcat $ replicate 1000 $ "this is some content\n"+            fp = "tmp"+            open = IO.openBinaryFile "tmp" IO.WriteMode+        runConduitRes $ yield contents .| sinkIOHandle open+        res <- S.readFile fp+        res `shouldBe` contents+    prop "map" $ \input ->+        runConduitPure (yieldMany input .| mapC succChar .| sinkList)+        `shouldBe` map succChar input+    prop "mapE" $ \(map V.fromList -> inputs) ->+        runConduitPure (yieldMany inputs .| mapCE succChar .| foldC)+        `shouldBe` V.map succChar (V.concat inputs)+    prop "omapE" $ \(map T.pack -> inputs) ->+        runConduitPure (yieldMany inputs .| omapCE succChar .| foldC)+        `shouldBe` T.map succChar (T.concat inputs)+    prop "concatMap" $ \ (input :: [Int]) ->+        runConduitPure (yieldMany input .| concatMapC showInt .| sinkList)+        `shouldBe` concatMap showInt input+    prop "concatMapE" $ \ (input :: [Int]) ->+        runConduitPure (yield input .| concatMapCE showInt .| foldC)+        `shouldBe` concatMap showInt input+    prop "take" $ \(T.pack -> input) count ->+        runConduitPure (yieldMany input .| (takeC count >>= \() -> mempty) .| sinkList)+        `shouldBe` T.unpack (T.take count input)+    prop "takeE" $ \(T.pack -> input) count ->+        runConduitPure (yield input .| (takeCE count >>= \() -> mempty) .| foldC)+        `shouldBe` T.take count input+    prop "takeWhile" $ \(T.pack -> input) sep ->+        runConduitPure (yieldMany input .| do+            x <- (takeWhileC (<= sep) >>= \() -> mempty) .| sinkList+            y <- sinkList+            return (x, y))+        `shouldBe` span (<= sep) (T.unpack input)+    prop "takeWhileE" $ \(T.pack -> input) sep ->+        runConduitPure (yield input .| do+            x <- (takeWhileCE (<= sep) >>= \() -> mempty) .| foldC+            y <- foldC+            return (x, y))+        `shouldBe` T.span (<= sep) input+    it "takeExactly" $+        let src = yieldMany [1..10]+            sink = do+                x <- takeExactlyC 5 $ return 1+                y <- sinkList+                return (x, y)+            res = runConduitPure $ src .| sink+         in res `shouldBe` (1, [6..10])+    it "takeExactlyE" $+        let src = yield ("Hello World" :: T.Text)+            sink = do+                takeExactlyCE 5 (mempty :: ConduitT T.Text Void Identity ())+                y <- sinkLazy+                return y+            res = runConduitPure $ src .| sink+         in res `shouldBe` " World"+    it "takeExactlyE Vector" $ do+        let src = yield (V.fromList $ T.unpack "Hello World")+            sink = do+                x <- takeExactlyCE 5 $ return 1+                y <- foldC+                return (x, y)+        res <- runConduit $ src .| sink+        res `shouldBe` (1, V.fromList $ T.unpack " World")+    it "takeExactlyE 2" $+        let src = yield ("Hello World" :: T.Text)+            sink = do+                x <- takeExactlyCE 5 $ return 1+                y <- sinkLazy+                return (x, y)+            res = runConduitPure $ src .| sink+            -- FIXME type signature on next line is necessary in GHC 7.6.3 to+            -- avoid a crash:+            --+            -- test: internal error: ARR_WORDS object entered!+            --     (GHC version 7.6.3 for x86_64_unknown_linux)+            --     Please report this as a GHC bug:  http://www.haskell.org/ghc/reportabug+            -- Aborted (core dumped)+            --+            -- Report upstream when packages are released+         in res `shouldBe` (1, " World" :: TL.Text)+    prop "concat" $ \input ->+        runConduitPure (yield (T.pack input) .| concatC .| sinkList)+        `shouldBe` input+    prop "filter" $ \input ->+        runConduitPure (yieldMany input .| filterC evenInt .| sinkList)+        `shouldBe` filter evenInt input+    prop "filterE" $ \input ->+        runConduitPure (yield input .| filterCE evenInt .| foldC)+        `shouldBe` filter evenInt input+    prop "mapWhile" $ \input (min 20 -> highest) ->+        let f i | i < highest = Just (i + 2 :: Int)+                | otherwise   = Nothing+            res = runConduitPure $ yieldMany input .| do+                x <- (mapWhileC f >>= \() -> mempty) .| sinkList+                y <- sinkList+                return (x, y)+            (taken, dropped) = span (< highest) input+         in res `shouldBe` (map (+ 2) taken, dropped)+    prop "conduitVector" $ \(take 200 -> input) size' -> do+        let size = min 30 $ succ $ abs size'+        res <- runConduit $ yieldMany input .| conduitVector size .| sinkList+        res `shouldSatisfy` all (\v -> V.length v <= size)+        drop 1 (reverse res) `shouldSatisfy` all (\v -> V.length v == size)+        V.concat res `shouldBe` V.fromList (input :: [Int])+    prop "scanl" $ \input seed ->+        let f a b = a + b :: Int+            res = runConduitPure $ yieldMany input .| scanlC f seed .| sinkList+         in res `shouldBe` scanl f seed input+    prop "mapAccumWhile" $ \input (min 20 -> highest) ->+        let f i accum | i < highest = Right (i + accum, 2 * i :: Int)+                      | otherwise   = Left accum+            res = runConduitPure $ yieldMany input .| do+                (s, x) <- fuseBoth (mapAccumWhileC f 0) sinkList+                y <- sinkList+                return (s, x, y)+            (taken, dropped) = span (< highest) input+         in res `shouldBe` (sum taken, map (* 2) taken, tailSafe dropped)+    prop "concatMapAccum" $ \(input :: [Int]) ->+        let f a accum = (a + accum, [a, accum])+            res = runConduitPure $ yieldMany input .| concatMapAccumC f 0 .| sinkList+            expected = concat $ snd $ mapAccumL (flip f) 0 input+         in res `shouldBe` expected+    prop "intersperse" $ \xs x ->+        runConduitPure (yieldMany xs .| intersperseC x .| sinkList)+        `shouldBe` intersperse (x :: Int) xs+    prop "mapM" $ \input ->+        runConduitPure (yieldMany input .| mapMC (return . succChar) .| sinkList)+        `shouldBe` map succChar input+    prop "mapME" $ \(map V.fromList -> inputs) ->+        runConduitPure (yieldMany inputs .| mapMCE (return . succChar) .| foldC)+        `shouldBe` V.map succChar (V.concat inputs)+    prop "omapME" $ \(map T.pack -> inputs) ->+        runConduitPure (yieldMany inputs .| omapMCE (return . succChar) .| foldC)+        `shouldBe` T.map succChar (T.concat inputs)+    prop "concatMapM" $ \ (input :: [Int]) ->+        runConduitPure (yieldMany input .| concatMapMC (return . showInt) .| sinkList)+        `shouldBe` concatMap showInt input+    prop "filterM" $ \input ->+        runConduitPure (yieldMany input .| filterMC (return . evenInt) .| sinkList)+        `shouldBe` filter evenInt input+    prop "filterME" $ \input ->+        runConduitPure (yield input .| filterMCE (return . evenInt) .| foldC)+        `shouldBe` filter evenInt input+    prop "iterM" $ \input -> do+        (x, y) <- runWriterT $ runConduit $ yieldMany input .| iterMC (tell . return) .| sinkList+        x `shouldBe` (input :: [Int])+        y `shouldBe` input+    prop "scanlM" $ \input seed ->+        let f a b = a + b :: Int+            fm a b = return $ a + b+            res = runConduitPure $ yieldMany input .| scanlMC fm seed .| sinkList+         in res `shouldBe` scanl f seed input+    prop "mapAccumWhileM" $ \input (min 20 -> highest) ->+        let f i accum | i < highest = Right (i + accum, 2 * i :: Int)+                      | otherwise   = Left accum+            res = runConduitPure $ yieldMany input .| do+                (s, x) <- fuseBoth (mapAccumWhileMC ((return.).f) 0) sinkList+                y <- sinkList+                return (s, x, y)+            (taken, dropped) = span (< highest) input+         in res `shouldBe` (sum taken, map (* 2) taken, tailSafe dropped)+    prop "concatMapAccumM" $ \(input :: [Int]) ->+        let f a accum = (a + accum, [a, accum])+            res = runConduitPure $ yieldMany input .| concatMapAccumMC ((return.).f) 0 .| sinkList+            expected = concat $ snd $ mapAccumL (flip f) 0 input+         in res `shouldBe` expected+    prop "encode UTF8" $ \(map T.pack -> inputs) -> do+        let expected = encodeUtf8 $ fromChunks inputs+        actual <- runConduit+                $ yieldMany inputs+               .| encodeUtf8C+               .| sinkLazy+        actual `shouldBe` expected+    prop "encode/decode UTF8" $ \(map T.pack -> inputs) (min 50 . max 1 . abs -> chunkSize) -> do+        let expected = fromChunks inputs+        actual <- runConduit+                $ yieldMany inputs+               .| encodeUtf8C+               .| concatC+               .| conduitVector chunkSize+               .| mapC (S.pack . V.toList)+               .| decodeUtf8C+               .| sinkLazy+        actual `shouldBe` expected+    it "invalid UTF8 is an exception" $+      case runConduit $ yield "\129" .| decodeUtf8C .| sinkLazy of+        Left _ -> return () :: IO ()+        Right x -> error $ "this should have failed, got: " ++ show x+    prop "encode/decode UTF8 lenient" $ \(map T.pack -> inputs) (min 50 . max 1 . abs -> chunkSize) -> do+        let expected = fromChunks inputs+        actual <- runConduit+                $ yieldMany inputs+               .| encodeUtf8C+               .| concatC+               .| conduitVector chunkSize+               .| mapC (S.pack . V.toList)+               .| decodeUtf8LenientC+               .| sinkLazy+        actual `shouldBe` expected+    prop "line" $ \(map T.pack -> input) size ->+        let src = yieldMany input+            sink = do+                x <- lineC $ takeCE size .| foldC+                y <- foldC+                return (x, y)+            res = runConduitPure $ src .| sink+            expected =+                let (x, y) = T.break (== '\n') (T.concat input)+                 in (T.take size x, T.drop 1 y)+         in res `shouldBe` expected+    prop "lineAscii" $ \(map S.pack -> input) size ->+        let src = yieldMany input+            sink = do+                x <- lineAsciiC $ takeCE size .| foldC+                y <- foldC+                return (x, y)+            res = runConduitPure $ src .| sink+            expected =+                let (x, y) = S.break (== 10) (S.concat input)+                 in (S.take size x, S.drop 1 y)+         in res `shouldBe` expected+    prop "unlines" $ \(map T.pack -> input) ->+        runConduitPure (yieldMany input .| unlinesC .| foldC)+        `shouldBe` T.unlines input+    prop "unlinesAscii" $ \(map S.pack -> input) ->+        runConduitPure (yieldMany input .| unlinesAsciiC .| foldC)+        `shouldBe` S8.unlines input+    prop "linesUnbounded" $ \(map T.pack -> input) ->+        runConduitPure (yieldMany input .| (linesUnboundedC >>= \() -> mempty) .| sinkList)+        `shouldBe` T.lines (T.concat input)+    prop "linesUnboundedAscii" $ \(map S.pack -> input) ->+        runConduitPure (yieldMany input .| (linesUnboundedAsciiC >>= \() -> mempty) .| sinkList)+        `shouldBe` S8.lines (S.concat input)+    it "slidingWindow 0" $+        let res = runConduitPure $ yieldMany [1..5] .| slidingWindow 0 .| sinkList+        in res `shouldBe` [[1],[2],[3],[4],[5]]+    it "slidingWindow 1" $+        let res = runConduitPure $ yieldMany [1..5] .| slidingWindow 1 .| sinkList+        in res `shouldBe` [[1],[2],[3],[4],[5]]+    it "slidingWindow 2" $+        let res = runConduitPure $ yieldMany [1..5] .| slidingWindow 2 .| sinkList+        in res `shouldBe` [[1,2],[2,3],[3,4],[4,5]]+    it "slidingWindow 3" $+        let res = runConduitPure $ yieldMany [1..5] .| slidingWindow 3 .| sinkList+        in res `shouldBe` [[1,2,3],[2,3,4],[3,4,5]]+    it "slidingWindow 4" $+        let res = runConduitPure $ yieldMany [1..5] .| slidingWindow 4 .| sinkList+        in res `shouldBe` [[1,2,3,4],[2,3,4,5]]+    it "slidingWindow 5" $+        let res = runConduitPure $ yieldMany [1..5] .| slidingWindow 5 .| sinkList+        in res `shouldBe` [[1,2,3,4,5]]+    it "slidingWindow 6" $+        let res = runConduitPure $ yieldMany [1..5] .| slidingWindow 6 .| sinkList+        in res `shouldBe` [[1,2,3,4,5]]+    it "chunksOfE 1" $+        let res = runConduitPure $ yieldMany [[1,2], [3,4], [5,6]] .| chunksOfE 3 .| sinkList+        in res `shouldBe` [[1,2,3], [4,5,6]]+    it "chunksOfE 2 (last smaller)" $+        let res = runConduitPure $ yieldMany [[1,2], [3,4], [5,6,7]] .| chunksOfE 3 .| sinkList+        in res `shouldBe` [[1,2,3], [4,5,6], [7]]+    it "chunksOfE (ByteString)" $+        let res = runConduitPure $ yieldMany [S8.pack "01234", "56789ab", "cdef", "h"] .| chunksOfE 4 .| sinkList+        in res `shouldBe` ["0123", "4567", "89ab", "cdef", "h"]+    it "chunksOfExactlyE 1" $+        let res = runConduitPure $ yieldMany [[1,2], [3,4], [5,6]] .| chunksOfExactlyE 3 .| sinkList+        in res `shouldBe` [[1,2,3], [4,5,6]]+    it "chunksOfExactlyE 2 (last smaller; thus not yielded)" $+        let res = runConduitPure $ yieldMany [[1,2], [3,4], [5,6,7]] .| chunksOfExactlyE 3 .| sinkList+        in res `shouldBe` [[1,2,3], [4,5,6]]+    prop "vectorBuilder" $ \(values :: [[Int]]) ((+1) . (`mod` 30) . abs -> size) -> do+        let res = runST $ runConduit+                $ yieldMany values+               .| vectorBuilderC size mapM_CE+               .| sinkList+            expected =+                loop $ concat values+              where+                loop [] = []+                loop x =+                    VU.fromList y : loop z+                  where+                    (y, z) = splitAt size x+        res `shouldBe` expected+    prop "mapAccumS" $ \input ->+        let ints  = [1..]+            f a s = liftM (:s) $ mapC (* a) .| takeC a .| sinkList+            res   = reverse $ runConduitPure $ yieldMany input+                           .| mapAccumS f [] (yieldMany ints)+            expected = loop input ints+                where  loop []     _  = []+                       loop (a:as) xs = let (y, ys) = Prelude.splitAt a xs+                                        in  map (* a) y : loop as ys+        in  res `shouldBe` expected+    prop "peekForever" $ \(strs' :: [String]) -> do+        let strs = filter (not . null) strs'+        res1 <- runConduit $ yieldMany strs .| linesUnboundedC .| sinkList+        res2 <- runConduit $ yieldMany strs .| peekForever (lineC $ foldC >>= yield) .| sinkList+        res2 `shouldBe` res1+    prop "peekForeverE" $ \(strs :: [String]) -> do+        res1 <- runConduit $ yieldMany strs .| linesUnboundedC .| sinkList+        res2 <- runConduit $ yieldMany strs .| peekForeverE (lineC $ foldC >>= yield) .| sinkList+        res2 `shouldBe` res1+    StreamSpec.spec++evenInt :: Int -> Bool+evenInt = even++elemInt :: Int -> [Int] -> Bool+elemInt = elem++notElemInt :: Int -> [Int] -> Bool+notElemInt = notElem++addM :: Monad m => Int -> Int -> m Int+addM x y = return (x + y)++succChar :: Char -> Char+succChar c =+  case pureTry (succ c) of+    Left _ -> 'X' -- QuickCheck may generate characters out of range+    Right x -> x++showInt :: Int -> String+showInt = Prelude.show++nocrBL :: L8.ByteString -> L8.ByteString+nocrBL = L8.filter (/= '\r')
+ test/StreamSpec.hs view
@@ -0,0 +1,512 @@+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ViewPatterns #-}+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE CPP #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+module StreamSpec where++import           Control.Arrow (first)+import           Control.Applicative+import qualified Control.Monad+import           Control.Monad (liftM)+import           Control.Monad.Identity (Identity, runIdentity)+import           Control.Monad.State (StateT(..), get, put)+import           Data.Conduit+import           Data.Conduit.Combinators+import           Data.Conduit.Combinators.Stream+import           Data.Conduit.Internal.Fusion+import           Data.Conduit.Internal.List.Stream (takeS, sourceListS, mapS)+import qualified Data.List+import           Data.MonoTraversable+import           Data.Monoid (Monoid(..))+import qualified Data.NonNull as NonNull+import           Data.Sequence (Seq)+import qualified Data.Sequences as Seq+import           Data.Vector (Vector)+import qualified Prelude+import           Prelude+    ((.), ($), (>>=), (=<<), return, id, Maybe(..), Either(..), Monad,+     Bool(..), Int, Eq, Show, String, Functor, fst, snd, either)+import qualified Safe+import qualified System.IO as IO+import           System.IO.Unsafe+import           Test.Hspec+import           Test.QuickCheck+import           Data.Semigroup (Semigroup (..))++spec :: Spec+spec = do+    describe "Comparing list function to" $ do+        qit "yieldMany" $+            \(mono :: Seq Int) ->+                yieldMany mono `checkProducer`+                otoList mono+        qit "sourceListS" $+            \(mono :: Seq Int) ->+                yieldManyS mono `checkStreamProducer`+                otoList mono+        qit "repeatM" $+            \(getBlind -> (f :: M Int)) ->+                repeatM f `checkInfiniteProducerM`+                repeatML f+        qit "repeatMS" $+            \(getBlind -> (f :: M Int)) ->+                repeatMS f `checkInfiniteStreamProducerM`+                repeatML f+        qit "repeatWhileM" $+            \(getBlind -> (f :: M Int), getBlind -> g) ->+                repeatWhileM f g `checkInfiniteProducerM`+                repeatWhileML f g+        qit "repeatWhileMS" $+            \(getBlind -> (f :: M Int), getBlind -> g) ->+                repeatWhileMS f g `checkInfiniteStreamProducerM`+                repeatWhileML f g+        qit "foldl1" $+            \(getBlind -> f) ->+                foldl1 f `checkConsumer`+                foldl1L f+        qit "foldl1S" $+            \(getBlind -> f) ->+                foldl1S f `checkStreamConsumer`+                foldl1L f+        qit "all" $+            \(getBlind -> f) ->+                all f `checkConsumer`+                Prelude.all f+        qit "allS" $+            \(getBlind -> f) ->+                allS f `checkStreamConsumer`+                Prelude.all f+        qit "any" $+            \(getBlind -> f) ->+                any f `checkConsumer`+                Prelude.any f+        qit "anyS" $+            \(getBlind -> f) ->+                anyS f `checkStreamConsumer`+                Prelude.any f+        qit "last" $+            \() ->+                last `checkConsumer`+                Safe.lastMay+        qit "lastS" $+            \() ->+                lastS `checkStreamConsumer`+                Safe.lastMay+        qit "lastE" $+            \(getBlind -> f) ->+                let g x = Seq.replicate (Prelude.abs (getSmall (f x))) x :: Seq Int+                 in (map g .| lastE) `checkConsumer`+                    (lastEL . Prelude.map g :: [Int] -> Maybe Int)+        qit "lastES" $+            \(getBlind -> f) ->+                let g x = Seq.replicate (Prelude.abs (getSmall (f x))) x :: Seq Int+                 in (lastES . mapS g) `checkStreamConsumer`+                    (lastEL . Prelude.map g :: [Int] -> Maybe Int)+        qit "find" $+            \(getBlind -> f) ->+                find f `checkConsumer`+                Data.List.find f+        qit "findS" $+            \(getBlind -> f) ->+                findS f `checkStreamConsumer`+                Data.List.find f+        qit "concatMap" $+            \(getBlind -> (f :: Int -> Seq Int)) ->+                concatMap f `checkConduit`+                concatMapL f+        qit "concatMapS" $+            \(getBlind -> (f :: Int -> Seq Int)) ->+                concatMapS f `checkStreamConduit`+                concatMapL f+        qit "concatMapM" $+            \(getBlind -> (f :: Int -> M (Seq Int))) ->+                concatMapM f `checkConduitT`+                concatMapML f+        qit "concatMapMS" $+            \(getBlind -> (f :: Int -> M (Seq Int))) ->+                concatMapMS f `checkStreamConduitT`+                concatMapML f+        qit "concat" $+            \() ->+                concat `checkConduit`+                (concatL :: [Seq Int] -> [Int])+        qit "concatS" $+            \() ->+                concatS `checkStreamConduit`+                (concatL :: [Seq Int] -> [Int])+        qit "scanl" $+            \(getBlind -> (f :: Int -> Int -> Int), initial) ->+                scanl f initial `checkConduit`+                Prelude.scanl f initial+        qit "scanlS" $+            \(getBlind -> (f :: Int -> Int -> Int), initial) ->+                scanlS f initial `checkStreamConduit`+                Prelude.scanl f initial+        qit "scanlM" $+            \(getBlind -> (f :: Int -> Int -> M Int), initial) ->+                scanlM f initial `checkConduitT`+                scanlML f initial+        qit "scanlMS" $+            \(getBlind -> (f :: Int -> Int -> M Int), initial) ->+                scanlMS f initial `checkStreamConduitT`+                scanlML f initial+        qit "mapAccumWhileS" $+            \(getBlind -> ( f :: Int -> [Int] -> Either [Int] ([Int], Int))+                          , initial :: [Int]) ->+                mapAccumWhileS f initial `checkStreamConduitResult`+                mapAccumWhileL f initial+        qit "mapAccumWhileMS" $+            \(getBlind -> ( f :: Int -> [Int] -> M (Either [Int] ([Int], Int)))+                          , initial :: [Int]) ->+                mapAccumWhileMS f initial `checkStreamConduitResultM`+                mapAccumWhileML f initial+        qit "intersperse" $+            \(sep :: Int) ->+                intersperse sep `checkConduit`+                Data.List.intersperse sep+        qit "intersperseS" $+            \(sep :: Int) ->+                intersperseS sep `checkStreamConduit`+                Data.List.intersperse sep+        qit "filterM" $+            \(getBlind -> (f :: Int -> M Bool)) ->+                filterM f `checkConduitT`+                Control.Monad.filterM f+        qit "filterMS" $+            \(getBlind -> (f :: Int -> M Bool)) ->+                filterMS f `checkStreamConduitT`+                Control.Monad.filterM f+    describe "comparing normal conduit function to" $ do+        qit "slidingWindowS" $+            \(getSmall -> n) ->+                slidingWindowS n `checkStreamConduit`+                (\xs -> runConduitPure $+                    yieldMany xs .| preventFusion (slidingWindow n) .| sinkList+                    :: [Seq Int])+        qit "splitOnUnboundedES" $+            \(getBlind -> (f :: Int -> Bool)) ->+                splitOnUnboundedES f `checkStreamConduit`+                (\xs -> runConduitPure $+                    yieldMany xs .| preventFusion (splitOnUnboundedE f) .| sinkList+                    :: [Seq Int])+        qit "sinkVectorS" $+            \() -> checkStreamConsumerM'+                unsafePerformIO+                (sinkVectorS :: forall o. StreamConduitT Int o IO.IO (Vector Int))+                (\xs -> runConduit $ yieldMany xs .| preventFusion sinkVector)+        qit "sinkVectorNS" $+            \(getSmall . getNonNegative -> n) -> checkStreamConsumerM'+                unsafePerformIO+                (sinkVectorNS n :: forall o. StreamConduitT Int o IO.IO (Vector Int))+                (\xs -> runConduit $ yieldMany xs .| preventFusion (sinkVectorN n))++#if !MIN_VERSION_QuickCheck(2,8,2)+instance Arbitrary a => Arbitrary (Seq a) where+    arbitrary = Seq.fromList <$> arbitrary+#endif++repeatML :: Monad m => m a -> m [a]+repeatML = Prelude.sequence . Prelude.repeat++repeatWhileML :: Monad m => m a -> (a -> Bool) -> m [a]+repeatWhileML m f = go+  where+    go = do+        x <- m+        if f x+           then liftM (x:) go+           else return []++foldl1L :: (a -> a -> a) -> [a] -> Maybe a+foldl1L _ [] = Nothing+foldl1L f xs = Just $ Prelude.foldl1 f xs++lastEL :: Seq.IsSequence seq+       => [seq] -> Maybe (Element seq)+lastEL = Prelude.foldl go Nothing+  where+    go _ (NonNull.fromNullable -> Just l) = Just (NonNull.last l)+    go mlast _ = mlast++concatMapL :: MonoFoldable mono+           => (a -> mono) -> [a] -> [Element mono]+concatMapL f = Prelude.concatMap (otoList . f)++concatMapML :: (Monad m, MonoFoldable mono)+             => (a -> m mono) -> [a] -> m [Element mono]+concatMapML f = liftM (Prelude.concatMap otoList) . Prelude.mapM f++concatL :: MonoFoldable mono+        => [mono] -> [Element mono]+concatL = Prelude.concatMap otoList++scanlML :: Monad m => (a -> b -> m a) -> a -> [b] -> m [a]+scanlML f = go+  where+    go l [] = return [l]+    go l (r:rs) = do+        l' <- f l r+        liftM (l:) (go l' rs)++mapAccumWhileL :: (a -> s -> Either s (s, b)) -> s -> [a] -> ([b], s)+mapAccumWhileL f = (runIdentity.) . mapAccumWhileML ((return.) . f)++mapAccumWhileML :: Monad m =>+    (a -> s -> m (Either s (s, b))) -> s -> [a] -> m ([b], s)+mapAccumWhileML f = go+    where go s []     = return ([], s)+          go s (a:as) = f a s >>= either+              (return . ([], ))+              (\(s', b) -> liftM (first (b:)) $ go s' as)++--FIXME: the following code is directly copied from the conduit test+--suite.  How to share this code??++qit :: (Arbitrary a, Testable prop, Show a)+     => String -> (a -> prop) -> Spec+qit n f = it n $ property $ forAll arbitrary f++--------------------------------------------------------------------------------+-- Quickcheck utilities for pure conduits / streams++checkProducer :: (Show a, Eq a) => ConduitT () a Identity () -> [a] -> Property+checkProducer c l  = checkProducerM' runIdentity c (return l)++checkStreamProducer :: (Show a, Eq a) => StreamSource Identity a -> [a] -> Property+checkStreamProducer s l = checkStreamProducerM' runIdentity s (return l)++checkInfiniteProducer :: (Show a, Eq a) => ConduitT () a Identity () -> [a] -> Property+checkInfiniteProducer c l = checkInfiniteProducerM' runIdentity c (return l)++checkInfiniteStreamProducer :: (Show a, Eq a) => StreamSource Identity a -> [a] -> Property+checkInfiniteStreamProducer s l = checkInfiniteStreamProducerM' runIdentity s (return l)++checkConsumer :: (Show b, Eq b) => ConduitT Int Void Identity b -> ([Int] -> b) -> Property+checkConsumer c l = checkConsumerM' runIdentity c (return . l)++checkStreamConsumer :: (Show b, Eq b) => StreamConduitT Int o Identity b -> ([Int] -> b) -> Property+checkStreamConsumer c l = checkStreamConsumerM' runIdentity c (return . l)++checkConduit :: (Show a, Arbitrary a, Show b, Eq b) => ConduitT a b Identity () -> ([a] -> [b]) -> Property+checkConduit c l = checkConduitT' runIdentity c (return . l)++checkStreamConduit :: (Show a, Arbitrary a, Show b, Eq b) => StreamConduit a Identity b -> ([a] -> [b]) -> Property+checkStreamConduit c l = checkStreamConduitT' runIdentity c (return . l)++-- checkConduitResult :: (Show a, Arbitrary a, Show b, Eq b, Show r, Eq r) => ConduitT a b Identity r -> ([a] -> ([b], r)) -> Property+-- checkConduitResult c l = checkConduitResultM' runIdentity c (return . l)++checkStreamConduitResult :: (Show a, Arbitrary a, Show b, Eq b, Show r, Eq r) => StreamConduitT a b Identity r -> ([a] -> ([b], r)) -> Property+checkStreamConduitResult c l = checkStreamConduitResultM' runIdentity c (return . l)++--------------------------------------------------------------------------------+-- Quickcheck utilities for conduits / streams in the M monad.++checkProducerM :: (Show a, Eq a) => ConduitT () a M () -> M [a] -> Property+checkProducerM = checkProducerM' runM++checkStreamProducerM :: (Show a, Eq a) => StreamSource M a -> M [a] -> Property+checkStreamProducerM = checkStreamProducerM' runM++checkInfiniteProducerM :: (Show a, Eq a) => ConduitT () a M () -> M [a] -> Property+checkInfiniteProducerM = checkInfiniteProducerM' (fst . runM)++checkInfiniteStreamProducerM :: (Show a, Eq a) => StreamSource M a -> M [a] -> Property+checkInfiniteStreamProducerM = checkInfiniteStreamProducerM' (fst . runM)++checkConsumerM :: (Show b, Eq b) => ConduitT Int Void M b -> ([Int] -> M b) -> Property+checkConsumerM  = checkConsumerM' runM++checkStreamConsumerM :: (Show b, Eq b) => StreamConduitT Int o M b -> ([Int] -> M b) -> Property+checkStreamConsumerM  = checkStreamConsumerM' runM++checkConduitT :: (Show a, Arbitrary a, Show b, Eq b) => ConduitT a b M () -> ([a] -> M [b]) -> Property+checkConduitT = checkConduitT' runM++checkStreamConduitT :: (Show a, Arbitrary a, Show b, Eq b) => StreamConduitT a b M () -> ([a] -> M [b]) -> Property+checkStreamConduitT = checkStreamConduitT' runM++-- checkConduitResultM :: (Show a, Arbitrary a, Show b, Eq b, Show r, Eq r) => ConduitT a b M r -> ([a] -> M ([b], r)) -> Property+-- checkConduitResultM = checkConduitResultM' runM++checkStreamConduitResultM :: (Show a, Arbitrary a, Show b, Eq b, Show r, Eq r) => StreamConduitT a b M r -> ([a] -> M ([b], r)) -> Property+checkStreamConduitResultM = checkStreamConduitResultM' runM++--------------------------------------------------------------------------------+-- Quickcheck utilities for monadic streams / conduits+-- These are polymorphic in which Monad is used.++checkProducerM' :: (Show a, Monad m, Show b, Eq b)+                => (m [a] -> b)+                -> ConduitT () a m ()+                -> m [a]+                -> Property+checkProducerM' f c l =+    f (runConduit $ preventFusion c .| sinkList)+    ===+    f l++checkStreamProducerM' :: (Show a, Monad m, Show b, Eq b)+                      => (m [a] -> b)+                      -> StreamConduitT () a m ()+                      -> m [a]+                      -> Property+checkStreamProducerM' f s l =+    f (liftM fst $ evalStream $ s emptyStream)+    ===+    f l++checkInfiniteProducerM' :: (Show a, Monad m, Show b, Eq b)+                        => (m [a] -> b)+                        -> ConduitT () a m ()+                        -> m [a]+                        -> Property+checkInfiniteProducerM' f s l =+    checkProducerM' f+        (preventFusion s .| take 10)+        (liftM (Prelude.take 10) l)++checkInfiniteStreamProducerM' :: (Show a, Monad m, Show b, Eq b)+                              => (m [a] -> b)+                              -> StreamConduitT () a m ()+                              -> m [a]+                              -> Property+checkInfiniteStreamProducerM' f s l =+    f (liftM snd $ evalStream $ takeS 10 $ s emptyStream)+    ===+    f (liftM (Prelude.take 10) l)++checkConsumerM' :: (Show a, Monad m, Show b, Eq b)+                => (m a -> b)+                -> ConduitT Int Void m a+                -> ([Int] -> m a)+                -> Property+checkConsumerM' f c l = forAll arbitrary $ \xs ->+    f (runConduit $ yieldMany xs .| preventFusion c)+    ===+    f (l xs)++checkStreamConsumerM' :: (Show a, Monad m, Show b, Eq b)+                      => (m a -> b)+                      -> StreamConduitT Int o m a+                      -> ([Int] -> m a)+                      -> Property+checkStreamConsumerM' f s l = forAll (arbitrary) $ \xs ->+    f (liftM snd $ evalStream $ s $ sourceListS xs emptyStream)+    ===+    f (l xs)++checkConduitT' :: (Show a, Arbitrary a, Monad m, Show c, Eq c)+               => (m [b] -> c)+               -> ConduitT a b m ()+               -> ([a] -> m [b])+               -> Property+checkConduitT' f c l = forAll arbitrary $ \xs ->+    f (runConduit $ yieldMany xs .| preventFusion c .| sinkList)+    ===+    f (l xs)++checkStreamConduitT' :: (Show a, Arbitrary a, Monad m, Show c, Eq c)+                     =>  (m [b] -> c)+                     -> StreamConduit a m b+                     -> ([a] -> m [b])+                     -> Property+checkStreamConduitT' f s l = forAll arbitrary $ \xs ->+    f (liftM fst $ evalStream $ s $ sourceListS xs emptyStream)+    ===+    f (l xs)++-- TODO: Fixing this would allow comparing conduit sinkListrs against+-- their list versions.+--+-- checkConduitResultM' :: (Show a, Arbitrary a, Monad m, Show c, Eq c)+--                      => (m ([b], r) -> c)+--                      -> ConduitT a b m r+--                      -> ([a] -> m ([b], r))+--                      -> Property+-- checkConduitResultM' f c l = FIXME forAll arbitrary $ \xs ->+--     f (runConduit $ yieldMany xs .| preventFusion c .| sinkList)+--     ===+--     f (l xs)++checkStreamConduitResultM' :: (Show a, Arbitrary a, Monad m, Show c, Eq c)+                           =>  (m ([b], r) -> c)+                           -> StreamConduitT a b m r+                           -> ([a] -> m ([b], r))+                           -> Property+checkStreamConduitResultM' f s l = forAll arbitrary $ \xs ->+    f (evalStream $ s $ sourceListS xs emptyStream)+    ===+    f (l xs)++emptyStream :: Monad m => Stream m () ()+emptyStream = Stream (\_ -> return $ Stop ()) (return ())++evalStream :: Monad m => Stream m o r -> m ([o], r)+evalStream (Stream step s0) = go =<< s0+  where+    go s = do+        res <- step s+        case res of+            Stop r -> return ([], r)+            Skip s' -> go s'+            Emit s' x -> liftM (\(l, r) -> (x:l, r)) (go s')++--------------------------------------------------------------------------------+-- Misc utilities++-- Prefer this to creating an orphan instance for Data.Monoid.Sum:++newtype Sum a = Sum a+  deriving (Eq, Show, Arbitrary)++instance Prelude.Num a => Semigroup (Sum a) where+  Sum x <> Sum y = Sum $ x Prelude.+ y+instance Prelude.Num a => Monoid (Sum a) where+  mempty = Sum 0+  mappend (Sum x) (Sum y) = Sum $ x Prelude.+ y++preventFusion :: a -> a+preventFusion = id+{-# INLINE [0] preventFusion #-}++newtype M a = M (StateT Int Identity a)+  deriving (Functor, Applicative, Monad)++instance Arbitrary a => Arbitrary (M a) where+    arbitrary = do+        f <- arbitrary+        return $ do+            s <- M get+            let (x, s') = f s+            M (put s')+            return x++runM :: M a -> (a, Int)+runM (M m) = runIdentity $ runStateT m 0++--------------------------------------------------------------------------------+-- Utilities from QuickCheck-2.7 (absent in earlier versions)++#if !MIN_VERSION_QuickCheck(2,7,0)+getBlind :: Blind a -> a+getBlind (Blind x) = x++-- | @Small x@: generates values of @x@ drawn from a small range.+-- The opposite of 'Large'.+newtype Small a = Small {getSmall :: a}+    deriving (Prelude.Ord, Prelude.Eq, Prelude.Enum, Prelude.Show, Prelude.Num)++instance Prelude.Integral a => Arbitrary (Small a) where+    arbitrary = Prelude.fmap Small arbitrarySizedIntegral+    shrink (Small x) = Prelude.map Small (shrinkIntegral x)++(===) :: (Show a, Eq a) => a -> a -> Property+x === y = whenFail+    (Prelude.fail $ Prelude.show x Prelude.++ " should match " Prelude.++ Prelude.show y)+    (x Prelude.== y)+#endif
+ test/doctests.hs view
@@ -0,0 +1,6 @@+module Main where++import Test.DocTest++main :: IO ()+main = doctest ["Data/Conduit.hs"]
test/main.hs view
@@ -1,450 +1,883 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE CPP #-}-import Test.Hspec.Monadic-import Test.Hspec.HUnit ()-import Test.Hspec.QuickCheck (prop)-import Test.HUnit--import qualified Data.Conduit as C-import qualified Data.Conduit.List as CL-import qualified Data.Conduit.Lazy as CLazy-import qualified Data.Conduit.Binary as CB-import qualified Data.Conduit.Text as CT-import Data.Conduit (runResourceT)-import Data.Maybe (fromMaybe)-import qualified Data.List as DL-import Control.Monad.ST (runST)-import Data.Monoid-import qualified Data.ByteString as S-import qualified Data.ByteString.Char8 as S8-import qualified Data.IORef as I-import qualified Data.ByteString.Lazy as L-import Data.ByteString.Lazy.Char8 ()-import qualified Data.Text as T-import qualified Data.Text.Lazy as TL-import qualified Data.Text.Lazy.Encoding as TLE-import Control.Monad.Trans.Resource (runExceptionT_, withIO, resourceForkIO)-import Control.Concurrent (threadDelay, killThread)-import Control.Monad.IO.Class (liftIO)-import Control.Applicative (pure, (<$>), (<*>))--main :: IO ()-main = hspecX $ do-    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-                  liftIO $ putStr $ unlines strings-                  CL.fold (+) 0-            40 @?= 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-                liftIO $ putStr $ unlines strings-                CL.fold (+) 0-            40 @?= x--    describe "filter" $ do-        it "even" $ do-            x <- runResourceT $ CL.sourceList [1..10] C.$$ CL.filter even C.=$ CL.consume-            x @?= filter even [1..10 :: Int]--    describe "ResourceT" $ do-        it "resourceForkIO" $ do-            counter <- I.newIORef 0-            let w = withIO-                        (I.atomicModifyIORef counter $ \i ->-                            (i + 1, ()))-                        (const $ I.atomicModifyIORef counter $ \i ->-                            (i - 1, ()))-            runResourceT $ do-                _ <- w-                _ <- resourceForkIO $ return ()-                _ <- resourceForkIO $ return ()-                sequence_ $ replicate 1000 $ do-                    tid <- resourceForkIO $ return ()-                    liftIO $ killThread tid-                _ <- resourceForkIO $ return ()-                _ <- resourceForkIO $ return ()-                return ()--            -- give enough of a chance to the cleanup code to finish-            threadDelay 1000-            res <- I.readIORef counter-            res @?= (0 :: Int)--    describe "sum" $ do-        it "works for 1..10" $ do-            x <- runResourceT $ CL.sourceList [1..10] C.$$ CL.fold (+) (0 :: Int)-            x @?= sum [1..10]-        prop "is idempotent" $ \list ->-            (runST $ runResourceT $ CL.sourceList list C.$$ CL.fold (+) (0 :: Int))-            == sum list--    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 @?= sum [1..10]-        it "mconcat" $ do-            x <- runResourceT $ mconcat-                [ CL.sourceList [1..5 :: Int]-                , CL.sourceList [6..10]-                , CL.sourceList [11..20]-                ] C.$$ CL.fold (+) 0-            x @?= sum [1..20]--    describe "file access" $ do-        it "read" $ do-            bs <- S.readFile "conduit.cabal"-            bss <- runResourceT $ CB.sourceFile "conduit.cabal" C.$$ CL.consume-            bs @=? S.concat bss--        it "read range" $ do-            S.writeFile "tmp" "0123456789"-            bss <- runResourceT $ CB.sourceFileRange "tmp" (Just 2) (Just 3) C.$$ CL.consume-            S.concat bss @?= "234"--        it "write" $ do-            runResourceT $ CB.sourceFile "conduit.cabal" C.$$ CB.sinkFile "tmp"-            bs1 <- S.readFile "conduit.cabal"-            bs2 <- S.readFile "tmp"-            bs1 @=? bs2--        it "conduit" $ do-            runResourceT $ CB.sourceFile "conduit.cabal"-                C.$= CB.conduitFile "tmp"-                C.$$ CB.sinkFile "tmp2"-            bs1 <- S.readFile "conduit.cabal"-            bs2 <- S.readFile "tmp"-            bs3 <- S.readFile "tmp2"-            bs1 @=? bs2-            bs1 @=? bs3--    describe "zipping" $ do-        it "zipping two small lists" $ do-            res <- runResourceT $ CL.zip (CL.sourceList [1..10]) (CL.sourceList [11..12]) C.$$ CL.consume-            res @=? zip [1..10 :: Int] [11..12 :: Int]--    describe "Monad instance for Sink" $ do-        it "binding" $ do-            x <- runResourceT $ CL.sourceList [1..10] C.$$ do-                _ <- CL.take 5-                CL.fold (+) (0 :: Int)-            x @?= sum [6..10]--    describe "Applicative instance for Sink" $ do-        it "<$> and <*>" $ do-            x <- runResourceT $ CL.sourceList [1..10] C.$$-                (+) <$> pure 5 <*> CL.fold (+) (0 :: Int)-            x @?= sum [1..10] + 5--    describe "resumable sources" $ do-        it "simple" $ do-            (x, y, z) <- runResourceT $ do-                bs <- C.bufferSource $ CL.sourceList [1..10 :: Int]-                x <- bs C.$$ CL.take 5-                y <- bs C.$$ CL.fold (+) 0-                z <- bs C.$$ CL.consume-                C.bsourceClose bs-                return (x, y, z)-            x @?= [1..5] :: IO ()-            y @?= sum [6..10]-            z @?= []--    describe "conduits" $ do-        it "map, left" $ do-            x <- runResourceT $-                CL.sourceList [1..10]-                    C.$= CL.map (* 2)-                    C.$$ CL.fold (+) 0-            x @?= 2 * sum [1..10 :: Int]--        it "map, right" $ do-            x <- runResourceT $-                CL.sourceList [1..10]-                    C.$$ CL.map (* 2)-                    C.=$ CL.fold (+) 0-            x @?= 2 * sum [1..10 :: Int]--        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 @?= 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 @?= DL.groupBy (==) input--        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 @?= 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-            x @?= sum (map (* 2) $ map (+ 5) [1..10 :: Int])--#if !FAST-    describe "isolate" $ do-        it "bound to resumable source" $ do-            (x, y) <- runResourceT $ do-                bsrc <- C.bufferSource $ CL.sourceList [1..10 :: Int]-                x <- bsrc C.$= CL.isolate 5 C.$$ CL.consume-                y <- bsrc C.$$ CL.consume-                return (x, y)-            x @?= [1..5]-            y @?= [6..10]--        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-                    y <- CL.consume-                    return (x, y)-            x @?= [1..5]-            y @?= [6..10]--        it "bound to sink, resumable" $ do-            (x, y) <- runResourceT $ do-                bsrc <- C.bufferSource $ CL.sourceList [1..10 :: Int]-                x <- bsrc C.$$ CL.isolate 5 C.=$ CL.consume-                y <- bsrc C.$$ CL.consume-                return (x, y)-            x @?= [1..5]-            y @?= [6..10]--        it "consumes all data" $ do-            x <- runResourceT $ CL.sourceList [1..10 :: Int] C.$$ do-                CL.isolate 5 C.=$ CL.sinkNull-                CL.consume-            x @?= [6..10]--    describe "lazy" $ do-        it' "works inside a ResourceT" $ runResourceT $ do-            counter <- liftIO $ I.newIORef 0-            let incr i = C.sourceIO-                    (liftIO $ I.newIORef $ C.IOOpen (i :: Int))-                    (const $ return ())-                    (\istate -> do-                        res <- liftIO $ I.atomicModifyIORef istate-                            (\state -> (C.IOClosed, state))-                        case res of-                            C.IOClosed -> return ()-                            _ -> do-                                count <- liftIO $ I.atomicModifyIORef counter-                                    (\j -> (j + 1, j + 1))-                                liftIO $ count @?= i-                        return res-                            )-            nums <- CLazy.lazyConsume $ mconcat $ map incr [1..10]-            liftIO $ nums @?= [1..10]--        it' "returns nothing outside ResourceT" $ do-            bss <- runResourceT $ CLazy.lazyConsume $ CB.sourceFile "test/main.hs"-            bss @?= []--    describe "sequence" $ do-        it "simple sink" $ do-            let sumSink :: C.Resource m => C.Sink Int m Int-                sumSink = do-                    ma <- CL.head-                    case ma of-                        Nothing -> return 0-                        Just a  -> (+a) . fromMaybe 0 <$> CL.head--            res <- runResourceT $ CL.sourceList [1..11]-                             C.$= C.sequence sumSink-                             C.$$ CL.consume-            res @?= [3, 7, 11, 15, 19, 11]--        it "sink with unpull behaviour" $ do-            let sumSink :: C.Resource m => C.Sink Int m Int-                sumSink = do-                    ma <- CL.head-                    case ma of-                        Nothing -> return 0-                        Just a  -> (+a) . fromMaybe 0 <$> CL.peek--            res <- runResourceT $ CL.sourceList [1..11]-                             C.$= C.sequence sumSink-                             C.$$ CL.consume-            res @?= [3, 5, 7, 9, 11, 13, 15, 17, 19, 21, 11]-           --    describe "sequenceSink" $ do-        it "simple sink" $ do-            let sink () = do-                    _ <- CL.drop 2-                    x <- CL.head-                    return $ C.Emit () $ maybe [] return x-            let conduit = C.sequenceSink () sink-            res <- runResourceT $ CL.sourceList [1..10 :: Int]-                           C.$= conduit-                           C.$$ CL.consume-            res @?= [3, 6, 9]-        it "finishes on new state" $ do-            let sink () = do-                x <- CL.head-                return $ C.Emit () $ maybe [] return x-            let conduit = C.sequenceSink () sink-            res <- runResourceT $ CL.sourceList [1..10 :: Int]-                        C.$= conduit C.$$ CL.consume-            res @?= [1..10]-        it "switch to a conduit" $ do-            let sink () = do-                _ <- CL.drop 4-                return $ C.StartConduit $ CL.filter even-            let conduit = C.sequenceSink () sink-            res <- runResourceT $ CL.sourceList [1..10 :: Int]-                            C.$= conduit-                            C.$$ CL.consume-            res @?= [6, 8, 10]-#endif--    describe "peek" $ do-        it "works" $ do-            (a, b) <- runResourceT $ CL.sourceList [1..10 :: Int] C.$$ do-                a <- CL.peek-                b <- CL.consume-                return (a, b)-            (a, b) @?= (Just 1, [1..10])--    describe "text" $ do-        let go enc tenc cenc = do-                prop (enc ++ " single chunk") $ \chars -> runST $ runExceptionT_ $ runResourceT $ do-                    let tl = TL.pack chars-                        lbs = tenc tl-                        src = CL.sourceList $ L.toChunks lbs-                    ts <- src C.$= CT.decode cenc C.$$ CL.consume-                    return $ TL.fromChunks ts == tl-                prop (enc ++ " many chunks") $ \chars -> runST $ runExceptionT_ $ runResourceT $ do-                    let tl = TL.pack chars-                        lbs = tenc tl-                        src = mconcat $ map (CL.sourceList . return . S.singleton) $ L.unpack lbs-                    ts <- src C.$= CT.decode cenc C.$$ CL.consume-                    return $ TL.fromChunks ts == tl-                prop (enc ++ " encoding") $ \chars -> runST $ runExceptionT_ $ runResourceT $ do-                    let tss = map T.pack chars-                        lbs = tenc $ TL.fromChunks tss-                        src = mconcat $ map (CL.sourceList . return) tss-                    bss <- src C.$= CT.encode cenc C.$$ CL.consume-                    return $ L.fromChunks bss == lbs-        go "utf8" TLE.encodeUtf8 CT.utf8-        go "utf16_le" TLE.encodeUtf16LE CT.utf16_le-        go "utf16_be" TLE.encodeUtf16BE CT.utf16_be-        go "utf32_le" TLE.encodeUtf32LE CT.utf32_le-        go "utf32_be" TLE.encodeUtf32BE CT.utf32_be--    describe "binary isolate" $ do-        it "works" $ do-            bss <- runResourceT $ CL.sourceList (replicate 1000 "X")-                           C.$= CB.isolate 6-                           C.$$ CL.consume-            S.concat bss @?= "XXXXXX"-    describe "unbuffering" $ do-        it "works" $ do-            x <- runResourceT $ do-                bsrc <- C.bufferSource $ CL.sourceList [1..10 :: Int]-                bsrc C.$$ CL.drop 5-                let src = C.unbufferSource bsrc-                src C.$$ CL.fold (+) 0-            x @?= sum [6..10]--    describe "properly using binary file reading" $ do-        it "sourceFile" $ do-            x <- runResourceT $ CB.sourceFile "test/random" C.$$ CL.consume-            lbs <- L.readFile "test/random"-            L.fromChunks x @?= lbs--    describe "binary head" $ do-        let go lbs = do-                x <- CB.head-                case (x, L.uncons lbs) of-                    (Nothing, Nothing) -> return True-                    (Just y, Just (z, lbs'))-                        | y == z -> go lbs'-                    _ -> return False--        prop "works" $ \bss' ->-            let bss = map S.pack bss'-             in runST $ runResourceT $-                CL.sourceList bss C.$$ go (L.fromChunks bss)-    describe "binary takeWhile" $ do-        prop "works" $ \bss' ->-            let bss = map S.pack bss'-             in runST $ runResourceT $ do-                bss2 <- CL.sourceList bss C.$$ CB.takeWhile (>= 5) C.=$ CL.consume-                return $ L.fromChunks bss2 == L.takeWhile (>= 5) (L.fromChunks bss)--    describe "binary dropWhile" $ do-        prop "works" $ \bss' ->-            let bss = map S.pack bss'-             in runST $ runResourceT $ do-                bss2 <- CL.sourceList bss C.$$ do-                    CB.dropWhile (< 5)-                    CL.consume-                return $ L.fromChunks bss2 == L.dropWhile (< 5) (L.fromChunks bss)--    describe "binary take" $ do-      let go n l = CL.sourceList l C.$$ do-          a <- CB.take n-          b <- CL.consume-          return (a, b)--      -- Taking nothing should result in an empty Bytestring-      it "nothing" $ do-        (a, b) <- runResourceT $ go 0 ["abc", "defg"]-        a              @?= L.empty-        L.fromChunks b @?= "abcdefg"--      it "normal" $ do-        (a, b) <- runResourceT $ go 4 ["abc", "defg"]-        a              @?= "abcd"-        L.fromChunks b @?= "efg"--      -- Taking exactly the data that is available should result in no-      -- leftover.-      it "all" $ do-        (a, b) <- runResourceT $ go 7 ["abc", "defg"]-        a @?= "abcdefg"-        b @?= []--      -- Take as much as possible.-      it "more" $ do-        (a, b) <- runResourceT $ go 10 ["abc", "defg"]-        a @?= "abcdefg"-        b @?= []--    describe "normalFuseLeft" $ do-        it "does not double close conduit" $ do-            x <- runResourceT $ do-                let src = CL.sourceList ["foobarbazbin"]-                src C.$= CB.isolate 10 C.$$ CL.head-            x @?= Just "foobarbazb"--    describe "bufferedFuseLeft" $ do-        it "does not double close conduit" $ do-            x <- runResourceT $ do-                bsrc <- C.bufferSource $ CL.sourceList ["foobarbazbin"]-                bsrc C.$= CB.isolate 10 C.$$ CL.head-            x @?= Just "foobarbazb"--    describe "binary" $ do-        prop "lines" $ \bss' -> runST $ runResourceT $ do-            let bss = map S.pack bss'-                bs = S.concat bss-                src = CL.sourceList bss-            res <- src C.$$ CB.lines C.=$ CL.consume-            return $ S8.lines bs == res--it' :: String -> IO () -> Specs-it' = it+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE FlexibleInstances #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+import Test.Hspec+import Test.Hspec.QuickCheck (prop)+import Test.QuickCheck (getPositive)+import Test.QuickCheck.Monadic (assert, monadicIO, run)++import Data.Conduit (runConduit, (.|), ConduitT, runConduitPure, runConduitRes)+import qualified Data.Conduit as C+import qualified Data.Conduit.Lift as C+import qualified Data.Conduit.Internal as CI+import qualified Data.Conduit.List as CL+import Data.Typeable (Typeable)+import Control.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 (liftIO)+import Control.Monad.Trans.Class (lift)+import Control.Monad.Trans.Writer (execWriter, tell, runWriterT)+import Control.Monad.Trans.State (evalStateT, get, put)+import qualified Control.Monad.Writer as W+import Control.Applicative (pure, (<$>), (<*>), liftA2)+import qualified Control.Monad.Catch as Catch+import Data.Functor.Identity (Identity,runIdentity)+import Control.Monad (forever, void)+import Data.Void (Void)+import qualified Control.Concurrent.MVar as M+import Control.Monad.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]) -> ConduitT a b Identity () -> [a] -> Bool+equivToList f conduit xs =+  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 <- 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 <- 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 <- 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++    describe "mapFoldable" $ do+        prop "list" $+            equivToList (concatMap (:[]) :: [Int]->[Int]) (CL.mapFoldable  (:[]))+        let f x = if odd x then Just x else Nothing+        prop "Maybe" $+            equivToList (catMaybes . map f :: [Int]->[Int]) (CL.mapFoldable f)++    prop "scan" $ equivToList (tail . scanl (+) 0 :: [Int]->[Int]) (void $ CL.scan (+) 0)++    -- mapFoldableM and scanlM are fully polymorphic in type of monad+    -- so it suffice to check only with Identity.+    describe "mapFoldableM" $ do+        prop "list" $+            equivToList (concatMap (:[]) :: [Int]->[Int]) (CL.mapFoldableM (return . (:[])))+        let f x = if odd x then Just x else Nothing+        prop "Maybe" $+            equivToList (catMaybes . map f :: [Int]->[Int]) (CL.mapFoldableM (return . f))++    prop "scanM" $ equivToList (tail . scanl (+) 0) (void $ CL.scanM (\a s -> return $ a + s) (0 :: Int))++    describe "ResourceT" $ do+        it "resourceForkIO" $ do+            counter <- I.newIORef 0+            let w = allocate+                        (I.atomicModifyIORef counter $ \i ->+                            (i + 1, ()))+                        (const $ I.atomicModifyIORef counter $ \i ->+                            (i - 1, ()))+            runResourceT $ do+                _ <- w+                _ <- resourceForkIO $ return ()+                _ <- resourceForkIO $ return ()+                sequence_ $ replicate 1000 $ do+                    tid <- resourceForkIO $ return ()+                    liftIO $ killThread tid+                _ <- resourceForkIO $ return ()+                _ <- resourceForkIO $ return ()+                return ()++            -- give enough of a chance to the cleanup code to finish+            threadDelay 1000+            res <- I.readIORef counter+            res `shouldBe` (0 :: Int)++    describe "sum" $ do+        it "works for 1..10" $ do+            x <- runConduitRes $ CL.sourceList [1..10] .| CL.fold (+) (0 :: Int)+            x `shouldBe` sum [1..10]+        prop "is idempotent" $ \list ->+            (runST $ runConduit $ CL.sourceList list .| CL.fold (+) (0 :: Int))+            == sum list++    describe "foldMap" $ do+        it "sums 1..10" $ do+            Sum x <- runConduit $ CL.sourceList [1..(10 :: Int)] .| CL.foldMap Sum+            x `shouldBe` sum [1..10]++        it "preserves order" $ do+            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 <- runConduit $ CL.sourceList [1..(10 :: Int)] .| CL.foldMapM (return . Sum)+            x `shouldBe` sum [1..10]++        it "preserves order" $ do+            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+        it "works" $ do+            let f 0 = Nothing+                f i = Just (show i, i - 1)+                seed = 10 :: Int+            x <- runConduit $ CL.unfold f seed .| CL.consume+            let y = DL.unfoldr f seed+            x `shouldBe` y++    describe "unfoldM" $ do+        it "works" $ do+            let f 0 = Nothing+                f i = Just (show i, i - 1)+                seed = 10 :: Int+            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 <- runConduitRes $ (CL.sourceList [1..5 :: Int] `mappend` CL.sourceList [6..10]) .| CL.fold (+) 0+            x `shouldBe` sum [1..10]+        it "mconcat" $ do+            x <- runConduitRes $ mconcat+                [ CL.sourceList [1..5 :: Int]+                , CL.sourceList [6..10]+                , CL.sourceList [11..20]+                ] .| CL.fold (+) 0+            x `shouldBe` sum [1..20]++    describe "zipping" $ do+        it "zipping two small lists" $ do+            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 <- 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 <- 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 <- 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 <- 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 <- 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) <- runConduitRes $ do+                let src1 = CL.sourceList [1..10 :: Int]+                (src2, x) <- src1 C.$$+ CL.take 5+                (src3, y) <- src2 C.$$++ CL.fold (+) 0+                z <- src3 C.$$+- CL.consume+                return (x, y, z)+            x `shouldBe` [1..5] :: IO ()+            y `shouldBe` sum [6..10]+            z `shouldBe` []++    describe "conduits" $ do+        it "map, left" $ do+            x <- runConduitRes $+                CL.sourceList [1..10]+                    .| CL.map (* 2)+                    .| CL.fold (+) 0+            x `shouldBe` 2 * sum [1..10 :: Int]++        it "map, left >+>" $ do+            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 <- runConduitRes $+                CL.sourceList [1..10]+                    .| CL.map (* 2)+                    .| CL.fold (+) 0+            x `shouldBe` 2 * sum [1..10 :: Int]++        prop "chunksOf" $ \(positive, xs) ->+            let p = getPositive positive+                conduit = CL.sourceList xs .| CL.chunksOf p .| CL.consume+            in DLS.chunksOf p (xs :: [Int]) == runConduitPure conduit++        it "chunksOf (zero)" $+            let conduit = return () .| CL.chunksOf 0 .| CL.consume+            in evaluate (runConduitPure conduit) `shouldThrow` anyException++        it "chunksOf (negative)" $+            let conduit = return () .| CL.chunksOf (-5) .| CL.consume+            in evaluate (runConduitPure conduit) `shouldThrow` anyException++        it "groupBy" $ do+            let input = [1::Int, 1, 2, 3, 3, 3, 4, 5, 5]+            x <- 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 <- 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 <- 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 <- 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 <- 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 <- 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 <- runConduitRes $ CL.sourceList input+                    .| CL.catMaybes+                    .| CL.consume+            x `shouldBe` [1, 2, 3]++        it "concatMap" $ do+            let input = [1, 11, 21]+            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) .| 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) <- runConduitRes $ do+                let src1 = CL.sourceList [1..10 :: Int]+                (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) <- 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) <- runConduitRes $ do+                let src1 = CL.sourceList [1..10 :: Int]+                (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 <- runConduitRes $ CL.sourceList [1..10 :: Int] .| do+                CL.isolate 5 .| CL.sinkNull+                CL.consume+            x `shouldBe` [6..10]++    describe "sequence" $ do+        it "simple sink" $ do+            let sumSink = do+                    ma <- CL.head+                    case ma of+                        Nothing -> return 0+                        Just a  -> (+a) . fromMaybe 0 <$> CL.head++            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+            let sumSink = do+                    ma <- CL.head+                    case ma of+                        Nothing -> return 0+                        Just a  -> (+a) . fromMaybe 0 <$> CL.peek++            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) <- runConduitRes $ CL.sourceList [1..10 :: Int] .| do+                a <- CL.peek+                b <- CL.consume+                return (a, b)+            (a, b) `shouldBe` (Just 1, [1..10])++    describe "unbuffering" $ do+        it "works" $ 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 .|" $+            runConduitPure+            (    CL.sourceList [1..10 :: Int]+              .| 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 =$" $+            runConduitPure+            (    CL.sourceList [1..10 :: Int]+              .| 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 <-    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 <- runConduit $ src .| CL.head+            x `shouldBe` Just ()+        it "bracket" $ do+            ref <- I.newIORef (0 :: Int)+            let src = C.bracketP+                    (I.modifyIORef ref (+ 1))+                    (\() -> I.modifyIORef ref (+ 2))+                    (\() -> forever $ C.yield (1 :: Int))+            val <- runConduitRes $ src .| CL.isolate 10 .| CL.fold (+) 0+            val `shouldBe` 10+            i <- I.readIORef ref+            i `shouldBe` 3+        it "bracket skipped if not needed" $ do+            ref <- I.newIORef (0 :: Int)+            let src = C.bracketP+                    (I.modifyIORef ref (+ 1))+                    (\() -> I.modifyIORef ref (+ 2))+                    (\() -> forever $ C.yield (1 :: Int))+                src' = CL.sourceList $ repeat 1+            val <- runConduitRes $ (src' >> src) .| CL.isolate 10 .| CL.fold (+) 0+            val `shouldBe` 10+            i <- I.readIORef ref+            i `shouldBe` 0+        it "bracket + toPipe" $ do+            ref <- I.newIORef (0 :: Int)+            let src = C.bracketP+                    (I.modifyIORef ref (+ 1))+                    (\() -> I.modifyIORef ref (+ 2))+                    (\() -> forever $ C.yield (1 :: Int))+            val <- runConduitRes $ src .| CL.isolate 10 .| CL.fold (+) 0+            val `shouldBe` 10+            i <- I.readIORef ref+            i `shouldBe` 3+        it "bracket skipped if not needed" $ do+            ref <- I.newIORef (0 :: Int)+            let src = C.bracketP+                    (I.modifyIORef ref (+ 1))+                    (\() -> I.modifyIORef ref (+ 2))+                    (\() -> forever $ C.yield (1 :: Int))+                src' = CL.sourceList $ repeat 1+            val <- runConduitRes $ (src' >> src) .| CL.isolate 10 .| CL.fold (+) 0+            val `shouldBe` 10+            i <- I.readIORef ref+            i `shouldBe` 0++    describe "invariant violations" $ do+        it "leftovers without input" $ do+            ref <- I.newIORef []+            let add x = I.modifyIORef ref (x:)+                adder' = CI.NeedInput (\a -> liftIO (add a) >> adder') return+                adder = CI.ConduitT (adder' >>=)+                residue x = CI.ConduitT $ \rest -> CI.Leftover (rest ()) x++            _ <- runConduit $ C.yield 1 .| adder+            x <- I.readIORef ref+            x `shouldBe` [1 :: Int]+            I.writeIORef ref []++            _ <- runConduit $ C.yield 1 .| ((residue 2 >> residue 3) >> adder)+            y <- I.readIORef ref+            y `shouldBe` [1, 2, 3]+            I.writeIORef ref []++            _ <- runConduit $ C.yield 1 .| (residue 2 >> (residue 3 >> adder))+            z <- I.readIORef ref+            z `shouldBe` [1, 2, 3]+            I.writeIORef ref []++    describe "sane yield/await'" $ do+        it' "yield terminates" $ do+            let is = [1..10] ++ undefined+                src [] = return ()+                src (x:xs) = C.yield x >> src xs+            x <- runConduit $ src is .| CL.take 10+            x `shouldBe` [1..10 :: Int]+        it' "yield terminates (2)" $ do+            let is = [1..10] ++ undefined+            x <- runConduit $ mapM_ C.yield is .| CL.take 10+            x `shouldBe` [1..10 :: Int]++    describe "upstream results" $ do+        it' "works" $ do+            let foldUp :: (b -> a -> b) -> b -> CI.Pipe l a Void u IO (u, b)+                foldUp f b = CI.awaitE >>= either (\u -> return (u, b)) (\a -> let b' = f b a in b' `seq` foldUp f b')+                passFold :: (b -> a -> b) -> b -> CI.Pipe l a a () IO b+                passFold f b = CI.await >>= maybe (return b) (\a -> let b' = f b a in b' `seq` CI.yield a >> passFold f b')+            (x, y) <- CI.runPipe $ mapM_ CI.yield [1..10 :: Int] CI.>+> passFold (+) 0 CI.>+>  foldUp (*) 1+            (x, y) `shouldBe` (sum [1..10], product [1..10])++    describe "input/output mapping" $ do+        it' "mapOutput" $ do+            x <- runConduit $ C.mapOutput (+ 1) (CL.sourceList [1..10 :: Int]) .| CL.fold (+) 0+            x `shouldBe` sum [2..11]+        it' "mapOutputMaybe" $ do+            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 <- runConduit $ (CL.sourceList $ map show [1..10 :: Int]) .| do+                (x, y) <- C.mapInput read (Just . show) $ ((do+                    x <- CL.isolate 5 .| CL.fold (+) 0+                    y <- CL.peek+                    return (x :: Int, y :: Maybe Int)) :: ConduitT Int Void IO (Int, Maybe Int))+                z <- CL.consume+                return (x, y, concat z)++            xyz `shouldBe` (sum [1..5], Just 6, "678910")++    describe "left/right identity" $ do+        it' "left identity" $ do+            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 $ (\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+        it' "works" $ do+            x <-     CI.runPipe+                   $ CI.sourceToPipe  (CL.sourceList [1..10 :: Int])+               CI.>+> CI.conduitToPipe (CL.map (+ 1))+               CI.>+> CI.sinkToPipe    (CL.fold (+) 0)+            x `shouldBe` sum [2..11]++    describe "withUpstream" $ do+        it' "works" $ do+            let src = mapM_ CI.yield [1..10 :: Int] >> return True+                fold f =+                    loop+                  where+                    loop accum =+                        CI.await >>= maybe (return accum) go+                      where+                        go a =+                            let accum' = f accum a+                             in accum' `seq` loop accum'+                sink = CI.withUpstream $ fold (+) 0+            res <- CI.runPipe $ src CI.>+> sink+            res `shouldBe` (True, sum [1..10])++    describe "iterate" $ do+        it' "works" $ do+            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 <- runConduit $ CL.replicate cnt () .| CL.consume+        res `shouldBe` replicate cnt ()++    prop "replicateM" $ \cnt' -> do+        ref <- I.newIORef 0+        let cnt = min cnt' 100+        res <- runConduit $ CL.replicateM cnt (I.modifyIORef ref (+ 1)) .| CL.consume+        res `shouldBe` replicate cnt ()++        ref' <- I.readIORef ref+        ref' `shouldBe` (if cnt' <= 0 then 0 else cnt)++    describe "injectLeftovers" $ do+        it "works" $ do+            let src = mapM_ CI.yield [1..10 :: Int]+                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 <- runConduit $ CI.ConduitT ((src CI.>+> CI.injectLeftovers conduit) >>=) .| CL.consume+            res `shouldBe` [1..10]+    describe "monad transformer laws" $ do+        it "transPipe" $ do+            let source = CL.sourceList $ replicate 10 ()+            let tell' x = tell [x :: Int]++            let replaceNum1 = C.awaitForever $ \() -> do+                    i <- lift get+                    lift $ (put $ i + 1) >> (get >>= lift . tell')+                    C.yield i++            let replaceNum2 = C.awaitForever $ \() -> do+                    i <- lift get+                    lift $ put $ i + 1+                    lift $ get >>= lift . tell'+                    C.yield i++            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+                runConduit $ CL.sourceList l .| counter ref .| CL.mapM_ (const $ return ())+                M.readMVar ref++            assert $ v == length (l :: [Int])+        prop "mapM_ equivalence" $ \l -> monadicIO $ do+            let runTest h = run $ do+                    ref <- M.newMVar (0 :: Int)+                    let f = action ref+                    s <- runConduit $ CL.sourceList (l :: [Int]) .| h f .| CL.fold (+) 0+                    c <- M.readMVar ref++                    return (c, s)++                action ref = const $ liftIO $ M.modifyMVar_ ref (\i -> return $! i + 1)+            (c1, s1) <- runTest CL.iterM+            (c2, s2) <- runTest (\f -> CL.mapM (\a -> f a >>= \() -> return a))++            assert $ c1 == c2+            assert $ s1 == s2++    describe "generalizing" $ do+        it "works" $ do+            let src :: Int -> ConduitT () Int IO ()+                src i = CL.sourceList [1..i]+                sink :: ConduitT Int Void IO Int+                sink = CL.fold (+) 0+            res <- runConduit $ C.yield 10 .| C.awaitForever (C.toProducer . src) .| (C.toConsumer sink >>= C.yield) .| C.await+            res `shouldBe` Just (sum [1..10])++    describe "mergeSource" $ do+        it "works" $ do+            let src :: ConduitT () String IO ()+                src = CL.sourceList ["A", "B", "C"]+                withIndex :: ConduitT String (Integer, String) IO ()+                withIndex = CI.mergeSource (CL.sourceList [1..])+            output <- runConduit $ src .| withIndex .| CL.consume+            output `shouldBe` [(1, "A"), (2, "B"), (3, "C")]+        it "does stop processing when the source exhausted" $ do+            let src :: ConduitT () Integer IO ()+                src = CL.sourceList [1..]+                withShortAlphaIndex :: ConduitT Integer (String, Integer) IO ()+                withShortAlphaIndex = CI.mergeSource (CL.sourceList ["A", "B", "C"])+            output <- runConduit $ src .| withShortAlphaIndex .| CL.consume+            output `shouldBe` [("A", 1), ("B", 2), ("C", 3)]+        it "does not drop upstream items" $ do+            let num = CL.sourceList [1 .. 10 :: Int]+            let chr = CL.sourceList ['a' .. 'c']+            (output, remainder) <- runConduit $ num .| liftA2 (,) (CI.mergeSource chr .| CL.consume) CL.consume+            output `shouldBe` [('a', 1), ('b', 2), ('c', 3)]+            remainder `shouldBe` [4 .. 10]++    describe "passthroughSink" $ do+        it "works" $ do+            ref <- I.newIORef (-1)+            let sink = CL.fold (+) (0 :: Int)+                conduit = C.passthroughSink sink (I.writeIORef ref)+                input = [1..10]+            output <- runConduit $ mapM_ C.yield input .| conduit .| CL.consume+            output `shouldBe` input+            x <- I.readIORef ref+            x `shouldBe` sum input+        it "does nothing when downstream does nothing" $ do+            ref <- I.newIORef (-1)+            let sink = CL.fold (+) (0 :: Int)+                conduit = C.passthroughSink sink (I.writeIORef ref)+                input = [undefined]+            runConduit $ mapM_ C.yield input .| conduit .| return ()+            x <- I.readIORef ref+            x `shouldBe` (-1)++        it "handles the last input correctly #304" $ do+            ref <- I.newIORef (-1 :: Int)+            let sink = CL.mapM_ (I.writeIORef ref)+                conduit = C.passthroughSink sink (const (return ()))+            res <- runConduit $ mapM_ C.yield [1..] .| conduit .| CL.take 5+            res `shouldBe` [1..5]+            x <- I.readIORef ref+            x `shouldBe` 5++    describe "mtl instances" $ do+        it "ErrorT" $ do+            let src = flip catchError (const $ C.yield 4) $ do+                    lift $ return ()+                    C.yield 1+                    lift $ return ()+                    C.yield 2+                    lift $ return ()+                    () <- throwError DummyError+                    lift $ return ()+                    C.yield 3+                    lift $ return ()+            runConduit (src .| CL.consume) `shouldBe` Right [1, 2, 4 :: Int]+        describe "WriterT" $+            it "pass" $+                let writer = W.pass $ do+                      W.tell [1 :: Int]+                      pure ((), (2:))+                in execWriter (runConduit writer) `shouldBe` [2, 1]++    describe "Data.Conduit.Lift" $ do+        it "execStateC" $ do+            let sink = C.execStateLC 0 $ CL.mapM_ $ modify . (+)+                src = mapM_ C.yield [1..10 :: Int]+            res <- 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 <- runConduit $ src .| sink+            res `shouldBe` [1..10]++        it "runExceptC" $ do+            let sink = C.runExceptC $ do+                    x <- C.catchExceptC (lift $ throwError "foo") return+                    return $ x ++ "bar"+            res <- runConduit $ return () .| sink+            res `shouldBe` Right ("foobar" :: String)++        it "runMaybeC" $ do+            let src = void $ C.runMaybeC $ do+                    C.yield 1+                    () <- lift $ MaybeT $ return Nothing+                    C.yield 2+                sink = CL.consume+            res <- runConduit $ src .| sink+            res `shouldBe` [1 :: Int]++    describe "sequenceSources" $ do+        it "works" $ do+            let src1 = mapM_ C.yield [1, 2, 3 :: Int]+                src2 = mapM_ C.yield [3, 2, 1]+                src3 = mapM_ C.yield $ repeat 2+                srcs = C.sequenceSources $ Map.fromList+                    [ (1 :: Int, src1)+                    , (2, src2)+                    , (3, src3)+                    ]+            res <- runConduit $ srcs .| CL.consume+            res `shouldBe`+                [ Map.fromList [(1, 1), (2, 3), (3, 2)]+                , Map.fromList [(1, 2), (2, 2), (3, 2)]+                , Map.fromList [(1, 3), (2, 1), (3, 2)]+                ]+    describe "zipSink" $ do+        it "zip equal-sized" $ do+            x <- runConduitRes $+                    CL.sourceList [1..100] .|+                    C.sequenceSinks [ CL.fold (+) 0,+                                   (`mod` 101) <$> CL.fold (*) 1 ]+            x `shouldBe` [5050, 100 :: Integer]++        it "zip distinct sizes" $ do+            let sink = C.getZipSink $+                        (*) <$> C.ZipSink (CL.fold (+) 0)+                            <*> C.ZipSink (Data.Maybe.fromJust <$> C.await)+            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 .| CL.fold (+) 0+                downstream = C.fuseBoth upstream CL.consume+            res <- runConduit $ CL.sourceList [1..10 :: Int] .| do+                (x, y) <- downstream+                z <- CL.consume+                return (x, y, z)+            res `shouldBe` (sum [1..5], ["hello"], [6..10])++        it "fuseBothMaybe with no result" $ do+            let src = mapM_ C.yield [1 :: Int ..]+                sink = CL.isolate 5 .| CL.fold (+) 0+            (mup, down) <- runConduit $ C.fuseBothMaybe src sink+            mup `shouldBe` (Nothing :: Maybe ())+            down `shouldBe` sum [1..5]++        it "fuseBothMaybe with result" $ do+            let src = mapM_ C.yield [1 :: Int .. 5]+                sink = CL.isolate 6 .| CL.fold (+) 0+            (mup, down) <- runConduit $ C.fuseBothMaybe src sink+            mup `shouldBe` Just ()+            down `shouldBe` sum [1..5]++        it "fuseBothMaybe with almost result" $ do+            let src = mapM_ C.yield [1 :: Int .. 5]+                sink = CL.isolate 5 .| CL.fold (+) 0+            (mup, down) <- runConduit $ C.fuseBothMaybe src sink+            mup `shouldBe` (Nothing :: Maybe ())+            down `shouldBe` sum [1..5]++    describe "catching exceptions" $ do+        it "works" $ do+            let src = do+                    C.yield 1+                    () <- Catch.throwM DummyError+                    C.yield 2+                src' = do+                    CI.catchC src (\DummyError -> C.yield (3 :: Int))+            res <- runConduit $ src' .| CL.consume+            res `shouldBe` [1, 3]++    describe "sourceToList" $ do+        it "works lazily in Identity" $ do+            let src = C.yield 1 >> C.yield 2 >> throw DummyError+            let res = runIdentity $ C.sourceToList src+            take 2 res `shouldBe` [1, 2 :: Int]+        it "is not lazy in IO" $ do+            let src = C.yield 1 >> C.yield (2 :: Int) >> throw DummyError+            C.sourceToList src `shouldThrow` (==DummyError)++    ZipConduit.spec+    Stream.spec++it' :: String -> IO () -> Spec+it' = it++data DummyError = DummyError+    deriving (Show, Eq, Typeable)+instance Catch.Exception DummyError
− test/random

binary file changed (1024 → absent bytes)

+ test/subdir/dummyfile.txt view