module Control.Effect.Reader
  ( Reader(..)
  , ask
  , local
  , runReader
  ) where

import Control.Effect.Base

-- | The @'Reader' r@ effect provides access to a global environment of type @r@.
--
-- Handlers should obey the law @/f/ '<$>' 'ask'@ ≡ @'local' /f/ 'ask'@.
data Reader r :: Effect where
  Ask :: Reader r m r
  Local :: (r1 -> r2) -> Eff (Reader r2 ': effs) a -> Reader r1 (Eff effs) a

-- | Retrieves a value from the environment.
ask :: Reader r :< effs => Eff effs r
ask :: Eff effs r
ask = Reader r (Eff effs) r -> Eff effs r
forall (eff :: Effect) a (effs :: [Effect]).
(eff :< effs) =>
eff (Eff effs) a -> Eff effs a
send Reader r (Eff effs) r
forall r (m :: * -> *). Reader r m r
Ask

-- | Runs a subcomputation in an environment modified by the given function.
local :: Reader r1 :< effs => (r1 -> r2) -> Eff (Reader r2 ': effs) a -> Eff effs a
local :: (r1 -> r2) -> Eff (Reader r2 : effs) a -> Eff effs a
local r1 -> r2
a Eff (Reader r2 : effs) a
b = Reader r1 (Eff effs) a -> Eff effs a
forall (eff :: Effect) a (effs :: [Effect]).
(eff :< effs) =>
eff (Eff effs) a -> Eff effs a
send (Reader r1 (Eff effs) a -> Eff effs a)
-> Reader r1 (Eff effs) a -> Eff effs a
forall a b. (a -> b) -> a -> b
$ (r1 -> r2) -> Eff (Reader r2 : effs) a -> Reader r1 (Eff effs) a
forall r1 r2 (effs :: [Effect]) a.
(r1 -> r2) -> Eff (Reader r2 : effs) a -> Reader r1 (Eff effs) a
Local r1 -> r2
a Eff (Reader r2 : effs) a
b

-- | Handles a @'Reader'@ effect by supplying a value for the environment.
runReader :: r -> Eff (Reader r ': effs) a -> Eff effs a
runReader :: r -> Eff (Reader r : effs) a -> Eff effs a
runReader r
r = (a -> Eff effs a)
-> (forall (effs' :: [Effect]) b.
    (Reader r :< effs') =>
    Reader r (Eff effs') b -> Handle (Reader r) effs a a effs' b)
-> Eff (Reader r : effs) a
-> Eff effs a
forall (eff :: Effect) a r (effs :: [Effect]).
(a -> Eff effs r)
-> (forall (effs' :: [Effect]) b.
    (eff :< effs') =>
    eff (Eff effs') b -> Handle eff effs a r effs' b)
-> Eff (eff : effs) a
-> Eff effs r
handle a -> Eff effs a
forall (f :: * -> *) a. Applicative f => a -> f a
pure \case
  Reader r (Eff effs') b
Ask -> r -> Handle (Reader r) effs a a effs' r
forall (f :: * -> *) a. Applicative f => a -> f a
pure r
r
  Local f m -> Eff effs b -> Handle (Reader r) effs a a effs b
forall (effs' :: [Effect]) a (eff :: Effect) (effs :: [Effect]) i
       r.
Eff effs' a -> Handle eff effs i r effs' a
locally let !r' :: r2
r' = r -> r2
f r
r in r2 -> Eff (Reader r2 : effs) b -> Eff effs b
forall r (effs :: [Effect]) a.
r -> Eff (Reader r : effs) a -> Eff effs a
runReader r2
r' Eff (Reader r2 : effs) b
m