{-# LANGUAGE CPP #-}
{-# OPTIONS_HADDOCK not-home #-}
module Control.Effect.Carrier.Internal.Compose where

import Control.Applicative
import Control.Monad
import qualified Control.Monad.Fail as Fail
import Control.Monad.Trans
import Control.Monad.Trans.Identity
import Control.Monad.Fix
import Control.Effect.Internal
import Control.Effect.Internal.Derive
import Control.Effect.Internal.Utils
import Control.Monad.Trans.Control

import Unsafe.Coerce

-- | Composition of monad/carrier transformers.
newtype ComposeT t (u :: (* -> *) -> * -> *) m a = ComposeT {
    ComposeT t u m a -> t (u m) a
getComposeT :: t (u m) a
  }
  deriving ( a -> ComposeT t u m b -> ComposeT t u m a
(a -> b) -> ComposeT t u m a -> ComposeT t u m b
(forall a b. (a -> b) -> ComposeT t u m a -> ComposeT t u m b)
-> (forall a b. a -> ComposeT t u m b -> ComposeT t u m a)
-> Functor (ComposeT t u m)
forall a b. a -> ComposeT t u m b -> ComposeT t u m a
forall a b. (a -> b) -> ComposeT t u m a -> ComposeT t u 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 :: (* -> *) -> * -> *) (u :: (* -> *) -> * -> *)
       (m :: * -> *) a b.
Functor (t (u m)) =>
a -> ComposeT t u m b -> ComposeT t u m a
forall (t :: (* -> *) -> * -> *) (u :: (* -> *) -> * -> *)
       (m :: * -> *) a b.
Functor (t (u m)) =>
(a -> b) -> ComposeT t u m a -> ComposeT t u m b
<$ :: a -> ComposeT t u m b -> ComposeT t u m a
$c<$ :: forall (t :: (* -> *) -> * -> *) (u :: (* -> *) -> * -> *)
       (m :: * -> *) a b.
Functor (t (u m)) =>
a -> ComposeT t u m b -> ComposeT t u m a
fmap :: (a -> b) -> ComposeT t u m a -> ComposeT t u m b
$cfmap :: forall (t :: (* -> *) -> * -> *) (u :: (* -> *) -> * -> *)
       (m :: * -> *) a b.
Functor (t (u m)) =>
(a -> b) -> ComposeT t u m a -> ComposeT t u m b
Functor, Functor (ComposeT t u m)
a -> ComposeT t u m a
Functor (ComposeT t u m)
-> (forall a. a -> ComposeT t u m a)
-> (forall a b.
    ComposeT t u m (a -> b) -> ComposeT t u m a -> ComposeT t u m b)
-> (forall a b c.
    (a -> b -> c)
    -> ComposeT t u m a -> ComposeT t u m b -> ComposeT t u m c)
-> (forall a b.
    ComposeT t u m a -> ComposeT t u m b -> ComposeT t u m b)
-> (forall a b.
    ComposeT t u m a -> ComposeT t u m b -> ComposeT t u m a)
-> Applicative (ComposeT t u m)
ComposeT t u m a -> ComposeT t u m b -> ComposeT t u m b
ComposeT t u m a -> ComposeT t u m b -> ComposeT t u m a
ComposeT t u m (a -> b) -> ComposeT t u m a -> ComposeT t u m b
(a -> b -> c)
-> ComposeT t u m a -> ComposeT t u m b -> ComposeT t u m c
forall a. a -> ComposeT t u m a
forall a b.
ComposeT t u m a -> ComposeT t u m b -> ComposeT t u m a
forall a b.
ComposeT t u m a -> ComposeT t u m b -> ComposeT t u m b
forall a b.
ComposeT t u m (a -> b) -> ComposeT t u m a -> ComposeT t u m b
forall a b c.
(a -> b -> c)
-> ComposeT t u m a -> ComposeT t u m b -> ComposeT t u 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 :: (* -> *) -> * -> *) (u :: (* -> *) -> * -> *)
       (m :: * -> *).
Applicative (t (u m)) =>
Functor (ComposeT t u m)
forall (t :: (* -> *) -> * -> *) (u :: (* -> *) -> * -> *)
       (m :: * -> *) a.
Applicative (t (u m)) =>
a -> ComposeT t u m a
forall (t :: (* -> *) -> * -> *) (u :: (* -> *) -> * -> *)
       (m :: * -> *) a b.
Applicative (t (u m)) =>
ComposeT t u m a -> ComposeT t u m b -> ComposeT t u m a
forall (t :: (* -> *) -> * -> *) (u :: (* -> *) -> * -> *)
       (m :: * -> *) a b.
Applicative (t (u m)) =>
ComposeT t u m a -> ComposeT t u m b -> ComposeT t u m b
forall (t :: (* -> *) -> * -> *) (u :: (* -> *) -> * -> *)
       (m :: * -> *) a b.
Applicative (t (u m)) =>
ComposeT t u m (a -> b) -> ComposeT t u m a -> ComposeT t u m b
forall (t :: (* -> *) -> * -> *) (u :: (* -> *) -> * -> *)
       (m :: * -> *) a b c.
Applicative (t (u m)) =>
(a -> b -> c)
-> ComposeT t u m a -> ComposeT t u m b -> ComposeT t u m c
<* :: ComposeT t u m a -> ComposeT t u m b -> ComposeT t u m a
$c<* :: forall (t :: (* -> *) -> * -> *) (u :: (* -> *) -> * -> *)
       (m :: * -> *) a b.
Applicative (t (u m)) =>
ComposeT t u m a -> ComposeT t u m b -> ComposeT t u m a
*> :: ComposeT t u m a -> ComposeT t u m b -> ComposeT t u m b
$c*> :: forall (t :: (* -> *) -> * -> *) (u :: (* -> *) -> * -> *)
       (m :: * -> *) a b.
Applicative (t (u m)) =>
ComposeT t u m a -> ComposeT t u m b -> ComposeT t u m b
liftA2 :: (a -> b -> c)
-> ComposeT t u m a -> ComposeT t u m b -> ComposeT t u m c
$cliftA2 :: forall (t :: (* -> *) -> * -> *) (u :: (* -> *) -> * -> *)
       (m :: * -> *) a b c.
Applicative (t (u m)) =>
(a -> b -> c)
-> ComposeT t u m a -> ComposeT t u m b -> ComposeT t u m c
<*> :: ComposeT t u m (a -> b) -> ComposeT t u m a -> ComposeT t u m b
$c<*> :: forall (t :: (* -> *) -> * -> *) (u :: (* -> *) -> * -> *)
       (m :: * -> *) a b.
Applicative (t (u m)) =>
ComposeT t u m (a -> b) -> ComposeT t u m a -> ComposeT t u m b
pure :: a -> ComposeT t u m a
$cpure :: forall (t :: (* -> *) -> * -> *) (u :: (* -> *) -> * -> *)
       (m :: * -> *) a.
Applicative (t (u m)) =>
a -> ComposeT t u m a
$cp1Applicative :: forall (t :: (* -> *) -> * -> *) (u :: (* -> *) -> * -> *)
       (m :: * -> *).
Applicative (t (u m)) =>
Functor (ComposeT t u m)
Applicative, Applicative (ComposeT t u m)
a -> ComposeT t u m a
Applicative (ComposeT t u m)
-> (forall a b.
    ComposeT t u m a -> (a -> ComposeT t u m b) -> ComposeT t u m b)
-> (forall a b.
    ComposeT t u m a -> ComposeT t u m b -> ComposeT t u m b)
-> (forall a. a -> ComposeT t u m a)
-> Monad (ComposeT t u m)
ComposeT t u m a -> (a -> ComposeT t u m b) -> ComposeT t u m b
ComposeT t u m a -> ComposeT t u m b -> ComposeT t u m b
forall a. a -> ComposeT t u m a
forall a b.
ComposeT t u m a -> ComposeT t u m b -> ComposeT t u m b
forall a b.
ComposeT t u m a -> (a -> ComposeT t u m b) -> ComposeT t u 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 :: (* -> *) -> * -> *) (u :: (* -> *) -> * -> *)
       (m :: * -> *).
Monad (t (u m)) =>
Applicative (ComposeT t u m)
forall (t :: (* -> *) -> * -> *) (u :: (* -> *) -> * -> *)
       (m :: * -> *) a.
Monad (t (u m)) =>
a -> ComposeT t u m a
forall (t :: (* -> *) -> * -> *) (u :: (* -> *) -> * -> *)
       (m :: * -> *) a b.
Monad (t (u m)) =>
ComposeT t u m a -> ComposeT t u m b -> ComposeT t u m b
forall (t :: (* -> *) -> * -> *) (u :: (* -> *) -> * -> *)
       (m :: * -> *) a b.
Monad (t (u m)) =>
ComposeT t u m a -> (a -> ComposeT t u m b) -> ComposeT t u m b
return :: a -> ComposeT t u m a
$creturn :: forall (t :: (* -> *) -> * -> *) (u :: (* -> *) -> * -> *)
       (m :: * -> *) a.
Monad (t (u m)) =>
a -> ComposeT t u m a
>> :: ComposeT t u m a -> ComposeT t u m b -> ComposeT t u m b
$c>> :: forall (t :: (* -> *) -> * -> *) (u :: (* -> *) -> * -> *)
       (m :: * -> *) a b.
Monad (t (u m)) =>
ComposeT t u m a -> ComposeT t u m b -> ComposeT t u m b
>>= :: ComposeT t u m a -> (a -> ComposeT t u m b) -> ComposeT t u m b
$c>>= :: forall (t :: (* -> *) -> * -> *) (u :: (* -> *) -> * -> *)
       (m :: * -> *) a b.
Monad (t (u m)) =>
ComposeT t u m a -> (a -> ComposeT t u m b) -> ComposeT t u m b
$cp1Monad :: forall (t :: (* -> *) -> * -> *) (u :: (* -> *) -> * -> *)
       (m :: * -> *).
Monad (t (u m)) =>
Applicative (ComposeT t u m)
Monad
           , Applicative (ComposeT t u m)
ComposeT t u m a
Applicative (ComposeT t u m)
-> (forall a. ComposeT t u m a)
-> (forall a.
    ComposeT t u m a -> ComposeT t u m a -> ComposeT t u m a)
-> (forall a. ComposeT t u m a -> ComposeT t u m [a])
-> (forall a. ComposeT t u m a -> ComposeT t u m [a])
-> Alternative (ComposeT t u m)
ComposeT t u m a -> ComposeT t u m a -> ComposeT t u m a
ComposeT t u m a -> ComposeT t u m [a]
ComposeT t u m a -> ComposeT t u m [a]
forall a. ComposeT t u m a
forall a. ComposeT t u m a -> ComposeT t u m [a]
forall a. ComposeT t u m a -> ComposeT t u m a -> ComposeT t u m a
forall (f :: * -> *).
Applicative f
-> (forall a. f a)
-> (forall a. f a -> f a -> f a)
-> (forall a. f a -> f [a])
-> (forall a. f a -> f [a])
-> Alternative f
forall (t :: (* -> *) -> * -> *) (u :: (* -> *) -> * -> *)
       (m :: * -> *).
Alternative (t (u m)) =>
Applicative (ComposeT t u m)
forall (t :: (* -> *) -> * -> *) (u :: (* -> *) -> * -> *)
       (m :: * -> *) a.
Alternative (t (u m)) =>
ComposeT t u m a
forall (t :: (* -> *) -> * -> *) (u :: (* -> *) -> * -> *)
       (m :: * -> *) a.
Alternative (t (u m)) =>
ComposeT t u m a -> ComposeT t u m [a]
forall (t :: (* -> *) -> * -> *) (u :: (* -> *) -> * -> *)
       (m :: * -> *) a.
Alternative (t (u m)) =>
ComposeT t u m a -> ComposeT t u m a -> ComposeT t u m a
many :: ComposeT t u m a -> ComposeT t u m [a]
$cmany :: forall (t :: (* -> *) -> * -> *) (u :: (* -> *) -> * -> *)
       (m :: * -> *) a.
Alternative (t (u m)) =>
ComposeT t u m a -> ComposeT t u m [a]
some :: ComposeT t u m a -> ComposeT t u m [a]
$csome :: forall (t :: (* -> *) -> * -> *) (u :: (* -> *) -> * -> *)
       (m :: * -> *) a.
Alternative (t (u m)) =>
ComposeT t u m a -> ComposeT t u m [a]
<|> :: ComposeT t u m a -> ComposeT t u m a -> ComposeT t u m a
$c<|> :: forall (t :: (* -> *) -> * -> *) (u :: (* -> *) -> * -> *)
       (m :: * -> *) a.
Alternative (t (u m)) =>
ComposeT t u m a -> ComposeT t u m a -> ComposeT t u m a
empty :: ComposeT t u m a
$cempty :: forall (t :: (* -> *) -> * -> *) (u :: (* -> *) -> * -> *)
       (m :: * -> *) a.
Alternative (t (u m)) =>
ComposeT t u m a
$cp1Alternative :: forall (t :: (* -> *) -> * -> *) (u :: (* -> *) -> * -> *)
       (m :: * -> *).
Alternative (t (u m)) =>
Applicative (ComposeT t u m)
Alternative, Monad (ComposeT t u m)
Alternative (ComposeT t u m)
ComposeT t u m a
Alternative (ComposeT t u m)
-> Monad (ComposeT t u m)
-> (forall a. ComposeT t u m a)
-> (forall a.
    ComposeT t u m a -> ComposeT t u m a -> ComposeT t u m a)
-> MonadPlus (ComposeT t u m)
ComposeT t u m a -> ComposeT t u m a -> ComposeT t u m a
forall a. ComposeT t u m a
forall a. ComposeT t u m a -> ComposeT t u m a -> ComposeT t u m a
forall (m :: * -> *).
Alternative m
-> Monad m
-> (forall a. m a)
-> (forall a. m a -> m a -> m a)
-> MonadPlus m
forall (t :: (* -> *) -> * -> *) (u :: (* -> *) -> * -> *)
       (m :: * -> *).
MonadPlus (t (u m)) =>
Monad (ComposeT t u m)
forall (t :: (* -> *) -> * -> *) (u :: (* -> *) -> * -> *)
       (m :: * -> *).
MonadPlus (t (u m)) =>
Alternative (ComposeT t u m)
forall (t :: (* -> *) -> * -> *) (u :: (* -> *) -> * -> *)
       (m :: * -> *) a.
MonadPlus (t (u m)) =>
ComposeT t u m a
forall (t :: (* -> *) -> * -> *) (u :: (* -> *) -> * -> *)
       (m :: * -> *) a.
MonadPlus (t (u m)) =>
ComposeT t u m a -> ComposeT t u m a -> ComposeT t u m a
mplus :: ComposeT t u m a -> ComposeT t u m a -> ComposeT t u m a
$cmplus :: forall (t :: (* -> *) -> * -> *) (u :: (* -> *) -> * -> *)
       (m :: * -> *) a.
MonadPlus (t (u m)) =>
ComposeT t u m a -> ComposeT t u m a -> ComposeT t u m a
mzero :: ComposeT t u m a
$cmzero :: forall (t :: (* -> *) -> * -> *) (u :: (* -> *) -> * -> *)
       (m :: * -> *) a.
MonadPlus (t (u m)) =>
ComposeT t u m a
$cp2MonadPlus :: forall (t :: (* -> *) -> * -> *) (u :: (* -> *) -> * -> *)
       (m :: * -> *).
MonadPlus (t (u m)) =>
Monad (ComposeT t u m)
$cp1MonadPlus :: forall (t :: (* -> *) -> * -> *) (u :: (* -> *) -> * -> *)
       (m :: * -> *).
MonadPlus (t (u m)) =>
Alternative (ComposeT t u m)
MonadPlus
           , Monad (ComposeT t u m)
Monad (ComposeT t u m)
-> (forall a. (a -> ComposeT t u m a) -> ComposeT t u m a)
-> MonadFix (ComposeT t u m)
(a -> ComposeT t u m a) -> ComposeT t u m a
forall a. (a -> ComposeT t u m a) -> ComposeT t u m a
forall (m :: * -> *).
Monad m -> (forall a. (a -> m a) -> m a) -> MonadFix m
forall (t :: (* -> *) -> * -> *) (u :: (* -> *) -> * -> *)
       (m :: * -> *).
MonadFix (t (u m)) =>
Monad (ComposeT t u m)
forall (t :: (* -> *) -> * -> *) (u :: (* -> *) -> * -> *)
       (m :: * -> *) a.
MonadFix (t (u m)) =>
(a -> ComposeT t u m a) -> ComposeT t u m a
mfix :: (a -> ComposeT t u m a) -> ComposeT t u m a
$cmfix :: forall (t :: (* -> *) -> * -> *) (u :: (* -> *) -> * -> *)
       (m :: * -> *) a.
MonadFix (t (u m)) =>
(a -> ComposeT t u m a) -> ComposeT t u m a
$cp1MonadFix :: forall (t :: (* -> *) -> * -> *) (u :: (* -> *) -> * -> *)
       (m :: * -> *).
MonadFix (t (u m)) =>
Monad (ComposeT t u m)
MonadFix, Monad (ComposeT t u m)
Monad (ComposeT t u m)
-> (forall a. String -> ComposeT t u m a)
-> MonadFail (ComposeT t u m)
String -> ComposeT t u m a
forall a. String -> ComposeT t u m a
forall (m :: * -> *).
Monad m -> (forall a. String -> m a) -> MonadFail m
forall (t :: (* -> *) -> * -> *) (u :: (* -> *) -> * -> *)
       (m :: * -> *).
MonadFail (t (u m)) =>
Monad (ComposeT t u m)
forall (t :: (* -> *) -> * -> *) (u :: (* -> *) -> * -> *)
       (m :: * -> *) a.
MonadFail (t (u m)) =>
String -> ComposeT t u m a
fail :: String -> ComposeT t u m a
$cfail :: forall (t :: (* -> *) -> * -> *) (u :: (* -> *) -> * -> *)
       (m :: * -> *) a.
MonadFail (t (u m)) =>
String -> ComposeT t u m a
$cp1MonadFail :: forall (t :: (* -> *) -> * -> *) (u :: (* -> *) -> * -> *)
       (m :: * -> *).
MonadFail (t (u m)) =>
Monad (ComposeT t u m)
MonadFail, Monad (ComposeT t u m)
Monad (ComposeT t u m)
-> (forall a. IO a -> ComposeT t u m a) -> MonadIO (ComposeT t u m)
IO a -> ComposeT t u m a
forall a. IO a -> ComposeT t u m a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
forall (t :: (* -> *) -> * -> *) (u :: (* -> *) -> * -> *)
       (m :: * -> *).
MonadIO (t (u m)) =>
Monad (ComposeT t u m)
forall (t :: (* -> *) -> * -> *) (u :: (* -> *) -> * -> *)
       (m :: * -> *) a.
MonadIO (t (u m)) =>
IO a -> ComposeT t u m a
liftIO :: IO a -> ComposeT t u m a
$cliftIO :: forall (t :: (* -> *) -> * -> *) (u :: (* -> *) -> * -> *)
       (m :: * -> *) a.
MonadIO (t (u m)) =>
IO a -> ComposeT t u m a
$cp1MonadIO :: forall (t :: (* -> *) -> * -> *) (u :: (* -> *) -> * -> *)
       (m :: * -> *).
MonadIO (t (u m)) =>
Monad (ComposeT t u m)
MonadIO
           , Monad (ComposeT t u m)
e -> ComposeT t u m a
Monad (ComposeT t u m)
-> (forall e a. Exception e => e -> ComposeT t u m a)
-> MonadThrow (ComposeT t u m)
forall e a. Exception e => e -> ComposeT t u m a
forall (m :: * -> *).
Monad m -> (forall e a. Exception e => e -> m a) -> MonadThrow m
forall (t :: (* -> *) -> * -> *) (u :: (* -> *) -> * -> *)
       (m :: * -> *).
MonadThrow (t (u m)) =>
Monad (ComposeT t u m)
forall (t :: (* -> *) -> * -> *) (u :: (* -> *) -> * -> *)
       (m :: * -> *) e a.
(MonadThrow (t (u m)), Exception e) =>
e -> ComposeT t u m a
throwM :: e -> ComposeT t u m a
$cthrowM :: forall (t :: (* -> *) -> * -> *) (u :: (* -> *) -> * -> *)
       (m :: * -> *) e a.
(MonadThrow (t (u m)), Exception e) =>
e -> ComposeT t u m a
$cp1MonadThrow :: forall (t :: (* -> *) -> * -> *) (u :: (* -> *) -> * -> *)
       (m :: * -> *).
MonadThrow (t (u m)) =>
Monad (ComposeT t u m)
MonadThrow, MonadThrow (ComposeT t u m)
MonadThrow (ComposeT t u m)
-> (forall e a.
    Exception e =>
    ComposeT t u m a -> (e -> ComposeT t u m a) -> ComposeT t u m a)
-> MonadCatch (ComposeT t u m)
ComposeT t u m a -> (e -> ComposeT t u m a) -> ComposeT t u m a
forall e a.
Exception e =>
ComposeT t u m a -> (e -> ComposeT t u m a) -> ComposeT t u m a
forall (m :: * -> *).
MonadThrow m
-> (forall e a. Exception e => m a -> (e -> m a) -> m a)
-> MonadCatch m
forall (t :: (* -> *) -> * -> *) (u :: (* -> *) -> * -> *)
       (m :: * -> *).
MonadCatch (t (u m)) =>
MonadThrow (ComposeT t u m)
forall (t :: (* -> *) -> * -> *) (u :: (* -> *) -> * -> *)
       (m :: * -> *) e a.
(MonadCatch (t (u m)), Exception e) =>
ComposeT t u m a -> (e -> ComposeT t u m a) -> ComposeT t u m a
catch :: ComposeT t u m a -> (e -> ComposeT t u m a) -> ComposeT t u m a
$ccatch :: forall (t :: (* -> *) -> * -> *) (u :: (* -> *) -> * -> *)
       (m :: * -> *) e a.
(MonadCatch (t (u m)), Exception e) =>
ComposeT t u m a -> (e -> ComposeT t u m a) -> ComposeT t u m a
$cp1MonadCatch :: forall (t :: (* -> *) -> * -> *) (u :: (* -> *) -> * -> *)
       (m :: * -> *).
MonadCatch (t (u m)) =>
MonadThrow (ComposeT t u m)
MonadCatch, MonadCatch (ComposeT t u m)
MonadCatch (ComposeT t u m)
-> (forall b.
    ((forall a. ComposeT t u m a -> ComposeT t u m a)
     -> ComposeT t u m b)
    -> ComposeT t u m b)
-> (forall b.
    ((forall a. ComposeT t u m a -> ComposeT t u m a)
     -> ComposeT t u m b)
    -> ComposeT t u m b)
-> (forall a b c.
    ComposeT t u m a
    -> (a -> ExitCase b -> ComposeT t u m c)
    -> (a -> ComposeT t u m b)
    -> ComposeT t u m (b, c))
-> MonadMask (ComposeT t u m)
ComposeT t u m a
-> (a -> ExitCase b -> ComposeT t u m c)
-> (a -> ComposeT t u m b)
-> ComposeT t u m (b, c)
((forall a. ComposeT t u m a -> ComposeT t u m a)
 -> ComposeT t u m b)
-> ComposeT t u m b
((forall a. ComposeT t u m a -> ComposeT t u m a)
 -> ComposeT t u m b)
-> ComposeT t u m b
forall b.
((forall a. ComposeT t u m a -> ComposeT t u m a)
 -> ComposeT t u m b)
-> ComposeT t u m b
forall a b c.
ComposeT t u m a
-> (a -> ExitCase b -> ComposeT t u m c)
-> (a -> ComposeT t u m b)
-> ComposeT t u m (b, c)
forall (m :: * -> *).
MonadCatch m
-> (forall b. ((forall a. m a -> m a) -> m b) -> m b)
-> (forall b. ((forall a. m a -> m a) -> m b) -> m b)
-> (forall a b c.
    m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c))
-> MonadMask m
forall (t :: (* -> *) -> * -> *) (u :: (* -> *) -> * -> *)
       (m :: * -> *).
MonadMask (t (u m)) =>
MonadCatch (ComposeT t u m)
forall (t :: (* -> *) -> * -> *) (u :: (* -> *) -> * -> *)
       (m :: * -> *) b.
MonadMask (t (u m)) =>
((forall a. ComposeT t u m a -> ComposeT t u m a)
 -> ComposeT t u m b)
-> ComposeT t u m b
forall (t :: (* -> *) -> * -> *) (u :: (* -> *) -> * -> *)
       (m :: * -> *) a b c.
MonadMask (t (u m)) =>
ComposeT t u m a
-> (a -> ExitCase b -> ComposeT t u m c)
-> (a -> ComposeT t u m b)
-> ComposeT t u m (b, c)
generalBracket :: ComposeT t u m a
-> (a -> ExitCase b -> ComposeT t u m c)
-> (a -> ComposeT t u m b)
-> ComposeT t u m (b, c)
$cgeneralBracket :: forall (t :: (* -> *) -> * -> *) (u :: (* -> *) -> * -> *)
       (m :: * -> *) a b c.
MonadMask (t (u m)) =>
ComposeT t u m a
-> (a -> ExitCase b -> ComposeT t u m c)
-> (a -> ComposeT t u m b)
-> ComposeT t u m (b, c)
uninterruptibleMask :: ((forall a. ComposeT t u m a -> ComposeT t u m a)
 -> ComposeT t u m b)
-> ComposeT t u m b
$cuninterruptibleMask :: forall (t :: (* -> *) -> * -> *) (u :: (* -> *) -> * -> *)
       (m :: * -> *) b.
MonadMask (t (u m)) =>
((forall a. ComposeT t u m a -> ComposeT t u m a)
 -> ComposeT t u m b)
-> ComposeT t u m b
mask :: ((forall a. ComposeT t u m a -> ComposeT t u m a)
 -> ComposeT t u m b)
-> ComposeT t u m b
$cmask :: forall (t :: (* -> *) -> * -> *) (u :: (* -> *) -> * -> *)
       (m :: * -> *) b.
MonadMask (t (u m)) =>
((forall a. ComposeT t u m a -> ComposeT t u m a)
 -> ComposeT t u m b)
-> ComposeT t u m b
$cp1MonadMask :: forall (t :: (* -> *) -> * -> *) (u :: (* -> *) -> * -> *)
       (m :: * -> *).
MonadMask (t (u m)) =>
MonadCatch (ComposeT t u m)
MonadMask
           , MonadBase b, MonadBaseControl b
           , Monad (ComposeT t u m)
Monad (ComposeT t u m)
-> (forall a. Algebra' (Prims (ComposeT t u m)) (ComposeT t u m) a)
-> (forall (z :: * -> *) a.
    Monad z =>
    Reformulation'
      (Derivs (ComposeT t u m))
      (Prims (ComposeT t u m))
      (ComposeT t u m)
      z
      a)
-> (forall a.
    Algebra' (Derivs (ComposeT t u m)) (ComposeT t u m) a)
-> Carrier (ComposeT t u m)
Algebra' (Derivs (ComposeT t u m)) (ComposeT t u m) a
Algebra' (Prims (ComposeT t u m)) (ComposeT t u m) a
Reformulation'
  (Derivs (ComposeT t u m))
  (Prims (ComposeT t u m))
  (ComposeT t u m)
  z
  a
forall a. Algebra' (Derivs (ComposeT t u m)) (ComposeT t u m) a
forall a. Algebra' (Prims (ComposeT t u m)) (ComposeT t u m) a
forall (m :: * -> *).
Monad m
-> (forall a. Algebra' (Prims m) m a)
-> (forall (z :: * -> *) a.
    Monad z =>
    Reformulation' (Derivs m) (Prims m) m z a)
-> (forall a. Algebra' (Derivs m) m a)
-> Carrier m
forall (z :: * -> *) a.
Monad z =>
Reformulation'
  (Derivs (ComposeT t u m))
  (Prims (ComposeT t u m))
  (ComposeT t u m)
  z
  a
forall (t :: (* -> *) -> * -> *) (u :: (* -> *) -> * -> *)
       (m :: * -> *).
Carrier (t (u m)) =>
Monad (ComposeT t u m)
forall (t :: (* -> *) -> * -> *) (u :: (* -> *) -> * -> *)
       (m :: * -> *) a.
Carrier (t (u m)) =>
Algebra' (Derivs (ComposeT t u m)) (ComposeT t u m) a
forall (t :: (* -> *) -> * -> *) (u :: (* -> *) -> * -> *)
       (m :: * -> *) a.
Carrier (t (u m)) =>
Algebra' (Prims (ComposeT t u m)) (ComposeT t u m) a
forall (t :: (* -> *) -> * -> *) (u :: (* -> *) -> * -> *)
       (m :: * -> *) (z :: * -> *) a.
(Carrier (t (u m)), Monad z) =>
Reformulation'
  (Derivs (ComposeT t u m))
  (Prims (ComposeT t u m))
  (ComposeT t u m)
  z
  a
algDerivs :: Algebra' (Derivs (ComposeT t u m)) (ComposeT t u m) a
$calgDerivs :: forall (t :: (* -> *) -> * -> *) (u :: (* -> *) -> * -> *)
       (m :: * -> *) a.
Carrier (t (u m)) =>
Algebra' (Derivs (ComposeT t u m)) (ComposeT t u m) a
reformulate :: Reformulation'
  (Derivs (ComposeT t u m))
  (Prims (ComposeT t u m))
  (ComposeT t u m)
  z
  a
$creformulate :: forall (t :: (* -> *) -> * -> *) (u :: (* -> *) -> * -> *)
       (m :: * -> *) (z :: * -> *) a.
(Carrier (t (u m)), Monad z) =>
Reformulation'
  (Derivs (ComposeT t u m))
  (Prims (ComposeT t u m))
  (ComposeT t u m)
  z
  a
algPrims :: Algebra' (Prims (ComposeT t u m)) (ComposeT t u m) a
$calgPrims :: forall (t :: (* -> *) -> * -> *) (u :: (* -> *) -> * -> *)
       (m :: * -> *) a.
Carrier (t (u m)) =>
Algebra' (Prims (ComposeT t u m)) (ComposeT t u m) a
$cp1Carrier :: forall (t :: (* -> *) -> * -> *) (u :: (* -> *) -> * -> *)
       (m :: * -> *).
Carrier (t (u m)) =>
Monad (ComposeT t u m)
Carrier
           )

instance ( MonadTrans t
         , MonadTrans u
         , forall m. Monad m => Monad (u m)
         )
      => MonadTrans (ComposeT t u) where
  lift :: m a -> ComposeT t u m a
lift m a
m = t (u m) a -> ComposeT t u m a
forall k (t :: (* -> *) -> k -> *) (u :: (* -> *) -> * -> *)
       (m :: * -> *) (a :: k).
t (u m) a -> ComposeT t u m a
ComposeT (u m a -> t (u m) a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> u m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m a
m))
  {-# INLINEABLE lift #-}

instance ( MonadTransControl t
         , MonadTransControl u
         , forall m. Monad m => Monad (u m)
         )
      => MonadTransControl (ComposeT t u) where
  type StT (ComposeT t u) a = StT u (StT t a)

  liftWith :: (Run (ComposeT t u) -> m a) -> ComposeT t u m a
liftWith Run (ComposeT t u) -> m a
main = t (u m) a -> ComposeT t u m a
forall k (t :: (* -> *) -> k -> *) (u :: (* -> *) -> * -> *)
       (m :: * -> *) (a :: k).
t (u m) a -> ComposeT t u m a
ComposeT (t (u m) a -> ComposeT t u m a) -> t (u m) a -> ComposeT t u m a
forall a b. (a -> b) -> a -> b
$
    (Run t -> u m a) -> t (u m) a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTransControl t, Monad m) =>
(Run t -> m a) -> t m a
liftWith ((Run t -> u m a) -> t (u m) a) -> (Run t -> u m a) -> t (u m) a
forall a b. (a -> b) -> a -> b
$ \Run t
lowerT ->
    (Run u -> m a) -> u m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTransControl t, Monad m) =>
(Run t -> m a) -> t m a
liftWith ((Run u -> m a) -> u m a) -> (Run u -> m a) -> u m a
forall a b. (a -> b) -> a -> b
$ \Run u
lowerU ->
    Run (ComposeT t u) -> m a
main (u n (StT t b) -> n (StT u (StT t b))
Run u
lowerU (u n (StT t b) -> n (StT u (StT t b)))
-> (t (u n) b -> u n (StT t b)) -> t (u n) b -> n (StT u (StT t b))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t (u n) b -> u n (StT t b)
Run t
lowerT (t (u n) b -> n (StT u (StT t b)))
-> (ComposeT t u n b -> t (u n) b)
-> ComposeT t u n b
-> n (StT u (StT t b))
forall b a c. Coercible b a => (b -> c) -> (a -> b) -> a -> c
.# ComposeT t u n b -> t (u n) b
forall k (t :: (* -> *) -> k -> *) (u :: (* -> *) -> * -> *)
       (m :: * -> *) (a :: k).
ComposeT t u m a -> t (u m) a
getComposeT)
  {-# INLINEABLE liftWith #-}

  restoreT :: m (StT (ComposeT t u) a) -> ComposeT t u m a
restoreT m (StT (ComposeT t u) a)
m = t (u m) a -> ComposeT t u m a
forall k (t :: (* -> *) -> k -> *) (u :: (* -> *) -> * -> *)
       (m :: * -> *) (a :: k).
t (u m) a -> ComposeT t u m a
ComposeT (u m (StT t a) -> t (u m) a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTransControl t, Monad m) =>
m (StT t a) -> t m a
restoreT (m (StT u (StT t a)) -> u m (StT t a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTransControl t, Monad m) =>
m (StT t a) -> t m a
restoreT m (StT u (StT t a))
m (StT (ComposeT t u) a)
m))
  {-# INLINEABLE restoreT #-}

-- | Composition of a list of carrier transformers.
--
-- This is useful when you have multiple interpretations whose
-- carriers you'd like to treat as one larger object, such that
-- 'lift' lifts past all those carriers.
--
-- For example:
--
-- @
-- data Counter m a where
--   Probe :: Counter m Int
--
-- type CounterC = 'CompositionC'
--   '[ 'Control.Effect.ReinterpretSimpleC' Counter '['Control.Effect.State.State' Int]
--    , 'Control.Effect.State.StateC' Int
--    ]
--
-- runCounter :: ('Control.Effect.Carrier' m, 'Control.Effect.Threaders' '['Control.Effect.State.StateThreads'] m p)
--            => CounterC m a
--            -> m a
-- runCounter =
--    'Control.Effect.State.runState' 0
--  . 'Control.Effect.reinterpretSimple' (\case
--      Probe -> 'Control.Effect.State.state'' (\s -> (s+1,s))
--    )
--  . 'runComposition'
-- @
--
-- Then you have @'lift' :: Monad m => m a -> CounterC m a@
newtype CompositionC ts m a = CompositionC {
    CompositionC ts m a -> CompositionBaseT ts m a
unCompositionC :: CompositionBaseT ts m a
  }

#define DERIVE_COMP_M(ctx)                            \
deriving newtype instance ctx (CompositionBaseT ts m) \
                       => ctx (CompositionC ts m)

#define DERIVE_COMP_T(ctx)                          \
deriving newtype instance ctx (CompositionBaseT ts) \
                       => ctx (CompositionC ts)

DERIVE_COMP_M(Functor)
DERIVE_COMP_M(Applicative)
DERIVE_COMP_M(Monad)
DERIVE_COMP_M(Alternative)
DERIVE_COMP_M(MonadPlus)
DERIVE_COMP_M(MonadFix)
DERIVE_COMP_M(Fail.MonadFail)
DERIVE_COMP_M(MonadIO)
DERIVE_COMP_M(MonadThrow)
DERIVE_COMP_M(MonadCatch)
DERIVE_COMP_M(MonadMask)

-- Yes, this is necessary. Don't ask, I haven't got a clue.
deriving newtype instance (Monad b, MonadBase b (CompositionBaseT ts m))
                       => MonadBase b (CompositionC ts m)
DERIVE_COMP_M(MonadBaseControl b)
DERIVE_COMP_M(Carrier)

DERIVE_COMP_T(MonadTrans)
DERIVE_COMP_T(MonadTransControl)

-- KingoftheHomeless: Why a left fold? Consider:
--
--   CompositionBaseT [t, u, v] m a
-- = ComposeT (ComposeT (ComposeT IdentityT t) u) v m a
-- ~ ComposeT (ComposeT IdentityT t) u (v m) a
-- ~ ComposeT IdentityT t (u (v m)) a
-- ~ IdentityT (t (u (v m))) a
-- ~ t (u (v m)) a
--
-- Where "~" is representational equality.
--
-- In contrast, imagine if CompositionBaseT were a right fold, instead. Then we'd get:
--
--   CompositionBaseT [t, u, v] m a
-- = ComposeT t (ComposeT u (ComposeT v IdentityT)) m a
-- ~ t (ComposeT u (ComposeT v IdentityT) m) a
--
-- ... and we can't reduce this further. Why? Because t,u,v may not be representational in the monads they're transforming!
-- This matters! In fact, this library even makes use of monad transformers that aren't representational in the monad,
-- such as InterpretSimpleC.
--
-- So only with a left fold can we guarantee that the unsafeCoerce in runComposition is safe.
type family CompositionBaseT' acc ts :: (* -> *) -> * -> * where
  CompositionBaseT' acc '[] = acc
  CompositionBaseT' acc (t ': ts) = CompositionBaseT' (ComposeT acc t) ts

type CompositionBaseT ts = CompositionBaseT' IdentityT ts

type family CompositionBaseM (ts :: [(* -> *) -> * -> *]) (m :: * -> *) where
  CompositionBaseM '[] m = m
  CompositionBaseM (t ': ts) m = t (CompositionBaseM ts m)



-- | Transform @'CompositionC' [t1, t2, ..., tn] m a@ to @t1 (t2 (... (tn m) ...)) a@
runComposition :: CompositionC ts m a
               -> CompositionBaseM ts m a
-- This is a safe use of 'unsafeCoerce'; the two types are always representationally equal,
-- without even needing the transformers in ts to be representational.
-- GHC can only prove that, however, if ts is concrete. We could stick a 'Coercible' constraint,
-- but in order to prove that constraint, both ComposeT and IdentityT needs to be in scope for the
-- user.
-- This seems like too much of a hassle, so unsafeCoerce is used instead.
--
-- TODO(KingoftheHomeless): Investigate if the use of unsafeCoerce messes up optimizations.
runComposition :: CompositionC ts m a -> CompositionBaseM ts m a
runComposition = CompositionC ts m a -> CompositionBaseM ts m a
forall a b. a -> b
unsafeCoerce
{-# INLINE runComposition #-}