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