module DeepControl.Monad.Trans (
MonadIO(..),
MonadTrans(..),
MonadTransDown(..), M,
MonadTransCover(..),
MonadTrans_(..),
MonadTrans2(..),
MonadTrans2Down(..), M_, T_,
MonadTransFold2(..),
MonadTransCover2(..),
(|**|),
trans2, untrans2,
MonadTrans3(..),
MonadTrans3Down(..), M__, T__,
MonadTransFold3(..),
MonadTransCover3(..),
(|***|), (|-**|), (|*-*|), (|**-|),
trans3, untrans3,
MonadTrans4(..),
MonadTrans5(..),
) where
import DeepControl.Applicative
import DeepControl.Monad
import Control.Monad.IO.Class
import Control.Monad.Trans.Class (MonadTrans (..))
import qualified Control.Monad.List as L
import qualified Control.Monad.Trans.Maybe as M
import qualified Control.Monad.Except as E
import Control.Monad.Identity
class (Monad (TransDown t1), MonadTrans t1) => MonadTransDown t1 where
type TransDown t1 :: * -> *
type M t1 = TransDown t1
instance MonadTransDown L.ListT where
type TransDown L.ListT = []
instance MonadTransDown M.MaybeT where
type TransDown M.MaybeT = Maybe
instance MonadTransDown (E.ExceptT e) where
type TransDown (E.ExceptT e) = E.Except e
infixl 3 |*|
class (MonadTransDown t1) => MonadTransCover t1 where
(|*|) :: Monad m1 => (TransDown t1) a -> t1 m1 a
instance MonadTransCover L.ListT where
(|*|) = L.ListT . (*:)
instance MonadTransCover M.MaybeT where
(|*|) = M.MaybeT . (*:)
instance MonadTransCover (E.ExceptT e) where
(|*|) = E.ExceptT . (*:) . E.runExcept
class MonadTrans_ t1 where
trans :: (Monad m2) => m2 ((TransDown t1) a) -> t1 m2 a
untrans :: (Monad m2) => t1 m2 a -> m2 ((TransDown t1) a)
instance MonadTrans_ L.ListT where
trans = L.ListT
untrans = L.runListT
instance MonadTrans_ M.MaybeT where
trans = M.MaybeT
untrans = M.runMaybeT
instance MonadTrans_ (E.ExceptT e) where
untrans x = (E.ExceptT . Identity) |$> E.runExceptT x
trans x = E.ExceptT ((runIdentity . E.runExceptT) |$> x)
class MonadTrans2 t where
lift2 :: (Monad m1, Monad2 m2) => m1 (m2 a) -> t m1 m2 a
class (MonadTrans (Trans2Down t2), MonadTrans2 t2) => MonadTrans2Down t2 where
type Trans2Down t2 :: (* -> *) -> * -> *
type M_ t2 = TransDown (Trans2Down t2)
type T_ t2 = Trans2Down t2
class (MonadTrans (T_ t), MonadTrans2 t) => MonadTransFold2 t where
transfold2 :: (Monad m1, Monad (t2 m1),
MonadTrans_ t2) =>
t m1 (TransDown t2) a -> (T_ t) (t2 m1) a
untransfold2 :: (Monad m1, Monad (t2 m1),
MonadTrans_ t2) =>
(T_ t) (t2 m1) a -> t m1 (TransDown t2) a
infixl 3 |-*|, |*-|, |**|
class (MonadTransCover (Trans2Down t2)) => MonadTransCover2 t2 where
(|-*|) :: (Monad m1, Monad2 m2) => (Trans2Down t2) m1 a -> t2 m1 m2 a
(|*-|) :: (Monad m1, Monad2 m2) => (Trans2Down t2) m2 a -> t2 m1 m2 a
(|**|) :: (Monad m1, Monad2 m2, MonadTransCover2 t2) =>
(M_ t2) a -> t2 m1 m2 a
(|**|) = (|*-|) . (|*|)
trans2 :: (Monad m1, Monad (t2 m1),
MonadTrans_ t2, MonadTrans_ t3) =>
m1 ((TransDown t2) ((TransDown t3) a)) -> t3 (t2 m1) a
trans2 = trans . trans
untrans2 :: (Monad m1, Monad (t2 m1),
MonadTrans_ t2, MonadTrans_ t3) =>
t3 (t2 m1) a -> m1 ((TransDown t2) ((TransDown t3) a))
untrans2 = untrans . untrans
class MonadTrans3 t where
lift3 :: (Monad m1, Monad2 m2, Monad3 m3) => m1 (m2 (m3 a)) -> t m1 m2 m3 a
class (MonadTrans2 (Trans3Down t3), MonadTrans3 t3) => MonadTrans3Down t3 where
type Trans3Down t3 :: (* -> *) -> (* -> *) -> * -> *
type M__ t3 = M_ (Trans3Down t3)
type T__ t3 = T_ (Trans3Down t3)
class (MonadTrans (T__ t), MonadTrans3 t) => MonadTransFold3 t where
transfold3 :: (Monad m1, Monad (t2 m1), Monad (t3 (t2 m1)),
MonadTrans t3, MonadTrans t2,
MonadTrans_ t2, MonadTrans_ t3) =>
t m1 (TransDown t2) (TransDown t3) a -> (T__ t) (t3 (t2 m1)) a
untransfold3 :: (Monad m1, Monad (t2 m1), Monad (t3 (t2 m1)),
MonadTrans t3, MonadTrans t2,
MonadTrans_ t2, MonadTrans_ t3) =>
(T__ t) (t3 (t2 m1)) a -> t m1 (TransDown t2) (TransDown t3) a
infixl 3 |--*|, |-*-|, |*--|, |***|, |-**|, |*-*|, |**-|
class (MonadTransCover2 (Trans3Down t3)) => MonadTransCover3 t3 where
(|--*|) :: (Monad m1, Monad2 m2, Monad3 m3) => (Trans3Down t3) m1 m2 a -> t3 m1 m2 m3 a
(|-*-|) :: (Monad m1, Monad2 m2, Monad3 m3) => (Trans3Down t3) m1 m3 a -> t3 m1 m2 m3 a
(|*--|) :: (Monad m1, Monad2 m2, Monad3 m3) => (Trans3Down t3) m2 m3 a -> t3 m1 m2 m3 a
(|***|) :: (Monad m1, Monad2 m2, Monad3 m3, MonadTransCover3 t3) =>
(M__ t3) a -> t3 m1 m2 m3 a
(|***|) = (|*--|) . (|**|)
(|-**|) :: (Monad m1, Monad2 m2, Monad3 m3, MonadTransCover3 t3) =>
(T__ t3) m1 a -> t3 m1 m2 m3 a
(|-**|) = (|--*|) . (|-*|)
(|*-*|) :: (Monad m1, Monad2 m2, Monad3 m3, MonadTransCover3 t3) =>
(T__ t3) m2 a -> t3 m1 m2 m3 a
(|*-*|) = (|--*|) . (|*-|)
(|**-|) :: (Monad m1, Monad2 m2, Monad3 m3, MonadTransCover3 t3) =>
(T__ t3) m3 a -> t3 m1 m2 m3 a
(|**-|) = (|*--|) . (|*-|)
trans3 :: (Monad m1, Monad (t3 (t2 m1)), Monad (t2 m1),
MonadTrans_ t2, MonadTrans_ t3, MonadTrans_ t4) =>
m1 ((TransDown t2) ((TransDown t3) ((TransDown t4) a))) -> t4 (t3 (t2 m1)) a
trans3 = trans2 . trans
untrans3 :: (Monad m1, Monad (t3 (t2 m1)), Monad (t2 m1),
MonadTrans_ t2, MonadTrans_ t3, MonadTrans_ t4) =>
t4 (t3 (t2 m1)) a -> m1 ((TransDown t2) ((TransDown t3) ((TransDown t4) a)))
untrans3 = untrans2 . untrans
class MonadTrans4 t where
lift4 :: (Monad m1, Monad2 m2, Monad3 m3, Monad4 m4) => m1 (m2 (m3 (m4 a))) -> t m1 m2 m3 m4 a
class MonadTrans5 t where
lift5 :: (Monad m1, Monad2 m2, Monad3 m3, Monad4 m4, Monad5 m5) => m1 (m2 (m3 (m4 (m5 a)))) -> t m1 m2 m3 m4 m5 a