diff --git a/conduit-resumablesink.cabal b/conduit-resumablesink.cabal index 7fa703f..70f81b2 100644 --- a/conduit-resumablesink.cabal +++ b/conduit-resumablesink.cabal @@ -1,5 +1,5 @@ Name: conduit-resumablesink -Version: 0.1 +Version: 0.1.1 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@ @@ -18,9 +18,10 @@ Homepage: http://github.com/A1kmm/conduit-resumablesink Library Hs-Source-Dirs: hssrc Exposed-modules: Data.Conduit.ResumableSink - Build-depends: base >= 4 && < 5, - conduit >= 0.5 && <0.6, - void >= 0.5.5 && < 0.6 + Build-depends: + base >= 4 && < 5, + conduit >= 1.0.5 && <1.1, + void >= 0.6 && < 0.7 ghc-options: -Wall test-suite test diff --git a/hssrc/Data/Conduit/ResumableSink.hs b/hssrc/Data/Conduit/ResumableSink.hs index 108f078..b97fb53 100644 --- a/hssrc/Data/Conduit/ResumableSink.hs +++ b/hssrc/Data/Conduit/ResumableSink.hs @@ -20,32 +20,32 @@ connectResumeSink left0 (ResumableSink right0) = where go :: Monad m => m () -> Source m i -> Sink i m r -> m (Either r (ResumableSink m i r)) go leftFinal left right = - case right of + case unConduitM right of Done r -> leftFinal >> (return . Left $ r) - PipeM mp -> mp >>= go leftFinal left + PipeM mp -> mp >>= go leftFinal left . ConduitM HaveOutput _ _ o -> absurd o - Leftover p i -> go leftFinal (HaveOutput left leftFinal i) p + Leftover p i -> go leftFinal (ConduitM $ HaveOutput (unConduitM left) leftFinal i) $ ConduitM p NeedInput rp _ -> - case left of - Leftover p () -> go leftFinal p right - HaveOutput left' leftFinal' o -> go leftFinal' left' (rp o) - NeedInput _ lc -> go leftFinal (lc ()) right + 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 left' right + PipeM mp -> mp >>= \left' -> go leftFinal (ConduitM left') right -- | Converts a sink into a ResumableSink that can be used with ++$$ newResumableSink :: Monad m => Sink i m r -> ResumableSink m i r -newResumableSink s = ResumableSink s +newResumableSink = ResumableSink -- | Closes a ResumableSink and gets the final result. closeResumableSink :: Monad m => ResumableSink m i r -> m r closeResumableSink (ResumableSink sink) = - go sink + go (unConduitM sink) where go right = case right of Leftover p i -> do - res <- connectResumeSink (HaveOutput (return ()) (return ()) i) (ResumableSink p) + res <- connectResumeSink (ConduitM $ HaveOutput (return ()) (return ()) i) (ResumableSink $ ConduitM p) case res of Left r -> return r Right rs -> closeResumableSink rs @@ -57,7 +57,7 @@ closeResumableSink (ResumableSink 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)) -source +$$ sink = source `connectResumeSink` (newResumableSink sink) +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. @@ -66,6 +66,4 @@ source +$$ sink = source `connectResumeSink` (newResumableSink sink) -- | 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 -source -++$$ (ResumableSink sink) = do - r <- source $$ sink - return r +source -++$$ ResumableSink sink = source $$ sink diff --git a/test/main.hs b/test/main.hs index 0b2a0eb..d8c6596 100644 --- a/test/main.hs +++ b/test/main.hs @@ -6,26 +6,33 @@ import Data.IORef import Control.Monad.IO.Class main :: IO () -main = hspec $ do - describe "use resumable sink" $ do +main = hspec $ describe "use resumable sink" $ do it "behaves like normal conduit when -++$$ used immediately" $ do r <- C.runResourceT $ - (C.sourceList ["hello", "world"]) -++$$ (newResumableSink C.consume) + C.sourceList ["hello", "world"] -++$$ newResumableSink C.consume r `shouldBe` ["hello", "world"] it "sink can be resumed" $ do r <- C.runResourceT $ do - Right r1 <- ((C.sourceList ["hello", "world"]) +$$ C.consume) - (C.sourceList ["hello", "world"]) -++$$ r1 + Right r1 <- C.sourceList ["hello", "world"] +$$ C.consume + C.sourceList ["hello", "world"] -++$$ r1 r `shouldBe` ["hello", "world", "hello", "world"] it "does correct cleanup" $ do s <- newIORef (0 :: Int, 0 :: Int, 0 :: Int) + let clean f _ = liftIO $ modifyIORef s f + r <- C.runResourceT $ do Right r1 <- - ((C.addCleanup (const . liftIO $ modifyIORef s (\(a,b,c) -> (a + 1, b, c))) (C.sourceList ["hello", "world"])) +$$ - C.addCleanup (const . liftIO $ modifyIORef s (\(a,b,c) -> (a,b,c+1))) (C.consume)) - ((C.addCleanup (const . liftIO $ modifyIORef s (\(a, b, c) -> (a, b + 1, c))) (C.sourceList ["hello", "world"]))) -++$$ r1 - `shouldBe` ["hello", "world", "hello", "world"] + C.addCleanup (clean incA) (C.sourceList ["hello", "world"]) + +$$ C.addCleanup (clean incC) C.consume + C.addCleanup (clean incB) (C.sourceList ["hello", "world"]) + -++$$ r1 + r `shouldBe` ["hello", "world", "hello", "world"] sfinal <- readIORef s sfinal `shouldBe` (1, 1, 1) + +incA, incB, incC :: (Int, Int, Int) -> (Int, Int, Int) +incA (a,b,c) = (a+1,b,c) +incB (a,b,c) = (a,b+1,c) +incC (a,b,c) = (a,b,c+1)