-- | The dynamically dispatched variant of the 'Reader' effect.
--
-- /Note:/ unless you plan to change interpretations at runtime, it's
-- recommended to use the statically dispatched variant,
-- i.e. "Effectful.Reader.Static".
module Effectful.Reader.Dynamic
  ( -- * Effect
    Reader(..)

    -- ** Handlers
  , runReader
  , withReader

    -- ** Operations
  , ask
  , asks
  , local
  ) where

import Effectful
import Effectful.Dispatch.Dynamic
import Effectful.Reader.Static qualified as R

data Reader r :: Effect where
  Ask   :: Reader r m r
  Local :: (r -> r) -> m a -> Reader r m a

type instance DispatchOf (Reader r) = Dynamic

-- | Run the 'Reader' effect with the given initial environment (via
-- "Effectful.Reader.Static").
runReader
  :: r -- ^ The initial environment.
  -> Eff (Reader r : es) a
  -> Eff es a
runReader :: forall r (es :: [(Type -> Type) -> Type -> Type]) a.
r -> Eff (Reader r : es) a -> Eff es a
runReader r
r = (Eff (Reader r : es) a -> Eff es a)
-> (forall {a} {localEs :: [(Type -> Type) -> Type -> Type]}.
    (HasCallStack, Reader r :> localEs) =>
    LocalEnv localEs (Reader r : es)
    -> Reader r (Eff localEs) a -> Eff (Reader r : es) a)
-> Eff (Reader r : es) a
-> Eff es a
forall (e :: (Type -> Type) -> Type -> Type)
       (handlerEs :: [(Type -> Type) -> Type -> Type]) a
       (es :: [(Type -> Type) -> Type -> Type]) b.
(DispatchOf e ~ 'Dynamic) =>
(Eff handlerEs a -> Eff es b)
-> EffectHandler e handlerEs -> Eff (e : es) a -> Eff es b
reinterpret (r -> Eff (Reader r : es) a -> Eff es a
forall r (es :: [(Type -> Type) -> Type -> Type]) a.
r -> Eff (Reader r : es) a -> Eff es a
R.runReader r
r) ((forall {a} {localEs :: [(Type -> Type) -> Type -> Type]}.
  (HasCallStack, Reader r :> localEs) =>
  LocalEnv localEs (Reader r : es)
  -> Reader r (Eff localEs) a -> Eff (Reader r : es) a)
 -> Eff (Reader r : es) a -> Eff es a)
-> (forall {a} {localEs :: [(Type -> Type) -> Type -> Type]}.
    (HasCallStack, Reader r :> localEs) =>
    LocalEnv localEs (Reader r : es)
    -> Reader r (Eff localEs) a -> Eff (Reader r : es) a)
-> Eff (Reader r : es) a
-> Eff es a
forall a b. (a -> b) -> a -> b
$ \LocalEnv localEs (Reader r : es)
env -> \case
  Reader r (Eff localEs) a
Ask       -> Eff (Reader r : es) a
forall r (es :: [(Type -> Type) -> Type -> Type]).
(Reader r :> es) =>
Eff es r
R.ask
  Local r -> r
f Eff localEs a
m -> LocalEnv localEs (Reader r : es)
-> ((forall {r}. Eff localEs r -> Eff (Reader r : es) r)
    -> Eff (Reader r : es) a)
-> Eff (Reader r : es) a
forall (es :: [(Type -> Type) -> Type -> Type])
       (handlerEs :: [(Type -> Type) -> Type -> Type])
       (localEs :: [(Type -> Type) -> Type -> Type]) a.
(HasCallStack, SharedSuffix es handlerEs) =>
LocalEnv localEs handlerEs
-> ((forall r. Eff localEs r -> Eff es r) -> Eff es a) -> Eff es a
localSeqUnlift LocalEnv localEs (Reader r : es)
env (((forall {r}. Eff localEs r -> Eff (Reader r : es) r)
  -> Eff (Reader r : es) a)
 -> Eff (Reader r : es) a)
-> ((forall {r}. Eff localEs r -> Eff (Reader r : es) r)
    -> Eff (Reader r : es) a)
-> Eff (Reader r : es) a
forall a b. (a -> b) -> a -> b
$ \forall {r}. Eff localEs r -> Eff (Reader r : es) r
unlift -> (r -> r) -> Eff (Reader r : es) a -> Eff (Reader r : es) a
forall r (es :: [(Type -> Type) -> Type -> Type]) a.
(Reader r :> es) =>
(r -> r) -> Eff es a -> Eff es a
R.local r -> r
f (Eff localEs a -> Eff (Reader r : es) a
forall {r}. Eff localEs r -> Eff (Reader r : es) r
unlift Eff localEs a
m)

-- | Execute a computation in a modified environment.
--
-- @since 1.1.0.0
withReader
  :: (r1 -> r2)
  -- ^ The function to modify the environment.
  -> Eff (Reader r2 : es) a
  -- ^ Computation to run in the modified environment.
  -> Eff (Reader r1 : es) a
withReader :: forall r1 r2 (es :: [(Type -> Type) -> Type -> Type]) a.
(r1 -> r2) -> Eff (Reader r2 : es) a -> Eff (Reader r1 : es) a
withReader r1 -> r2
f Eff (Reader r2 : es) a
m = do
  r1
r <- Eff (Reader r1 : es) r1
forall r (es :: [(Type -> Type) -> Type -> Type]).
(HasCallStack, Reader r :> es) =>
Eff es r
ask
  Eff es a -> Eff (Reader r1 : es) a
forall (es :: [(Type -> Type) -> Type -> Type]) a
       (e :: (Type -> Type) -> Type -> Type).
Eff es a -> Eff (e : es) a
raise (Eff es a -> Eff (Reader r1 : es) a)
-> Eff es a -> Eff (Reader r1 : es) a
forall a b. (a -> b) -> a -> b
$ r2 -> Eff (Reader r2 : es) a -> Eff es a
forall r (es :: [(Type -> Type) -> Type -> Type]) a.
r -> Eff (Reader r : es) a -> Eff es a
runReader (r1 -> r2
f r1
r) Eff (Reader r2 : es) a
m

----------------------------------------
-- Operations

-- | Fetch the value of the environment.
ask :: (HasCallStack, Reader r :> es) => Eff es r
ask :: forall r (es :: [(Type -> Type) -> Type -> Type]).
(HasCallStack, Reader r :> es) =>
Eff es r
ask = Reader r (Eff es) r -> Eff es r
forall (e :: (Type -> Type) -> Type -> Type)
       (es :: [(Type -> Type) -> Type -> Type]) a.
(HasCallStack, DispatchOf e ~ 'Dynamic, e :> es) =>
e (Eff es) a -> Eff es a
send Reader r (Eff es) r
forall r (m :: Type -> Type). Reader r m r
Ask

-- | Retrieve a function of the current environment.
--
-- @'asks' f ≡ f '<$>' 'ask'@
asks
  :: (HasCallStack, Reader r :> es)
  => (r -> a) -- ^ The function to apply to the environment.
  -> Eff es a
asks :: forall r (es :: [(Type -> Type) -> Type -> Type]) a.
(HasCallStack, Reader r :> es) =>
(r -> a) -> Eff es a
asks r -> a
f = r -> a
f (r -> a) -> Eff es r -> Eff es a
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Eff es r
forall r (es :: [(Type -> Type) -> Type -> Type]).
(HasCallStack, Reader r :> es) =>
Eff es r
ask

-- | Execute a computation in a modified environment.
--
-- @'runReader' r ('local' f m) ≡ 'runReader' (f r) m@
--
local
  :: (HasCallStack, Reader r :> es)
  => (r -> r) -- ^ The function to modify the environment.
  -> Eff es a
  -> Eff es a
local :: forall r (es :: [(Type -> Type) -> Type -> Type]) a.
(HasCallStack, Reader r :> es) =>
(r -> r) -> Eff es a -> Eff es a
local r -> r
f = Reader r (Eff es) a -> Eff es a
forall (e :: (Type -> Type) -> Type -> Type)
       (es :: [(Type -> Type) -> Type -> Type]) a.
(HasCallStack, DispatchOf e ~ 'Dynamic, e :> es) =>
e (Eff es) a -> Eff es a
send (Reader r (Eff es) a -> Eff es a)
-> (Eff es a -> Reader r (Eff es) a) -> Eff es a -> Eff es a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (r -> r) -> Eff es a -> Reader r (Eff es) a
forall r (m :: Type -> Type) a. (r -> r) -> m a -> Reader r m a
Local r -> r
f