update for newer versions of base and conduit

This commit is contained in:
Sarah Vaupel 2025-09-17 17:29:44 +02:00
parent 786c58e967
commit 1ccab7417a
2 changed files with 14 additions and 16 deletions

View File

@ -1,5 +1,5 @@
Name: conduit-resumablesink Name: conduit-resumablesink
Version: 0.2 Version: 0.3
Synopsis: Allows conduit to resume sinks to feed multiple sources into it. Synopsis: Allows conduit to resume sinks to feed multiple sources into it.
Description: Description:
@conduit-resumablesink@ is a solution to the problem where you have a @conduit@ @conduit-resumablesink@ is a solution to the problem where you have a @conduit@
@ -16,13 +16,12 @@ Cabal-version: >=1.8
Homepage: http://github.com/A1kmm/conduit-resumablesink Homepage: http://github.com/A1kmm/conduit-resumablesink
Library Library
Hs-Source-Dirs: hssrc Hs-Source-Dirs: hssrc
Exposed-modules: Data.Conduit.ResumableSink Exposed-modules: Data.Conduit.ResumableSink
Build-depends: Build-depends:
base >= 4 && < 5, base >= 4 && < 5,
conduit >= 1.2 && <1.3, conduit >= 1.2 && <2
void >= 0.6 && < 0.8 ghc-options: -Wall
ghc-options: -Wall
test-suite test test-suite test
hs-source-dirs: test hs-source-dirs: test
@ -33,7 +32,6 @@ test-suite test
base, base,
hspec >= 1.3, hspec >= 1.3,
bytestring, bytestring,
void,
resourcet, resourcet,
transformers transformers
ghc-options: -Wall ghc-options: -Wall

View File

@ -13,22 +13,22 @@ 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 -- | Connects a new source to a resumable sink. The result will be Right an updated
-- ResumableSink or Left result if the Sink completes. -- ResumableSink or Left result if the Sink completes.
connectResumeSink :: Monad m => Source m i -> ResumableSink i m r -> m (Either r (ResumableSink i m r)) 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) connectResumeSink (ConduitT left') (ResumableSink (ConduitT right')) = go (return ()) (left' Done) (right' Done)
where where
go :: Monad m go :: Monad m
=> m () => m ()
-> Pipe () () i () m () -> Pipe () () i () m ()
-> Pipe i i Void () m r -> Pipe i i Void () m r
-> m (Either r (ResumableSink i m r)) -> m (Either r (ResumableSink i m r))
go final (NeedInput cont0 _ ) right = go final (cont0 ()) right go final (NeedInput cont0 _) right = go final (cont0 ()) right
go final (Done ()) right = return . Right . ResumableSink $ ConduitM (\finalize -> right >>= finalize) go final (Done ()) right = return . Right . ResumableSink $ ConduitT (\finalize -> right >>= finalize)
go final (PipeM pm) right = pm >>= \left -> go final left right go final (PipeM pm) right = pm >>= \left -> go final left right
go final (Leftover left ()) right = 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 final (HaveOutput left o) (NeedInput cont0 _) = go final left (cont0 o)
go _ _ (HaveOutput _ _ o) = absurd o go _ _ (HaveOutput _ o) = absurd o
go final _ (Done r) = Left r <$ final go final _ (Done r) = Left r <$ final
go final left (PipeM pm) = pm >>= go final left go final left (PipeM pm) = pm >>= go final left
go final left (Leftover right i) = go final (HaveOutput left (return ()) i) right go final left (Leftover right i) = go final (HaveOutput left i) right
-- | Converts a sink into a ResumableSink that can be used with ++$$ -- | Converts a sink into a ResumableSink that can be used with ++$$
newResumableSink :: Monad m => Sink i m r -> ResumableSink i m r newResumableSink :: Monad m => Sink i m r -> ResumableSink i m r