{-# LANGUAGE CPP #-}
{-# OPTIONS_GHC -Wno-orphans #-}
{-# OPTIONS_HADDOCK not-home #-}
-- | The 'Eff' monad.
--
-- This module is intended for internal use only, and may change without warning
-- in subsequent releases.
module Effectful.Internal.Monad
  ( -- * The 'Eff' monad
    Eff
  , runPureEff

  -- ** Access to the internal representation
  , unEff
  , unsafeEff
  , unsafeEff_

  -- * NonDet
  , NonDet(..)

  -- * Fail
  , Fail(..)

  -- * IO
  , IOE
  , runEff

  -- * Prim
  , Prim
  , PrimStateEff
  , runPrim

  -- * Lifting
  , raise
  , raiseWith
  , subsume
  , inject
  , Subset

  -- * Unlifting
  , UnliftStrategy(..)
  , Persistence(..)
  , Limit(..)
  , unliftStrategy
  , withUnliftStrategy
  , withSeqEffToIO
  , withEffToIO
  , reallyUnsafeLiftMapIO
  , reallyUnsafeUnliftIO

  -- ** Low-level unlifts
  , seqUnliftIO
  , seqForkUnliftIO
  , concUnliftIO
  , seqForkUnliftsIO
  , concUnliftsIO

  -- * Dispatch

  -- ** Dynamic dispatch
  , EffectHandler
  , LocalEnv
  , unwrapLocalEnv
  , requireMatchingStorages
  , Handler(..)
  , HandlerImpl(..)
  , relinkHandler
  , runHandler
  , send

  -- ** Static dispatch
  , StaticRep
  , MaybeIOE
  , runStaticRep
  , evalStaticRep
  , execStaticRep
  , getStaticRep
  , putStaticRep
  , stateStaticRep
  , stateStaticRepM
  , localStaticRep
  ) where

import Control.Applicative
import Control.Concurrent (myThreadId)
import Control.Exception qualified as E
import Control.Monad
import Control.Monad.Base
import Control.Monad.Catch qualified as C
import Control.Monad.Fix
import Control.Monad.IO.Class
import Control.Monad.IO.Unlift
import Control.Monad.Primitive
import Control.Monad.Trans.Control
import Data.Kind (Constraint)
import GHC.Exts (oneShot)
import GHC.IO (IO(..))
import GHC.Stack
import System.IO.Unsafe (unsafeDupablePerformIO)
import Unsafe.Coerce (unsafeCoerce)

import Effectful.Internal.Effect
import Effectful.Internal.Env
import Effectful.Internal.Unlift
import Effectful.Internal.Utils

type role Eff nominal representational

-- | The 'Eff' monad provides the implementation of a computation that performs
-- an arbitrary set of effects. In @'Eff' es a@, @es@ is a type-level list that
-- contains all the effects that the computation may perform. For example, a
-- computation that produces an 'Integer' by consuming a 'String' from the
-- global environment and acting upon a single mutable value of type 'Bool'
-- would have the following type:
--
-- @
-- ('Effectful.Reader.Static.Reader' 'String' ':>' es, 'Effectful.State.Static.Local.State' 'Bool' ':>' es) => 'Eff' es 'Integer'
-- @
--
-- Abstracting over the list of effects with '(:>)':
--
-- - Allows the computation to be used in functions that may perform other
-- effects.
--
-- - Allows the effects to be handled in any order.
newtype Eff (es :: [Effect]) a = Eff (Env es -> IO a)
  deriving newtype (Semigroup (Eff es a)
Eff es a
Semigroup (Eff es a) =>
Eff es a
-> (Eff es a -> Eff es a -> Eff es a)
-> ([Eff es a] -> Eff es a)
-> Monoid (Eff es a)
[Eff es a] -> Eff es a
Eff es a -> Eff es a -> Eff es a
forall (es :: [Effect]) a. Monoid a => Semigroup (Eff es a)
forall (es :: [Effect]) a. Monoid a => Eff es a
forall (es :: [Effect]) a. Monoid a => [Eff es a] -> Eff es a
forall (es :: [Effect]) a.
Monoid a =>
Eff es a -> Eff es a -> Eff es a
forall a.
Semigroup a =>
a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
$cmempty :: forall (es :: [Effect]) a. Monoid a => Eff es a
mempty :: Eff es a
$cmappend :: forall (es :: [Effect]) a.
Monoid a =>
Eff es a -> Eff es a -> Eff es a
mappend :: Eff es a -> Eff es a -> Eff es a
$cmconcat :: forall (es :: [Effect]) a. Monoid a => [Eff es a] -> Eff es a
mconcat :: [Eff es a] -> Eff es a
Monoid, NonEmpty (Eff es a) -> Eff es a
Eff es a -> Eff es a -> Eff es a
(Eff es a -> Eff es a -> Eff es a)
-> (NonEmpty (Eff es a) -> Eff es a)
-> (forall b. Integral b => b -> Eff es a -> Eff es a)
-> Semigroup (Eff es a)
forall (es :: [Effect]) a.
Semigroup a =>
NonEmpty (Eff es a) -> Eff es a
forall (es :: [Effect]) a.
Semigroup a =>
Eff es a -> Eff es a -> Eff es a
forall (es :: [Effect]) a b.
(Semigroup a, Integral b) =>
b -> Eff es a -> Eff es a
forall b. Integral b => b -> Eff es a -> Eff es a
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
$c<> :: forall (es :: [Effect]) a.
Semigroup a =>
Eff es a -> Eff es a -> Eff es a
<> :: Eff es a -> Eff es a -> Eff es a
$csconcat :: forall (es :: [Effect]) a.
Semigroup a =>
NonEmpty (Eff es a) -> Eff es a
sconcat :: NonEmpty (Eff es a) -> Eff es a
$cstimes :: forall (es :: [Effect]) a b.
(Semigroup a, Integral b) =>
b -> Eff es a -> Eff es a
stimes :: forall b. Integral b => b -> Eff es a -> Eff es a
Semigroup)

-- | Run a pure 'Eff' computation.
--
-- For running computations with side effects see 'runEff'.
runPureEff :: HasCallStack => Eff '[] a -> a
runPureEff :: forall a. HasCallStack => Eff '[] a -> a
runPureEff (Eff Env '[] -> IO a
m) =
  -- unsafeDupablePerformIO is safe here since IOE was not on the stack, so no
  -- IO with side effects was performed (unless someone sneakily introduced side
  -- effects with unsafeEff, but then all bets are off).
  --
  -- Moreover, internals don't allocate any resources that require explicit
  -- cleanup actions to run.
  IO a -> a
forall a. IO a -> a
unsafeDupablePerformIO (IO a -> a) -> IO a -> a
forall a b. (a -> b) -> a -> b
$ Env '[] -> IO a
m (Env '[] -> IO a) -> IO (Env '[]) -> IO a
forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO (Env '[])
HasCallStack => IO (Env '[])
emptyEnv

----------------------------------------
-- Access to the internal representation

-- | Peel off the constructor of 'Eff'.
unEff :: Eff es a -> Env es -> IO a
unEff :: forall (es :: [Effect]) a. Eff es a -> Env es -> IO a
unEff (Eff Env es -> IO a
m) = Env es -> IO a
m

-- | Access the underlying 'IO' monad along with the environment.
--
-- This function is __unsafe__ because it can be used to introduce arbitrary
-- 'IO' actions into pure 'Eff' computations.
unsafeEff :: (Env es -> IO a) -> Eff es a
unsafeEff :: forall (es :: [Effect]) a. (Env es -> IO a) -> Eff es a
unsafeEff Env es -> IO a
m = (Env es -> IO a) -> Eff es a
forall (es :: [Effect]) a. (Env es -> IO a) -> Eff es a
Eff ((Env es -> IO a) -> Env es -> IO a
forall a b. (a -> b) -> a -> b
oneShot Env es -> IO a
m)

-- | Access the underlying 'IO' monad.
--
-- This function is __unsafe__ because it can be used to introduce arbitrary
-- 'IO' actions into pure 'Eff' computations.
unsafeEff_ :: IO a -> Eff es a
unsafeEff_ :: forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ IO a
m = (Env es -> IO a) -> Eff es a
forall (es :: [Effect]) a. (Env es -> IO a) -> Eff es a
unsafeEff ((Env es -> IO a) -> Eff es a) -> (Env es -> IO a) -> Eff es a
forall a b. (a -> b) -> a -> b
$ \Env es
_ -> IO a
m

----------------------------------------
-- Unlifting IO

-- | Get the current 'UnliftStrategy'.
--
-- /Note:/ this strategy is implicitly used by the 'MonadUnliftIO' and
-- 'MonadBaseControl' instance for 'Eff'.
unliftStrategy :: (HasCallStack, IOE :> es) => Eff es UnliftStrategy
unliftStrategy :: forall (es :: [Effect]).
(HasCallStack, IOE :> es) =>
Eff es UnliftStrategy
unliftStrategy = do
  IOE UnliftStrategy
unlift <- Eff es (StaticRep IOE)
forall (e :: Effect) (sideEffects :: SideEffects) (es :: [Effect]).
(HasCallStack, DispatchOf e ~ 'Static sideEffects, e :> es) =>
Eff es (StaticRep e)
getStaticRep
  UnliftStrategy -> Eff es UnliftStrategy
forall a. a -> Eff es a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure UnliftStrategy
unlift

-- | Locally override the current 'UnliftStrategy' with the given value.
withUnliftStrategy :: (HasCallStack, IOE :> es) => UnliftStrategy -> Eff es a -> Eff es a
withUnliftStrategy :: forall (es :: [Effect]) a.
(HasCallStack, IOE :> es) =>
UnliftStrategy -> Eff es a -> Eff es a
withUnliftStrategy UnliftStrategy
unlift = (StaticRep IOE -> StaticRep IOE) -> Eff es a -> Eff es a
forall (e :: Effect) (sideEffects :: SideEffects) (es :: [Effect])
       a.
(HasCallStack, DispatchOf e ~ 'Static sideEffects, e :> es) =>
(StaticRep e -> StaticRep e) -> Eff es a -> Eff es a
localStaticRep ((StaticRep IOE -> StaticRep IOE) -> Eff es a -> Eff es a)
-> (StaticRep IOE -> StaticRep IOE) -> Eff es a -> Eff es a
forall a b. (a -> b) -> a -> b
$ \StaticRep IOE
_ -> UnliftStrategy -> StaticRep IOE
IOE UnliftStrategy
unlift

-- | Create an unlifting function with the 'SeqUnlift' strategy. For the general
-- version see 'withEffToIO'.
--
-- /Note:/ usage of this function is preferrable to 'Effectful.withRunInIO'
-- because of explicit unlifting strategy and better error reporting.
--
-- @since 2.2.2.0
withSeqEffToIO
  :: (HasCallStack, IOE :> es)
  => ((forall r. Eff es r -> IO r) -> IO a)
  -- ^ Continuation with the unlifting function in scope.
  -> Eff es a
withSeqEffToIO :: forall (es :: [Effect]) a.
(HasCallStack, IOE :> es) =>
((forall r. Eff es r -> IO r) -> IO a) -> Eff es a
withSeqEffToIO (forall r. Eff es r -> IO r) -> IO a
k = (Env es -> IO a) -> Eff es a
forall (es :: [Effect]) a. (Env es -> IO a) -> Eff es a
unsafeEff ((Env es -> IO a) -> Eff es a) -> (Env es -> IO a) -> Eff es a
forall a b. (a -> b) -> a -> b
$ \Env es
es -> Env es -> ((forall r. Eff es r -> IO r) -> IO a) -> IO a
forall (es :: [Effect]) a.
HasCallStack =>
Env es -> ((forall r. Eff es r -> IO r) -> IO a) -> IO a
seqUnliftIO Env es
es (forall r. Eff es r -> IO r) -> IO a
k
{-# INLINE withSeqEffToIO #-}

-- | Create an unlifting function with the given strategy.
--
-- /Note:/ usage of this function is preferrable to 'Effectful.withRunInIO'
-- because of explicit unlifting strategy and better error reporting.
withEffToIO
  :: (HasCallStack, IOE :> es)
  => UnliftStrategy
  -> ((forall r. Eff es r -> IO r) -> IO a)
  -- ^ Continuation with the unlifting function in scope.
  -> Eff es a
withEffToIO :: forall (es :: [Effect]) a.
(HasCallStack, IOE :> es) =>
UnliftStrategy
-> ((forall r. Eff es r -> IO r) -> IO a) -> Eff es a
withEffToIO UnliftStrategy
strategy (forall r. Eff es r -> IO r) -> IO a
k = case UnliftStrategy
strategy of
  UnliftStrategy
SeqUnlift      -> (Env es -> IO a) -> Eff es a
forall (es :: [Effect]) a. (Env es -> IO a) -> Eff es a
unsafeEff ((Env es -> IO a) -> Eff es a) -> (Env es -> IO a) -> Eff es a
forall a b. (a -> b) -> a -> b
$ \Env es
es -> Env es -> ((forall r. Eff es r -> IO r) -> IO a) -> IO a
forall (es :: [Effect]) a.
HasCallStack =>
Env es -> ((forall r. Eff es r -> IO r) -> IO a) -> IO a
seqUnliftIO Env es
es (forall r. Eff es r -> IO r) -> IO a
k
  UnliftStrategy
SeqForkUnlift  -> (Env es -> IO a) -> Eff es a
forall (es :: [Effect]) a. (Env es -> IO a) -> Eff es a
unsafeEff ((Env es -> IO a) -> Eff es a) -> (Env es -> IO a) -> Eff es a
forall a b. (a -> b) -> a -> b
$ \Env es
es -> Env es -> ((forall r. Eff es r -> IO r) -> IO a) -> IO a
forall (es :: [Effect]) a.
HasCallStack =>
Env es -> ((forall r. Eff es r -> IO r) -> IO a) -> IO a
seqForkUnliftIO Env es
es (forall r. Eff es r -> IO r) -> IO a
k
  ConcUnlift Persistence
p Limit
b -> (Env es -> IO a) -> Eff es a
forall (es :: [Effect]) a. (Env es -> IO a) -> Eff es a
unsafeEff ((Env es -> IO a) -> Eff es a) -> (Env es -> IO a) -> Eff es a
forall a b. (a -> b) -> a -> b
$ \Env es
es -> Env es
-> Persistence
-> Limit
-> ((forall r. Eff es r -> IO r) -> IO a)
-> IO a
forall (es :: [Effect]) a.
HasCallStack =>
Env es
-> Persistence
-> Limit
-> ((forall r. Eff es r -> IO r) -> IO a)
-> IO a
concUnliftIO Env es
es Persistence
p Limit
b (forall r. Eff es r -> IO r) -> IO a
k
{-# INLINE withEffToIO #-}

-- | Create an unlifting function with the 'SeqUnlift' strategy.
seqUnliftIO
  :: HasCallStack
  => Env es
  -- ^ The environment.
  -> ((forall r. Eff es r -> IO r) -> IO a)
  -- ^ Continuation with the unlifting function in scope.
  -> IO a
seqUnliftIO :: forall (es :: [Effect]) a.
HasCallStack =>
Env es -> ((forall r. Eff es r -> IO r) -> IO a) -> IO a
seqUnliftIO Env es
es (forall r. Eff es r -> IO r) -> IO a
k = do
  ThreadId
tid0 <- IO ThreadId
myThreadId
  (forall r. Eff es r -> IO r) -> IO a
k ((forall r. Eff es r -> IO r) -> IO a)
-> (forall r. Eff es r -> IO r) -> IO a
forall a b. (a -> b) -> a -> b
$ \Eff es r
m -> do
    ThreadId
tid <- IO ThreadId
myThreadId
    if ThreadId
tid ThreadId -> ThreadId -> Bool
forall a. Eq a => a -> a -> Bool
== ThreadId
tid0
      then Eff es r -> Env es -> IO r
forall (es :: [Effect]) a. Eff es a -> Env es -> IO a
unEff Eff es r
m Env es
es
      else [Char] -> IO r
forall a. HasCallStack => [Char] -> a
error
         ([Char] -> IO r) -> [Char] -> IO r
forall a b. (a -> b) -> a -> b
$ [Char]
"If you want to use the unlifting function to run Eff computations "
        [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"in multiple threads, have a look at UnliftStrategy (ConcUnlift)."

-- | Create an unlifting function with the 'SeqForkUnlift' strategy.
seqForkUnliftIO
  :: HasCallStack
  => Env es
  -- ^ The environment.
  -> ((forall r. Eff es r -> IO r) -> IO a)
  -- ^ Continuation with the unlifting function in scope.
  -> IO a
seqForkUnliftIO :: forall (es :: [Effect]) a.
HasCallStack =>
Env es -> ((forall r. Eff es r -> IO r) -> IO a) -> IO a
seqForkUnliftIO Env es
es0 (forall r. Eff es r -> IO r) -> IO a
k = Env es -> IO (Env es)
forall (es :: [Effect]). HasCallStack => Env es -> IO (Env es)
cloneEnv Env es
es0 IO (Env es) -> (Env es -> IO a) -> IO a
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Env es
es -> Env es -> ((forall r. Eff es r -> IO r) -> IO a) -> IO a
forall (es :: [Effect]) a.
HasCallStack =>
Env es -> ((forall r. Eff es r -> IO r) -> IO a) -> IO a
seqUnliftIO Env es
es (forall r. Eff es r -> IO r) -> IO a
k
{-# INLINE seqForkUnliftIO #-}

-- | Create an unlifting function with the 'ConcUnlift' strategy.
concUnliftIO
  :: HasCallStack
  => Env es
  -- ^ The environment.
  -> Persistence
  -> Limit
  -> ((forall r. Eff es r -> IO r) -> IO a)
  -- ^ Continuation with the unlifting function in scope.
  -> IO a
concUnliftIO :: forall (es :: [Effect]) a.
HasCallStack =>
Env es
-> Persistence
-> Limit
-> ((forall r. Eff es r -> IO r) -> IO a)
-> IO a
concUnliftIO Env es
es Persistence
Ephemeral (Limited Int
uses) (forall r. Eff es r -> IO r) -> IO a
k = Env es -> Int -> ((forall r. Eff es r -> IO r) -> IO a) -> IO a
forall (effEs :: Type -> Type) (es :: [Effect]) a.
(HasCallStack, forall r. Coercible (effEs r) (Env es -> IO r)) =>
Env es -> Int -> ((forall r. effEs r -> IO r) -> IO a) -> IO a
ephemeralConcLimitedUnlift Env es
es Int
uses (forall r. Eff es r -> IO r) -> IO a
k
concUnliftIO Env es
es Persistence
Ephemeral Limit
Unlimited (forall r. Eff es r -> IO r) -> IO a
k = Env es -> ((forall r. Eff es r -> IO r) -> IO a) -> IO a
forall (effEs :: Type -> Type) (es :: [Effect]) a.
(HasCallStack, forall r. Coercible (effEs r) (Env es -> IO r)) =>
Env es -> ((forall r. effEs r -> IO r) -> IO a) -> IO a
ephemeralConcUnlimitedUnlift Env es
es (forall r. Eff es r -> IO r) -> IO a
k
concUnliftIO Env es
es Persistence
Persistent (Limited Int
threads) (forall r. Eff es r -> IO r) -> IO a
k =
  if Int
threads Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1
  then Env es -> ((forall r. Eff es r -> IO r) -> IO a) -> IO a
forall (effEs :: Type -> Type) (es :: [Effect]) a.
(HasCallStack, forall r. Coercible (effEs r) (Env es -> IO r)) =>
Env es -> ((forall r. effEs r -> IO r) -> IO a) -> IO a
persistentConcSingleUnlift Env es
es (forall r. Eff es r -> IO r) -> IO a
k
  else Env es
-> Bool -> Int -> ((forall r. Eff es r -> IO r) -> IO a) -> IO a
forall (effEs :: Type -> Type) (es :: [Effect]) a.
(HasCallStack, forall r. Coercible (effEs r) (Env es -> IO r)) =>
Env es
-> Bool -> Int -> ((forall r. effEs r -> IO r) -> IO a) -> IO a
persistentConcUnlift Env es
es Bool
False Int
threads (forall r. Eff es r -> IO r) -> IO a
k
concUnliftIO Env es
es Persistence
Persistent Limit
Unlimited (forall r. Eff es r -> IO r) -> IO a
k = Env es
-> Bool -> Int -> ((forall r. Eff es r -> IO r) -> IO a) -> IO a
forall (effEs :: Type -> Type) (es :: [Effect]) a.
(HasCallStack, forall r. Coercible (effEs r) (Env es -> IO r)) =>
Env es
-> Bool -> Int -> ((forall r. effEs r -> IO r) -> IO a) -> IO a
persistentConcUnlift Env es
es Bool
True Int
forall a. Bounded a => a
maxBound (forall r. Eff es r -> IO r) -> IO a
k

-- | Create two unlifting functions with the 'SeqForkUnlift' strategy.
--
-- The unlifting functions will share the effect storage (unlike with two
-- separate calls to 'seqForkUnliftIO').
--
-- /Warning:/ both environments must have the same underlying storage.
--
-- @since 2.7.0.0
seqForkUnliftsIO
  :: HasCallStack
  => Env es
  -> Env localEs
  -> ((forall r. Eff es r -> IO r) -> (forall r. Eff localEs r -> IO r) -> IO a)
  -- ^ Continuation with the unlifting functions in scope.
  -> IO a
seqForkUnliftsIO :: forall (es :: [Effect]) (localEs :: [Effect]) a.
HasCallStack =>
Env es
-> Env localEs
-> ((forall r. Eff es r -> IO r)
    -> (forall r. Eff localEs r -> IO r) -> IO a)
-> IO a
seqForkUnliftsIO Env es
es0 Env localEs
les0 (forall r. Eff es r -> IO r)
-> (forall r. Eff localEs r -> IO r) -> IO a
k = do
  IORef Storage
storage <- HasCallStack => IORef Storage -> IO (IORef Storage)
IORef Storage -> IO (IORef Storage)
cloneStorage Env es
es0.storage
  Env es
es <- Env es -> IORef Storage -> IO (Env es)
forall (es :: [Effect]). Env es -> IORef Storage -> IO (Env es)
replaceStorage Env es
es0 IORef Storage
storage
  Env localEs
les <- Env localEs -> IORef Storage -> IO (Env localEs)
forall (es :: [Effect]). Env es -> IORef Storage -> IO (Env es)
replaceStorage Env localEs
les0 IORef Storage
storage
  Env es -> ((forall r. Eff es r -> IO r) -> IO a) -> IO a
forall (es :: [Effect]) a.
HasCallStack =>
Env es -> ((forall r. Eff es r -> IO r) -> IO a) -> IO a
seqUnliftIO Env es
es (((forall r. Eff es r -> IO r) -> IO a) -> IO a)
-> ((forall r. Eff es r -> IO r) -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \forall r. Eff es r -> IO r
unliftEs -> do
    Env localEs -> ((forall r. Eff localEs r -> IO r) -> IO a) -> IO a
forall (es :: [Effect]) a.
HasCallStack =>
Env es -> ((forall r. Eff es r -> IO r) -> IO a) -> IO a
seqUnliftIO Env localEs
les (((forall r. Eff localEs r -> IO r) -> IO a) -> IO a)
-> ((forall r. Eff localEs r -> IO r) -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \forall r. Eff localEs r -> IO r
unliftLocalEs -> do
      (forall r. Eff es r -> IO r)
-> (forall r. Eff localEs r -> IO r) -> IO a
k Eff es r -> IO r
forall r. Eff es r -> IO r
unliftEs Eff localEs r -> IO r
forall r. Eff localEs r -> IO r
unliftLocalEs
{-# INLINE seqForkUnliftsIO #-}

-- | Create unlifting functions with the 'ConcUnlift' strategy.
--
-- In the 'Persistent' variant the unlifting functions will share the effect
-- storage in each thread (unlike with two separate calls to 'concUnliftIO').
--
-- /Warning:/ both environments must have the same underlying storage.
--
-- @since 2.7.0.0
concUnliftsIO
  :: HasCallStack
  => Env es
  -> Env localEs
  -- ^ The environment.
  -> Persistence
  -> Limit
  -> ((forall r. Eff es r -> IO r) -> (forall r. Eff localEs r -> IO r) -> IO a)
  -- ^ Continuation with the unlifting functions in scope.
  -> IO a
concUnliftsIO :: forall (es :: [Effect]) (localEs :: [Effect]) a.
HasCallStack =>
Env es
-> Env localEs
-> Persistence
-> Limit
-> ((forall r. Eff es r -> IO r)
    -> (forall r. Eff localEs r -> IO r) -> IO a)
-> IO a
concUnliftsIO Env es
es Env localEs
les Persistence
Ephemeral (Limited Int
uses) (forall r. Eff es r -> IO r)
-> (forall r. Eff localEs r -> IO r) -> IO a
k = do
  Env es -> Int -> ((forall r. Eff es r -> IO r) -> IO a) -> IO a
forall (effEs :: Type -> Type) (es :: [Effect]) a.
(HasCallStack, forall r. Coercible (effEs r) (Env es -> IO r)) =>
Env es -> Int -> ((forall r. effEs r -> IO r) -> IO a) -> IO a
ephemeralConcLimitedUnlift Env es
es Int
uses (((forall r. Eff es r -> IO r) -> IO a) -> IO a)
-> ((forall r. Eff es r -> IO r) -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \forall r. Eff es r -> IO r
unliftEs -> do
    Env localEs
-> Int -> ((forall r. Eff localEs r -> IO r) -> IO a) -> IO a
forall (effEs :: Type -> Type) (es :: [Effect]) a.
(HasCallStack, forall r. Coercible (effEs r) (Env es -> IO r)) =>
Env es -> Int -> ((forall r. effEs r -> IO r) -> IO a) -> IO a
ephemeralConcLimitedUnlift Env localEs
les Int
uses (((forall r. Eff localEs r -> IO r) -> IO a) -> IO a)
-> ((forall r. Eff localEs r -> IO r) -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \forall r. Eff localEs r -> IO r
unliftLocalEs -> do
      (forall r. Eff es r -> IO r)
-> (forall r. Eff localEs r -> IO r) -> IO a
k Eff es r -> IO r
forall r. Eff es r -> IO r
unliftEs Eff localEs r -> IO r
forall r. Eff localEs r -> IO r
unliftLocalEs
concUnliftsIO Env es
es Env localEs
les Persistence
Ephemeral Limit
Unlimited (forall r. Eff es r -> IO r)
-> (forall r. Eff localEs r -> IO r) -> IO a
k = do
  Env es -> ((forall r. Eff es r -> IO r) -> IO a) -> IO a
forall (effEs :: Type -> Type) (es :: [Effect]) a.
(HasCallStack, forall r. Coercible (effEs r) (Env es -> IO r)) =>
Env es -> ((forall r. effEs r -> IO r) -> IO a) -> IO a
ephemeralConcUnlimitedUnlift Env es
es (((forall r. Eff es r -> IO r) -> IO a) -> IO a)
-> ((forall r. Eff es r -> IO r) -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \forall r. Eff es r -> IO r
unliftEs -> do
    Env localEs -> ((forall r. Eff localEs r -> IO r) -> IO a) -> IO a
forall (effEs :: Type -> Type) (es :: [Effect]) a.
(HasCallStack, forall r. Coercible (effEs r) (Env es -> IO r)) =>
Env es -> ((forall r. effEs r -> IO r) -> IO a) -> IO a
ephemeralConcUnlimitedUnlift Env localEs
les (((forall r. Eff localEs r -> IO r) -> IO a) -> IO a)
-> ((forall r. Eff localEs r -> IO r) -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \forall r. Eff localEs r -> IO r
unliftLocalEs -> do
      (forall r. Eff es r -> IO r)
-> (forall r. Eff localEs r -> IO r) -> IO a
k Eff es r -> IO r
forall r. Eff es r -> IO r
unliftEs Eff localEs r -> IO r
forall r. Eff localEs r -> IO r
unliftLocalEs
concUnliftsIO Env es
es Env localEs
les Persistence
Persistent (Limited Int
threads) (forall r. Eff es r -> IO r)
-> (forall r. Eff localEs r -> IO r) -> IO a
k = do
  if Int
threads Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1
    then Env es
-> Env localEs
-> ((forall r. Eff es r -> IO r)
    -> (forall r. Eff localEs r -> IO r) -> IO a)
-> IO a
forall (effEs :: Type -> Type) (es :: [Effect])
       (effLocalEs :: Type -> Type) (localEs :: [Effect]) a.
(HasCallStack, forall r. Coercible (effEs r) (Env es -> IO r),
 forall r. Coercible (effLocalEs r) (Env localEs -> IO r)) =>
Env es
-> Env localEs
-> ((forall r. effEs r -> IO r)
    -> (forall r. effLocalEs r -> IO r) -> IO a)
-> IO a
persistentConcSingleUnlifts Env es
es Env localEs
les (forall r. Eff es r -> IO r)
-> (forall r. Eff localEs r -> IO r) -> IO a
k
    else Env es
-> Env localEs
-> Bool
-> Int
-> ((forall r. Eff es r -> IO r)
    -> (forall r. Eff localEs r -> IO r) -> IO a)
-> IO a
forall (effEs :: Type -> Type) (es :: [Effect])
       (effLocalEs :: Type -> Type) (localEs :: [Effect]) a.
(HasCallStack, forall r. Coercible (effEs r) (Env es -> IO r),
 forall r. Coercible (effLocalEs r) (Env localEs -> IO r)) =>
Env es
-> Env localEs
-> Bool
-> Int
-> ((forall r. effEs r -> IO r)
    -> (forall r. effLocalEs r -> IO r) -> IO a)
-> IO a
persistentConcUnlifts Env es
es Env localEs
les Bool
False Int
threads (forall r. Eff es r -> IO r)
-> (forall r. Eff localEs r -> IO r) -> IO a
k
concUnliftsIO Env es
es Env localEs
les Persistence
Persistent Limit
Unlimited (forall r. Eff es r -> IO r)
-> (forall r. Eff localEs r -> IO r) -> IO a
k = do
  Env es
-> Env localEs
-> Bool
-> Int
-> ((forall r. Eff es r -> IO r)
    -> (forall r. Eff localEs r -> IO r) -> IO a)
-> IO a
forall (effEs :: Type -> Type) (es :: [Effect])
       (effLocalEs :: Type -> Type) (localEs :: [Effect]) a.
(HasCallStack, forall r. Coercible (effEs r) (Env es -> IO r),
 forall r. Coercible (effLocalEs r) (Env localEs -> IO r)) =>
Env es
-> Env localEs
-> Bool
-> Int
-> ((forall r. effEs r -> IO r)
    -> (forall r. effLocalEs r -> IO r) -> IO a)
-> IO a
persistentConcUnlifts Env es
es Env localEs
les Bool
True Int
forall a. Bounded a => a
maxBound (forall r. Eff es r -> IO r)
-> (forall r. Eff localEs r -> IO r) -> IO a
k

-- | Utility for lifting 'IO' computations of type
--
-- @'IO' a -> 'IO' b@
--
-- to
--
-- @'Eff' es a -> 'Eff' es b@
--
-- This function is __really unsafe__ because:
--
-- - It can be used to introduce arbitrary 'IO' actions into pure 'Eff'
--   computations.
--
-- - The 'IO' computation must run its argument in a way that's perceived as
--   sequential to the outside observer, e.g. in the same thread or in a worker
--   thread that finishes before the argument is run again.
--
-- __Warning:__ if you disregard the second point, you will experience weird
-- bugs, data races or internal consistency check failures.
--
-- When in doubt, use 'Effectful.Dispatch.Static.unsafeLiftMapIO', especially
-- since this version saves only a simple safety check per call of
-- @reallyUnsafeLiftMapIO f@.
reallyUnsafeLiftMapIO :: (IO a -> IO b) -> Eff es a -> Eff es b
reallyUnsafeLiftMapIO :: forall a b (es :: [Effect]). (IO a -> IO b) -> Eff es a -> Eff es b
reallyUnsafeLiftMapIO IO a -> IO b
f Eff es a
m = (Env es -> IO b) -> Eff es b
forall (es :: [Effect]) a. (Env es -> IO a) -> Eff es a
unsafeEff ((Env es -> IO b) -> Eff es b) -> (Env es -> IO b) -> Eff es b
forall a b. (a -> b) -> a -> b
$ \Env es
es -> IO a -> IO b
f (Eff es a -> Env es -> IO a
forall (es :: [Effect]) a. Eff es a -> Env es -> IO a
unEff Eff es a
m Env es
es)

-- | Create an unlifting function.
--
-- This function is __really unsafe__ because:
--
-- - It can be used to introduce arbitrary 'IO' actions into pure 'Eff'
--   computations.
--
-- - Unlifted 'Eff' computations must be run in a way that's perceived as
--   sequential to the outside observer, e.g. in the same thread as the caller
--   of 'reallyUnsafeUnliftIO' or in a worker thread that finishes before
--   another unlifted computation is run.
--
-- __Warning:__ if you disregard the second point, you will experience weird
-- bugs, data races or internal consistency check failures.
--
-- When in doubt, use 'Effectful.Dispatch.Static.unsafeSeqUnliftIO', especially
-- since this version saves only a simple safety check per call of the unlifting
-- function.
reallyUnsafeUnliftIO :: ((forall r. Eff es r -> IO r) -> IO a) -> Eff es a
reallyUnsafeUnliftIO :: forall (es :: [Effect]) a.
((forall r. Eff es r -> IO r) -> IO a) -> Eff es a
reallyUnsafeUnliftIO (forall r. Eff es r -> IO r) -> IO a
k = (Env es -> IO a) -> Eff es a
forall (es :: [Effect]) a. (Env es -> IO a) -> Eff es a
unsafeEff ((Env es -> IO a) -> Eff es a) -> (Env es -> IO a) -> Eff es a
forall a b. (a -> b) -> a -> b
$ \Env es
es -> (forall r. Eff es r -> IO r) -> IO a
k (Eff es r -> Env es -> IO r
forall (es :: [Effect]) a. Eff es a -> Env es -> IO a
`unEff` Env es
es)

----------------------------------------
-- Base

instance Functor (Eff es) where
  fmap :: forall a b. (a -> b) -> Eff es a -> Eff es b
fmap a -> b
f (Eff Env es -> IO a
m) = (Env es -> IO b) -> Eff es b
forall (es :: [Effect]) a. (Env es -> IO a) -> Eff es a
unsafeEff ((Env es -> IO b) -> Eff es b) -> (Env es -> IO b) -> Eff es b
forall a b. (a -> b) -> a -> b
$ \Env es
es -> a -> b
f (a -> b) -> IO a -> IO b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Env es -> IO a
m Env es
es
  a
a <$ :: forall a b. a -> Eff es b -> Eff es a
<$ Eff Env es -> IO b
fb = (Env es -> IO a) -> Eff es a
forall (es :: [Effect]) a. (Env es -> IO a) -> Eff es a
unsafeEff ((Env es -> IO a) -> Eff es a) -> (Env es -> IO a) -> Eff es a
forall a b. (a -> b) -> a -> b
$ \Env es
es -> a
a a -> IO b -> IO a
forall a b. a -> IO b -> IO a
forall (f :: Type -> Type) a b. Functor f => a -> f b -> f a
<$ Env es -> IO b
fb Env es
es

instance Applicative (Eff es) where
  pure :: forall a. a -> Eff es a
pure = IO a -> Eff es a
forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ (IO a -> Eff es a) -> (a -> IO a) -> a -> Eff es a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> IO a
forall a. a -> IO a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure
  Eff Env es -> IO (a -> b)
mf <*> :: forall a b. Eff es (a -> b) -> Eff es a -> Eff es b
<*> Eff Env es -> IO a
mx = (Env es -> IO b) -> Eff es b
forall (es :: [Effect]) a. (Env es -> IO a) -> Eff es a
unsafeEff ((Env es -> IO b) -> Eff es b) -> (Env es -> IO b) -> Eff es b
forall a b. (a -> b) -> a -> b
$ \Env es
es -> Env es -> IO (a -> b)
mf Env es
es IO (a -> b) -> IO a -> IO b
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> Env es -> IO a
mx Env es
es
  Eff Env es -> IO a
ma  *> :: forall a b. Eff es a -> Eff es b -> Eff es b
*> Eff Env es -> IO b
mb = (Env es -> IO b) -> Eff es b
forall (es :: [Effect]) a. (Env es -> IO a) -> Eff es a
unsafeEff ((Env es -> IO b) -> Eff es b) -> (Env es -> IO b) -> Eff es b
forall a b. (a -> b) -> a -> b
$ \Env es
es -> Env es -> IO a
ma Env es
es  IO a -> IO b -> IO b
forall a b. IO a -> IO b -> IO b
forall (f :: Type -> Type) a b. Applicative f => f a -> f b -> f b
*> Env es -> IO b
mb Env es
es
  Eff Env es -> IO a
ma <* :: forall a b. Eff es a -> Eff es b -> Eff es a
<*  Eff Env es -> IO b
mb = (Env es -> IO a) -> Eff es a
forall (es :: [Effect]) a. (Env es -> IO a) -> Eff es a
unsafeEff ((Env es -> IO a) -> Eff es a) -> (Env es -> IO a) -> Eff es a
forall a b. (a -> b) -> a -> b
$ \Env es
es -> Env es -> IO a
ma Env es
es IO a -> IO b -> IO a
forall a b. IO a -> IO b -> IO a
forall (f :: Type -> Type) a b. Applicative f => f a -> f b -> f a
<*  Env es -> IO b
mb Env es
es
  liftA2 :: forall a b c. (a -> b -> c) -> Eff es a -> Eff es b -> Eff es c
liftA2 a -> b -> c
f (Eff Env es -> IO a
ma) (Eff Env es -> IO b
mb) = (Env es -> IO c) -> Eff es c
forall (es :: [Effect]) a. (Env es -> IO a) -> Eff es a
unsafeEff ((Env es -> IO c) -> Eff es c) -> (Env es -> IO c) -> Eff es c
forall a b. (a -> b) -> a -> b
$ \Env es
es -> (a -> b -> c) -> IO a -> IO b -> IO c
forall a b c. (a -> b -> c) -> IO a -> IO b -> IO c
forall (f :: Type -> Type) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> b -> c
f (Env es -> IO a
ma Env es
es) (Env es -> IO b
mb Env es
es)

instance Monad (Eff es) where
  Eff Env es -> IO a
m >>= :: forall a b. Eff es a -> (a -> Eff es b) -> Eff es b
>>= a -> Eff es b
k = (Env es -> IO b) -> Eff es b
forall (es :: [Effect]) a. (Env es -> IO a) -> Eff es a
unsafeEff ((Env es -> IO b) -> Eff es b) -> (Env es -> IO b) -> Eff es b
forall a b. (a -> b) -> a -> b
$ \Env es
es -> Env es -> IO a
m Env es
es IO a -> (a -> IO b) -> IO b
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a
a -> Eff es b -> Env es -> IO b
forall (es :: [Effect]) a. Eff es a -> Env es -> IO a
unEff (a -> Eff es b
k a
a) Env es
es
  -- https://gitlab.haskell.org/ghc/ghc/-/issues/20008
  {-# INLINE (>>=) #-}

instance MonadFix (Eff es) where
  mfix :: forall a. (a -> Eff es a) -> Eff es a
mfix a -> Eff es a
f = (Env es -> IO a) -> Eff es a
forall (es :: [Effect]) a. (Env es -> IO a) -> Eff es a
unsafeEff ((Env es -> IO a) -> Eff es a) -> (Env es -> IO a) -> Eff es a
forall a b. (a -> b) -> a -> b
$ \Env es
es -> (a -> IO a) -> IO a
forall a. (a -> IO a) -> IO a
forall (m :: Type -> Type) a. MonadFix m => (a -> m a) -> m a
mfix ((a -> IO a) -> IO a) -> (a -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \a
a -> Eff es a -> Env es -> IO a
forall (es :: [Effect]) a. Eff es a -> Env es -> IO a
unEff (a -> Eff es a
f a
a) Env es
es

----------------------------------------
-- NonDet

-- | Provide the ability to use the 'Alternative' and 'MonadPlus' instance for
-- 'Eff'.
--
-- /Note:/ 'NonDet' does not backtrack. Formally, it obeys the "left-catch" law
-- for 'MonadPlus', rather than the "left-distribution" law. This means that it
-- behaves more like 'Maybe' than @[]@.
--
-- @since 2.2.0.0
data NonDet :: Effect where
  Empty   :: NonDet m a
  (:<|>:) :: m a -> m a -> NonDet m a

type instance DispatchOf NonDet = Dynamic

-- | @since 2.2.0.0
instance NonDet :> es => Alternative (Eff es) where
  empty :: forall a. Eff es a
empty   = NonDet (Eff es) a -> Eff es a
forall (e :: Effect) (es :: [Effect]) a.
(HasCallStack, DispatchOf e ~ 'Dynamic, e :> es) =>
e (Eff es) a -> Eff es a
send NonDet (Eff es) a
forall (m :: Type -> Type) a. NonDet m a
Empty
  Eff es a
a <|> :: forall a. Eff es a -> Eff es a -> Eff es a
<|> Eff es a
b = NonDet (Eff es) a -> Eff es a
forall (e :: Effect) (es :: [Effect]) a.
(HasCallStack, DispatchOf e ~ 'Dynamic, e :> es) =>
e (Eff es) a -> Eff es a
send (Eff es a
a Eff es a -> Eff es a -> NonDet (Eff es) a
forall (m :: Type -> Type) a. m a -> m a -> NonDet m a
:<|>: Eff es a
b)

-- | @since 2.2.0.0
instance NonDet :> es => MonadPlus (Eff es)

----------------------------------------
-- Exception

-- | Available without any effect requirements.
--
-- Gating it behind an effect (such as 'IOE' or a more specialized effect) would
-- accomplish nothing, since any Haskell expression is free to throw an
-- exception with 'E.throw' at any point.
instance C.MonadThrow (Eff es) where
  throwM :: forall e a. (HasCallStack, Exception e) => e -> Eff es a
throwM = IO a -> Eff es a
forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ (IO a -> Eff es a) -> (e -> IO a) -> e -> Eff es a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HasCallStack => e -> IO a) -> e -> IO a
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack e -> IO a
HasCallStack => e -> IO a
forall e a. Exception e => e -> IO a
E.throwIO

#if MIN_VERSION_base(4,21,0) && MIN_VERSION_exceptions(0,10,11)
  rethrowM = unsafeEff_ . E.rethrowIO
#endif

-- | Available without any effect requirements.
--
-- This is the one instance of the three that would arguably benefit from
-- requiring 'IOE' (or a more specialized effect), as catching imprecise
-- exceptions makes it possible to write non-deterministic pure functions with
-- 'runPureEff'. Unfortunately it can't, because t'C.MonadCatch' is a superclass
-- of t'C.MonadMask', which needs to be available unconditionally (see the note
-- there).
--
-- For the full discussion see
-- [issue #76](https://github.com/haskell-effectful/effectful/issues/76).
instance C.MonadCatch (Eff es) where
  catch :: forall e a.
(HasCallStack, Exception e) =>
Eff es a -> (e -> Eff es a) -> Eff es a
catch Eff es a
action e -> Eff es a
handler = ((forall r. Eff es r -> IO r) -> IO a) -> Eff es a
forall (es :: [Effect]) a.
((forall r. Eff es r -> IO r) -> IO a) -> Eff es a
reallyUnsafeUnliftIO (((forall r. Eff es r -> IO r) -> IO a) -> Eff es a)
-> ((forall r. Eff es r -> IO r) -> IO a) -> Eff es a
forall a b. (a -> b) -> a -> b
$ \forall r. Eff es r -> IO r
unlift -> do
    IO a -> (e -> IO a) -> IO a
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
E.catch (Eff es a -> IO a
forall r. Eff es r -> IO r
unlift Eff es a
action) (Eff es a -> IO a
forall r. Eff es r -> IO r
unlift (Eff es a -> IO a) -> (e -> Eff es a) -> e -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> Eff es a
handler)

#if MIN_VERSION_base(4,21,0) && MIN_VERSION_exceptions(0,10,11)
  catchNoPropagate action handler = reallyUnsafeUnliftIO $ \unlift -> do
    E.catchNoPropagate (unlift action) (unlift . handler)
#endif

-- | Available without any effect requirements.
--
-- This makes it possible to use cleanup functions such as
-- 'Effectful.Exception.bracket' or 'Effectful.Exception.finally' anywhere, e.g.
-- to restore a state on error:
--
-- @
-- transactionally :: forall s es a. 'Effectful.State.Static.Local.State' s ':>' es => 'Eff' es a -> 'Eff' es a
-- transactionally = 'Effectful.Exception.bracketOnError' ('Effectful.State.Static.Local.get' \@s) ('Effectful.State.Static.Local.put' \@s) . const
-- @
--
-- Requiring 'IOE' would make functions like the above impossible to write and
-- force 'IOE' to show up in application code that otherwise only needs more
-- restricted effects, which would be a significant usability regression. On the
-- other hand, requiring a more specialized effect would be annoying, since
-- functions making use of t'C.MonadMask' are ubiquitous.
instance C.MonadMask (Eff es) where
  mask :: forall b.
HasCallStack =>
((forall a. Eff es a -> Eff es a) -> Eff es b) -> Eff es b
mask (forall a. Eff es a -> Eff es a) -> Eff es b
k = ((forall r. Eff es r -> IO r) -> IO b) -> Eff es b
forall (es :: [Effect]) a.
((forall r. Eff es r -> IO r) -> IO a) -> Eff es a
reallyUnsafeUnliftIO (((forall r. Eff es r -> IO r) -> IO b) -> Eff es b)
-> ((forall r. Eff es r -> IO r) -> IO b) -> Eff es b
forall a b. (a -> b) -> a -> b
$ \forall r. Eff es r -> IO r
unlift -> do
    ((forall a. IO a -> IO a) -> IO b) -> IO b
forall b. ((forall a. IO a -> IO a) -> IO b) -> IO b
E.mask (((forall a. IO a -> IO a) -> IO b) -> IO b)
-> ((forall a. IO a -> IO a) -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \forall a. IO a -> IO a
release -> Eff es b -> IO b
forall r. Eff es r -> IO r
unlift (Eff es b -> IO b) -> Eff es b -> IO b
forall a b. (a -> b) -> a -> b
$ (forall a. Eff es a -> Eff es a) -> Eff es b
k ((IO a -> IO a) -> Eff es a -> Eff es a
forall a b (es :: [Effect]). (IO a -> IO b) -> Eff es a -> Eff es b
reallyUnsafeLiftMapIO IO a -> IO a
forall a. IO a -> IO a
release)

  uninterruptibleMask :: forall b.
HasCallStack =>
((forall a. Eff es a -> Eff es a) -> Eff es b) -> Eff es b
uninterruptibleMask (forall a. Eff es a -> Eff es a) -> Eff es b
k = ((forall r. Eff es r -> IO r) -> IO b) -> Eff es b
forall (es :: [Effect]) a.
((forall r. Eff es r -> IO r) -> IO a) -> Eff es a
reallyUnsafeUnliftIO (((forall r. Eff es r -> IO r) -> IO b) -> Eff es b)
-> ((forall r. Eff es r -> IO r) -> IO b) -> Eff es b
forall a b. (a -> b) -> a -> b
$ \forall r. Eff es r -> IO r
unlift -> do
    ((forall a. IO a -> IO a) -> IO b) -> IO b
forall b. ((forall a. IO a -> IO a) -> IO b) -> IO b
E.uninterruptibleMask (((forall a. IO a -> IO a) -> IO b) -> IO b)
-> ((forall a. IO a -> IO a) -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \forall a. IO a -> IO a
release -> Eff es b -> IO b
forall r. Eff es r -> IO r
unlift (Eff es b -> IO b) -> Eff es b -> IO b
forall a b. (a -> b) -> a -> b
$ (forall a. Eff es a -> Eff es a) -> Eff es b
k ((IO a -> IO a) -> Eff es a -> Eff es a
forall a b (es :: [Effect]). (IO a -> IO b) -> Eff es a -> Eff es b
reallyUnsafeLiftMapIO IO a -> IO a
forall a. IO a -> IO a
release)

  generalBracket :: forall a b c.
HasCallStack =>
Eff es a
-> (a -> ExitCase b -> Eff es c)
-> (a -> Eff es b)
-> Eff es (b, c)
generalBracket Eff es a
before a -> ExitCase b -> Eff es c
after a -> Eff es b
action = ((forall r. Eff es r -> IO r) -> IO (b, c)) -> Eff es (b, c)
forall (es :: [Effect]) a.
((forall r. Eff es r -> IO r) -> IO a) -> Eff es a
reallyUnsafeUnliftIO (((forall r. Eff es r -> IO r) -> IO (b, c)) -> Eff es (b, c))
-> ((forall r. Eff es r -> IO r) -> IO (b, c)) -> Eff es (b, c)
forall a b. (a -> b) -> a -> b
$ \forall r. Eff es r -> IO r
unlift -> do
     ((forall a. IO a -> IO a) -> IO (b, c)) -> IO (b, c)
forall b. ((forall a. IO a -> IO a) -> IO b) -> IO b
E.mask (((forall a. IO a -> IO a) -> IO (b, c)) -> IO (b, c))
-> ((forall a. IO a -> IO a) -> IO (b, c)) -> IO (b, c)
forall a b. (a -> b) -> a -> b
$ \forall a. IO a -> IO a
unmask -> do
      a
a <- Eff es a -> IO a
forall r. Eff es r -> IO r
unlift Eff es a
before
#if MIN_VERSION_base(4,21,0)
      b <- E.catchNoPropagate
        (unmask . unlift $ action a)
        (\ec@(E.ExceptionWithContext _ e) -> do
            _ <- E.annotateIO (E.WhileHandling (E.toException ec)) $ do
              unlift . after a $ C.ExitCaseException e
            E.rethrowIO ec
        )
#else
      b
b <- IO b -> (SomeException -> IO b) -> IO b
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
E.catch
        (IO b -> IO b
forall a. IO a -> IO a
unmask (IO b -> IO b) -> (Eff es b -> IO b) -> Eff es b -> IO b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Eff es b -> IO b
forall r. Eff es r -> IO r
unlift (Eff es b -> IO b) -> Eff es b -> IO b
forall a b. (a -> b) -> a -> b
$ a -> Eff es b
action a
a)
        (\SomeException
e -> do
            c
_ <- Eff es c -> IO c
forall r. Eff es r -> IO r
unlift (Eff es c -> IO c)
-> (ExitCase b -> Eff es c) -> ExitCase b -> IO c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ExitCase b -> Eff es c
after a
a (ExitCase b -> IO c) -> ExitCase b -> IO c
forall a b. (a -> b) -> a -> b
$ SomeException -> ExitCase b
forall a. SomeException -> ExitCase a
C.ExitCaseException SomeException
e
            SomeException -> IO b
forall e a. Exception e => e -> IO a
E.throwIO SomeException
e
        )
#endif
      c
c <- Eff es c -> IO c
forall r. Eff es r -> IO r
unlift (Eff es c -> IO c)
-> (ExitCase b -> Eff es c) -> ExitCase b -> IO c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ExitCase b -> Eff es c
after a
a (ExitCase b -> IO c) -> ExitCase b -> IO c
forall a b. (a -> b) -> a -> b
$ b -> ExitCase b
forall a. a -> ExitCase a
C.ExitCaseSuccess b
b
      (b, c) -> IO (b, c)
forall a. a -> IO a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (b
b, c
c)

----------------------------------------
-- Fail

-- | Provide the ability to use the 'MonadFail' instance for 'Eff'.
data Fail :: Effect where
  Fail :: String -> Fail m a

type instance DispatchOf Fail = Dynamic

instance Fail :> es => MonadFail (Eff es) where
  fail :: forall a. [Char] -> Eff es a
fail [Char]
msg = Fail (Eff es) a -> Eff es a
forall (e :: Effect) (es :: [Effect]) a.
(HasCallStack, DispatchOf e ~ 'Dynamic, e :> es) =>
e (Eff es) a -> Eff es a
send ([Char] -> Fail (Eff es) a
forall (m :: Type -> Type) a. [Char] -> Fail m a
Fail [Char]
msg)

----------------------------------------
-- IO

-- | Run arbitrary 'IO' computations via 'MonadIO' or 'MonadUnliftIO'.
--
-- /Note:/ it is not recommended to use this effect in application code as it is
-- too liberal. Ideally, this is only used in handlers of more fine-grained
-- effects.
data IOE :: Effect

type instance DispatchOf IOE = Static WithSideEffects
newtype instance StaticRep IOE = IOE UnliftStrategy

-- | Run an 'Eff' computation with side effects.
--
-- For running pure computations see 'runPureEff'.
runEff :: HasCallStack => Eff '[IOE] a -> IO a
runEff :: forall a. HasCallStack => Eff '[IOE] a -> IO a
runEff Eff '[IOE] a
m = Eff '[IOE] a -> Env '[IOE] -> IO a
forall (es :: [Effect]) a. Eff es a -> Env es -> IO a
unEff Eff '[IOE] a
m (Env '[IOE] -> IO a) -> IO (Env '[IOE]) -> IO a
forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< EffectRep (DispatchOf IOE) IOE
-> Relinker (EffectRep (DispatchOf IOE)) IOE
-> Env '[]
-> IO (Env '[IOE])
forall (e :: Effect) (es :: [Effect]).
HasCallStack =>
EffectRep (DispatchOf e) e
-> Relinker (EffectRep (DispatchOf e)) e
-> Env es
-> IO (Env (e : es))
consEnv (UnliftStrategy -> StaticRep IOE
IOE UnliftStrategy
SeqUnlift) Relinker (EffectRep (DispatchOf IOE)) IOE
Relinker StaticRep IOE
forall (rep :: Effect -> Type) (e :: Effect). Relinker rep e
dummyRelinker (Env '[] -> IO (Env '[IOE])) -> IO (Env '[]) -> IO (Env '[IOE])
forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO (Env '[])
HasCallStack => IO (Env '[])
emptyEnv

instance IOE :> es => MonadIO (Eff es) where
  liftIO :: forall a. IO a -> Eff es a
liftIO = IO a -> Eff es a
forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_

-- | Instance included for compatibility with existing code.
--
-- Usage of 'withEffToIO' is preferrable as it allows specifying the
-- 'UnliftStrategy' on a case-by-case basis and has better error reporting.
--
-- /Note:/ the unlifting strategy for 'withRunInIO' is taken from the 'IOE'
-- context (see 'unliftStrategy').
instance IOE :> es => MonadUnliftIO (Eff es) where
  withRunInIO :: forall b. ((forall a. Eff es a -> IO a) -> IO b) -> Eff es b
withRunInIO (forall a. Eff es a -> IO a) -> IO b
k = Eff es UnliftStrategy
forall (es :: [Effect]).
(HasCallStack, IOE :> es) =>
Eff es UnliftStrategy
unliftStrategy Eff es UnliftStrategy -> (UnliftStrategy -> Eff es b) -> Eff es b
forall a b. Eff es a -> (a -> Eff es b) -> Eff es b
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= (UnliftStrategy
-> ((forall a. Eff es a -> IO a) -> IO b) -> Eff es b
forall (es :: [Effect]) a.
(HasCallStack, IOE :> es) =>
UnliftStrategy
-> ((forall r. Eff es r -> IO r) -> IO a) -> Eff es a
`withEffToIO` (forall a. Eff es a -> IO a) -> IO b
k)

-- | Instance included for compatibility with existing code.
--
-- Usage of 'liftIO' is preferrable as it's a standard.
instance IOE :> es => MonadBase IO (Eff es) where
  liftBase :: forall α. IO α -> Eff es α
liftBase = IO α -> Eff es α
forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_

-- | Instance included for compatibility with existing code.
--
-- Usage of 'withEffToIO' is preferrable as it allows specifying the
-- 'UnliftStrategy' on a case-by-case basis and has better error reporting.
--
-- /Note:/ the unlifting strategy for 'liftBaseWith' is taken from the 'IOE'
-- context (see 'unliftStrategy').
instance IOE :> es => MonadBaseControl IO (Eff es) where
  type StM (Eff es) a = a
  liftBaseWith :: forall a. (RunInBase (Eff es) IO -> IO a) -> Eff es a
liftBaseWith RunInBase (Eff es) IO -> IO a
k = Eff es UnliftStrategy
forall (es :: [Effect]).
(HasCallStack, IOE :> es) =>
Eff es UnliftStrategy
unliftStrategy Eff es UnliftStrategy -> (UnliftStrategy -> Eff es a) -> Eff es a
forall a b. Eff es a -> (a -> Eff es b) -> Eff es b
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= (UnliftStrategy
-> ((forall r. Eff es r -> IO r) -> IO a) -> Eff es a
forall (es :: [Effect]) a.
(HasCallStack, IOE :> es) =>
UnliftStrategy
-> ((forall r. Eff es r -> IO r) -> IO a) -> Eff es a
`withEffToIO` (forall r. Eff es r -> IO r) -> IO a
RunInBase (Eff es) IO -> IO a
k)
  restoreM :: forall a. StM (Eff es) a -> Eff es a
restoreM = a -> Eff es a
StM (Eff es) a -> Eff es a
forall a. a -> Eff es a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure

----------------------------------------
-- Primitive

-- | Provide the ability to perform primitive state-transformer actions.
data Prim :: Effect

type instance DispatchOf Prim = Static WithSideEffects
data instance StaticRep Prim = Prim

-- | 'PrimState' token for 'Eff'. Used instead of 'RealWorld' to prevent the
-- 'Prim' effect from executing arbitrary 'IO' actions via 'ioToPrim'.
data PrimStateEff

-- | Run an 'Eff' computation with primitive state-transformer actions.
runPrim :: (HasCallStack, IOE :> es) => Eff (Prim : es) a -> Eff es a
runPrim :: forall (es :: [Effect]) a.
(HasCallStack, IOE :> es) =>
Eff (Prim : es) a -> Eff es a
runPrim = StaticRep Prim -> Eff (Prim : es) a -> Eff es a
forall (e :: Effect) (sideEffects :: SideEffects) (es :: [Effect])
       a.
(HasCallStack, DispatchOf e ~ 'Static sideEffects,
 MaybeIOE sideEffects es) =>
StaticRep e -> Eff (e : es) a -> Eff es a
evalStaticRep StaticRep Prim
Prim

instance Prim :> es => PrimMonad (Eff es) where
  type PrimState (Eff es) = PrimStateEff
  primitive :: forall a.
(State# (PrimState (Eff es))
 -> (# State# (PrimState (Eff es)), a #))
-> Eff es a
primitive = IO a -> Eff es a
forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ (IO a -> Eff es a)
-> ((State# PrimStateEff -> (# State# PrimStateEff, a #)) -> IO a)
-> (State# PrimStateEff -> (# State# PrimStateEff, a #))
-> Eff es a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO ((State# RealWorld -> (# State# RealWorld, a #)) -> IO a)
-> ((State# PrimStateEff -> (# State# PrimStateEff, a #))
    -> State# RealWorld -> (# State# RealWorld, a #))
-> (State# PrimStateEff -> (# State# PrimStateEff, a #))
-> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (State# PrimStateEff -> (# State# PrimStateEff, a #))
-> State# RealWorld -> (# State# RealWorld, a #)
forall a b. a -> b
unsafeCoerce

----------------------------------------
-- Lifting

-- | Lift an 'Eff' computation into an effect stack with one more effect.
raise :: forall e es a. Eff es a -> Eff (e : es) a
raise :: forall (e :: Effect) (es :: [Effect]) a. Eff es a -> Eff (e : es) a
raise Eff es a
m = (Env (e : es) -> IO a) -> Eff (e : es) a
forall (es :: [Effect]) a. (Env es -> IO a) -> Eff es a
unsafeEff ((Env (e : es) -> IO a) -> Eff (e : es) a)
-> (Env (e : es) -> IO a) -> Eff (e : es) a
forall a b. (a -> b) -> a -> b
$ \Env (e : es)
es -> Eff es a -> Env es -> IO a
forall (es :: [Effect]) a. Eff es a -> Env es -> IO a
unEff Eff es a
m (Env es -> IO a) -> IO (Env es) -> IO a
forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< Env (e : es) -> IO (Env es)
forall (e :: Effect) (es :: [Effect]). Env (e : es) -> IO (Env es)
tailEnv Env (e : es)
es

-- | Lift an 'Eff' computation into an effect stack with one more effect and
-- create an unlifting function with the given strategy.
--
-- @since 1.2.0.0
raiseWith
  :: HasCallStack
  => UnliftStrategy
  -> ((forall r. Eff (e : es) r -> Eff es r) -> Eff es a)
  -- ^ Continuation with the unlifting function in scope.
  -> Eff (e : es) a
raiseWith :: forall (e :: Effect) (es :: [Effect]) a.
HasCallStack =>
UnliftStrategy
-> ((forall r. Eff (e : es) r -> Eff es r) -> Eff es a)
-> Eff (e : es) a
raiseWith UnliftStrategy
strategy (forall r. Eff (e : es) r -> Eff es r) -> Eff es a
k = (Env (e : es) -> IO a) -> Eff (e : es) a
forall (es :: [Effect]) a. (Env es -> IO a) -> Eff es a
unsafeEff ((Env (e : es) -> IO a) -> Eff (e : es) a)
-> (Env (e : es) -> IO a) -> Eff (e : es) a
forall a b. (a -> b) -> a -> b
$ \Env (e : es)
ees -> do
  Env es
es <- Env (e : es) -> IO (Env es)
forall (e :: Effect) (es :: [Effect]). Env (e : es) -> IO (Env es)
tailEnv Env (e : es)
ees
  case UnliftStrategy
strategy of
    UnliftStrategy
SeqUnlift -> Env (e : es)
-> ((forall r. Eff (e : es) r -> IO r) -> IO a) -> IO a
forall (es :: [Effect]) a.
HasCallStack =>
Env es -> ((forall r. Eff es r -> IO r) -> IO a) -> IO a
seqUnliftIO Env (e : es)
ees (((forall r. Eff (e : es) r -> IO r) -> IO a) -> IO a)
-> ((forall r. Eff (e : es) r -> IO r) -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \forall r. Eff (e : es) r -> IO r
unlift -> do
      (Eff es a -> Env es -> IO a
forall (es :: [Effect]) a. Eff es a -> Env es -> IO a
`unEff` Env es
es) (Eff es a -> IO a) -> Eff es a -> IO a
forall a b. (a -> b) -> a -> b
$ (forall r. Eff (e : es) r -> Eff es r) -> Eff es a
k ((forall r. Eff (e : es) r -> Eff es r) -> Eff es a)
-> (forall r. Eff (e : es) r -> Eff es r) -> Eff es a
forall a b. (a -> b) -> a -> b
$ IO r -> Eff es r
forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ (IO r -> Eff es r)
-> (Eff (e : es) r -> IO r) -> Eff (e : es) r -> Eff es r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Eff (e : es) r -> IO r
forall r. Eff (e : es) r -> IO r
unlift
    UnliftStrategy
SeqForkUnlift -> Env (e : es)
-> ((forall r. Eff (e : es) r -> IO r) -> IO a) -> IO a
forall (es :: [Effect]) a.
HasCallStack =>
Env es -> ((forall r. Eff es r -> IO r) -> IO a) -> IO a
seqForkUnliftIO Env (e : es)
ees (((forall r. Eff (e : es) r -> IO r) -> IO a) -> IO a)
-> ((forall r. Eff (e : es) r -> IO r) -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \forall r. Eff (e : es) r -> IO r
unlift -> do
      (Eff es a -> Env es -> IO a
forall (es :: [Effect]) a. Eff es a -> Env es -> IO a
`unEff` Env es
es) (Eff es a -> IO a) -> Eff es a -> IO a
forall a b. (a -> b) -> a -> b
$ (forall r. Eff (e : es) r -> Eff es r) -> Eff es a
k ((forall r. Eff (e : es) r -> Eff es r) -> Eff es a)
-> (forall r. Eff (e : es) r -> Eff es r) -> Eff es a
forall a b. (a -> b) -> a -> b
$ IO r -> Eff es r
forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ (IO r -> Eff es r)
-> (Eff (e : es) r -> IO r) -> Eff (e : es) r -> Eff es r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Eff (e : es) r -> IO r
forall r. Eff (e : es) r -> IO r
unlift
    ConcUnlift Persistence
p Limit
l -> Env (e : es)
-> Persistence
-> Limit
-> ((forall r. Eff (e : es) r -> IO r) -> IO a)
-> IO a
forall (es :: [Effect]) a.
HasCallStack =>
Env es
-> Persistence
-> Limit
-> ((forall r. Eff es r -> IO r) -> IO a)
-> IO a
concUnliftIO Env (e : es)
ees Persistence
p Limit
l (((forall r. Eff (e : es) r -> IO r) -> IO a) -> IO a)
-> ((forall r. Eff (e : es) r -> IO r) -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \forall r. Eff (e : es) r -> IO r
unlift -> do
      (Eff es a -> Env es -> IO a
forall (es :: [Effect]) a. Eff es a -> Env es -> IO a
`unEff` Env es
es) (Eff es a -> IO a) -> Eff es a -> IO a
forall a b. (a -> b) -> a -> b
$ (forall r. Eff (e : es) r -> Eff es r) -> Eff es a
k ((forall r. Eff (e : es) r -> Eff es r) -> Eff es a)
-> (forall r. Eff (e : es) r -> Eff es r) -> Eff es a
forall a b. (a -> b) -> a -> b
$ IO r -> Eff es r
forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ (IO r -> Eff es r)
-> (Eff (e : es) r -> IO r) -> Eff (e : es) r -> Eff es r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Eff (e : es) r -> IO r
forall r. Eff (e : es) r -> IO r
unlift
{-# INLINE raiseWith #-}

-- | Eliminate a duplicate effect from the top of the effect stack.
subsume :: e :> es => Eff (e : es) a -> Eff es a
subsume :: forall (e :: Effect) (es :: [Effect]) a.
(e :> es) =>
Eff (e : es) a -> Eff es a
subsume Eff (e : es) a
m = (Env es -> IO a) -> Eff es a
forall (es :: [Effect]) a. (Env es -> IO a) -> Eff es a
unsafeEff ((Env es -> IO a) -> Eff es a) -> (Env es -> IO a) -> Eff es a
forall a b. (a -> b) -> a -> b
$ \Env es
es -> Eff (e : es) a -> Env (e : es) -> IO a
forall (es :: [Effect]) a. Eff es a -> Env es -> IO a
unEff Eff (e : es) a
m (Env (e : es) -> IO a) -> IO (Env (e : es)) -> IO a
forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< Env es -> IO (Env (e : es))
forall (e :: Effect) (es :: [Effect]).
(e :> es) =>
Env es -> IO (Env (e : es))
subsumeEnv Env es
es

-- | Allow for running an effect stack @subEs@ within @es@ as long as @subEs@ is
-- a permutation (with possible duplicates) of a subset of @es@.
--
-- Generalizes 'raise' and 'subsume'.
--
-- >>> data E1 :: Effect
-- >>> data E2 :: Effect
-- >>> data E3 :: Effect
--
-- It makes it possible to rearrange the effect stack however you like:
--
-- >>> :{
--   shuffle :: Eff (E3 : E1 : E2 : es) a -> Eff (E1 : E2 : E3 : es) a
--   shuffle = inject
-- :}
--
-- It can also turn a monomorphic effect stack into a polymorphic one:
--
-- >>> :{
--   toPoly :: (E1 :> es, E2 :> es, E3 :> es) => Eff [E1, E2, E3] a -> Eff es a
--   toPoly = inject
-- :}
--
-- Moreover, it allows for hiding specific effects from downstream:
--
-- >>> :{
--   onlyE1 :: Eff (E1 : es) a -> Eff (E1 : E2 : E3 : es) a
--   onlyE1 = inject
-- :}
--
-- >>> :{
--   onlyE2 :: Eff (E2 : es) a -> Eff (E1 : E2 : E3 : es) a
--   onlyE2 = inject
-- :}
--
-- >>> :{
--   onlyE3 :: Eff (E3 : es) a -> Eff (E1 : E2 : E3 : es) a
--   onlyE3 = inject
-- :}
--
-- However, it's not possible to inject a computation into an incompatible
-- effect stack:
--
-- >>> :{
--   coerceEs :: Eff es1 a -> Eff es2 a
--   coerceEs = inject
-- :}
-- ...
-- ...Couldn't match type ‘es1’ with ‘es2’
-- ...
inject :: Subset subEs es => Eff subEs a -> Eff es a
inject :: forall (subEs :: [Effect]) (es :: [Effect]) a.
Subset subEs es =>
Eff subEs a -> Eff es a
inject Eff subEs a
m = (Env es -> IO a) -> Eff es a
forall (es :: [Effect]) a. (Env es -> IO a) -> Eff es a
unsafeEff ((Env es -> IO a) -> Eff es a) -> (Env es -> IO a) -> Eff es a
forall a b. (a -> b) -> a -> b
$ \Env es
es -> Eff subEs a -> Env subEs -> IO a
forall (es :: [Effect]) a. Eff es a -> Env es -> IO a
unEff Eff subEs a
m (Env subEs -> IO a) -> IO (Env subEs) -> IO a
forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< Env es -> IO (Env subEs)
forall (subEs :: [Effect]) (es :: [Effect]).
Subset subEs es =>
Env es -> IO (Env subEs)
injectEnv Env es
es

----------------------------------------
-- Dynamic dispatch

type role LocalEnv nominal

-- | Opaque representation of the 'Eff' environment at the point of calling the
-- 'send' function, i.e. right before the control is passed to the effect
-- handler.
--
-- /Note:/ functions that consume it perform runtime checks to ensure that it's
-- used within the scope of the effect handler it belongs to.
newtype LocalEnv (localEs :: [Effect]) = LocalEnv (Env localEs)

-- | Unwrap the 'LocalEnv' via 'requireMatchingStorages'.
unwrapLocalEnv :: HasCallStack => Env es -> LocalEnv localEs -> IO (Env localEs)
unwrapLocalEnv :: forall (es :: [Effect]) (localEs :: [Effect]).
HasCallStack =>
Env es -> LocalEnv localEs -> IO (Env localEs)
unwrapLocalEnv Env es
es localEs :: LocalEnv localEs
localEs@(LocalEnv Env localEs
les) = do
  Env es -> LocalEnv localEs -> IO ()
forall (es :: [Effect]) (localEs :: [Effect]).
HasCallStack =>
Env es -> LocalEnv localEs -> IO ()
requireMatchingStorages Env es
es LocalEnv localEs
localEs
  Env localEs -> IO (Env localEs)
forall a. a -> IO a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Env localEs
les

-- | Make sure that the 'LocalEnv' is used in the thread/context of the effect
-- handler it belongs to.
requireMatchingStorages :: HasCallStack => Env es -> LocalEnv localEs -> IO ()
requireMatchingStorages :: forall (es :: [Effect]) (localEs :: [Effect]).
HasCallStack =>
Env es -> LocalEnv localEs -> IO ()
requireMatchingStorages Env es
es (LocalEnv Env localEs
les)
  | Env es
es.storage IORef Storage -> IORef Storage -> Bool
forall a. Eq a => a -> a -> Bool
/= Env localEs
les.storage = [Char] -> IO ()
forall a. HasCallStack => [Char] -> a
error
    ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Env and LocalEnv point to different Storages.\n"
    [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"If you passed LocalEnv to a different thread/context and tried to "
    [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"use it there, it's not allowed. You need to use it in the "
    [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"thread/context of the effect handler."
  | Bool
otherwise = () -> IO ()
forall a. a -> IO a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure ()

-- | Type signature of the effect handler.
type EffectHandler (e :: Effect) (es :: [Effect])
  = forall a localEs. (HasCallStack, e :> localEs)
  => LocalEnv localEs
  -- ^ Capture of the local environment for handling local 'Eff' computations
  -- when @e@ is a higher order effect.
  -> e (Eff localEs) a
  -- ^ The operation.
  -> Eff es a

-- | Wrapper to prevent a space leak on reconstruction of 'Handler' in
-- 'relinkHandler' (see https://gitlab.haskell.org/ghc/ghc/-/issues/25520).
newtype HandlerImpl e es = HandlerImpl (EffectHandler e es)

-- | An internal representation of dynamically dispatched effects, i.e. the
-- effect handler bundled with its environment.
data Handler :: Effect -> Type where
  Handler :: !(Env handlerEs) -> !(HandlerImpl e handlerEs) -> Handler e
type instance EffectRep Dynamic = Handler

relinkHandler :: Relinker Handler e
relinkHandler :: forall (e :: Effect). Relinker Handler e
relinkHandler = (HasCallStack =>
 (forall (es :: [Effect]). Env es -> IO (Env es))
 -> Handler e -> IO (Handler e))
-> Relinker Handler e
forall (a :: Effect -> Type) (b :: Effect).
(HasCallStack =>
 (forall (es :: [Effect]). Env es -> IO (Env es))
 -> a b -> IO (a b))
-> Relinker a b
Relinker ((HasCallStack =>
  (forall (es :: [Effect]). Env es -> IO (Env es))
  -> Handler e -> IO (Handler e))
 -> Relinker Handler e)
-> (HasCallStack =>
    (forall (es :: [Effect]). Env es -> IO (Env es))
    -> Handler e -> IO (Handler e))
-> Relinker Handler e
forall a b. (a -> b) -> a -> b
$ \forall (es :: [Effect]). Env es -> IO (Env es)
relink (Handler Env handlerEs
handlerEs HandlerImpl e handlerEs
handler) -> do
  Env handlerEs
newHandlerEs <- Env handlerEs -> IO (Env handlerEs)
forall (es :: [Effect]). Env es -> IO (Env es)
relink Env handlerEs
handlerEs
  Handler e -> IO (Handler e)
forall a. a -> IO a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Handler e -> IO (Handler e)) -> Handler e -> IO (Handler e)
forall a b. (a -> b) -> a -> b
$ Env handlerEs -> HandlerImpl e handlerEs -> Handler e
forall (handlerEs :: [Effect]) (e :: Effect).
Env handlerEs -> HandlerImpl e handlerEs -> Handler e
Handler Env handlerEs
newHandlerEs HandlerImpl e handlerEs
handler

-- | Run a dynamically dispatched effect with the given handler.
runHandler
  :: (HasCallStack, DispatchOf e ~ Dynamic)
  => Handler e
  -> Eff (e : es) a
  -> Eff es a
runHandler :: forall (e :: Effect) (es :: [Effect]) a.
(HasCallStack, DispatchOf e ~ 'Dynamic) =>
Handler e -> Eff (e : es) a -> Eff es a
runHandler Handler e
e Eff (e : es) a
m = (Env es -> IO a) -> Eff es a
forall (es :: [Effect]) a. (Env es -> IO a) -> Eff es a
unsafeEff ((Env es -> IO a) -> Eff es a) -> (Env es -> IO a) -> Eff es a
forall a b. (a -> b) -> a -> b
$ \Env es
es0 -> do
  IO (Env (e : es))
-> (Env (e : es) -> IO ()) -> (Env (e : es) -> IO a) -> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
inlineBracket
    (EffectRep (DispatchOf e) e
-> Relinker (EffectRep (DispatchOf e)) e
-> Env es
-> IO (Env (e : es))
forall (e :: Effect) (es :: [Effect]).
HasCallStack =>
EffectRep (DispatchOf e) e
-> Relinker (EffectRep (DispatchOf e)) e
-> Env es
-> IO (Env (e : es))
consEnv EffectRep (DispatchOf e) e
Handler e
e Relinker (EffectRep (DispatchOf e)) e
Relinker Handler e
forall (e :: Effect). Relinker Handler e
relinkHandler Env es
es0)
    Env (e : es) -> IO ()
forall (e :: Effect) (es :: [Effect]).
HasCallStack =>
Env (e : es) -> IO ()
unconsEnv
    (\Env (e : es)
es -> Eff (e : es) a -> Env (e : es) -> IO a
forall (es :: [Effect]) a. Eff es a -> Env es -> IO a
unEff Eff (e : es) a
m Env (e : es)
es)

-- | Send an operation of the given effect to its handler for execution.
send
  :: (HasCallStack, DispatchOf e ~ Dynamic, e :> es)
  => e (Eff es) a
  -- ^ The operation.
  -> Eff es a
send :: forall (e :: Effect) (es :: [Effect]) a.
(HasCallStack, DispatchOf e ~ 'Dynamic, e :> es) =>
e (Eff es) a -> Eff es a
send e (Eff es) a
op = (Env es -> IO a) -> Eff es a
forall (es :: [Effect]) a. (Env es -> IO a) -> Eff es a
unsafeEff ((Env es -> IO a) -> Eff es a) -> (Env es -> IO a) -> Eff es a
forall a b. (a -> b) -> a -> b
$ \Env es
es -> do
  Handler Env handlerEs
handlerEs (HandlerImpl EffectHandler e handlerEs
handler) <- Env es -> IO (EffectRep (DispatchOf e) e)
forall (e :: Effect) (es :: [Effect]).
(HasCallStack, e :> es) =>
Env es -> IO (EffectRep (DispatchOf e) e)
getEnv Env es
es
  Bool -> IO () -> IO ()
forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
when (Env es
es.storage IORef Storage -> IORef Storage -> Bool
forall a. Eq a => a -> a -> Bool
/= Env handlerEs
handlerEs.storage) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    [Char] -> IO ()
forall a. HasCallStack => [Char] -> a
error [Char]
"es and handlerEs point to different Storages"
  -- Prevent the addition of unnecessary 'handler' stack frame to the call
  -- stack. Note that functions 'interpret', 'reinterpret', 'interpose' and
  -- 'impose' need to thaw the call stack so that useful stack frames from
  -- inside the effect handler continue to be added.
  Eff handlerEs a -> Env handlerEs -> IO a
forall (es :: [Effect]) a. Eff es a -> Env es -> IO a
unEff ((HasCallStack => LocalEnv es -> e (Eff es) a -> Eff handlerEs a)
-> LocalEnv es -> e (Eff es) a -> Eff handlerEs a
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack HasCallStack => LocalEnv es -> e (Eff es) a -> Eff handlerEs a
LocalEnv es -> e (Eff es) a -> Eff handlerEs a
EffectHandler e handlerEs
handler (Env es -> LocalEnv es
forall (localEs :: [Effect]). Env localEs -> LocalEnv localEs
LocalEnv Env es
es) e (Eff es) a
op) Env handlerEs
handlerEs
{-# NOINLINE send #-}

----------------------------------------
-- Static dispatch

-- | Require the 'IOE' effect for running statically dispatched effects whose
-- operations perform side effects.
type family MaybeIOE (sideEffects :: SideEffects) (es :: [Effect]) :: Constraint where
  MaybeIOE NoSideEffects   _  = ()
  MaybeIOE WithSideEffects es = IOE :> es

-- | Internal representations of statically dispatched effects.
data family StaticRep (e :: Effect) :: Type
type instance EffectRep (Static sideEffects) = StaticRep

-- | Run a statically dispatched effect with the given initial representation
-- and return the final value along with the final representation.
runStaticRep
  :: (HasCallStack, DispatchOf e ~ Static sideEffects, MaybeIOE sideEffects es)
  => StaticRep e -- ^ The initial representation.
  -> Eff (e : es) a
  -> Eff es (a, StaticRep e)
runStaticRep :: forall (e :: Effect) (sideEffects :: SideEffects) (es :: [Effect])
       a.
(HasCallStack, DispatchOf e ~ 'Static sideEffects,
 MaybeIOE sideEffects es) =>
StaticRep e -> Eff (e : es) a -> Eff es (a, StaticRep e)
runStaticRep StaticRep e
e0 Eff (e : es) a
m = (Env es -> IO (a, StaticRep e)) -> Eff es (a, StaticRep e)
forall (es :: [Effect]) a. (Env es -> IO a) -> Eff es a
unsafeEff ((Env es -> IO (a, StaticRep e)) -> Eff es (a, StaticRep e))
-> (Env es -> IO (a, StaticRep e)) -> Eff es (a, StaticRep e)
forall a b. (a -> b) -> a -> b
$ \Env es
es0 -> do
  IO (Env (e : es))
-> (Env (e : es) -> IO ())
-> (Env (e : es) -> IO (a, StaticRep e))
-> IO (a, StaticRep e)
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
inlineBracket
    (EffectRep (DispatchOf e) e
-> Relinker (EffectRep (DispatchOf e)) e
-> Env es
-> IO (Env (e : es))
forall (e :: Effect) (es :: [Effect]).
HasCallStack =>
EffectRep (DispatchOf e) e
-> Relinker (EffectRep (DispatchOf e)) e
-> Env es
-> IO (Env (e : es))
consEnv EffectRep (DispatchOf e) e
StaticRep e
e0 Relinker (EffectRep (DispatchOf e)) e
Relinker StaticRep e
forall (rep :: Effect -> Type) (e :: Effect). Relinker rep e
dummyRelinker Env es
es0)
    Env (e : es) -> IO ()
forall (e :: Effect) (es :: [Effect]).
HasCallStack =>
Env (e : es) -> IO ()
unconsEnv
    (\Env (e : es)
es -> (,) (a -> StaticRep e -> (a, StaticRep e))
-> IO a -> IO (StaticRep e -> (a, StaticRep e))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Eff (e : es) a -> Env (e : es) -> IO a
forall (es :: [Effect]) a. Eff es a -> Env es -> IO a
unEff Eff (e : es) a
m Env (e : es)
es IO (StaticRep e -> (a, StaticRep e))
-> IO (StaticRep e) -> IO (a, StaticRep e)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> Env (e : es) -> IO (EffectRep (DispatchOf e) e)
forall (e :: Effect) (es :: [Effect]).
(HasCallStack, e :> es) =>
Env es -> IO (EffectRep (DispatchOf e) e)
getEnv Env (e : es)
es)

-- | Run a statically dispatched effect with the given initial representation
-- and return the final value, discarding the final representation.
evalStaticRep
  :: (HasCallStack, DispatchOf e ~ Static sideEffects, MaybeIOE sideEffects es)
  => StaticRep e -- ^ The initial representation.
  -> Eff (e : es) a
  -> Eff es a
evalStaticRep :: forall (e :: Effect) (sideEffects :: SideEffects) (es :: [Effect])
       a.
(HasCallStack, DispatchOf e ~ 'Static sideEffects,
 MaybeIOE sideEffects es) =>
StaticRep e -> Eff (e : es) a -> Eff es a
evalStaticRep StaticRep e
e Eff (e : es) a
m = (Env es -> IO a) -> Eff es a
forall (es :: [Effect]) a. (Env es -> IO a) -> Eff es a
unsafeEff ((Env es -> IO a) -> Eff es a) -> (Env es -> IO a) -> Eff es a
forall a b. (a -> b) -> a -> b
$ \Env es
es0 -> do
  IO (Env (e : es))
-> (Env (e : es) -> IO ()) -> (Env (e : es) -> IO a) -> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
inlineBracket
    (EffectRep (DispatchOf e) e
-> Relinker (EffectRep (DispatchOf e)) e
-> Env es
-> IO (Env (e : es))
forall (e :: Effect) (es :: [Effect]).
HasCallStack =>
EffectRep (DispatchOf e) e
-> Relinker (EffectRep (DispatchOf e)) e
-> Env es
-> IO (Env (e : es))
consEnv EffectRep (DispatchOf e) e
StaticRep e
e Relinker (EffectRep (DispatchOf e)) e
Relinker StaticRep e
forall (rep :: Effect -> Type) (e :: Effect). Relinker rep e
dummyRelinker Env es
es0)
    Env (e : es) -> IO ()
forall (e :: Effect) (es :: [Effect]).
HasCallStack =>
Env (e : es) -> IO ()
unconsEnv
    (\Env (e : es)
es -> Eff (e : es) a -> Env (e : es) -> IO a
forall (es :: [Effect]) a. Eff es a -> Env es -> IO a
unEff Eff (e : es) a
m Env (e : es)
es)

-- | Run a statically dispatched effect with the given initial representation
-- and return the final representation, discarding the final value.
execStaticRep
  :: (HasCallStack, DispatchOf e ~ Static sideEffects, MaybeIOE sideEffects es)
  => StaticRep e -- ^ The initial representation.
  -> Eff (e : es) a
  -> Eff es (StaticRep e)
execStaticRep :: forall (e :: Effect) (sideEffects :: SideEffects) (es :: [Effect])
       a.
(HasCallStack, DispatchOf e ~ 'Static sideEffects,
 MaybeIOE sideEffects es) =>
StaticRep e -> Eff (e : es) a -> Eff es (StaticRep e)
execStaticRep StaticRep e
e0 Eff (e : es) a
m = (Env es -> IO (StaticRep e)) -> Eff es (StaticRep e)
forall (es :: [Effect]) a. (Env es -> IO a) -> Eff es a
unsafeEff ((Env es -> IO (StaticRep e)) -> Eff es (StaticRep e))
-> (Env es -> IO (StaticRep e)) -> Eff es (StaticRep e)
forall a b. (a -> b) -> a -> b
$ \Env es
es0 -> do
  IO (Env (e : es))
-> (Env (e : es) -> IO ())
-> (Env (e : es) -> IO (StaticRep e))
-> IO (StaticRep e)
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
inlineBracket
    (EffectRep (DispatchOf e) e
-> Relinker (EffectRep (DispatchOf e)) e
-> Env es
-> IO (Env (e : es))
forall (e :: Effect) (es :: [Effect]).
HasCallStack =>
EffectRep (DispatchOf e) e
-> Relinker (EffectRep (DispatchOf e)) e
-> Env es
-> IO (Env (e : es))
consEnv EffectRep (DispatchOf e) e
StaticRep e
e0 Relinker (EffectRep (DispatchOf e)) e
Relinker StaticRep e
forall (rep :: Effect -> Type) (e :: Effect). Relinker rep e
dummyRelinker Env es
es0)
    Env (e : es) -> IO ()
forall (e :: Effect) (es :: [Effect]).
HasCallStack =>
Env (e : es) -> IO ()
unconsEnv
    (\Env (e : es)
es -> Eff (e : es) a -> Env (e : es) -> IO a
forall (es :: [Effect]) a. Eff es a -> Env es -> IO a
unEff Eff (e : es) a
m Env (e : es)
es IO a -> IO (StaticRep e) -> IO (StaticRep e)
forall a b. IO a -> IO b -> IO b
forall (f :: Type -> Type) a b. Applicative f => f a -> f b -> f b
*> Env (e : es) -> IO (EffectRep (DispatchOf e) e)
forall (e :: Effect) (es :: [Effect]).
(HasCallStack, e :> es) =>
Env es -> IO (EffectRep (DispatchOf e) e)
getEnv Env (e : es)
es)

-- | Fetch the current representation of the effect.
getStaticRep
  :: (HasCallStack, DispatchOf e ~ Static sideEffects, e :> es)
  => Eff es (StaticRep e)
getStaticRep :: forall (e :: Effect) (sideEffects :: SideEffects) (es :: [Effect]).
(HasCallStack, DispatchOf e ~ 'Static sideEffects, e :> es) =>
Eff es (StaticRep e)
getStaticRep = (Env es -> IO (StaticRep e)) -> Eff es (StaticRep e)
forall (es :: [Effect]) a. (Env es -> IO a) -> Eff es a
unsafeEff ((Env es -> IO (StaticRep e)) -> Eff es (StaticRep e))
-> (Env es -> IO (StaticRep e)) -> Eff es (StaticRep e)
forall a b. (a -> b) -> a -> b
$ \Env es
es -> Env es -> IO (EffectRep (DispatchOf e) e)
forall (e :: Effect) (es :: [Effect]).
(HasCallStack, e :> es) =>
Env es -> IO (EffectRep (DispatchOf e) e)
getEnv Env es
es

-- | Set the current representation of the effect to the given value.
putStaticRep
  :: (HasCallStack, DispatchOf e ~ Static sideEffects, e :> es)
  => StaticRep e -> Eff es ()
putStaticRep :: forall (e :: Effect) (sideEffects :: SideEffects) (es :: [Effect]).
(HasCallStack, DispatchOf e ~ 'Static sideEffects, e :> es) =>
StaticRep e -> Eff es ()
putStaticRep StaticRep e
s = (Env es -> IO ()) -> Eff es ()
forall (es :: [Effect]) a. (Env es -> IO a) -> Eff es a
unsafeEff ((Env es -> IO ()) -> Eff es ()) -> (Env es -> IO ()) -> Eff es ()
forall a b. (a -> b) -> a -> b
$ \Env es
es -> Env es -> EffectRep (DispatchOf e) e -> IO ()
forall (e :: Effect) (es :: [Effect]).
(HasCallStack, e :> es) =>
Env es -> EffectRep (DispatchOf e) e -> IO ()
putEnv Env es
es EffectRep (DispatchOf e) e
StaticRep e
s

-- | Apply the function to the current representation of the effect and return a
-- value.
stateStaticRep
  :: (HasCallStack, DispatchOf e ~ Static sideEffects, e :> es)
  => (StaticRep e -> (a, StaticRep e))
  -- ^ The function to modify the representation.
  -> Eff es a
stateStaticRep :: forall (e :: Effect) (sideEffects :: SideEffects) (es :: [Effect])
       a.
(HasCallStack, DispatchOf e ~ 'Static sideEffects, e :> es) =>
(StaticRep e -> (a, StaticRep e)) -> Eff es a
stateStaticRep StaticRep e -> (a, StaticRep e)
f = (Env es -> IO a) -> Eff es a
forall (es :: [Effect]) a. (Env es -> IO a) -> Eff es a
unsafeEff ((Env es -> IO a) -> Eff es a) -> (Env es -> IO a) -> Eff es a
forall a b. (a -> b) -> a -> b
$ \Env es
es -> Env es
-> (EffectRep (DispatchOf e) e -> (a, EffectRep (DispatchOf e) e))
-> IO a
forall (e :: Effect) (es :: [Effect]) a.
(HasCallStack, e :> es) =>
Env es
-> (EffectRep (DispatchOf e) e -> (a, EffectRep (DispatchOf e) e))
-> IO a
stateEnv Env es
es EffectRep (DispatchOf e) e -> (a, EffectRep (DispatchOf e) e)
StaticRep e -> (a, StaticRep e)
f

-- | Apply the monadic function to the current representation of the effect and
-- return a value.
stateStaticRepM
  :: (HasCallStack, DispatchOf e ~ Static sideEffects, e :> es)
  => (StaticRep e -> Eff es (a, StaticRep e))
  -- ^ The function to modify the representation.
  -> Eff es a
stateStaticRepM :: forall (e :: Effect) (sideEffects :: SideEffects) (es :: [Effect])
       a.
(HasCallStack, DispatchOf e ~ 'Static sideEffects, e :> es) =>
(StaticRep e -> Eff es (a, StaticRep e)) -> Eff es a
stateStaticRepM StaticRep e -> Eff es (a, StaticRep e)
f = (Env es -> IO a) -> Eff es a
forall (es :: [Effect]) a. (Env es -> IO a) -> Eff es a
unsafeEff ((Env es -> IO a) -> Eff es a) -> (Env es -> IO a) -> Eff es a
forall a b. (a -> b) -> a -> b
$ \Env es
es -> ((forall a. IO a -> IO a) -> IO a) -> IO a
forall b. ((forall a. IO a -> IO a) -> IO b) -> IO b
E.mask (((forall a. IO a -> IO a) -> IO a) -> IO a)
-> ((forall a. IO a -> IO a) -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \forall a. IO a -> IO a
unmask -> do
  (a
a, StaticRep e
e) <- IO (a, StaticRep e) -> IO (a, StaticRep e)
forall a. IO a -> IO a
unmask (IO (a, StaticRep e) -> IO (a, StaticRep e))
-> (StaticRep e -> IO (a, StaticRep e))
-> StaticRep e
-> IO (a, StaticRep e)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Eff es (a, StaticRep e) -> Env es -> IO (a, StaticRep e)
forall (es :: [Effect]) a. Eff es a -> Env es -> IO a
`unEff` Env es
es) (Eff es (a, StaticRep e) -> IO (a, StaticRep e))
-> (StaticRep e -> Eff es (a, StaticRep e))
-> StaticRep e
-> IO (a, StaticRep e)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StaticRep e -> Eff es (a, StaticRep e)
f (StaticRep e -> IO (a, StaticRep e))
-> IO (StaticRep e) -> IO (a, StaticRep e)
forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< Env es -> IO (EffectRep (DispatchOf e) e)
forall (e :: Effect) (es :: [Effect]).
(HasCallStack, e :> es) =>
Env es -> IO (EffectRep (DispatchOf e) e)
getEnv Env es
es
  Env es -> EffectRep (DispatchOf e) e -> IO ()
forall (e :: Effect) (es :: [Effect]).
(HasCallStack, e :> es) =>
Env es -> EffectRep (DispatchOf e) e -> IO ()
putEnv Env es
es EffectRep (DispatchOf e) e
StaticRep e
e
  a -> IO a
forall a. a -> IO a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure a
a

-- | Execute a computation with a temporarily modified representation of the
-- effect.
localStaticRep
  :: (HasCallStack, DispatchOf e ~ Static sideEffects, e :> es)
  => (StaticRep e -> StaticRep e)
  -- ^ The function to temporarily modify the representation.
  -> Eff es a
  -> Eff es a
localStaticRep :: forall (e :: Effect) (sideEffects :: SideEffects) (es :: [Effect])
       a.
(HasCallStack, DispatchOf e ~ 'Static sideEffects, e :> es) =>
(StaticRep e -> StaticRep e) -> Eff es a -> Eff es a
localStaticRep StaticRep e -> StaticRep e
f Eff es a
m = (Env es -> IO a) -> Eff es a
forall (es :: [Effect]) a. (Env es -> IO a) -> Eff es a
unsafeEff ((Env es -> IO a) -> Eff es a) -> (Env es -> IO a) -> Eff es a
forall a b. (a -> b) -> a -> b
$ \Env es
es -> do
  IO (EffectRep (DispatchOf e) e)
-> (EffectRep (DispatchOf e) e -> IO ())
-> (EffectRep (DispatchOf e) e -> IO a)
-> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
inlineBracket
    (Env es
-> (EffectRep (DispatchOf e) e
    -> (EffectRep (DispatchOf e) e, EffectRep (DispatchOf e) e))
-> IO (EffectRep (DispatchOf e) e)
forall (e :: Effect) (es :: [Effect]) a.
(HasCallStack, e :> es) =>
Env es
-> (EffectRep (DispatchOf e) e -> (a, EffectRep (DispatchOf e) e))
-> IO a
stateEnv Env es
es ((EffectRep (DispatchOf e) e
  -> (EffectRep (DispatchOf e) e, EffectRep (DispatchOf e) e))
 -> IO (EffectRep (DispatchOf e) e))
-> (EffectRep (DispatchOf e) e
    -> (EffectRep (DispatchOf e) e, EffectRep (DispatchOf e) e))
-> IO (EffectRep (DispatchOf e) e)
forall a b. (a -> b) -> a -> b
$ \EffectRep (DispatchOf e) e
s -> (EffectRep (DispatchOf e) e
s, StaticRep e -> StaticRep e
f EffectRep (DispatchOf e) e
StaticRep e
s))
    (\EffectRep (DispatchOf e) e
s -> Env es -> EffectRep (DispatchOf e) e -> IO ()
forall (e :: Effect) (es :: [Effect]).
(HasCallStack, e :> es) =>
Env es -> EffectRep (DispatchOf e) e -> IO ()
putEnv Env es
es EffectRep (DispatchOf e) e
s)
    (\EffectRep (DispatchOf e) e
_ -> Eff es a -> Env es -> IO a
forall (es :: [Effect]) a. Eff es a -> Env es -> IO a
unEff Eff es a
m Env es
es)