{-# 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
#endif

#if defined(VERSION_mtl)
import Control.Monad.Cont.Class
import Control.Monad.Error.Class
import Control.Monad.Reader.Class
import Control.Monad.RWS.Class (MonadRWS)
import Control.Monad.State.Class
import Control.Monad.Writer.Class
#endif

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

#if defined(VERSION_unliftio_core)
import Control.Monad.IO.Unlift
#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 :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> Elevator t m a
forall (t :: (* -> *) -> * -> *).
(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 (Monad (t m), MonadTrans t, MonadBase b m) => 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 (Monad (t m), MonadTransControl t, MonadBaseControl b m) => 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 (Monad (t m), MonadTransControlIdentity t, MonadBaseControlIdentity b m) => 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 (Monad (t m), MonadTransControl t, Monad m, Alternative m) => 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 (Monad (t m), MonadTrans t, MonadFail m) => 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 (Monad (t m), MonadTransControlIdentity t, MonadFix m) => 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 (Monad (t m), MonadTrans t, MonadIO m) => 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 (Monad (t m), MonadTransControl t, MonadPlus m) => MonadPlus (Elevator t m)

instance (Monad (t m), MonadTransControlIdentity t, MonadZip m) => 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 (Monad (t m), MonadTrans t, MonadThrow m) => MonadThrow (Elevator t m) where
  throwM :: forall e a. 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, Exception e) => e -> m a
throwM

instance (Monad (t m), MonadTransControl t, MonadCatch m) => MonadCatch (Elevator t m) where
  catch :: forall e a.
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, Exception e) =>
m a -> (e -> m a) -> m a
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 (Monad (t m), MonadTransControl t, MonadCont m) => 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
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 (Monad (t m), MonadTransControl t, MonadError e m) => 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
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
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 (Monad (t m), MonadTransControl t, MonadReader r m) => 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
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
local r -> r
f forall a b. (a -> b) -> a -> b
$ Run (Elevator t)
runT Elevator t m a
tma

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

instance (Monad (t m), MonadTrans t, MonadState s m) => 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
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 ()
put

instance (Monad (t m), MonadTransControl t, MonadWriter w m) => 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 ()
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)
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
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 (Monad (t m), MonadTrans t, PrimMonad m) => PrimMonad (Elevator t m) where
  type PrimState (Elevator t m) = 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
#endif

#if defined(VERSION_unliftio_core)
instance (Monad (t m), MonadTransControlIdentity t, MonadUnliftIO m) => 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
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').