module Data.Conduit.Util.Sink
( sinkState
, sinkIO
, transSink
) where
import Control.Monad.Trans.Resource
import Control.Monad.Trans.Class (lift)
import Data.Conduit.Types.Sink
import Control.Monad (liftM)
sinkState
:: Resource m
=> state
-> (state -> input -> ResourceT m (state, SinkResult input output))
-> (state -> ResourceT m output)
-> Sink input m output
sinkState state0 push close = Sink $ do
istate <- newRef state0
#if DEBUG
iclosed <- newRef False
#endif
return SinkData
{ sinkPush = \input -> do
#if DEBUG
False <- readRef iclosed
#endif
state <- readRef istate
(state', res) <- state `seq` push state input
writeRef istate state'
#if DEBUG
case res of
Done{} -> writeRef iclosed True
Processing -> return ()
#endif
return res
, sinkClose = do
#if DEBUG
False <- readRef iclosed
writeRef iclosed True
#endif
readRef istate >>= close
}
sinkIO :: ResourceIO m
=> IO state
-> (state -> IO ())
-> (state -> input -> m (SinkResult input output))
-> (state -> m output)
-> Sink input m output
sinkIO alloc cleanup push close = Sink $ do
(key, state) <- withIO alloc cleanup
#if DEBUG
iclosed <- newRef False
#endif
return SinkData
{ sinkPush = \input -> do
#if DEBUG
False <- readRef iclosed
#endif
res <- lift $ push state input
case res of
Done{} -> do
release key
#if DEBUG
writeRef iclosed True
#endif
Processing -> return ()
return res
, sinkClose = do
#if DEBUG
False <- readRef iclosed
writeRef iclosed True
#endif
res <- lift $ close state
release key
return res
}
transSink :: (Base m ~ Base n, Monad m)
=> (forall a. m a -> n a)
-> Sink input m output
-> Sink input n output
transSink f (Sink mc) =
Sink (transResourceT f (liftM go mc))
where
go c = c
{ sinkPush = transResourceT f . sinkPush c
, sinkClose = transResourceT f (sinkClose c)
}