module Control.Monad.Trans.MaybeCont
( MaybeContT
( MaybeContT
, runMaybeContT
)
, liftMaybeT
, nothingC
, mapMaybeContT
, withMaybeContTJust
, withMaybeContTNothing
) where
import Control.Applicative
import Control.Monad.Cont
import Control.Monad.Trans
import Control.Monad.Trans.Maybe
newtype MaybeContT a m r
= MaybeContT
{
runMaybeContT :: m a -> (r -> m a) -> m a
}
liftMaybeT :: Monad m => MaybeT m r -> MaybeContT a m r
liftMaybeT may = MaybeContT $ \ma k -> maybe ma k =<< runMaybeT may
instance Functor (MaybeContT a m) where
fmap f mc = MaybeContT $ \ma k -> runMaybeContT mc ma (k . f)
instance Applicative (MaybeContT a m) where
pure r = MaybeContT $ \_ k -> k r
mcf <*> mc = MaybeContT $ \ma k ->
runMaybeContT mcf ma (\f -> runMaybeContT mc ma (k . f))
instance Monad (MaybeContT a m) where
return = pure
mc >>= mcf = MaybeContT $ \ma k ->
runMaybeContT mc ma (\r -> runMaybeContT (mcf r) ma k)
instance MonadTrans (MaybeContT a) where
lift mr = MaybeContT $ \_ k -> mr >>= k
instance MonadCont (MaybeContT a m) where
callCC f = MaybeContT $ \ma k ->
runMaybeContT (f (\r -> (MaybeContT $ \_ _ -> k r))) ma k
nothingC :: MaybeContT a m r
nothingC = MaybeContT $ \ma _ -> ma
mapMaybeContT :: (m a -> m a) -> MaybeContT a m r -> MaybeContT a m r
mapMaybeContT f mc = MaybeContT $ \ma k -> f (runMaybeContT mc ma k)
withMaybeContTJust :: ((r' -> m a) -> r -> m a)
-> MaybeContT a m r
-> MaybeContT a m r'
withMaybeContTJust f mc = MaybeContT $ \ma k -> runMaybeContT mc ma (f k)
withMaybeContTNothing :: (m a -> m a) -> MaybeContT a m r -> MaybeContT a m r
withMaybeContTNothing f mc = MaybeContT $ \ma k -> runMaybeContT mc (f ma) k