{- | @Monad@ transformers. There are also @MonadPlus@ and @MonadFix@ transformes, see the corresponding modules. -} 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 -- | @MonadM m@ is actually a free monad generated by @m@. @MonadM@ is a monad itself (on the @(* -> *)@ category), as usually happens with free structures. newtype MonadM m x = MonadM {bindM :: forall n. Monad n => (m :-> n) -> n x} -- | A monad is nothing but an algebra over the @MonadM@ monad. @instM@ provides it's structure map. instM :: Monad m => Inst MonadM m instM mmx = bindM mmx id -- | Sometimes we need an @instance Monad T@, while everything we've got is @Inst MonadP T@. In this case, @return'@ serves as a @return@ substitution. return' :: Inst MonadM m -> x -> m x return' i x = i $ MonadM {bindM = \_ -> return x} -- | Sometimes we need an @instance Monad T@, while everything we've got is @Inst MonadP T@. In this case, @bind'@ serves as a @>>=@ substitution. bind' :: Inst MonadM m -> m x -> (x -> m y) -> m y bind' i mx f = i $ MonadM {bindM = \mor -> mor mx >>= mor . f} -- | A composable monad transformer. class MonadTrans t => TransM t where -- | You shoudn't (and probably can't) use *anything* except for @'instM'@, defined in this very module, as @transMInst@. -- -- If you define @instance TransM T where transMInst = instM@, then you would also need to define @instance Monad m => Monad (T m)@ somewhere in your code. 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