{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE ImplicitParams #-}
-- | Dynamically dispatched effects.
module Effectful.Dispatch.Dynamic
  ( -- * Introduction
    -- $intro

    -- ** An example
    -- $example

    -- ** First order and higher order effects
    -- $order

    -- ** Integration with @mtl@ style effects
    -- $integration

    -- *** Functional dependencies
    -- $mtl-fundeps

    -- * Sending operations to the handler
    send
  , passthrough

    -- * Handling effects
  , EffectHandler
  , interpret
  , interpretWith
  , reinterpret
  , reinterpretWith
  , interpose
  , interposeWith
  , impose
  , imposeWith

    -- ** Handling local 'Eff' computations
  , LocalEnv

    -- *** Unlifts
  , localSeqUnlift
  , localSeqUnliftIO
  , localUnlift
  , localUnliftIO

    -- *** Lifts
  , localSeqLift
  , localLift
  , withLiftMap
  , withLiftMapIO

    -- *** Bidirectional lifts
  , localLiftUnlift
  , localLiftUnliftIO

    -- *** Misc
  , localSeqLend
  , localLend
  , localSeqBorrow
  , localBorrow
  , localLendBorrow
  , SharedSuffix
  , KnownSubset
  , type (++)

    -- ** Utils for first order effects
  , EffectHandler_
  , interpret_
  , interpretWith_
  , reinterpret_
  , reinterpretWith_
  , interpose_
  , interposeWith_
  , impose_
  , imposeWith_

    -- * Re-exports
  , HasCallStack
  ) where

import Control.Monad
import Data.Primitive.PrimArray
import GHC.Stack
import GHC.TypeLits

import Effectful.Internal.Effect
import Effectful.Internal.Env
import Effectful.Internal.Monad
import Effectful.Internal.Utils

-- $intro
--
-- A dynamically dispatched effect is a collection of operations that can be
-- interpreted in different ways at runtime, depending on the handler that is
-- used to run the effect.
--
-- This allows a programmer to separate the __what__ from the __how__,
-- i.e. define effects that model what the code should do, while providing
-- handlers that determine how it should do it later. Moreover, different
-- environments can use different handlers to change the behavior of specific
-- parts of the application if appropriate.
--

-- $example
--
-- Let's create an effect for basic file access, i.e. writing and reading files.
--
-- First, we need to define a generalized algebraic data type of kind 'Effect',
-- where each constructor corresponds to a specific operation of the effect in
-- question.
--
-- >>> :{
--   data FileSystem :: Effect where
--     ReadFile  :: FilePath -> FileSystem m String
--     WriteFile :: FilePath -> String -> FileSystem m ()
-- :}
--
-- >>> type instance DispatchOf FileSystem = Dynamic
--
-- The @FileSystem@ effect has two operations:
--
-- - @ReadFile@, which takes a @FilePath@ and returns a @String@ in the monadic
--   context.
--
-- - @WriteFile@, which takes a @FilePath@, a @String@ and returns a @()@ in the
--   monadic context.
--
-- For people familiar with @mtl@ style effects, note that the syntax looks very
-- similar to defining an appropriate type class:
--
-- @
-- class FileSystem m where
--   readFile  :: FilePath -> m String
--   writeFile :: FilePath -> String -> m ()
-- @
--
-- The biggest difference between these two is that the definition of a type
-- class gives us operations as functions, while the definition of an effect
-- gives us operations as data constructors. They can be turned into functions
-- with the help of 'send':
--
-- >>> :{
--   readFile :: (HasCallStack, FileSystem :> es) => FilePath -> Eff es String
--   readFile path = send (ReadFile path)
-- :}
--
-- >>> :{
--   writeFile :: (HasCallStack, FileSystem :> es) => FilePath -> String -> Eff es ()
--   writeFile path content = send (WriteFile path content)
-- :}
--
-- /Note:/ the above functions and the 'DispatchOf' instance can also be
-- automatically generated by the
-- [@makeEffect@](https://hackage.haskell.org/package/effectful-th/docs/Effectful-TH.html#v:makeEffect)
-- function from the
-- [effectful-th](https://hackage.haskell.org/package/effectful-th) package.
--
-- The following defines an 'EffectHandler' that reads and writes files from the
-- drive:
--
-- >>> import Effectful.Error.Static
-- >>> import Effectful.Exception
-- >>> import System.IO qualified as IO
--
-- >>> newtype FsError = FsError String deriving Show
--
-- >>> :{
--  runFileSystemIO
--    :: (IOE :> es, Error FsError :> es)
--    => Eff (FileSystem : es) a
--    -> Eff es a
--  runFileSystemIO = interpret $ \_ -> \case
--    ReadFile path           -> adapt $ IO.readFile path
--    WriteFile path contents -> adapt $ IO.writeFile path contents
--    where
--      adapt m = liftIO m `catchIO` \e -> throwError . FsError $ show e
-- :}
--
-- Here, we use 'interpret' and simply execute corresponding 'IO' actions for
-- each operation, additionally doing a bit of error management.
--
-- On the other hand, maybe there is a situation in which instead of interacting
-- with the outside world, a pure, in-memory storage is preferred:
--
-- >>> import Data.Map.Strict qualified as M
-- >>> import Effectful.State.Static.Local
--
-- >>> :{
--   runFileSystemPure
--     :: Error FsError :> es
--     => M.Map FilePath String
--     -> Eff (FileSystem : es) a
--     -> Eff es a
--   runFileSystemPure fs0 = reinterpret (evalState fs0) $ \_ -> \case
--     ReadFile path -> gets (M.lookup path) >>= \case
--       Just contents -> pure contents
--       Nothing       -> throwError . FsError $ "File not found: " ++ show path
--     WriteFile path contents -> modify $ M.insert path contents
-- :}
--
-- Here, we use 'reinterpret' and introduce a
-- t'Effectful.State.Static.Local.State' effect for the storage that is private
-- to the effect handler and cannot be accessed outside of it.
--
-- Let's compare how these differ.
--
-- >>> :{
--   action = do
--     file <- readFile "effectful-core.cabal"
--     pure $ length file > 0
-- :}
--
-- >>> :t action
-- action :: (FileSystem :> es) => Eff es Bool
--
-- >>> runEff . runError @FsError . runFileSystemIO $ action
-- Right True
--
-- >>> runPureEff . runErrorNoCallStack @FsError . runFileSystemPure M.empty $ action
-- Left (FsError "File not found: \"effectful-core.cabal\"")
--

-- $order
--
-- Note that the definition of the @FileSystem@ effect from the previous section
-- doesn't use the @m@ type parameter. What is more, when the effect is
-- interpreted, the 'LocalEnv' argument of the 'EffectHandler' is also not
-- used. Such effects are /first order/.
--
-- If an effect makes use of the @m@ parameter, it is a /higher order effect/.
--
-- /Note:/ for handling first order effects you can use 'interpret_' or
-- 'reinterpret_' whose 'EffectHandler_' doesn't take the 'LocalEnv' parameter.
--
-- Interpretation of higher order effects is slightly more involving. To see
-- why, let's consider the @Profiling@ effect for logging how much time a
-- specific action took to run:
--
-- >>> :{
--   data Profiling :: Effect where
--     Profile :: String -> m a -> Profiling m a
-- :}
--
-- >>> type instance DispatchOf Profiling = Dynamic
--
-- >>> :{
--   profile :: (HasCallStack, Profiling :> es) => String -> Eff es a -> Eff es a
--   profile label action = send (Profile label action)
-- :}
--
-- If we naively try to interpret it, we will run into trouble:
--
-- >>> import GHC.Clock (getMonotonicTime)
--
-- >>> :{
--  runProfiling :: IOE :> es => Eff (Profiling : es) a -> Eff es a
--  runProfiling = interpret $ \_ -> \case
--    Profile label action -> do
--      t1 <- liftIO getMonotonicTime
--      r <- action
--      t2 <- liftIO getMonotonicTime
--      liftIO . putStrLn $ "Action '" ++ label ++ "' took " ++ show (t2 - t1) ++ " seconds."
--      pure r
-- :}
-- ...
-- ... Couldn't match type ‘localEs’ with ‘es’
-- ...
--
-- The problem is that @action@ has a type @Eff localEs a@, while the monad of
-- the effect handler is @Eff es@. @localEs@ represents the /local environment/
-- in which the @Profile@ operation was called, which is more or less opaque to
-- the effect handler.
--
-- The solution is to use the 'LocalEnv' that an 'EffectHandler' is given to run
-- the action using one of the functions from the 'localUnlift' family:
--
-- >>> :{
--  runProfiling :: IOE :> es => Eff (Profiling : es) a -> Eff es a
--  runProfiling = interpret $ \env -> \case
--    Profile label action -> localSeqUnliftIO env $ \unlift -> do
--      t1 <- getMonotonicTime
--      r <- unlift action
--      t2 <- getMonotonicTime
--      putStrLn $ "Action '" ++ label ++ "' took " ++ show (t2 - t1) ++ " seconds."
--      pure r
-- :}
--
-- In a similar way we can define a dummy interpreter that does no profiling:
--
-- >>> :{
--  runNoProfiling :: Eff (Profiling : es) a -> Eff es a
--  runNoProfiling = interpret $ \env -> \case
--    Profile label action -> localSeqUnlift env $ \unlift -> unlift action
-- :}
--
-- ...and it's done.
--
-- >>> action = profile "greet" . liftIO $ putStrLn "Hello!"
--
-- >>> :t action
-- action :: (Profiling :> es, IOE :> es) => Eff es ()
--
-- >>> runEff . runProfiling $ action
-- Hello!
-- Action 'greet' took ... seconds.
--
-- >>> runEff . runNoProfiling $ action
-- Hello!
--

-- $integration
--
-- #integration#
--
-- There exists a lot of libraries that provide their functionality as an @mtl@
-- style effect, which generally speaking is a type class that contains core
-- operations of the library in question.
--
-- Such effects are quite easy to use with the 'Eff' monad. As an example,
-- consider the @mtl@ style effect for generation of random numbers:
--
-- >>> :{
--   class Monad m => MonadRNG m where
--     randomInt :: m Int
-- :}
--
-- Let's say the library also defines a helper function for generation of random
-- strings:
--
-- >>> import Control.Monad
-- >>> import Data.Char
--
-- >>> :{
--  randomString :: MonadRNG m => Int -> m String
--  randomString n = map chr <$> replicateM n randomInt
-- :}
--
-- To make it possible to use it with the 'Eff' monad, the first step is to
-- create an effect with operations that mirror the ones of a type class:
--
-- >>> :{
--   data RNG :: Effect where
--     RandomInt :: RNG m Int
-- :}
--
-- >>> type instance DispatchOf RNG = Dynamic
--
-- If we continued as in the example above, we'd now create top level helper
-- functions that execute effect operations using 'send', in this case
-- @randomInt@ tied to @RandomInt@. But this function is already declared by the
-- @MonadRNG@ type class! Therefore, what we do instead is provide an
-- __orphan__, __canonical__ instance of @MonadRNG@ for 'Eff' that delegates to
-- the @RNG@ effect:
--
-- >>> :{
--   instance RNG :> es => MonadRNG (Eff es) where
--     randomInt = send RandomInt
-- :}
--
-- Now we only need an interpreter:
--
-- >>> :{
--   runDummyRNG :: Eff (RNG : es) a -> Eff es a
--   runDummyRNG = interpret_ $ \case
--     RandomInt -> pure 55
-- :}
--
-- and we can use any function that requires a @MonadRNG@ constraint with the
-- 'Eff' monad as long as the @RNG@ effect is in place:
--
-- >>> runEff . runDummyRNG $ randomString 3
-- "777"
--

-- $mtl-fundeps
--
-- For dealing with classes that employ functional dependencies an additional
-- trick is needed.
--
-- Consider the following:
--
-- >>> :set -XFunctionalDependencies
--
-- >>> :{
--   class Monad m => MonadInput i m | m -> i where
--     input :: m i
-- :}
--
-- An attempt to define the instance as in the example above leads to violation
-- of the liberal coverage condition:
--
-- >>> :{
--   instance Reader i :> es => MonadInput i (Eff es) where
--     input = ask
-- :}
-- ...
-- ...Illegal instance declaration for ‘MonadInput i (Eff es)’...
-- ...  The liberal coverage condition fails in class ‘MonadInput’...
-- ...    for functional dependency: ‘m -> i’...
-- ...
--
-- However, there exists a trick for bypassing the coverage condition,
-- i.e. including the instance head in its context:
--
-- >>> :{
--   instance (MonadInput i (Eff es), Reader i :> es) => MonadInput i (Eff es) where
--     input = ask
-- :}
--
-- Now the @MonadInput@ class can be used with the 'Eff' monad:
--
-- >>> :{
--   double :: MonadInput Int m => m Int
--   double = (+) <$> input <*> input
-- :}
--
-- >>> runPureEff . runReader @Int 3 $ double
-- 6

-- | A variant of 'send' for passing operations to the upstream handler within
-- 'interpose' and 'impose' without having to fully pattern match on them.
passthrough
  :: (HasCallStack, DispatchOf e ~ Dynamic, e :> es, e :> localEs)
  => LocalEnv localEs
  -> e (Eff localEs) a
  -- ^ The operation.
  -> Eff es a
passthrough :: forall (e :: Effect) (es :: [Effect]) (localEs :: [Effect]) a.
(HasCallStack, DispatchOf e ~ 'Dynamic, e :> es, e :> localEs) =>
LocalEnv localEs -> e (Eff localEs) a -> Eff es a
passthrough LocalEnv localEs
localEs e (Eff localEs) 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
  Env localEs
les <- Env es -> LocalEnv localEs -> IO (Env localEs)
forall (es :: [Effect]) (localEs :: [Effect]).
HasCallStack =>
Env es -> LocalEnv localEs -> IO (Env localEs)
unwrapLocalEnv Env es
es LocalEnv localEs
localEs
  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 localEs
les.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]
"les 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 localEs -> e (Eff localEs) a -> Eff handlerEs a)
-> LocalEnv localEs -> e (Eff localEs) a -> Eff handlerEs a
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack HasCallStack =>
LocalEnv localEs -> e (Eff localEs) a -> Eff handlerEs a
LocalEnv localEs -> e (Eff localEs) a -> Eff handlerEs a
EffectHandler e handlerEs
handler LocalEnv localEs
localEs e (Eff localEs) a
op) Env handlerEs
handlerEs
{-# NOINLINE passthrough #-}

----------------------------------------
-- Handling effects

-- | Interpret an effect.
--
-- /Note:/ if you want to use intermediate effects in multiple handlers, then
-- hide them from downstream, have a look at 'inject'.
interpret
  :: (HasCallStack, DispatchOf e ~ Dynamic)
  => EffectHandler e es
  -- ^ The effect handler.
  -> Eff (e : es) a
  -> Eff      es  a
interpret :: forall (e :: Effect) (es :: [Effect]) a.
(HasCallStack, DispatchOf e ~ 'Dynamic) =>
EffectHandler e es -> Eff (e : es) a -> Eff es a
interpret EffectHandler e es
handler Eff (e : es) a
action = Eff (e : es) a -> HandlerImpl e es -> Eff es a
forall (e :: Effect) (es :: [Effect]) a.
(HasCallStack, DispatchOf e ~ 'Dynamic) =>
Eff (e : es) a -> HandlerImpl e es -> Eff es a
interpretImpl Eff (e : es) a
action (HandlerImpl e es -> Eff es a) -> HandlerImpl e es -> Eff es a
forall a b. (a -> b) -> a -> b
$
  EffectHandler e es -> HandlerImpl e es
forall (e :: Effect) (es :: [Effect]).
EffectHandler e es -> HandlerImpl e es
HandlerImpl (let ?callStack = CallStack -> CallStack
thawCallStack HasCallStack
CallStack
?callStack in LocalEnv localEs -> e (Eff localEs) a -> Eff es a
EffectHandler e es
handler)

-- | 'interpret' with the effect handler as the last argument.
--
-- @since 2.4.0.0
interpretWith
  :: (HasCallStack, DispatchOf e ~ Dynamic)
  => Eff (e : es) a
  -> EffectHandler e es
  -- ^ The effect handler.
  -> Eff      es  a
interpretWith :: forall (e :: Effect) (es :: [Effect]) a.
(HasCallStack, DispatchOf e ~ 'Dynamic) =>
Eff (e : es) a -> EffectHandler e es -> Eff es a
interpretWith Eff (e : es) a
action EffectHandler e es
handler = Eff (e : es) a -> HandlerImpl e es -> Eff es a
forall (e :: Effect) (es :: [Effect]) a.
(HasCallStack, DispatchOf e ~ 'Dynamic) =>
Eff (e : es) a -> HandlerImpl e es -> Eff es a
interpretImpl Eff (e : es) a
action (HandlerImpl e es -> Eff es a) -> HandlerImpl e es -> Eff es a
forall a b. (a -> b) -> a -> b
$
  EffectHandler e es -> HandlerImpl e es
forall (e :: Effect) (es :: [Effect]).
EffectHandler e es -> HandlerImpl e es
HandlerImpl (let ?callStack = CallStack -> CallStack
thawCallStack HasCallStack
CallStack
?callStack in LocalEnv localEs -> e (Eff localEs) a -> Eff es a
EffectHandler e es
handler)

-- | Interpret an effect using other, private effects.
--
-- @'interpret' ≡ 'reinterpret' 'id'@
--
-- /Note:/ If you want to interpret multiple effects using other, private
-- effects, you can do so with a combination of 'interpret' and 'inject'.
--
-- This is in particular useful for splitting a large effect into smaller
-- ones. For example, let's say you want to split a
-- t'Effectful.State.Static.Local.State' into a read only and read write
-- component:
--
-- >>> :{
--  data Get s :: Effect where
--    Get :: Get s m s
--  type instance DispatchOf (Get s) = Dynamic
-- :}
--
-- >>> :{
--  data Put s :: Effect where
--    Put :: s -> Put s m ()
--  type instance DispatchOf (Put s) = Dynamic
-- :}
--
-- >>> import Effectful.State.Static.Local qualified as S
--
-- >>> :{
--  runGetPut :: forall s es a. s -> Eff (Get s : Put s : es) a -> Eff es (a, s)
--  runGetPut s0
--    = S.runState s0
--    . interpret_ @(Put s) (\(Put s) -> S.put s)
--    . interpret_ @(Get s) (\Get -> S.get)
--    . inject
-- :}
--
-- Here, a t'Effectful.State.Static.Local.State' effect is introduced, then
-- @Put@ and @Get@ effects that use it underneath and finally 'inject' hides the
-- original state from downstream code.
reinterpret
  :: (HasCallStack, DispatchOf e ~ Dynamic)
  => (Eff handlerEs a -> Eff es b)
  -- ^ Setup of effects encapsulated in the handler.
  -> EffectHandler e handlerEs
  -- ^ The effect handler.
  -> Eff (e : es) a
  -> Eff      es  b
reinterpret :: forall (e :: Effect) (handlerEs :: [Effect]) a (es :: [Effect]) b.
(HasCallStack, DispatchOf e ~ 'Dynamic) =>
(Eff handlerEs a -> Eff es b)
-> EffectHandler e handlerEs -> Eff (e : es) a -> Eff es b
reinterpret Eff handlerEs a -> Eff es b
runSetup EffectHandler e handlerEs
handler Eff (e : es) a
action = (Eff handlerEs a -> Eff es b)
-> Eff (e : es) a -> HandlerImpl e handlerEs -> Eff es b
forall (e :: Effect) (handlerEs :: [Effect]) a (es :: [Effect]) b.
(HasCallStack, DispatchOf e ~ 'Dynamic) =>
(Eff handlerEs a -> Eff es b)
-> Eff (e : es) a -> HandlerImpl e handlerEs -> Eff es b
reinterpretImpl Eff handlerEs a -> Eff es b
runSetup Eff (e : es) a
action (HandlerImpl e handlerEs -> Eff es b)
-> HandlerImpl e handlerEs -> Eff es b
forall a b. (a -> b) -> a -> b
$
  EffectHandler e handlerEs -> HandlerImpl e handlerEs
forall (e :: Effect) (es :: [Effect]).
EffectHandler e es -> HandlerImpl e es
HandlerImpl (let ?callStack = CallStack -> CallStack
thawCallStack HasCallStack
CallStack
?callStack in LocalEnv localEs -> e (Eff localEs) a -> Eff handlerEs a
EffectHandler e handlerEs
handler)

-- | 'reinterpret' with the effect handler as the last argument.
--
-- @since 2.4.0.0
reinterpretWith
  :: (HasCallStack, DispatchOf e ~ Dynamic)
  => (Eff handlerEs a -> Eff es b)
  -- ^ Setup of effects encapsulated in the handler.
  -> Eff (e : es) a
  -> EffectHandler e handlerEs
  -- ^ The effect handler.
  -> Eff      es  b
reinterpretWith :: forall (e :: Effect) (handlerEs :: [Effect]) a (es :: [Effect]) b.
(HasCallStack, DispatchOf e ~ 'Dynamic) =>
(Eff handlerEs a -> Eff es b)
-> Eff (e : es) a -> EffectHandler e handlerEs -> Eff es b
reinterpretWith Eff handlerEs a -> Eff es b
runSetup Eff (e : es) a
action EffectHandler e handlerEs
handler = (Eff handlerEs a -> Eff es b)
-> Eff (e : es) a -> HandlerImpl e handlerEs -> Eff es b
forall (e :: Effect) (handlerEs :: [Effect]) a (es :: [Effect]) b.
(HasCallStack, DispatchOf e ~ 'Dynamic) =>
(Eff handlerEs a -> Eff es b)
-> Eff (e : es) a -> HandlerImpl e handlerEs -> Eff es b
reinterpretImpl Eff handlerEs a -> Eff es b
runSetup Eff (e : es) a
action (HandlerImpl e handlerEs -> Eff es b)
-> HandlerImpl e handlerEs -> Eff es b
forall a b. (a -> b) -> a -> b
$
  EffectHandler e handlerEs -> HandlerImpl e handlerEs
forall (e :: Effect) (es :: [Effect]).
EffectHandler e es -> HandlerImpl e es
HandlerImpl (let ?callStack = CallStack -> CallStack
thawCallStack HasCallStack
CallStack
?callStack in LocalEnv localEs -> e (Eff localEs) a -> Eff handlerEs a
EffectHandler e handlerEs
handler)

-- | Replace the handler of an existing effect with a new one.
--
-- /Note:/ this function allows for augmenting handlers with a new functionality
-- as the new handler can send operations to the old one.
--
-- >>> :{
--   data E :: Effect where
--     Op1 :: E m ()
--     Op2 :: E m ()
--     Op3 :: E m ()
--   type instance DispatchOf E = Dynamic
-- :}
--
-- >>> :{
--   runE :: IOE :> es => Eff (E : es) a -> Eff es a
--   runE = interpret_ $ \case
--     Op1 -> liftIO (putStrLn "op1")
--     Op2 -> liftIO (putStrLn "op2")
--     Op3 -> error "Op3 not implemented"
-- :}
--
-- >>> let action = send Op1 >> send Op2
--
-- >>> runEff . runE $ action
-- op1
-- op2
--
-- You can modify only specific operations and send the rest to the upstream
-- handler with 'passthrough':
--
-- >>> :{
--   augmentOp2 :: (E :> es, IOE :> es) => Eff es a -> Eff es a
--   augmentOp2 = interpose $ \env -> \case
--     Op2 -> liftIO (putStrLn "augmented op2") >> send Op2
--     op  -> passthrough env op
-- :}
--
-- >>> runEff . runE . augmentOp2 $ action
-- op1
-- augmented op2
-- op2
--
-- /Note:/ when an exception is raised while handling an operation, good
-- debugging experience is ensured by strategically placed 'HasCallStack'
-- constraints:
--
-- >>> runEff . runE . augmentOp2 $ send Op3
-- *** Exception: Op3 not implemented
-- ...
--   error, called at <interactive>:...
--   handler, called at src/Effectful/Dispatch/Dynamic.hs:...
--   passthrough, called at <interactive>:...
--   handler, called at src/Effectful/Dispatch/Dynamic.hs:...
--   send, called at <interactive>:...
-- ...
interpose
  :: (HasCallStack, DispatchOf e ~ Dynamic, e :> es)
  => EffectHandler e es
  -- ^ The effect handler.
  -> Eff es a
  -> Eff es a
interpose :: forall (e :: Effect) (es :: [Effect]) a.
(HasCallStack, DispatchOf e ~ 'Dynamic, e :> es) =>
EffectHandler e es -> Eff es a -> Eff es a
interpose EffectHandler e es
handler Eff es a
action = Eff es a -> HandlerImpl e es -> Eff es a
forall (e :: Effect) (es :: [Effect]) a.
(HasCallStack, DispatchOf e ~ 'Dynamic, e :> es) =>
Eff es a -> HandlerImpl e es -> Eff es a
interposeImpl Eff es a
action (HandlerImpl e es -> Eff es a) -> HandlerImpl e es -> Eff es a
forall a b. (a -> b) -> a -> b
$
  EffectHandler e es -> HandlerImpl e es
forall (e :: Effect) (es :: [Effect]).
EffectHandler e es -> HandlerImpl e es
HandlerImpl (let ?callStack = CallStack -> CallStack
thawCallStack HasCallStack
CallStack
?callStack in LocalEnv localEs -> e (Eff localEs) a -> Eff es a
EffectHandler e es
handler)

-- | 'interpose' with the effect handler as the last argument.
--
-- @since 2.4.0.0
interposeWith
  :: (HasCallStack, DispatchOf e ~ Dynamic, e :> es)
  => Eff es a
  -> EffectHandler e es
  -- ^ The effect handler.
  -> Eff es a
interposeWith :: forall (e :: Effect) (es :: [Effect]) a.
(HasCallStack, DispatchOf e ~ 'Dynamic, e :> es) =>
Eff es a -> EffectHandler e es -> Eff es a
interposeWith Eff es a
action EffectHandler e es
handler = Eff es a -> HandlerImpl e es -> Eff es a
forall (e :: Effect) (es :: [Effect]) a.
(HasCallStack, DispatchOf e ~ 'Dynamic, e :> es) =>
Eff es a -> HandlerImpl e es -> Eff es a
interposeImpl Eff es a
action (HandlerImpl e es -> Eff es a) -> HandlerImpl e es -> Eff es a
forall a b. (a -> b) -> a -> b
$
  EffectHandler e es -> HandlerImpl e es
forall (e :: Effect) (es :: [Effect]).
EffectHandler e es -> HandlerImpl e es
HandlerImpl (let ?callStack = CallStack -> CallStack
thawCallStack HasCallStack
CallStack
?callStack in LocalEnv localEs -> e (Eff localEs) a -> Eff es a
EffectHandler e es
handler)

-- | Replace the handler of an existing effect with a new one that uses other,
-- private effects.
--
-- @'interpose' ≡ 'impose' 'id'@
impose
  :: (HasCallStack, DispatchOf e ~ Dynamic, e :> es)
  => (Eff handlerEs a -> Eff es b)
  -- ^ Setup of effects encapsulated in the handler.
  -> EffectHandler e handlerEs
  -- ^ The effect handler.
  -> Eff es a
  -> Eff es b
impose :: forall (e :: Effect) (es :: [Effect]) (handlerEs :: [Effect]) a b.
(HasCallStack, DispatchOf e ~ 'Dynamic, e :> es) =>
(Eff handlerEs a -> Eff es b)
-> EffectHandler e handlerEs -> Eff es a -> Eff es b
impose Eff handlerEs a -> Eff es b
runSetup EffectHandler e handlerEs
handler Eff es a
action = (Eff handlerEs a -> Eff es b)
-> Eff es a -> HandlerImpl e handlerEs -> Eff es b
forall (e :: Effect) (es :: [Effect]) (handlerEs :: [Effect]) a b.
(HasCallStack, DispatchOf e ~ 'Dynamic, e :> es) =>
(Eff handlerEs a -> Eff es b)
-> Eff es a -> HandlerImpl e handlerEs -> Eff es b
imposeImpl Eff handlerEs a -> Eff es b
runSetup Eff es a
action (HandlerImpl e handlerEs -> Eff es b)
-> HandlerImpl e handlerEs -> Eff es b
forall a b. (a -> b) -> a -> b
$
  EffectHandler e handlerEs -> HandlerImpl e handlerEs
forall (e :: Effect) (es :: [Effect]).
EffectHandler e es -> HandlerImpl e es
HandlerImpl (let ?callStack = CallStack -> CallStack
thawCallStack HasCallStack
CallStack
?callStack in LocalEnv localEs -> e (Eff localEs) a -> Eff handlerEs a
EffectHandler e handlerEs
handler)

-- | 'impose' with the effect handler as the last argument.
--
-- @since 2.4.0.0
imposeWith
  :: (HasCallStack, DispatchOf e ~ Dynamic, e :> es)
  => (Eff handlerEs a -> Eff es b)
  -- ^ Setup of effects encapsulated in the handler.
  -> Eff es a
  -> EffectHandler e handlerEs
  -- ^ The effect handler.
  -> Eff es b
imposeWith :: forall (e :: Effect) (es :: [Effect]) (handlerEs :: [Effect]) a b.
(HasCallStack, DispatchOf e ~ 'Dynamic, e :> es) =>
(Eff handlerEs a -> Eff es b)
-> Eff es a -> EffectHandler e handlerEs -> Eff es b
imposeWith Eff handlerEs a -> Eff es b
runSetup Eff es a
action EffectHandler e handlerEs
handler = (Eff handlerEs a -> Eff es b)
-> Eff es a -> HandlerImpl e handlerEs -> Eff es b
forall (e :: Effect) (es :: [Effect]) (handlerEs :: [Effect]) a b.
(HasCallStack, DispatchOf e ~ 'Dynamic, e :> es) =>
(Eff handlerEs a -> Eff es b)
-> Eff es a -> HandlerImpl e handlerEs -> Eff es b
imposeImpl Eff handlerEs a -> Eff es b
runSetup Eff es a
action (HandlerImpl e handlerEs -> Eff es b)
-> HandlerImpl e handlerEs -> Eff es b
forall a b. (a -> b) -> a -> b
$
  EffectHandler e handlerEs -> HandlerImpl e handlerEs
forall (e :: Effect) (es :: [Effect]).
EffectHandler e es -> HandlerImpl e es
HandlerImpl (let ?callStack = CallStack -> CallStack
thawCallStack HasCallStack
CallStack
?callStack in LocalEnv localEs -> e (Eff localEs) a -> Eff handlerEs a
EffectHandler e handlerEs
handler)

----------------------------------------
-- First order effects

-- | Type signature of a first order effect handler.
--
-- @since 2.4.0.0
type EffectHandler_ (e :: Effect) (es :: [Effect])
  = forall a localEs. HasCallStack
  => e (Eff localEs) a
  -- ^ The operation.
  -> Eff es a

-- | 'interpret' for first order effects.
--
-- @since 2.4.0.0
interpret_
  :: (HasCallStack, DispatchOf e ~ Dynamic)
  => EffectHandler_ e es
  -- ^ The effect handler.
  -> Eff (e : es) a
  -> Eff      es  a
interpret_ :: forall (e :: Effect) (es :: [Effect]) a.
(HasCallStack, DispatchOf e ~ 'Dynamic) =>
EffectHandler_ e es -> Eff (e : es) a -> Eff es a
interpret_ EffectHandler_ e es
handler Eff (e : es) a
action = Eff (e : es) a -> HandlerImpl e es -> Eff es a
forall (e :: Effect) (es :: [Effect]) a.
(HasCallStack, DispatchOf e ~ 'Dynamic) =>
Eff (e : es) a -> HandlerImpl e es -> Eff es a
interpretImpl Eff (e : es) a
action (HandlerImpl e es -> Eff es a) -> HandlerImpl e es -> Eff es a
forall a b. (a -> b) -> a -> b
$
  EffectHandler e es -> HandlerImpl e es
forall (e :: Effect) (es :: [Effect]).
EffectHandler e es -> HandlerImpl e es
HandlerImpl (let ?callStack = CallStack -> CallStack
thawCallStack HasCallStack
CallStack
?callStack in (e (Eff localEs) a -> Eff es a)
-> LocalEnv localEs -> e (Eff localEs) a -> Eff es a
forall a b. a -> b -> a
const e (Eff localEs) a -> Eff es a
EffectHandler_ e es
handler)

-- | 'interpretWith' for first order effects.
--
-- @since 2.4.0.0
interpretWith_
  :: (HasCallStack, DispatchOf e ~ Dynamic)
  => Eff (e : es) a
  -> EffectHandler_ e es
  -- ^ The effect handler.
  -> Eff      es  a
interpretWith_ :: forall (e :: Effect) (es :: [Effect]) a.
(HasCallStack, DispatchOf e ~ 'Dynamic) =>
Eff (e : es) a -> EffectHandler_ e es -> Eff es a
interpretWith_ Eff (e : es) a
action EffectHandler_ e es
handler = Eff (e : es) a -> HandlerImpl e es -> Eff es a
forall (e :: Effect) (es :: [Effect]) a.
(HasCallStack, DispatchOf e ~ 'Dynamic) =>
Eff (e : es) a -> HandlerImpl e es -> Eff es a
interpretImpl Eff (e : es) a
action (HandlerImpl e es -> Eff es a) -> HandlerImpl e es -> Eff es a
forall a b. (a -> b) -> a -> b
$
  EffectHandler e es -> HandlerImpl e es
forall (e :: Effect) (es :: [Effect]).
EffectHandler e es -> HandlerImpl e es
HandlerImpl (let ?callStack = CallStack -> CallStack
thawCallStack HasCallStack
CallStack
?callStack in (e (Eff localEs) a -> Eff es a)
-> LocalEnv localEs -> e (Eff localEs) a -> Eff es a
forall a b. a -> b -> a
const e (Eff localEs) a -> Eff es a
EffectHandler_ e es
handler)

-- | 'reinterpret' for first order effects.
--
-- @since 2.4.0.0
reinterpret_
  :: (HasCallStack, DispatchOf e ~ Dynamic)
  => (Eff handlerEs a -> Eff es b)
  -- ^ Setup of effects encapsulated in the handler.
  -> EffectHandler_ e handlerEs
  -- ^ The effect handler.
  -> Eff (e : es) a
  -> Eff      es  b
reinterpret_ :: forall (e :: Effect) (handlerEs :: [Effect]) a (es :: [Effect]) b.
(HasCallStack, DispatchOf e ~ 'Dynamic) =>
(Eff handlerEs a -> Eff es b)
-> EffectHandler_ e handlerEs -> Eff (e : es) a -> Eff es b
reinterpret_ Eff handlerEs a -> Eff es b
runSetup EffectHandler_ e handlerEs
handler Eff (e : es) a
action = (Eff handlerEs a -> Eff es b)
-> Eff (e : es) a -> HandlerImpl e handlerEs -> Eff es b
forall (e :: Effect) (handlerEs :: [Effect]) a (es :: [Effect]) b.
(HasCallStack, DispatchOf e ~ 'Dynamic) =>
(Eff handlerEs a -> Eff es b)
-> Eff (e : es) a -> HandlerImpl e handlerEs -> Eff es b
reinterpretImpl Eff handlerEs a -> Eff es b
runSetup Eff (e : es) a
action (HandlerImpl e handlerEs -> Eff es b)
-> HandlerImpl e handlerEs -> Eff es b
forall a b. (a -> b) -> a -> b
$
  EffectHandler e handlerEs -> HandlerImpl e handlerEs
forall (e :: Effect) (es :: [Effect]).
EffectHandler e es -> HandlerImpl e es
HandlerImpl (let ?callStack = CallStack -> CallStack
thawCallStack HasCallStack
CallStack
?callStack in (e (Eff localEs) a -> Eff handlerEs a)
-> LocalEnv localEs -> e (Eff localEs) a -> Eff handlerEs a
forall a b. a -> b -> a
const e (Eff localEs) a -> Eff handlerEs a
EffectHandler_ e handlerEs
handler)

-- | 'reinterpretWith' for first order effects.
--
-- @since 2.4.0.0
reinterpretWith_
  :: (HasCallStack, DispatchOf e ~ Dynamic)
  => (Eff handlerEs a -> Eff es b)
  -- ^ Setup of effects encapsulated in the handler.
  -> Eff (e : es) a
  -> EffectHandler_ e handlerEs
  -- ^ The effect handler.
  -> Eff      es  b
reinterpretWith_ :: forall (e :: Effect) (handlerEs :: [Effect]) a (es :: [Effect]) b.
(HasCallStack, DispatchOf e ~ 'Dynamic) =>
(Eff handlerEs a -> Eff es b)
-> Eff (e : es) a -> EffectHandler_ e handlerEs -> Eff es b
reinterpretWith_ Eff handlerEs a -> Eff es b
runSetup Eff (e : es) a
action EffectHandler_ e handlerEs
handler = (Eff handlerEs a -> Eff es b)
-> Eff (e : es) a -> HandlerImpl e handlerEs -> Eff es b
forall (e :: Effect) (handlerEs :: [Effect]) a (es :: [Effect]) b.
(HasCallStack, DispatchOf e ~ 'Dynamic) =>
(Eff handlerEs a -> Eff es b)
-> Eff (e : es) a -> HandlerImpl e handlerEs -> Eff es b
reinterpretImpl Eff handlerEs a -> Eff es b
runSetup Eff (e : es) a
action (HandlerImpl e handlerEs -> Eff es b)
-> HandlerImpl e handlerEs -> Eff es b
forall a b. (a -> b) -> a -> b
$
  EffectHandler e handlerEs -> HandlerImpl e handlerEs
forall (e :: Effect) (es :: [Effect]).
EffectHandler e es -> HandlerImpl e es
HandlerImpl (let ?callStack = CallStack -> CallStack
thawCallStack HasCallStack
CallStack
?callStack in (e (Eff localEs) a -> Eff handlerEs a)
-> LocalEnv localEs -> e (Eff localEs) a -> Eff handlerEs a
forall a b. a -> b -> a
const e (Eff localEs) a -> Eff handlerEs a
EffectHandler_ e handlerEs
handler)

-- | 'interpose' for first order effects.
--
-- @since 2.4.0.0
interpose_
  :: (HasCallStack, DispatchOf e ~ Dynamic, e :> es)
  => EffectHandler_ e es
  -- ^ The effect handler.
  -> Eff es a
  -> Eff es a
interpose_ :: forall (e :: Effect) (es :: [Effect]) a.
(HasCallStack, DispatchOf e ~ 'Dynamic, e :> es) =>
EffectHandler_ e es -> Eff es a -> Eff es a
interpose_ EffectHandler_ e es
handler Eff es a
action = Eff es a -> HandlerImpl e es -> Eff es a
forall (e :: Effect) (es :: [Effect]) a.
(HasCallStack, DispatchOf e ~ 'Dynamic, e :> es) =>
Eff es a -> HandlerImpl e es -> Eff es a
interposeImpl Eff es a
action (HandlerImpl e es -> Eff es a) -> HandlerImpl e es -> Eff es a
forall a b. (a -> b) -> a -> b
$
  EffectHandler e es -> HandlerImpl e es
forall (e :: Effect) (es :: [Effect]).
EffectHandler e es -> HandlerImpl e es
HandlerImpl (let ?callStack = CallStack -> CallStack
thawCallStack HasCallStack
CallStack
?callStack in (e (Eff localEs) a -> Eff es a)
-> LocalEnv localEs -> e (Eff localEs) a -> Eff es a
forall a b. a -> b -> a
const e (Eff localEs) a -> Eff es a
EffectHandler_ e es
handler)

-- | 'interposeWith' for first order effects.
--
-- @since 2.4.0.0
interposeWith_
  :: (HasCallStack, DispatchOf e ~ Dynamic, e :> es)
  => Eff es a
  -> EffectHandler_ e es
  -- ^ The effect handler.
  -> Eff es a
interposeWith_ :: forall (e :: Effect) (es :: [Effect]) a.
(HasCallStack, DispatchOf e ~ 'Dynamic, e :> es) =>
Eff es a -> EffectHandler_ e es -> Eff es a
interposeWith_ Eff es a
action EffectHandler_ e es
handler = Eff es a -> HandlerImpl e es -> Eff es a
forall (e :: Effect) (es :: [Effect]) a.
(HasCallStack, DispatchOf e ~ 'Dynamic, e :> es) =>
Eff es a -> HandlerImpl e es -> Eff es a
interposeImpl Eff es a
action (HandlerImpl e es -> Eff es a) -> HandlerImpl e es -> Eff es a
forall a b. (a -> b) -> a -> b
$
  EffectHandler e es -> HandlerImpl e es
forall (e :: Effect) (es :: [Effect]).
EffectHandler e es -> HandlerImpl e es
HandlerImpl (let ?callStack = CallStack -> CallStack
thawCallStack HasCallStack
CallStack
?callStack in (e (Eff localEs) a -> Eff es a)
-> LocalEnv localEs -> e (Eff localEs) a -> Eff es a
forall a b. a -> b -> a
const e (Eff localEs) a -> Eff es a
EffectHandler_ e es
handler)

-- | 'impose' for first order effects.
--
-- @since 2.4.0.0
impose_
  :: (HasCallStack, DispatchOf e ~ Dynamic, e :> es)
  => (Eff handlerEs a -> Eff es b)
  -- ^ Setup of effects encapsulated in the handler.
  -> EffectHandler_ e handlerEs
  -- ^ The effect handler.
  -> Eff es a
  -> Eff es b
impose_ :: forall (e :: Effect) (es :: [Effect]) (handlerEs :: [Effect]) a b.
(HasCallStack, DispatchOf e ~ 'Dynamic, e :> es) =>
(Eff handlerEs a -> Eff es b)
-> EffectHandler_ e handlerEs -> Eff es a -> Eff es b
impose_ Eff handlerEs a -> Eff es b
runSetup EffectHandler_ e handlerEs
handler Eff es a
action = (Eff handlerEs a -> Eff es b)
-> Eff es a -> HandlerImpl e handlerEs -> Eff es b
forall (e :: Effect) (es :: [Effect]) (handlerEs :: [Effect]) a b.
(HasCallStack, DispatchOf e ~ 'Dynamic, e :> es) =>
(Eff handlerEs a -> Eff es b)
-> Eff es a -> HandlerImpl e handlerEs -> Eff es b
imposeImpl Eff handlerEs a -> Eff es b
runSetup Eff es a
action (HandlerImpl e handlerEs -> Eff es b)
-> HandlerImpl e handlerEs -> Eff es b
forall a b. (a -> b) -> a -> b
$
  EffectHandler e handlerEs -> HandlerImpl e handlerEs
forall (e :: Effect) (es :: [Effect]).
EffectHandler e es -> HandlerImpl e es
HandlerImpl (let ?callStack = CallStack -> CallStack
thawCallStack HasCallStack
CallStack
?callStack in (e (Eff localEs) a -> Eff handlerEs a)
-> LocalEnv localEs -> e (Eff localEs) a -> Eff handlerEs a
forall a b. a -> b -> a
const e (Eff localEs) a -> Eff handlerEs a
EffectHandler_ e handlerEs
handler)

-- | 'imposeWith' for first order effects.
--
-- @since 2.4.0.0
imposeWith_
  :: (HasCallStack, DispatchOf e ~ Dynamic, e :> es)
  => (Eff handlerEs a -> Eff es b)
  -- ^ Setup of effects encapsulated in the handler.
  -> Eff es a
  -> EffectHandler_ e handlerEs
  -- ^ The effect handler.
  -> Eff es b
imposeWith_ :: forall (e :: Effect) (es :: [Effect]) (handlerEs :: [Effect]) a b.
(HasCallStack, DispatchOf e ~ 'Dynamic, e :> es) =>
(Eff handlerEs a -> Eff es b)
-> Eff es a -> EffectHandler_ e handlerEs -> Eff es b
imposeWith_ Eff handlerEs a -> Eff es b
runSetup Eff es a
action EffectHandler_ e handlerEs
handler = (Eff handlerEs a -> Eff es b)
-> Eff es a -> HandlerImpl e handlerEs -> Eff es b
forall (e :: Effect) (es :: [Effect]) (handlerEs :: [Effect]) a b.
(HasCallStack, DispatchOf e ~ 'Dynamic, e :> es) =>
(Eff handlerEs a -> Eff es b)
-> Eff es a -> HandlerImpl e handlerEs -> Eff es b
imposeImpl Eff handlerEs a -> Eff es b
runSetup Eff es a
action (HandlerImpl e handlerEs -> Eff es b)
-> HandlerImpl e handlerEs -> Eff es b
forall a b. (a -> b) -> a -> b
$
  EffectHandler e handlerEs -> HandlerImpl e handlerEs
forall (e :: Effect) (es :: [Effect]).
EffectHandler e es -> HandlerImpl e es
HandlerImpl (let ?callStack = CallStack -> CallStack
thawCallStack HasCallStack
CallStack
?callStack in (e (Eff localEs) a -> Eff handlerEs a)
-> LocalEnv localEs -> e (Eff localEs) a -> Eff handlerEs a
forall a b. a -> b -> a
const e (Eff localEs) a -> Eff handlerEs a
EffectHandler_ e handlerEs
handler)

----------------------------------------
-- Unlifts

-- | Create a local unlifting function with the 'SeqUnlift' strategy. For the
-- general version see 'localUnlift'.
localSeqUnlift
  :: HasCallStack
  => LocalEnv localEs
  -- ^ Local environment.
  -> ((forall r. Eff localEs r -> Eff es r) -> Eff es a)
  -- ^ Continuation with the unlifting function in scope.
  -> Eff es a
localSeqUnlift :: forall (localEs :: [Effect]) (es :: [Effect]) a.
HasCallStack =>
LocalEnv localEs
-> ((forall r. Eff localEs r -> Eff es r) -> Eff es a) -> Eff es a
localSeqUnlift LocalEnv localEs
localEs (forall r. Eff localEs r -> Eff es r) -> Eff es 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 -> do
  Env localEs
les <- Env es -> LocalEnv localEs -> IO (Env localEs)
forall (es :: [Effect]) (localEs :: [Effect]).
HasCallStack =>
Env es -> LocalEnv localEs -> IO (Env localEs)
unwrapLocalEnv Env es
es LocalEnv localEs
localEs
  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
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 localEs r -> Eff es r) -> Eff es a
k ((forall r. Eff localEs r -> Eff es r) -> Eff es a)
-> (forall r. Eff localEs 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 localEs r -> IO r) -> Eff localEs r -> Eff es r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Eff localEs r -> IO r
forall r. Eff localEs r -> IO r
unlift
{-# INLINE localSeqUnlift #-}

-- | Create a local unlifting function with the 'SeqUnlift' strategy. For the
-- general version see 'localUnliftIO'.
localSeqUnliftIO
  :: (HasCallStack, IOE :> es)
  => LocalEnv localEs
  -- ^ Local environment.
  -> ((forall r. Eff localEs r -> IO r) -> IO a)
  -- ^ Continuation with the unlifting function in scope.
  -> Eff es a
localSeqUnliftIO :: forall (es :: [Effect]) (localEs :: [Effect]) a.
(HasCallStack, IOE :> es) =>
LocalEnv localEs
-> ((forall r. Eff localEs r -> IO r) -> IO a) -> Eff es a
localSeqUnliftIO LocalEnv localEs
localEs (forall r. Eff localEs 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 -> do
  Env localEs
les <- Env es -> LocalEnv localEs -> IO (Env localEs)
forall (es :: [Effect]) (localEs :: [Effect]).
HasCallStack =>
Env es -> LocalEnv localEs -> IO (Env localEs)
unwrapLocalEnv Env es
es LocalEnv localEs
localEs
  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
k
{-# INLINE localSeqUnliftIO #-}

-- | Create a local unlifting function with the given strategy.
localUnlift
  :: HasCallStack
  => LocalEnv localEs
  -- ^ Local environment.
  -> UnliftStrategy
  -> ((forall r. Eff localEs r -> Eff es r) -> Eff es a)
  -- ^ Continuation with the unlifting function in scope.
  -> Eff es a
localUnlift :: forall (localEs :: [Effect]) (es :: [Effect]) a.
HasCallStack =>
LocalEnv localEs
-> UnliftStrategy
-> ((forall r. Eff localEs r -> Eff es r) -> Eff es a)
-> Eff es a
localUnlift LocalEnv localEs
localEs UnliftStrategy
strategy (forall r. Eff localEs r -> Eff es r) -> Eff es 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 -> do
  Env localEs
les <- Env es -> LocalEnv localEs -> IO (Env localEs)
forall (es :: [Effect]) (localEs :: [Effect]).
HasCallStack =>
Env es -> LocalEnv localEs -> IO (Env localEs)
unwrapLocalEnv Env es
es LocalEnv localEs
localEs
  case UnliftStrategy
strategy of
    UnliftStrategy
SeqUnlift -> 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
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 localEs r -> Eff es r) -> Eff es a
k ((forall r. Eff localEs r -> Eff es r) -> Eff es a)
-> (forall r. Eff localEs 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 localEs r -> IO r) -> Eff localEs r -> Eff es r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Eff localEs r -> IO r
forall r. Eff localEs r -> IO r
unlift
    UnliftStrategy
SeqForkUnlift -> 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
seqForkUnliftIO 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
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 localEs r -> Eff es r) -> Eff es a
k ((forall r. Eff localEs r -> Eff es r) -> Eff es a)
-> (forall r. Eff localEs 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 localEs r -> IO r) -> Eff localEs r -> Eff es r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Eff localEs r -> IO r
forall r. Eff localEs r -> IO r
unlift
    ConcUnlift Persistence
p Limit
l -> Env localEs
-> Persistence
-> Limit
-> ((forall r. Eff localEs 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 localEs
les Persistence
p Limit
l (((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
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 localEs r -> Eff es r) -> Eff es a
k ((forall r. Eff localEs r -> Eff es r) -> Eff es a)
-> (forall r. Eff localEs 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 localEs r -> IO r) -> Eff localEs r -> Eff es r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Eff localEs r -> IO r
forall r. Eff localEs r -> IO r
unlift
{-# INLINE localUnlift #-}

-- | Create a local unlifting function with the given strategy.
localUnliftIO
  :: (HasCallStack, IOE :> es)
  => LocalEnv localEs
  -- ^ Local environment.
  -> UnliftStrategy
  -> ((forall r. Eff localEs r -> IO r) -> IO a)
  -- ^ Continuation with the unlifting function in scope.
  -> Eff es a
localUnliftIO :: forall (es :: [Effect]) (localEs :: [Effect]) a.
(HasCallStack, IOE :> es) =>
LocalEnv localEs
-> UnliftStrategy
-> ((forall r. Eff localEs r -> IO r) -> IO a)
-> Eff es a
localUnliftIO LocalEnv localEs
localEs UnliftStrategy
strategy (forall r. Eff localEs 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 -> do
  Env localEs
les <- Env es -> LocalEnv localEs -> IO (Env localEs)
forall (es :: [Effect]) (localEs :: [Effect]).
HasCallStack =>
Env es -> LocalEnv localEs -> IO (Env localEs)
unwrapLocalEnv Env es
es LocalEnv localEs
localEs
  case UnliftStrategy
strategy of
    UnliftStrategy
SeqUnlift -> 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
k
    UnliftStrategy
SeqForkUnlift -> 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
seqForkUnliftIO Env localEs
les (forall r. Eff localEs r -> IO r) -> IO a
k
    ConcUnlift Persistence
p Limit
l -> Env localEs
-> Persistence
-> Limit
-> ((forall r. Eff localEs 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 localEs
les Persistence
p Limit
l (forall r. Eff localEs r -> IO r) -> IO a
k
{-# INLINE localUnliftIO #-}

----------------------------------------
-- Lifts

-- | Create a local lifting function with the 'SeqUnlift' strategy. For the
-- general version see 'localLift'.
--
-- @since 2.2.1.0
localSeqLift
  :: HasCallStack
  => LocalEnv localEs
  -- ^ Local environment.
  -> ((forall r. Eff es r -> Eff localEs r) -> Eff es a)
  -- ^ Continuation with the lifting function in scope.
  -> Eff es a
localSeqLift :: forall (localEs :: [Effect]) (es :: [Effect]) a.
HasCallStack =>
LocalEnv localEs
-> ((forall r. Eff es r -> Eff localEs r) -> Eff es a) -> Eff es a
localSeqLift LocalEnv localEs
localEs (forall r. Eff es r -> Eff localEs r) -> Eff es 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 -> 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 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
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 es r -> Eff localEs r) -> Eff es a
k ((forall r. Eff es r -> Eff localEs r) -> Eff es a)
-> (forall r. Eff es r -> Eff localEs r) -> Eff es a
forall a b. (a -> b) -> a -> b
$ IO r -> Eff localEs r
forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ (IO r -> Eff localEs r)
-> (Eff es r -> IO r) -> Eff es r -> Eff localEs r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Eff es r -> IO r
forall r. Eff es r -> IO r
unlift
{-# INLINE localSeqLift #-}

-- | Create a local lifting function with the given strategy.
--
-- @since 2.2.1.0
localLift
  :: HasCallStack
  => LocalEnv localEs
  -- ^ Local environment.
  -> UnliftStrategy
  -> ((forall r. Eff es r -> Eff localEs r) -> Eff es a)
  -- ^ Continuation with the lifting function in scope.
  -> Eff es a
localLift :: forall (localEs :: [Effect]) (es :: [Effect]) a.
HasCallStack =>
LocalEnv localEs
-> UnliftStrategy
-> ((forall r. Eff es r -> Eff localEs r) -> Eff es a)
-> Eff es a
localLift LocalEnv localEs
localEs UnliftStrategy
strategy (forall r. Eff es r -> Eff localEs r) -> Eff es 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 -> do
  Env es -> LocalEnv localEs -> IO ()
forall (es :: [Effect]) (localEs :: [Effect]).
HasCallStack =>
Env es -> LocalEnv localEs -> IO ()
requireMatchingStorages Env es
es LocalEnv localEs
localEs
  case UnliftStrategy
strategy of
    UnliftStrategy
SeqUnlift -> 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
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 es r -> Eff localEs r) -> Eff es a
k ((forall r. Eff es r -> Eff localEs r) -> Eff es a)
-> (forall r. Eff es r -> Eff localEs r) -> Eff es a
forall a b. (a -> b) -> a -> b
$ IO r -> Eff localEs r
forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ (IO r -> Eff localEs r)
-> (Eff es r -> IO r) -> Eff es r -> Eff localEs r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Eff es r -> IO r
forall r. Eff es r -> IO r
unlift
    UnliftStrategy
SeqForkUnlift -> 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) -> 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
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 es r -> Eff localEs r) -> Eff es a
k ((forall r. Eff es r -> Eff localEs r) -> Eff es a)
-> (forall r. Eff es r -> Eff localEs r) -> Eff es a
forall a b. (a -> b) -> a -> b
$ IO r -> Eff localEs r
forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ (IO r -> Eff localEs r)
-> (Eff es r -> IO r) -> Eff es r -> Eff localEs r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Eff es r -> IO r
forall r. Eff es r -> IO r
unlift
    ConcUnlift Persistence
p Limit
l -> 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
l (((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
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 es r -> Eff localEs r) -> Eff es a
k ((forall r. Eff es r -> Eff localEs r) -> Eff es a)
-> (forall r. Eff es r -> Eff localEs r) -> Eff es a
forall a b. (a -> b) -> a -> b
$ IO r -> Eff localEs r
forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ (IO r -> Eff localEs r)
-> (Eff es r -> IO r) -> Eff es r -> Eff localEs r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Eff es r -> IO r
forall r. Eff es r -> IO r
unlift
{-# INLINE localLift #-}

-- | Utility for lifting 'Eff' computations of type
--
-- @'Eff' es a -> 'Eff' es b@
--
-- to
--
-- @'Eff' localEs a -> 'Eff' localEs b@
--
-- /Note:/ the computation must not run its argument in a different thread,
-- attempting to do so will result in a runtime error.
--
-- /Warning:/ if the lifting function is used in a thread distinct from its
-- creator, the lifted computation must not interact with the environment. This
-- cannot be detected at runtime, hence the deprecation.
withLiftMap
  :: HasCallStack
  => LocalEnv localEs
  -- ^ Local environment.
  -> ((forall a b. (Eff es a -> Eff es b) -> Eff localEs a -> Eff localEs b) -> Eff es r)
  -- ^ Continuation with the lifting function in scope.
  -> Eff es r
withLiftMap :: forall (localEs :: [Effect]) (es :: [Effect]) r.
HasCallStack =>
LocalEnv localEs
-> ((forall a b.
     (Eff es a -> Eff es b) -> Eff localEs a -> Eff localEs b)
    -> Eff es r)
-> Eff es r
withLiftMap LocalEnv localEs
localEs (forall a b.
 (Eff es a -> Eff es b) -> Eff localEs a -> Eff localEs b)
-> Eff es r
k = (Env es -> IO r) -> Eff es r
forall (es :: [Effect]) a. (Env es -> IO a) -> Eff es a
unsafeEff ((Env es -> IO r) -> Eff es r) -> (Env es -> IO r) -> Eff es r
forall a b. (a -> b) -> a -> b
$ \Env es
es -> do
  Env es -> LocalEnv localEs -> IO ()
forall (es :: [Effect]) (localEs :: [Effect]).
HasCallStack =>
Env es -> LocalEnv localEs -> IO ()
requireMatchingStorages Env es
es LocalEnv localEs
localEs
  (Eff es r -> Env es -> IO r
forall (es :: [Effect]) a. Eff es a -> Env es -> IO a
`unEff` Env es
es) (Eff es r -> IO r) -> Eff es r -> IO r
forall a b. (a -> b) -> a -> b
$ (forall a b.
 (Eff es a -> Eff es b) -> Eff localEs a -> Eff localEs b)
-> Eff es r
k ((forall a b.
  (Eff es a -> Eff es b) -> Eff localEs a -> Eff localEs b)
 -> Eff es r)
-> (forall a b.
    (Eff es a -> Eff es b) -> Eff localEs a -> Eff localEs b)
-> Eff es r
forall a b. (a -> b) -> a -> b
$ \Eff es a -> Eff es b
mapEff Eff localEs a
m -> (Env localEs -> IO b) -> Eff localEs b
forall (es :: [Effect]) a. (Env es -> IO a) -> Eff es a
unsafeEff ((Env localEs -> IO b) -> Eff localEs b)
-> (Env localEs -> IO b) -> Eff localEs b
forall a b. (a -> b) -> a -> b
$ \Env localEs
les -> do
    Env localEs -> ((forall r. Eff localEs r -> IO r) -> IO b) -> IO b
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 b) -> IO b)
-> ((forall r. Eff localEs r -> IO r) -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \forall r. Eff localEs r -> IO r
unlift -> do
      (Eff es b -> Env es -> IO b
forall (es :: [Effect]) a. Eff es a -> Env es -> IO a
`unEff` Env es
es) (Eff es b -> IO b) -> (IO a -> Eff es b) -> IO a -> IO b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Eff es a -> Eff es b
mapEff (Eff es a -> Eff es b) -> (IO a -> Eff es a) -> IO a -> Eff es b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO a -> Eff es a
forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ (IO a -> IO b) -> IO a -> IO b
forall a b. (a -> b) -> a -> b
$ Eff localEs a -> IO a
forall r. Eff localEs r -> IO r
unlift Eff localEs a
m
{-# DEPRECATED withLiftMap
  "Misusing withLiftMap in multiple threads results in undefined behavior. Use localLiftUnlift with an appropriate UnliftStrategy instead." #-}

-- | Utility for lifting 'IO' computations of type
--
-- @'IO' a -> 'IO' b@
--
-- to
--
-- @'Eff' localEs a -> 'Eff' localEs b@
--
-- /Note:/ the computation must not run its argument in a different thread,
-- attempting to do so will result in a runtime error.
--
-- Useful e.g. for lifting the unmasking function in
-- 'Control.Exception.mask'-like computations:
--
-- >>> :{
-- data Fork :: Effect where
--   ForkWithUnmask :: ((forall a. m a -> m a) -> m ()) -> Fork m ThreadId
-- type instance DispatchOf Fork = Dynamic
-- :}
--
-- >>> :{
-- runFork :: IOE :> es => Eff (Fork : es) a -> Eff es a
-- runFork = interpret $ \env (ForkWithUnmask m) -> withLiftMapIO env $ \liftMap -> do
--   localUnliftIO env (ConcUnlift Ephemeral $ Limited 1) $ \unlift -> do
--     forkIOWithUnmask $ \unmask -> unlift $ m $ liftMap unmask
-- :}
withLiftMapIO
  :: (HasCallStack, IOE :> es)
  => LocalEnv localEs
  -- ^ Local environment.
  -> ((forall a b. (IO a -> IO b) -> Eff localEs a -> Eff localEs b) -> Eff es r)
  -- ^ Continuation with the lifting function in scope.
  -> Eff es r
withLiftMapIO :: forall (es :: [Effect]) (localEs :: [Effect]) r.
(HasCallStack, IOE :> es) =>
LocalEnv localEs
-> ((forall a b. (IO a -> IO b) -> Eff localEs a -> Eff localEs b)
    -> Eff es r)
-> Eff es r
withLiftMapIO LocalEnv localEs
localEs (forall a b. (IO a -> IO b) -> Eff localEs a -> Eff localEs b)
-> Eff es r
k = (Env es -> IO r) -> Eff es r
forall (es :: [Effect]) a. (Env es -> IO a) -> Eff es a
unsafeEff ((Env es -> IO r) -> Eff es r) -> (Env es -> IO r) -> Eff es r
forall a b. (a -> b) -> a -> b
$ \Env es
es -> do
  Env es -> LocalEnv localEs -> IO ()
forall (es :: [Effect]) (localEs :: [Effect]).
HasCallStack =>
Env es -> LocalEnv localEs -> IO ()
requireMatchingStorages Env es
es LocalEnv localEs
localEs
  (Eff es r -> Env es -> IO r
forall (es :: [Effect]) a. Eff es a -> Env es -> IO a
`unEff` Env es
es) (Eff es r -> IO r) -> Eff es r -> IO r
forall a b. (a -> b) -> a -> b
$ (forall a b. (IO a -> IO b) -> Eff localEs a -> Eff localEs b)
-> Eff es r
k ((forall a b. (IO a -> IO b) -> Eff localEs a -> Eff localEs b)
 -> Eff es r)
-> (forall a b. (IO a -> IO b) -> Eff localEs a -> Eff localEs b)
-> Eff es r
forall a b. (a -> b) -> a -> b
$ \IO a -> IO b
mapIO Eff localEs a
m -> (Env localEs -> IO b) -> Eff localEs b
forall (es :: [Effect]) a. (Env es -> IO a) -> Eff es a
unsafeEff ((Env localEs -> IO b) -> Eff localEs b)
-> (Env localEs -> IO b) -> Eff localEs b
forall a b. (a -> b) -> a -> b
$ \Env localEs
les -> do
    Env localEs -> ((forall r. Eff localEs r -> IO r) -> IO b) -> IO b
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 b) -> IO b)
-> ((forall r. Eff localEs r -> IO r) -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \forall r. Eff localEs r -> IO r
unlift -> IO a -> IO b
mapIO (IO a -> IO b) -> IO a -> IO b
forall a b. (a -> b) -> a -> b
$ Eff localEs a -> IO a
forall r. Eff localEs r -> IO r
unlift Eff localEs a
m
{-# INLINE withLiftMapIO #-}

----------------------------------------
-- Bidirectional lifts

-- | Create a local lifting and unlifting function with the given strategy.
--
-- Useful for lifting complicated 'Eff' computations where the monadic action
-- shows in both positive (as a result) and negative (as an argument) position.
--
-- /Note:/ when 'SeqForkUnlift' or 'ConcUnlift' 'Persistent' strategy is used,
-- the unlifting functions will share the effect storage (unlike with two
-- separate calls to 'localLift' and 'localUnlift').
localLiftUnlift
  :: HasCallStack
  => LocalEnv localEs
  -- ^ Local environment.
  -> UnliftStrategy
  -> ((forall r. Eff es r -> Eff localEs r) -> (forall r. Eff localEs r -> Eff es r) -> Eff es a)
  -- ^ Continuation with the lifting and unlifting function in scope.
  -> Eff es a
localLiftUnlift :: forall (localEs :: [Effect]) (es :: [Effect]) a.
HasCallStack =>
LocalEnv localEs
-> UnliftStrategy
-> ((forall r. Eff es r -> Eff localEs r)
    -> (forall r. Eff localEs r -> Eff es r) -> Eff es a)
-> Eff es a
localLiftUnlift LocalEnv localEs
localEs UnliftStrategy
strategy (forall r. Eff es r -> Eff localEs r)
-> (forall r. Eff localEs r -> Eff es r) -> Eff es 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 -> do
  Env localEs
les <- Env es -> LocalEnv localEs -> IO (Env localEs)
forall (es :: [Effect]) (localEs :: [Effect]).
HasCallStack =>
Env es -> LocalEnv localEs -> IO (Env localEs)
unwrapLocalEnv Env es
es LocalEnv localEs
localEs
  case UnliftStrategy
strategy of
    UnliftStrategy
SeqUnlift -> 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
        (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 es r -> Eff localEs r)
-> (forall r. Eff localEs r -> Eff es r) -> Eff es a
k (IO r -> Eff localEs r
forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ (IO r -> Eff localEs r)
-> (Eff es r -> IO r) -> Eff es r -> Eff localEs r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Eff es r -> IO r
forall r. Eff es r -> IO r
unliftEs) (IO r -> Eff es r
forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ (IO r -> Eff es r)
-> (Eff localEs r -> IO r) -> Eff localEs r -> Eff es r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Eff localEs r -> IO r
forall r. Eff localEs r -> IO r
unliftLocalEs)
    UnliftStrategy
SeqForkUnlift -> Env es
-> Env localEs
-> ((forall r. Eff es r -> IO r)
    -> (forall r. Eff localEs r -> IO r) -> IO a)
-> IO a
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
es Env localEs
les (((forall r. Eff es r -> IO r)
  -> (forall r. Eff localEs r -> IO r) -> IO a)
 -> IO a)
-> ((forall r. Eff es r -> IO r)
    -> (forall r. Eff localEs r -> IO r) -> IO a)
-> IO a
forall a b. (a -> b) -> a -> b
$ \forall r. Eff es r -> IO r
unliftEs forall r. Eff localEs r -> IO r
unliftLocalEs -> 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 es r -> Eff localEs r)
-> (forall r. Eff localEs r -> Eff es r) -> Eff es a
k (IO r -> Eff localEs r
forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ (IO r -> Eff localEs r)
-> (Eff es r -> IO r) -> Eff es r -> Eff localEs r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Eff es r -> IO r
forall r. Eff es r -> IO r
unliftEs) (IO r -> Eff es r
forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ (IO r -> Eff es r)
-> (Eff localEs r -> IO r) -> Eff localEs r -> Eff es r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Eff localEs r -> IO r
forall r. Eff localEs r -> IO r
unliftLocalEs)
    ConcUnlift Persistence
p Limit
l -> Env es
-> Env localEs
-> Persistence
-> Limit
-> ((forall r. Eff es r -> IO r)
    -> (forall r. Eff localEs r -> IO r) -> IO a)
-> IO a
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
p Limit
l (((forall r. Eff es r -> IO r)
  -> (forall r. Eff localEs r -> IO r) -> IO a)
 -> IO a)
-> ((forall r. Eff es r -> IO r)
    -> (forall r. Eff localEs r -> IO r) -> IO a)
-> IO a
forall a b. (a -> b) -> a -> b
$ \forall r. Eff es r -> IO r
unliftEs forall r. Eff localEs r -> IO r
unliftLocalEs -> 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 es r -> Eff localEs r)
-> (forall r. Eff localEs r -> Eff es r) -> Eff es a
k (IO r -> Eff localEs r
forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ (IO r -> Eff localEs r)
-> (Eff es r -> IO r) -> Eff es r -> Eff localEs r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Eff es r -> IO r
forall r. Eff es r -> IO r
unliftEs) (IO r -> Eff es r
forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ (IO r -> Eff es r)
-> (Eff localEs r -> IO r) -> Eff localEs r -> Eff es r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Eff localEs r -> IO r
forall r. Eff localEs r -> IO r
unliftLocalEs)
{-# INLINE localLiftUnlift #-}

-- | Create a local unlifting function with the given strategy along with an
-- unrestricted lifting function.
--
-- Useful for lifting complicated 'IO' computations where the monadic action
-- shows in both positive (as a result) and negative (as an argument) position.
--
-- /Note:/ depending on the computation you're lifting 'localUnliftIO' along
-- with 'withLiftMapIO' might be enough and is more efficient.
localLiftUnliftIO
  :: (HasCallStack, IOE :> es)
  => LocalEnv localEs
  -- ^ Local environment.
  -> UnliftStrategy
  -> ((forall r. IO r -> Eff localEs r) -> (forall r. Eff localEs r -> IO r) -> IO a)
  -- ^ Continuation with the lifting and unlifting function in scope.
  -> Eff es a
localLiftUnliftIO :: forall (es :: [Effect]) (localEs :: [Effect]) a.
(HasCallStack, IOE :> es) =>
LocalEnv localEs
-> UnliftStrategy
-> ((forall r. IO r -> Eff localEs r)
    -> (forall r. Eff localEs r -> IO r) -> IO a)
-> Eff es a
localLiftUnliftIO LocalEnv localEs
localEs UnliftStrategy
strategy (forall r. IO r -> Eff localEs r)
-> (forall r. Eff localEs 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 -> do
  Env localEs
les <- Env es -> LocalEnv localEs -> IO (Env localEs)
forall (es :: [Effect]) (localEs :: [Effect]).
HasCallStack =>
Env es -> LocalEnv localEs -> IO (Env localEs)
unwrapLocalEnv Env es
es LocalEnv localEs
localEs
  case UnliftStrategy
strategy of
    UnliftStrategy
SeqUnlift      -> 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. IO r -> Eff localEs r)
-> (forall r. Eff localEs r -> IO r) -> IO a
k IO r -> Eff localEs r
forall r. IO r -> Eff localEs r
forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_
    UnliftStrategy
SeqForkUnlift  -> 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
seqForkUnliftIO 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. IO r -> Eff localEs r)
-> (forall r. Eff localEs r -> IO r) -> IO a
k IO r -> Eff localEs r
forall r. IO r -> Eff localEs r
forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_
    ConcUnlift Persistence
p Limit
l -> Env localEs
-> Persistence
-> Limit
-> ((forall r. Eff localEs 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 localEs
les Persistence
p Limit
l (((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. IO r -> Eff localEs r)
-> (forall r. Eff localEs r -> IO r) -> IO a
k IO r -> Eff localEs r
forall r. IO r -> Eff localEs r
forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_
{-# INLINE localLiftUnliftIO #-}

----------------------------------------
-- Misc

-- | Lend effects to the local environment.
--
-- Consider the following effect:
--
-- >>> :{
--   data D :: Effect where
--     D :: D m ()
--   type instance DispatchOf D = Dynamic
-- :}
--
-- and an auxiliary effect that requires both @IOE@ and @D@ to run:
--
-- >>> :{
--   data E :: Effect
--   runE :: (IOE :> es, D :> es) => Eff (E : es) a -> Eff es a
--   runE = error "runE"
-- :}
--
-- Trying to use @runE@ inside the handler of @D@ doesn't work out of the box:
--
-- >>> :{
--   runD :: IOE :> es => Eff (D : es) a -> Eff es a
--   runD = interpret $ \env -> \case
--     D -> localSeqUnlift env $ \unlift -> do
--       unlift . runE $ pure ()
-- :}
-- ...
-- ...Could not deduce ...IOE :> localEs... arising from a use of ‘runE’
-- ...from the context: IOE :> es
-- ...
--
-- The problem is that @runE@ needs @IOE :> localEs@, but only @IOE :> es@ is
-- available. This function allows us to bridge the gap:
--
-- >>> :{
--   runD :: IOE :> es => Eff (D : es) a -> Eff es a
--   runD = interpret $ \env -> \case
--     D -> localSeqUnlift env $ \unlift -> do
--       localSeqLend @'[IOE] env $ \useIOE -> do
--         unlift . useIOE . runE $ pure ()
-- :}
--
-- @since 2.4.0.0
localSeqLend
  :: forall lentEs es localEs a
   . (HasCallStack, KnownSubset lentEs es)
  => LocalEnv localEs
  -> ((forall r. Eff (lentEs ++ localEs) r -> Eff localEs r) -> Eff es a)
  -- ^ Continuation with the lent handler in scope.
  -> Eff es a
localSeqLend :: forall (lentEs :: [Effect]) (es :: [Effect]) (localEs :: [Effect])
       a.
(HasCallStack, KnownSubset lentEs es) =>
LocalEnv localEs
-> ((forall r. Eff (lentEs ++ localEs) r -> Eff localEs r)
    -> Eff es a)
-> Eff es a
localSeqLend LocalEnv localEs
localEs (forall r. Eff (lentEs ++ localEs) r -> Eff localEs r) -> Eff es 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 -> do
  Env localEs
les <- Env es -> LocalEnv localEs -> IO (Env localEs)
forall (es :: [Effect]) (localEs :: [Effect]).
HasCallStack =>
Env es -> LocalEnv localEs -> IO (Env localEs)
unwrapLocalEnv Env es
es LocalEnv localEs
localEs
  Env (lentEs ++ localEs)
eles <- forall (es :: [Effect]) (srcEs :: [Effect]) (destEs :: [Effect]).
(HasCallStack, KnownSubset es srcEs) =>
Env srcEs -> Env destEs -> IO (Env (es ++ destEs))
copyRefs @lentEs Env es
es Env localEs
les
  Env (lentEs ++ localEs)
-> ((forall r. Eff (lentEs ++ 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 (lentEs ++ localEs)
eles (((forall r. Eff (lentEs ++ localEs) r -> IO r) -> IO a) -> IO a)
-> ((forall r. Eff (lentEs ++ localEs) r -> IO r) -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \forall r. Eff (lentEs ++ localEs) r -> IO r
unlift -> (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 (lentEs ++ localEs) r -> Eff localEs r) -> Eff es a
k ((forall r. Eff (lentEs ++ localEs) r -> Eff localEs r)
 -> Eff es a)
-> (forall r. Eff (lentEs ++ localEs) r -> Eff localEs r)
-> Eff es a
forall a b. (a -> b) -> a -> b
$ IO r -> Eff localEs r
forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ (IO r -> Eff localEs r)
-> (Eff (lentEs ++ localEs) r -> IO r)
-> Eff (lentEs ++ localEs) r
-> Eff localEs r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Eff (lentEs ++ localEs) r -> IO r
forall r. Eff (lentEs ++ localEs) r -> IO r
unlift
{-# INLINE localSeqLend #-}

-- | Lend effects to the local environment with a given unlifting strategy.
--
-- Generalizes 'localSeqLend'.
--
-- @since 2.4.0.0
localLend
  :: forall lentEs es localEs a
   . (HasCallStack, KnownSubset lentEs es)
  => LocalEnv localEs
  -> UnliftStrategy
  -> ((forall r. Eff (lentEs ++ localEs) r -> Eff localEs r) -> Eff es a)
  -- ^ Continuation with the lent handler in scope.
  -> Eff es a
localLend :: forall (lentEs :: [Effect]) (es :: [Effect]) (localEs :: [Effect])
       a.
(HasCallStack, KnownSubset lentEs es) =>
LocalEnv localEs
-> UnliftStrategy
-> ((forall r. Eff (lentEs ++ localEs) r -> Eff localEs r)
    -> Eff es a)
-> Eff es a
localLend LocalEnv localEs
localEs UnliftStrategy
strategy (forall r. Eff (lentEs ++ localEs) r -> Eff localEs r) -> Eff es 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 -> do
  Env localEs
les <- Env es -> LocalEnv localEs -> IO (Env localEs)
forall (es :: [Effect]) (localEs :: [Effect]).
HasCallStack =>
Env es -> LocalEnv localEs -> IO (Env localEs)
unwrapLocalEnv Env es
es LocalEnv localEs
localEs
  Env (lentEs ++ localEs)
eles <- forall (es :: [Effect]) (srcEs :: [Effect]) (destEs :: [Effect]).
(HasCallStack, KnownSubset es srcEs) =>
Env srcEs -> Env destEs -> IO (Env (es ++ destEs))
copyRefs @lentEs Env es
es Env localEs
les
  case UnliftStrategy
strategy of
    UnliftStrategy
SeqUnlift -> Env (lentEs ++ localEs)
-> ((forall r. Eff (lentEs ++ 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 (lentEs ++ localEs)
eles (((forall r. Eff (lentEs ++ localEs) r -> IO r) -> IO a) -> IO a)
-> ((forall r. Eff (lentEs ++ localEs) r -> IO r) -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \forall r. Eff (lentEs ++ localEs) 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 (lentEs ++ localEs) r -> Eff localEs r) -> Eff es a
k ((forall r. Eff (lentEs ++ localEs) r -> Eff localEs r)
 -> Eff es a)
-> (forall r. Eff (lentEs ++ localEs) r -> Eff localEs r)
-> Eff es a
forall a b. (a -> b) -> a -> b
$ IO r -> Eff localEs r
forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ (IO r -> Eff localEs r)
-> (Eff (lentEs ++ localEs) r -> IO r)
-> Eff (lentEs ++ localEs) r
-> Eff localEs r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Eff (lentEs ++ localEs) r -> IO r
forall r. Eff (lentEs ++ localEs) r -> IO r
unlift
    UnliftStrategy
SeqForkUnlift -> Env (lentEs ++ localEs)
-> ((forall r. Eff (lentEs ++ 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
seqForkUnliftIO Env (lentEs ++ localEs)
eles (((forall r. Eff (lentEs ++ localEs) r -> IO r) -> IO a) -> IO a)
-> ((forall r. Eff (lentEs ++ localEs) r -> IO r) -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \forall r. Eff (lentEs ++ localEs) 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 (lentEs ++ localEs) r -> Eff localEs r) -> Eff es a
k ((forall r. Eff (lentEs ++ localEs) r -> Eff localEs r)
 -> Eff es a)
-> (forall r. Eff (lentEs ++ localEs) r -> Eff localEs r)
-> Eff es a
forall a b. (a -> b) -> a -> b
$ IO r -> Eff localEs r
forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ (IO r -> Eff localEs r)
-> (Eff (lentEs ++ localEs) r -> IO r)
-> Eff (lentEs ++ localEs) r
-> Eff localEs r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Eff (lentEs ++ localEs) r -> IO r
forall r. Eff (lentEs ++ localEs) r -> IO r
unlift
    ConcUnlift Persistence
p Limit
l -> Env (lentEs ++ localEs)
-> Persistence
-> Limit
-> ((forall r. Eff (lentEs ++ localEs) 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 (lentEs ++ localEs)
eles Persistence
p Limit
l (((forall r. Eff (lentEs ++ localEs) r -> IO r) -> IO a) -> IO a)
-> ((forall r. Eff (lentEs ++ localEs) r -> IO r) -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \forall r. Eff (lentEs ++ localEs) 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 (lentEs ++ localEs) r -> Eff localEs r) -> Eff es a
k ((forall r. Eff (lentEs ++ localEs) r -> Eff localEs r)
 -> Eff es a)
-> (forall r. Eff (lentEs ++ localEs) r -> Eff localEs r)
-> Eff es a
forall a b. (a -> b) -> a -> b
$ IO r -> Eff localEs r
forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ (IO r -> Eff localEs r)
-> (Eff (lentEs ++ localEs) r -> IO r)
-> Eff (lentEs ++ localEs) r
-> Eff localEs r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Eff (lentEs ++ localEs) r -> IO r
forall r. Eff (lentEs ++ localEs) r -> IO r
unlift
{-# INLINE localLend #-}

-- | Borrow effects from the local environment.
--
-- @since 2.4.0.0
localSeqBorrow
  :: forall borrowedEs es localEs a
   . (HasCallStack, KnownSubset borrowedEs localEs)
  => LocalEnv localEs
  -> ((forall r. Eff (borrowedEs ++ es) r -> Eff es r) -> Eff es a)
  -- ^ Continuation with the borrowed handler in scope.
  -> Eff es a
localSeqBorrow :: forall (borrowedEs :: [Effect]) (es :: [Effect])
       (localEs :: [Effect]) a.
(HasCallStack, KnownSubset borrowedEs localEs) =>
LocalEnv localEs
-> ((forall r. Eff (borrowedEs ++ es) r -> Eff es r) -> Eff es a)
-> Eff es a
localSeqBorrow LocalEnv localEs
localEs (forall r. Eff (borrowedEs ++ es) r -> Eff es r) -> Eff es 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 -> do
  Env localEs
les <- Env es -> LocalEnv localEs -> IO (Env localEs)
forall (es :: [Effect]) (localEs :: [Effect]).
HasCallStack =>
Env es -> LocalEnv localEs -> IO (Env localEs)
unwrapLocalEnv Env es
es LocalEnv localEs
localEs
  Env (borrowedEs ++ es)
ees <- forall (es :: [Effect]) (srcEs :: [Effect]) (destEs :: [Effect]).
(HasCallStack, KnownSubset es srcEs) =>
Env srcEs -> Env destEs -> IO (Env (es ++ destEs))
copyRefs @borrowedEs Env localEs
les Env es
es
  Env (borrowedEs ++ es)
-> ((forall r. Eff (borrowedEs ++ 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 (borrowedEs ++ es)
ees (((forall r. Eff (borrowedEs ++ es) r -> IO r) -> IO a) -> IO a)
-> ((forall r. Eff (borrowedEs ++ es) r -> IO r) -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \forall r. Eff (borrowedEs ++ es) r -> IO r
unlift -> (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 (borrowedEs ++ es) r -> Eff es r) -> Eff es a
k ((forall r. Eff (borrowedEs ++ es) r -> Eff es r) -> Eff es a)
-> (forall r. Eff (borrowedEs ++ 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 (borrowedEs ++ es) r -> IO r)
-> Eff (borrowedEs ++ es) r
-> Eff es r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Eff (borrowedEs ++ es) r -> IO r
forall r. Eff (borrowedEs ++ es) r -> IO r
unlift
{-# INLINE localSeqBorrow #-}

-- | Borrow effects from the local environment with a given unlifting
-- strategy.
--
-- Generalizes 'localSeqBorrow'.
--
-- @since 2.4.0.0
localBorrow
  :: forall borrowedEs es localEs a
   . (HasCallStack, KnownSubset borrowedEs localEs)
  => LocalEnv localEs
  -> UnliftStrategy
  -> ((forall r. Eff (borrowedEs ++ es) r -> Eff es r) -> Eff es a)
  -- ^ Continuation with the borrowed handler in scope.
  -> Eff es a
localBorrow :: forall (borrowedEs :: [Effect]) (es :: [Effect])
       (localEs :: [Effect]) a.
(HasCallStack, KnownSubset borrowedEs localEs) =>
LocalEnv localEs
-> UnliftStrategy
-> ((forall r. Eff (borrowedEs ++ es) r -> Eff es r) -> Eff es a)
-> Eff es a
localBorrow LocalEnv localEs
localEs UnliftStrategy
strategy (forall r. Eff (borrowedEs ++ es) r -> Eff es r) -> Eff es 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 -> do
  Env localEs
les <- Env es -> LocalEnv localEs -> IO (Env localEs)
forall (es :: [Effect]) (localEs :: [Effect]).
HasCallStack =>
Env es -> LocalEnv localEs -> IO (Env localEs)
unwrapLocalEnv Env es
es LocalEnv localEs
localEs
  Env (borrowedEs ++ es)
ees <- forall (es :: [Effect]) (srcEs :: [Effect]) (destEs :: [Effect]).
(HasCallStack, KnownSubset es srcEs) =>
Env srcEs -> Env destEs -> IO (Env (es ++ destEs))
copyRefs @borrowedEs Env localEs
les Env es
es
  case UnliftStrategy
strategy of
    UnliftStrategy
SeqUnlift -> Env (borrowedEs ++ es)
-> ((forall r. Eff (borrowedEs ++ 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 (borrowedEs ++ es)
ees (((forall r. Eff (borrowedEs ++ es) r -> IO r) -> IO a) -> IO a)
-> ((forall r. Eff (borrowedEs ++ es) r -> IO r) -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \forall r. Eff (borrowedEs ++ 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 (borrowedEs ++ es) r -> Eff es r) -> Eff es a
k ((forall r. Eff (borrowedEs ++ es) r -> Eff es r) -> Eff es a)
-> (forall r. Eff (borrowedEs ++ 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 (borrowedEs ++ es) r -> IO r)
-> Eff (borrowedEs ++ es) r
-> Eff es r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Eff (borrowedEs ++ es) r -> IO r
forall r. Eff (borrowedEs ++ es) r -> IO r
unlift
    UnliftStrategy
SeqForkUnlift -> Env (borrowedEs ++ es)
-> ((forall r. Eff (borrowedEs ++ 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 (borrowedEs ++ es)
ees (((forall r. Eff (borrowedEs ++ es) r -> IO r) -> IO a) -> IO a)
-> ((forall r. Eff (borrowedEs ++ es) r -> IO r) -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \forall r. Eff (borrowedEs ++ 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 (borrowedEs ++ es) r -> Eff es r) -> Eff es a
k ((forall r. Eff (borrowedEs ++ es) r -> Eff es r) -> Eff es a)
-> (forall r. Eff (borrowedEs ++ 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 (borrowedEs ++ es) r -> IO r)
-> Eff (borrowedEs ++ es) r
-> Eff es r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Eff (borrowedEs ++ es) r -> IO r
forall r. Eff (borrowedEs ++ es) r -> IO r
unlift
    ConcUnlift Persistence
p Limit
l -> Env (borrowedEs ++ es)
-> Persistence
-> Limit
-> ((forall r. Eff (borrowedEs ++ 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 (borrowedEs ++ es)
ees Persistence
p Limit
l (((forall r. Eff (borrowedEs ++ es) r -> IO r) -> IO a) -> IO a)
-> ((forall r. Eff (borrowedEs ++ es) r -> IO r) -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \forall r. Eff (borrowedEs ++ 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 (borrowedEs ++ es) r -> Eff es r) -> Eff es a
k ((forall r. Eff (borrowedEs ++ es) r -> Eff es r) -> Eff es a)
-> (forall r. Eff (borrowedEs ++ 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 (borrowedEs ++ es) r -> IO r)
-> Eff (borrowedEs ++ es) r
-> Eff es r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Eff (borrowedEs ++ es) r -> IO r
forall r. Eff (borrowedEs ++ es) r -> IO r
unlift
{-# INLINE localBorrow #-}

-- | Simultaneously lend effects to the local environment and borrow effects
-- from it with a given unlifting strategy.
--
-- /Note:/ when 'SeqForkUnlift' or 'ConcUnlift' 'Persistent' strategy is used,
-- the lending and borrowing functions will share the effect storage (unlike
-- with two separate calls to 'localLend' and 'localBorrow').
--
-- @since 2.7.0.0
localLendBorrow
  :: forall lentEs borrowedEs es localEs a
   . ( HasCallStack
     , KnownSubset lentEs es
     , KnownSubset borrowedEs localEs
     )
  => LocalEnv localEs
  -> UnliftStrategy
  -> (    (forall r. Eff (lentEs ++ localEs) r -> Eff localEs r)
       -> (forall r. Eff (borrowedEs ++ es) r -> Eff es r)
       -> Eff es a
     )
  -- ^ Continuation with the lending and borrowing functions in scope.
  -> Eff es a
localLendBorrow :: forall (lentEs :: [Effect]) (borrowedEs :: [Effect])
       (es :: [Effect]) (localEs :: [Effect]) a.
(HasCallStack, KnownSubset lentEs es,
 KnownSubset borrowedEs localEs) =>
LocalEnv localEs
-> UnliftStrategy
-> ((forall r. Eff (lentEs ++ localEs) r -> Eff localEs r)
    -> (forall r. Eff (borrowedEs ++ es) r -> Eff es r) -> Eff es a)
-> Eff es a
localLendBorrow LocalEnv localEs
localEs UnliftStrategy
strategy (forall r. Eff (lentEs ++ localEs) r -> Eff localEs r)
-> (forall r. Eff (borrowedEs ++ es) r -> Eff es r) -> Eff es 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 -> do
  Env localEs
les <- Env es -> LocalEnv localEs -> IO (Env localEs)
forall (es :: [Effect]) (localEs :: [Effect]).
HasCallStack =>
Env es -> LocalEnv localEs -> IO (Env localEs)
unwrapLocalEnv Env es
es LocalEnv localEs
localEs
  Env (lentEs ++ localEs)
eles <- forall (es :: [Effect]) (srcEs :: [Effect]) (destEs :: [Effect]).
(HasCallStack, KnownSubset es srcEs) =>
Env srcEs -> Env destEs -> IO (Env (es ++ destEs))
copyRefs @lentEs Env es
es Env localEs
les
  Env (borrowedEs ++ es)
ees <- forall (es :: [Effect]) (srcEs :: [Effect]) (destEs :: [Effect]).
(HasCallStack, KnownSubset es srcEs) =>
Env srcEs -> Env destEs -> IO (Env (es ++ destEs))
copyRefs @borrowedEs Env localEs
les Env es
es
  case UnliftStrategy
strategy of
    UnliftStrategy
SeqUnlift -> Env (lentEs ++ localEs)
-> ((forall r. Eff (lentEs ++ 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 (lentEs ++ localEs)
eles (((forall r. Eff (lentEs ++ localEs) r -> IO r) -> IO a) -> IO a)
-> ((forall r. Eff (lentEs ++ localEs) r -> IO r) -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \forall r. Eff (lentEs ++ localEs) r -> IO r
unliftLent -> do
      Env (borrowedEs ++ es)
-> ((forall r. Eff (borrowedEs ++ 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 (borrowedEs ++ es)
ees (((forall r. Eff (borrowedEs ++ es) r -> IO r) -> IO a) -> IO a)
-> ((forall r. Eff (borrowedEs ++ es) r -> IO r) -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \forall r. Eff (borrowedEs ++ es) r -> IO r
unliftBorrowed -> 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 (lentEs ++ localEs) r -> Eff localEs r)
-> (forall r. Eff (borrowedEs ++ es) r -> Eff es r) -> Eff es a
k (IO r -> Eff localEs r
forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ (IO r -> Eff localEs r)
-> (Eff (lentEs ++ localEs) r -> IO r)
-> Eff (lentEs ++ localEs) r
-> Eff localEs r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Eff (lentEs ++ localEs) r -> IO r
forall r. Eff (lentEs ++ localEs) r -> IO r
unliftLent) (IO r -> Eff es r
forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ (IO r -> Eff es r)
-> (Eff (borrowedEs ++ es) r -> IO r)
-> Eff (borrowedEs ++ es) r
-> Eff es r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Eff (borrowedEs ++ es) r -> IO r
forall r. Eff (borrowedEs ++ es) r -> IO r
unliftBorrowed)
    UnliftStrategy
SeqForkUnlift -> Env (lentEs ++ localEs)
-> Env (borrowedEs ++ es)
-> ((forall r. Eff (lentEs ++ localEs) r -> IO r)
    -> (forall r. Eff (borrowedEs ++ es) r -> IO r) -> IO a)
-> IO a
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 (lentEs ++ localEs)
eles Env (borrowedEs ++ es)
ees (((forall r. Eff (lentEs ++ localEs) r -> IO r)
  -> (forall r. Eff (borrowedEs ++ es) r -> IO r) -> IO a)
 -> IO a)
-> ((forall r. Eff (lentEs ++ localEs) r -> IO r)
    -> (forall r. Eff (borrowedEs ++ es) r -> IO r) -> IO a)
-> IO a
forall a b. (a -> b) -> a -> b
$ \forall r. Eff (lentEs ++ localEs) r -> IO r
unliftLent forall r. Eff (borrowedEs ++ es) r -> IO r
unliftBorrowed -> 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 (lentEs ++ localEs) r -> Eff localEs r)
-> (forall r. Eff (borrowedEs ++ es) r -> Eff es r) -> Eff es a
k (IO r -> Eff localEs r
forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ (IO r -> Eff localEs r)
-> (Eff (lentEs ++ localEs) r -> IO r)
-> Eff (lentEs ++ localEs) r
-> Eff localEs r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Eff (lentEs ++ localEs) r -> IO r
forall r. Eff (lentEs ++ localEs) r -> IO r
unliftLent) (IO r -> Eff es r
forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ (IO r -> Eff es r)
-> (Eff (borrowedEs ++ es) r -> IO r)
-> Eff (borrowedEs ++ es) r
-> Eff es r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Eff (borrowedEs ++ es) r -> IO r
forall r. Eff (borrowedEs ++ es) r -> IO r
unliftBorrowed)
    ConcUnlift Persistence
p Limit
l -> Env (lentEs ++ localEs)
-> Env (borrowedEs ++ es)
-> Persistence
-> Limit
-> ((forall r. Eff (lentEs ++ localEs) r -> IO r)
    -> (forall r. Eff (borrowedEs ++ es) r -> IO r) -> IO a)
-> IO a
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 (lentEs ++ localEs)
eles Env (borrowedEs ++ es)
ees Persistence
p Limit
l (((forall r. Eff (lentEs ++ localEs) r -> IO r)
  -> (forall r. Eff (borrowedEs ++ es) r -> IO r) -> IO a)
 -> IO a)
-> ((forall r. Eff (lentEs ++ localEs) r -> IO r)
    -> (forall r. Eff (borrowedEs ++ es) r -> IO r) -> IO a)
-> IO a
forall a b. (a -> b) -> a -> b
$ \forall r. Eff (lentEs ++ localEs) r -> IO r
unliftLent forall r. Eff (borrowedEs ++ es) r -> IO r
unliftBorrowed -> 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 (lentEs ++ localEs) r -> Eff localEs r)
-> (forall r. Eff (borrowedEs ++ es) r -> Eff es r) -> Eff es a
k (IO r -> Eff localEs r
forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ (IO r -> Eff localEs r)
-> (Eff (lentEs ++ localEs) r -> IO r)
-> Eff (lentEs ++ localEs) r
-> Eff localEs r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Eff (lentEs ++ localEs) r -> IO r
forall r. Eff (lentEs ++ localEs) r -> IO r
unliftLent) (IO r -> Eff es r
forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ (IO r -> Eff es r)
-> (Eff (borrowedEs ++ es) r -> IO r)
-> Eff (borrowedEs ++ es) r
-> Eff es r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Eff (borrowedEs ++ es) r -> IO r
forall r. Eff (borrowedEs ++ es) r -> IO r
unliftBorrowed)
{-# INLINE localLendBorrow #-}

-- | Require that both effect stacks share an opaque suffix.
--
-- Functions from the 'localUnlift' family previously required this constraint
-- to reject a subset of improper uses of unlifting functions at compile
-- time. It's no longer necessary, since all of them are detected at runtime
-- now.
--
-- As an example, consider the following higher order effect:
--
-- >>> :{
--   data E :: Effect where
--     E :: m a -> E m a
--   type instance DispatchOf E = Dynamic
-- :}
--
-- Running local actions in a more specific environment is fine:
--
-- >>> :{
--  runE1 :: Eff (E : es) a -> Eff es a
--  runE1 = interpret $ \env -> \case
--    E m -> runReader () $ do
--      localSeqUnlift env $ \unlift -> unlift m
-- :}
--
-- Running local actions in a more general environment is fine:
--
-- >>> :{
--  runE2 :: Eff (E : es) a -> Eff es a
--  runE2 = reinterpret (runReader ()) $ \env -> \case
--    E m -> raise $ do
--      localSeqUnlift env $ \unlift -> unlift m
-- :}
--
-- However, running local actions in an unrelated environment is not fine as
-- this would make it possible to run anything within 'runPureEff':
--
-- >>> :{
--  runE3 :: Eff (E : es) a -> Eff es a
--  runE3 = reinterpret (runReader ()) $ \env -> \case
--    E m -> pure . runPureEff $ do
--      localSeqUnlift env $ \unlift -> unlift m
-- :}
--
-- >>> runEff . runE3 $ send (E (pure 'x'))
-- *** Exception: Env and LocalEnv point to different Storages.
-- ...
--
-- @since 1.2.0.0
{-# DEPRECATED SharedSuffix
      "Runtime sanity checks in relevant functions make this constraint unnecessary."
  #-}
class SharedSuffix (es1 :: [Effect]) (es2 :: [Effect])

instance {-# INCOHERENT #-} SharedSuffix es es
instance {-# INCOHERENT #-} SharedSuffix es1 es2 => SharedSuffix (e : es1) es2
instance {-# INCOHERENT #-} SharedSuffix es1 es2 => SharedSuffix es1 (e : es2)

-- | This is always preferred to @SharedSuffix es es@ as it's not incoherent.
instance
  TypeError
  ( Text "Running local actions in monomorphic effect stacks is not supported." :$$:
    Text "As a solution simply change the stack to have a polymorphic suffix."
  ) => SharedSuffix '[] '[]

----------------------------------------
-- Helpers

-- Note [NOINLINE on the Impl functions]
--
-- The public wrappers must inline at call sites, because that's the only place
-- the callstack-thawing adapter around the handler (see 'HandlerImpl') can
-- fuse with a concrete handler. If it doesn't, the adapter is stored in the
-- 'Handler' as a closure over an unknown function and every 'send' pays for an
-- extra unknown call, CallStack allocation and generic apply of a PAP.
--
-- The wrappers have no INLINE pragmas, so they expose their optimized RHS as
-- the unfolding and GHC inlines them based on its size. NOINLINE below keeps
-- the bodies of the Impl functions out of these unfoldings, guaranteeing that
-- they stay small. Historically reinterpretImpl had an INLINE pragma instead
-- and a minor addition to it grew the wrappers of reinterpret past the
-- inlining threshold, silently causing exactly this regression.

interpretImpl
  :: (HasCallStack, DispatchOf e ~ Dynamic)
  => Eff (e : es) a
  -> HandlerImpl e es
  -> Eff      es  a
interpretImpl :: forall (e :: Effect) (es :: [Effect]) a.
(HasCallStack, DispatchOf e ~ 'Dynamic) =>
Eff (e : es) a -> HandlerImpl e es -> Eff es a
interpretImpl Eff (e : es) a
action HandlerImpl e es
handlerImpl = (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` Env es
es) (Eff es a -> IO a) -> Eff es a -> IO a
forall a b. (a -> b) -> a -> b
$ Handler e -> Eff (e : es) a -> Eff es a
forall (e :: Effect) (es :: [Effect]) a.
(HasCallStack, DispatchOf e ~ 'Dynamic) =>
Handler e -> Eff (e : es) a -> Eff es a
runHandler (Env es -> HandlerImpl e es -> Handler e
forall (handlerEs :: [Effect]) (a :: Effect).
Env handlerEs -> HandlerImpl a handlerEs -> Handler a
Handler Env es
es HandlerImpl e es
handlerImpl) Eff (e : es) a
action
{-# NOINLINE interpretImpl #-}

reinterpretImpl
  :: (HasCallStack, DispatchOf e ~ Dynamic)
  => (Eff handlerEs a -> Eff es b)
  -> Eff (e : es) a
  -> HandlerImpl e handlerEs
  -> Eff      es  b
reinterpretImpl :: forall (e :: Effect) (handlerEs :: [Effect]) a (es :: [Effect]) b.
(HasCallStack, DispatchOf e ~ 'Dynamic) =>
(Eff handlerEs a -> Eff es b)
-> Eff (e : es) a -> HandlerImpl e handlerEs -> Eff es b
reinterpretImpl Eff handlerEs a -> Eff es b
runSetup Eff (e : es) a
action HandlerImpl e handlerEs
handlerImpl = (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 -> do
  (Eff es b -> Env es -> IO b
forall (es :: [Effect]) a. Eff es a -> Env es -> IO a
`unEff` Env es
es) (Eff es b -> IO b)
-> ((Env handlerEs -> IO a) -> Eff es b)
-> (Env handlerEs -> IO a)
-> IO b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Eff handlerEs a -> Eff es b
runSetup (Eff handlerEs a -> Eff es b)
-> ((Env handlerEs -> IO a) -> Eff handlerEs a)
-> (Env handlerEs -> IO a)
-> Eff es b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Env handlerEs -> IO a) -> Eff handlerEs a
forall (es :: [Effect]) a. (Env es -> IO a) -> Eff es a
unsafeEff ((Env handlerEs -> IO a) -> IO b)
-> (Env handlerEs -> IO a) -> IO b
forall a b. (a -> b) -> a -> b
$ \Env handlerEs
handlerEs -> do
    Env es -> Env handlerEs -> IO ()
forall (es :: [Effect]) (handlerEs :: [Effect]).
HasCallStack =>
Env es -> Env handlerEs -> IO ()
requireInScopeSetup Env es
es Env handlerEs
handlerEs
    (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
$ Handler e -> Eff (e : es) a -> Eff es a
forall (e :: Effect) (es :: [Effect]) a.
(HasCallStack, DispatchOf e ~ 'Dynamic) =>
Handler e -> Eff (e : es) a -> Eff es a
runHandler (Env handlerEs -> HandlerImpl e handlerEs -> Handler e
forall (handlerEs :: [Effect]) (a :: Effect).
Env handlerEs -> HandlerImpl a handlerEs -> Handler a
Handler Env handlerEs
handlerEs HandlerImpl e handlerEs
handlerImpl) Eff (e : es) a
action
{-# NOINLINE reinterpretImpl #-}

interposeImpl
  :: forall e es a. (HasCallStack, DispatchOf e ~ Dynamic, e :> es)
  => Eff es a
  -> HandlerImpl e es
  -> Eff es a
interposeImpl :: forall (e :: Effect) (es :: [Effect]) a.
(HasCallStack, DispatchOf e ~ 'Dynamic, e :> es) =>
Eff es a -> HandlerImpl e es -> Eff es a
interposeImpl Eff es a
action HandlerImpl e es
handlerImpl = (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 (Env es) -> (Env es -> IO ()) -> (Env es -> IO a) -> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
inlineBracket
    (do
        Handler e
origHandler <- forall (e :: Effect) (es :: [Effect]).
(HasCallStack, e :> es) =>
Env es -> IO (EffectRep (DispatchOf e) e)
getEnv @e Env es
es
        EffectRep (DispatchOf e) e
-> Relinker (EffectRep (DispatchOf e)) e -> Env es -> IO (Env es)
forall (e :: Effect) (es :: [Effect]).
(HasCallStack, e :> es) =>
EffectRep (DispatchOf e) e
-> Relinker (EffectRep (DispatchOf e)) e -> Env es -> IO (Env es)
replaceEnv EffectRep (DispatchOf e) e
Handler e
origHandler Relinker (EffectRep (DispatchOf e)) e
Relinker Handler e
forall (e :: Effect). Relinker Handler e
relinkHandler Env es
es
    )
    (\Env es
newEs -> do
        -- Restore the original handler.
        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 -> IO ())
-> IO (EffectRep (DispatchOf e) e) -> IO ()
forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (e :: Effect) (es :: [Effect]).
(HasCallStack, e :> es) =>
Env es -> IO (EffectRep (DispatchOf e) e)
getEnv @e Env es
newEs
        forall (e :: Effect) (es :: [Effect]).
(HasCallStack, e :> es) =>
Env es -> IO ()
unreplaceEnv @e Env es
newEs
    )
    (\Env es
newEs -> do
        -- Replace the original handler with a new one. Note that 'newEs'
        -- will still see the original handler.
        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 -> IO ())
-> EffectRep (DispatchOf e) e -> IO ()
forall a b. (a -> b) -> a -> b
$ Env es -> HandlerImpl e es -> Handler e
forall (handlerEs :: [Effect]) (a :: Effect).
Env handlerEs -> HandlerImpl a handlerEs -> Handler a
Handler Env es
newEs HandlerImpl e es
handlerImpl
        Eff es a -> Env es -> IO a
forall (es :: [Effect]) a. Eff es a -> Env es -> IO a
unEff Eff es a
action Env es
es
    )
{-# NOINLINE interposeImpl #-}

imposeImpl
  :: forall e es handlerEs a b. (HasCallStack, DispatchOf e ~ Dynamic, e :> es)
  => (Eff handlerEs a -> Eff es b)
  -> Eff es a
  -> HandlerImpl e handlerEs
  -> Eff es b
imposeImpl :: forall (e :: Effect) (es :: [Effect]) (handlerEs :: [Effect]) a b.
(HasCallStack, DispatchOf e ~ 'Dynamic, e :> es) =>
(Eff handlerEs a -> Eff es b)
-> Eff es a -> HandlerImpl e handlerEs -> Eff es b
imposeImpl Eff handlerEs a -> Eff es b
runSetup Eff es a
action HandlerImpl e handlerEs
handlerImpl = (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 -> do
  IO (Env es) -> (Env es -> IO ()) -> (Env es -> IO b) -> IO b
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
inlineBracket
    (do
        Handler e
origHandler <- forall (e :: Effect) (es :: [Effect]).
(HasCallStack, e :> es) =>
Env es -> IO (EffectRep (DispatchOf e) e)
getEnv @e Env es
es
        EffectRep (DispatchOf e) e
-> Relinker (EffectRep (DispatchOf e)) e -> Env es -> IO (Env es)
forall (e :: Effect) (es :: [Effect]).
(HasCallStack, e :> es) =>
EffectRep (DispatchOf e) e
-> Relinker (EffectRep (DispatchOf e)) e -> Env es -> IO (Env es)
replaceEnv EffectRep (DispatchOf e) e
Handler e
origHandler Relinker (EffectRep (DispatchOf e)) e
Relinker Handler e
forall (e :: Effect). Relinker Handler e
relinkHandler Env es
es
    )
    (\Env es
newEs -> do
        -- Restore the original handler.
        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 -> IO ())
-> IO (EffectRep (DispatchOf e) e) -> IO ()
forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (e :: Effect) (es :: [Effect]).
(HasCallStack, e :> es) =>
Env es -> IO (EffectRep (DispatchOf e) e)
getEnv @e Env es
newEs
        forall (e :: Effect) (es :: [Effect]).
(HasCallStack, e :> es) =>
Env es -> IO ()
unreplaceEnv @e Env es
newEs
    )
    (\Env es
newEs -> do
        (Eff es b -> Env es -> IO b
forall (es :: [Effect]) a. Eff es a -> Env es -> IO a
`unEff` Env es
newEs) (Eff es b -> IO b)
-> ((Env handlerEs -> IO a) -> Eff es b)
-> (Env handlerEs -> IO a)
-> IO b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Eff handlerEs a -> Eff es b
runSetup (Eff handlerEs a -> Eff es b)
-> ((Env handlerEs -> IO a) -> Eff handlerEs a)
-> (Env handlerEs -> IO a)
-> Eff es b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Env handlerEs -> IO a) -> Eff handlerEs a
forall (es :: [Effect]) a. (Env es -> IO a) -> Eff es a
unsafeEff ((Env handlerEs -> IO a) -> IO b)
-> (Env handlerEs -> IO a) -> IO b
forall a b. (a -> b) -> a -> b
$ \Env handlerEs
handlerEs -> do
          Env es -> Env handlerEs -> IO ()
forall (es :: [Effect]) (handlerEs :: [Effect]).
HasCallStack =>
Env es -> Env handlerEs -> IO ()
requireInScopeSetup Env es
es Env handlerEs
handlerEs
          -- Replace the original handler with a new one. Note that
          -- 'newEs' (and thus 'handlerEs') wil still see the original
          -- handler.
          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 -> IO ())
-> EffectRep (DispatchOf e) e -> IO ()
forall a b. (a -> b) -> a -> b
$ Env handlerEs -> HandlerImpl e handlerEs -> Handler e
forall (handlerEs :: [Effect]) (a :: Effect).
Env handlerEs -> HandlerImpl a handlerEs -> Handler a
Handler Env handlerEs
handlerEs HandlerImpl e handlerEs
handlerImpl
          Eff es a -> Env es -> IO a
forall (es :: [Effect]) a. Eff es a -> Env es -> IO a
unEff Eff es a
action Env es
es
    )
{-# NOINLINE imposeImpl #-}

copyRefs
  :: forall es srcEs destEs
   . (HasCallStack, KnownSubset es srcEs)
  => Env srcEs
  -> Env destEs
  -> IO (Env (es ++ destEs))
copyRefs :: forall (es :: [Effect]) (srcEs :: [Effect]) (destEs :: [Effect]).
(HasCallStack, KnownSubset es srcEs) =>
Env srcEs -> Env destEs -> IO (Env (es ++ destEs))
copyRefs (Env Int
soffset PrimArray Ref
srefs IORef Storage
_) (Env Int
doffset PrimArray Ref
drefs IORef Storage
storage) = do
  let es :: [Int]
es = forall (subEs :: [Effect]) (es :: [Effect]).
Subset subEs es =>
[Int]
reifyIndices @es @srcEs
      esSize :: Int
esSize = [Int] -> Int
forall a. [a] -> Int
forall (t :: Type -> Type) a. Foldable t => t a -> Int
length [Int]
es
      destSize :: Int
destSize = PrimArray Ref -> Int
forall a. Prim a => PrimArray a -> Int
sizeofPrimArray PrimArray Ref
drefs Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
doffset
  MutablePrimArray RealWorld Ref
mrefs <- Int -> IO (MutablePrimArray (PrimState IO) Ref)
forall (m :: Type -> Type) a.
(PrimMonad m, Prim a) =>
Int -> m (MutablePrimArray (PrimState m) a)
newPrimArray (Int
esSize Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
destSize)
  MutablePrimArray (PrimState IO) Ref
-> Int -> PrimArray Ref -> Int -> Int -> IO ()
forall (m :: Type -> Type) a.
(PrimMonad m, Prim a) =>
MutablePrimArray (PrimState m) a
-> Int -> PrimArray a -> Int -> Int -> m ()
copyPrimArray MutablePrimArray RealWorld Ref
MutablePrimArray (PrimState IO) Ref
mrefs Int
esSize PrimArray Ref
drefs Int
doffset Int
destSize
  let writeRefs :: Int -> [Int] -> IO ()
writeRefs Int
i = \case
        [] -> () -> IO ()
forall a. a -> IO a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure ()
        (Int
x : [Int]
xs) -> do
          MutablePrimArray (PrimState IO) Ref -> Int -> Ref -> IO ()
forall a (m :: Type -> Type).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m ()
writePrimArray MutablePrimArray RealWorld Ref
MutablePrimArray (PrimState IO) Ref
mrefs Int
i (Ref -> IO ()) -> Ref -> IO ()
forall a b. (a -> b) -> a -> b
$ PrimArray Ref -> Int -> Ref
forall a. Prim a => PrimArray a -> Int -> a
indexPrimArray PrimArray Ref
srefs (Int
soffset Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
x)
          Int -> [Int] -> IO ()
writeRefs (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) [Int]
xs
  Int -> [Int] -> IO ()
writeRefs Int
0 [Int]
es
  PrimArray Ref
refs <- MutablePrimArray (PrimState IO) Ref -> IO (PrimArray Ref)
forall (m :: Type -> Type) a.
PrimMonad m =>
MutablePrimArray (PrimState m) a -> m (PrimArray a)
unsafeFreezePrimArray MutablePrimArray RealWorld Ref
MutablePrimArray (PrimState IO) Ref
mrefs
  Env (es ++ destEs) -> IO (Env (es ++ destEs))
forall a. a -> IO a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Env (es ++ destEs) -> IO (Env (es ++ destEs)))
-> Env (es ++ destEs) -> IO (Env (es ++ destEs))
forall a b. (a -> b) -> a -> b
$ Int -> PrimArray Ref -> IORef Storage -> Env (es ++ destEs)
forall (es :: [Effect]).
Int -> PrimArray Ref -> IORef Storage -> Env es
Env Int
0 PrimArray Ref
refs IORef Storage
storage
{-# NOINLINE copyRefs #-}

-- | Make sure the setup function of 'reinterpret' or 'impose' runs its
-- argument within its scope. If it runs in a cloned environment, the handler
-- would still operate on the environment of the call site, corrupting it.
requireInScopeSetup :: HasCallStack => Env es -> Env handlerEs -> IO ()
requireInScopeSetup :: forall (es :: [Effect]) (handlerEs :: [Effect]).
HasCallStack =>
Env es -> Env handlerEs -> IO ()
requireInScopeSetup Env es
es Env handlerEs
handlerEs
  | Env es
es.storage IORef Storage -> IORef Storage -> Bool
forall a. Eq a => a -> a -> Bool
/= Env handlerEs
handlerEs.storage = [Char] -> IO ()
forall a. HasCallStack => [Char] -> a
error
    ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"The setup function ran the computation in a cloned environment.\n"
    [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"If you unlifted it with the SeqForkUnlift or ConcUnlift strategy and "
    [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"attempted to run it outside of the scope of the setup function or in "
    [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"a different thread, it's not allowed."
  | Bool
otherwise = () -> IO ()
forall a. a -> IO a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure ()

-- $setup
-- >>> import Control.Concurrent (ThreadId, forkIOWithUnmask)
-- >>> import Control.Monad.IO.Class
-- >>> import Effectful.Reader.Static