module Control.Monad.Trans.Monad (MonadM, TransM(..), instM, return', bind') where
import Control.Monad.Cont
import Control.Monad.List
import Control.Monad.Reader
import Control.Monad.State
import Control.Monad.Trans.Category
import Control.Monad.Writer
newtype MonadM m x = MonadM {bindM :: forall n. Monad n => (m :-> n) -> n x}
instM :: Monad m => Inst MonadM m
instM mmx = bindM mmx id
return' :: Inst MonadM m -> x -> m x
return' i x = i $ MonadM {bindM = \_ -> return x}
bind' :: Inst MonadM m -> m x -> (x -> m y) -> m y
bind' i mx f = i $ MonadM {bindM = \mor -> mor mx >>= mor . f}
class MonadTrans t => TransM t where
transMInst :: Monad m => Inst MonadM (t m)
instance (Monad m, TransM t) => Monad (t :$ m) where
return x = ApplyF {runApplyF = return' transMInst x}
tmx >>= f = ApplyF {runApplyF = runApplyF tmx >>>= (runApplyF . f)} where (>>>=) = bind' transMInst
deriving instance MonadTrans t => MonadTrans ((:$) t)
deriving instance (Monad m, TransM t1, TransM t2) => Monad ((t2 :. t1) m)
instance (TransM t1, MonadTrans t2) => MonadTrans (t2 :. t1) where lift mx = ComposeF {runComposeF = lift $ lift mx}
instance (TransM t1, TransM t2) => TransM (t2 :. t1) where transMInst = instM
instance TransM (ContT c) where transMInst = instM
instance TransM ListT where transMInst = instM
instance TransM (ReaderT r) where transMInst = instM
instance TransM (StateT s) where transMInst = instM
instance Monoid w => TransM (WriterT w) where transMInst = instM