{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE QuantifiedConstraints #-}
{-# LANGUAGE UndecidableInstances #-}

-- SPDX-License-Identifier: MPL-2.0

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

Effects that can be used to hold environmental values in the context.
Environmental values are immutable and do not change across procedures, but you
can modify the value within a local scope using the `local` operation.
-}
module Data.Effect.Reader (
    module Data.Effect.Reader,
    Ask (..),
    Local (..),
)
where

import Control.Effect (sendFor)
import Control.Effect.Interpret (interposeFor)
import Data.Effect (Ask (Ask), Local (Local))
import Data.Effect.OpenUnion (IdentityResolver, Membership, membership)

makeEffectF_' (def & noGenerateLabel & noGenerateOrderInstance) ''Ask
makeEffectH_' (def & noGenerateLabel & noGenerateOrderInstance) ''Local

-- | Obtains a value from the environment and returns it transformed by the given function.
asks
    :: forall r es ff a c
     . (Ask r :> es, Functor (Eff ff es), Free c ff)
    => (r -> a)
    -> Eff ff es a
asks :: forall r (es :: [Effect]) (ff :: Effect) a
       (c :: (* -> *) -> Constraint).
(Ask r :> es, Functor (Eff ff es), Free c ff) =>
(r -> a) -> Eff ff es a
asks r -> a
f = r -> a
f (r -> a) -> Eff ff es r -> Eff ff es a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Eff ff es r
forall r (a :: * -> *) (es :: [Effect]) (ff :: Effect)
       (c :: (* -> *) -> Constraint).
(Free c ff, a ~ Eff ff es, Ask r :> es) =>
a r
ask
{-# INLINE asks #-}

-- | Interpret the t'Ask'/t'Local' effects.
runReader
    :: forall r es ff a c
     . (forall es'. Applicative (Eff ff es'), Free c ff)
    => r
    -> Eff ff (Local r ': Ask r ': es) a
    -> Eff ff es a
runReader :: forall r (es :: [Effect]) (ff :: Effect) a
       (c :: (* -> *) -> Constraint).
(forall (es' :: [Effect]). Applicative (Eff ff es'), Free c ff) =>
r -> Eff ff (Local r : Ask r : es) a -> Eff ff es a
runReader r
r = r -> Eff ff (Ask r : es) a -> Eff ff es a
forall r (es :: [Effect]) (ff :: Effect) a
       (c :: (* -> *) -> Constraint).
(Applicative (Eff ff es), Free c ff) =>
r -> Eff ff (Ask r : es) a -> Eff ff es a
runAsk r
r (Eff ff (Ask r : es) a -> Eff ff es a)
-> (Eff ff (Local r : Ask r : es) a -> Eff ff (Ask r : es) a)
-> Eff ff (Local r : Ask r : es) a
-> Eff ff es a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Eff ff (Local r : Ask r : es) a -> Eff ff (Ask r : es) a
forall r (es :: [Effect]) (ff :: Effect) a
       (c :: (* -> *) -> Constraint).
(Applicative (Eff ff es), In (Ask r) es, Free c ff) =>
Eff ff (Local r : es) a -> Eff ff es a
runLocal
{-# INLINE runReader #-}

-- | Interpret the t'Ask' effect.
runAsk
    :: forall r es ff a c
     . (Applicative (Eff ff es), Free c ff)
    => r
    -> Eff ff (Ask r ': es) a
    -> Eff ff es a
runAsk :: forall r (es :: [Effect]) (ff :: Effect) a
       (c :: (* -> *) -> Constraint).
(Applicative (Eff ff es), Free c ff) =>
r -> Eff ff (Ask r : es) a -> Eff ff es a
runAsk r
r = (Ask r ~~> Eff ff es) -> Eff ff (Ask r : es) a -> Eff ff es a
forall (e :: Effect) (es :: [Effect]) (ff :: Effect) a
       (c :: (* -> *) -> Constraint).
(KnownOrder e, Free c ff) =>
(e ~~> Eff ff es) -> Eff ff (e : es) a -> Eff ff es a
interpret \Ask r (Eff ff es) x
Ask -> x -> Eff ff es x
forall a. a -> Eff ff es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure r
x
r
{-# INLINE runAsk #-}

-- | Interpret the t'Local' effect.
runLocal
    :: forall r es ff a c
     . (Applicative (Eff ff es), Ask r `In` es, Free c ff)
    => Eff ff (Local r ': es) a
    -> Eff ff es a
runLocal :: forall r (es :: [Effect]) (ff :: Effect) a
       (c :: (* -> *) -> Constraint).
(Applicative (Eff ff es), In (Ask r) es, Free c ff) =>
Eff ff (Local r : es) a -> Eff ff es a
runLocal = (Local r ~~> Eff ff es) -> Eff ff (Local r : es) a -> Eff ff es a
forall (e :: Effect) (es :: [Effect]) (ff :: Effect) a
       (c :: (* -> *) -> Constraint).
(KnownOrder e, Free c ff) =>
(e ~~> Eff ff es) -> Eff ff (e : es) a -> Eff ff es a
interpret Local r (Eff ff es) x -> Eff ff es x
Local r ~~> Eff ff es
forall r (es :: [Effect]) (ff :: Effect)
       (c :: (* -> *) -> Constraint).
(Applicative (Eff ff es), In (Ask r) es, Free c ff) =>
Local r ~~> Eff ff es
handleLocal
{-# INLINE runLocal #-}

-- | A handler for the t'Local' effect.
handleLocal
    :: forall r es ff c
     . (Applicative (Eff ff es), Ask r `In` es, Free c ff)
    => Local r ~~> Eff ff es
handleLocal :: forall r (es :: [Effect]) (ff :: Effect)
       (c :: (* -> *) -> Constraint).
(Applicative (Eff ff es), In (Ask r) es, Free c ff) =>
Local r ~~> Eff ff es
handleLocal = Membership (Ask r) es -> Local r ~~> Eff ff es
forall r (es :: [Effect]) (ff :: Effect)
       (c :: (* -> *) -> Constraint).
(Applicative (Eff ff es), Free c ff) =>
Membership (Ask r) es -> Local r ~~> Eff ff es
handleLocalFor (Membership (Ask r) es -> Local r ~~> Eff ff es)
-> Membership (Ask r) es -> Local r ~~> Eff ff es
forall a b. (a -> b) -> a -> b
$ forall resolver dscr (e :: Effect) (es :: [Effect]).
FindBy resolver dscr (Discriminator resolver (HeadOf es)) e es =>
Membership e es
membership @IdentityResolver
{-# INLINE handleLocal #-}

-- | A handler for the t'Local' effect.
handleLocalFor
    :: forall r es ff c
     . (Applicative (Eff ff es), Free c ff)
    => Membership (Ask r) es
    -> Local r ~~> Eff ff es
handleLocalFor :: forall r (es :: [Effect]) (ff :: Effect)
       (c :: (* -> *) -> Constraint).
(Applicative (Eff ff es), Free c ff) =>
Membership (Ask r) es -> Local r ~~> Eff ff es
handleLocalFor Membership (Ask r) es
pr (Local r -> r
f Eff ff es x
a) = Eff ff es x
a Eff ff es x -> (Eff ff es x -> Eff ff es x) -> Eff ff es x
forall a b. a -> (a -> b) -> b
& Membership (Ask r) es
-> (Ask r ~~> Eff ff es) -> Eff ff es x -> Eff ff es x
forall (e :: Effect) (es :: [Effect]) (ff :: Effect) a
       (c :: (* -> *) -> Constraint).
(KnownOrder e, Free c ff) =>
Membership e es -> (e ~~> Eff ff es) -> Eff ff es a -> Eff ff es a
interposeFor Membership (Ask r) es
pr \Ask r (Eff ff es) x
Ask -> r -> r
r -> x
f (r -> x) -> Eff ff es r -> Eff ff es x
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Membership (Ask r) es -> Ask r (Eff ff es) r -> Eff ff es r
forall (e :: Effect) (es :: [Effect]) (ff :: Effect) a
       (c :: (* -> *) -> Constraint).
(KnownOrder e, Free c ff) =>
Membership e es -> e (Eff ff es) a -> Eff ff es a
sendFor Membership (Ask r) es
pr Ask r (Eff ff es) r
forall r (a :: * -> *). Ask r a r
Ask
{-# INLINE handleLocalFor #-}