{-# LANGUAGE AllowAmbiguousTypes #-}

-- SPDX-License-Identifier: MPL-2.0 AND BSD-3-Clause

{- |
Copyright   :  (c) 2016 Allele Dev; 2017 Ixperta Solutions s.r.o.; 2017 Alexis King; 2024 Sayo contributors
License     :  MPL-2.0 AND BSD-3-Clause (see the LICENSE and LICENSE.BSD3 files)
Maintainer  :  ymdfield@outlook.jp

This module provides functions for interpretation.
Please refer to the documentation of the [top-level module]("Control.Monad.Hefty").
-}
module Control.Monad.Hefty.Interpret (
    module Control.Monad.Hefty.Interpret,
    module Control.Effect.Interpret,
)
where

import Control.Effect (unEff, type (~>))
import Control.Effect qualified as D
import Control.Effect.Interpret hiding (runEff, runPure)
import Control.Effect.Interpret qualified as D
import Control.Monad.Hefty.Types (
    AlgHandler,
    Eff,
    Freer (Op, Val),
    qApp,
 )
import Data.Effect (Emb)
import Data.Effect.OpenUnion (
    FOEs,
    Has,
    In,
    KnownLength,
    KnownOrder,
    Membership,
    Suffix,
    Union,
    coerceFOEs,
    identityMembership,
    keyMembership,
    labelMembership,
    nil,
    project,
    weakens,
    (!++),
    (!:),
    (:>),
    type (++),
 )
import Data.Effect.Tag (unTag)
import Data.FTCQueue (tsingleton)
import Data.Function ((&))

-- * Running t`Eff`

-- | Lowers the computation into a monad @m@ by treating the effect as a monad.
runEff :: (Monad m) => Eff '[Emb m] ~> m
runEff :: forall (m :: * -> *). Monad m => Eff '[Emb m] ~> m
runEff = Eff Freer '[Emb m] x -> m x
forall (c :: (* -> *) -> Constraint) (ff :: (* -> *) -> * -> *)
       (f :: * -> *) a.
(Free c ff, c f) =>
Eff ff '[Emb f] a -> f a
D.runEff
{-# INLINE runEff #-}

-- | Extracts the value from a computation that contains only pure values without any effect.
runPure :: Eff '[] a -> a
runPure :: forall a. Eff '[] a -> a
runPure (D.Eff Freer (Union '[] (Eff Freer '[])) a
m) =
    case Freer (Union '[] (Eff Freer '[])) a
m of
        Val a
x -> a
x
        Op Union '[] (Eff Freer '[]) x
r FTCQueue (Freer (Union '[] (Eff Freer '[]))) x a
_ -> Union '[] (Eff Freer '[]) x -> a
forall (f :: * -> *) a r. Union '[] f a -> r
nil Union '[] (Eff Freer '[]) x
r
{-# INLINE runPure #-}

-- * Standard continuational interpretation functions

-- | Interprets the effect @e@ at the head of the list using the provided algebraic handler.
interpretWith
    :: forall e es a
     . (KnownOrder e, FOEs es)
    => AlgHandler e (Eff (e ': es)) (Eff es) a
    -> Eff (e ': es) a
    -> Eff es a
interpretWith :: forall (e :: (* -> *) -> * -> *) (es :: [(* -> *) -> * -> *]) a.
(KnownOrder e, FOEs es) =>
AlgHandler e (Eff (e : es)) (Eff es) a
-> Eff (e : es) a -> Eff es a
interpretWith = AlgHandler e (Eff (e : es)) (Eff es) a
-> Eff (e : es) a -> Eff es a
forall (e :: (* -> *) -> * -> *) (es' :: [(* -> *) -> * -> *])
       (es :: [(* -> *) -> * -> *]) a.
(Suffix es es', KnownOrder e, FOEs es) =>
AlgHandler e (Eff (e : es)) (Eff es') a
-> Eff (e : es) a -> Eff es' a
reinterpretWith
{-# INLINE interpretWith #-}

-- | Interprets the effect @e@ at the head of the list using the provided value handler and algebraic handler.
interpretBy
    :: forall e es ans a
     . (KnownOrder e, FOEs es)
    => (a -> Eff es ans)
    -> AlgHandler e (Eff (e ': es)) (Eff es) ans
    -> Eff (e ': es) a
    -> Eff es ans
interpretBy :: forall (e :: (* -> *) -> * -> *) (es :: [(* -> *) -> * -> *]) ans
       a.
(KnownOrder e, FOEs es) =>
(a -> Eff es ans)
-> AlgHandler e (Eff (e : es)) (Eff es) ans
-> Eff (e : es) a
-> Eff es ans
interpretBy = (a -> Eff es ans)
-> AlgHandler e (Eff (e : es)) (Eff es) ans
-> Eff (e : es) a
-> Eff es ans
forall (e :: (* -> *) -> * -> *) (es :: [(* -> *) -> * -> *])
       (es' :: [(* -> *) -> * -> *]) ans a.
(KnownOrder e, FOEs es, Suffix es es') =>
(a -> Eff es' ans)
-> AlgHandler e (Eff (e : es)) (Eff es') ans
-> Eff (e : es) a
-> Eff es' ans
reinterpretBy
{-# INLINE interpretBy #-}

interpretsBy
    :: forall es r ans a
     . (FOEs r, KnownLength es)
    => (a -> Eff r ans)
    -> AlgHandler (Union es) (Eff (es ++ r)) (Eff r) ans
    -> Eff (es ++ r) a
    -> Eff r ans
interpretsBy :: forall (es :: [(* -> *) -> * -> *]) (r :: [(* -> *) -> * -> *]) ans
       a.
(FOEs r, KnownLength es) =>
(a -> Eff r ans)
-> AlgHandler (Union es) (Eff (es ++ r)) (Eff r) ans
-> Eff (es ++ r) a
-> Eff r ans
interpretsBy = forall (es :: [(* -> *) -> * -> *]) (r :: [(* -> *) -> * -> *])
       (r' :: [(* -> *) -> * -> *]) ans a.
(FOEs r, Suffix r r', KnownLength es) =>
(a -> Eff r' ans)
-> AlgHandler (Union es) (Eff (es ++ r)) (Eff r') ans
-> Eff (es ++ r) a
-> Eff r' ans
reinterpretsBy @_ @r
{-# INLINE interpretsBy #-}

reinterpretWith
    :: forall e es' es a
     . (Suffix es es', KnownOrder e, FOEs es)
    => AlgHandler e (Eff (e ': es)) (Eff es') a
    -> Eff (e ': es) a
    -> Eff es' a
reinterpretWith :: forall (e :: (* -> *) -> * -> *) (es' :: [(* -> *) -> * -> *])
       (es :: [(* -> *) -> * -> *]) a.
(Suffix es es', KnownOrder e, FOEs es) =>
AlgHandler e (Eff (e : es)) (Eff es') a
-> Eff (e : es) a -> Eff es' a
reinterpretWith = (a -> Eff Freer es' a)
-> AlgHandler e (Eff (e : es)) (Eff Freer es') a
-> Eff Freer (e : es) a
-> Eff Freer es' a
forall (e :: (* -> *) -> * -> *) (es :: [(* -> *) -> * -> *])
       (es' :: [(* -> *) -> * -> *]) ans a.
(KnownOrder e, FOEs es, Suffix es es') =>
(a -> Eff es' ans)
-> AlgHandler e (Eff (e : es)) (Eff es') ans
-> Eff (e : es) a
-> Eff es' ans
reinterpretBy a -> Eff Freer es' a
forall a. a -> Eff Freer es' a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
{-# INLINE reinterpretWith #-}

reinterpretBy
    :: forall e es es' ans a
     . (KnownOrder e, FOEs es, Suffix es es')
    => (a -> Eff es' ans)
    -> AlgHandler e (Eff (e ': es)) (Eff es') ans
    -> Eff (e ': es) a
    -> Eff es' ans
reinterpretBy :: forall (e :: (* -> *) -> * -> *) (es :: [(* -> *) -> * -> *])
       (es' :: [(* -> *) -> * -> *]) ans a.
(KnownOrder e, FOEs es, Suffix es es') =>
(a -> Eff es' ans)
-> AlgHandler e (Eff (e : es)) (Eff es') ans
-> Eff (e : es) a
-> Eff es' ans
reinterpretBy a -> Eff es' ans
ret AlgHandler e (Eff (e : es)) (Eff es') ans
hdl = Eff Freer (e : es) a -> Eff es' ans
loop
  where
    loop :: Eff Freer (e : es) a -> Eff es' ans
loop (D.Eff Freer (Union (e : es) (Eff (e : es))) a
m) = case Freer (Union (e : es) (Eff (e : es))) a
m of
        Val a
x -> a -> Eff es' ans
ret a
x
        Op Union (e : es) (Eff (e : es)) x
u FTCQueue (Freer (Union (e : es) (Eff (e : es)))) x a
q ->
            let k :: x -> Eff es' ans
k = Eff Freer (e : es) a -> Eff es' ans
loop (Eff Freer (e : es) a -> Eff es' ans)
-> (x -> Eff Freer (e : es) a) -> x -> Eff es' ans
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Freer (Union (e : es) (Eff (e : es))) a -> Eff Freer (e : es) a
forall (ff :: (* -> *) -> * -> *) (es :: [(* -> *) -> * -> *]) a.
ff (Union es (Eff ff es)) a -> Eff ff es a
D.Eff (Freer (Union (e : es) (Eff (e : es))) a -> Eff Freer (e : es) a)
-> (x -> Freer (Union (e : es) (Eff (e : es))) a)
-> x
-> Eff Freer (e : es) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FTCQueue (Freer (Union (e : es) (Eff (e : es)))) x a
-> x -> Freer (Union (e : es) (Eff (e : es))) a
forall (f :: * -> *) a b. FTCQueue (Freer f) a b -> a -> Freer f b
qApp FTCQueue (Freer (Union (e : es) (Eff (e : es)))) x a
q
             in Union (e : es) (Eff (e : es)) x
u Union (e : es) (Eff (e : es)) x
-> (Union (e : es) (Eff (e : es)) x -> Eff es' ans) -> Eff es' ans
forall a b. a -> (a -> b) -> b
& (e (Eff (e : es)) x -> (x -> Eff es' ans) -> Eff es' ans
AlgHandler e (Eff (e : es)) (Eff es') ans
`hdl` x -> Eff es' ans
k) (e (Eff (e : es)) x -> Eff es' ans)
-> (Union es (Eff (e : es)) x -> Eff es' ans)
-> Union (e : es) (Eff (e : es)) x
-> Eff es' ans
forall (f :: * -> *) a r (es :: [(* -> *) -> * -> *]).
(e f a -> r) -> (Union es f a -> r) -> Union (e : es) f a -> r
forall (e :: (* -> *) -> * -> *) (order :: EffectOrder)
       (f :: * -> *) a r (es :: [(* -> *) -> * -> *]).
Elem e order =>
(e f a -> r) -> (Union es f a -> r) -> Union (e : es) f a -> r
!: Freer (Union es' (Eff es')) ans -> Eff es' ans
forall (ff :: (* -> *) -> * -> *) (es :: [(* -> *) -> * -> *]) a.
ff (Union es (Eff ff es)) a -> Eff ff es a
D.Eff (Freer (Union es' (Eff es')) ans -> Eff es' ans)
-> (Union es (Eff (e : es)) x -> Freer (Union es' (Eff es')) ans)
-> Union es (Eff (e : es)) x
-> Eff es' ans
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Union es' (Eff es') x
-> FTCQueue (Freer (Union es' (Eff es'))) x ans
-> Freer (Union es' (Eff es')) ans
forall (f :: * -> *) a x.
f x -> FTCQueue (Freer f) x a -> Freer f a
`Op` (x -> Freer (Union es' (Eff es')) ans)
-> FTCQueue (Freer (Union es' (Eff es'))) x ans
forall a (m :: * -> *) b. (a -> m b) -> FTCQueue m a b
tsingleton (Eff es' ans -> Freer (Union es' (Eff es')) ans
forall (ff :: (* -> *) -> * -> *) (es :: [(* -> *) -> * -> *]) a.
Eff ff es a -> ff (Union es (Eff ff es)) a
unEff (Eff es' ans -> Freer (Union es' (Eff es')) ans)
-> (x -> Eff es' ans) -> x -> Freer (Union es' (Eff es')) ans
forall b c a. (b -> c) -> (a -> b) -> a -> c
. x -> Eff es' ans
k)) (Union es' (Eff es') x -> Freer (Union es' (Eff es')) ans)
-> (Union es (Eff (e : es)) x -> Union es' (Eff es') x)
-> Union es (Eff (e : es)) x
-> Freer (Union es' (Eff es')) ans
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Union es (Eff es') x -> Union es' (Eff es') x
forall (es :: [(* -> *) -> * -> *]) (es' :: [(* -> *) -> * -> *])
       (f :: * -> *) a.
Suffix es es' =>
Union es f a -> Union es' f a
weakens (Union es (Eff es') x -> Union es' (Eff es') x)
-> (Union es (Eff (e : es)) x -> Union es (Eff es') x)
-> Union es (Eff (e : es)) x
-> Union es' (Eff es') x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Union es (Eff (e : es)) x -> Union es (Eff es') x
forall (es :: [(* -> *) -> * -> *]) (f :: * -> *) a (g :: * -> *).
FOEs es =>
Union es f a -> Union es g a
coerceFOEs
{-# INLINE reinterpretBy #-}

reinterpretsBy
    :: forall es r r' ans a
     . (FOEs r, Suffix r r', KnownLength es)
    => (a -> Eff r' ans)
    -> AlgHandler (Union es) (Eff (es ++ r)) (Eff r') ans
    -> Eff (es ++ r) a
    -> Eff r' ans
reinterpretsBy :: forall (es :: [(* -> *) -> * -> *]) (r :: [(* -> *) -> * -> *])
       (r' :: [(* -> *) -> * -> *]) ans a.
(FOEs r, Suffix r r', KnownLength es) =>
(a -> Eff r' ans)
-> AlgHandler (Union es) (Eff (es ++ r)) (Eff r') ans
-> Eff (es ++ r) a
-> Eff r' ans
reinterpretsBy a -> Eff r' ans
ret AlgHandler (Union es) (Eff (es ++ r)) (Eff r') ans
hdl = Eff (es ++ r) a -> Eff r' ans
loop
  where
    loop :: Eff (es ++ r) a -> Eff r' ans
    loop :: Eff (es ++ r) a -> Eff r' ans
loop (D.Eff Freer (Union (es ++ r) (Eff (es ++ r))) a
m) = case Freer (Union (es ++ r) (Eff (es ++ r))) a
m of
        Val a
x -> a -> Eff r' ans
ret a
x
        Op Union (es ++ r) (Eff (es ++ r)) x
u FTCQueue (Freer (Union (es ++ r) (Eff (es ++ r)))) x a
q ->
            let k :: x -> Eff r' ans
k = Eff (es ++ r) a -> Eff r' ans
loop (Eff (es ++ r) a -> Eff r' ans)
-> (x -> Eff (es ++ r) a) -> x -> Eff r' ans
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Freer (Union (es ++ r) (Eff (es ++ r))) a -> Eff (es ++ r) a
forall (ff :: (* -> *) -> * -> *) (es :: [(* -> *) -> * -> *]) a.
ff (Union es (Eff ff es)) a -> Eff ff es a
D.Eff (Freer (Union (es ++ r) (Eff (es ++ r))) a -> Eff (es ++ r) a)
-> (x -> Freer (Union (es ++ r) (Eff (es ++ r))) a)
-> x
-> Eff (es ++ r) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FTCQueue (Freer (Union (es ++ r) (Eff (es ++ r)))) x a
-> x -> Freer (Union (es ++ r) (Eff (es ++ r))) a
forall (f :: * -> *) a b. FTCQueue (Freer f) a b -> a -> Freer f b
qApp FTCQueue (Freer (Union (es ++ r) (Eff (es ++ r)))) x a
q
             in Union (es ++ r) (Eff (es ++ r)) x
u Union (es ++ r) (Eff (es ++ r)) x
-> (Union (es ++ r) (Eff (es ++ r)) x -> Eff r' ans) -> Eff r' ans
forall a b. a -> (a -> b) -> b
& (Union es (Eff (es ++ r)) x -> (x -> Eff r' ans) -> Eff r' ans
AlgHandler (Union es) (Eff (es ++ r)) (Eff r') ans
`hdl` x -> Eff r' ans
k) (Union es (Eff (es ++ r)) x -> Eff r' ans)
-> (Union r (Eff (es ++ r)) x -> Eff r' ans)
-> Union (es ++ r) (Eff (es ++ r)) x
-> Eff r' ans
forall (es :: [(* -> *) -> * -> *]) (es' :: [(* -> *) -> * -> *])
       (f :: * -> *) a r.
KnownLength es =>
(Union es f a -> r)
-> (Union es' f a -> r) -> Union (es ++ es') f a -> r
!++ Freer (Union r' (Eff r')) ans -> Eff r' ans
forall (ff :: (* -> *) -> * -> *) (es :: [(* -> *) -> * -> *]) a.
ff (Union es (Eff ff es)) a -> Eff ff es a
D.Eff (Freer (Union r' (Eff r')) ans -> Eff r' ans)
-> (Union r (Eff (es ++ r)) x -> Freer (Union r' (Eff r')) ans)
-> Union r (Eff (es ++ r)) x
-> Eff r' ans
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Union r' (Eff r') x
-> FTCQueue (Freer (Union r' (Eff r'))) x ans
-> Freer (Union r' (Eff r')) ans
forall (f :: * -> *) a x.
f x -> FTCQueue (Freer f) x a -> Freer f a
`Op` (x -> Freer (Union r' (Eff r')) ans)
-> FTCQueue (Freer (Union r' (Eff r'))) x ans
forall a (m :: * -> *) b. (a -> m b) -> FTCQueue m a b
tsingleton (Eff r' ans -> Freer (Union r' (Eff r')) ans
forall (ff :: (* -> *) -> * -> *) (es :: [(* -> *) -> * -> *]) a.
Eff ff es a -> ff (Union es (Eff ff es)) a
unEff (Eff r' ans -> Freer (Union r' (Eff r')) ans)
-> (x -> Eff r' ans) -> x -> Freer (Union r' (Eff r')) ans
forall b c a. (b -> c) -> (a -> b) -> a -> c
. x -> Eff r' ans
k)) (Union r' (Eff r') x -> Freer (Union r' (Eff r')) ans)
-> (Union r (Eff (es ++ r)) x -> Union r' (Eff r') x)
-> Union r (Eff (es ++ r)) x
-> Freer (Union r' (Eff r')) ans
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (es :: [(* -> *) -> * -> *]) (es' :: [(* -> *) -> * -> *])
       (f :: * -> *) a.
Suffix es es' =>
Union es f a -> Union es' f a
weakens @r (Union r (Eff r') x -> Union r' (Eff r') x)
-> (Union r (Eff (es ++ r)) x -> Union r (Eff r') x)
-> Union r (Eff (es ++ r)) x
-> Union r' (Eff r') x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Union r (Eff (es ++ r)) x -> Union r (Eff r') x
forall (es :: [(* -> *) -> * -> *]) (f :: * -> *) a (g :: * -> *).
FOEs es =>
Union es f a -> Union es g a
coerceFOEs
{-# INLINE reinterpretsBy #-}

-- * Interposition functions

-- | Reinterprets (hooks) the effect @e@ in the list using the provided value handler and algebraic handler.
interposeBy
    :: forall e es ans a
     . (e :> es, FOEs es)
    => (a -> Eff es ans)
    -- ^ Value handler
    -> AlgHandler e (Eff es) (Eff es) ans
    -- ^ Effect handler
    -> Eff es a
    -> Eff es ans
interposeBy :: forall (e :: (* -> *) -> * -> *) (es :: [(* -> *) -> * -> *]) ans
       a.
(e :> es, FOEs es) =>
(a -> Eff es ans)
-> AlgHandler e (Eff es) (Eff es) ans -> Eff es a -> Eff es ans
interposeBy = Membership e es
-> (a -> Eff Freer es ans)
-> (forall {x}.
    e (Eff Freer es) x -> (x -> Eff Freer es ans) -> Eff Freer es ans)
-> Eff Freer es a
-> Eff Freer es ans
forall (e :: (* -> *) -> * -> *) (es :: [(* -> *) -> * -> *]) ans
       a.
(KnownOrder e, FOEs es) =>
Membership e es
-> (a -> Eff es ans)
-> AlgHandler e (Eff es) (Eff es) ans
-> Eff es a
-> Eff es ans
interposeForBy Membership e es
forall (e :: (* -> *) -> * -> *) (es :: [(* -> *) -> * -> *]).
FindBy LabelResolver (LabelOf e) (LabelOf (HeadOf es)) e es =>
Membership e es
labelMembership
{-# INLINE interposeBy #-}

-- | Reinterprets (hooks) the effect @e@ in the list using the provided algebraic handler.
interposeWith
    :: forall e es a
     . (e :> es, FOEs es)
    => AlgHandler e (Eff es) (Eff es) a
    -- ^ Effect handler
    -> Eff es a
    -> Eff es a
interposeWith :: forall (e :: (* -> *) -> * -> *) (es :: [(* -> *) -> * -> *]) a.
(e :> es, FOEs es) =>
AlgHandler e (Eff es) (Eff es) a -> Eff es a -> Eff es a
interposeWith = Membership e es
-> (forall {x}.
    e (Eff Freer es) x -> (x -> Eff Freer es a) -> Eff Freer es a)
-> Eff Freer es a
-> Eff Freer es a
forall (e :: (* -> *) -> * -> *) (es :: [(* -> *) -> * -> *]) a.
(KnownOrder e, FOEs es) =>
Membership e es
-> AlgHandler e (Eff es) (Eff es) a -> Eff es a -> Eff es a
interposeForWith Membership e es
forall (e :: (* -> *) -> * -> *) (es :: [(* -> *) -> * -> *]).
FindBy LabelResolver (LabelOf e) (LabelOf (HeadOf es)) e es =>
Membership e es
labelMembership
{-# INLINE interposeWith #-}

-- | Reinterprets (hooks) the effect @e@ in the list using the provided value handler and algebraic handler.
interposeOnBy
    :: forall key e es ans a
     . (Has key e es, FOEs es)
    => (a -> Eff es ans)
    -- ^ Value handler
    -> AlgHandler e (Eff es) (Eff es) ans
    -- ^ Effect handler
    -> Eff es a
    -> Eff es ans
interposeOnBy :: forall {k} (key :: k) (e :: (* -> *) -> * -> *)
       (es :: [(* -> *) -> * -> *]) ans a.
(Has key e es, FOEs es) =>
(a -> Eff es ans)
-> AlgHandler e (Eff es) (Eff es) ans -> Eff es a -> Eff es ans
interposeOnBy a -> Eff es ans
ret AlgHandler e (Eff es) (Eff es) ans
hdl = Membership (e # key) es
-> (a -> Eff es ans)
-> AlgHandler (e # key) (Eff es) (Eff es) ans
-> Eff es a
-> Eff es ans
forall (e :: (* -> *) -> * -> *) (es :: [(* -> *) -> * -> *]) ans
       a.
(KnownOrder e, FOEs es) =>
Membership e es
-> (a -> Eff es ans)
-> AlgHandler e (Eff es) (Eff es) ans
-> Eff es a
-> Eff es ans
interposeForBy (forall (key :: k) (e :: (* -> *) -> * -> *)
       (es :: [(* -> *) -> * -> *]).
FindBy
  KeyResolver
  (KeyDiscriminator key)
  (KeyOf (HeadOf es))
  (e # key)
  es =>
Membership (e # key) es
forall {k} (key :: k) (e :: (* -> *) -> * -> *)
       (es :: [(* -> *) -> * -> *]).
FindBy
  KeyResolver
  (KeyDiscriminator key)
  (KeyOf (HeadOf es))
  (e # key)
  es =>
Membership (e # key) es
keyMembership @key) a -> Eff es ans
ret (e (Eff es) x -> (x -> Eff es ans) -> Eff es ans
AlgHandler e (Eff es) (Eff es) ans
hdl (e (Eff es) x -> (x -> Eff es ans) -> Eff es ans)
-> ((#) e key (Eff es) x -> e (Eff es) x)
-> (#) e key (Eff es) x
-> (x -> Eff es ans)
-> Eff es ans
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (#) e key (Eff es) x -> e (Eff es) x
forall {k} (tag :: k) (e :: (* -> *) -> * -> *) (f :: * -> *) a.
Tagged tag e f a -> e f a
unTag)
{-# INLINE interposeOnBy #-}

-- | Reinterprets (hooks) the effect @e@ in the list using the provided algebraic handler.
interposeOnWith
    :: forall key e es a
     . (Has key e es, FOEs es)
    => AlgHandler e (Eff es) (Eff es) a
    -- ^ Effect handler
    -> Eff es a
    -> Eff es a
interposeOnWith :: forall {k} (key :: k) (e :: (* -> *) -> * -> *)
       (es :: [(* -> *) -> * -> *]) a.
(Has key e es, FOEs es) =>
AlgHandler e (Eff es) (Eff es) a -> Eff es a -> Eff es a
interposeOnWith AlgHandler e (Eff es) (Eff es) a
hdl = Membership (e # key) es
-> AlgHandler (e # key) (Eff es) (Eff es) a -> Eff es a -> Eff es a
forall (e :: (* -> *) -> * -> *) (es :: [(* -> *) -> * -> *]) a.
(KnownOrder e, FOEs es) =>
Membership e es
-> AlgHandler e (Eff es) (Eff es) a -> Eff es a -> Eff es a
interposeForWith (forall (key :: k) (e :: (* -> *) -> * -> *)
       (es :: [(* -> *) -> * -> *]).
FindBy
  KeyResolver
  (KeyDiscriminator key)
  (KeyOf (HeadOf es))
  (e # key)
  es =>
Membership (e # key) es
forall {k} (key :: k) (e :: (* -> *) -> * -> *)
       (es :: [(* -> *) -> * -> *]).
FindBy
  KeyResolver
  (KeyDiscriminator key)
  (KeyOf (HeadOf es))
  (e # key)
  es =>
Membership (e # key) es
keyMembership @key) (e (Eff es) x -> (x -> Eff es a) -> Eff es a
AlgHandler e (Eff es) (Eff es) a
hdl (e (Eff es) x -> (x -> Eff es a) -> Eff es a)
-> ((#) e key (Eff es) x -> e (Eff es) x)
-> (#) e key (Eff es) x
-> (x -> Eff es a)
-> Eff es a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (#) e key (Eff es) x -> e (Eff es) x
forall {k} (tag :: k) (e :: (* -> *) -> * -> *) (f :: * -> *) a.
Tagged tag e f a -> e f a
unTag)
{-# INLINE interposeOnWith #-}

-- | Reinterprets (hooks) the effect @e@ in the list using the provided value handler and algebraic handler.
interposeInBy
    :: forall e es ans a
     . (e `In` es, FOEs es)
    => (a -> Eff es ans)
    -- ^ Value handler
    -> AlgHandler e (Eff es) (Eff es) ans
    -- ^ Effect handler
    -> Eff es a
    -> Eff es ans
interposeInBy :: forall (e :: (* -> *) -> * -> *) (es :: [(* -> *) -> * -> *]) ans
       a.
(In e es, FOEs es) =>
(a -> Eff es ans)
-> AlgHandler e (Eff es) (Eff es) ans -> Eff es a -> Eff es ans
interposeInBy = Membership e es
-> (a -> Eff Freer es ans)
-> (forall {x}.
    e (Eff Freer es) x -> (x -> Eff Freer es ans) -> Eff Freer es ans)
-> Eff Freer es a
-> Eff Freer es ans
forall (e :: (* -> *) -> * -> *) (es :: [(* -> *) -> * -> *]) ans
       a.
(KnownOrder e, FOEs es) =>
Membership e es
-> (a -> Eff es ans)
-> AlgHandler e (Eff es) (Eff es) ans
-> Eff es a
-> Eff es ans
interposeForBy Membership e es
forall (e :: (* -> *) -> * -> *) (es :: [(* -> *) -> * -> *]).
FindBy
  IdentityResolver
  (IdentityDiscriminator e)
  (IdentityDiscriminator (HeadOf es))
  e
  es =>
Membership e es
identityMembership
{-# INLINE interposeInBy #-}

-- | Reinterprets (hooks) the effect @e@ in the list using the provided algebraic handler.
interposeInWith
    :: forall e es a
     . (e `In` es, FOEs es)
    => AlgHandler e (Eff es) (Eff es) a
    -- ^ Effect handler
    -> Eff es a
    -> Eff es a
interposeInWith :: forall (e :: (* -> *) -> * -> *) (es :: [(* -> *) -> * -> *]) a.
(In e es, FOEs es) =>
AlgHandler e (Eff es) (Eff es) a -> Eff es a -> Eff es a
interposeInWith = Membership e es
-> (forall {x}.
    e (Eff Freer es) x -> (x -> Eff Freer es a) -> Eff Freer es a)
-> Eff Freer es a
-> Eff Freer es a
forall (e :: (* -> *) -> * -> *) (es :: [(* -> *) -> * -> *]) a.
(KnownOrder e, FOEs es) =>
Membership e es
-> AlgHandler e (Eff es) (Eff es) a -> Eff es a -> Eff es a
interposeForWith Membership e es
forall (e :: (* -> *) -> * -> *) (es :: [(* -> *) -> * -> *]).
FindBy
  IdentityResolver
  (IdentityDiscriminator e)
  (IdentityDiscriminator (HeadOf es))
  e
  es =>
Membership e es
identityMembership
{-# INLINE interposeInWith #-}

interposeForBy
    :: forall e es ans a
     . (KnownOrder e, FOEs es)
    => Membership e es
    -> (a -> Eff es ans)
    -- ^ Value handler
    -> AlgHandler e (Eff es) (Eff es) ans
    -- ^ Effect handler
    -> Eff es a
    -> Eff es ans
interposeForBy :: forall (e :: (* -> *) -> * -> *) (es :: [(* -> *) -> * -> *]) ans
       a.
(KnownOrder e, FOEs es) =>
Membership e es
-> (a -> Eff es ans)
-> AlgHandler e (Eff es) (Eff es) ans
-> Eff es a
-> Eff es ans
interposeForBy Membership e es
i a -> Eff es ans
ret AlgHandler e (Eff es) (Eff es) ans
hdl = Eff Freer es a -> Eff es ans
loop
  where
    loop :: Eff Freer es a -> Eff es ans
loop (D.Eff Freer (Union es (Eff es)) a
a) = case Freer (Union es (Eff es)) a
a of
        Val a
x -> a -> Eff es ans
ret a
x
        Op Union es (Eff es) x
u FTCQueue (Freer (Union es (Eff es))) x a
q ->
            let k :: x -> Eff es ans
k = Eff Freer es a -> Eff es ans
loop (Eff Freer es a -> Eff es ans)
-> (x -> Eff Freer es a) -> x -> Eff es ans
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Freer (Union es (Eff es)) a -> Eff Freer es a
forall (ff :: (* -> *) -> * -> *) (es :: [(* -> *) -> * -> *]) a.
ff (Union es (Eff ff es)) a -> Eff ff es a
D.Eff (Freer (Union es (Eff es)) a -> Eff Freer es a)
-> (x -> Freer (Union es (Eff es)) a) -> x -> Eff Freer es a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FTCQueue (Freer (Union es (Eff es))) x a
-> x -> Freer (Union es (Eff es)) a
forall (f :: * -> *) a b. FTCQueue (Freer f) a b -> a -> Freer f b
qApp FTCQueue (Freer (Union es (Eff es))) x a
q
             in case Membership e es -> Union es (Eff es) x -> Maybe (e (Eff es) x)
forall (es :: [(* -> *) -> * -> *]) (f :: * -> *) a.
Membership e es -> Union es f a -> Maybe (e f a)
forall (e :: (* -> *) -> * -> *) (order :: EffectOrder)
       (es :: [(* -> *) -> * -> *]) (f :: * -> *) a.
Elem e order =>
Membership e es -> Union es f a -> Maybe (e f a)
project Membership e es
i Union es (Eff es) x
u of
                    Just e (Eff es) x
e -> e (Eff es) x -> (x -> Eff es ans) -> Eff es ans
AlgHandler e (Eff es) (Eff es) ans
hdl e (Eff es) x
e x -> Eff es ans
k
                    Maybe (e (Eff es) x)
Nothing -> Freer (Union es (Eff es)) ans -> Eff es ans
forall (ff :: (* -> *) -> * -> *) (es :: [(* -> *) -> * -> *]) a.
ff (Union es (Eff ff es)) a -> Eff ff es a
D.Eff (Freer (Union es (Eff es)) ans -> Eff es ans)
-> Freer (Union es (Eff es)) ans -> Eff es ans
forall a b. (a -> b) -> a -> b
$ Union es (Eff es) x
-> FTCQueue (Freer (Union es (Eff es))) x ans
-> Freer (Union es (Eff es)) ans
forall (f :: * -> *) a x.
f x -> FTCQueue (Freer f) x a -> Freer f a
Op Union es (Eff es) x
u ((x -> Freer (Union es (Eff es)) ans)
-> FTCQueue (Freer (Union es (Eff es))) x ans
forall a (m :: * -> *) b. (a -> m b) -> FTCQueue m a b
tsingleton ((x -> Freer (Union es (Eff es)) ans)
 -> FTCQueue (Freer (Union es (Eff es))) x ans)
-> (x -> Freer (Union es (Eff es)) ans)
-> FTCQueue (Freer (Union es (Eff es))) x ans
forall a b. (a -> b) -> a -> b
$ Eff es ans -> Freer (Union es (Eff es)) ans
forall (ff :: (* -> *) -> * -> *) (es :: [(* -> *) -> * -> *]) a.
Eff ff es a -> ff (Union es (Eff ff es)) a
unEff (Eff es ans -> Freer (Union es (Eff es)) ans)
-> (x -> Eff es ans) -> x -> Freer (Union es (Eff es)) ans
forall b c a. (b -> c) -> (a -> b) -> a -> c
. x -> Eff es ans
k)
{-# INLINE interposeForBy #-}

-- | Reinterprets (hooks) the effect @e@ in the list using the provided algebraic handler.
interposeForWith
    :: forall e es a
     . (KnownOrder e, FOEs es)
    => Membership e es
    -> AlgHandler e (Eff es) (Eff es) a
    -- ^ Effect handler
    -> Eff es a
    -> Eff es a
interposeForWith :: forall (e :: (* -> *) -> * -> *) (es :: [(* -> *) -> * -> *]) a.
(KnownOrder e, FOEs es) =>
Membership e es
-> AlgHandler e (Eff es) (Eff es) a -> Eff es a -> Eff es a
interposeForWith Membership e es
i = Membership e es
-> (a -> Eff Freer es a)
-> AlgHandler e (Eff Freer es) (Eff Freer es) a
-> Eff Freer es a
-> Eff Freer es a
forall (e :: (* -> *) -> * -> *) (es :: [(* -> *) -> * -> *]) ans
       a.
(KnownOrder e, FOEs es) =>
Membership e es
-> (a -> Eff es ans)
-> AlgHandler e (Eff es) (Eff es) ans
-> Eff es a
-> Eff es ans
interposeForBy Membership e es
i a -> Eff Freer es a
forall a. a -> Eff Freer es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
{-# INLINE interposeForWith #-}

-- * Utilities

-- | Lifts a stateless handler into a algebraic handler.
stateless :: forall e m n ans. (Monad n) => (e m ~> n) -> AlgHandler e m n ans
stateless :: forall (e :: (* -> *) -> * -> *) (m :: * -> *) (n :: * -> *) ans.
Monad n =>
(e m ~> n) -> AlgHandler e m n ans
stateless e m ~> n
i e m x
e x -> n ans
k = e m x -> n x
e m ~> n
i e m x
e n x -> (x -> n ans) -> n ans
forall a b. n a -> (a -> n b) -> n b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= x -> n ans
k
{-# INLINE stateless #-}