pipes-transduce 0.1.0.0 → 0.2.0.0

raw patch · 6 files changed

+250/−116 lines, 6 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG +4/−0
• pipes-transduce.cabal +1/−1
• src/Pipes/Transduce.hs +23/−15
• src/Pipes/Transduce/ByteString.hs +6/−6
• src/Pipes/Transduce/Internal.hs +185/−77
• src/Pipes/Transduce/Text.hs +31/−17

@@ -0,0 +1,4 @@+0.2.0.0++- Added folds of two Producers.+- Name changes.

@@ -1,5 +1,5 @@ Name: pipes-transduce-Version: 0.1.0.0+Version: 0.2.0.0 Cabal-Version: >=1.8.0.2 Build-Type: Simple License: BSD3

@@ -1,8 +1,14 @@ module Pipes.Transduce (         -- * Producer folds-        Fold'-    ,   foldFallibly-    ,   Pipes.Transduce.Internal.fold+        Fold1+    ,   foldFallibly1+    ,   Pipes.Transduce.Internal.fold1+        -- * Multiple Producer folds+    ,   Fold2+    ,   foldFallibly2+    ,   fold2+    ,   separated+    ,   combined         -- * Building folds         -- ** From foldl folds         -- $foldl@@ -28,10 +34,10 @@     ,   withFallibleCont      ,   withFallibleCont'           -- * Transducers-    ,   Transducer'-    ,   transduce+    ,   Transducer     ,   Delimited     ,   Continuous+    ,   transduce1         -- * Building transducers     ,   mapper      ,   fallibleMapper @@ -43,6 +49,8 @@     ,   delimit     ,   groups     ,   folds+    ,   concats+    ,   intercalates         -- * Utilities     ,   trip     ,   tripx@@ -83,13 +91,13 @@     Fail if the 'Producer' produces anything at all. The error value is what came     out of the 'Producer'. ->>> PT.foldFallibly trip (mapM_ yield ['z']) +>>> PT.foldFallibly1 trip (mapM_ yield ['z'])  Left 'z' ->>> PT.foldFallibly trip (mapM_ yield []) +>>> PT.foldFallibly1 trip (mapM_ yield [])  Right ((),()) -}-trip :: Fold' b b ()+trip :: Fold1 b b () trip = withFallibleCont' $ \producer -> do     n <- next producer       return $ case n of @@ -100,13 +108,13 @@     Throw an exception if the 'Producer' produces anything at all      __/BEWARE!/__ -    This 'Transducer' may throw 'AssertionFailed'.+    This 'Transducer may throw 'AssertionFailed'.     __/BEWARE!/__  ->>> PT.foldFallibly tripx (mapM_ yield ['z']) +>>> PT.foldFallibly1 tripx (mapM_ yield ['z'])  *** Exception: tripx -}-tripx :: Fold' b e ()+tripx :: Fold1 b e () tripx = withFallibleCont' $ \producer -> do     n <- next producer       case n of @@ -116,22 +124,22 @@  {- $foldl  -    'Fold'' values can be created out of the more general folds of the @foldl@+    'Fold1' values can be created out of the more general folds of the @foldl@     library, which are producer-agnostic. -}   {- $consumers  -    'Fold'' values can be created out of 'Consumer's from the @pipes@ library.+    'Fold1' values can be created out of 'Consumer's from the @pipes@ library. -}  {- $parsers  -    'Fold'' values can be created out of 'Parser's from the @pipes-parse@ library.+    'Fold1' values can be created out of 'Parser's from the @pipes-parse@ library. -}  {- $continuations  -    The most general way of constructing 'Fold'' values is from an arbitrary+    The most general way of constructing 'Fold1' values is from an arbitrary     function that consumes a 'Producer'. -}

@@ -56,28 +56,28 @@ {-|      Collect strict 'ByteString's into a lazy 'ByteString'. ->>> PT.fold intoLazyBytes (mapM_ yield ["aa","bb","cc"]) +>>> PT.fold1  intoLazyBytes (mapM_ yield ["aa","bb","cc"])  ("aabbcc",())  -}-intoLazyBytes :: Fold' ByteString e Data.ByteString.Lazy.ByteString+intoLazyBytes :: Fold1 ByteString e Data.ByteString.Lazy.ByteString intoLazyBytes = fmap Data.ByteString.Lazy.fromChunks (withFold Foldl.list)  drainHandleFallibly -    :: Fold' ByteString e r +    :: Fold1 ByteString e r      -> ChunkSize      -> Handle      -> IO (Either e r)  drainHandleFallibly somefold (ChunkSize csize) handle =-    fmap (bimap id fst) (Pipes.Transduce.foldFallibly somefold (Pipes.ByteString.hGetSome csize handle))+    fmap (bimap id fst) (Pipes.Transduce.foldFallibly1 somefold (Pipes.ByteString.hGetSome csize handle))  drainHandle-    :: Fold' ByteString Void r +    :: Fold1 ByteString Void r      -> ChunkSize       -> Handle      -> IO r drainHandle somefold (ChunkSize csize) handle =-    fmap fst (Pipes.Transduce.fold somefold (Pipes.ByteString.hGetSome csize handle))+    fmap fst (Pipes.Transduce.fold1 somefold (Pipes.ByteString.hGetSome csize handle))  {-| Maximum chunk size       -}

@@ -37,26 +37,26 @@     returning a value of type @a@, except when it fails early with an error of     type @e@. -}-newtype Fold' b e a = Fold' (Lift (Fold'_ b e) a) deriving (Functor)+newtype Fold1 b e a = Fold1 (Lift (Fold1_ b e) a) deriving (Functor) -data Fold'_ b e a = +data Fold1_ b e a =           TrueFold (Foldl.FoldM (ExceptT e IO) b a)        | ExhaustiveCont (forall r. Producer b IO r -> IO (Either e (a,r)))        | NonexhaustiveCont (Producer b IO () -> IO (Either e a))        deriving (Functor)  {-| -    'pure' creates a 'Fold'' that does nothing besides draining the+    'pure' creates a 'Fold1' that does nothing besides draining the     'Producer'.       '<*>' feeds both folds with the data of the same 'Producer'. If any of     them fails the combination fails. -}-instance Applicative (Fold' b e) where-    pure a = Fold' (pure a)-    Fold' fa <*> Fold' a = Fold' (fa <*> a)+instance Applicative (Fold1 b e) where+    pure a = Fold1 (pure a)+    Fold1 fa <*> Fold1 a = Fold1 (fa <*> a) -instance Applicative (Fold'_ b e) where+instance Applicative (Fold1_ b e) where     pure a = ExhaustiveCont (\producer -> do         r <- runEffect (producer >-> Pipes.drain)         pure (Right (a,r)))@@ -80,7 +80,7 @@                     `finally` atomically seal1                      `finally` atomically seal2)) -instance Bifunctor (Fold'_ b) where+instance Bifunctor (Fold1_ b) where   bimap f g s = case s of       TrueFold (Foldl.FoldM step start done) -> TrueFold (Foldl.FoldM            (\previous input -> withExceptT f (step previous input))@@ -92,21 +92,21 @@ {-|      'first' is useful to massage errors. -}-instance Bifunctor (Fold' b) where-  bimap f g (Fold' s) = Fold' (case s of+instance Bifunctor (Fold1 b) where+  bimap f g (Fold1 s) = Fold1 (case s of       Pure a -> Pure (g a)       Other o -> Other (bimap f g o)) -instance (Monoid a) => Monoid (Fold' b e a) where+instance (Monoid a) => Monoid (Fold1 b e a) where    mempty = pure mempty    mappend s1 s2 = (<>) <$> s1 <*> s2 -nonexhaustiveCont :: Fold'_ b e a -> Producer b IO () -> IO (Either e a)+nonexhaustiveCont :: Fold1_ b e a -> Producer b IO () -> IO (Either e a) nonexhaustiveCont (TrueFold e) = \producer -> runExceptT (Foldl.impurely Pipes.foldM e (hoist lift producer)) nonexhaustiveCont (ExhaustiveCont e) = \producer -> liftM (fmap fst) (e producer) nonexhaustiveCont (NonexhaustiveCont u) = u -exhaustiveCont :: Fold'_ b e a -> Producer b IO r -> IO (Either e (a,r))+exhaustiveCont :: Fold1_ b e a -> Producer b IO r -> IO (Either e (a,r)) exhaustiveCont s = case s of      TrueFold e -> \producer ->          runExceptT (Foldl.impurely Pipes.foldM' e (hoist lift producer))@@ -125,79 +125,79 @@  withFallibleCont      :: (Producer b IO () -> IO (Either e a)) -- ^-    -> Fold' b e a -withFallibleCont f = Fold' (Other (NonexhaustiveCont f))+    -> Fold1 b e a +withFallibleCont f = Fold1 (Other (NonexhaustiveCont f))  withFallibleCont'       :: (forall r. Producer b IO r -> IO (Either e (a,r))) -- ^-    -> Fold' b e a -withFallibleCont' f = Fold' (Other (ExhaustiveCont f))+    -> Fold1 b e a +withFallibleCont' f = Fold1 (Other (ExhaustiveCont f))  withCont      :: (Producer b IO () -> IO a) -- ^-    -> Fold' b e a -- ^+    -> Fold1 b e a -- ^ withCont aFold = withFallibleCont $ fmap (fmap pure) $ aFold  withCont'      :: (forall r. Producer b IO r -> IO (a,r)) -- ^-    -> Fold' b e a -- ^+    -> Fold1 b e a -- ^ withCont' aFold = withFallibleCont' $ fmap (fmap pure) aFold -withFold :: Foldl.Fold b a -> Fold' b e a -withFold aFold = Fold' (Other (TrueFold (Foldl.generalize aFold)))+withFold :: Foldl.Fold b a -> Fold1 b e a +withFold aFold = Fold1 (Other (TrueFold (Foldl.generalize aFold))) -withFoldIO :: Foldl.FoldM IO b a -> Fold' b e a -withFoldIO aFold = Fold' (Other (TrueFold (hoistFold lift aFold)))+withFoldIO :: Foldl.FoldM IO b a -> Fold1 b e a +withFoldIO aFold = Fold1 (Other (TrueFold (hoistFold lift aFold)))  hoistFold :: Monad m => (forall a. m a -> n a) -> Foldl.FoldM m i r -> Foldl.FoldM n i r  hoistFold g (Foldl.FoldM step begin done) = Foldl.FoldM (\s i -> g (step s i)) (g begin) (g . done) -withFallibleFold :: Foldl.FoldM (ExceptT e IO) b a -> Fold' b e a -withFallibleFold aFold = Fold' (Other (TrueFold aFold))+withFallibleFold :: Foldl.FoldM (ExceptT e IO) b a -> Fold1 b e a +withFallibleFold aFold = Fold1 (Other (TrueFold aFold))  --withFoldM  --    :: MonadIO m  --    => (forall r. m (a,r) -> IO (Either e (c,r)))  --    -> Foldl.FoldM m b a ---    -> Fold' b e c +--    -> Fold1 b e c  --withFoldM whittle aFoldM = withFallibleCont' $ \producer ->  --    whittle $ Foldl.impurely Pipes.Prelude.foldM' aFoldM (hoist liftIO producer) -withConsumer :: Consumer b IO () -> Fold' b e ()+withConsumer :: Consumer b IO () -> Fold1 b e () withConsumer consumer = withCont $ \producer -> runEffect $ producer >-> consumer  -{-| Builds a 'Fold'' out of a 'Consumer' that never stops by itself.+{-| Builds a 'Fold1' out of a 'Consumer' that never stops by itself.  -}-withConsumer' :: Consumer b IO Void -> Fold' b e ()+withConsumer' :: Consumer b IO Void -> Fold1 b e () withConsumer' consumer = withCont' $ \producer -> fmap ((,) ()) $ runEffect $ producer >-> fmap absurd consumer   withConsumerM :: MonadIO m                => (m () -> IO (Either e a))  -- ^               -> Consumer b m () -              -> Fold' b e a+              -> Fold1 b e a withConsumerM whittle consumer = withFallibleCont $ \producer -> whittle $ runEffect $ (hoist liftIO producer) >-> consumer   withConsumerM' :: MonadIO m                 => (forall r. m r -> IO (Either e (a,r))) -- ^                -> Consumer b m Void-               -> Fold' b e a+               -> Fold1 b e a withConsumerM' whittle consumer = withFallibleCont' $ \producer -> whittle $ runEffect $ (hoist liftIO producer) >-> fmap absurd consumer   withSafeConsumer      :: Consumer b (SafeT IO) Void -- ^-    -> Fold' b e ()+    -> Fold1 b e () withSafeConsumer = withConsumerM' (fmap (\r -> Right ((),r)) . runSafeT)  withFallibleConsumer      :: Consumer b (ExceptT e IO) Void -- ^-    -> Fold' b e ()+    -> Fold1 b e () withFallibleConsumer = withConsumerM' (fmap (fmap (\r -> ((), r))) . runExceptT)   withParser      :: Pipes.Parse.Parser b IO (Either e a) -- ^-    -> Fold' b e a +    -> Fold1 b e a  withParser parser = withFallibleCont' $ \producer -> drainage $ Pipes.Parse.runStateT parser producer   where     drainage m = do @@ -209,7 +209,7 @@  withParserM :: MonadIO m              => (forall r. m (a,r) -> IO (Either e (c,r))) -- ^-            -> Pipes.Parse.Parser b m a -> Fold' b e c +            -> Pipes.Parse.Parser b m a -> Fold1 b e c  withParserM f parser = withFallibleCont' $ \producer -> f $ drainage $ (Pipes.Parse.runStateT parser) (hoist liftIO producer)   where     drainage m = do @@ -220,24 +220,24 @@ ------------------------------------------------------------------------------  {-| -    Run a 'Fold''.+    Run a 'Fold1'. -}-foldFallibly :: Fold' b e a -> Producer b IO r -> IO (Either e (a,r))-foldFallibly (Fold' (unLift -> s)) = exhaustiveCont s+foldFallibly1 :: Fold1 b e a -> Producer b IO r -> IO (Either e (a,r))+foldFallibly1 (Fold1 (unLift -> s)) = exhaustiveCont s  {-| -    Run a 'Fold'' that never returns an error value (but which may still throw exceptions!)+    Run a 'Fold1' that never returns an error value (but which may still throw exceptions!) -}-fold :: Fold' b Void a -> Producer b IO r -> IO (a,r)-fold (Fold' (unLift -> s)) = liftM (either absurd id) . exhaustiveCont s+fold1 :: Fold1 b Void a -> Producer b IO r -> IO (a,r)+fold1 (Fold1 (unLift -> s)) = liftM (either absurd id) . exhaustiveCont s -{-| A transformation that takes the inputs of a 'Fold'' from type @a@ to type @b@.		+{-| A transformation that takes the inputs of a 'Fold1' from type @a@ to type @b@.		      Optionally, the transformation may delimit groups of elements in the     stream. In that case the phantom type @x@ will be 'Delimited'. Otherwise, it will be     'Continuous'. -}-data Transducer' x b e a = +data Transducer x b e a =        M (b -> a)     | F (b -> [a])     | P (forall r. Producer b IO r -> Producer a IO r)@@ -245,10 +245,10 @@     | S (forall r. Producer b IO r -> FreeT (Producer a IO) IO r)     | SE (forall r. Producer b IO r -> FreeT (Producer a IO) IO (Either e r)) -instance Functor (Transducer' x b e) where+instance Functor (Transducer x b e) where   fmap = second -instance Bifunctor (Transducer' x b) where+instance Bifunctor (Transducer x b) where   bimap f g s = case s of       M x -> M (g . x)       F x -> F (fmap g . x)@@ -259,12 +259,12 @@  mapper      :: (a -> b) -- ^-    -> Transducer' Continuous a e b+    -> Transducer Continuous a e b mapper = M  fallibleM      :: (a -> Either e b) -- ^-    -> Transducer' Continuous a e b  -- ^+    -> Transducer Continuous a e b  -- ^ fallibleM fallible = PE (\producer -> (runExceptT . distribute) (for (hoist lift producer) (\a -> do     case fallible a of         Left e -> lift (throwE e)@@ -272,7 +272,7 @@  fallibleMapper      :: (a -> Either e b) -- ^-    -> Transducer' Continuous a e b  -- ^+    -> Transducer Continuous a e b  -- ^ fallibleMapper fallible = PE (\producer -> (runExceptT . distribute) (for (hoist lift producer) (\a -> do     case fallible a of         Left e -> lift (throwE e)@@ -281,23 +281,23 @@ mapperFoldable      :: Foldable f      => (a -> f b) -- ^-    -> Transducer' Continuous a e b -- ^+    -> Transducer Continuous a e b -- ^ mapperFoldable f = F (Data.Foldable.toList . f)  mapperEnumerable      :: Enumerable f      => (a -> f IO b) -- ^-    -> Transducer' Continuous a e b  -- ^+    -> Transducer Continuous a e b  -- ^ mapperEnumerable enumerable = P (\producer -> for producer (enumerate . toListT . enumerable))  transducer      :: (forall r. Producer b IO r -> Producer a IO r)  -- ^-    -> Transducer' Continuous b e a -- ^+    -> Transducer Continuous b e a -- ^ transducer = P  fallibleTransducer      :: (forall r. Producer b IO r -> Producer a IO (Either e r))  -- ^-    -> Transducer' Continuous b e a  -- ^+    -> Transducer Continuous b e a  -- ^ fallibleTransducer = PE  {-| Plug splitting functions from @pipes-group@ here.		@@ -305,8 +305,8 @@ -} delimit      :: (forall r. Producer a IO r -> FreeT (Producer a' IO) IO r) -- ^-    -> Transducer' Continuous b e a -- ^-    -> Transducer' Delimited b e a' -- ^+    -> Transducer Continuous b e a -- ^+    -> Transducer Delimited b e a' -- ^ delimit f t = case t of     M func -> S (\producer -> f (producer >-> Pipes.Prelude.map func))     F func -> S (\producer -> f (producer >-> mapFoldable func))@@ -315,27 +315,27 @@     S g -> S (f . Pipes.concats . g)     SE g -> SE (f . Pipes.concats . g) -{-| Apply a 'Transducer'' ('Delimited' of 'Continuous') to a 'Fold''.		+{-| Apply a 'Transducer' to a 'Fold1'.		  -}-transduce :: Transducer' x b e a -> Fold' a e r -> Fold' b e r-transduce (M _) (Fold' (Pure x)) = -    Fold' (Pure x)-transduce (M f) (Fold' (Other s)) = (Fold' (Other (case s of+transduce1 :: Transducer Continuous b e a -> Fold1 a e r -> Fold1 b e r+transduce1 (M _) (Fold1 (Pure x)) = +    Fold1 (Pure x)+transduce1 (M f) (Fold1 (Other s)) = (Fold1 (Other (case s of     TrueFold x -> TrueFold (Foldl.premapM f x)     ExhaustiveCont x -> ExhaustiveCont (\producer -> x (producer >-> Pipes.Prelude.map f))     NonexhaustiveCont x -> NonexhaustiveCont (\producer -> x (producer >-> Pipes.Prelude.map f)))))-transduce (F _) (Fold' (Pure x)) = -    Fold' (Pure x)-transduce (F f) (Fold' (Other s)) = (Fold' (Other (case s of+transduce1 (F _) (Fold1 (Pure x)) = +    Fold1 (Pure x)+transduce1 (F f) (Fold1 (Other s)) = (Fold1 (Other (case s of     TrueFold x -> TrueFold (Foldl.handlesM (folding f) x)     ExhaustiveCont x -> ExhaustiveCont (\producer -> x (producer >-> Pipes.Prelude.mapFoldable f))     NonexhaustiveCont x -> NonexhaustiveCont (\producer -> x (producer >-> Pipes.Prelude.mapFoldable f)))))-transduce (P f) (Fold' (unLift -> s)) = case s of-    NonexhaustiveCont x -> Fold' (Other (NonexhaustiveCont (x . f)))-    _ -> Fold' (Other (ExhaustiveCont (exhaustiveCont s . f)))-transduce (PE f) (Fold' (exhaustiveCont . unLift -> s)) = do-    Fold' (Other (ExhaustiveCont (\producer -> do+transduce1 (P f) (Fold1 (unLift -> s)) = case s of+    NonexhaustiveCont x -> Fold1 (Other (NonexhaustiveCont (x . f)))+    _ -> Fold1 (Other (ExhaustiveCont (exhaustiveCont s . f)))+transduce1 (PE f) (Fold1 (exhaustiveCont . unLift -> s)) = do+    Fold1 (Other (ExhaustiveCont (\producer -> do         (outbox,inbox,seal) <- spawn' (bounded 1)         runConceit $              (\(r,()) r' -> (r,r'))@@ -345,16 +345,16 @@             (Conceit $                 (runEffect (f producer >-> (toOutput outbox *> Pipes.drain))                  `finally` atomically seal)))))-transduce (S f) somefold = transduce (P (Pipes.concats . f)) somefold-transduce (SE f) somefold = transduce (PE (Pipes.concats . f)) somefold+transduce1 (S f) somefold = transduce1 (P (Pipes.concats . f)) somefold+transduce1 (SE f) somefold = transduce1 (PE (Pipes.concats . f)) somefold -{-| Tweak each of the groups delimited by a 'Transducer''.		+{-| Tweak each of the groups delimited by a 'Transducer'.		  -} groups      :: (forall r. Producer b IO r -> Producer b' IO r) -- ^-    -> Transducer' Delimited a e b  -- ^-    -> Transducer' Delimited a e b' -- ^+    -> Transducer Delimited a e b  -- ^+    -> Transducer Delimited a e b' -- ^ groups f t = case t of     M func -> P (f . (\producer -> producer >-> Pipes.Prelude.map func))     F func -> P (f . (\producer -> producer >-> mapFoldable func))@@ -364,18 +364,126 @@     SE g -> SE (Pipes.maps f . g)  folds -    :: Fold' b Void b' -- ^-    -> Transducer' Delimited a e b -    -> Transducer' Continuous a e b'+    :: Fold1 b Void b' -- ^+    -> Transducer Delimited a e b +    -> Transducer Continuous a e b' folds somefold t = case t of     M func -> folds somefold (P (\producer -> producer >-> Pipes.Prelude.map func))     F func -> folds somefold (P (\producer -> producer >-> mapFoldable func))     P g -> folds somefold (S (liftF . g))     PE g -> folds somefold (SE (liftF . g))-    S g -> P (Pipes.concats . transFreeT ((\action -> lift action >>= (\(b',r) -> Pipes.yield b' >> return r)) . Pipes.Transduce.Internal.fold somefold) . g)-    SE g -> PE (Pipes.concats . transFreeT ((\action -> lift action >>= (\(b',r) -> Pipes.yield b' >> return r)) . Pipes.Transduce.Internal.fold somefold) . g)+    S g -> P (Pipes.concats . transFreeT ((\action -> lift action >>= (\(b',r) -> Pipes.yield b' >> return r)) . Pipes.Transduce.Internal.fold1 somefold) . g)+    SE g -> PE (Pipes.concats . transFreeT ((\action -> lift action >>= (\(b',r) -> Pipes.yield b' >> return r)) . Pipes.Transduce.Internal.fold1 somefold) . g)  data Delimited  data Continuous +concats +    :: Transducer Delimited a e b   -- ^+    -> Transducer Continuous a e b+concats t =  case t of+    M func -> M func+    F func -> F func+    P g -> P g+    PE g -> PE g+    S g -> P (Pipes.concats . g)+    SE g -> PE (Pipes.concats . g)++intercalates +    :: Producer b IO ()  -- ^+    -> Transducer Delimited a e b +    -> Transducer Continuous a e b+intercalates p t =  case t of+    M func -> M func+    F func -> F func+    P g -> P g+    PE g -> PE g+    S g -> P (Pipes.intercalates p . g)+    SE g -> PE (Pipes.intercalates p . g)++++newtype Fold2 b1 b2 e a = Fold2 (forall r1 r2. Producer b1 IO r1 -> Producer b2 IO r2 -> IO (Either e (a,r1,r2))) deriving (Functor)++instance Bifunctor (Fold2 b1 b2) where+    bimap f g (Fold2 s) = Fold2 (fmap (fmap (fmap (bimap f (\(x1,x2,x3) -> (g x1,x2,x3))))) s) ++instance Applicative (Fold2 b1 b2 e) where+    pure a = Fold2 (\producer1 producer2 -> do+        (r1,r2) <- _runConceit $+            (,)+            <$>+            _Conceit (runEffect (producer1 >-> Pipes.drain))+            <*>+            _Conceit (runEffect (producer2 >-> Pipes.drain))+        pure (Right (a,r1,r2)))++    Fold2 fs <*> Fold2 as = Fold2 (\producer1 producer2 -> do+        (outbox1a,inbox1a,seal1a) <- spawn' (bounded 1)+        (outbox2a,inbox2a,seal2a) <- spawn' (bounded 1)+        (outbox1b,inbox1b,seal1b) <- spawn' (bounded 1)+        (outbox2b,inbox2b,seal2b) <- spawn' (bounded 1)+        runConceit $+            (\(f,(),()) (x,(),()) r1 r2 -> (f x,r1,r2))+            <$>+            Conceit (fs (fromInput inbox1a) (fromInput inbox1b) `finally` atomically seal1a `finally` atomically seal1b)+            <*>+            Conceit (as (fromInput inbox2a) (fromInput inbox2b) `finally` atomically seal2a `finally` atomically seal2b)+            <*>+            (_Conceit $+                (runEffect (producer1 >-> Pipes.tee (toOutput outbox1a *> Pipes.drain) +                                      >->           (toOutput outbox2a *> Pipes.drain)))+                `finally` atomically seal1a +                `finally` atomically seal2a)+            <*>+            (_Conceit $+                (runEffect (producer2 >-> Pipes.tee (toOutput outbox1b *> Pipes.drain) +                                      >->           (toOutput outbox2b *> Pipes.drain)))+                `finally` atomically seal1b +                `finally` atomically seal2b))++instance (Monoid a) => Monoid (Fold2 b1 b2 e a) where+   mempty = pure mempty+   mappend s1 s2 = (<>) <$> s1 <*> s2++{-| +    Run a 'Fold2'.+-}+foldFallibly2 :: Fold2 b1 b2 e a -> Producer b1 IO r1 -> Producer b2 IO r2 -> IO (Either e (a,r1,r2))+foldFallibly2 (Fold2 s) producer1 producer2 = s producer1 producer2+++{-| +    Run a 'Fold2' that never returns an error value (but which may still throw exceptions!)+-}+fold2 :: Fold2 b1 b2 Void a -> Producer b1 IO r1 -> Producer b2 IO r2 -> IO (a,r1,r2)+fold2 (Fold2 s) producer1 producer2 = liftM (either absurd id) (s producer1 producer2) ++separated :: Fold1 b1 e r1 -> Fold1 b2 e r2 -> Fold2 b1 b2 e (r1,r2)+separated f1 f2 = Fold2 (\producer1 producer2 ->+    runConceit $+        (\(r1,x1) (r2,x2) -> ((r1,r2),x1,x2))+        <$>+        Conceit (foldFallibly1 f1 producer1)+        <*>+        Conceit (foldFallibly1 f2 producer2))++combined :: Transducer Delimited b1 e x -> Transducer Delimited b2 e x -> Fold1 x e a -> Fold2 b1 b2 e a+combined t1 t2 f = Fold2 (\producer1 producer2 -> do+   (outbox, inbox, seal) <- spawn' (bounded 1)+   lock <- newMVar outbox+   runConceit $ +       (\((),r1) ((),r2) (a,()) -> (a,r1,r2))+       <$>+       Conceit (foldFallibly1 (transduce1 (folds (withCont' (iterTLines lock)) t1) (pure ())) producer1 `finally` atomically seal)+       <*>+       Conceit (foldFallibly1 (transduce1 (folds (withCont' (iterTLines lock)) t2) (pure ())) producer2 `finally` atomically seal)+       <*>+       Conceit (foldFallibly1 f (fromInput inbox) `finally` atomically seal))+  where+    -- iterTLines mvar = iterT $ \textProducer -> do+    iterTLines mvar = \textProducer -> fmap (\x -> ((),x)) $ do+        -- the P.drain bit was difficult to figure out!!!+        withMVar mvar $ \output -> do+            runEffect $ textProducer >-> (toOutput output >> Pipes.drain)

@@ -5,6 +5,7 @@         intoLazyText          -- * Splitting     ,   lines+    ,   lines_         -- * Grouping     ,   foldedLines         -- * Decoding@@ -20,6 +21,7 @@ import Data.Void import Data.Foldable import Data.ByteString+import qualified Data.Text  import Data.Text hiding (lines) import Data.Text.Encoding.Error (UnicodeException(..)) import Control.Applicative@@ -62,27 +64,38 @@     Split the stream into lines, collect them into lazy 'Text' values, and pass     them downstream.  ->>> PT.fold (transduce foldedLines (withFold L.list)) (mapM_ yield ["aa","aa\nbb","bb"]) +>>> PT.fold1  (transduce1 foldedLines (withFold L.list)) (mapM_ yield ["aa","aa\nbb","bb"])  (["aaaa","bbbb"],())  -} foldedLines -    :: Transducer' Continuous Text e Data.Text.Lazy.Text +    :: Transducer Continuous Text e Data.Text.Lazy.Text  foldedLines =      Pipes.Transduce.folds      (fmap Data.Text.Lazy.fromChunks (Pipes.Transduce.withFold Foldl.list)) -    (lines (Pipes.Transduce.mapper id))+    (lines_ (Pipes.Transduce.mapper id))  {-|  ->>> PT.fold (transduce (groups (\p -> yield "x" >> p) (lines (transducer id))) intoLazyText) (mapM_ yield ["aa\n","bb"]) +>>> PT.fold1  (transduce1 (concats (groups (\p -> yield "x" >> p) (lines_ (transducer id)))) intoLazyText) (mapM_ yield ["aa\n","bb"])  ("xaaxbb",())  -}+lines_ +    :: Transducer Continuous a e Text -- ^+    -> Transducer Delimited a e Text -- ^+lines_ sometrans = delimit (view Pipes.Text.lines) sometrans++{-| ++>>> PT.fold1  (transduce1 (concats (groups (\p -> yield "x" >> p) (lines (transducer id)))) intoLazyText) (mapM_ yield ["aa\n","bb"]) +("xaa\nxbb\n",())++-} lines -    :: Transducer' Continuous a e Text -- ^-    -> Transducer' Delimited a e Text -- ^-lines sometrans = delimit (view Pipes.Text.lines) sometrans+    :: Transducer Continuous a e Text -- ^+    -> Transducer Delimited a e Text -- ^+lines  = groups (\p -> p <* Pipes.yield (Data.Text.singleton '\n')) . lines_  {-| Plug decoding functions from @pipes-text@ here.  @@ -90,7 +103,7 @@ -} decoder      :: (forall r. Producer ByteString IO r -> Producer Text IO (Producer ByteString IO r))-    -> Transducer' Continuous ByteString ByteString Text -- ^+    -> Transducer Continuous ByteString ByteString Text -- ^ decoder f = PE (\producer -> f producer >>= \producer' -> lift (do     n <- next producer'     case n of@@ -100,12 +113,12 @@ {-| Plug decoding functions from @pipes-text@ here.       __/BEWARE!/__ -    This 'Transducer'' may throw 'DecodeError' here.+    This 'Transducer' may throw 'DecodeError' here.     __/BEWARE!/__  -} decoderx     :: (forall r. Producer ByteString IO r -> Producer Text IO (Producer ByteString IO r))-    -> Transducer' Continuous ByteString e Text -- ^+    -> Transducer Continuous ByteString e Text -- ^ decoderx f = P (\producer -> f producer >>= \producer' -> lift (do     n <- next producer'     case n of@@ -115,31 +128,32 @@ {-|      The first undecodable bytes will be the error value. ->>> PT.foldFallibly (transduce utf8 intoLazyText) (mapM_ yield ["aa"]) +>>> PT.foldFallibly1 (transduce1 utf8 intoLazyText) (mapM_ yield ["aa"])  Right ("aa",())  -}-utf8 :: Transducer' Continuous ByteString ByteString Text -- ^+utf8 :: Transducer Continuous ByteString ByteString Text -- ^ utf8 = decoder decodeUtf8  {-|  ->>> PT.fold (transduce utf8x intoLazyText) (mapM_ yield ["aa"]) +>>> PT.fold1  (transduce1 utf8x intoLazyText) (mapM_ yield ["aa"])  ("aa",())      __/BEWARE!/__ -    This 'Transducer'' may throw 'DecodeError'.+    This 'Transducer' may throw 'DecodeError'.     __/BEWARE!/__  -}-utf8x :: Transducer' Continuous ByteString e Text -- ^+utf8x :: Transducer Continuous ByteString e Text -- ^ utf8x = decoderx decodeUtf8  {-|      Collect strict 'Text's into a lazy 'Text'. ->>> PT.fold intoLazyText (mapM_ yield ["aa","bb","cc"]) +>>> PT.fold1  intoLazyText (mapM_ yield ["aa","bb","cc"])  ("aabbcc",())  -}-intoLazyText :: Fold' Text e Data.Text.Lazy.Text+intoLazyText :: Fold1 Text e Data.Text.Lazy.Text intoLazyText = fmap Data.Text.Lazy.fromChunks (withFold Foldl.list)+