{-# LANGUAGE CPP #-}
{-# LANGUAGE QuantifiedConstraints #-}
{-# LANGUAGE UndecidableInstances #-}

module Control.Monad.Trans.Elevator where

import Control.Applicative
import Control.Monad
import Control.Monad.Base
import Control.Monad.Fix
import Control.Monad.IO.Class
import Control.Monad.Trans.Class
import Control.Monad.Trans.Control
import Control.Monad.Trans.Control.Identity
import Control.Monad.Zip
import Data.Kind

#if defined(VERSION_exceptions)
import Control.Monad.Catch qualified as Exceptions
#endif

#if defined(VERSION_mtl)
import Control.Monad.Accum qualified as Mtl
import Control.Monad.Cont.Class qualified as Mtl
import Control.Monad.Error.Class qualified as Mtl
import Control.Monad.Reader.Class qualified as Mtl
import Control.Monad.RWS.Class qualified as Mtl (MonadRWS)
import Control.Monad.Select qualified as Mtl
import Control.Monad.State.Class qualified as Mtl
import Control.Monad.Writer.Class qualified as Mtl
#endif

#if defined(VERSION_primitive)
import Control.Monad.Primitive qualified as Primitive
#endif

#if defined(VERSION_resourcet)
import Control.Monad.Trans.Resource qualified as ResourceT
#endif

#if defined(VERSION_unliftio_core)
import Control.Monad.IO.Unlift qualified as UnliftIO
#endif

-- * 'Elevator'
--
-- $elevator
--
-- 'Elevator' can be used to lift instances through monad transformers as long as they implement
-- a 'MonadTrans' \/ 'MonadTransControl' \/ 'MonadTransControlIdentity' instance.
--
-- 'MonadTransControl' is only necessary when there is atleast one method with a monadic argument.
-- 'MonadTransControlIdentity' is even stronger and only required for a few specific instances.

-- | A newtype wrapper for monad transformers.
--
-- Access instances of the inner monad @m@.
--
-- __Type level arguments:__
--
-- [@t :: ('Type' -> 'Type') -> 'Type' -> 'Type'@] monad transformer
-- [@m :: 'Type' -> 'Type'@] monad
-- [@a :: 'Type'@] value
type Elevator :: ((Type -> Type) -> Type -> Type) -- ^ @t@
              -> (Type -> Type) -- ^ @m@
              -> Type -- ^ @a@
              -> Type
newtype Elevator t m a = Ascend { forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
Elevator t m a -> t m a
descend :: t m a }
  deriving newtype (forall a. a -> Elevator t m a
forall a b. Elevator t m a -> Elevator t m b -> Elevator t m a
forall a b. Elevator t m a -> Elevator t m b -> Elevator t m b
forall a b.
Elevator t m (a -> b) -> Elevator t m a -> Elevator t m b
forall a b c.
(a -> b -> c) -> Elevator t m a -> Elevator t m b -> Elevator t m c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
forall {t :: (* -> *) -> * -> *} {m :: * -> *}.
Applicative (t m) =>
Functor (Elevator t m)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
Applicative (t m) =>
a -> Elevator t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a b.
Applicative (t m) =>
Elevator t m a -> Elevator t m b -> Elevator t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a b.
Applicative (t m) =>
Elevator t m a -> Elevator t m b -> Elevator t m b
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a b.
Applicative (t m) =>
Elevator t m (a -> b) -> Elevator t m a -> Elevator t m b
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a b c.
Applicative (t m) =>
(a -> b -> c) -> Elevator t m a -> Elevator t m b -> Elevator t m c
<* :: forall a b. Elevator t m a -> Elevator t m b -> Elevator t m a
$c<* :: forall (t :: (* -> *) -> * -> *) (m :: * -> *) a b.
Applicative (t m) =>
Elevator t m a -> Elevator t m b -> Elevator t m a
*> :: forall a b. Elevator t m a -> Elevator t m b -> Elevator t m b
$c*> :: forall (t :: (* -> *) -> * -> *) (m :: * -> *) a b.
Applicative (t m) =>
Elevator t m a -> Elevator t m b -> Elevator t m b
liftA2 :: forall a b c.
(a -> b -> c) -> Elevator t m a -> Elevator t m b -> Elevator t m c
$cliftA2 :: forall (t :: (* -> *) -> * -> *) (m :: * -> *) a b c.
Applicative (t m) =>
(a -> b -> c) -> Elevator t m a -> Elevator t m b -> Elevator t m c
<*> :: forall a b.
Elevator t m (a -> b) -> Elevator t m a -> Elevator t m b
$c<*> :: forall (t :: (* -> *) -> * -> *) (m :: * -> *) a b.
Applicative (t m) =>
Elevator t m (a -> b) -> Elevator t m a -> Elevator t m b
pure :: forall a. a -> Elevator t m a
$cpure :: forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
Applicative (t m) =>
a -> Elevator t m a
Applicative, forall a b. a -> Elevator t m b -> Elevator t m a
forall a b. (a -> b) -> Elevator t m a -> Elevator t m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a b.
Functor (t m) =>
a -> Elevator t m b -> Elevator t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a b.
Functor (t m) =>
(a -> b) -> Elevator t m a -> Elevator t m b
<$ :: forall a b. a -> Elevator t m b -> Elevator t m a
$c<$ :: forall (t :: (* -> *) -> * -> *) (m :: * -> *) a b.
Functor (t m) =>
a -> Elevator t m b -> Elevator t m a
fmap :: forall a b. (a -> b) -> Elevator t m a -> Elevator t m b
$cfmap :: forall (t :: (* -> *) -> * -> *) (m :: * -> *) a b.
Functor (t m) =>
(a -> b) -> Elevator t m a -> Elevator t m b
Functor, forall a. a -> Elevator t m a
forall a b. Elevator t m a -> Elevator t m b -> Elevator t m b
forall a b.
Elevator t m a -> (a -> Elevator t m b) -> Elevator t m b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
forall {t :: (* -> *) -> * -> *} {m :: * -> *}.
Monad (t m) =>
Applicative (Elevator t m)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
Monad (t m) =>
a -> Elevator t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a b.
Monad (t m) =>
Elevator t m a -> Elevator t m b -> Elevator t m b
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a b.
Monad (t m) =>
Elevator t m a -> (a -> Elevator t m b) -> Elevator t m b
return :: forall a. a -> Elevator t m a
$creturn :: forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
Monad (t m) =>
a -> Elevator t m a
>> :: forall a b. Elevator t m a -> Elevator t m b -> Elevator t m b
$c>> :: forall (t :: (* -> *) -> * -> *) (m :: * -> *) a b.
Monad (t m) =>
Elevator t m a -> Elevator t m b -> Elevator t m b
>>= :: forall a b.
Elevator t m a -> (a -> Elevator t m b) -> Elevator t m b
$c>>= :: forall (t :: (* -> *) -> * -> *) (m :: * -> *) a b.
Monad (t m) =>
Elevator t m a -> (a -> Elevator t m b) -> Elevator t m b
Monad)
  deriving newtype (forall (m :: * -> *) a. Monad m => m a -> Elevator t m a
forall {t :: (* -> *) -> * -> *} (m :: * -> *).
(MonadTrans t, Monad m) =>
Monad (Elevator t m)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> Elevator t m a
forall (t :: (* -> *) -> * -> *).
(forall (m :: * -> *). Monad m => Monad (t m))
-> (forall (m :: * -> *) a. Monad m => m a -> t m a)
-> MonadTrans t
lift :: forall (m :: * -> *) a. Monad m => m a -> Elevator t m a
$clift :: forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> Elevator t m a
MonadTrans, forall (m :: * -> *) a.
Monad m =>
m (StT (Elevator t) a) -> Elevator t m a
forall (m :: * -> *) a.
Monad m =>
(Run (Elevator t) -> m a) -> Elevator t m a
forall (t :: (* -> *) -> * -> *).
MonadTrans t
-> (forall (m :: * -> *) a. Monad m => (Run t -> m a) -> t m a)
-> (forall (m :: * -> *) a. Monad m => m (StT t a) -> t m a)
-> MonadTransControl t
forall {t :: (* -> *) -> * -> *}.
MonadTransControl t =>
MonadTrans (Elevator t)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTransControl t, Monad m) =>
m (StT (Elevator t) a) -> Elevator t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTransControl t, Monad m) =>
(Run (Elevator t) -> m a) -> Elevator t m a
restoreT :: forall (m :: * -> *) a.
Monad m =>
m (StT (Elevator t) a) -> Elevator t m a
$crestoreT :: forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTransControl t, Monad m) =>
m (StT (Elevator t) a) -> Elevator t m a
liftWith :: forall (m :: * -> *) a.
Monad m =>
(Run (Elevator t) -> m a) -> Elevator t m a
$cliftWith :: forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTransControl t, Monad m) =>
(Run (Elevator t) -> m a) -> Elevator t m a
MonadTransControl, forall (m :: * -> *) a.
Monad m =>
((forall x. Elevator t m x -> m x) -> m a) -> Elevator t m a
forall (t :: (* -> *) -> * -> *).
MonadTransControl t
-> (forall (m :: * -> *) a.
    Monad m =>
    ((forall x. t m x -> m x) -> m a) -> t m a)
-> MonadTransControlIdentity t
forall {t :: (* -> *) -> * -> *}.
MonadTransControlIdentity t =>
MonadTransControl (Elevator t)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTransControlIdentity t, Monad m) =>
((forall x. Elevator t m x -> m x) -> m a) -> Elevator t m a
liftWithIdentity :: forall (m :: * -> *) a.
Monad m =>
((forall x. Elevator t m x -> m x) -> m a) -> Elevator t m a
$cliftWithIdentity :: forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTransControlIdentity t, Monad m) =>
((forall x. Elevator t m x -> m x) -> m a) -> Elevator t m a
MonadTransControlIdentity)

instance (MonadBase b m, MonadTrans t) => MonadBase b (Elevator t m) where
  liftBase :: forall α. b α -> Elevator t m α
liftBase = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase

instance (MonadBaseControl b m, MonadTransControl t) => MonadBaseControl b (Elevator t m) where
  type StM (Elevator t m) a = StM m (StT t a)
  liftBaseWith :: forall a. (RunInBase (Elevator t m) b -> b a) -> Elevator t m a
liftBaseWith RunInBase (Elevator t m) b -> b a
f = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTransControl t, Monad m) =>
(Run t -> m a) -> t m a
liftWith forall a b. (a -> b) -> a -> b
$ \ Run (Elevator t)
runT -> forall (b :: * -> *) (m :: * -> *) a.
MonadBaseControl b m =>
(RunInBase m b -> b a) -> m a
liftBaseWith forall a b. (a -> b) -> a -> b
$ \ RunInBase m b
runInBase -> RunInBase (Elevator t m) b -> b a
f forall a b. (a -> b) -> a -> b
$ RunInBase m b
runInBase forall b c a. (b -> c) -> (a -> b) -> a -> c
. Run (Elevator t)
runT
  restoreM :: forall a. StM (Elevator t m) a -> Elevator t m a
restoreM = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTransControl t, Monad m) =>
m (StT t a) -> t m a
restoreT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (b :: * -> *) (m :: * -> *) a.
MonadBaseControl b m =>
StM m a -> m a
restoreM

instance (MonadBaseControlIdentity b m, MonadTransControlIdentity t) => MonadBaseControlIdentity b (Elevator t m) where
  liftBaseWithIdentity :: forall a.
((forall x. Elevator t m x -> b x) -> b a) -> Elevator t m a
liftBaseWithIdentity = forall (b :: * -> *) (m :: * -> *) (t :: (* -> *) -> * -> *) a.
(MonadBaseControlIdentity b m, MonadTransControlIdentity t) =>
((forall x. t m x -> b x) -> b a) -> t m a
defaultLiftBaseWithIdentity

instance (Alternative m, Monad m, MonadTransControl t) => Alternative (Elevator t m) where
  empty :: forall a. Elevator t m a
empty = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (f :: * -> *) a. Alternative f => f a
empty
  <|> :: forall a. Elevator t m a -> Elevator t m a -> Elevator t m a
(<|>) Elevator t m a
x Elevator t m a
y = (forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTransControl t, Monad m) =>
m (StT t a) -> t m a
restoreT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) forall a b. (a -> b) -> a -> b
$ forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTransControl t, Monad m) =>
(Run t -> m a) -> t m a
liftWith forall a b. (a -> b) -> a -> b
$ \ Run (Elevator t)
runT -> Run (Elevator t)
runT Elevator t m a
x forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Run (Elevator t)
runT Elevator t m a
y

instance (MonadFail m, MonadTrans t) => MonadFail (Elevator t m) where
  fail :: forall a. String -> Elevator t m a
fail = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadFail m => String -> m a
fail

instance (MonadFix m, MonadTransControlIdentity t) => MonadFix (Elevator t m) where
  mfix :: forall a. (a -> Elevator t m a) -> Elevator t m a
mfix a -> Elevator t m a
f = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTransControlIdentity t, Monad m) =>
((forall x. t m x -> m x) -> m a) -> t m a
liftWithIdentity forall a b. (a -> b) -> a -> b
$ \ forall x. Elevator t m x -> m x
runT -> forall (m :: * -> *) a. MonadFix m => (a -> m a) -> m a
mfix forall a b. (a -> b) -> a -> b
$ \ a
x -> forall x. Elevator t m x -> m x
runT forall a b. (a -> b) -> a -> b
$ a -> Elevator t m a
f a
x

instance (MonadIO m, MonadTrans t) => MonadIO (Elevator t m) where
  liftIO :: forall a. IO a -> Elevator t m a
liftIO = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO

instance (MonadPlus m, MonadTransControl t) => MonadPlus (Elevator t m)

instance (MonadZip m, MonadTransControlIdentity t) => MonadZip (Elevator t m) where
  mzip :: forall a b. Elevator t m a -> Elevator t m b -> Elevator t m (a, b)
mzip Elevator t m a
x Elevator t m b
y = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTransControlIdentity t, Monad m) =>
((forall x. t m x -> m x) -> m a) -> t m a
liftWithIdentity forall a b. (a -> b) -> a -> b
$ \ forall x. Elevator t m x -> m x
runT ->
    forall (m :: * -> *) a b. MonadZip m => m a -> m b -> m (a, b)
mzip (forall x. Elevator t m x -> m x
runT Elevator t m a
x) (forall x. Elevator t m x -> m x
runT Elevator t m b
y)

#if defined(VERSION_exceptions)
instance (Exceptions.MonadThrow m, MonadTrans t) => Exceptions.MonadThrow (Elevator t m) where
  throwM :: forall e a. (HasCallStack, Exception e) => e -> Elevator t m a
throwM = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
Exceptions.throwM

instance (Exceptions.MonadCatch m, MonadTransControl t) => Exceptions.MonadCatch (Elevator t m) where
  catch :: forall e a.
(HasCallStack, Exception e) =>
Elevator t m a -> (e -> Elevator t m a) -> Elevator t m a
catch Elevator t m a
throwing e -> Elevator t m a
catching = (forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTransControl t, Monad m) =>
m (StT t a) -> t m a
restoreT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) forall a b. (a -> b) -> a -> b
$ forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTransControl t, Monad m) =>
(Run t -> m a) -> t m a
liftWith forall a b. (a -> b) -> a -> b
$ \ Run (Elevator t)
runT ->
    forall (m :: * -> *) e a.
(MonadCatch m, HasCallStack, Exception e) =>
m a -> (e -> m a) -> m a
Exceptions.catch (Run (Elevator t)
runT Elevator t m a
throwing) (Run (Elevator t)
runT forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> Elevator t m a
catching)
#endif

#if defined(VERSION_mtl)
instance (Mtl.MonadAccum w m, MonadTrans t) => Mtl.MonadAccum w (Elevator t m) where
  look :: Elevator t m w
look = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall w (m :: * -> *). MonadAccum w m => m w
Mtl.look
  add :: w -> Elevator t m ()
add = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall w (m :: * -> *). MonadAccum w m => w -> m ()
Mtl.add

instance (Mtl.MonadCont m, MonadTransControl t) => Mtl.MonadCont (Elevator t m) where
  callCC :: forall a b.
((a -> Elevator t m b) -> Elevator t m a) -> Elevator t m a
callCC (a -> Elevator t m b) -> Elevator t m a
f = (forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTransControl t, Monad m) =>
m (StT t a) -> t m a
restoreT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) forall a b. (a -> b) -> a -> b
$ forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTransControl t, Monad m) =>
(Run t -> m a) -> t m a
liftWith forall a b. (a -> b) -> a -> b
$ \ Run (Elevator t)
runT ->
    forall (m :: * -> *) a b. MonadCont m => ((a -> m b) -> m a) -> m a
Mtl.callCC forall a b. (a -> b) -> a -> b
$ \ StT t a -> m (StT t b)
c -> Run (Elevator t)
runT forall a b. (a -> b) -> a -> b
$ (a -> Elevator t m b) -> Elevator t m a
f forall a b. (a -> b) -> a -> b
$ \ a
a -> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTransControl t, Monad m) =>
m (StT t a) -> t m a
restoreT forall a b. (a -> b) -> a -> b
$ StT t a -> m (StT t b)
c forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Run (Elevator t)
runT (forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a)

instance (Mtl.MonadError e m, MonadTransControl t) => Mtl.MonadError e (Elevator t m) where
  throwError :: forall a. e -> Elevator t m a
throwError = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e (m :: * -> *) a. MonadError e m => e -> m a
Mtl.throwError
  catchError :: forall a. Elevator t m a -> (e -> Elevator t m a) -> Elevator t m a
catchError Elevator t m a
throwing e -> Elevator t m a
catching = (forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTransControl t, Monad m) =>
m (StT t a) -> t m a
restoreT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) forall a b. (a -> b) -> a -> b
$ forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTransControl t, Monad m) =>
(Run t -> m a) -> t m a
liftWith forall a b. (a -> b) -> a -> b
$ \ Run (Elevator t)
runT ->
    forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
Mtl.catchError (Run (Elevator t)
runT Elevator t m a
throwing) (Run (Elevator t)
runT forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> Elevator t m a
catching)

instance (Mtl.MonadReader r m, MonadTransControl t) => Mtl.MonadReader r (Elevator t m) where
  ask :: Elevator t m r
ask = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall r (m :: * -> *). MonadReader r m => m r
Mtl.ask
  local :: forall a. (r -> r) -> Elevator t m a -> Elevator t m a
local r -> r
f Elevator t m a
tma = (forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTransControl t, Monad m) =>
m (StT t a) -> t m a
restoreT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) forall a b. (a -> b) -> a -> b
$ forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTransControl t, Monad m) =>
(Run t -> m a) -> t m a
liftWith forall a b. (a -> b) -> a -> b
$ \ Run (Elevator t)
runT ->
    forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
Mtl.local r -> r
f forall a b. (a -> b) -> a -> b
$ Run (Elevator t)
runT Elevator t m a
tma

instance (Mtl.MonadRWS r w s m, MonadTransControl t) => Mtl.MonadRWS r w s (Elevator t m)

instance (Mtl.MonadSelect r m, MonadTrans t) => Mtl.MonadSelect r (Elevator t m) where
  select :: forall a. ((a -> r) -> a) -> Elevator t m a
select = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r (m :: * -> *) a. MonadSelect r m => ((a -> r) -> a) -> m a
Mtl.select

instance (Mtl.MonadState s m, MonadTrans t) => Mtl.MonadState s (Elevator t m) where
  get :: Elevator t m s
get = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall s (m :: * -> *). MonadState s m => m s
Mtl.get
  put :: s -> Elevator t m ()
put = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *). MonadState s m => s -> m ()
Mtl.put

instance (Mtl.MonadWriter w m, MonadTransControl t) => Mtl.MonadWriter w (Elevator t m) where
  tell :: w -> Elevator t m ()
tell = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall w (m :: * -> *). MonadWriter w m => w -> m ()
Mtl.tell
  listen :: forall a. Elevator t m a -> Elevator t m (a, w)
listen Elevator t m a
tma = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTransControl t, Monad m) =>
(Run t -> m a) -> t m a
liftWith (\ Run (Elevator t)
runT -> forall w (m :: * -> *) a. MonadWriter w m => m a -> m (a, w)
Mtl.listen forall a b. (a -> b) -> a -> b
$ Run (Elevator t)
runT Elevator t m a
tma) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ (StT t a
sta, w
w) ->
    (, w
w) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTransControl t, Monad m) =>
m (StT t a) -> t m a
restoreT (forall (f :: * -> *) a. Applicative f => a -> f a
pure StT t a
sta)
  pass :: forall a. Elevator t m (a, w -> w) -> Elevator t m a
pass Elevator t m (a, w -> w)
tma = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall w (m :: * -> *) a. MonadWriter w m => m (a, w -> w) -> m a
Mtl.pass forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Elevator t m (a, w -> w)
tma
#endif

#if defined(VERSION_primitive)
instance (Primitive.PrimMonad m, MonadTrans t) => Primitive.PrimMonad (Elevator t m) where
  type PrimState (Elevator t m) = Primitive.PrimState m
  primitive :: forall a.
(State# (PrimState (Elevator t m))
 -> (# State# (PrimState (Elevator t m)), a #))
-> Elevator t m a
primitive = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a.
PrimMonad m =>
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
Primitive.primitive
#endif

#if defined(VERSION_resourcet)
instance (ResourceT.MonadResource m, MonadTrans t) => ResourceT.MonadResource (Elevator t m) where
  liftResourceT :: forall a. ResourceT IO a -> Elevator t m a
liftResourceT = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadResource m => ResourceT IO a -> m a
ResourceT.liftResourceT
#endif

#if defined(VERSION_unliftio_core)
instance (UnliftIO.MonadUnliftIO m, MonadTransControlIdentity t) => UnliftIO.MonadUnliftIO (Elevator t m) where
  withRunInIO :: forall b.
((forall a. Elevator t m a -> IO a) -> IO b) -> Elevator t m b
withRunInIO (forall a. Elevator t m a -> IO a) -> IO b
f = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTransControlIdentity t, Monad m) =>
((forall x. t m x -> m x) -> m a) -> t m a
liftWithIdentity forall a b. (a -> b) -> a -> b
$ \forall x. Elevator t m x -> m x
runT -> forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
UnliftIO.withRunInIO forall a b. (a -> b) -> a -> b
$ \forall a. m a -> IO a
runInIO -> (forall a. Elevator t m a -> IO a) -> IO b
f forall a b. (a -> b) -> a -> b
$ forall a. m a -> IO a
runInIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall x. Elevator t m x -> m x
runT
#endif

-- * Examples

-- ** Example 1: Recover submerged instances
--
-- $example1
--
-- Let's assume you want to define a monad transformer stack.
--
-- @
-- newtype StackT m a = StackT { unStackT :: 'Control.Monad.Trans.Reader.ReaderT' 'Char' ('Control.Monad.Trans.Reader.ReaderT' 'Bool' m) a }
--   deriving newtype ('Functor', 'Applicative', 'Monad')
-- @
--
-- Now you want to expose the inner @('Control.Monad.Reader.Class.MonadReader' 'Bool')@ instance with @(StackT m)@.
--
-- Normally it's shadowed by the @('Control.Monad.Reader.Class.MonadReader' 'Char')@ instance, but we can use 'Elevator' to
-- access the inner transformer.
--
-- @
--   deriving ('Control.Monad.Reader.Class.MonadReader' 'Bool') via 'Elevator' ('Control.Monad.Trans.Reader.ReaderT' 'Char') ('Control.Monad.Trans.Reader.ReaderT' 'Bool' m)
-- @

-- ** Example 2: Custom transformer without boilerplate
--
-- $example2
--
-- Let's assume you have defined a monad transformer.
--
-- @
-- newtype CustomT m a = CustomT { unCustomT :: 'Control.Monad.Trans.Identity.IdentityT' m a }
--   deriving newtype ('Functor', 'Applicative', 'Monad')
--   deriving newtype ('MonadTrans', 'MonadTransControl')
--
-- runCustomT :: CustomT m a -> m a
-- runCustomT = 'Control.Monad.Trans.Identity.runIdentityT' . unCustomT
-- @
--
-- Now you want to use this monad transformer in a transformer stack.
--
-- @
-- newtype StackT m a = StackT { unStackT :: CustomT ('Control.Monad.Trans.Reader.ReaderT' 'Bool' m) a }
--   deriving newtype ('Functor', 'Applicative', 'Monad')
-- @
--
-- Unfortunately we can't derive a @('Monad' m => 'Control.Monad.Reader.Class.MonadReader' 'Bool' (StackT m))@ instance with
-- /GeneralizedNewtypeDeriving/, without also adding the instance to @CustomT@.
--
-- To still derive this trivial instance we can use 'Elevator' with /DerivingVia/.
--
-- @
--   deriving ('Control.Monad.Reader.Class.MonadReader' 'Bool') via ('Elevator' CustomT ('Control.Monad.Trans.Reader.ReaderT' 'Bool' m))
-- @

-- ** Example 3: Adding an instance for 'Elevator'
--
-- $example3
--
-- Suppose you define a new type class.
--
-- @
-- class 'Monad' m => MonadCustom m where
--   simpleMethod :: a -> m a
--   complicatedMethod :: (a -> m b) -> m b
-- @
--
-- A simple way to allow a type class to be lifted through other monad transformers is by adding an
-- instance for 'Elevator'.
--
-- You have to be careful about monadic state 'StT', when defining such instances using
-- 'MonadTransControl'.
--
-- @
-- instance (MonadCustom m, 'MonadTransControl' t) => MonadCustom ('Elevator' t m) where
--   simpleMethod = 'lift' . simpleMethod
--   complicatedMethod f = ('restoreT' . 'pure' '=<<') $ 'liftWith' $ \\ runT ->
--     complicatedMethod $ runT . f
-- @
--
-- Some useful examples (or exercises) are the instances for
-- [mtl](https://hackage.haskell.org/package/mtl)'s type classes ('Control.Monad.Error.Class.MonadError', 'Control.Monad.Reader.Class.MonadReader',
-- 'Control.Monad.State.Class.MonadState', 'Control.Monad.Writer.Class.MonadWriter').