module Control.Monad.Consumer (
ConsumerT, evalConsumerT, next, consumeRestM
) where
import Control.Applicative (Applicative(..))
import Control.Monad (MonadPlus(..), ap)
import Control.Monad.ListT (ListT(..), ListItem(..))
import Control.Monad.Maybe (MaybeT(..))
import Control.Monad.State (StateT, evalStateT, get, put)
import Control.Monad.Trans (MonadTrans(..), MonadIO(..))
import Data.List.Class (List(..))
import Data.Maybe (fromMaybe)
newtype ConsumerT v m a = ConsumerT { runConsumerT :: StateT (Maybe (ListT m v)) m a }
instance Monad m => Functor (ConsumerT v m) where
fmap f = ConsumerT . fmap f . runConsumerT
instance Monad m => Monad (ConsumerT v m) where
return = ConsumerT . return
fail = ConsumerT . fail
a >>= b = ConsumerT $ runConsumerT a >>= runConsumerT . b
instance Monad m => Applicative (ConsumerT v m) where
pure = return
(<*>) = ap
instance MonadTrans (ConsumerT v) where
lift = ConsumerT . lift
instance MonadIO m => MonadIO (ConsumerT v m) where
liftIO = lift . liftIO
evalConsumerT :: List l => ConsumerT v (ItemM l) a -> l v -> ItemM l a
evalConsumerT (ConsumerT i) = evalStateT i . Just . toListT
putNoProducer :: List l => StateT (Maybe (l v)) (ItemM l) ()
putNoProducer = put Nothing
next :: Monad m => ConsumerT v m (Maybe v)
next =
ConsumerT . runMaybeT $ do
list <- MaybeT get
item <- lift . lift $ runListT list
case item of
Nil -> do
lift putNoProducer
mzero
Cons x xs -> do
putProducer xs
return x
where
putProducer = put . Just
consumeRestM :: Monad m => ConsumerT a m b -> ConsumerT a m (m b)
consumeRestM consume =
ConsumerT $ do
mRest <- get
let rest = fromMaybe mzero mRest
putNoProducer
return $ evalConsumerT consume rest