contt.hs

module ContT where

import Control.Monad.Trans.Class

newtype ContT r m a = ContT { runContT :: (a -> m r) -> m r }

instance Functor (ContT r m) where
    fmap f (ContT cv) = ContT $ \c ->
        cv (c . f)

instance Applicative (ContT r m) where
    pure a = ContT $ \c -> c a

    (ContT cf) <*> (ContT cv) = ContT $ \c ->
        cf $ \f ->
        cv (c . f)

instance Monad (ContT r m) where
    return = pure

    (ContT ca) >>= acb = ContT $ \c ->
        ca $ \a' ->
        runContT (acb a') c

instance MonadTrans (ContT r) where
    lift m = ContT (\k -> m >>= k)