haskell/conduit-resumablesink
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Updated types for conduit-1.0.5, plus some tidying up as suggested by hlint.

Browse Source
This commit is contained in:
Paul Johnson 2013-06-16 16:07:56 +01:00
parent af7fa567c8
commit 5ebd1450c7
3 changed files with 34 additions and 28 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
conduit-resumablesink.cabal
View File

@ -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

28
hssrc/Data/Conduit/ResumableSink.hs
View File

@ -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

25
test/main.hs
View File

@ -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)