{-# LANGUAGE AllowAmbiguousTypes #-}
-- | Convenience functions for the 'Labeled' 'Reader' effect.
--
-- @since 2.4.0.0
module Effectful.Labeled.Reader
  ( -- * Effect
    Reader(..)

    -- ** Handlers
  , runReader

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

import Effectful
import Effectful.Dispatch.Dynamic
import Effectful.Labeled
import Effectful.Reader.Dynamic (Reader(..))
import Effectful.Reader.Dynamic qualified as R

-- | Run the 'Reader' effect with the given initial environment (via
-- "Effectful.Reader.Static").
runReader
  :: forall label r es a
   . HasCallStack
  => r
  -- ^ The initial environment.
  -> Eff (Labeled label (Reader r) : es) a
  -> Eff es a
runReader :: forall {k} (label :: k) r (es :: [(Type -> Type) -> Type -> Type])
       a.
HasCallStack =>
r -> Eff (Labeled label (Reader r) : es) a -> Eff es a
runReader = forall (label :: k) (e :: (Type -> Type) -> Type -> Type)
       (es :: [(Type -> Type) -> Type -> Type]) a b.
HasCallStack =>
(Eff (e : es) a -> Eff es b)
-> Eff (Labeled label e : es) a -> Eff es b
forall {k} (label :: k) (e :: (Type -> Type) -> Type -> Type)
       (es :: [(Type -> Type) -> Type -> Type]) a b.
HasCallStack =>
(Eff (e : es) a -> Eff es b)
-> Eff (Labeled label e : es) a -> Eff es b
runLabeled @label ((Eff (Reader r : es) a -> Eff es a)
 -> Eff (Labeled label (Reader r) : es) a -> Eff es a)
-> (r -> Eff (Reader r : es) a -> Eff es a)
-> r
-> Eff (Labeled label (Reader r) : es) a
-> Eff es a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. r -> Eff (Reader r : es) a -> Eff es a
forall r (es :: [(Type -> Type) -> Type -> Type]) a.
HasCallStack =>
r -> Eff (Reader r : es) a -> Eff es a
R.runReader

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

-- | Fetch the value of the environment.
ask
  :: forall label r es
  . (HasCallStack, Labeled label (Reader r) :> es)
  => Eff es r
ask :: forall {k} (label :: k) r (es :: [(Type -> Type) -> Type -> Type]).
(HasCallStack, Labeled label (Reader r) :> es) =>
Eff es r
ask = Labeled label (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 (Labeled label (Reader r) (Eff es) r -> Eff es r)
-> Labeled label (Reader r) (Eff es) r -> Eff es r
forall a b. (a -> b) -> a -> b
$ forall (label :: k) (e :: (Type -> Type) -> Type -> Type)
       (a :: Type -> Type) b.
e a b -> Labeled label e a b
forall {k} (label :: k) (e :: (Type -> Type) -> Type -> Type)
       (a :: Type -> Type) b.
e a b -> Labeled label e a b
Labeled @label Reader r (Eff es) r
forall r (a :: Type -> Type). Reader r a r
Ask

-- | Retrieve a function of the current environment.
--
-- @'asks' f ≡ f '<$>' 'ask'@
asks
  :: forall label r es a
   . (HasCallStack, Labeled label (Reader r) :> es)
  => (r -> a)
  -- ^ The function to apply to the environment.
  -> Eff es a
asks :: forall {k} (label :: k) r (es :: [(Type -> Type) -> Type -> Type])
       a.
(HasCallStack, Labeled label (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
<$> forall (label :: k) r (es :: [(Type -> Type) -> Type -> Type]).
(HasCallStack, Labeled label (Reader r) :> es) =>
Eff es r
forall {k} (label :: k) r (es :: [(Type -> Type) -> Type -> Type]).
(HasCallStack, Labeled label (Reader r) :> es) =>
Eff es r
ask @label

-- | Execute a computation in a modified environment.
--
-- @'runReader' r ('local' f m) ≡ 'runReader' (f r) m@
--
local
  :: forall label r es a
   . (HasCallStack, Labeled label (Reader r) :> es)
  => (r -> r)
  -- ^ The function to modify the environment.
  -> Eff es a
  -> Eff es a
local :: forall {k} (label :: k) r (es :: [(Type -> Type) -> Type -> Type])
       a.
(HasCallStack, Labeled label (Reader r) :> es) =>
(r -> r) -> Eff es a -> Eff es a
local r -> r
f = Labeled label (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 (Labeled label (Reader r) (Eff es) a -> Eff es a)
-> (Eff es a -> Labeled label (Reader r) (Eff es) a)
-> Eff es a
-> Eff es a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (label :: k) (e :: (Type -> Type) -> Type -> Type)
       (a :: Type -> Type) b.
e a b -> Labeled label e a b
forall {k} (label :: k) (e :: (Type -> Type) -> Type -> Type)
       (a :: Type -> Type) b.
e a b -> Labeled label e a b
Labeled @label (Reader r (Eff es) a -> Labeled label (Reader r) (Eff es) a)
-> (Eff es a -> Reader r (Eff es) a)
-> Eff es a
-> Labeled label (Reader r) (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 (a :: Type -> Type) b. (r -> r) -> a b -> Reader r a b
Local r -> r
f