module Data.Conduit.Util.Source
( sourceState
, sourceStateIO
, SourceStateResult (..)
, sourceIO
, SourceIOResult (..)
, transSource
, sourceClose
) where
import Control.Monad.Trans.Resource
import Data.Conduit.Types.Source
import Control.Monad (liftM)
data SourceStateResult state output = StateOpen state output | StateClosed
sourceState
:: Monad m
=> state
-> (state -> m (SourceStateResult state output))
-> Source m output
sourceState state0 pull0 =
src state0
where
src state = SourceM (pull state) (return ())
pull state = do
res <- pull0 state
return $ case res of
StateOpen state' val -> Open (src state') (return ()) val
StateClosed -> Closed
data SourceIOResult output = IOOpen output | IOClosed
sourceIO :: MonadResource m
=> IO state
-> (state -> IO ())
-> (state -> m (SourceIOResult output))
-> Source m output
sourceIO alloc cleanup pull0 =
SourceM (do
(key, state) <- allocate alloc cleanup
pull key state) (return ())
where
src key state = SourceM (pull key state) (release key)
pull key state = do
res <- pull0 state
case res of
IOClosed -> do
release key
return Closed
IOOpen val -> return $ Open (src key state) (release key) val
sourceStateIO :: MonadResource m
=> IO state
-> (state -> IO ())
-> (state -> m (SourceStateResult state output))
-> Source m output
sourceStateIO alloc cleanup pull0 =
SourceM (do
(key, state) <- allocate alloc cleanup
pull key state) (return ())
where
src key state = SourceM (pull key state) (release key)
pull key state = do
res <- pull0 state
case res of
StateClosed -> do
release key
return Closed
StateOpen state' val -> return $ Open (src key state') (release key) val
transSource :: Monad m
=> (forall a. m a -> n a)
-> Source m output
-> Source n output
transSource f (Open next close output) = Open (transSource f next) (f close) output
transSource _ Closed = Closed
transSource f (SourceM msrc close) = SourceM (f (liftM (transSource f) msrc)) (f close)
sourceClose :: Monad m => Source m a -> m ()
sourceClose Closed = return ()
sourceClose (Open _ close _) = close
sourceClose (SourceM _ close) = close