module Data.Conduit.Extra.Resumable
( ResumableConduit(..)
, connectResume
, (=$$+)
, (=$$++)
, (=$$+-)
) where
import Control.Monad
import Control.Monad.Trans (lift)
import Data.Conduit
import Data.Conduit.Internal (ConduitM(..), Pipe(..))
import Data.Void (absurd)
data ResumableConduit i m o =
ResumableConduit (Conduit i m o) (m ())
connectResume :: Monad m
=> ResumableConduit i m o
-> Sink o m r
-> Sink i m (ResumableConduit i m o, r)
connectResume (ResumableConduit (ConduitM left0) leftFinal0) (ConduitM right0) =
ConduitM $ goRight leftFinal0 left0 right0
where
goRight leftFinal left right =
case right of
HaveOutput _ _ o -> absurd o
NeedInput rp rc -> goLeft rp rc leftFinal left
Done r2 -> Done (ResumableConduit (ConduitM left) leftFinal, r2)
PipeM mp -> PipeM (liftM (goRight leftFinal left) mp)
Leftover p i -> goRight leftFinal (HaveOutput left leftFinal i) p
goLeft rp rc leftFinal left =
case left of
HaveOutput left' leftFinal' o -> goRight leftFinal' left' (rp o)
NeedInput left' lc -> NeedInput (recurse . left') (recurse . lc)
Done () -> goRight (return ()) (Done ()) (rc ())
PipeM mp -> PipeM (liftM recurse mp)
Leftover left' i -> Leftover (recurse left') i
where
recurse = goLeft rp rc leftFinal
(=$$+) :: Monad m => Conduit a m b -> Sink b m r -> Sink a m (ResumableConduit a m b, r)
(=$$+) conduit = connectResume (ResumableConduit conduit (return ()))
(=$$++) :: Monad m => ResumableConduit i m o -> Sink o m r -> Sink i m (ResumableConduit i m o, r)
(=$$++) = connectResume
(=$$+-) :: Monad m => ResumableConduit i m o -> Sink o m r -> Sink i m r
rsrc =$$+- sink = do
(ResumableConduit _ final, res) <- connectResume rsrc sink
lift final
return res
infixr 0 =$$+
infixr 0 =$$++
infixr 0 =$$+-