diff --git a/.gitignore b/.gitignore index 733412c..99e6f56 100644 --- a/.gitignore +++ b/.gitignore @@ -1,2 +1,5 @@ *~ dist +*.sw[a-z] +.cabal-sandbox/ +cabal.sandbox.config diff --git a/conduit-resumablesink.cabal b/conduit-resumablesink.cabal index 70f81b2..092c58c 100644 --- a/conduit-resumablesink.cabal +++ b/conduit-resumablesink.cabal @@ -1,5 +1,5 @@ Name: conduit-resumablesink -Version: 0.1.1 +Version: 0.2 Synopsis: Allows conduit to resume sinks to feed multiple sources into it. Description: @conduit-resumablesink@ is a solution to the problem where you have a @conduit@ @@ -20,8 +20,8 @@ Library Exposed-modules: Data.Conduit.ResumableSink Build-depends: base >= 4 && < 5, - conduit >= 1.0.5 && <1.1, - void >= 0.6 && < 0.7 + conduit >= 1.2 && <1.3, + void >= 0.6 && < 0.8 ghc-options: -Wall test-suite test @@ -34,6 +34,7 @@ test-suite test hspec >= 1.3, bytestring, void, + resourcet, transformers ghc-options: -Wall diff --git a/hssrc/Data/Conduit/ResumableSink.hs b/hssrc/Data/Conduit/ResumableSink.hs index b97fb53..b3226ab 100644 --- a/hssrc/Data/Conduit/ResumableSink.hs +++ b/hssrc/Data/Conduit/ResumableSink.hs @@ -5,65 +5,49 @@ module Data.Conduit.ResumableSink ( where import Data.Conduit.Internal -import Data.Conduit import Data.Void -- | -data ResumableSink m i r = ResumableSink (Sink i m r) +data ResumableSink i m r = ResumableSink (Sink i m r) -- | Connects a new source to a resumable sink. The result will be Right an updated -- ResumableSink or Left result if the Sink completes. -connectResumeSink - :: Monad m => Source m i -> ResumableSink m i r -> m (Either r (ResumableSink m i r)) -connectResumeSink left0 (ResumableSink right0) = - go (return ()) left0 right0 +connectResumeSink :: Monad m => Source m i -> ResumableSink i m r -> m (Either r (ResumableSink i m r)) +connectResumeSink (ConduitM left') (ResumableSink (ConduitM right')) = go (return ()) (left' Done) (right' Done) where - go :: Monad m => m () -> Source m i -> Sink i m r -> m (Either r (ResumableSink m i r)) - go leftFinal left right = - case unConduitM right of - Done r -> leftFinal >> (return . Left $ r) - PipeM mp -> mp >>= go leftFinal left . ConduitM - HaveOutput _ _ o -> absurd o - Leftover p i -> go leftFinal (ConduitM $ HaveOutput (unConduitM left) leftFinal i) $ ConduitM p - NeedInput rp _ -> - case unConduitM left of - Leftover p () -> go leftFinal (ConduitM p) right - HaveOutput left' leftFinal' o -> go leftFinal' (ConduitM left') (ConduitM $ rp o) - NeedInput _ lc -> go leftFinal (ConduitM $ lc ()) right - Done () -> return . Right $ ResumableSink right - PipeM mp -> mp >>= \left' -> go leftFinal (ConduitM left') right + go :: Monad m + => m () + -> Pipe () () i () m () + -> Pipe i i Void () m r + -> m (Either r (ResumableSink i m r)) + go final (NeedInput cont0 _ ) right = go final (cont0 ()) right + go final (Done ()) right = return . Right . ResumableSink $ ConduitM (\finalize -> right >>= finalize) + go final (PipeM pm) right = pm >>= \left -> go final left right + go final (Leftover left ()) right = go final left right + go final0 (HaveOutput left1 final1 o) (NeedInput cont0 _) = go (final0 >> final1) left1 (cont0 o) + go _ _ (HaveOutput _ _ o) = absurd o + go final _ (Done r) = Left r <$ final + go final left (PipeM pm) = pm >>= go final left + go final left (Leftover right i) = go final (HaveOutput left (return ()) i) right -- | Converts a sink into a ResumableSink that can be used with ++$$ -newResumableSink :: Monad m => Sink i m r -> ResumableSink m i r +newResumableSink :: Monad m => Sink i m r -> ResumableSink i m r newResumableSink = ResumableSink -- | Closes a ResumableSink and gets the final result. -closeResumableSink :: Monad m => ResumableSink m i r -> m r -closeResumableSink (ResumableSink sink) = - go (unConduitM sink) - where - go right = - case right of - Leftover p i -> do - res <- connectResumeSink (ConduitM $ HaveOutput (return ()) (return ()) i) (ResumableSink $ ConduitM p) - case res of - Left r -> return r - Right rs -> closeResumableSink rs - HaveOutput _ _ o -> absurd o - NeedInput _ r -> go (r ()) - Done r -> return r - PipeM mp -> mp >>= go +closeResumableSink :: Monad m => ResumableSink i m r -> m r +closeResumableSink (ResumableSink sink) = runConduit $ return () =$= sink -- | Connects a source and a sink. The result will be Right a -- ResumableSink or Left result if the Sink completes. -(+$$) :: Monad m => Source m i -> Sink i m r -> m (Either r (ResumableSink m i r)) +(+$$) :: Monad m => Source m i -> Sink i m r -> m (Either r (ResumableSink i m r)) source +$$ sink = source `connectResumeSink` newResumableSink sink -- | Connects a new source to a resumable sink. The result will be Right an updated -- ResumableSink or Left result if the Sink completes. -(++$$) :: Monad m => Source m i -> ResumableSink m i r -> m (Either r (ResumableSink m i r)) +(++$$) :: Monad m => Source m i -> ResumableSink i m r -> m (Either r (ResumableSink i m r)) (++$$) = connectResumeSink -- | Attaches a source to a resumable sink, finishing the sink and returning a result. -(-++$$) :: Monad m => Source m i -> ResumableSink m i r -> m r +(-++$$) :: Monad m => Source m i -> ResumableSink i m r -> m r source -++$$ ResumableSink sink = source $$ sink diff --git a/test/main.hs b/test/main.hs index d8c6596..80e0210 100644 --- a/test/main.hs +++ b/test/main.hs @@ -4,16 +4,17 @@ import qualified Data.Conduit.List as C import Data.Conduit.ResumableSink import Data.IORef import Control.Monad.IO.Class +import Control.Monad.Trans.Resource as R main :: IO () main = hspec $ describe "use resumable sink" $ do it "behaves like normal conduit when -++$$ used immediately" $ do - r <- C.runResourceT $ + r <- R.runResourceT $ C.sourceList ["hello", "world"] -++$$ newResumableSink C.consume r `shouldBe` ["hello", "world"] it "sink can be resumed" $ do - r <- C.runResourceT $ do + r <- R.runResourceT $ do Right r1 <- C.sourceList ["hello", "world"] +$$ C.consume C.sourceList ["hello", "world"] -++$$ r1 r `shouldBe` ["hello", "world", "hello", "world"] @@ -22,7 +23,7 @@ main = hspec $ describe "use resumable sink" $ do s <- newIORef (0 :: Int, 0 :: Int, 0 :: Int) let clean f _ = liftIO $ modifyIORef s f - r <- C.runResourceT $ do + r <- R.runResourceT $ do Right r1 <- C.addCleanup (clean incA) (C.sourceList ["hello", "world"]) +$$ C.addCleanup (clean incC) C.consume