module Data.Conduit.Util.Sink
( sinkState
, SinkStateResult (..)
, sinkIO
, SinkIOResult (..)
, transSink
, sinkClose
) where
import Control.Monad.Trans.Resource
import Data.Conduit.Types.Sink
import Control.Monad (liftM)
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 =
Processing (push state0) (close0 state0)
where
push state input = SinkM $ do
res <- state `seq` push0 state input
case res of
StateProcessing state' -> return $ Processing (push state') (close0 state')
StateDone mleftover output -> return $ Done mleftover output
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 = Processing
(\input -> SinkM $ do
(key, state) <- allocate alloc cleanup
push key state input)
(do
(key, state) <- allocate alloc cleanup
close key state)
where
push key state input = do
res <- push0 state input
case res of
IODone a b -> do
release key
return $ Done a b
IOProcessing -> return $ Processing
(SinkM . push key state)
(close key state)
close key state = do
res <- close0 state
release key
return res
transSink :: Monad m
=> (forall a. m a -> n a)
-> Sink input m output
-> Sink input n output
transSink _ (Done a b) = Done a b
transSink f (Processing push close) = Processing (transSink f . push) (f close)
transSink f (SinkM msink) = SinkM (f (liftM (transSink f) msink))
sinkClose :: Monad m => Sink input m output -> m ()
sinkClose (SinkM msink) = msink >>= sinkClose
sinkClose Done{} = return ()
sinkClose (Processing _ close) = close >> return ()