simple-conduit 0.2.0 → 0.3.0

raw patch · 3 files changed

+398/−424 lines, 3 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• Conduit/Simple.hs +382/−421
• simple-conduit.cabal +2/−1
• test/bench.hs +14/−2

@@ -2,7 +2,7 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE ScopedTypeVariables #-}  -- | Please see the project README for more details: --@@ -21,19 +21,19 @@ import           Control.Foldl import           Control.Monad hiding (mapM) import           Control.Monad.Base-import           Control.Monad.Catch hiding (bracket)+import           Control.Monad.Catch hiding (bracket, catch) import           Control.Monad.IO.Class import           Control.Monad.Morph import           Control.Monad.Primitive import           Control.Monad.Trans.Control import           Control.Monad.Trans.Either-import           Control.Monad.Trans.State import           Data.Bifunctor import           Data.Builder import           Data.ByteString hiding (hPut, putStrLn)-import           Data.Foldable-import           Data.Functor.Identity import           Data.IOData+{-+import           Data.IORef+-} import           Data.MonoTraversable import           Data.Monoid import           Data.NonNull as NonNull@@ -49,77 +49,59 @@ import           System.IO import           System.Random.MWC as MWC --- | In the type variable below, r stands for "result", with much the same---   meaning as you find in 'ContT'.  a is the type of each element in the---   "stream".  The type of Source should recall 'foldM':+-- | The type of Source should recall 'foldM': -- -- @ -- Monad m => (a -> b -> m a) -> a -> [b] -> m a -- @ ----- 'EitherT' is used to signal short-circuiting of the pipeline.-type Source m a r    = r -> (r -> a -> EitherT r m r) -> EitherT r m r-type Conduit a m b r = Source m a r -> Source m b r-type Sink a m r      = Source m a r -> m r---- | When wrapped in a 'SourceWrapper' using 'wrap', Sources offer a number of---   typeclass instances, one of which is Monad.  As a Monad, it behaves very---   much list the list monad: the value bound is each element of the---   iteration in turn.------ @--- sinkList $ getSource $ do---     x <- wrap $ yieldMany [1..3]---     y <- wrap $ yieldMany [4..6]---     wrap $ yieldOne (x, y)------ ==> [(1,4),(1,5),(1,6),(2,4),(2,5),(2,6),(3,4),(3,5),(3,6)]--- @-newtype SourceWrapper m a = SourceWrapper { getSource :: forall r. Source m a r }+-- 'EitherT' is used to signal short-circuiting of the pipeline.  If it+-- weren't for conduits like 'dropC' and 'takeC', we would not need it most of+-- the time.+newtype Source m a = Source+    { getSource :: forall r. r -> (r -> a -> EitherT r m r) -> EitherT r m r } -wrap :: (forall r. Source m a r) -> SourceWrapper m a-wrap = SourceWrapper+type Conduit a m b = Source m a -> Source m b+type Sink a m r    = Source m a -> m r -instance Monad m => Monoid (SourceWrapper m a) where-    mempty = SourceWrapper $ \z _ -> return z-    SourceWrapper x `mappend` SourceWrapper y = SourceWrapper $ x <+> y+instance Monad m => Monoid (Source m a) where+    mempty = Source $ const . return+    mappend x y = Source $ \r f -> flip (getSource y) f =<< getSource x r f -instance Foldable (SourceWrapper Identity) where-    foldMap f (SourceWrapper await) =-        runIdentity $ resolve await mempty $ \r x -> return $ r <> f x+instance Functor (Source m) where+    fmap f (Source await) = Source $ \z yield -> await z $ \r x -> yield r (f x) -instance Functor (SourceWrapper m) where-    fmap f (SourceWrapper await) =-        SourceWrapper $ \z yield -> await z $ \r x -> yield r (f x)+instance Applicative (Source m) where+    pure  = return+    (<*>) = ap -instance Applicative (SourceWrapper m) where-    pure x = SourceWrapper $ \z yield -> yield z x-    SourceWrapper f <*> SourceWrapper g =-        SourceWrapper $ \z yield ->-            f z $ \r x ->-                g r $ \r' y ->-                    yield r' (x y)+instance Monad (Source m) where+    return x = Source $ \z yield -> yield z x+    Source await >>= f = Source $ \z yield ->+        await z $ \r x -> getSource (f x) r $ \r' y -> yield r' y -instance Monad (SourceWrapper m) where-    return = pure-    SourceWrapper await >>= f =-        SourceWrapper $ \z yield ->-            await z $ \r x ->-                getSource (f x) r $ \r' y ->-                    yield r' y+instance MonadIO m => MonadIO (Source m) where+    liftIO m = Source $ \z yield -> yield z =<< liftIO m -newtype SinkWrapper a m r = SinkWrapper { getSink :: SourceWrapper m a -> m r }+instance MonadTrans Source where+    lift m = Source $ \z yield -> yield z =<< lift m -instance Monad m => Functor (SinkWrapper a m) where-    fmap f (SinkWrapper k) = SinkWrapper $ \await -> f `liftM` k await+-- | Sequence a collection of sources.+--+-- >>> sinkList $ sequenceSources [yieldOne 1, yieldOne 2, yieldOne 3]+-- [[1,2,3]]+sequenceSources :: (Traversable f, Monad m) => f (Source m a) -> Source m (f a)+sequenceSources = sequenceA  -- | Promote any sink to a source.  This can be used as if it were a source --   transformer (aka, a conduit): ----- >>> sinkList $ returnC $ sumC $ mapC (+1) $ sourceList [1..10]+-- >>> sinkList $ returnC $ sumC $ mapC (+1) $ yieldMany [1..10] -- [65]-returnC :: Monad m => m a -> Source m a r-returnC f z yield = yield z =<< lift f+--+-- Note that 'returnC' is a synonym for 'Control.Monad.Trans.Class.lift'.+returnC :: Monad m => m a -> Source m a+returnC = lift  -- | Compose a 'Source' and a 'Conduit' into a new 'Source'.  Note that this --   is just flipped function application, so ($) can be used to achieve the@@ -160,128 +142,164 @@ resolve await z f = either id id `liftM` runEitherT (await z f) {-# INLINE resolve #-} -yieldMany :: (Monad m, MonoFoldable mono) => mono -> Source m (Element mono) r-yieldMany xs z yield = ofoldlM yield z xs+yieldMany :: (Monad m, MonoFoldable mono) => mono -> Source m (Element mono)+yieldMany xs = Source $ \z yield -> ofoldlM yield z xs {-# INLINE yieldMany #-} -yieldOne :: Monad m => a -> Source m a r-yieldOne x z yield = yield z x+sourceList :: (Monad m, MonoFoldable mono) => mono -> Source m (Element mono)+sourceList = yieldMany+{-# INLINE sourceList #-}++yieldOne :: Monad m => a -> Source m a+yieldOne x = Source $ \z yield -> yield z x {-# INLINE yieldOne #-} -unfoldC :: Monad m => (b -> Maybe (a, b)) -> b -> Source m a r-unfoldC f i z yield = go i z+unfoldC :: forall m a b. Monad m => (b -> Maybe (a, b)) -> b -> Source m a+unfoldC f i = Source $ go i   where-    go x y = case f x of-        Nothing      -> return y-        Just (a, x') -> go x' =<< yield y a+    go :: forall r. b -> r -> (r -> a -> EitherT r m r) -> EitherT r m r+    go y z yield = loop y z+      where+        loop x r = case f x of+            Nothing      -> return r+            Just (a, x') -> loop x' =<< yield r a -enumFromToC :: (Monad m, Enum a, Eq a) => a -> a -> Source m a r-enumFromToC start stop z yield = go start z+enumFromToC :: forall m a. (Monad m, Enum a, Eq a) => a -> a -> Source m a+enumFromToC start stop = Source $ go start   where-    go a r-        | a == stop = return r-        | otherwise = go (succ a) =<< yield r a+    go :: forall r. a -> r -> (r -> a -> EitherT r m r) -> EitherT r m r+    go y z yield = loop y z+      where+        loop a r+            | a == stop = return r+            | otherwise = loop (succ a) =<< yield r a -iterateC :: Monad m => (a -> a) -> a -> Source m a r-iterateC f i z yield = go i z+iterateC :: forall m a. Monad m => (a -> a) -> a -> Source m a+iterateC f i = Source $ go i   where-    go x y = let x' = f x-             in go x' =<< yield y x'+    go :: forall r. a -> r -> (r -> a -> EitherT r m r) -> EitherT r m r+    go y z yield = loop y z+      where+        loop x r = let x' = f x+                   in loop x' =<< yield r x' -repeatC :: Monad m => a -> Source m a r-repeatC x z yield = go z where go y = go =<< yield y x+repeatC :: forall m a. Monad m => a -> Source m a+repeatC x = Source go+  where+    go :: forall r. r -> (r -> a -> EitherT r m r) -> EitherT r m r+    go z yield = loop z+      where+        loop y = loop =<< yield y x {-# INLINE repeatC #-} -replicateC :: Monad m => Int -> a -> Source m a r-replicateC n x z yield = go n z+replicateC :: forall m a. Monad m => Int -> a -> Source m a+replicateC n x = Source $ go n   where-    go n' y-        | n' >= 0   = go (n' - 1) =<< yield y x-        | otherwise = return y+    go :: Int -> r -> (r -> a -> EitherT r m r) -> EitherT r m r+    go i z yield = loop i z+      where+        loop n' r+            | n' >= 0   = loop (n' - 1) =<< yield r x+            | otherwise = return r -sourceLazy :: (Monad m, LazySequence lazy strict) => lazy -> Source m strict r+sourceLazy :: (Monad m, LazySequence lazy strict) => lazy -> Source m strict sourceLazy = yieldMany . toChunks {-# INLINE sourceLazy #-} -repeatMC :: Monad m => m a -> Source m a r-repeatMC x z yield = go z where go y = go =<< yield y =<< lift x+repeatMC :: forall m a. Monad m => m a -> Source m a+repeatMC x = Source go+  where+    go :: r -> (r -> a -> EitherT r m r) -> EitherT r m r+    go z yield = loop z+      where+        loop r = loop =<< yield r =<< lift x -repeatWhileMC :: Monad m => m a -> (a -> Bool) -> Source m a r-repeatWhileMC m f z yield = go z+repeatWhileMC :: forall m a. Monad m => m a -> (a -> Bool) -> Source m a+repeatWhileMC m f = Source go   where-    go r = do-        x <- lift m-        if f x-            then go =<< yield r x-            else return r+    go :: r -> (r -> a -> EitherT r m r) -> EitherT r m r+    go z yield = loop z+      where+        loop r = do+            x <- lift m+            if f x+                then loop =<< yield r x+                else return r -replicateMC :: Monad m => Int -> m a -> Source m a r-replicateMC n m z yield = go n z+replicateMC :: forall m a. Monad m => Int -> m a -> Source m a+replicateMC n m = Source $ go n   where-    go n' r | n' > 0 = go (n' - 1) =<< yield r =<< lift m-    go _ r = return r+    go :: Int -> r -> (r -> a -> EitherT r m r) -> EitherT r m r+    go i z yield = loop i z+      where+        loop n' r | n' > 0 = loop (n' - 1) =<< yield r =<< lift m+        loop _ r = return r -sourceHandle :: (MonadIO m, IOData a) => Handle -> Source m a r-sourceHandle h z yield = go z+sourceHandle :: forall m a. (MonadIO m, IOData a) => Handle -> Source m a+sourceHandle h = Source go   where-    go y = do-        x <- liftIO $ hGetChunk h-        if onull x-            then return y-            else go =<< yield y x+    go :: r -> (r -> a -> EitherT r m r) -> EitherT r m r+    go z yield = loop z+      where+        loop y = do+            x <- liftIO $ hGetChunk h+            if onull x+                then return y+                else loop =<< yield y x  sourceFile :: (MonadBaseControl IO m, MonadIO m, IOData a)-           => FilePath -> Source m a r-sourceFile path z yield =+           => FilePath -> Source m a+sourceFile path = Source $ \z yield ->     bracket         (liftIO $ openFile path ReadMode)         (liftIO . hClose)-        (\h -> sourceHandle h z yield)+        (\h -> getSource (sourceHandle h) z yield)  sourceIOHandle :: (MonadBaseControl IO m, MonadIO m, IOData a)-               => IO Handle -> Source m a r-sourceIOHandle f z yield =+               => IO Handle -> Source m a+sourceIOHandle f = Source $ \z yield ->     bracket         (liftIO f)         (liftIO . hClose)-        (\h -> sourceHandle h z yield)+        (\h -> getSource (sourceHandle h) z yield) -stdinC :: (MonadBaseControl IO m, MonadIO m, IOData a) => Source m a r+stdinC :: (MonadBaseControl IO m, MonadIO m, IOData a) => Source m a stdinC = sourceHandle stdin -initRepeat :: Monad m => m seed -> (seed -> m a) -> Source m a r-initRepeat mseed f z yield =-    lift mseed >>= \seed -> repeatMC (f seed) z yield+initRepeat :: Monad m => m seed -> (seed -> m a) -> Source m a+initRepeat mseed f = Source $ \z yield ->+    lift mseed >>= \seed -> getSource (repeatMC (f seed)) z yield -initReplicate :: Monad m => m seed -> (seed -> m a) -> Int -> Source m a r-initReplicate mseed f n z yield =-    lift mseed >>= \seed -> replicateMC n (f seed) z yield+initReplicate :: Monad m => m seed -> (seed -> m a) -> Int -> Source m a+initReplicate mseed f n = Source $ \z yield ->+    lift mseed >>= \seed -> getSource (replicateMC n (f seed)) z yield -sourceRandom :: (Variate a, MonadIO m) => Source m a r+sourceRandom :: (Variate a, MonadIO m) => Source m a sourceRandom =     initRepeat (liftIO MWC.createSystemRandom) (liftIO . MWC.uniform) -sourceRandomN :: (Variate a, MonadIO m) => Int -> Source m a r+sourceRandomN :: (Variate a, MonadIO m) => Int -> Source m a sourceRandomN =     initReplicate (liftIO MWC.createSystemRandom) (liftIO . MWC.uniform)  sourceRandomGen :: (Variate a, MonadBase base m, PrimMonad base)-                => Gen (PrimState base) -> Source m a r+                => Gen (PrimState base) -> Source m a sourceRandomGen gen = initRepeat (return gen) (liftBase . MWC.uniform)  sourceRandomNGen :: (Variate a, MonadBase base m, PrimMonad base)-                 => Gen (PrimState base) -> Int -> Source m a r+                 => Gen (PrimState base) -> Int -> Source m a sourceRandomNGen gen = initReplicate (return gen) (liftBase . MWC.uniform) -sourceDirectory :: (MonadBaseControl IO m, MonadIO m)-                => FilePath -> Source m FilePath r-sourceDirectory dir z yield =+sourceDirectory :: forall m. (MonadBaseControl IO m, MonadIO m)+                => FilePath -> Source m FilePath+sourceDirectory dir = Source $ \z yield ->     bracket         (liftIO (F.openDirStream dir))         (liftIO . F.closeDirStream)-        (go z)+        (go z yield)   where-    go y ds = loop y+    go :: r -> (r -> FilePath -> EitherT r m r) -> F.DirStream -> EitherT r m r+    go z yield ds = loop z       where         loop r = do             mfp <- liftIO $ F.readDirStream ds@@ -289,53 +307,58 @@                 Nothing -> return r                 Just fp -> loop =<< yield r (dir </> fp) -sourceDirectoryDeep :: (MonadBaseControl IO m, MonadIO m)-                    => Bool -> FilePath -> Source m FilePath r-sourceDirectoryDeep followSymlinks startDir z yield =-    start startDir z+sourceDirectoryDeep :: forall m. (MonadBaseControl IO m, MonadIO m)+                    => Bool -> FilePath -> Source m FilePath+sourceDirectoryDeep followSymlinks startDir = Source go   where-    start dir r = sourceDirectory dir r go--    go r fp = do-        ft <- liftIO $ F.getFileType fp-        case ft of-            F.FTFile -> yield r fp-            F.FTFileSym -> yield r fp-            F.FTDirectory -> start fp r-            F.FTDirectorySym-                | followSymlinks -> start fp r-                | otherwise -> return r-            F.FTOther -> return r+    go :: r -> (r -> FilePath -> EitherT r m r) -> EitherT r m r+    go z yield = start startDir z+      where+        start dir r = getSource (sourceDirectory dir) r entry+        entry r fp = do+            ft <- liftIO $ F.getFileType fp+            case ft of+                F.FTFile -> yield r fp+                F.FTFileSym -> yield r fp+                F.FTDirectory -> start fp r+                F.FTDirectorySym+                    | followSymlinks -> start fp r+                    | otherwise -> return r+                F.FTOther -> return r -dropC :: Monad m => Int -> Source m a (Int, r) -> Source m a r-dropC n await z yield = rewrap snd $ await (n, z) go+dropC :: Monad m => Int -> Conduit a m a+dropC n (Source await) = Source $ \z yield ->+    rewrap snd $ await (n, z) (go yield)   where-    go (n', r) _ | n' > 0 = return (n' - 1, r)-    go (_, r) x = rewrap (0,) $ yield r x+    go _ (n', r) _ | n' > 0 = return (n' - 1, r)+    go yield (_, r) x = rewrap (0,) $ yield r x  dropCE :: (Monad m, IsSequence seq)-       => Index seq -> Source m seq (Index seq, r) -> Source m seq r-dropCE n await z yield = rewrap snd $ await (n, z) go+       => Index seq -> Conduit seq m seq+dropCE n (Source await) = Source $ \z yield ->+    rewrap snd $ await (n, z) (go yield)   where-    go  (n', r) s+    go yield (n', r) s         | onull y   = return (n' - xn, r)         | otherwise = rewrap (0,) $ yield r y       where         (x, y) = Seq.splitAt n' s         xn = n' - fromIntegral (olength x) -dropWhileC :: Monad m => (a -> Bool) -> Source m a (a -> Bool, r) -> Source m a r-dropWhileC f await z yield = rewrap snd $ await (f, z) go+dropWhileC :: Monad m => (a -> Bool) -> Conduit a m a+dropWhileC f (Source await) = Source $ \z yield ->+    rewrap snd $ await (f, z) (go yield)   where-    go (k, r) x | k x = return (k, r)-    go (_, r) x = rewrap (const False,) $ yield r x+    go _ (k, r) x | k x = return (k, r)+    go yield (_, r) x = rewrap (const False,) $ yield r x  dropWhileCE :: (Monad m, IsSequence seq)-            => (Element seq -> Bool) -> Source m seq (Element seq -> Bool, r)-            -> Source m seq r-dropWhileCE f await z yield = rewrap snd $ await (f, z) go+            => (Element seq -> Bool)+            -> Conduit seq m seq+dropWhileCE f (Source await) =+    Source $ \z yield -> rewrap snd $ await (f, z) (go yield)   where-    go  (k, r) s+    go yield (k, r) s         | onull x   = return (k, r)         | otherwise = rewrap (const False,) $ yield r s       where@@ -349,7 +372,7 @@ foldCE = foldlC (\acc mono -> acc <> ofoldMap id mono) mempty  foldlC :: Monad m => (a -> b -> a) -> a -> Sink b m a-foldlC f z await = resolve await z ((return .) . f)+foldlC f z (Source await) = resolve await z ((return .) . f) {-# INLINE foldlC #-}  foldlCE :: (Monad m, MonoFoldable mono)@@ -363,58 +386,57 @@           => (Element mono -> w) -> Sink mono m w foldMapCE = foldMapC . ofoldMap -allC :: Monad m => (a -> Bool) -> Source m a All -> m Bool+allC :: Monad m => (a -> Bool) -> Sink a m Bool allC f = liftM getAll `liftM` foldMapC (All . f)  allCE :: (Monad m, MonoFoldable mono)-      => (Element mono -> Bool) -> Source m mono All -> m Bool+      => (Element mono -> Bool) -> Sink mono m Bool allCE = allC . oall -anyC :: Monad m => (a -> Bool) -> Source m a Any -> m Bool+anyC :: Monad m => (a -> Bool) -> Sink a m Bool anyC f = liftM getAny `liftM` foldMapC (Any . f)  anyCE :: (Monad m, MonoFoldable mono)-      => (Element mono -> Bool) -> Source m mono Any -> m Bool+      => (Element mono -> Bool) -> Sink mono m Bool anyCE = anyC . oany -andC :: Monad m => Source m Bool All -> m Bool+andC :: Monad m => Sink Bool m Bool andC = allC id  andCE :: (Monad m, MonoFoldable mono, Element mono ~ Bool)-      => Source m mono All -> m Bool+      => Sink mono m Bool andCE = allCE id -orC :: Monad m => Source m Bool Any -> m Bool+orC :: Monad m => Sink Bool m Bool orC = anyC id  orCE :: (Monad m, MonoFoldable mono, Element mono ~ Bool)-     => Source m mono Any -> m Bool+     => Sink mono m Bool orCE = anyCE id -elemC :: (Monad m, Eq a) => a -> Source m a Any -> m Bool+elemC :: (Monad m, Eq a) => a -> Sink a m Bool elemC x = anyC (== x) -elemCE :: (Monad m, EqSequence seq) => Element seq -> Source m seq Any -> m Bool+elemCE :: (Monad m, EqSequence seq) => Element seq -> Sink seq m Bool elemCE = anyC . Seq.elem -notElemC :: (Monad m, Eq a) => a -> Source m a All -> m Bool+notElemC :: (Monad m, Eq a) => a -> Sink a m Bool notElemC x = allC (/= x) -notElemCE :: (Monad m, EqSequence seq) => Element seq -> Source m seq All -> m Bool+notElemCE :: (Monad m, EqSequence seq) => Element seq -> Sink seq m Bool notElemCE = allC . Seq.notElem -produceList :: Monad m => ([a] -> b) -> Source m a ([a] -> [a]) -> m b-produceList f await =-    (f . ($ [])) `liftM`-        resolve await id (\front x -> front `seq` return (front . (x:)))+produceList :: Monad m => ([a] -> b) -> Source m a -> m b+produceList f (Source await) =+    (f . ($ [])) `liftM` resolve await id (\front x -> return (front . (x:))) {-# INLINE produceList #-}  sinkLazy :: (Monad m, LazySequence lazy strict)-         => Source m strict ([strict] -> [strict]) -> m lazy+         => Sink strict m lazy sinkLazy = produceList fromChunks -- {-# INLINE sinkLazy #-} -sinkList :: Monad m => Source m a ([a] -> [a]) -> m [a]+sinkList :: Monad m => Sink a m [a] sinkList = produceList id {-# INLINE sinkList #-} @@ -432,44 +454,19 @@  sinkLazyBuilder :: (Monad m, Monoid builder, ToBuilder a builder,                     Builder builder lazy)-                => Source m a builder -> m lazy+                => Sink a m lazy sinkLazyBuilder = liftM builderToLazy . foldMapC toBuilder  sinkNull :: Monad m => Sink a m () sinkNull _ = return () -awaitNonNull :: (Monad m, MonoFoldable a) => Conduit a m (Maybe (NonNull a)) r-awaitNonNull await z yield = await z $ \r x ->+awaitNonNull :: (Monad m, MonoFoldable a) => Conduit a m (Maybe (NonNull a))+awaitNonNull (Source await) = Source $ \z yield -> await z $ \r x ->     maybe (return r) (yield r . Just) (NonNull.fromNullable x)  headCE :: (Monad m, IsSequence seq) => Sink seq m (Maybe (Element seq)) headCE = undefined --- newtype Pipe a m b = Pipe { runPipe :: Sink a m b }---- instance Monad m => Functor (Pipe a m) where---     fmap f (Pipe p) = Pipe $ liftM f . p---- instance Monad m => Monad (Pipe a m) where---     return x = Pipe $ \_ -> return x---     Pipe p >>= f = Pipe $ \await -> do---         x <- p await---         runPipe (f x) await---- dropC' :: Monad m => Int -> Sink a m ()--- dropC' n await = rewrap snd $ await n go---   where---     go (n', r) _ | n' > 0 = return (n' - 1, r)---     go (_, r) x = rewrap (0,) $ yield r x---- test :: IO [Int]--- test = flip runPipe (yieldMany [1..10]) $ do---     Pipe $ dropC' 2---     Pipe sinkList---- leftover :: Monad m => a -> ResumableSource m a r--- leftover l z _ = lift (modify (Sequence.|> l)) >> return z- -- jww (2014-06-07): These two cannot be implemented without leftover support. -- peekC :: Monad m => Sink a m (Maybe a) -- peekC = undefined@@ -478,7 +475,7 @@ -- peekCE = undefined  lastC :: Monad m => Sink a m (Maybe a)-lastC await = resolve await Nothing (const (return . Just))+lastC (Source await) = resolve await Nothing (const (return . Just))  lastCE :: (Monad m, IsSequence seq) => Sink seq m (Maybe (Element seq)) lastCE = undefined@@ -497,7 +494,7 @@ lengthIfCE f = foldlCE (\cnt a -> if f a then cnt + 1 else cnt) 0  maximumC :: (Monad m, Ord a) => Sink a m (Maybe a)-maximumC await = resolve await Nothing $ \r y ->+maximumC (Source await) = resolve await Nothing $ \r y ->     return $ Just $ case r of         Just x -> max x y         _      -> y@@ -506,7 +503,7 @@ maximumCE = undefined  minimumC :: (Monad m, Ord a) => Sink a m (Maybe a)-minimumC await = resolve await Nothing $ \r y ->+minimumC (Source await) = resolve await Nothing $ \r y ->     return $ Just $ case r of         Just x -> min x y         _      -> y@@ -536,11 +533,11 @@ productCE = undefined  findC :: Monad m => (a -> Bool) -> Sink a m (Maybe a)-findC f await = resolve await Nothing $ \r x ->+findC f (Source await) = resolve await Nothing $ \r x ->     if f x then left (Just x) else return r  mapM_C :: Monad m => (a -> m ()) -> Sink a m ()-mapM_C f await = resolve await () (const $ lift . f)+mapM_C f (Source await) = resolve await () (const $ lift . f) {-# INLINE mapM_C #-}  mapM_CE :: (Monad m, MonoFoldable mono)@@ -548,7 +545,7 @@ mapM_CE = undefined  foldMC :: Monad m => (a -> b -> m a) -> a -> Sink b m a-foldMC f z await = resolve await z (\r x -> lift (f r x))+foldMC f z (Source await) = resolve await z (\r x -> lift (f r x))  foldMCE :: (Monad m, MonoFoldable mono)         => (a -> Element mono -> m a) -> a -> Sink mono m a@@ -585,87 +582,91 @@ stderrC :: (MonadIO m, IOData a) => Sink a m () stderrC = sinkHandle stderr -mapC :: Monad m => (a -> b) -> Conduit a m b r-mapC f await z yield = await z $ \acc x ->-    let y = f x in y `seq` acc `seq` yield acc y+mapC :: Monad m => (a -> b) -> Conduit a m b+mapC f (Source await) = Source $ \z yield -> await z $ \acc -> yield acc . f {-# INLINE mapC #-} -mapCE :: (Monad m, Functor f) => (a -> b) -> Conduit (f a) m (f b) r+mapC' :: Monad m => (a -> b) -> Conduit a m b+mapC' f (Source await) = Source $ \z yield -> await z $ \acc x ->+    let y = f x in y `seq` acc `seq` yield acc y+{-# INLINE mapC' #-}++mapCE :: (Monad m, Functor f) => (a -> b) -> Conduit (f a) m (f b) mapCE = undefined  omapCE :: (Monad m, MonoFunctor mono)-       => (Element mono -> Element mono) -> Conduit mono m mono r+       => (Element mono -> Element mono) -> Conduit mono m mono omapCE = undefined  concatMapC :: (Monad m, MonoFoldable mono)-           => (a -> mono) -> Conduit a m (Element mono) r-concatMapC f await z yield = await z $ \r x -> ofoldlM yield r (f x)+           => (a -> mono) -> Conduit a m (Element mono)+concatMapC f (Source await) = Source $ \z yield -> await z $ \r x -> ofoldlM yield r (f x)  concatMapCE :: (Monad m, MonoFoldable mono, Monoid w)-            => (Element mono -> w) -> Conduit mono m w r+            => (Element mono -> w) -> Conduit mono m w concatMapCE = undefined -takeC :: Monad m => Int -> Source m a (Int, r) -> Source m a r-takeC n await z yield = rewrap snd $ await (n, z) go+takeC :: Monad m => Int -> Source m a -> Source m a+takeC n (Source await) = Source $ \z yield -> rewrap snd $ await (n, z) (go yield)   where-    go (n', z') x+    go yield (n', z') x         | n' > 1    = next         | n' > 0    = left =<< next         | otherwise = left (0, z')       where         next = rewrap (n' - 1,) $ yield z' x -takeCE :: (Monad m, IsSequence seq) => Index seq -> Conduit seq m seq r+takeCE :: (Monad m, IsSequence seq) => Index seq -> Conduit seq m seq takeCE = undefined  -- | This function reads one more element than it yields, which would be a --   problem if Sinks were monadic, as they are in conduit or pipes.  There is --   no such concept as "resuming where the last conduit left off" in this --   library.-takeWhileC :: Monad m => (a -> Bool) -> Source m a (a -> Bool, r) -> Source m a r-takeWhileC f await z yield = rewrap snd $ await (f, z) go+takeWhileC :: Monad m => (a -> Bool) -> Source m a -> Source m a+takeWhileC f (Source await) = Source $ \z yield -> rewrap snd $ await (f, z) (go yield)   where-    go (k, z') x | k x = rewrap (k,) $ yield z' x-    go (_, z') _ = left (const False, z')+    go yield (k, z') x | k x = rewrap (k,) $ yield z' x+    go _ (_, z') _ = left (const False, z')  takeWhileCE :: (Monad m, IsSequence seq)-            => (Element seq -> Bool) -> Conduit seq m seq r+            => (Element seq -> Bool) -> Conduit seq m seq takeWhileCE = undefined -takeExactlyC :: Monad m => Int -> Conduit a m b r -> Conduit a m b r+takeExactlyC :: Monad m => Int -> Conduit a m b -> Conduit a m b takeExactlyC = undefined  takeExactlyCE :: (Monad m, IsSequence a)-              => Index a -> Conduit a m b r -> Conduit a m b r+              => Index a -> Conduit a m b -> Conduit a m b takeExactlyCE = undefined -concatC :: (Monad m, MonoFoldable mono) => Conduit mono m (Element mono) r+concatC :: (Monad m, MonoFoldable mono) => Conduit mono m (Element mono) concatC = undefined -filterC :: Monad m => (a -> Bool) -> Conduit a m a r-filterC f await z yield =+filterC :: Monad m => (a -> Bool) -> Conduit a m a+filterC f (Source await) = Source $ \z yield ->     await z $ \r x -> if f x then yield r x else return r  filterCE :: (IsSequence seq, Monad m)-         => (Element seq -> Bool) -> Conduit seq m seq r+         => (Element seq -> Bool) -> Conduit seq m seq filterCE = undefined -mapWhileC :: Monad m => (a -> Maybe b) -> Conduit a m b r-mapWhileC f await z yield = await z $ \z' x ->+mapWhileC :: Monad m => (a -> Maybe b) -> Conduit a m b+mapWhileC f (Source await) = Source $ \z yield -> await z $ \z' x ->     maybe (left z') (yield z') (f x)  conduitVector :: (MonadBase base m, Vector v a, PrimMonad base)-              => Int -> Conduit a m (v a) r+              => Int -> Conduit a m (v a) conduitVector = undefined -scanlC :: Monad m => (a -> b -> a) -> a -> Conduit b m a r+scanlC :: Monad m => (a -> b -> a) -> a -> Conduit b m a scanlC = undefined -concatMapAccumC :: Monad m => (a -> accum -> (accum, [b])) -> accum -> Conduit a m b r+concatMapAccumC :: Monad m => (a -> accum -> (accum, [b])) -> accum -> Conduit a m b concatMapAccumC = undefined -intersperseC :: Monad m => a -> Source m a (Maybe a, r) -> Source m a r-intersperseC s await z yield = EitherT $ do+intersperseC :: Monad m => a -> Source m a -> Source m a+intersperseC s (Source await) = Source $ \z yield -> EitherT $ do     eres <- runEitherT $ await (Nothing, z) $ \(my, r) x ->         case my of             Nothing ->@@ -678,85 +679,86 @@         Right (Nothing, r) -> return $ Right r         Right (Just x, r)  -> runEitherT $ yield r x -encodeBase64C :: Monad m => Conduit ByteString m ByteString r+encodeBase64C :: Monad m => Conduit ByteString m ByteString encodeBase64C = undefined -decodeBase64C :: Monad m => Conduit ByteString m ByteString r+decodeBase64C :: Monad m => Conduit ByteString m ByteString decodeBase64C = undefined -encodeBase64URLC :: Monad m => Conduit ByteString m ByteString r+encodeBase64URLC :: Monad m => Conduit ByteString m ByteString encodeBase64URLC = undefined -decodeBase64URLC :: Monad m => Conduit ByteString m ByteString r+decodeBase64URLC :: Monad m => Conduit ByteString m ByteString decodeBase64URLC = undefined -encodeBase16C :: Monad m => Conduit ByteString m ByteString r+encodeBase16C :: Monad m => Conduit ByteString m ByteString encodeBase16C = undefined -decodeBase16C :: Monad m => Conduit ByteString m ByteString r+decodeBase16C :: Monad m => Conduit ByteString m ByteString decodeBase16C = undefined -mapMC :: Monad m => (a -> m b) -> Conduit a m b r-mapMC f await z yield = await z (\r x -> yield r =<< lift (f x))+mapMC :: Monad m => (a -> m b) -> Conduit a m b+mapMC f (Source await) = Source $ \z yield -> await z (\r x -> yield r =<< lift (f x)) {-# INLINE mapMC #-} -mapMCE :: (Monad m, Traversable f) => (a -> m b) -> Conduit (f a) m (f b) r+mapMCE :: (Monad m, Traversable f) => (a -> m b) -> Conduit (f a) m (f b) mapMCE = undefined  omapMCE :: (Monad m, MonoTraversable mono)-        => (Element mono -> m (Element mono)) -> Conduit mono m mono r+        => (Element mono -> m (Element mono)) -> Conduit mono m mono omapMCE = undefined  concatMapMC :: (Monad m, MonoFoldable mono)-            => (a -> m mono) -> Conduit a m (Element mono) r+            => (a -> m mono) -> Conduit a m (Element mono) concatMapMC = undefined -filterMC :: Monad m => (a -> m Bool) -> Conduit a m a r-filterMC f await z yield = await z $ \z' x -> do+filterMC :: Monad m => (a -> m Bool) -> Conduit a m a+filterMC f (Source await) = Source $ \z yield -> await z $ \z' x -> do     res <- lift $ f x     if res         then yield z' x         else return z'  filterMCE :: (Monad m, IsSequence seq)-          => (Element seq -> m Bool) -> Conduit seq m seq r+          => (Element seq -> m Bool) -> Conduit seq m seq filterMCE = undefined -iterMC :: Monad m => (a -> m ()) -> Conduit a m a r+iterMC :: Monad m => (a -> m ()) -> Conduit a m a iterMC = undefined -scanlMC :: Monad m => (a -> b -> m a) -> a -> Conduit b m a r+scanlMC :: Monad m => (a -> b -> m a) -> a -> Conduit b m a scanlMC = undefined  concatMapAccumMC :: Monad m-                 => (a -> accum -> m (accum, [b])) -> accum -> Conduit a m b r+                 => (a -> accum -> m (accum, [b])) -> accum -> Conduit a m b concatMapAccumMC = undefined -encodeUtf8C :: (Monad m, Utf8 text binary) => Conduit text m binary r+encodeUtf8C :: (Monad m, Utf8 text binary) => Conduit text m binary encodeUtf8C = mapC encodeUtf8 -decodeUtf8C :: MonadThrow m => Conduit ByteString m Text r+decodeUtf8C :: MonadThrow m => Conduit ByteString m Text decodeUtf8C = undefined  lineC :: (Monad m, IsSequence seq, Element seq ~ Char)-      => Conduit seq m o r -> Conduit seq m o r+      => Conduit seq m o -> Conduit seq m o lineC = undefined  lineAsciiC :: (Monad m, IsSequence seq, Element seq ~ Word8)-           => Conduit seq m o r -> Conduit seq m o r+           => Conduit seq m o -> Conduit seq m o lineAsciiC = undefined -unlinesC :: (Monad m, IsSequence seq, Element seq ~ Char) => Conduit seq m seq r+unlinesC :: (Monad m, IsSequence seq, Element seq ~ Char)+         => Conduit seq m seq unlinesC = concatMapC (:[Seq.singleton '\n'])  unlinesAsciiC :: (Monad m, IsSequence seq, Element seq ~ Word8)-              => Conduit seq m seq r+              => Conduit seq m seq unlinesAsciiC = concatMapC (:[Seq.singleton 10]) -linesUnboundedC_ :: (Monad m, IsSequence seq, Eq (Element seq))-                 => Element seq -> Source m seq (r, seq) -> Source m seq r-linesUnboundedC_ sep await z yield = EitherT $ do-    eres <- runEitherT $ await (z, n) go+linesUnboundedC_ :: forall m seq. (Monad m, IsSequence seq, Eq (Element seq))+                 => Element seq -> Conduit seq m seq+linesUnboundedC_ sep (Source await) = Source $ \z yield -> EitherT $ do+    eres <- runEitherT $ await (z, n) (go yield)     case eres of         Left (r, _)  -> return $ Left r         Right (r, t)@@ -765,65 +767,38 @@   where     n = Seq.fromList [] -    go (r, t') t-        | onull y = return (r, t <> t')-        | otherwise = do-            r' <- rewrap (, n) $ yield r (t' <> x)-            go r' (Seq.drop 1 y)+    go :: (r -> seq -> EitherT r m r) -> (r, seq) -> seq+       -> EitherT (r, seq) m (r, seq)+    go yield = loop       where-        (x, y) = Seq.break (== sep) t+        loop (r, t') t+            | onull y = return (r, t <> t')+            | otherwise = do+                r' <- rewrap (, n) $ yield r (t' <> x)+                loop r' (Seq.drop 1 y)+          where+            (x, y) = Seq.break (== sep) t  linesUnboundedC :: (Monad m, IsSequence seq, Element seq ~ Char)-                => Source m seq (r, seq) -> Source m seq r+                => Conduit seq m seq linesUnboundedC = linesUnboundedC_ '\n'  linesUnboundedAsciiC :: (Monad m, IsSequence seq, Element seq ~ Word8)-                     => Source m seq (r, seq) -> Source m seq r+                     => Conduit seq m seq linesUnboundedAsciiC = linesUnboundedC_ 10  -- | The use of 'awaitForever' in this library is just a bit different from --   conduit: ----- >>> awaitForever $ \x yield skip -> if even x then yield x else skip+-- >>> awaitForever $ \x yield done -> if even x then yield x else done awaitForever :: Monad m-             => (a -> (b -> EitherT r m r) -> EitherT r m r+             => (forall r. a -> (b -> EitherT r m r) -> EitherT r m r                  -> EitherT r m r)-             -> Conduit a m b r-awaitForever f await z yield =+             -> Conduit a m b+awaitForever f (Source await) = Source $ \z yield ->     await z $ \r x -> f x (yield r) (return r) -zipSourceApp :: Monad m => Source m (x -> y) r -> Source m x r -> Source m y r-zipSourceApp f arg z yield = f z $ \r x -> arg r $ \_ y -> yield z (x y)--newtype ZipSource m r a = ZipSource { getZipSource :: Source m a r }--instance Monad m => Functor (ZipSource m r) where-    fmap f (ZipSource p) = ZipSource $ \z yield -> p z $ \r x -> yield r (f x)--instance Monad m => Applicative (ZipSource m r) where-    pure x = ZipSource $ yieldOne x-    ZipSource l <*> ZipSource r = ZipSource (zipSourceApp l r)---- | Sequence a collection of sources.------ >>> sinkList $ sequenceSources [yieldOne 1, yieldOne 2, yieldOne 3]--- [[1,2,3]]-sequenceSources :: (Traversable f, Monad m)-                => f (Source m a r) -> Source m (f a) r-sequenceSources = getZipSource . sequenceA . fmap ZipSource---- | Since Sources are not Monads in this library (as they are in the full---   conduit library), they can be sequentially "chained" using this append---   operator.  If Source were a newtype, we could make it an instance of---   Monoid.-infixr 3 <+>-(<+>) :: Monad m => Source m a r -> Conduit a m a r-x <+> y = \r f -> flip y f =<< x r f-{-# INLINE (<+>) #-}--instance MFunctor (EitherT s) where-  hoist f (EitherT m) = EitherT $ f m-+{- -- | Zip sinks together.  This function may be used multiple times: -- -- >>> let mySink s await => resolve await () $ \() x -> liftIO $ print $ s <> show x@@ -835,38 +810,39 @@ -- "foo: 3" -- "bar: 3" -- ([1,2,3],((),()))-zipSinks :: Monad m-         => (Source (StateT (r', s) m) i s  -> StateT (r', s) m r)-         -> (Source (StateT (r', s) m) i s' -> StateT (r', s) m r')-         -> Source m i (s, s') -> m (r, r')-zipSinks x y await = do-    let i = (error "accessing r'", error "accessing s")-    flip evalStateT i $ do-        r <- x $ \rx yieldx -> do-            r' <- lift $ y $ \ry yieldy -> EitherT $ do-                    st <- get-                    eres <- lift $ runEitherT $ await (rx, ry) $ \(rx', ry') u -> do-                        x' <- stripS st $ rewrap (, ry') $ yieldx rx' u-                        y' <- stripS st $ rewrap (rx' ,) $ yieldy ry' u-                        return (fst x', snd y')-                    let (s, s') = either id id eres-                    modify (\(b, _) -> (b, s))-                    return $ Right s'-            lift $ do-                modify (\(_, b) -> (r', b))-                gets snd-        r' <- gets fst-        return (r, r')-  where-    stripS :: (MFunctor t, Monad n) => b1 -> t (StateT b1 n) b -> t n b-    stripS s = hoist (`evalStateT` s)+--+-- jww (2014-06-09): Can this be written sanely without resorting to IORefs?+zipSinks :: MonadIO m+         => Sink a (StateT s m) r -> Sink a (StateT s' m) r'+         -> Sink a m (r, r')+zipSinks x y (Source await) = do+    res_s  <- liftIO $ newIORef (error "zipSinks: s never assigned a value")+    res_r' <- liftIO $ newIORef (error "zipSinks: r' never assigned a value")+    r <- x $ Source $ \rx yieldx -> do+        r' <- lift $ y $ Source $ \ry yieldy -> EitherT $ do+            (rx', ry') <- resolve await (rx, ry) $ \(rx', ry') u -> EitherT $ do+                eres <- runEitherT $ yieldx rx' u+                case eres of+                    Left r -> return $ Left (r, ry')+                    Right r -> do+                        eres' <- runEitherT $ yieldy ry' u+                        case eres' of+                            Left r' -> return $ Left (r, r')+                            Right r' -> return $ Right (r, r')+            liftIO $ writeIORef res_s rx'+            return $ Right ry'+        liftIO $ do+            writeIORef res_r' r'+            readIORef res_s+    r' <- liftIO $ readIORef res_r'+    return (r, r') -newtype ZipSink i m r s = ZipSink { getZipSink :: Source m i r -> m s }+newtype ZipSink a m r = ZipSink { getZipSink :: Source m a -> m r } -instance Monad m => Functor (ZipSink i m r) where+instance Monad m => Functor (ZipSink a m) where     fmap f (ZipSink k) = ZipSink $ liftM f . k -instance Monad m => Applicative (ZipSink i m r) where+instance Monad m => Applicative (ZipSink a m) where     pure x = ZipSink $ \_ -> return x     ZipSink f <*> ZipSink x = ZipSink $ \await -> f await `ap` x await @@ -874,44 +850,14 @@ --   coalesce together all return values. -- -- Implemented on top of @ZipSink@, see that data type for more details.-sequenceSinks :: (Traversable f, Monad m)-              => f (Source m i r -> m s) -> Source m i r -> m (f s)+sequenceSinks :: (Traversable f, Monad m) => f (Sink a m r) -> Sink a m (f r) sequenceSinks = getZipSink . sequenceA . fmap ZipSink---- infixr 3 <*>--- (<*>) :: Monad m---       => (Source (StateT (r', s) m) i s  -> StateT (r', s) m r)---       -> (Source (StateT (r', s) m) i s' -> StateT (r', s) m r')---       -> Source m i (s, s') -> m (r, r')--- (<*>) = zipSinks--- {-# INLINE (<*>) #-}---- zipConduitApp :: Monad m => Conduit a m (x -> y) r -> Conduit a m x r -> Conduit a m y r--- zipConduitApp f arg z yield = f z $ \r x -> arg r $ \_ y -> yield z (x y)---- newtype ZipConduit a m r b = ZipConduit { getZipConduit :: Conduit a m b r }---- instance Monad m => Functor (ZipConduit a m r) where---     fmap f (ZipConduit p) = ZipConduit $ \z yield -> p z $ \r x -> yield r (f x)---- instance Monad m => Applicative (ZipConduit a m r) where---     pure x = ZipConduit $ yieldOne x---     ZipConduit l <*> ZipConduit r = ZipConduit (zipConduitApp l r)---- -- | Sequence a collection of sources.--- ----- -- >>> sinkList $ sequenceConduits [yieldOne 1, yieldOne 2, yieldOne 3]--- -- [[1,2,3]]--- sequenceConduits :: (Traversable f, Monad m)---                 => f (Conduit a m b r) -> Conduit a m (f b) r--- sequenceConduits = getZipConduit . sequenceA . fmap ZipConduit+-}  asyncC :: (MonadBaseControl IO m, Monad m)-       => (a -> m b) -> Conduit a m (Async (StM m b)) r-asyncC f await k yield = do-    res <- async $ await k $ \r x ->-        yield r =<< lift (async (f x))-    wait res+       => (a -> m b) -> Conduit a m (Async (StM m b))+asyncC f (Source await) = Source $ \k yield ->+    await k $ \r x -> yield r =<< lift (async (f x))  -- | Convert a 'Control.Foldl.FoldM' fold abstraction into a Sink. --@@ -919,8 +865,8 @@ -- -- >>> fromFoldM (FoldM ((return .) . (+)) (return 0) return) $ yieldMany [1..10] -- 55-fromFoldM :: Monad m => FoldM m a b -> (forall r. Source m a r) -> m b-fromFoldM (FoldM step initial final) await =+fromFoldM :: Monad m => FoldM m a b -> Source m a -> m b+fromFoldM (FoldM step initial final) (Source await) =     initial >>= flip (resolve await) ((lift .) . step) >>= final  -- | Convert a Sink into a 'Control.Foldl.FoldM', passing it into a@@ -929,59 +875,74 @@ -- >>> toFoldM sumC (\f -> Control.Foldl.foldM f [1..10]) -- 55 toFoldM :: Monad m-        => Sink a m r -> (FoldM (EitherT r m) a r -> EitherT r m r) -> m r-toFoldM sink f = sink $ \k yield -> f $ FoldM yield (return k) return+        => Sink a m r -> (forall s. FoldM (EitherT s m) a s -> EitherT s m s) -> m r+toFoldM sink f = sink $ Source $ \k yield -> f $ FoldM yield (return k) return  -- | A Source for exhausting a TChan, but blocks if it is initially empty.-sourceTChan :: TChan a -> Source STM a r-sourceTChan chan z yield = go z+sourceTChan :: forall a. TChan a -> Source STM a+sourceTChan chan = Source go   where-    go r = do-        x  <- lift $ readTChan chan-        r' <- yield r x-        mt <- lift $ isEmptyTChan chan-        if mt-            then return r'-            else go r'+    go :: r -> (r -> a -> EitherT r STM r) -> EitherT r STM r+    go z yield = loop z+      where+        loop r = do+            x  <- lift $ readTChan chan+            r' <- yield r x+            mt <- lift $ isEmptyTChan chan+            if mt+                then return r'+                else loop r' -sourceTQueue :: TQueue a -> Source STM a r-sourceTQueue chan z yield = go z+sourceTQueue :: forall a. TQueue a -> Source STM a+sourceTQueue chan = Source go   where-    go r = do-        x  <- lift $ readTQueue chan-        r' <- yield r x-        mt <- lift $ isEmptyTQueue chan-        if mt-            then return r'-            else go r'+    go :: r -> (r -> a -> EitherT r STM r) -> EitherT r STM r+    go z yield = loop z+      where+        loop r = do+            x  <- lift $ readTQueue chan+            r' <- yield r x+            mt <- lift $ isEmptyTQueue chan+            if mt+                then return r'+                else loop r' -sourceTBQueue :: TBQueue a -> Source STM a r-sourceTBQueue chan z yield = go z+sourceTBQueue :: forall a. TBQueue a -> Source STM a+sourceTBQueue chan = Source go   where-    go r = do-        x  <- lift $ readTBQueue chan-        r' <- yield r x-        mt <- lift $ isEmptyTBQueue chan-        if mt-            then return r'-            else go r'+    go :: r -> (r -> a -> EitherT r STM r) -> EitherT r STM r+    go z yield = loop z+      where+        loop r = do+            x  <- lift $ readTBQueue chan+            r' <- yield r x+            mt <- lift $ isEmptyTBQueue chan+            if mt+                then return r'+                else loop r' -untilMC :: Monad m => m a -> m Bool -> Source m a r-untilMC m f z yield = go z+untilMC :: forall m a. Monad m => m a -> m Bool -> Source m a+untilMC m f = Source go   where-    go r = do-        x <- lift m-        r' <- yield r x-        cont <- lift f-        if cont-            then go r'-            else return r'+    go :: r -> (r -> a -> EitherT r m r) -> EitherT r m r+    go z yield = loop z+      where+        loop r = do+            x <- lift m+            r' <- yield r x+            cont <- lift f+            if cont+                then loop r'+                else return r' -whileMC :: Monad m => m Bool -> m a -> Source m a r-whileMC f m z yield = go z+whileMC :: forall m a. Monad m => m Bool -> m a -> Source m a+whileMC f m = Source go   where-    go r = do-        cont <- lift f-        if cont-            then lift m >>= yield r >>= go-            else return r+    go :: r -> (r -> a -> EitherT r m r) -> EitherT r m r+    go z yield = loop z+      where+        loop r = do+            cont <- lift f+            if cont+                then lift m >>= yield r >>= loop+                else return r

@@ -1,5 +1,5 @@ Name:                simple-conduit-Version:             0.2.0+Version:             0.3.0 Synopsis:            A simple streaming library based on composing monadic folds. Description:     @simple-conduit@ follows a similar UI to the more capable @conduit@ library, but reduces the scope of what it can solve donw to what can be expressed by chaining monadic folds that allow for early termination.  This allows for more predictable resource management behavior, at the cost of not allowing scenarios that @conduit@ is better designed.@@ -44,6 +44,7 @@     hs-source-dirs: test     main-is: bench.hs     type: exitcode-stdio-1.0+    ghc-options:   -O2     cpp-options:   -DTEST     build-depends:   simple-conduit                    , base

@@ -4,6 +4,7 @@  import qualified Conduit as C import           Conduit.Simple+import           Control.Monad import           Control.Monad.IO.Class import           Criterion.Main (defaultMain, bench, nf) import           Data.Functor.Identity@@ -25,7 +26,7 @@     ws <- yieldMany [1..10] $= takeC 5 $= mapC (+2) $$ sinkList     print (ws :: [Int]) -    us <- (sourceFile "simple-conduit.cabal" <+> sourceFile "README.md")+    us <- (sourceFile "simple-conduit.cabal" <> sourceFile "README.md")         $= takeC 1         $$ sinkList     print (T.unpack (decodeUtf8 (Prelude.head us)))@@ -33,7 +34,7 @@     vs <- sinkList         $ mapC (<> "Hello")         $ takeC 1-        $ sourceFile "simple-conduit.cabal" <+> sourceFile "README.md"+        $ sourceFile "simple-conduit.cabal" <> sourceFile "README.md"     print (T.unpack (decodeUtf8 (Prelude.head vs)))      x <- sinkList $ returnC $ sumC $ mapC (+1) $ yieldMany ([1..10] :: [Int])@@ -45,8 +46,19 @@         bench "centipede1" $ nf (runIdentity . useThis) ([1..1000000] :: [Int])       , bench "conduit1"   $ nf (runIdentity . useThat) ([1..1000000] :: [Int])       , bench "centipede2" $ nf (runIdentity . useThis) ([1..1000000] :: [Int])+      , bench "centipede3" $ nf (runIdentity . useThis2) ([1..1000000] :: [Int])       , bench "conduit2"   $ nf (runIdentity . useThat) ([1..1000000] :: [Int])       ]   where     useThis xs = yieldMany xs $= mapC (+2) $$ sinkList+    useThis2 xs = yieldMany2 xs $= mapC (+2) $$ sinkList2     useThat xs = C.yieldMany xs C.$= C.mapC (+2) C.$$ C.sinkList++yieldMany2 :: Monad m => [a] -> Source m a+yieldMany2 xs = Source $ \z yield -> foldM yield z xs+{-# INLINE yieldMany2 #-}++sinkList2 :: Monad m => Sink a m [a]+sinkList2 (Source await) =+    liftM ($ []) $ resolve await id $ \r x -> return (r . (x:))+{-# INLINE sinkList2 #-}