-- SPDX-License-Identifier: MPL-2.0

{- |
Copyright   :  (c) 2023 Sayo Koyoneda
License     :  MPL-2.0 (see the LICENSE file)
Maintainer  :  ymdfield@outlook.jp

Interpreters for the [Reader]("Data.Effect.Reader") effects.
-}
module Control.Monad.Hefty.Reader (
    module Control.Monad.Hefty.Reader,
    module Data.Effect.Reader,
)
where

import Control.Monad.Hefty (
    Eff,
    interpose,
    interpret,
    interpretH,
    (&),
    type (<|),
    type (~>),
    type (~~>),
 )
import Data.Effect.Reader

-- | Interpret the t'Ask'/t'Local' effects.
runReader
    :: forall r eh ef
     . r
    -> Eff (Local r ': eh) (Ask r ': ef) ~> Eff eh ef
runReader :: forall r (eh :: [(* -> *) -> * -> *]) (ef :: [* -> *]).
r -> Eff (Local r : eh) (Ask r : ef) ~> Eff eh ef
runReader r
r = r -> Eff eh (Ask r : ef) ~> Eff eh ef
forall r (ef :: [* -> *]) (eh :: [(* -> *) -> * -> *]).
r -> Eff eh (Ask r : ef) ~> Eff eh ef
runAsk r
r (Eff eh (Ask r : ef) x -> Eff eh ef x)
-> (Eff (Local r : eh) (Ask r : ef) x -> Eff eh (Ask r : ef) x)
-> Eff (Local r : eh) (Ask r : ef) x
-> Eff eh ef x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Eff (Local r : eh) (Ask r : ef) x -> Eff eh (Ask r : ef) x
Eff (Local r : eh) (Ask r : ef) ~> Eff eh (Ask r : ef)
forall r (eh :: [(* -> *) -> * -> *]) (ef :: [* -> *]).
(Ask r <| ef) =>
Eff (Local r : eh) ef ~> Eff eh ef
runLocal

-- | Interpret the t'Local' effect.
runLocal
    :: forall r eh ef
     . (Ask r <| ef)
    => Eff (Local r ': eh) ef ~> Eff eh ef
runLocal :: forall r (eh :: [(* -> *) -> * -> *]) (ef :: [* -> *]).
(Ask r <| ef) =>
Eff (Local r : eh) ef ~> Eff eh ef
runLocal = (Local r ~~> Eff eh ef) -> Eff (Local r : eh) ef ~> Eff eh ef
forall (e :: (* -> *) -> * -> *) (eh :: [(* -> *) -> * -> *])
       (ef :: [* -> *]).
HFunctor e =>
(e ~~> Eff eh ef) -> Eff (e : eh) ef ~> Eff eh ef
interpretH Local r (Eff eh ef) x -> Eff eh ef x
Local r ~~> Eff eh ef
forall r (eh :: [(* -> *) -> * -> *]) (ef :: [* -> *]).
(Ask r <| ef) =>
Local r ~~> Eff eh ef
elabLocal

-- | A elaborator function for the t'Local' effect.
elabLocal
    :: forall r eh ef
     . (Ask r <| ef)
    => Local r ~~> Eff eh ef
elabLocal :: forall r (eh :: [(* -> *) -> * -> *]) (ef :: [* -> *]).
(Ask r <| ef) =>
Local r ~~> Eff eh ef
elabLocal (Local r -> r
f Eff eh ef x
a) = Eff eh ef x
a Eff eh ef x -> (Eff eh ef x -> Eff eh ef x) -> Eff eh ef x
forall a b. a -> (a -> b) -> b
& forall (e :: * -> *) (ef :: [* -> *]) (eh :: [(* -> *) -> * -> *]).
(e <| ef) =>
(e ~> Eff eh ef) -> Eff eh ef ~> Eff eh ef
interpose @(Ask r) \Ask r x
Ask -> r -> r
r -> x
f (r -> x) -> Eff eh ef r -> Eff eh ef x
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Eff eh ef r
forall r (f :: * -> *). SendFOE (Ask r) f => f r
ask

-- | Interpret the t'Ask' effect.
runAsk
    :: forall r ef eh
     . r
    -> Eff eh (Ask r ': ef) ~> Eff eh ef
runAsk :: forall r (ef :: [* -> *]) (eh :: [(* -> *) -> * -> *]).
r -> Eff eh (Ask r : ef) ~> Eff eh ef
runAsk r
r = (Ask r ~> Eff eh ef) -> Eff eh (Ask r : ef) ~> Eff eh ef
forall (e :: * -> *) (ef :: [* -> *]) (eh :: [(* -> *) -> * -> *]).
(e ~> Eff eh ef) -> Eff eh (e : ef) ~> Eff eh ef
interpret \Ask r x
Ask -> x -> Eff eh ef x
forall a. a -> Eff eh ef a
forall (f :: * -> *) a. Applicative f => a -> f a
pure r
x
r