-- This Source Code Form is subject to the terms of the Mozilla Public
-- License, v. 2.0. If a copy of the MPL was not distributed with this
-- file, You can obtain one at https://mozilla.org/MPL/2.0/.

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

Interpreters for the t'Ask' / t'Local' effects.
-}
module Control.Monad.Hefty.Reader where

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

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

-- | Elaborate 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

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