{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-noncanonical-monad-instances #-}
{-# 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_

  -- * Fail
  , Fail(..)

  -- * IO
  , IOE
  , runEff

  -- * Prim
  , Prim
  , runPrim

  -- * Lifting
  , raise
  , subsume
  , inject

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

  -- ** Low-level unlifts
  , seqUnliftIO
  , concUnliftIO

  -- * Dispatch

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

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

  -- *** Primitive operations
  , consEnv
  , getEnv
  , putEnv
  , stateEnv
  , modifyEnv
  ) where

import Control.Applicative (liftA2)
import Control.Monad.Base
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 (HasCallStack)
import System.IO.Unsafe (unsafeDupablePerformIO)
import qualified Control.Exception as E
import qualified Control.Monad.Catch as C

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

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 (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
mconcat :: [Eff es a] -> Eff es a
$cmconcat :: forall (es :: [Effect]) a. Monoid a => [Eff es a] -> Eff es a
mappend :: Eff es a -> Eff es a -> Eff es a
$cmappend :: forall (es :: [Effect]) a.
Monoid a =>
Eff es a -> Eff es a -> Eff es a
mempty :: Eff es a
$cmempty :: forall (es :: [Effect]) a. Monoid 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
stimes :: forall b. Integral b => b -> Eff es a -> Eff es a
$cstimes :: forall (es :: [Effect]) a b.
(Semigroup a, Integral b) =>
b -> Eff es a -> Eff es a
sconcat :: NonEmpty (Eff es a) -> Eff es a
$csconcat :: forall (es :: [Effect]) a.
Semigroup a =>
NonEmpty (Eff es a) -> Eff es a
<> :: Eff es a -> Eff es a -> Eff es a
$c<> :: forall (es :: [Effect]) a.
Semigroup a =>
Eff es a -> Eff es a -> Eff es a
Semigroup)

-- | Run a pure 'Eff' computation.
--
-- For running computations with side effects see 'runEff'.
runPureEff :: Eff '[] a -> a
runPureEff :: forall a. 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 '[])
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
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'.
unliftStrategy :: IOE :> es => Eff es UnliftStrategy
unliftStrategy :: forall (es :: [Effect]). (IOE :> es) => Eff es UnliftStrategy
unliftStrategy = do
  IOE UnliftStrategy
unlift <- Eff es (StaticRep IOE)
forall (e :: Effect) (sideEffects :: SideEffects) (es :: [Effect]).
(DispatchOf e ~ 'Static sideEffects, e :> es) =>
Eff es (StaticRep e)
getStaticRep
  UnliftStrategy -> Eff es UnliftStrategy
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure UnliftStrategy
unlift

-- | Locally override the 'UnliftStrategy' with the given value.
withUnliftStrategy :: IOE :> es => UnliftStrategy -> Eff es a -> Eff es a
withUnliftStrategy :: forall (es :: [Effect]) a.
(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.
(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 current 'UnliftStrategy'.
--
-- This function is equivalent to 'Effectful.withRunInIO', but has a
-- 'HasCallStack' constraint for accurate stack traces in case an insufficiently
-- powerful 'UnliftStrategy' is used and the unlifting function fails.
withEffToIO
  :: (HasCallStack, IOE :> es)
  => ((forall r. Eff es r -> IO r) -> IO a)
  -- ^ Continuation with the unlifting function in scope.
  --
  -- /Note:/ the strategy is reset to 'SeqUnlift' inside the continuation.
  -> Eff es a
withEffToIO :: forall (es :: [Effect]) a.
(HasCallStack, IOE :> es) =>
((forall r. Eff es r -> IO r) -> IO a) -> Eff es a
withEffToIO (forall r. Eff es r -> IO r) -> IO a
f = Eff es UnliftStrategy
forall (es :: [Effect]). (IOE :> es) => Eff es UnliftStrategy
unliftStrategy Eff es UnliftStrategy -> (UnliftStrategy -> Eff es a) -> Eff es a
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
  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
f
  ConcUnlift Persistence
p Limit
b -> UnliftStrategy -> Eff es a -> Eff es a
forall (es :: [Effect]) a.
(IOE :> es) =>
UnliftStrategy -> Eff es a -> Eff es a
withUnliftStrategy UnliftStrategy
SeqUnlift (Eff es a -> Eff es a) -> Eff es a -> Eff es a
forall a b. (a -> b) -> a -> b
$ do
    (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
f

-- | 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 = ((forall r. Eff es r -> IO r) -> IO a)
-> Env es -> (forall r. Eff es r -> Env es -> IO r) -> IO a
forall (m :: Type -> Type) a (es :: [Effect]).
HasCallStack =>
((forall r. m r -> IO r) -> IO a)
-> Env es -> (forall r. m r -> Env es -> IO r) -> IO a
seqUnlift (forall r. Eff es r -> IO r) -> IO a
k Env es
es forall (es :: [Effect]) a. Eff es a -> Env es -> IO a
forall r. Eff es r -> Env es -> IO r
unEff

-- | 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
persistence Limit
limit (forall r. Eff es r -> IO r) -> IO a
k = Persistence
-> Limit
-> ((forall r. Eff es r -> IO r) -> IO a)
-> Env es
-> (forall r. Eff es r -> Env es -> IO r)
-> IO a
forall (m :: Type -> Type) a (es :: [Effect]).
HasCallStack =>
Persistence
-> Limit
-> ((forall r. m r -> IO r) -> IO a)
-> Env es
-> (forall r. m r -> Env es -> IO r)
-> IO a
concUnlift Persistence
persistence Limit
limit (forall r. Eff es r -> IO r) -> IO a
k Env es
es forall (es :: [Effect]) a. Eff es a -> Env es -> IO a
forall r. Eff es r -> Env es -> IO r
unEff

----------------------------------------
-- 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 (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 (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 (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 (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 (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 (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
  return :: forall a. a -> Eff es a
return = 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 (f :: Type -> Type) a. Applicative f => a -> f a
pure
  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 (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
  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 (m :: Type -> Type) a b. Monad m => m a -> m b -> m b
>> Env es -> IO b
mb Env es
es

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 (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

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

instance C.MonadThrow (Eff es) where
  throwM :: forall e a. 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
. e -> IO a
forall e a. Exception e => e -> IO a
E.throwIO

instance C.MonadCatch (Eff es) where
  catch :: forall e a. Exception e => Eff es a -> (e -> Eff es a) -> Eff es a
catch Eff es a
m e -> Eff es a
handler = (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
    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 IO a -> (e -> IO a) -> IO a
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`E.catch` \e
e -> do
      Env es -> IO ()
forall (es :: [Effect]). Env es -> IO ()
checkSizeEnv Env es
es
      Eff es a -> Env es -> IO a
forall (es :: [Effect]) a. Eff es a -> Env es -> IO a
unEff (e -> Eff es a
handler e
e) Env es
es

instance C.MonadMask (Eff es) where
  mask :: forall b.
((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 = (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 -> ((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
unmask ->
    Eff es b -> Env es -> IO b
forall (es :: [Effect]) a. Eff es a -> Env es -> IO a
unEff ((forall a. Eff es a -> Eff es a) -> Eff es b
k ((forall a. Eff es a -> Eff es a) -> Eff es b)
-> (forall a. Eff es a -> Eff es a) -> Eff es b
forall a b. (a -> b) -> a -> b
$ \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
$ IO a -> IO a
forall a. IO a -> IO a
unmask (IO a -> IO a) -> (Env es -> IO a) -> Env es -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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

  uninterruptibleMask :: forall b.
((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 = (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 -> ((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
unmask ->
    Eff es b -> Env es -> IO b
forall (es :: [Effect]) a. Eff es a -> Env es -> IO a
unEff ((forall a. Eff es a -> Eff es a) -> Eff es b
k ((forall a. Eff es a -> Eff es a) -> Eff es b)
-> (forall a. Eff es a -> Eff es a) -> Eff es b
forall a b. (a -> b) -> a -> b
$ \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
$ IO a -> IO a
forall a. IO a -> IO a
unmask (IO a -> IO a) -> (Env es -> IO a) -> Env es -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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

  generalBracket :: forall a b c.
Eff es a
-> (a -> ExitCase b -> Eff es c)
-> (a -> Eff es b)
-> Eff es (b, c)
generalBracket Eff es a
acquire a -> ExitCase b -> Eff es c
release a -> Eff es b
use = (Env es -> IO (b, c)) -> Eff es (b, c)
forall (es :: [Effect]) a. (Env es -> IO a) -> Eff es a
unsafeEff ((Env es -> IO (b, c)) -> Eff es (b, c))
-> (Env es -> IO (b, c)) -> Eff es (b, c)
forall a b. (a -> b) -> a -> b
$ \Env es
es -> ((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
resource <- Eff es a -> Env es -> IO a
forall (es :: [Effect]) a. Eff es a -> Env es -> IO a
unEff Eff es a
acquire Env es
es
    b
b <- IO b -> IO b
forall a. IO a -> IO a
unmask (Eff es b -> Env es -> IO b
forall (es :: [Effect]) a. Eff es a -> Env es -> IO a
unEff (a -> Eff es b
use a
resource) Env es
es) IO b -> (SomeException -> IO b) -> IO b
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`E.catch` \SomeException
e -> do
      Env es -> IO ()
forall (es :: [Effect]). Env es -> IO ()
checkSizeEnv Env es
es
      c
_ <- Eff es c -> Env es -> IO c
forall (es :: [Effect]) a. Eff es a -> Env es -> IO a
unEff (a -> ExitCase b -> Eff es c
release a
resource (ExitCase b -> Eff es c) -> ExitCase b -> Eff es c
forall a b. (a -> b) -> a -> b
$ SomeException -> ExitCase b
forall a. SomeException -> ExitCase a
C.ExitCaseException SomeException
e) Env es
es
      SomeException -> IO b
forall e a. Exception e => e -> IO a
E.throwIO SomeException
e
    c
c <- Eff es c -> Env es -> IO c
forall (es :: [Effect]) a. Eff es a -> Env es -> IO a
unEff (a -> ExitCase b -> Eff es c
release a
resource (ExitCase b -> Eff es c) -> ExitCase b -> Eff es c
forall a b. (a -> b) -> a -> b
$ b -> ExitCase b
forall a. a -> ExitCase a
C.ExitCaseSuccess b
b) Env es
es
    (b, c) -> IO (b, c)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (b
b, c
c)

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

-- | Provide the ability to use the 'MonadFail' instance of '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. String -> Eff es a
fail = 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 (Fail (Eff es) a -> Eff es a)
-> (String -> Fail (Eff es) a) -> String -> Eff es a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Fail (Eff es) a
forall (m :: Type -> Type) a. String -> Fail m a
Fail

----------------------------------------
-- 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 :: Eff '[IOE] a -> IO a
runEff :: forall a. 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]).
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
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 '[])
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_

-- | Use 'withEffToIO' if you want accurate stack traces on errors.
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) -> Eff es b
forall (es :: [Effect]) a.
(HasCallStack, IOE :> es) =>
((forall r. Eff es r -> IO r) -> IO a) -> Eff es a
withEffToIO

-- | Instance included for compatibility with existing code, usage of 'liftIO'
-- is preferrable.
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
-- 'Effectful.withRunInIO' is preferrable.
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) -> Eff es a
forall (es :: [Effect]) a.
(HasCallStack, IOE :> es) =>
((forall r. Eff es r -> IO r) -> IO a) -> Eff es a
withEffToIO
  restoreM :: forall a. StM (Eff es) a -> Eff es a
restoreM = StM (Eff es) 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

-- | Run an 'Eff' computation with primitive state-transformer actions.
runPrim :: IOE :> es => Eff (Prim : es) a -> Eff es a
runPrim :: forall (es :: [Effect]) a.
(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.
(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) = RealWorld
  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# RealWorld -> (# State# RealWorld, a #)) -> IO a)
-> (State# RealWorld -> (# State# RealWorld, 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

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

-- | Lift an 'Eff' computation into an effect stack with one more effect.
raise :: Eff es a -> Eff (e : es) a
raise :: forall (es :: [Effect]) a (e :: Effect). 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

-- | 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
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
E.bracket (Env es -> IO (Env (e : es))
forall (e :: Effect) (es :: [Effect]).
(e :> es) =>
Env es -> IO (Env (e : es))
subsumeEnv Env es
es0)
            Env (e : es) -> IO ()
forall (e :: Effect) (es :: [Effect]).
(e :> es) =>
Env (e : es) -> IO ()
unsubsumeEnv
            (\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)

-- | Allow for running an effect stack @xs@ within @es@ as long as @xs@ is a
-- permutation (with possible duplicates) of a subset of @es@.
--
-- Generalizes 'raise' and 'subsume'.
--
-- /Note:/ this function should be needed rarely, usually when you have to cross
-- API boundaries and monomorphic effect stacks are involved. Using monomorphic
-- stacks is discouraged (see 'Eff'), but sometimes might be necessary due to
-- external constraints.
inject :: Subset xs es => Eff xs a -> Eff es a
inject :: forall (xs :: [Effect]) (es :: [Effect]) a.
Subset xs es =>
Eff xs a -> Eff es a
inject Eff xs 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 xs a -> Env xs -> IO a
forall (es :: [Effect]) a. Eff es a -> Env es -> IO a
unEff Eff xs a
m (Env xs -> IO a) -> IO (Env xs) -> IO a
forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< Env es -> IO (Env xs)
forall (xs :: [Effect]) (es :: [Effect]).
Subset xs es =>
Env es -> IO (Env xs)
injectEnv Env es
es

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

type role LocalEnv nominal 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.
--
-- The second type variable represents effects of a handler and is needed for
-- technical reasons to guarantee soundness.
newtype LocalEnv (localEs :: [Effect]) (handlerEs :: [Effect]) = LocalEnv (Env localEs)

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

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

relinkHandler :: Relinker Handler e
relinkHandler :: forall (e :: Effect). Relinker Handler e
relinkHandler = ((forall (es :: [Effect]). Env es -> IO (Env es))
 -> Handler e -> IO (Handler e))
-> Relinker Handler e
forall (rep :: Effect -> Type) (e :: Effect).
((forall (es :: [Effect]). Env es -> IO (Env es))
 -> rep e -> IO (rep e))
-> Relinker rep e
Relinker (((forall (es :: [Effect]). Env es -> IO (Env es))
  -> Handler e -> IO (Handler e))
 -> Relinker Handler e)
-> ((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 es
handlerEs EffectHandler e es
handle) -> do
  Env es
newHandlerEs <- Env es -> IO (Env es)
forall (es :: [Effect]). Env es -> IO (Env es)
relink Env es
handlerEs
  Handler e -> IO (Handler e)
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 es -> EffectHandler e es -> Handler e
forall (es :: [Effect]) (e :: Effect).
Env es -> EffectHandler e es -> Handler e
Handler Env es
newHandlerEs EffectHandler e es
handle

-- | Run a dynamically dispatched effect with the given handler.
runHandler :: DispatchOf e ~ Dynamic => Handler e -> Eff (e : es) a -> Eff es a
runHandler :: forall (e :: Effect) (es :: [Effect]) a.
(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
E.bracket (EffectRep (DispatchOf e) e
-> Relinker (EffectRep (DispatchOf e)) e
-> Env es
-> IO (Env (e : es))
forall (e :: Effect) (es :: [Effect]).
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
forall (e :: Effect). Relinker Handler e
relinkHandler Env es
es0)
            Env (e : es) -> IO ()
forall (e :: Effect) (es :: [Effect]). 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 effect.
  -> 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 es
handlerEs EffectHandler e es
handle <- Env es -> IO (EffectRep (DispatchOf e) e)
forall (e :: Effect) (es :: [Effect]).
(e :> es) =>
Env es -> IO (EffectRep (DispatchOf e) e)
getEnv Env es
es
  Eff es a -> Env es -> IO a
forall (es :: [Effect]) a. Eff es a -> Env es -> IO a
unEff (LocalEnv es es -> e (Eff es) a -> Eff es a
EffectHandler e es
handle (Env es -> LocalEnv es es
forall (localEs :: [Effect]) (handlerEs :: [Effect]).
Env localEs -> LocalEnv localEs handlerEs
LocalEnv Env es
es) e (Eff es) a
op) Env es
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
  :: (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.
(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
E.bracket (EffectRep (DispatchOf e) e
-> Relinker (EffectRep (DispatchOf e)) e
-> Env es
-> IO (Env (e : es))
forall (e :: Effect) (es :: [Effect]).
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
forall (rep :: Effect -> Type) (e :: Effect). Relinker rep e
dummyRelinker Env es
es0)
            Env (e : es) -> IO ()
forall (e :: Effect) (es :: [Effect]). 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 (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]).
(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
  :: (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.
(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
E.bracket (EffectRep (DispatchOf e) e
-> Relinker (EffectRep (DispatchOf e)) e
-> Env es
-> IO (Env (e : es))
forall (e :: Effect) (es :: [Effect]).
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
forall (rep :: Effect -> Type) (e :: Effect). Relinker rep e
dummyRelinker Env es
es0)
            Env (e : es) -> IO ()
forall (e :: Effect) (es :: [Effect]). 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
  :: (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.
(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
E.bracket (EffectRep (DispatchOf e) e
-> Relinker (EffectRep (DispatchOf e)) e
-> Env es
-> IO (Env (e : es))
forall (e :: Effect) (es :: [Effect]).
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
forall (rep :: Effect -> Type) (e :: Effect). Relinker rep e
dummyRelinker Env es
es0)
            Env (e : es) -> IO ()
forall (e :: Effect) (es :: [Effect]). 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 (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]).
(e :> es) =>
Env es -> IO (EffectRep (DispatchOf e) e)
getEnv Env (e : es)
es)

-- | Fetch the current representation of the effect.
getStaticRep :: (DispatchOf e ~ Static sideEffects, e :> es) => Eff es (StaticRep e)
getStaticRep :: forall (e :: Effect) (sideEffects :: SideEffects) (es :: [Effect]).
(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]).
(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 :: (DispatchOf e ~ Static sideEffects, e :> es) => StaticRep e -> Eff es ()
putStaticRep :: forall (e :: Effect) (sideEffects :: SideEffects) (es :: [Effect]).
(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]).
(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
  :: (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.
(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.
(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
  :: (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.
(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
s) <- (\StaticRep e
s0 -> IO (a, StaticRep e) -> IO (a, StaticRep e)
forall a. IO a -> IO a
unmask (IO (a, StaticRep e) -> IO (a, StaticRep e))
-> IO (a, StaticRep e) -> IO (a, StaticRep e)
forall a b. (a -> b) -> a -> b
$ Eff es (a, StaticRep e) -> Env es -> IO (a, StaticRep e)
forall (es :: [Effect]) a. Eff es a -> Env es -> IO a
unEff (StaticRep e -> Eff es (a, StaticRep e)
f StaticRep e
s0) Env es
es) (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]).
(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]).
(e :> es) =>
Env es -> EffectRep (DispatchOf e) e -> IO ()
putEnv Env es
es EffectRep (DispatchOf e) e
StaticRep e
s
  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
  :: (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.
(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
E.bracket (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.
(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]).
(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)