{-# LANGUAGE AllowAmbiguousTypes   #-}
{-# LANGUAGE CPP                  #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE MonoLocalBinds        #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE UndecidableInstances  #-}

{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# OPTIONS_HADDOCK not-home #-}

module Polysemy.Internal
  ( Sem (..)
  , Member
  , MemberWithError
  , Members
  , send
  , sendUsing
  , embed
  , run
  , runM
  , raise_
  , Raise (..)
  , raise
  , raiseUnder
  , raiseUnder2
  , raiseUnder3
  , raise2Under
  , raise3Under
  , subsume_
  , Subsume (..)
  , subsume
  , subsumeUsing
  , Embed (..)
  , usingSem
  , liftSem
  , hoistSem
  , InterpreterFor
  , (.@)
  , (.@@)
  ) where

import Control.Applicative
import Control.Monad
#if __GLASGOW_HASKELL__ < 808
import Control.Monad.Fail
#endif
import Control.Monad.Fix
import Control.Monad.IO.Class
import Data.Functor.Identity
import Data.Kind
import Polysemy.Embed.Type
import Polysemy.Fail.Type
import Polysemy.Internal.Fixpoint
import Polysemy.Internal.Kind
import Polysemy.Internal.NonDet
import Polysemy.Internal.PluginLookup
import Polysemy.Internal.Union


-- $setup
-- >>> import Data.Function
-- >>> import Polysemy.State
-- >>> import Polysemy.Error

------------------------------------------------------------------------------
-- | The 'Sem' monad handles computations of arbitrary extensible effects.
-- A value of type @Sem r@ describes a program with the capabilities of
-- @r@. For best results, @r@ should always be kept polymorphic, but you can
-- add capabilities via the 'Member' constraint.
--
-- The value of the 'Sem' monad is that it allows you to write programs
-- against a set of effects without a predefined meaning, and provide that
-- meaning later. For example, unlike with mtl, you can decide to interpret an
-- 'Polysemy.Error.Error' effect traditionally as an 'Either', or instead
-- as (a significantly faster) 'IO' 'Control.Exception.Exception'. These
-- interpretations (and others that you might add) may be used interchangeably
-- without needing to write any newtypes or 'Monad' instances. The only
-- change needed to swap interpretations is to change a call from
-- 'Polysemy.Error.runError' to 'Polysemy.Error.errorToIOFinal'.
--
-- The effect stack @r@ can contain arbitrary other monads inside of it. These
-- monads are lifted into effects via the 'Embed' effect. Monadic values can be
-- lifted into a 'Sem' via 'embed'.
--
-- Higher-order actions of another monad can be lifted into higher-order actions
-- of 'Sem' via the 'Polysemy.Final' effect, which is more powerful
-- than 'Embed', but also less flexible to interpret.
--
-- A 'Sem' can be interpreted as a pure value (via 'run') or as any
-- traditional 'Monad' (via 'runM' or 'Polysemy.runFinal').
-- Each effect @E@ comes equipped with some interpreters of the form:
--
-- @
-- runE :: 'Sem' (E ': r) a -> 'Sem' r a
-- @
--
-- which is responsible for removing the effect @E@ from the effect stack. It
-- is the order in which you call the interpreters that determines the
-- monomorphic representation of the @r@ parameter.
--
-- Order of interpreters can be important - it determines behaviour of effects
-- that manipulate state or change control flow. For example, when
-- interpreting this action:
--
-- >>> :{
--   example :: Members '[State String, Error String] r => Sem r String
--   example = do
--     put "start"
--     let throwing, catching :: Members '[State String, Error String] r => Sem r String
--         throwing = do
--           modify (++"-throw")
--           throw "error"
--           get
--         catching = do
--           modify (++"-catch")
--           get
--     catch @String throwing (\ _ -> catching)
-- :}
--
-- when handling 'Polysemy.Error.Error' first, state is preserved after error
-- occurs:
--
-- >>> :{
--   example
--     & runError
--     & fmap (either id id)
--     & evalState ""
--     & runM
--     & (print =<<)
-- :}
-- "start-throw-catch"
--
-- while handling 'Polysemy.State.State' first discards state in such cases:
--
-- >>> :{
--   example
--     & evalState ""
--     & runError
--     & fmap (either id id)
--     & runM
--     & (print =<<)
-- :}
-- "start-catch"
--
-- A good rule of thumb is to handle effects which should have \"global\"
-- behaviour over other effects later in the chain.
--
-- After all of your effects are handled, you'll be left with either
-- a @'Sem' '[] a@, a @'Sem' '[ 'Embed' m ] a@, or a @'Sem' '[ 'Polysemy.Final' m ] a@
-- value, which can be consumed respectively by 'run', 'runM', and
-- 'Polysemy.runFinal'.
--
-- ==== Examples
--
-- As an example of keeping @r@ polymorphic, we can consider the type
--
-- @
-- 'Member' ('Polysemy.State.State' String) r => 'Sem' r ()
-- @
--
-- to be a program with access to
--
-- @
-- 'Polysemy.State.get' :: 'Sem' r String
-- 'Polysemy.State.put' :: String -> 'Sem' r ()
-- @
--
-- methods.
--
-- By also adding a
--
-- @
-- 'Member' ('Polysemy.Error' Bool) r
-- @
--
-- constraint on @r@, we gain access to the
--
-- @
-- 'Polysemy.Error.throw' :: Bool -> 'Sem' r a
-- 'Polysemy.Error.catch' :: 'Sem' r a -> (Bool -> 'Sem' r a) -> 'Sem' r a
-- @
--
-- functions as well.
--
-- In this sense, a @'Member' ('Polysemy.State.State' s) r@ constraint is
-- analogous to mtl's @'Control.Monad.State.Class.MonadState' s m@ and should
-- be thought of as such. However, /unlike/ mtl, a 'Sem' monad may have
-- an arbitrary number of the same effect.
--
-- For example, we can write a 'Sem' program which can output either
-- 'Int's or 'Bool's:
--
-- @
-- foo :: ( 'Member' ('Polysemy.Output.Output' Int) r
--        , 'Member' ('Polysemy.Output.Output' Bool) r
--        )
--     => 'Sem' r ()
-- foo = do
--   'Polysemy.Output.output' @Int  5
--   'Polysemy.Output.output' True
-- @
--
-- Notice that we must use @-XTypeApplications@ to specify that we'd like to
-- use the ('Polysemy.Output.Output' 'Int') effect.
--
-- @since 0.1.2.0
newtype Sem r a = Sem
  { Sem r a
-> forall (m :: * -> *).
   Monad m =>
   (forall x. Union r (Sem r) x -> m x) -> m a
runSem
        :: ∀ m
         . Monad m
        => (∀ x. Union r (Sem r) x -> m x)
        -> m a
  }


------------------------------------------------------------------------------
-- | Due to a quirk of the GHC plugin interface, it's only easy to find
-- transitive dependencies if they define an orphan instance. This orphan
-- instance allows us to find "Polysemy.Internal" in the polysemy-plugin.
instance PluginLookup Plugin


------------------------------------------------------------------------------
-- | Makes constraints of functions that use multiple effects shorter by
-- translating single list of effects into multiple 'Member' constraints:
--
-- @
-- foo :: 'Members' \'[ 'Polysemy.Output.Output' Int
--                 , 'Polysemy.Output.Output' Bool
--                 , 'Polysemy.State' String
--                 ] r
--     => 'Sem' r ()
-- @
--
-- translates into:
--
-- @
-- foo :: ( 'Member' ('Polysemy.Output.Output' Int) r
--        , 'Member' ('Polysemy.Output.Output' Bool) r
--        , 'Member' ('Polysemy.State' String) r
--        )
--     => 'Sem' r ()
-- @
--
-- @since 0.1.2.0
type family Members es r :: Constraint where
  Members '[]       r = ()
  Members (e ': es) r = (Member e r, Members es r)


------------------------------------------------------------------------------
-- | Like 'runSem' but flipped for better ergonomics sometimes.
usingSem
    :: Monad m
    => (∀ x. Union r (Sem r) x -> m x)
    -> Sem r a
    -> m a
usingSem :: (forall x. Union r (Sem r) x -> m x) -> Sem r a -> m a
usingSem forall x. Union r (Sem r) x -> m x
k Sem r a
m = Sem r a -> (forall x. Union r (Sem r) x -> m x) -> m a
forall (r :: EffectRow) a.
Sem r a
-> forall (m :: * -> *).
   Monad m =>
   (forall x. Union r (Sem r) x -> m x) -> m a
runSem Sem r a
m forall x. Union r (Sem r) x -> m x
k
{-# INLINE usingSem #-}


instance Functor (Sem f) where
  fmap :: (a -> b) -> Sem f a -> Sem f b
fmap a -> b
f (Sem forall (m :: * -> *).
Monad m =>
(forall x. Union f (Sem f) x -> m x) -> m a
m) = (forall (m :: * -> *).
 Monad m =>
 (forall x. Union f (Sem f) x -> m x) -> m b)
-> Sem f b
forall (r :: EffectRow) a.
(forall (m :: * -> *).
 Monad m =>
 (forall x. Union r (Sem r) x -> m x) -> m a)
-> Sem r a
Sem ((forall (m :: * -> *).
  Monad m =>
  (forall x. Union f (Sem f) x -> m x) -> m b)
 -> Sem f b)
-> (forall (m :: * -> *).
    Monad m =>
    (forall x. Union f (Sem f) x -> m x) -> m b)
-> Sem f b
forall a b. (a -> b) -> a -> b
$ \forall x. Union f (Sem f) x -> m x
k -> a -> b
f (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall x. Union f (Sem f) x -> m x) -> m a
forall (m :: * -> *).
Monad m =>
(forall x. Union f (Sem f) x -> m x) -> m a
m forall x. Union f (Sem f) x -> m x
k
  {-# INLINE fmap #-}


instance Applicative (Sem f) where
  pure :: a -> Sem f a
pure a
a = (forall (m :: * -> *).
 Monad m =>
 (forall x. Union f (Sem f) x -> m x) -> m a)
-> Sem f a
forall (r :: EffectRow) a.
(forall (m :: * -> *).
 Monad m =>
 (forall x. Union r (Sem r) x -> m x) -> m a)
-> Sem r a
Sem ((forall (m :: * -> *).
  Monad m =>
  (forall x. Union f (Sem f) x -> m x) -> m a)
 -> Sem f a)
-> (forall (m :: * -> *).
    Monad m =>
    (forall x. Union f (Sem f) x -> m x) -> m a)
-> Sem f a
forall a b. (a -> b) -> a -> b
$ m a -> (Union f (Sem f) Any -> m Any) -> m a
forall a b. a -> b -> a
const (m a -> (Union f (Sem f) Any -> m Any) -> m a)
-> m a -> (Union f (Sem f) Any -> m Any) -> m a
forall a b. (a -> b) -> a -> b
$ a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a
  {-# INLINE pure #-}

  Sem forall (m :: * -> *).
Monad m =>
(forall x. Union f (Sem f) x -> m x) -> m (a -> b)
f <*> :: Sem f (a -> b) -> Sem f a -> Sem f b
<*> Sem forall (m :: * -> *).
Monad m =>
(forall x. Union f (Sem f) x -> m x) -> m a
a = (forall (m :: * -> *).
 Monad m =>
 (forall x. Union f (Sem f) x -> m x) -> m b)
-> Sem f b
forall (r :: EffectRow) a.
(forall (m :: * -> *).
 Monad m =>
 (forall x. Union r (Sem r) x -> m x) -> m a)
-> Sem r a
Sem ((forall (m :: * -> *).
  Monad m =>
  (forall x. Union f (Sem f) x -> m x) -> m b)
 -> Sem f b)
-> (forall (m :: * -> *).
    Monad m =>
    (forall x. Union f (Sem f) x -> m x) -> m b)
-> Sem f b
forall a b. (a -> b) -> a -> b
$ \forall x. Union f (Sem f) x -> m x
k -> (forall x. Union f (Sem f) x -> m x) -> m (a -> b)
forall (m :: * -> *).
Monad m =>
(forall x. Union f (Sem f) x -> m x) -> m (a -> b)
f forall x. Union f (Sem f) x -> m x
k m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall x. Union f (Sem f) x -> m x) -> m a
forall (m :: * -> *).
Monad m =>
(forall x. Union f (Sem f) x -> m x) -> m a
a forall x. Union f (Sem f) x -> m x
k
  {-# INLINE (<*>) #-}

  liftA2 :: (a -> b -> c) -> Sem f a -> Sem f b -> Sem f c
liftA2 a -> b -> c
f Sem f a
ma Sem f b
mb = (forall (m :: * -> *).
 Monad m =>
 (forall x. Union f (Sem f) x -> m x) -> m c)
-> Sem f c
forall (r :: EffectRow) a.
(forall (m :: * -> *).
 Monad m =>
 (forall x. Union r (Sem r) x -> m x) -> m a)
-> Sem r a
Sem ((forall (m :: * -> *).
  Monad m =>
  (forall x. Union f (Sem f) x -> m x) -> m c)
 -> Sem f c)
-> (forall (m :: * -> *).
    Monad m =>
    (forall x. Union f (Sem f) x -> m x) -> m c)
-> Sem f c
forall a b. (a -> b) -> a -> b
$ \forall x. Union f (Sem f) x -> m x
k -> (a -> b -> c) -> m a -> m b -> m c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> b -> c
f (Sem f a -> (forall x. Union f (Sem f) x -> m x) -> m a
forall (r :: EffectRow) a.
Sem r a
-> forall (m :: * -> *).
   Monad m =>
   (forall x. Union r (Sem r) x -> m x) -> m a
runSem Sem f a
ma forall x. Union f (Sem f) x -> m x
k) (Sem f b -> (forall x. Union f (Sem f) x -> m x) -> m b
forall (r :: EffectRow) a.
Sem r a
-> forall (m :: * -> *).
   Monad m =>
   (forall x. Union r (Sem r) x -> m x) -> m a
runSem Sem f b
mb forall x. Union f (Sem f) x -> m x
k)
  {-# INLINE liftA2 #-}

  Sem f a
ma <* :: Sem f a -> Sem f b -> Sem f a
<* Sem f b
mb = (forall (m :: * -> *).
 Monad m =>
 (forall x. Union f (Sem f) x -> m x) -> m a)
-> Sem f a
forall (r :: EffectRow) a.
(forall (m :: * -> *).
 Monad m =>
 (forall x. Union r (Sem r) x -> m x) -> m a)
-> Sem r a
Sem ((forall (m :: * -> *).
  Monad m =>
  (forall x. Union f (Sem f) x -> m x) -> m a)
 -> Sem f a)
-> (forall (m :: * -> *).
    Monad m =>
    (forall x. Union f (Sem f) x -> m x) -> m a)
-> Sem f a
forall a b. (a -> b) -> a -> b
$ \forall x. Union f (Sem f) x -> m x
k -> Sem f a -> (forall x. Union f (Sem f) x -> m x) -> m a
forall (r :: EffectRow) a.
Sem r a
-> forall (m :: * -> *).
   Monad m =>
   (forall x. Union r (Sem r) x -> m x) -> m a
runSem Sem f a
ma forall x. Union f (Sem f) x -> m x
k m a -> m b -> m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Sem f b -> (forall x. Union f (Sem f) x -> m x) -> m b
forall (r :: EffectRow) a.
Sem r a
-> forall (m :: * -> *).
   Monad m =>
   (forall x. Union r (Sem r) x -> m x) -> m a
runSem Sem f b
mb forall x. Union f (Sem f) x -> m x
k
  {-# INLINE (<*) #-}

  -- Use (>>=) because many monads are bad at optimizing (*>).
  -- Ref https://github.com/polysemy-research/polysemy/issues/368
  Sem f a
ma *> :: Sem f a -> Sem f b -> Sem f b
*> Sem f b
mb = (forall (m :: * -> *).
 Monad m =>
 (forall x. Union f (Sem f) x -> m x) -> m b)
-> Sem f b
forall (r :: EffectRow) a.
(forall (m :: * -> *).
 Monad m =>
 (forall x. Union r (Sem r) x -> m x) -> m a)
-> Sem r a
Sem ((forall (m :: * -> *).
  Monad m =>
  (forall x. Union f (Sem f) x -> m x) -> m b)
 -> Sem f b)
-> (forall (m :: * -> *).
    Monad m =>
    (forall x. Union f (Sem f) x -> m x) -> m b)
-> Sem f b
forall a b. (a -> b) -> a -> b
$ \forall x. Union f (Sem f) x -> m x
k -> Sem f a -> (forall x. Union f (Sem f) x -> m x) -> m a
forall (r :: EffectRow) a.
Sem r a
-> forall (m :: * -> *).
   Monad m =>
   (forall x. Union r (Sem r) x -> m x) -> m a
runSem Sem f a
ma forall x. Union f (Sem f) x -> m x
k m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a
_ -> Sem f b -> (forall x. Union f (Sem f) x -> m x) -> m b
forall (r :: EffectRow) a.
Sem r a
-> forall (m :: * -> *).
   Monad m =>
   (forall x. Union r (Sem r) x -> m x) -> m a
runSem Sem f b
mb forall x. Union f (Sem f) x -> m x
k
  {-# INLINE (*>) #-}

instance Monad (Sem f) where
  Sem forall (m :: * -> *).
Monad m =>
(forall x. Union f (Sem f) x -> m x) -> m a
ma >>= :: Sem f a -> (a -> Sem f b) -> Sem f b
>>= a -> Sem f b
f = (forall (m :: * -> *).
 Monad m =>
 (forall x. Union f (Sem f) x -> m x) -> m b)
-> Sem f b
forall (r :: EffectRow) a.
(forall (m :: * -> *).
 Monad m =>
 (forall x. Union r (Sem r) x -> m x) -> m a)
-> Sem r a
Sem ((forall (m :: * -> *).
  Monad m =>
  (forall x. Union f (Sem f) x -> m x) -> m b)
 -> Sem f b)
-> (forall (m :: * -> *).
    Monad m =>
    (forall x. Union f (Sem f) x -> m x) -> m b)
-> Sem f b
forall a b. (a -> b) -> a -> b
$ \forall x. Union f (Sem f) x -> m x
k -> do
    a
z <- (forall x. Union f (Sem f) x -> m x) -> m a
forall (m :: * -> *).
Monad m =>
(forall x. Union f (Sem f) x -> m x) -> m a
ma forall x. Union f (Sem f) x -> m x
k
    Sem f b -> (forall x. Union f (Sem f) x -> m x) -> m b
forall (r :: EffectRow) a.
Sem r a
-> forall (m :: * -> *).
   Monad m =>
   (forall x. Union r (Sem r) x -> m x) -> m a
runSem (a -> Sem f b
f a
z) forall x. Union f (Sem f) x -> m x
k
  {-# INLINE (>>=) #-}


instance (Member NonDet r) => Alternative (Sem r) where
  empty :: Sem r a
empty = NonDet (Sem r) a -> Sem r a
forall (e :: (* -> *) -> * -> *) (r :: EffectRow) a.
Member e r =>
e (Sem r) a -> Sem r a
send NonDet (Sem r) a
forall (m :: * -> *) a. NonDet m a
Empty
  {-# INLINE empty #-}
  Sem r a
a <|> :: Sem r a -> Sem r a -> Sem r a
<|> Sem r a
b = NonDet (Sem r) a -> Sem r a
forall (e :: (* -> *) -> * -> *) (r :: EffectRow) a.
Member e r =>
e (Sem r) a -> Sem r a
send (Sem r a -> Sem r a -> NonDet (Sem r) a
forall (m :: * -> *) a. m a -> m a -> NonDet m a
Choose Sem r a
a Sem r a
b)
  {-# INLINE (<|>) #-}

-- | @since 0.2.1.0
instance (Member NonDet r) => MonadPlus (Sem r) where
  mzero :: Sem r a
mzero = Sem r a
forall (f :: * -> *) a. Alternative f => f a
empty
  mplus :: Sem r a -> Sem r a -> Sem r a
mplus = Sem r a -> Sem r a -> Sem r a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>)

-- | @since 1.1.0.0
instance (Member Fail r) => MonadFail (Sem r) where
  fail :: String -> Sem r a
fail = Fail (Sem r) a -> Sem r a
forall (e :: (* -> *) -> * -> *) (r :: EffectRow) a.
Member e r =>
e (Sem r) a -> Sem r a
send (Fail (Sem r) a -> Sem r a)
-> (String -> Fail (Sem r) a) -> String -> Sem r a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Fail (Sem r) a
forall k k (m :: k) (a :: k). String -> Fail m a
Fail
  {-# INLINE fail #-}


------------------------------------------------------------------------------
-- | This instance will only lift 'IO' actions. If you want to lift into some
-- other 'MonadIO' type, use this instance, and handle it via the
-- 'Polysemy.IO.embedToMonadIO' interpretation.
instance Member (Embed IO) r => MonadIO (Sem r) where
  liftIO :: IO a -> Sem r a
liftIO = IO a -> Sem r a
forall (m :: * -> *) (r :: EffectRow) a.
Member (Embed m) r =>
m a -> Sem r a
embed
  {-# INLINE liftIO #-}

instance Member Fixpoint r => MonadFix (Sem r) where
  mfix :: (a -> Sem r a) -> Sem r a
mfix a -> Sem r a
f = Fixpoint (Sem r) a -> Sem r a
forall (e :: (* -> *) -> * -> *) (r :: EffectRow) a.
Member e r =>
e (Sem r) a -> Sem r a
send (Fixpoint (Sem r) a -> Sem r a) -> Fixpoint (Sem r) a -> Sem r a
forall a b. (a -> b) -> a -> b
$ (a -> Sem r a) -> Fixpoint (Sem r) a
forall a (m :: * -> *). (a -> m a) -> Fixpoint m a
Fixpoint a -> Sem r a
f
  {-# INLINE mfix #-}


liftSem :: Union r (Sem r) a -> Sem r a
liftSem :: Union r (Sem r) a -> Sem r a
liftSem Union r (Sem r) a
u = (forall (m :: * -> *).
 Monad m =>
 (forall x. Union r (Sem r) x -> m x) -> m a)
-> Sem r a
forall (r :: EffectRow) a.
(forall (m :: * -> *).
 Monad m =>
 (forall x. Union r (Sem r) x -> m x) -> m a)
-> Sem r a
Sem ((forall (m :: * -> *).
  Monad m =>
  (forall x. Union r (Sem r) x -> m x) -> m a)
 -> Sem r a)
-> (forall (m :: * -> *).
    Monad m =>
    (forall x. Union r (Sem r) x -> m x) -> m a)
-> Sem r a
forall a b. (a -> b) -> a -> b
$ \forall x. Union r (Sem r) x -> m x
k -> Union r (Sem r) a -> m a
forall x. Union r (Sem r) x -> m x
k Union r (Sem r) a
u
{-# INLINE liftSem #-}


hoistSem
    :: (∀ x. Union r (Sem r) x -> Union r' (Sem r') x)
    -> Sem r a
    -> Sem r' a
hoistSem :: (forall x. Union r (Sem r) x -> Union r' (Sem r') x)
-> Sem r a -> Sem r' a
hoistSem forall x. Union r (Sem r) x -> Union r' (Sem r') x
nat (Sem forall (m :: * -> *).
Monad m =>
(forall x. Union r (Sem r) x -> m x) -> m a
m) = (forall (m :: * -> *).
 Monad m =>
 (forall x. Union r' (Sem r') x -> m x) -> m a)
-> Sem r' a
forall (r :: EffectRow) a.
(forall (m :: * -> *).
 Monad m =>
 (forall x. Union r (Sem r) x -> m x) -> m a)
-> Sem r a
Sem ((forall (m :: * -> *).
  Monad m =>
  (forall x. Union r' (Sem r') x -> m x) -> m a)
 -> Sem r' a)
-> (forall (m :: * -> *).
    Monad m =>
    (forall x. Union r' (Sem r') x -> m x) -> m a)
-> Sem r' a
forall a b. (a -> b) -> a -> b
$ \forall x. Union r' (Sem r') x -> m x
k -> (forall x. Union r (Sem r) x -> m x) -> m a
forall (m :: * -> *).
Monad m =>
(forall x. Union r (Sem r) x -> m x) -> m a
m ((forall x. Union r (Sem r) x -> m x) -> m a)
-> (forall x. Union r (Sem r) x -> m x) -> m a
forall a b. (a -> b) -> a -> b
$ \Union r (Sem r) x
u -> Union r' (Sem r') x -> m x
forall x. Union r' (Sem r') x -> m x
k (Union r' (Sem r') x -> m x) -> Union r' (Sem r') x -> m x
forall a b. (a -> b) -> a -> b
$ Union r (Sem r) x -> Union r' (Sem r') x
forall x. Union r (Sem r) x -> Union r' (Sem r') x
nat Union r (Sem r) x
u
{-# INLINE hoistSem #-}


------------------------------------------------------------------------------
-- | Introduce an arbitrary number of effects on top of the effect stack. This
-- function is highly polymorphic, so it may be good idea to use its more
-- concrete versions (like 'raise') or type annotations to avoid vague errors
-- in ambiguous contexts.
--
-- @since 1.4.0.0
raise_ :: ∀ r r' a. Raise r r' => Sem r a -> Sem r' a
raise_ :: Sem r a -> Sem r' a
raise_ = (forall x. Union r (Sem r) x -> Union r' (Sem r') x)
-> Sem r a -> Sem r' a
forall (r :: EffectRow) (r' :: EffectRow) a.
(forall x. Union r (Sem r) x -> Union r' (Sem r') x)
-> Sem r a -> Sem r' a
hoistSem ((forall x. Union r (Sem r) x -> Union r' (Sem r') x)
 -> Sem r a -> Sem r' a)
-> (forall x. Union r (Sem r) x -> Union r' (Sem r') x)
-> Sem r a
-> Sem r' a
forall a b. (a -> b) -> a -> b
$ (forall x. Sem r x -> Sem r' x)
-> Union r' (Sem r) x -> Union r' (Sem r') x
forall (m :: * -> *) (n :: * -> *) (r :: EffectRow) a.
(forall x. m x -> n x) -> Union r m a -> Union r n a
hoist forall (r :: EffectRow) (r' :: EffectRow) a.
Raise r r' =>
Sem r a -> Sem r' a
forall x. Sem r x -> Sem r' x
raise_ (Union r' (Sem r) x -> Union r' (Sem r') x)
-> (Union r (Sem r) x -> Union r' (Sem r) x)
-> Union r (Sem r) x
-> Union r' (Sem r') x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Union r (Sem r) x -> Union r' (Sem r) x
forall (r :: EffectRow) (r' :: EffectRow) (m :: * -> *) a.
Raise r r' =>
Union r m a -> Union r' m a
raiseUnion
{-# INLINE raise_ #-}


-- | See 'raise''.
--
-- @since 1.4.0.0
class Raise (r :: EffectRow) (r' :: EffectRow) where
  raiseUnion :: Union r m a -> Union r' m a

instance {-# overlapping #-} Raise r r where
  raiseUnion :: Union r m a -> Union r m a
raiseUnion = Union r m a -> Union r m a
forall a. a -> a
id
  {-# INLINE raiseUnion #-}

instance (r' ~ (_0 ': r''), Raise r r'') => Raise r r' where
  raiseUnion :: Union r m a -> Union r' m a
raiseUnion = (\(Union ElemOf e r''
n Weaving e m a
w) -> ElemOf e (_0 : r'') -> Weaving e m a -> Union (_0 : r'') m a
forall (e :: (* -> *) -> * -> *) (r :: EffectRow) (m :: * -> *) a.
ElemOf e r -> Weaving e m a -> Union r m a
Union (ElemOf e r'' -> ElemOf e (_0 : r'')
forall a (e :: a) (r :: [a]) (e' :: a).
ElemOf e r -> ElemOf e (e' : r)
There ElemOf e r''
n) Weaving e m a
w) (Union r'' m a -> Union r' m a)
-> (Union r m a -> Union r'' m a) -> Union r m a -> Union r' m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Union r m a -> Union r'' m a
forall (r :: EffectRow) (r' :: EffectRow) (m :: * -> *) a.
Raise r r' =>
Union r m a -> Union r' m a
raiseUnion
  {-# INLINE raiseUnion #-}


------------------------------------------------------------------------------
-- | Introduce an effect into 'Sem'. Analogous to
-- 'Control.Monad.Class.Trans.lift' in the mtl ecosystem. For a variant that
-- can introduce an arbitrary number of effects, see 'raise_'.
raise :: ∀ e r a. Sem r a -> Sem (e ': r) a
raise :: Sem r a -> Sem (e : r) a
raise = Sem r a -> Sem (e : r) a
forall (r :: EffectRow) (r' :: EffectRow) a.
Raise r r' =>
Sem r a -> Sem r' a
raise_
{-# INLINE raise #-}


------------------------------------------------------------------------------
-- | Like 'raise', but introduces a new effect underneath the head of the
-- list. See 'raiseUnder2' or 'raiseUnder3' for introducing more effects. If
-- you need to introduce even more of them, check out 'subsume_'.
--
-- 'raiseUnder' can be used in order to turn transformative interpreters
-- into reinterpreters. This is especially useful if you're writing an
-- interpreter which introduces an intermediary effect, and then want to use
-- an existing interpreter on that effect.
--
-- For example, given:
--
-- @
-- fooToBar :: 'Member' Bar r => 'Sem' (Foo ': r) a -> 'Sem' r a
-- runBar   :: 'Sem' (Bar ': r) a -> 'Sem' r a
-- @
--
-- You can write:
--
-- @
-- runFoo :: 'Sem' (Foo ': r) a -> 'Sem' r a
-- runFoo =
--     runBar     -- Consume Bar
--   . fooToBar   -- Interpret Foo in terms of the new Bar
--   . 'raiseUnder' -- Introduces Bar under Foo
-- @
--
-- @since 1.2.0.0
raiseUnder :: ∀ e2 e1 r a. Sem (e1 ': r) a -> Sem (e1 ': e2 ': r) a
raiseUnder :: Sem (e1 : r) a -> Sem (e1 : e2 : r) a
raiseUnder = Sem (e1 : r) a -> Sem (e1 : e2 : r) a
forall (r :: EffectRow) (r' :: EffectRow) a.
Subsume r r' =>
Sem r a -> Sem r' a
subsume_
{-# INLINE raiseUnder #-}


------------------------------------------------------------------------------
-- | Like 'raise', but introduces two new effects underneath the head of the
-- list.
--
-- @since 1.2.0.0
raiseUnder2 :: ∀ e2 e3 e1 r a. Sem (e1 ': r) a -> Sem (e1 ': e2 ': e3 ': r) a
raiseUnder2 :: Sem (e1 : r) a -> Sem (e1 : e2 : e3 : r) a
raiseUnder2 = Sem (e1 : r) a -> Sem (e1 : e2 : e3 : r) a
forall (r :: EffectRow) (r' :: EffectRow) a.
Subsume r r' =>
Sem r a -> Sem r' a
subsume_
{-# INLINE raiseUnder2 #-}


------------------------------------------------------------------------------
-- | Like 'raise', but introduces three new effects underneath the head of the
-- list.
--
-- @since 1.2.0.0
raiseUnder3 :: ∀ e2 e3 e4 e1 r a. Sem (e1 ': r) a -> Sem (e1 ': e2 ': e3 ': e4 ': r) a
raiseUnder3 :: Sem (e1 : r) a -> Sem (e1 : e2 : e3 : e4 : r) a
raiseUnder3 = Sem (e1 : r) a -> Sem (e1 : e2 : e3 : e4 : r) a
forall (r :: EffectRow) (r' :: EffectRow) a.
Subsume r r' =>
Sem r a -> Sem r' a
subsume_
{-# INLINE raiseUnder3 #-}


------------------------------------------------------------------------------
-- | Like 'raise', but introduces an effect two levels underneath the head of
-- the list.
--
-- @since 1.4.0.0
raise2Under :: ∀ e3 e1 e2 r a. Sem (e1 : e2 : r) a -> Sem (e1 : e2 : e3 : r) a
raise2Under :: Sem (e1 : e2 : r) a -> Sem (e1 : e2 : e3 : r) a
raise2Under = (forall x.
 Union (e1 : e2 : r) (Sem (e1 : e2 : r)) x
 -> Union (e1 : e2 : e3 : r) (Sem (e1 : e2 : e3 : r)) x)
-> Sem (e1 : e2 : r) a -> Sem (e1 : e2 : e3 : r) a
forall (r :: EffectRow) (r' :: EffectRow) a.
(forall x. Union r (Sem r) x -> Union r' (Sem r') x)
-> Sem r a -> Sem r' a
hoistSem ((forall x.
  Union (e1 : e2 : r) (Sem (e1 : e2 : r)) x
  -> Union (e1 : e2 : e3 : r) (Sem (e1 : e2 : e3 : r)) x)
 -> Sem (e1 : e2 : r) a -> Sem (e1 : e2 : e3 : r) a)
-> (forall x.
    Union (e1 : e2 : r) (Sem (e1 : e2 : r)) x
    -> Union (e1 : e2 : e3 : r) (Sem (e1 : e2 : e3 : r)) x)
-> Sem (e1 : e2 : r) a
-> Sem (e1 : e2 : e3 : r) a
forall a b. (a -> b) -> a -> b
$ (forall x. Sem (e1 : e2 : r) x -> Sem (e1 : e2 : e3 : r) x)
-> Union (e1 : e2 : e3 : r) (Sem (e1 : e2 : r)) x
-> Union (e1 : e2 : e3 : r) (Sem (e1 : e2 : e3 : r)) x
forall (m :: * -> *) (n :: * -> *) (r :: EffectRow) a.
(forall x. m x -> n x) -> Union r m a -> Union r n a
hoist forall x. Sem (e1 : e2 : r) x -> Sem (e1 : e2 : e3 : r) x
forall (e3 :: (* -> *) -> * -> *) (e1 :: (* -> *) -> * -> *)
       (e2 :: (* -> *) -> * -> *) (r :: EffectRow) a.
Sem (e1 : e2 : r) a -> Sem (e1 : e2 : e3 : r) a
raise2Under (Union (e1 : e2 : e3 : r) (Sem (e1 : e2 : r)) x
 -> Union (e1 : e2 : e3 : r) (Sem (e1 : e2 : e3 : r)) x)
-> (Union (e1 : e2 : r) (Sem (e1 : e2 : r)) x
    -> Union (e1 : e2 : e3 : r) (Sem (e1 : e2 : r)) x)
-> Union (e1 : e2 : r) (Sem (e1 : e2 : r)) x
-> Union (e1 : e2 : e3 : r) (Sem (e1 : e2 : e3 : r)) x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Union (e1 : e2 : r) (Sem (e1 : e2 : r)) x
-> Union (e1 : e2 : e3 : r) (Sem (e1 : e2 : r)) x
forall (m :: * -> *) x.
Union (e1 : e2 : r) m x -> Union (e1 : e2 : e3 : r) m x
weaken2Under
  where
    weaken2Under :: ∀ m x. Union (e1 : e2 : r) m x -> Union (e1 : e2 : e3 : r) m x
    weaken2Under :: Union (e1 : e2 : r) m x -> Union (e1 : e2 : e3 : r) m x
weaken2Under (Union ElemOf e (e1 : e2 : r)
Here Weaving e m x
a) = ElemOf e (e : e2 : e3 : r)
-> Weaving e m x -> Union (e : e2 : e3 : r) m x
forall (e :: (* -> *) -> * -> *) (r :: EffectRow) (m :: * -> *) a.
ElemOf e r -> Weaving e m a -> Union r m a
Union ElemOf e (e : e2 : e3 : r)
forall a (e :: a) (r :: [a]). ElemOf e (e : r)
Here Weaving e m x
a
    weaken2Under (Union (There ElemOf e r
Here) Weaving e m x
a) = ElemOf e (e1 : e : e3 : r)
-> Weaving e m x -> Union (e1 : e : e3 : r) m x
forall (e :: (* -> *) -> * -> *) (r :: EffectRow) (m :: * -> *) a.
ElemOf e r -> Weaving e m a -> Union r m a
Union (ElemOf e (e : e3 : r) -> ElemOf e (e1 : e : e3 : r)
forall a (e :: a) (r :: [a]) (e' :: a).
ElemOf e r -> ElemOf e (e' : r)
There ElemOf e (e : e3 : r)
forall a (e :: a) (r :: [a]). ElemOf e (e : r)
Here) Weaving e m x
a
    weaken2Under (Union (There (There ElemOf e r
n)) Weaving e m x
a) = ElemOf e (e1 : e2 : e3 : r)
-> Weaving e m x -> Union (e1 : e2 : e3 : r) m x
forall (e :: (* -> *) -> * -> *) (r :: EffectRow) (m :: * -> *) a.
ElemOf e r -> Weaving e m a -> Union r m a
Union (ElemOf e (e2 : e3 : r) -> ElemOf e (e1 : e2 : e3 : r)
forall a (e :: a) (r :: [a]) (e' :: a).
ElemOf e r -> ElemOf e (e' : r)
There (ElemOf e (e3 : r) -> ElemOf e (e2 : e3 : r)
forall a (e :: a) (r :: [a]) (e' :: a).
ElemOf e r -> ElemOf e (e' : r)
There (ElemOf e r -> ElemOf e (e3 : r)
forall a (e :: a) (r :: [a]) (e' :: a).
ElemOf e r -> ElemOf e (e' : r)
There ElemOf e r
n))) Weaving e m x
a
    {-# INLINE weaken2Under #-}
{-# INLINE raise2Under #-}


------------------------------------------------------------------------------
-- | Like 'raise', but introduces an effect three levels underneath the head
-- of the list.
--
-- @since 1.4.0.0
raise3Under :: ∀ e4 e1 e2 e3 r a. Sem (e1 : e2 : e3 : r) a -> Sem (e1 : e2 : e3 : e4 : r) a
raise3Under :: Sem (e1 : e2 : e3 : r) a -> Sem (e1 : e2 : e3 : e4 : r) a
raise3Under = (forall x.
 Union (e1 : e2 : e3 : r) (Sem (e1 : e2 : e3 : r)) x
 -> Union (e1 : e2 : e3 : e4 : r) (Sem (e1 : e2 : e3 : e4 : r)) x)
-> Sem (e1 : e2 : e3 : r) a -> Sem (e1 : e2 : e3 : e4 : r) a
forall (r :: EffectRow) (r' :: EffectRow) a.
(forall x. Union r (Sem r) x -> Union r' (Sem r') x)
-> Sem r a -> Sem r' a
hoistSem ((forall x.
  Union (e1 : e2 : e3 : r) (Sem (e1 : e2 : e3 : r)) x
  -> Union (e1 : e2 : e3 : e4 : r) (Sem (e1 : e2 : e3 : e4 : r)) x)
 -> Sem (e1 : e2 : e3 : r) a -> Sem (e1 : e2 : e3 : e4 : r) a)
-> (forall x.
    Union (e1 : e2 : e3 : r) (Sem (e1 : e2 : e3 : r)) x
    -> Union (e1 : e2 : e3 : e4 : r) (Sem (e1 : e2 : e3 : e4 : r)) x)
-> Sem (e1 : e2 : e3 : r) a
-> Sem (e1 : e2 : e3 : e4 : r) a
forall a b. (a -> b) -> a -> b
$ (forall x.
 Sem (e1 : e2 : e3 : r) x -> Sem (e1 : e2 : e3 : e4 : r) x)
-> Union (e1 : e2 : e3 : e4 : r) (Sem (e1 : e2 : e3 : r)) x
-> Union (e1 : e2 : e3 : e4 : r) (Sem (e1 : e2 : e3 : e4 : r)) x
forall (m :: * -> *) (n :: * -> *) (r :: EffectRow) a.
(forall x. m x -> n x) -> Union r m a -> Union r n a
hoist forall x. Sem (e1 : e2 : e3 : r) x -> Sem (e1 : e2 : e3 : e4 : r) x
forall (e4 :: (* -> *) -> * -> *) (e1 :: (* -> *) -> * -> *)
       (e2 :: (* -> *) -> * -> *) (e3 :: (* -> *) -> * -> *)
       (r :: EffectRow) a.
Sem (e1 : e2 : e3 : r) a -> Sem (e1 : e2 : e3 : e4 : r) a
raise3Under (Union (e1 : e2 : e3 : e4 : r) (Sem (e1 : e2 : e3 : r)) x
 -> Union (e1 : e2 : e3 : e4 : r) (Sem (e1 : e2 : e3 : e4 : r)) x)
-> (Union (e1 : e2 : e3 : r) (Sem (e1 : e2 : e3 : r)) x
    -> Union (e1 : e2 : e3 : e4 : r) (Sem (e1 : e2 : e3 : r)) x)
-> Union (e1 : e2 : e3 : r) (Sem (e1 : e2 : e3 : r)) x
-> Union (e1 : e2 : e3 : e4 : r) (Sem (e1 : e2 : e3 : e4 : r)) x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Union (e1 : e2 : e3 : r) (Sem (e1 : e2 : e3 : r)) x
-> Union (e1 : e2 : e3 : e4 : r) (Sem (e1 : e2 : e3 : r)) x
forall (m :: * -> *) x.
Union (e1 : e2 : e3 : r) m x -> Union (e1 : e2 : e3 : e4 : r) m x
weaken3Under
  where
    weaken3Under :: ∀ m x. Union (e1 : e2 : e3 : r) m x -> Union (e1 : e2 : e3 : e4 : r) m x
    weaken3Under :: Union (e1 : e2 : e3 : r) m x -> Union (e1 : e2 : e3 : e4 : r) m x
weaken3Under (Union ElemOf e (e1 : e2 : e3 : r)
Here Weaving e m x
a) = ElemOf e (e : e2 : e3 : e4 : r)
-> Weaving e m x -> Union (e : e2 : e3 : e4 : r) m x
forall (e :: (* -> *) -> * -> *) (r :: EffectRow) (m :: * -> *) a.
ElemOf e r -> Weaving e m a -> Union r m a
Union ElemOf e (e : e2 : e3 : e4 : r)
forall a (e :: a) (r :: [a]). ElemOf e (e : r)
Here Weaving e m x
a
    weaken3Under (Union (There ElemOf e r
Here) Weaving e m x
a) = ElemOf e (e1 : e : e3 : e4 : r)
-> Weaving e m x -> Union (e1 : e : e3 : e4 : r) m x
forall (e :: (* -> *) -> * -> *) (r :: EffectRow) (m :: * -> *) a.
ElemOf e r -> Weaving e m a -> Union r m a
Union (ElemOf e (e : e3 : e4 : r) -> ElemOf e (e1 : e : e3 : e4 : r)
forall a (e :: a) (r :: [a]) (e' :: a).
ElemOf e r -> ElemOf e (e' : r)
There ElemOf e (e : e3 : e4 : r)
forall a (e :: a) (r :: [a]). ElemOf e (e : r)
Here) Weaving e m x
a
    weaken3Under (Union (There (There ElemOf e r
Here)) Weaving e m x
a) = ElemOf e (e1 : e2 : e : e4 : r)
-> Weaving e m x -> Union (e1 : e2 : e : e4 : r) m x
forall (e :: (* -> *) -> * -> *) (r :: EffectRow) (m :: * -> *) a.
ElemOf e r -> Weaving e m a -> Union r m a
Union (ElemOf e (e2 : e : e4 : r) -> ElemOf e (e1 : e2 : e : e4 : r)
forall a (e :: a) (r :: [a]) (e' :: a).
ElemOf e r -> ElemOf e (e' : r)
There (ElemOf e (e : e4 : r) -> ElemOf e (e2 : e : e4 : r)
forall a (e :: a) (r :: [a]) (e' :: a).
ElemOf e r -> ElemOf e (e' : r)
There ElemOf e (e : e4 : r)
forall a (e :: a) (r :: [a]). ElemOf e (e : r)
Here)) Weaving e m x
a
    weaken3Under (Union (There (There (There ElemOf e r
n))) Weaving e m x
a) = ElemOf e (e1 : e2 : e3 : e4 : r)
-> Weaving e m x -> Union (e1 : e2 : e3 : e4 : r) m x
forall (e :: (* -> *) -> * -> *) (r :: EffectRow) (m :: * -> *) a.
ElemOf e r -> Weaving e m a -> Union r m a
Union (ElemOf e (e2 : e3 : e4 : r) -> ElemOf e (e1 : e2 : e3 : e4 : r)
forall a (e :: a) (r :: [a]) (e' :: a).
ElemOf e r -> ElemOf e (e' : r)
There (ElemOf e (e3 : e4 : r) -> ElemOf e (e2 : e3 : e4 : r)
forall a (e :: a) (r :: [a]) (e' :: a).
ElemOf e r -> ElemOf e (e' : r)
There (ElemOf e (e4 : r) -> ElemOf e (e3 : e4 : r)
forall a (e :: a) (r :: [a]) (e' :: a).
ElemOf e r -> ElemOf e (e' : r)
There (ElemOf e r -> ElemOf e (e4 : r)
forall a (e :: a) (r :: [a]) (e' :: a).
ElemOf e r -> ElemOf e (e' : r)
There ElemOf e r
n)))) Weaving e m x
a
    {-# INLINE weaken3Under #-}
{-# INLINE raise3Under #-}


------------------------------------------------------------------------------
-- | Allows reordering and adding known effects on top of the effect stack, as
-- long as the polymorphic "tail" of new stack is a 'raise'-d version of the
-- original one. This function is highly polymorphic, so it may be a good idea
-- to use its more concrete version ('subsume'), fitting functions from the
-- 'raise' family or type annotations to avoid vague errors in ambiguous
-- contexts.
--
-- @since 1.4.0.0
subsume_ :: ∀ r r' a. Subsume r r' => Sem r a -> Sem r' a
subsume_ :: Sem r a -> Sem r' a
subsume_ = (forall x. Union r (Sem r) x -> Union r' (Sem r') x)
-> Sem r a -> Sem r' a
forall (r :: EffectRow) (r' :: EffectRow) a.
(forall x. Union r (Sem r) x -> Union r' (Sem r') x)
-> Sem r a -> Sem r' a
hoistSem ((forall x. Union r (Sem r) x -> Union r' (Sem r') x)
 -> Sem r a -> Sem r' a)
-> (forall x. Union r (Sem r) x -> Union r' (Sem r') x)
-> Sem r a
-> Sem r' a
forall a b. (a -> b) -> a -> b
$ (forall x. Sem r x -> Sem r' x)
-> Union r' (Sem r) x -> Union r' (Sem r') x
forall (m :: * -> *) (n :: * -> *) (r :: EffectRow) a.
(forall x. m x -> n x) -> Union r m a -> Union r n a
hoist forall (r :: EffectRow) (r' :: EffectRow) a.
Subsume r r' =>
Sem r a -> Sem r' a
forall x. Sem r x -> Sem r' x
subsume_ (Union r' (Sem r) x -> Union r' (Sem r') x)
-> (Union r (Sem r) x -> Union r' (Sem r) x)
-> Union r (Sem r) x
-> Union r' (Sem r') x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Union r (Sem r) x -> Union r' (Sem r) x
forall (r :: EffectRow) (r' :: EffectRow) (m :: * -> *) a.
Subsume r r' =>
Union r m a -> Union r' m a
subsumeUnion
{-# INLINE subsume_ #-}


-- | See 'subsume_'.
--
-- @since 1.4.0.0
class Subsume (r :: EffectRow) (r' :: EffectRow) where
  subsumeUnion :: Union r m a -> Union r' m a

instance {-# incoherent #-} Raise r r' => Subsume r r' where
  subsumeUnion :: Union r m a -> Union r' m a
subsumeUnion = Union r m a -> Union r' m a
forall (r :: EffectRow) (r' :: EffectRow) (m :: * -> *) a.
Raise r r' =>
Union r m a -> Union r' m a
raiseUnion
  {-# INLINE subsumeUnion #-}

instance (Member e r', Subsume r r') => Subsume (e ': r) r' where
  subsumeUnion :: Union (e : r) m a -> Union r' m a
subsumeUnion = (Union r m a -> Union r' m a)
-> (Weaving e m a -> Union r' m a)
-> Either (Union r m a) (Weaving e m a)
-> Union r' m a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Union r m a -> Union r' m a
forall (r :: EffectRow) (r' :: EffectRow) (m :: * -> *) a.
Subsume r r' =>
Union r m a -> Union r' m a
subsumeUnion Weaving e m a -> Union r' m a
forall (e :: (* -> *) -> * -> *) (r :: EffectRow) (m :: * -> *) a.
Member e r =>
Weaving e m a -> Union r m a
injWeaving (Either (Union r m a) (Weaving e m a) -> Union r' m a)
-> (Union (e : r) m a -> Either (Union r m a) (Weaving e m a))
-> Union (e : r) m a
-> Union r' m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Union (e : r) m a -> Either (Union r m a) (Weaving e m a)
forall (e :: (* -> *) -> * -> *) (r :: EffectRow) (m :: * -> *) a.
Union (e : r) m a -> Either (Union r m a) (Weaving e m a)
decomp
  {-# INLINE subsumeUnion #-}

instance Subsume '[] r where
  subsumeUnion :: Union '[] m a -> Union r m a
subsumeUnion = Union '[] m a -> Union r m a
forall (m :: * -> *) a b. Union '[] m a -> b
absurdU
  {-# INLINE subsumeUnion #-}


------------------------------------------------------------------------------
-- | Interprets an effect in terms of another identical effect.
--
-- This is useful for defining interpreters that use 'Polysemy.reinterpretH'
-- without immediately consuming the newly introduced effect.
-- Using such an interpreter recursively may result in duplicate effects,
-- which may then be eliminated using 'subsume'.
--
-- For a version that can introduce an arbitrary number of new effects and
-- reorder existing ones, see 'subsume_'.
--
-- @since 1.2.0.0
subsume :: ∀ e r a. Member e r => Sem (e ': r) a -> Sem r a
subsume :: Sem (e : r) a -> Sem r a
subsume = Sem (e : r) a -> Sem r a
forall (r :: EffectRow) (r' :: EffectRow) a.
Subsume r r' =>
Sem r a -> Sem r' a
subsume_
{-# INLINE subsume #-}


------------------------------------------------------------------------------
-- | Interprets an effect in terms of another identical effect, given an
-- explicit proof that the effect exists in @r@.
--
-- This is useful in conjunction with 'Polysemy.Membership.tryMembership'
-- in order to conditionally make use of effects. For example:
--
-- @
-- tryListen :: 'Polysemy.Membership.KnownRow' r => 'Sem' r a -> Maybe ('Sem' r ([Int], a))
-- tryListen m = case 'Polysemy.Membership.tryMembership' @('Polysemy.Writer.Writer' [Int]) of
--   Just pr -> Just $ 'subsumeUsing' pr ('Polysemy.Writer.listen' ('raise' m))
--   _       -> Nothing
-- @
--
-- @since 1.3.0.0
subsumeUsing :: ∀ e r a. ElemOf e r -> Sem (e ': r) a -> Sem r a
subsumeUsing :: ElemOf e r -> Sem (e : r) a -> Sem r a
subsumeUsing ElemOf e r
pr =
  let
    go :: ∀ x. Sem (e ': r) x -> Sem r x
    go :: Sem (e : r) x -> Sem r x
go = (forall x. Union (e : r) (Sem (e : r)) x -> Union r (Sem r) x)
-> Sem (e : r) x -> Sem r x
forall (r :: EffectRow) (r' :: EffectRow) a.
(forall x. Union r (Sem r) x -> Union r' (Sem r') x)
-> Sem r a -> Sem r' a
hoistSem ((forall x. Union (e : r) (Sem (e : r)) x -> Union r (Sem r) x)
 -> Sem (e : r) x -> Sem r x)
-> (forall x. Union (e : r) (Sem (e : r)) x -> Union r (Sem r) x)
-> Sem (e : r) x
-> Sem r x
forall a b. (a -> b) -> a -> b
$ \Union (e : r) (Sem (e : r)) x
u -> (forall x. Sem (e : r) x -> Sem r x)
-> Union r (Sem (e : r)) x -> Union r (Sem r) x
forall (m :: * -> *) (n :: * -> *) (r :: EffectRow) a.
(forall x. m x -> n x) -> Union r m a -> Union r n a
hoist forall x. Sem (e : r) x -> Sem r x
go (Union r (Sem (e : r)) x -> Union r (Sem r) x)
-> Union r (Sem (e : r)) x -> Union r (Sem r) x
forall a b. (a -> b) -> a -> b
$ case Union (e : r) (Sem (e : r)) x
-> Either (Union r (Sem (e : r)) x) (Weaving e (Sem (e : r)) x)
forall (e :: (* -> *) -> * -> *) (r :: EffectRow) (m :: * -> *) a.
Union (e : r) m a -> Either (Union r m a) (Weaving e m a)
decomp Union (e : r) (Sem (e : r)) x
u of
      Right Weaving e (Sem (e : r)) x
w -> ElemOf e r -> Weaving e (Sem (e : r)) x -> Union r (Sem (e : r)) x
forall (e :: (* -> *) -> * -> *) (r :: EffectRow) (m :: * -> *) a.
ElemOf e r -> Weaving e m a -> Union r m a
Union ElemOf e r
pr Weaving e (Sem (e : r)) x
w
      Left  Union r (Sem (e : r)) x
g -> Union r (Sem (e : r)) x
g
    {-# INLINE go #-}
  in
    Sem (e : r) a -> Sem r a
forall x. Sem (e : r) x -> Sem r x
go
{-# INLINE subsumeUsing #-}


------------------------------------------------------------------------------
-- | Embed an effect into a 'Sem'. This is used primarily via
-- 'Polysemy.makeSem' to implement smart constructors.
send :: Member e r => e (Sem r) a -> Sem r a
send :: e (Sem r) a -> Sem r a
send = Union r (Sem r) a -> Sem r a
forall (r :: EffectRow) a. Union r (Sem r) a -> Sem r a
liftSem (Union r (Sem r) a -> Sem r a)
-> (e (Sem r) a -> Union r (Sem r) a) -> e (Sem r) a -> Sem r a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e (Sem r) a -> Union r (Sem r) a
forall (e :: (* -> *) -> * -> *) (r :: EffectRow)
       (rInitial :: EffectRow) a.
Member e r =>
e (Sem rInitial) a -> Union r (Sem rInitial) a
inj
{-# INLINE[3] send #-}


------------------------------------------------------------------------------
-- | Embed an effect into a 'Sem', given an explicit proof
-- that the effect exists in @r@.
--
-- This is useful in conjunction with 'Polysemy.Membership.tryMembership',
-- in order to conditionally make use of effects.
sendUsing :: ElemOf e r -> e (Sem r) a -> Sem r a
sendUsing :: ElemOf e r -> e (Sem r) a -> Sem r a
sendUsing ElemOf e r
pr = Union r (Sem r) a -> Sem r a
forall (r :: EffectRow) a. Union r (Sem r) a -> Sem r a
liftSem (Union r (Sem r) a -> Sem r a)
-> (e (Sem r) a -> Union r (Sem r) a) -> e (Sem r) a -> Sem r a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ElemOf e r -> e (Sem r) a -> Union r (Sem r) a
forall (e :: (* -> *) -> * -> *) (r :: EffectRow)
       (rInitial :: EffectRow) a.
ElemOf e r -> e (Sem rInitial) a -> Union r (Sem rInitial) a
injUsing ElemOf e r
pr
{-# INLINE[3] sendUsing #-}


------------------------------------------------------------------------------
-- | Embed a monadic action @m@ in 'Sem'.
--
-- @since 1.0.0.0
embed :: Member (Embed m) r => m a -> Sem r a
embed :: m a -> Sem r a
embed = Embed m (Sem r) a -> Sem r a
forall (e :: (* -> *) -> * -> *) (r :: EffectRow) a.
Member e r =>
e (Sem r) a -> Sem r a
send (Embed m (Sem r) a -> Sem r a)
-> (m a -> Embed m (Sem r) a) -> m a -> Sem r a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> Embed m (Sem r) a
forall (m :: * -> *) a (z :: * -> *). m a -> Embed m z a
Embed
{-# INLINE embed #-}


------------------------------------------------------------------------------
-- | Run a 'Sem' containing no effects as a pure value.
run :: Sem '[] a -> a
run :: Sem '[] a -> a
run (Sem forall (m :: * -> *).
Monad m =>
(forall x. Union '[] (Sem '[]) x -> m x) -> m a
m) = Identity a -> a
forall a. Identity a -> a
runIdentity (Identity a -> a) -> Identity a -> a
forall a b. (a -> b) -> a -> b
$ (forall x. Union '[] (Sem '[]) x -> Identity x) -> Identity a
forall (m :: * -> *).
Monad m =>
(forall x. Union '[] (Sem '[]) x -> m x) -> m a
m forall x. Union '[] (Sem '[]) x -> Identity x
forall (m :: * -> *) a b. Union '[] m a -> b
absurdU
{-# INLINE run #-}


------------------------------------------------------------------------------
-- | Lower a 'Sem' containing only a single lifted 'Monad' into that
-- monad.
runM :: Monad m => Sem '[Embed m] a -> m a
runM :: Sem '[Embed m] a -> m a
runM (Sem forall (m :: * -> *).
Monad m =>
(forall x. Union '[Embed m] (Sem '[Embed m]) x -> m x) -> m a
m) = (forall x. Union '[Embed m] (Sem '[Embed m]) x -> m x) -> m a
forall (m :: * -> *).
Monad m =>
(forall x. Union '[Embed m] (Sem '[Embed m]) x -> m x) -> m a
m ((forall x. Union '[Embed m] (Sem '[Embed m]) x -> m x) -> m a)
-> (forall x. Union '[Embed m] (Sem '[Embed m]) x -> m x) -> m a
forall a b. (a -> b) -> a -> b
$ \Union '[Embed m] (Sem '[Embed m]) x
z ->
  case Union '[Embed m] (Sem '[Embed m]) x
-> Weaving (Embed m) (Sem '[Embed m]) x
forall (e :: (* -> *) -> * -> *) (m :: * -> *) a.
Union '[e] m a -> Weaving e m a
extract Union '[Embed m] (Sem '[Embed m]) x
z of
    Weaving Embed m (Sem rInitial) a
e f ()
s forall x. f (Sem rInitial x) -> Sem '[Embed m] (f x)
_ f a -> x
f forall x. f x -> Maybe x
_ -> do
      a
a <- Embed m (Sem rInitial) a -> m a
forall (m :: * -> *) (z :: * -> *) a. Embed m z a -> m a
unEmbed Embed m (Sem rInitial) a
e
      x -> m x
forall (f :: * -> *) a. Applicative f => a -> f a
pure (x -> m x) -> x -> m x
forall a b. (a -> b) -> a -> b
$ f a -> x
f (f a -> x) -> f a -> x
forall a b. (a -> b) -> a -> b
$ a
a a -> f () -> f a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ f ()
s
{-# INLINE runM #-}


------------------------------------------------------------------------------
-- | Type synonym for interpreters that consume an effect without changing the
-- return value. Offered for user convenience.
--
-- @r@ Is kept polymorphic so it's possible to place constraints upon it:
--
-- @
-- teletypeToIO :: 'Member' (Embed IO) r
--              => 'InterpreterFor' Teletype r
-- @
type InterpreterFor e r = ∀ a. Sem (e ': r) a -> Sem r a


------------------------------------------------------------------------------
-- | Some interpreters need to be able to lower down to the base monad (often
-- 'IO') in order to function properly --- some good examples of this are
-- 'Polysemy.Error.lowerError' and 'Polysemy.Resource.lowerResource'.
--
-- However, these interpreters don't compose particularly nicely; for example,
-- to run 'Polysemy.Resource.lowerResource', you must write:
--
-- @
-- runM . lowerError runM
-- @
--
-- Notice that 'runM' is duplicated in two places here. The situation gets
-- exponentially worse the more intepreters you have that need to run in this
-- pattern.
--
-- Instead, '.@' performs the composition we'd like. The above can be written as
--
-- @
-- (runM .@ lowerError)
-- @
--
-- The parentheses here are important; without them you'll run into operator
-- precedence errors.
--
-- __Warning:__ This combinator will __duplicate work__ that is intended to be
-- just for initialization. This can result in rather surprising behavior. For
-- a version of '.@' that won't duplicate work, see the @.\@!@ operator in
-- <http://hackage.haskell.org/package/polysemy-zoo/docs/Polysemy-IdempotentLowering.html polysemy-zoo>.
--
-- Interpreters using 'Polysemy.Final' may be composed normally, and
-- avoid the work duplication issue. For that reason, you're encouraged to use
-- @-'Polysemy.Final'@ interpreters instead of @lower-@ interpreters whenever
-- possible.
(.@)
    :: Monad m
    => (∀ x. Sem r x -> m x)
       -- ^ The lowering function, likely 'runM'.
    -> (∀ y. (∀ x. Sem r x -> m x)
          -> Sem (e ': r) y
          -> Sem r y)
    -> Sem (e ': r) z
    -> m z
forall x. Sem r x -> m x
f .@ :: (forall x. Sem r x -> m x)
-> (forall y.
    (forall x. Sem r x -> m x) -> Sem (e : r) y -> Sem r y)
-> Sem (e : r) z
-> m z
.@ forall y. (forall x. Sem r x -> m x) -> Sem (e : r) y -> Sem r y
g = Sem r z -> m z
forall x. Sem r x -> m x
f (Sem r z -> m z)
-> (Sem (e : r) z -> Sem r z) -> Sem (e : r) z -> m z
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall x. Sem r x -> m x) -> Sem (e : r) z -> Sem r z
forall y. (forall x. Sem r x -> m x) -> Sem (e : r) y -> Sem r y
g forall x. Sem r x -> m x
f
infixl 8 .@


------------------------------------------------------------------------------
-- | Like '.@', but for interpreters which change the resulting type --- eg.
-- 'Polysemy.Error.lowerError'.
(.@@)
    :: Monad m
    => (∀ x. Sem r x -> m x)
       -- ^ The lowering function, likely 'runM'.
    -> (∀ y. (∀ x. Sem r x -> m x)
          -> Sem (e ': r) y
          -> Sem r (f y))
    -> Sem (e ': r) z
    -> m (f z)
forall x. Sem r x -> m x
f .@@ :: (forall x. Sem r x -> m x)
-> (forall y.
    (forall x. Sem r x -> m x) -> Sem (e : r) y -> Sem r (f y))
-> Sem (e : r) z
-> m (f z)
.@@ forall y.
(forall x. Sem r x -> m x) -> Sem (e : r) y -> Sem r (f y)
g = Sem r (f z) -> m (f z)
forall x. Sem r x -> m x
f (Sem r (f z) -> m (f z))
-> (Sem (e : r) z -> Sem r (f z)) -> Sem (e : r) z -> m (f z)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall x. Sem r x -> m x) -> Sem (e : r) z -> Sem r (f z)
forall y.
(forall x. Sem r x -> m x) -> Sem (e : r) y -> Sem r (f y)
g forall x. Sem r x -> m x
f
infixl 8 .@@