module Data.Conduit.Util.Sink
( sinkState
, SinkStateResult (..)
, sinkIO
, SinkIOResult (..)
) where
import Control.Monad.Trans.Resource
import Control.Monad.Trans.Class (lift)
import Data.Conduit.Internal
data SinkStateResult state input output =
StateDone (Maybe input) output
| StateProcessing state
sinkState
:: Monad m
=> state
-> (state -> input -> m (SinkStateResult state input output))
-> (state -> m output)
-> Sink input m output
sinkState state0 push0 close0 =
NeedInput (push state0) (\() -> close state0)
where
push state input = PipeM
(do
res <- state `seq` push0 state input
case res of
StateProcessing state' -> return $ NeedInput (push state') (\() -> close state')
StateDone mleftover output -> return $ maybe id (flip Leftover) mleftover $ Done output)
close = lift . close0
data SinkIOResult input output = IODone (Maybe input) output | IOProcessing
sinkIO :: MonadResource m
=> IO state
-> (state -> IO ())
-> (state -> input -> m (SinkIOResult input output))
-> (state -> m output)
-> Sink input m output
sinkIO alloc cleanup push0 close0 = NeedInput
(\input -> PipeM $ do
(key, state) <- allocate alloc cleanup
push key state input)
(\() -> do
(key, state) <- lift $ allocate alloc cleanup
lift $ close key state)
where
push key state input = do
res <- push0 state input
case res of
IODone a b -> do
release key
return $ maybe id (flip Leftover) a $ Done b
IOProcessing -> return $ NeedInput
(PipeM . push key state)
(\() -> lift $ close key state)
close key state = do
res <- close0 state
release key
return res