module Control.Monad.Trans.Control.Functor (
  MonadTransFunctor (..)
, hoistTrans
) where

import Control.Monad.Base
import Control.Monad.Trans.Control
import Control.Monad.Trans.Control.Identity
import Control.Monad.Trans.Identity
import Control.Monad.Trans.Reader

{- | This type class is generalization of functions like 'mapReaderT'
  and 'mapIdentityT'.
-}
class MonadTransControlIdentity t => MonadTransFunctor t where
  liftMap :: (m a -> n b) -> t m a -> t n b

instance MonadTransFunctor IdentityT where
  liftMap :: forall (m :: * -> *) a (n :: * -> *) b.
(m a -> n b) -> IdentityT m a -> IdentityT n b
liftMap m a -> n b
f = n b -> IdentityT n b
forall {k} (f :: k -> *) (a :: k). f a -> IdentityT f a
IdentityT (n b -> IdentityT n b)
-> (IdentityT m a -> n b) -> IdentityT m a -> IdentityT n b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> n b
f (m a -> n b) -> (IdentityT m a -> m a) -> IdentityT m a -> n b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IdentityT m a -> m a
forall {k} (f :: k -> *) (a :: k). IdentityT f a -> f a
runIdentityT

instance MonadTransFunctor (ReaderT r) where
  liftMap :: forall (m :: * -> *) a (n :: * -> *) b.
(m a -> n b) -> ReaderT r m a -> ReaderT r n b
liftMap m a -> n b
f ReaderT r m a
m = (r -> n b) -> ReaderT r n b
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((r -> n b) -> ReaderT r n b) -> (r -> n b) -> ReaderT r n b
forall a b. (a -> b) -> a -> b
$ m a -> n b
f (m a -> n b) -> (r -> m a) -> r -> n b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReaderT r m a -> r -> m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT r m a
m

-- | Lift the inner monad of a monad transformer from the base monad.
hoistTrans :: (MonadBaseControl b m, MonadBaseControl b (t m), MonadTransFunctor t)
           => t b a
           -> t m a
hoistTrans :: forall (b :: * -> *) (m :: * -> *) (t :: (* -> *) -> * -> *) a.
(MonadBaseControl b m, MonadBaseControl b (t m),
 MonadTransFunctor t) =>
t b a -> t m a
hoistTrans t b a
a = (StM (t m) a -> t m a) -> t m (StM (t m) a) -> t m a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
(=<<) StM (t m) a -> t m a
forall (b :: * -> *) (m :: * -> *) a.
MonadBaseControl b m =>
StM m a -> m a
restoreM (t m (StM (t m) a) -> t m a) -> t m (StM (t m) a) -> t m a
forall a b. (a -> b) -> a -> b
$ (RunInBase (t m) b -> b (StM (t m) a)) -> t m (StM (t m) a)
forall (b :: * -> *) (m :: * -> *) a.
MonadBaseControl b m =>
(RunInBase m b -> b a) -> m a
liftBaseWith ((RunInBase (t m) b -> b (StM (t m) a)) -> t m (StM (t m) a))
-> (RunInBase (t m) b -> b (StM (t m) a)) -> t m (StM (t m) a)
forall a b. (a -> b) -> a -> b
$ \ RunInBase (t m) b
runInBase ->
                 t m a -> b (StM (t m) a)
RunInBase (t m) b
runInBase (t m a -> b (StM (t m) a)) -> t m a -> b (StM (t m) a)
forall a b. (a -> b) -> a -> b
$ (b a -> m a) -> t b a -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a (n :: * -> *) b.
MonadTransFunctor t =>
(m a -> n b) -> t m a -> t n b
liftMap b a -> m a
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (t b a -> t m a) -> t b a -> t m a
forall a b. (a -> b) -> a -> b
$ t b a
a