conduit-extra 0.1.4 → 0.1.5

raw patch · 4 files changed

+84/−1 lines, 4 files

Files

• Data/Conduit/Extra.hs +2/−0
• Data/Conduit/Extra/ZipConduit.hs +78/−0
• conduit-extra.cabal +2/−1
• test/main.hs +2/−0

@@ -1,11 +1,13 @@ module Data.Conduit.Extra     ( module Data.Conduit.Extra.ZipSink+    , module Data.Conduit.Extra.ZipConduit     , module Data.Conduit.Extra.Resumable     , fuseLeftovers     , fuseReturnLeftovers     ) where  import Data.Conduit.Extra.ZipSink+import Data.Conduit.Extra.ZipConduit import Data.Conduit.Extra.Resumable import Data.Conduit import Data.Conduit.Internal (Pipe (..), ConduitM (..))

@@ -0,0 +1,78 @@+{-# LANGUAGE DeriveFunctor #-}+module Data.Conduit.Extra.ZipConduit+    ( ZipConduit (..)+    , sequenceConduits+    ) where++import Data.Conduit+import Data.Conduit.Internal (Pipe (..), ConduitM (..), injectLeftovers)+import Data.Void (absurd)+import Control.Monad (liftM)+import Control.Applicative (Applicative (..))+import Data.Traversable (Traversable, sequenceA)++zipConduit :: Monad m+           => ConduitM i o m (x -> y)+           -> ConduitM i o m x+           -> ConduitM i o m y+zipConduit (ConduitM left0) (ConduitM right0) =+    ConduitM $ go (return ()) (return ()) (injectLeftovers left0) (injectLeftovers right0)+  where+    go _ _ (Done f) (Done x) = Done (f x)+    go _ finalY (HaveOutput x finalX o) y = HaveOutput+        (go finalX finalY x y)+        (finalX >> finalY)+        o+    go finalX _ x (HaveOutput y finalY o) = HaveOutput+        (go finalX finalY x y)+        (finalX >> finalY)+        o+    go _ _ (Leftover _ i) _ = absurd i+    go _ _ _ (Leftover _ i) = absurd i+    go finalX finalY (PipeM mx) y = PipeM (flip (go finalX finalY) y `liftM` mx)+    go finalX finalY x (PipeM my) = PipeM (go finalX finalY x `liftM` my)+    go finalX finalY (NeedInput px cx) (NeedInput py cy) = NeedInput+        (\i -> go finalX finalY (px i) (py i))+        (\u -> go finalX finalY (cx u) (cy u))+    go finalX finalY (NeedInput px cx) (Done y) = NeedInput+        (\i -> go finalX finalY (px i) (Done y))+        (\u -> go finalX finalY (cx u) (Done y))+    go finalX finalY (Done x) (NeedInput py cy) = NeedInput+        (\i -> go finalX finalY (Done x) (py i))+        (\u -> go finalX finalY (Done x) (cy u))++-- | Provides an alternative @Applicative@ instance for @ConduitM@. In this instance,+-- every incoming value is provided to all @ConduitM@s, and output is coalesced together.+-- Leftovers from individual @ConduitM@s will be used within that component, and then discarded+-- at the end of their computation. Output and finalizers will both be handled in a left-biased manner.+--+-- As an example, take the following program:+--+-- @+-- main :: IO ()+-- main = do+--     let src = mapM_ yield [1..3 :: Int]+--         conduit1 = CL.map (+1)+--         conduit2 = CL.concatMap (replicate 2)+--         conduit = getZipConduit $ ZipConduit conduit1 <* ZipConduit conduit2+--         sink = CL.mapM_ print+--     src $$ conduit =$ sink+-- @+--+-- It will produce the output: 2, 1, 1, 3, 2, 2, 4, 3, 3+--+-- Since 0.1.5+newtype ZipConduit i o m r = ZipConduit { getZipConduit :: ConduitM i o m r }+    deriving Functor+instance Monad m => Applicative (ZipConduit i o m) where+    pure = ZipConduit . pure+    ZipConduit left <*> ZipConduit right = ZipConduit (zipConduit 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 0.1.5+sequenceConduits :: (Traversable f, Monad m) => f (ConduitM i o m r) -> ConduitM i o m (f r)+sequenceConduits = getZipConduit . sequenceA . fmap ZipConduit

@@ -1,5 +1,5 @@ Name:                conduit-extra-Version:             0.1.4+Version:             0.1.5 Synopsis:            Experimental helper functions for conduit. Description:     This package is meant as a testing ground for new concepts in conduit. The idea is to have a much lower barrier to entry for this library relative to conduit itself. This way, conduit itself will continue to have a best-practices, minimal, stable API, while people are free to try crazy new features.@@ -17,6 +17,7 @@                      , Data.Conduit.Extra.Pipes                      , Data.Conduit.Extra.Resumable                      , Data.Conduit.Extra.ZipSink+                     , Data.Conduit.Extra.ZipConduit                      , Data.Conduit.Extra.Utils   Build-depends:       base                     >= 4            && < 5                      , conduit                  >= 1.0

@@ -13,6 +13,7 @@ import qualified Data.Conduit.Extra as CE import Data.Conduit (runResourceT) import qualified Data.Conduit.ExtraSpec as ES+import qualified Data.Conduit.Extra.ZipConduitSpec as ZipConduit   main :: IO ()@@ -33,3 +34,4 @@             x `shouldBe` (505000 :: Integer)      ES.spec+    ZipConduit.spec