packages feed

conduit-extra (empty) → 0.1.0

raw patch · 7 files changed

+225/−0 lines, 7 filesdep +QuickCheckdep +basedep +bytestringsetup-changed

Dependencies added: QuickCheck, base, bytestring, conduit, conduit-extra, hspec, mtl, resourcet, text, transformers, void

Files

+ Data/Conduit/Extra.hs view
@@ -0,0 +1,7 @@+module Data.Conduit.Extra+    ( module Data.Conduit.Extra.ZipSink+    , module Data.Conduit.Extra.Resumable+    ) where++import Data.Conduit.Extra.ZipSink+import Data.Conduit.Extra.Resumable
+ Data/Conduit/Extra/Resumable.hs view
@@ -0,0 +1,79 @@+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)++-- | 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 =$$+-
+ Data/Conduit/Extra/ZipSink.hs view
@@ -0,0 +1,33 @@+module Data.Conduit.Extra.ZipSink where++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
+ LICENSE view
@@ -0,0 +1,20 @@+Copyright (c) 2012 Michael Snoyman, http://www.yesodweb.com/++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be+included in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND+NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE+LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION+OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION+WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+ Setup.lhs view
@@ -0,0 +1,7 @@+#!/usr/bin/env runhaskell++> module Main where+> import Distribution.Simple++> main :: IO ()+> main = defaultMain
+ conduit-extra.cabal view
@@ -0,0 +1,45 @@+Name:                conduit-extra+Version:             0.1.0+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.+License:             MIT+License-file:        LICENSE+Author:              Michael Snoyman+Maintainer:          michael@snoyman.com+Category:            Data, Conduit+Build-type:          Simple+Cabal-version:       >=1.8+Homepage:            http://github.com/snoyberg/conduit++Library+  Exposed-modules:     Data.Conduit.Extra+                     , Data.Conduit.Extra.Resumable+                     , Data.Conduit.Extra.ZipSink+  Build-depends:       base                     >= 4            && < 5+                     , conduit                  >= 1.0+                     , mtl+                     , void+  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+    ghc-options:     -Wall++source-repository head+  type:     git+  location: git://github.com/snoyberg/conduit.git
+ test/main.hs view
@@ -0,0 +1,34 @@+{-# 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)+++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)++    return ()