module Control.Monad.Ology.General.Trans.Hoist where

import Control.Monad.Ology.General.Function
import Control.Monad.Ology.General.IO
import Control.Monad.Ology.General.Trans.Constraint
import Control.Monad.Ology.General.Trans.Trans
import Import

-- | Monad transformers for which monads can be hoisted.
type MonadTransHoist :: TransKind -> Constraint
class (MonadTrans t, TransConstraint Monad t) => MonadTransHoist t where
    hoist ::
           forall m1 m2. (Monad m1, Monad m2)
        => (m1 --> m2)
        -> t m1 --> t m2

hoistTransform :: (MonadTransHoist t, Monad m1, Monad m2) => (m1 --> m2) -> WRaised (t m2) --> WRaised (t m1)
hoistTransform :: forall (t :: TransKind) (m1 :: Type -> Type) (m2 :: Type -> Type).
(MonadTransHoist t, Monad m1, Monad m2) =>
(m1 --> m2) -> WRaised (t m2) --> WRaised (t m1)
hoistTransform m1 --> m2
ff (MkWRaised t m2 --> a
r2) = forall k (p :: k -> Type) (q :: k -> Type).
(p --> q) -> WRaised p q
MkWRaised forall a b. (a -> b) -> a -> b
$ \t m1 a
m1a -> t m2 --> a
r2 forall a b. (a -> b) -> a -> b
$ forall (t :: TransKind) (m1 :: Type -> Type) (m2 :: Type -> Type).
(MonadTransHoist t, Monad m1, Monad m2) =>
(m1 --> m2) -> t m1 --> t m2
hoist m1 --> m2
ff t m1 a
m1a

class MonadIO m => MonadHoistIO m where
    hoistIO :: (IO --> IO) -> m --> m

instance MonadHoistIO IO where
    hoistIO :: (IO --> IO) -> IO --> IO
hoistIO IO --> IO
f = IO --> IO
f

instance (MonadTransHoist t, MonadHoistIO m, MonadIO (t m)) => MonadHoistIO (t m) where
    hoistIO :: (IO --> IO) -> t m --> t m
hoistIO IO --> IO
f = forall (t :: TransKind) (m1 :: Type -> Type) (m2 :: Type -> Type).
(MonadTransHoist t, Monad m1, Monad m2) =>
(m1 --> m2) -> t m1 --> t m2
hoist forall a b. (a -> b) -> a -> b
$ forall (m :: Type -> Type).
MonadHoistIO m =>
(IO --> IO) -> m --> m
hoistIO IO --> IO
f

instance (MonadTransHoist t, TransConstraint MonadIO t) => TransConstraint MonadHoistIO t where
    hasTransConstraint :: forall (m :: Type -> Type).
MonadHoistIO m =>
Dict (MonadHoistIO (t m))
hasTransConstraint = forall (c :: (Type -> Type) -> Constraint) (t :: TransKind)
       (m :: Type -> Type) (c' :: (Type -> Type) -> Constraint).
(TransConstraint c t, c m) =>
(c (t m) => Dict (c' (t m))) -> Dict (c' (t m))
withTransConstraintDict @MonadIO forall a b. (a -> b) -> a -> b
$ forall (a :: Constraint). a => Dict a
Dict