module Control.Monad.Trans.MonadPlus (MonadP, TransP(..), instP, mzero', mplus') where
import Control.Monad.List
import Control.Monad.Reader
import Control.Monad.State
import Control.Monad.Trans.Category
import Control.Monad.Trans.Monad
import Control.Monad.Writer
newtype MonadP m x = MonadP {bindP :: forall n. MonadPlus n => (m :-> n) -> n x}
instP :: MonadPlus m => Inst MonadP m
instP mmx = bindP mmx id
mzero' :: Inst MonadP m -> m x
mzero' i = i $ MonadP {bindP = \_ -> mzero}
mplus' :: Inst MonadP m -> m x -> m x -> m x
mplus' i mx1 mx2 = i $ MonadP {bindP = \mor -> mor mx1 `mplus` mor mx2}
class TransM t => TransP t where
transPInst :: MonadPlus m => Inst MonadP (t m)
instance (MonadPlus m, TransP t) => MonadPlus (t :$ m) where
mzero = ApplyF {runApplyF = mzero' transPInst}
tm1 `mplus` tm2 = ApplyF {runApplyF = runApplyF tm1 `mplus1` runApplyF tm2} where mplus1 = mplus' transPInst
deriving instance (MonadPlus m, TransP t1, TransP t2) => MonadPlus ((t2 :. t1) m)
instance (TransP t1, TransP t2) => TransP (t2 :. t1) where transPInst = instP
instance TransP ListT where transPInst = instP
instance TransP (ReaderT r) where transPInst = instP
instance TransP (StateT s) where transPInst = instP
instance Monoid w => TransP (WriterT w) where transPInst = instP