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

Merge pull request #2 from pngwjpgh/fix/conduit-1.2

Browse Source 
Port to conduit 1.2
This commit is contained in:
Andrew Miller 2017-11-01 19:07:08 +11:00 committed by GitHub
commit 786c58e967
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
4 changed files with 34 additions and 45 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
.gitignore vendored
View File

@ -1,2 +1,5 @@
*~
dist
*.sw[a-z]
.cabal-sandbox/
cabal.sandbox.config

7
conduit-resumablesink.cabal
View File

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

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

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

7
test/main.hs
View File

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