{-# LANGUAGE Trustworthy #-}
-- |
-- Copyright: (c) 2021 Xy Ren
-- License: BSD3
-- Maintainer: xy.r@outlook.com
-- Stability: experimental
-- Portability: non-portable (GHC only)
module Cleff.Reader
  ( -- * Effect
    Reader (..)
    -- * Operations
  , ask
  , local
  , asks
    -- * Interpretations
  , runReader
  , magnify
  ) where

import           Cleff
import           Lens.Micro (Lens', (%~), (&), (^.))

-- * Effect

-- | An effect capable of providing an immutable environment @r@ that can be read. This roughly corresponds to the
-- @MonadReader@ typeclass and @ReaderT@ monad transformer in the @mtl@ library.
data Reader r :: Effect where
  Ask :: Reader r m r
  Local :: (r -> r) -> m a -> Reader r m a

-- * Operations

makeEffect_ ''Reader

-- | Obtain the environment value.
ask :: Reader r :> es => Eff es r

-- | Modify the environment value temporarily for a computation.
local :: Reader r :> es
  => (r -> r) -- ^ The function that modifies the environment
  -> Eff es a -- ^ The computation to run with the modified environment
  -> Eff es a

-- | Apply a function to the result of 'ask'.
asks :: Reader r :> es => (r -> s) -> Eff es s
asks :: (r -> s) -> Eff es s
asks = ((r -> s) -> Eff es r -> Eff es s
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Eff es r
forall r (es :: [(Type -> Type) -> Type -> Type]).
(Reader r :> es) =>
Eff es r
ask)

-- * Interpretations

-- | Run a 'Reader' effect with a given environment value.
runReader :: r -> Eff (Reader r ': es) ~> Eff es
runReader :: r -> Eff (Reader r : es) ~> Eff es
runReader r
x = Handler (Reader r) es -> Eff (Reader r : es) ~> Eff es
forall (e :: (Type -> Type) -> Type -> Type)
       (es :: [(Type -> Type) -> Type -> Type]).
Handler e es -> Eff (e : es) ~> Eff es
interpret (r -> Handler (Reader r) es
forall r (es :: [(Type -> Type) -> Type -> Type]).
r -> Handler (Reader r) es
h r
x)
  where
    h :: r -> Handler (Reader r) es
    h :: r -> Handler (Reader r) es
h r
r = \case
      Reader r (Eff esSend) a
Ask       -> r -> Eff es r
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure r
r
      Local r -> r
f Eff esSend a
m -> Handler (Reader r) es -> Eff esSend a -> Eff es a
forall (esSend :: [(Type -> Type) -> Type -> Type])
       (e :: (Type -> Type) -> Type -> Type)
       (es :: [(Type -> Type) -> Type -> Type]).
Handling esSend e es =>
Handler e es -> Eff esSend ~> Eff es
toEffWith (r -> Handler (Reader r) es
forall r (es :: [(Type -> Type) -> Type -> Type]).
r -> Handler (Reader r) es
h (r -> r
f r
r)) Eff esSend a
m
{-# INLINE runReader #-}

-- | Run a 'Reader' effect in terms of a larger 'Reader' via a 'Lens''.
magnify :: Reader t :> es => Lens' t r -> Eff (Reader r ': es) ~> Eff es
magnify :: Lens' t r -> Eff (Reader r : es) ~> Eff es
magnify Lens' t r
field = Handler (Reader r) es -> Eff (Reader r : es) ~> Eff es
forall (e :: (Type -> Type) -> Type -> Type)
       (es :: [(Type -> Type) -> Type -> Type]).
Handler e es -> Eff (e : es) ~> Eff es
interpret \case
  Reader r (Eff esSend) a
Ask       -> (t -> r) -> Eff es r
forall r (es :: [(Type -> Type) -> Type -> Type]) s.
(Reader r :> es) =>
(r -> s) -> Eff es s
asks (t -> Getting r t r -> r
forall s a. s -> Getting a s a -> a
^. Getting r t r
Lens' t r
field)
  Local f m -> (t -> t) -> Eff es a -> Eff es a
forall r (es :: [(Type -> Type) -> Type -> Type]) a.
(Reader r :> es) =>
(r -> r) -> Eff es a -> Eff es a
local (t -> (t -> t) -> t
forall a b. a -> (a -> b) -> b
& (r -> Identity r) -> t -> Identity t
Lens' t r
field ((r -> Identity r) -> t -> Identity t) -> (r -> r) -> t -> t
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ r -> r
f) (Eff es a -> Eff es a) -> Eff es a -> Eff es a
forall a b. (a -> b) -> a -> b
$ Eff esSend a -> Eff es a
forall (esSend :: [(Type -> Type) -> Type -> Type])
       (e :: (Type -> Type) -> Type -> Type)
       (es :: [(Type -> Type) -> Type -> Type]).
Handling esSend e es =>
Eff esSend ~> Eff es
toEff Eff esSend a
m
{-# INLINE magnify #-}