conduit-extra 0.1.7 → 1.0.0
raw patch · 9 files changed
+3/−545 lines, 9 filesdep −QuickCheckdep −bytestringdep −conduitdep ~base
Dependencies removed: QuickCheck, bytestring, conduit, conduit-extra, containers, foldl, hspec, monad-loops, mtl, primitive, resourcet, text, transformers, vector, void
Dependency ranges changed: base
Files
- Data/Conduit/Extra.hs +0/−68
- Data/Conduit/Extra/Foldl.hs +0/−21
- Data/Conduit/Extra/Pipes.hs +0/−94
- Data/Conduit/Extra/Resumable.hs +0/−92
- Data/Conduit/Extra/Utils.hs +0/−65
- Data/Conduit/Extra/ZipConduit.hs +0/−81
- Data/Conduit/Extra/ZipSink.hs +0/−45
- conduit-extra.cabal +3/−40
- test/main.hs +0/−39
− Data/Conduit/Extra.hs
@@ -1,68 +0,0 @@-{-# LANGUAGE CPP #-}-module Data.Conduit.Extra- ( module Data.Conduit.Extra.ZipSink- , module Data.Conduit.Extra.ZipConduit- , module Data.Conduit.Extra.Resumable- , module Data.Conduit.Extra.Foldl- , fuseLeftovers- , fuseReturnLeftovers- ) where--import Data.Conduit.Extra.ZipSink-import Data.Conduit.Extra.ZipConduit-import Data.Conduit.Extra.Resumable-import Data.Conduit.Extra.Foldl-import Data.Conduit-import Data.Conduit.Internal (Pipe (..), ConduitM (..))-import Control.Monad (liftM)--#if !MIN_VERSION_conduit(1,0,17)--- | Same as normal fusion (e.g. @=$=@), except instead of discarding leftovers--- from the downstream component, return them.------ Since 1.0.4-fuseReturnLeftovers :: Monad m- => ConduitM a b m ()- -> ConduitM b c m r- -> ConduitM a c m (r, [b])-fuseReturnLeftovers (ConduitM left0) (ConduitM right0) =- ConduitM $ goRight (return ()) [] left0 right0- where- goRight final bs left right =- case right of- HaveOutput p c o -> HaveOutput (recurse p) (c >> final) o- NeedInput rp rc ->- case bs of- [] -> goLeft rp rc final left- b:bs' -> goRight final bs' left (rp b)- Done r2 -> PipeM (final >> return (Done (r2, bs)))- PipeM mp -> PipeM (liftM recurse mp)- Leftover p b -> goRight final (b:bs) left p- where- recurse = goRight final bs left-- goLeft rp rc final left =- case left of- HaveOutput left' final' o -> goRight final' [] left' (rp o)- NeedInput left' lc -> NeedInput (recurse . left') (recurse . lc)- Done r1 -> goRight (return ()) [] (Done r1) (rc r1)- PipeM mp -> PipeM (liftM recurse mp)- Leftover left' i -> Leftover (recurse left') i- where- recurse = goLeft rp rc final---- | Similar to @fuseReturnLeftovers@, but use the provided function to convert--- downstream leftovers to upstream leftovers.------ Since 1.0.4-fuseLeftovers- :: Monad m- => ([b] -> [a])- -> ConduitM a b m ()- -> ConduitM b c m r- -> ConduitM a c m r-fuseLeftovers f left right = do- (r, bs) <- fuseReturnLeftovers left right- mapM_ leftover $ reverse $ f bs- return r-#endif
− Data/Conduit/Extra/Foldl.hs
@@ -1,21 +0,0 @@-{-# LANGUAGE RankNTypes #-}--- | Adapter module to work with the foldl package.-module Data.Conduit.Extra.Foldl where--import qualified Control.Foldl as F-import Data.Conduit-import Control.Monad.Trans.Class (lift)-import qualified Data.Conduit.List as CL---- | Convert a 'F.Fold' into a 'Consumer'.------ Since 0.1.6-sinkFold :: Monad m => F.Fold a b -> Consumer a m b-sinkFold (F.Fold f seed extract) = fmap extract (CL.fold f seed)---- | Convert a 'F.FoldM' into a 'Consumer'.------ Since 0.1.6-sinkFoldM :: Monad m => F.FoldM m a b -> Consumer a m b-sinkFoldM (F.FoldM f mseed extract) =- lift mseed >>= CL.foldM f >>= lift . extract
− Data/Conduit/Extra/Pipes.hs
@@ -1,94 +0,0 @@-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE RankNTypes #-}---- | Provides a convenience layer on top of conduit with functions and--- operators similar to the pipes library.-module Data.Conduit.Extra.Pipes- ( (>->), (<-<)- , runPipe, runPipeR, runEffect- , forP, each- , take, peel- , replicateM- , tee- , module X- , module CL- ) where--import Control.Monad.Trans.Class-import Data.Conduit as X-import Data.Conduit.List as CL hiding (take)-import Data.Foldable-import Data.Void-import Prelude hiding (take)---- | The conduit composition operator, ala pipes. When combined with--- 'runPipe' (or 'runEffect', if you prefer), this is the only operator--- needed.-(>->) :: forall a b i o m. Monad m- => ConduitM i a m () -> ConduitM a o m b -> ConduitM i o m b-(>->) = (=$=)--(<-<) :: forall a b i o m. Monad m- => ConduitM a o m b -> ConduitM i a m () -> ConduitM i o m b-(<-<) = flip (>->)---- | Run a conduit. This name may be preferable to the overly generic--- 'runEffect', which pipes uses.-runPipe :: forall m b. Monad m => ConduitM () Void m b -> m b-runPipe c = yield () $$ c--runEffect :: forall m b. Monad m => ConduitM () Void m b -> m b-runEffect = runPipe---- | Like 'runPipe', except implies a call to 'runResourceT', for running--- resource-sensitive pipelines.-runPipeR :: forall m b. (MonadBaseControl IO m, Monad m)- => ConduitM () Void (ResourceT m) b -> m b-runPipeR = runResourceT . runPipe---- | Iterate over all the elements from source, similar to 'forM' for a monad.-forP :: Monad m => Source m a -> (a -> m ()) -> m ()-forP p a = p $$ CL.mapM_ a---- | Take N items from a conduit. Synonym for Conduit's 'isolate'.-take :: Monad m => Int -> Conduit a m a-take = CL.isolate---- | Peel off N items from a conduit and return them. Synonym for Conduit's--- 'take'.-peel :: Monad m => Int -> m [()]-peel n = take n $$ CL.consume---- | Call 'yield' for each element of the 'Foldable' data structure, resulting--- in a 'Producer' over these elements.------ >>> runPipe $ forP (each [1..3]) $ liftIO . print--- 1--- 2--- 3-each :: (Monad m, Foldable f) => f a -> Producer m a-each = Data.Foldable.mapM_ yield---- | Replicate a monadic action a given number of times via a producer.-replicateM :: Monad m => Int -> m a -> Producer m a-replicateM 0 _ = return ()-replicateM n m = lift m >>= yield >> replicateM (n-1) m---- | Injects a sink within a pipeline which receives a copy of every input--- argument, similar to the Unix command of the same name.------ >>> runPipe $ each [1..3] >-> tee (P.mapM_ f) >-> P.mapM_ f--- 1--- 1--- 2--- 2--- 3--- 3-tee :: Monad m => Sink a (ConduitM a a m) b -> ConduitM a a m b-tee c = go $$ c- where- go = do- x <- lift await- case x of- Nothing -> return ()- Just x' -> yield x' >> lift (yield x') >> go
− Data/Conduit/Extra/Resumable.hs
@@ -1,92 +0,0 @@-{-# LANGUAGE CPP #-}-module Data.Conduit.Extra.Resumable- ( ResumableConduit(..)- , connectResume- , (=$$+)- , (=$$++)- , (=$$+-)- ) where--import Control.Monad-import Control.Monad.Trans (lift)-import Data.Conduit-import Data.Conduit.Internal (ConduitM(..), Pipe(..))-import Data.Void (absurd)--#if MIN_VERSION_conduit(1,0,17)-import Data.Conduit.Internal (connectResumeConduit)---- | Connect a 'ResumableConduit' to a sink and return the output of the sink--- together with a new 'ResumableConduit'.-connectResume :: Monad m- => ResumableConduit i m o- -> Sink o m r- -> Sink i m (ResumableConduit i m o, r)-connectResume = connectResumeConduit-#else--- | A generalization of 'ResumableSource'. Allows to resume an arbitrary--- conduit, keeping its state and using it later (or finalizing it).-data ResumableConduit i m o =- ResumableConduit (Conduit i m o) (m ())----- | Connect a 'ResumableConduit' to a sink and return the output of the sink--- together with a new 'ResumableConduit'.-connectResume :: Monad m- => ResumableConduit i m o- -> Sink o m r- -> Sink i m (ResumableConduit i m o, r)-connectResume (ResumableConduit (ConduitM left0) leftFinal0) (ConduitM right0) =- ConduitM $ goRight leftFinal0 left0 right0- where- goRight leftFinal left right =- case right of- HaveOutput _ _ o -> absurd o- NeedInput rp rc -> goLeft rp rc leftFinal left- Done r2 -> Done (ResumableConduit (ConduitM left) leftFinal, r2)- PipeM mp -> PipeM (liftM (goRight leftFinal left) mp)- Leftover p i -> goRight leftFinal (HaveOutput left leftFinal i) p-- goLeft rp rc leftFinal left =- case left of- HaveOutput left' leftFinal' o -> goRight leftFinal' left' (rp o)- NeedInput left' lc -> NeedInput (recurse . left') (recurse . lc)- Done () -> goRight (return ()) (Done ()) (rc ())- PipeM mp -> PipeM (liftM recurse mp)- Leftover left' i -> Leftover (recurse left') i -- recurse p- where- recurse = goLeft rp rc leftFinal---- | 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.-(=$$+) :: Monad m => Conduit a m b -> Sink b m r -> Sink a m (ResumableConduit a m b, r)-(=$$+) conduit = connectResume (ResumableConduit conduit (return ()))-{-# INLINE (=$$+) #-}---- | Continue processing after usage of '=$$+'. An alias for 'connectResume'.-(=$$++) :: Monad m => ResumableConduit i m o -> Sink o m r -> Sink i m (ResumableConduit i m o, r)-(=$$++) = connectResume-{-# INLINE (=$$++) #-} ---- | Complete processing of a 'ResumableConduit'. This will run the finalizer--- associated with the @ResumableConduit@. In order to guarantee process--- resource finalization, you /must/ use this operator after using '=$$+' and--- '=$$++'.-(=$$+-) :: Monad m => ResumableConduit i m o -> Sink o m r -> Sink i m r-rsrc =$$+- sink = do- (ResumableConduit _ final, res) <- connectResume rsrc sink- lift final- return res-{-# INLINE (=$$+-) #-}---infixr 0 =$$+-infixr 0 =$$++-infixr 0 =$$+--#endif
− Data/Conduit/Extra/Utils.hs
@@ -1,65 +0,0 @@-{- | Functions currently under development which have not been moved to their- final destination.--}--module Data.Conduit.Extra.Utils where--import Control.Applicative-import Control.Monad.Loops-import Control.Monad.Primitive-import Control.Monad.Trans.Class-import Control.Monad.Trans.State-import Data.Conduit-import Data.Conduit.List as CL-import Data.Foldable-import Data.Sequence as Seq-import Data.Vector as Boxed (Vector, freeze)-import Data.Vector.Mutable as Boxed hiding (length)-import qualified Data.Vector.Unboxed as Unboxed-import qualified Data.Vector.Unboxed.Mutable as Unboxed--takeWhile :: Monad m => (a -> Bool) -> Conduit a m a-takeWhile f = loop where- loop = await >>= maybe (return ()) go- go x | f x = yield x >> loop- | otherwise = leftover x--collect :: PrimMonad m => Int -> Sink a m (Vector a)-collect size = do- v <- lift $ unsafeNew size- forM_ [0..size-1] $ \i -> do- me <- await- case me of- Nothing ->- error $ "Too many elements for a vector of size "- ++ show size- Just e -> lift $ unsafeWrite v i e- lift $ freeze v--collectUnboxed :: (PrimMonad m, Unboxed.Unbox a)- => Int -> Sink a m (Unboxed.Vector a)-collectUnboxed size = do- v <- lift $ Unboxed.unsafeNew size- forM_ [0..size-1] $ \i -> do- me <- await- case me of- Nothing ->- error $ "Too many elements for an unboxed vector of size "- ++ show size- Just e -> lift $ Unboxed.unsafeWrite v i e- lift $ Unboxed.freeze v---- | Remove the last N elements from the stream. This requires holding up to--- N elements in memory.-dropRight :: Monad m => Int -> Conduit a m a-dropRight size = do- xs <- Seq.fromList <$> CL.take size- flip evalStateT xs $ whileM_ ((== size) . Seq.length <$> get) $ do- xs' <- get- case viewl xs' of- EmptyL -> error "impossible"- y :< ys -> do- mz <- lift await- case mz of- Nothing -> put Seq.empty- Just z -> put (ys |> z) >> lift (yield y)
− Data/Conduit/Extra/ZipConduit.hs
@@ -1,81 +0,0 @@-{-# LANGUAGE DeriveFunctor #-}-{-# LANGUAGE CPP #-}-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)--#if !MIN_VERSION_conduit(1,0,17)-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-#endif
− Data/Conduit/Extra/ZipSink.hs
@@ -1,45 +0,0 @@-{-# LANGUAGE CPP #-}-module Data.Conduit.Extra.ZipSink- ( ZipSink (..)- , broadcast- ) where--#if MIN_VERSION_conduit(1, 0, 13) || FPHC-import Data.Conduit (ZipSink (..), sequenceSinks, Sink)-import Data.Traversable (Traversable)--broadcast :: (Traversable f, Monad m) => f (Sink i m r) -> Sink i m (f r)-broadcast = sequenceSinks-#else-import Control.Applicative-import Control.Monad-import Data.Conduit as C-import Data.Conduit.Util-import Data.Traversable (Traversable(..), sequenceA)---- | 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------ @--- broadcast :: (Monad m)--- => [Sink i m r] -> Sink i m [r]--- broadcast = 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.-newtype ZipSink i m r = ZipSink { getZipSink :: Sink i m r }--instance Monad m => Functor (ZipSink i m) where- fmap f (ZipSink x) = ZipSink (liftM f x)-instance Monad m => Applicative (ZipSink i m) where- pure = ZipSink . return- (ZipSink f) <*> (ZipSink x) =- ZipSink $ liftM (uncurry ($)) $ zipSinks f x--broadcast :: (Traversable f, Monad m) => f (Sink i m r) -> Sink i m (f r)-broadcast = getZipSink . sequenceA . fmap ZipSink-#endif
conduit-extra.cabal view
@@ -1,8 +1,7 @@ Name: conduit-extra-Version: 0.1.7-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.+Version: 1.0.0+Synopsis: Temporary placeholder package.+Description: This package will soon contain much more functionality. This is a placeholder until the next release is ready. License: MIT License-file: LICENSE Author: Michael Snoyman@@ -13,43 +12,7 @@ Homepage: http://github.com/snoyberg/conduit Library- Exposed-modules: Data.Conduit.Extra- , Data.Conduit.Extra.Foldl- , 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- , mtl- , monad-loops- , containers- , primitive- , transformers- , vector- , void- , foldl- ghc-options: -Wall--test-suite test- hs-source-dirs: test- main-is: main.hs- type: exitcode-stdio-1.0- cpp-options: -DTEST- build-depends: conduit- , conduit-extra- , base- , hspec >= 1.3- , QuickCheck- , bytestring- , transformers- , mtl- , text- , resourcet- , void- , foldl- ghc-options: -Wall source-repository head type: git
− test/main.hs
@@ -1,39 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE CPP #-}-import Test.Hspec--import Control.Applicative---import Control.Monad-import Data.Maybe (fromJust)--import Data.Conduit as C---import qualified Data.Conduit.Util as C---import qualified Data.Conduit.Internal as CI-import qualified Data.Conduit.List as CL-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-import qualified Data.Conduit.Extra.FoldlSpec as FS---main :: IO ()-main = hspec $ do- describe "zipSink" $ do- it "zip equal-sized" $ do- x <- runResourceT $- CL.sourceList [1..100] $$- CE.broadcast [ CL.fold (+) 0,- (`mod` 101) <$> CL.fold (*) 1 ]- x `shouldBe` [5050, 100 :: Integer]-- it "zip distinct sizes" $ do- let sink = CE.getZipSink $- (*) <$> CE.ZipSink (CL.fold (+) 0)- <*> CE.ZipSink (Data.Maybe.fromJust <$> await)- x <- runResourceT $ CL.sourceList [100,99..1] $$ sink- x `shouldBe` (505000 :: Integer)-- ES.spec- ZipConduit.spec- FS.spec