{-# LANGUAGE CPP, UndecidableInstances #-}
module Foreign.Hoppy.Generator.Common.Consume (
MonadConsume (..),
ConsumeT,
runConsumeT,
evalConsumeT,
execConsumeT,
Consume,
runConsume,
evalConsume,
execConsume,
) where
#if !MIN_VERSION_base(4,8,0)
import Control.Applicative ((<*>), Applicative, pure)
#endif
import Control.Monad (ap, liftM)
import Control.Monad.Except (ExceptT)
import Control.Monad.Identity (Identity, runIdentity)
import Control.Monad.State (StateT, get, put, runStateT)
import Control.Monad.Trans (MonadTrans, lift)
import Data.Tuple (swap)
class Monad m => MonadConsume s m | m -> s where
next :: m (Maybe s)
newtype ConsumeT s m a = ConsumeT { getConsumeT :: StateT [s] m a }
instance Monad m => Functor (ConsumeT s m) where
fmap = liftM
instance Monad m => Applicative (ConsumeT s m) where
pure = return
(<*>) = ap
instance Monad m => Monad (ConsumeT s m) where
return = ConsumeT . return
m >>= f = ConsumeT $ getConsumeT . f =<< getConsumeT m
instance MonadTrans (ConsumeT s) where
lift = ConsumeT . lift
instance Monad m => MonadConsume s (ConsumeT s m) where
next = do
stream <- get'
case stream of
[] -> return Nothing
x:xs -> put' xs >> return (Just x)
instance MonadConsume s m => MonadConsume s (ExceptT e m) where
next = lift next
instance MonadConsume s m => MonadConsume s (StateT d m) where
next = lift next
runConsumeT :: Monad m => [s] -> ConsumeT s m a -> m ([s], a)
runConsumeT stream (ConsumeT m) = swap <$> runStateT m stream
evalConsumeT :: Monad m => [s] -> ConsumeT s m a -> m a
evalConsumeT stream = fmap snd . runConsumeT stream
execConsumeT :: Monad m => [s] -> ConsumeT s m a -> m [s]
execConsumeT stream = fmap fst . runConsumeT stream
type Consume s = ConsumeT s Identity
runConsume :: [s] -> Consume s a -> ([s], a)
runConsume stream m = runIdentity $ runConsumeT stream m
evalConsume :: [s] -> Consume s a -> a
evalConsume stream = snd . runConsume stream
execConsume :: [s] -> Consume s a -> [s]
execConsume stream = fst . runConsume stream
get' :: Monad m => ConsumeT s m [s]
get' = ConsumeT get
put' :: Monad m => [s] -> ConsumeT s m ()
put' = ConsumeT . put