{-# LANGUAGE AllowAmbiguousTypes #-}
{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
{-# HLINT ignore "Avoid lambda" #-}
module Control.Effect.Interpret where
import Control.Effect (
Eff (..),
Free (liftFree),
hoist,
runFree,
type (~>),
type (~~>),
)
import Data.Effect (Emb, getEmb)
import Data.Effect.OpenUnion (
Has,
In,
KnownLength,
KnownOrder,
Membership,
Suffix,
Union,
hfmapUnion,
identityMembership,
keyMembership,
labelMembership,
nil,
project,
weakens,
(!++),
(!:),
(:>),
type (++),
)
import Data.Effect.Tag (unTag)
import Data.Functor.Identity (Identity, runIdentity)
runEff :: (Free c ff, c f) => Eff ff '[Emb f] a -> f a
runEff :: forall (c :: (* -> *) -> Constraint) (ff :: (* -> *) -> * -> *)
(f :: * -> *) a.
(Free c ff, c f) =>
Eff ff '[Emb f] a -> f a
runEff = (forall x. Union '[Emb f] (Eff ff '[Emb f]) x -> f x)
-> ff (Union '[Emb f] (Eff ff '[Emb f])) a -> f a
forall (g :: * -> *) (f :: * -> *) a.
c g =>
(forall x. f x -> g x) -> ff f a -> g a
forall (c :: (* -> *) -> Constraint) (ff :: (* -> *) -> * -> *)
(g :: * -> *) (f :: * -> *) a.
(Free c ff, c g) =>
(forall x. f x -> g x) -> ff f a -> g a
runFree (Emb f (Eff ff '[Emb f]) x -> f x
forall (e :: * -> *) (f :: * -> *) a. Emb e f a -> e a
getEmb (Emb f (Eff ff '[Emb f]) x -> f x)
-> (Union '[] (Eff ff '[Emb f]) x -> f x)
-> Union '[Emb f] (Eff ff '[Emb f]) x
-> f x
forall (f :: * -> *) a r (es :: [(* -> *) -> * -> *]).
(Emb f f a -> r)
-> (Union es f a -> r) -> Union (Emb f : 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
!: Union '[] (Eff ff '[Emb f]) x -> f x
forall (f :: * -> *) a r. Union '[] f a -> r
nil) (ff (Union '[Emb f] (Eff ff '[Emb f])) a -> f a)
-> (Eff ff '[Emb f] a -> ff (Union '[Emb f] (Eff ff '[Emb f])) a)
-> Eff ff '[Emb f] a
-> f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Eff ff '[Emb f] a -> ff (Union '[Emb f] (Eff ff '[Emb f])) a
forall (ff :: (* -> *) -> * -> *) (es :: [(* -> *) -> * -> *]) a.
Eff ff es a -> ff (Union es (Eff ff es)) a
unEff
{-# INLINE runEff #-}
runPure :: (Free c ff, c Identity) => Eff ff '[] a -> a
runPure :: forall (c :: (* -> *) -> Constraint) (ff :: (* -> *) -> * -> *) a.
(Free c ff, c Identity) =>
Eff ff '[] a -> a
runPure = Identity a -> a
forall a. Identity a -> a
runIdentity (Identity a -> a)
-> (Eff ff '[] a -> Identity a) -> Eff ff '[] a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall x. Union '[] (Eff ff '[]) x -> Identity x)
-> ff (Union '[] (Eff ff '[])) a -> Identity a
forall (g :: * -> *) (f :: * -> *) a.
c g =>
(forall x. f x -> g x) -> ff f a -> g a
forall (c :: (* -> *) -> Constraint) (ff :: (* -> *) -> * -> *)
(g :: * -> *) (f :: * -> *) a.
(Free c ff, c g) =>
(forall x. f x -> g x) -> ff f a -> g a
runFree Union '[] (Eff ff '[]) x -> Identity x
forall x. Union '[] (Eff ff '[]) x -> Identity x
forall (f :: * -> *) a r. Union '[] f a -> r
nil (ff (Union '[] (Eff ff '[])) a -> Identity a)
-> (Eff ff '[] a -> ff (Union '[] (Eff ff '[])) a)
-> Eff ff '[] a
-> Identity a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Eff ff '[] a -> ff (Union '[] (Eff ff '[])) a
forall (ff :: (* -> *) -> * -> *) (es :: [(* -> *) -> * -> *]) a.
Eff ff es a -> ff (Union es (Eff ff es)) a
unEff
{-# INLINE runPure #-}
interpret
:: forall e es ff a c
. (KnownOrder e, Free c ff)
=> e ~~> Eff ff es
-> Eff ff (e ': es) a
-> Eff ff es a
interpret :: forall (e :: (* -> *) -> * -> *) (es :: [(* -> *) -> * -> *])
(ff :: (* -> *) -> * -> *) a (c :: (* -> *) -> Constraint).
(KnownOrder e, Free c ff) =>
(e ~~> Eff ff es) -> Eff ff (e : es) a -> Eff ff es a
interpret e ~~> Eff ff es
i = (Union (e : es) ~~> Eff ff es) -> Eff ff (e : es) a -> Eff ff es a
forall (es :: [(* -> *) -> * -> *]) (es' :: [(* -> *) -> * -> *])
(ff :: (* -> *) -> * -> *) a (c :: (* -> *) -> Constraint).
Free c ff =>
(Union es ~~> Eff ff es') -> Eff ff es a -> Eff ff es' a
interpretAll ((Union (e : es) ~~> Eff ff es)
-> Eff ff (e : es) a -> Eff ff es a)
-> (Union (e : es) ~~> Eff ff es)
-> Eff ff (e : es) a
-> Eff ff es a
forall a b. (a -> b) -> a -> b
$ e (Eff ff es) x -> Eff ff es x
e ~~> Eff ff es
i (e (Eff ff es) x -> Eff ff es x)
-> (Union es (Eff ff es) x -> Eff ff es x)
-> Union (e : es) (Eff ff es) x
-> Eff ff es x
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
!: ff (Union es (Eff ff es)) x -> Eff ff es x
forall (ff :: (* -> *) -> * -> *) (es :: [(* -> *) -> * -> *]) a.
ff (Union es (Eff ff es)) a -> Eff ff es a
Eff (ff (Union es (Eff ff es)) x -> Eff ff es x)
-> (Union es (Eff ff es) x -> ff (Union es (Eff ff es)) x)
-> Union es (Eff ff es) x
-> Eff ff es x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Union es (Eff ff es) x -> ff (Union es (Eff ff es)) x
forall (f :: * -> *) a. f a -> ff f a
forall (c :: (* -> *) -> Constraint) (ff :: (* -> *) -> * -> *)
(f :: * -> *) a.
Free c ff =>
f a -> ff f a
liftFree
{-# INLINE interpret #-}
reinterpret
:: forall e es es' ff a c
. (Suffix es es', KnownOrder e, Free c ff)
=> e ~~> Eff ff es'
-> Eff ff (e ': es) a
-> Eff ff es' a
reinterpret :: forall (e :: (* -> *) -> * -> *) (es :: [(* -> *) -> * -> *])
(es' :: [(* -> *) -> * -> *]) (ff :: (* -> *) -> * -> *) a
(c :: (* -> *) -> Constraint).
(Suffix es es', KnownOrder e, Free c ff) =>
(e ~~> Eff ff es') -> Eff ff (e : es) a -> Eff ff es' a
reinterpret e ~~> Eff ff es'
i = (Union (e : es) ~~> Eff ff es')
-> Eff ff (e : es) a -> Eff ff es' a
forall (es :: [(* -> *) -> * -> *]) (es' :: [(* -> *) -> * -> *])
(ff :: (* -> *) -> * -> *) a (c :: (* -> *) -> Constraint).
Free c ff =>
(Union es ~~> Eff ff es') -> Eff ff es a -> Eff ff es' a
interpretAll ((Union (e : es) ~~> Eff ff es')
-> Eff ff (e : es) a -> Eff ff es' a)
-> (Union (e : es) ~~> Eff ff es')
-> Eff ff (e : es) a
-> Eff ff es' a
forall a b. (a -> b) -> a -> b
$ e (Eff ff es') x -> Eff ff es' x
e ~~> Eff ff es'
i (e (Eff ff es') x -> Eff ff es' x)
-> (Union es (Eff ff es') x -> Eff ff es' x)
-> Union (e : es) (Eff ff es') x
-> Eff ff es' x
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
!: ff (Union es' (Eff ff es')) x -> Eff ff es' x
forall (ff :: (* -> *) -> * -> *) (es :: [(* -> *) -> * -> *]) a.
ff (Union es (Eff ff es)) a -> Eff ff es a
Eff (ff (Union es' (Eff ff es')) x -> Eff ff es' x)
-> (Union es (Eff ff es') x -> ff (Union es' (Eff ff es')) x)
-> Union es (Eff ff es') x
-> Eff ff es' x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Union es' (Eff ff es') x -> ff (Union es' (Eff ff es')) x
forall (f :: * -> *) a. f a -> ff f a
forall (c :: (* -> *) -> Constraint) (ff :: (* -> *) -> * -> *)
(f :: * -> *) a.
Free c ff =>
f a -> ff f a
liftFree (Union es' (Eff ff es') x -> ff (Union es' (Eff ff es')) x)
-> (Union es (Eff ff es') x -> Union es' (Eff ff es') x)
-> Union es (Eff ff es') x
-> ff (Union es' (Eff ff es')) x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Union es (Eff ff es') x -> Union es' (Eff ff es') x
forall (es :: [(* -> *) -> * -> *]) (es' :: [(* -> *) -> * -> *])
(f :: * -> *) a.
Suffix es es' =>
Union es f a -> Union es' f a
weakens
{-# INLINE reinterpret #-}
interprets
:: forall es r ff a c
. (KnownLength es, Free c ff)
=> Union es ~~> Eff ff r
-> Eff ff (es ++ r) a
-> Eff ff r a
interprets :: forall (es :: [(* -> *) -> * -> *]) (r :: [(* -> *) -> * -> *])
(ff :: (* -> *) -> * -> *) a (c :: (* -> *) -> Constraint).
(KnownLength es, Free c ff) =>
(Union es ~~> Eff ff r) -> Eff ff (es ++ r) a -> Eff ff r a
interprets Union es ~~> Eff ff r
i = (Union (es ++ r) ~~> Eff ff r) -> Eff ff (es ++ r) a -> Eff ff r a
forall (es :: [(* -> *) -> * -> *]) (es' :: [(* -> *) -> * -> *])
(ff :: (* -> *) -> * -> *) a (c :: (* -> *) -> Constraint).
Free c ff =>
(Union es ~~> Eff ff es') -> Eff ff es a -> Eff ff es' a
interpretAll ((Union (es ++ r) ~~> Eff ff r)
-> Eff ff (es ++ r) a -> Eff ff r a)
-> (Union (es ++ r) ~~> Eff ff r)
-> Eff ff (es ++ r) a
-> Eff ff r a
forall a b. (a -> b) -> a -> b
$ Union es (Eff ff r) x -> Eff ff r x
Union es ~~> Eff ff r
i (Union es (Eff ff r) x -> Eff ff r x)
-> (Union r (Eff ff r) x -> Eff ff r x)
-> Union (es ++ r) (Eff ff r) x
-> Eff ff r x
forall (es :: [(* -> *) -> * -> *]) (es' :: [(* -> *) -> * -> *])
(f :: * -> *) a r.
KnownLength es =>
(Union es f a -> r)
-> (Union es' f a -> r) -> Union (es ++ es') f a -> r
!++ ff (Union r (Eff ff r)) x -> Eff ff r x
forall (ff :: (* -> *) -> * -> *) (es :: [(* -> *) -> * -> *]) a.
ff (Union es (Eff ff es)) a -> Eff ff es a
Eff (ff (Union r (Eff ff r)) x -> Eff ff r x)
-> (Union r (Eff ff r) x -> ff (Union r (Eff ff r)) x)
-> Union r (Eff ff r) x
-> Eff ff r x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Union r (Eff ff r) x -> ff (Union r (Eff ff r)) x
forall (f :: * -> *) a. f a -> ff f a
forall (c :: (* -> *) -> Constraint) (ff :: (* -> *) -> * -> *)
(f :: * -> *) a.
Free c ff =>
f a -> ff f a
liftFree
{-# INLINE interprets #-}
reinterprets
:: forall es r r' ff a c
. (Suffix r r', KnownLength es, Free c ff)
=> (Union es (Eff ff r') ~> Eff ff r')
-> Eff ff (es ++ r) a
-> Eff ff r' a
reinterprets :: forall (es :: [(* -> *) -> * -> *]) (r :: [(* -> *) -> * -> *])
(r' :: [(* -> *) -> * -> *]) (ff :: (* -> *) -> * -> *) a
(c :: (* -> *) -> Constraint).
(Suffix r r', KnownLength es, Free c ff) =>
(Union es (Eff ff r') ~> Eff ff r')
-> Eff ff (es ++ r) a -> Eff ff r' a
reinterprets Union es (Eff ff r') ~> Eff ff r'
i = (Union (es ++ r) ~~> Eff ff r')
-> Eff ff (es ++ r) a -> Eff ff r' a
forall (es :: [(* -> *) -> * -> *]) (es' :: [(* -> *) -> * -> *])
(ff :: (* -> *) -> * -> *) a (c :: (* -> *) -> Constraint).
Free c ff =>
(Union es ~~> Eff ff es') -> Eff ff es a -> Eff ff es' a
interpretAll ((Union (es ++ r) ~~> Eff ff r')
-> Eff ff (es ++ r) a -> Eff ff r' a)
-> (Union (es ++ r) ~~> Eff ff r')
-> Eff ff (es ++ r) a
-> Eff ff r' a
forall a b. (a -> b) -> a -> b
$ Union es (Eff ff r') x -> Eff ff r' x
Union es (Eff ff r') ~> Eff ff r'
i (Union es (Eff ff r') x -> Eff ff r' x)
-> (Union r (Eff ff r') x -> Eff ff r' x)
-> Union (es ++ r) (Eff ff r') x
-> Eff ff r' x
forall (es :: [(* -> *) -> * -> *]) (es' :: [(* -> *) -> * -> *])
(f :: * -> *) a r.
KnownLength es =>
(Union es f a -> r)
-> (Union es' f a -> r) -> Union (es ++ es') f a -> r
!++ ff (Union r' (Eff ff r')) x -> Eff ff r' x
forall (ff :: (* -> *) -> * -> *) (es :: [(* -> *) -> * -> *]) a.
ff (Union es (Eff ff es)) a -> Eff ff es a
Eff (ff (Union r' (Eff ff r')) x -> Eff ff r' x)
-> (Union r (Eff ff r') x -> ff (Union r' (Eff ff r')) x)
-> Union r (Eff ff r') x
-> Eff ff r' x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Union r' (Eff ff r') x -> ff (Union r' (Eff ff r')) x
forall (f :: * -> *) a. f a -> ff f a
forall (c :: (* -> *) -> Constraint) (ff :: (* -> *) -> * -> *)
(f :: * -> *) a.
Free c ff =>
f a -> ff f a
liftFree (Union r' (Eff ff r') x -> ff (Union r' (Eff ff r')) x)
-> (Union r (Eff ff r') x -> Union r' (Eff ff r') x)
-> Union r (Eff ff r') x
-> ff (Union r' (Eff ff r')) x
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
{-# INLINE reinterprets #-}
interpose
:: forall e es ff a c
. (e :> es, Free c ff)
=> e ~~> Eff ff es
-> Eff ff es a
-> Eff ff es a
interpose :: forall (e :: (* -> *) -> * -> *) (es :: [(* -> *) -> * -> *])
(ff :: (* -> *) -> * -> *) a (c :: (* -> *) -> Constraint).
(e :> es, Free c ff) =>
(e ~~> Eff ff es) -> Eff ff es a -> Eff ff es a
interpose = Membership e es
-> (forall {x}. e (Eff ff es) x -> Eff ff es x)
-> Eff ff es a
-> Eff ff es a
forall (e :: (* -> *) -> * -> *) (es :: [(* -> *) -> * -> *])
(ff :: (* -> *) -> * -> *) 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 e es
forall (e :: (* -> *) -> * -> *) (es :: [(* -> *) -> * -> *]).
FindBy LabelResolver (LabelOf e) (LabelOf (HeadOf es)) e es =>
Membership e es
labelMembership
{-# INLINE interpose #-}
interposeOn
:: forall key e es ff a c
. (Has key e es, Free c ff)
=> e ~~> Eff ff es
-> Eff ff es a
-> Eff ff es a
interposeOn :: forall {k} (key :: k) (e :: (* -> *) -> * -> *)
(es :: [(* -> *) -> * -> *]) (ff :: (* -> *) -> * -> *) a
(c :: (* -> *) -> Constraint).
(Has key e es, Free c ff) =>
(e ~~> Eff ff es) -> Eff ff es a -> Eff ff es a
interposeOn e ~~> Eff ff es
f = Membership (e # key) es
-> ((e # key) ~~> Eff ff es) -> Eff ff es a -> Eff ff es a
forall (e :: (* -> *) -> * -> *) (es :: [(* -> *) -> * -> *])
(ff :: (* -> *) -> * -> *) a (c :: (* -> *) -> Constraint).
(KnownOrder e, Free c ff) =>
Membership e es -> (e ~~> Eff ff es) -> Eff ff es a -> Eff ff es a
interposeFor (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 ff es) x -> Eff ff es x
e ~~> Eff ff es
f (e (Eff ff es) x -> Eff ff es x)
-> ((#) e key (Eff ff es) x -> e (Eff ff es) x)
-> (#) e key (Eff ff es) x
-> Eff ff es x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (#) e key (Eff ff es) x -> e (Eff ff es) x
forall {k} (tag :: k) (e :: (* -> *) -> * -> *) (f :: * -> *) a.
Tagged tag e f a -> e f a
unTag)
{-# INLINE interposeOn #-}
interposeIn
:: forall e es ff a c
. (e `In` es, Free c ff)
=> e ~~> Eff ff es
-> Eff ff es a
-> Eff ff es a
interposeIn :: forall (e :: (* -> *) -> * -> *) (es :: [(* -> *) -> * -> *])
(ff :: (* -> *) -> * -> *) a (c :: (* -> *) -> Constraint).
(In e es, Free c ff) =>
(e ~~> Eff ff es) -> Eff ff es a -> Eff ff es a
interposeIn = Membership e es
-> (forall {x}. e (Eff ff es) x -> Eff ff es x)
-> Eff ff es a
-> Eff ff es a
forall (e :: (* -> *) -> * -> *) (es :: [(* -> *) -> * -> *])
(ff :: (* -> *) -> * -> *) 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 e es
forall (e :: (* -> *) -> * -> *) (es :: [(* -> *) -> * -> *]).
FindBy
IdentityResolver
(IdentityDiscriminator e)
(IdentityDiscriminator (HeadOf es))
e
es =>
Membership e es
identityMembership
{-# INLINE interposeIn #-}
interposeFor
:: forall e es ff a c
. (KnownOrder e, Free c ff)
=> Membership e es
-> e ~~> Eff ff es
-> Eff ff es a
-> Eff ff es a
interposeFor :: forall (e :: (* -> *) -> * -> *) (es :: [(* -> *) -> * -> *])
(ff :: (* -> *) -> * -> *) 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 e es
i e ~~> Eff ff es
f =
(Union es ~~> Eff ff es) -> Eff ff es a -> Eff ff es a
forall (es :: [(* -> *) -> * -> *]) (es' :: [(* -> *) -> * -> *])
(ff :: (* -> *) -> * -> *) a (c :: (* -> *) -> Constraint).
Free c ff =>
(Union es ~~> Eff ff es') -> Eff ff es a -> Eff ff es' a
interpretAll \Union es (Eff ff es) x
u ->
case Membership e es
-> Union es (Eff ff es) x -> Maybe (e (Eff ff 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 ff es) x
u of
Just e (Eff ff es) x
e -> e (Eff ff es) x -> Eff ff es x
e ~~> Eff ff es
f e (Eff ff es) x
e
Maybe (e (Eff ff es) x)
Nothing -> ff (Union es (Eff ff es)) x -> Eff ff es x
forall (ff :: (* -> *) -> * -> *) (es :: [(* -> *) -> * -> *]) a.
ff (Union es (Eff ff es)) a -> Eff ff es a
Eff (ff (Union es (Eff ff es)) x -> Eff ff es x)
-> ff (Union es (Eff ff es)) x -> Eff ff es x
forall a b. (a -> b) -> a -> b
$ Union es (Eff ff es) x -> ff (Union es (Eff ff es)) x
forall (f :: * -> *) a. f a -> ff f a
forall (c :: (* -> *) -> Constraint) (ff :: (* -> *) -> * -> *)
(f :: * -> *) a.
Free c ff =>
f a -> ff f a
liftFree Union es (Eff ff es) x
u
{-# INLINE interposeFor #-}
preinterpose
:: forall e es ff a c
. (e :> es, Free c ff)
=> e ~~> Eff ff es
-> Eff ff es a
-> Eff ff es a
preinterpose :: forall (e :: (* -> *) -> * -> *) (es :: [(* -> *) -> * -> *])
(ff :: (* -> *) -> * -> *) a (c :: (* -> *) -> Constraint).
(e :> es, Free c ff) =>
(e ~~> Eff ff es) -> Eff ff es a -> Eff ff es a
preinterpose = Membership e es
-> (forall {x}. e (Eff ff es) x -> Eff ff es x)
-> Eff ff es a
-> Eff ff es a
forall (e :: (* -> *) -> * -> *) (es :: [(* -> *) -> * -> *])
(ff :: (* -> *) -> * -> *) a (c :: (* -> *) -> Constraint).
(KnownOrder e, Free c ff) =>
Membership e es -> (e ~~> Eff ff es) -> Eff ff es a -> Eff ff es a
preinterposeFor Membership e es
forall (e :: (* -> *) -> * -> *) (es :: [(* -> *) -> * -> *]).
FindBy LabelResolver (LabelOf e) (LabelOf (HeadOf es)) e es =>
Membership e es
labelMembership
{-# INLINE preinterpose #-}
preinterposeOn
:: forall key e es ff a c
. (Has key e es, Free c ff)
=> e ~~> Eff ff es
-> Eff ff es a
-> Eff ff es a
preinterposeOn :: forall {k} (key :: k) (e :: (* -> *) -> * -> *)
(es :: [(* -> *) -> * -> *]) (ff :: (* -> *) -> * -> *) a
(c :: (* -> *) -> Constraint).
(Has key e es, Free c ff) =>
(e ~~> Eff ff es) -> Eff ff es a -> Eff ff es a
preinterposeOn e ~~> Eff ff es
f = Membership (e # key) es
-> ((e # key) ~~> Eff ff es) -> Eff ff es a -> Eff ff es a
forall (e :: (* -> *) -> * -> *) (es :: [(* -> *) -> * -> *])
(ff :: (* -> *) -> * -> *) a (c :: (* -> *) -> Constraint).
(KnownOrder e, Free c ff) =>
Membership e es -> (e ~~> Eff ff es) -> Eff ff es a -> Eff ff es a
preinterposeFor (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 ff es) x -> Eff ff es x
e ~~> Eff ff es
f (e (Eff ff es) x -> Eff ff es x)
-> ((#) e key (Eff ff es) x -> e (Eff ff es) x)
-> (#) e key (Eff ff es) x
-> Eff ff es x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (#) e key (Eff ff es) x -> e (Eff ff es) x
forall {k} (tag :: k) (e :: (* -> *) -> * -> *) (f :: * -> *) a.
Tagged tag e f a -> e f a
unTag)
{-# INLINE preinterposeOn #-}
preinterposeIn
:: forall e es ff a c
. (e `In` es, Free c ff)
=> e ~~> Eff ff es
-> Eff ff es a
-> Eff ff es a
preinterposeIn :: forall (e :: (* -> *) -> * -> *) (es :: [(* -> *) -> * -> *])
(ff :: (* -> *) -> * -> *) a (c :: (* -> *) -> Constraint).
(In e es, Free c ff) =>
(e ~~> Eff ff es) -> Eff ff es a -> Eff ff es a
preinterposeIn = Membership e es
-> (forall {x}. e (Eff ff es) x -> Eff ff es x)
-> Eff ff es a
-> Eff ff es a
forall (e :: (* -> *) -> * -> *) (es :: [(* -> *) -> * -> *])
(ff :: (* -> *) -> * -> *) a (c :: (* -> *) -> Constraint).
(KnownOrder e, Free c ff) =>
Membership e es -> (e ~~> Eff ff es) -> Eff ff es a -> Eff ff es a
preinterposeFor Membership e es
forall (e :: (* -> *) -> * -> *) (es :: [(* -> *) -> * -> *]).
FindBy
IdentityResolver
(IdentityDiscriminator e)
(IdentityDiscriminator (HeadOf es))
e
es =>
Membership e es
identityMembership
{-# INLINE preinterposeIn #-}
preinterposeFor
:: forall e es ff a c
. (KnownOrder e, Free c ff)
=> Membership e es
-> e ~~> Eff ff es
-> Eff ff es a
-> Eff ff es a
preinterposeFor :: forall (e :: (* -> *) -> * -> *) (es :: [(* -> *) -> * -> *])
(ff :: (* -> *) -> * -> *) a (c :: (* -> *) -> Constraint).
(KnownOrder e, Free c ff) =>
Membership e es -> (e ~~> Eff ff es) -> Eff ff es a -> Eff ff es a
preinterposeFor Membership e es
i e ~~> Eff ff es
f = Eff ff es a -> Eff ff es a
Eff ff es ~> Eff ff es
go
where
go :: Eff ff es ~> Eff ff es
go :: Eff ff es ~> Eff ff es
go (Eff ff (Union es (Eff ff es)) x
a) = ff (Union es (Eff ff es)) x -> Eff ff es x
forall (ff :: (* -> *) -> * -> *) (es :: [(* -> *) -> * -> *]) a.
ff (Union es (Eff ff es)) a -> Eff ff es a
Eff (ff (Union es (Eff ff es)) x -> Eff ff es x)
-> ff (Union es (Eff ff es)) x -> Eff ff es x
forall a b. (a -> b) -> a -> b
$ ((forall x. Union es (Eff ff es) x -> ff (Union es (Eff ff es)) x)
-> ff (Union es (Eff ff es)) x -> ff (Union es (Eff ff es)) x
forall (g :: * -> *) (f :: * -> *) a.
c g =>
(forall x. f x -> g x) -> ff f a -> g a
forall (c :: (* -> *) -> Constraint) (ff :: (* -> *) -> * -> *)
(g :: * -> *) (f :: * -> *) a.
(Free c ff, c g) =>
(forall x. f x -> g x) -> ff f a -> g a
`runFree` ff (Union es (Eff ff es)) x
a) \Union es (Eff ff es) x
u ->
(forall x. Union es (Eff ff es) x -> Union es (Eff ff es) x)
-> ff (Union es (Eff ff es)) x -> ff (Union es (Eff ff es)) x
forall (f :: * -> *) (g :: * -> *) a.
(forall x. f x -> g x) -> ff f a -> ff g a
forall (c :: (* -> *) -> Constraint) (ff :: (* -> *) -> * -> *)
(f :: * -> *) (g :: * -> *) a.
Free c ff =>
(forall x. f x -> g x) -> ff f a -> ff g a
hoist ((Eff ff es ~> Eff ff es)
-> Union es (Eff ff es) x -> Union es (Eff ff es) x
forall (f :: * -> *) (g :: * -> *) (es :: [(* -> *) -> * -> *]) a.
(forall x. f x -> g x) -> Union es f a -> Union es g a
hfmapUnion Eff ff es x -> Eff ff es x
Eff ff es ~> Eff ff es
go) (ff (Union es (Eff ff es)) x -> ff (Union es (Eff ff es)) x)
-> ff (Union es (Eff ff es)) x -> ff (Union es (Eff ff es)) x
forall a b. (a -> b) -> a -> b
$ case Membership e es
-> Union es (Eff ff es) x -> Maybe (e (Eff ff 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 ff es) x
u of
Just e (Eff ff es) x
e -> Eff ff es x -> ff (Union es (Eff ff es)) x
forall (ff :: (* -> *) -> * -> *) (es :: [(* -> *) -> * -> *]) a.
Eff ff es a -> ff (Union es (Eff ff es)) a
unEff (Eff ff es x -> ff (Union es (Eff ff es)) x)
-> Eff ff es x -> ff (Union es (Eff ff es)) x
forall a b. (a -> b) -> a -> b
$ e (Eff ff es) x -> Eff ff es x
e ~~> Eff ff es
f e (Eff ff es) x
e
Maybe (e (Eff ff es) x)
Nothing -> Union es (Eff ff es) x -> ff (Union es (Eff ff es)) x
forall (f :: * -> *) a. f a -> ff f a
forall (c :: (* -> *) -> Constraint) (ff :: (* -> *) -> * -> *)
(f :: * -> *) a.
Free c ff =>
f a -> ff f a
liftFree Union es (Eff ff es) x
u
{-# INLINE preinterposeFor #-}
interpretAll
:: forall es es' ff a c
. (Free c ff)
=> (Union es ~~> Eff ff es')
-> Eff ff es a
-> Eff ff es' a
interpretAll :: forall (es :: [(* -> *) -> * -> *]) (es' :: [(* -> *) -> * -> *])
(ff :: (* -> *) -> * -> *) a (c :: (* -> *) -> Constraint).
Free c ff =>
(Union es ~~> Eff ff es') -> Eff ff es a -> Eff ff es' a
interpretAll Union es ~~> Eff ff es'
i = Eff ff es a -> Eff ff es' a
Eff ff es ~> Eff ff es'
go
where
go :: Eff ff es ~> Eff ff es'
go :: Eff ff es ~> Eff ff es'
go = ff (Union es' (Eff ff es')) x -> Eff ff es' x
forall (ff :: (* -> *) -> * -> *) (es :: [(* -> *) -> * -> *]) a.
ff (Union es (Eff ff es)) a -> Eff ff es a
Eff (ff (Union es' (Eff ff es')) x -> Eff ff es' x)
-> (Eff ff es x -> ff (Union es' (Eff ff es')) x)
-> Eff ff es x
-> Eff ff es' x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall x. Union es (Eff ff es) x -> ff (Union es' (Eff ff es')) x)
-> ff (Union es (Eff ff es)) x -> ff (Union es' (Eff ff es')) x
forall (g :: * -> *) (f :: * -> *) a.
c g =>
(forall x. f x -> g x) -> ff f a -> g a
forall (c :: (* -> *) -> Constraint) (ff :: (* -> *) -> * -> *)
(g :: * -> *) (f :: * -> *) a.
(Free c ff, c g) =>
(forall x. f x -> g x) -> ff f a -> g a
runFree (Eff ff es' x -> ff (Union es' (Eff ff es')) x
forall (ff :: (* -> *) -> * -> *) (es :: [(* -> *) -> * -> *]) a.
Eff ff es a -> ff (Union es (Eff ff es)) a
unEff (Eff ff es' x -> ff (Union es' (Eff ff es')) x)
-> (Union es (Eff ff es) x -> Eff ff es' x)
-> Union es (Eff ff es) x
-> ff (Union es' (Eff ff es')) x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Union es (Eff ff es') x -> Eff ff es' x
Union es ~~> Eff ff es'
i (Union es (Eff ff es') x -> Eff ff es' x)
-> (Union es (Eff ff es) x -> Union es (Eff ff es') x)
-> Union es (Eff ff es) x
-> Eff ff es' x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Eff ff es ~> Eff ff es')
-> Union es (Eff ff es) x -> Union es (Eff ff es') x
forall (f :: * -> *) (g :: * -> *) (es :: [(* -> *) -> * -> *]) a.
(forall x. f x -> g x) -> Union es f a -> Union es g a
hfmapUnion Eff ff es x -> Eff ff es' x
Eff ff es ~> Eff ff es'
go) (ff (Union es (Eff ff es)) x -> ff (Union es' (Eff ff es')) x)
-> (Eff ff es x -> ff (Union es (Eff ff es)) x)
-> Eff ff es x
-> ff (Union es' (Eff ff es')) x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Eff ff es x -> ff (Union es (Eff ff es)) x
forall (ff :: (* -> *) -> * -> *) (es :: [(* -> *) -> * -> *]) a.
Eff ff es a -> ff (Union es (Eff ff es)) a
unEff
{-# INLINE interpretAll #-}
iterAllEff
:: forall es f ff a c
. (Free c ff, c f)
=> Union es ~~> f
-> Eff ff es a
-> f a
iterAllEff :: forall (es :: [(* -> *) -> * -> *]) (f :: * -> *)
(ff :: (* -> *) -> * -> *) a (c :: (* -> *) -> Constraint).
(Free c ff, c f) =>
(Union es ~~> f) -> Eff ff es a -> f a
iterAllEff Union es ~~> f
i = Eff ff es a -> f a
Eff ff es ~> f
go
where
go :: Eff ff es ~> f
go :: Eff ff es ~> f
go = (forall x. Union es (Eff ff es) x -> f x)
-> ff (Union es (Eff ff es)) x -> f x
forall (g :: * -> *) (f :: * -> *) a.
c g =>
(forall x. f x -> g x) -> ff f a -> g a
forall (c :: (* -> *) -> Constraint) (ff :: (* -> *) -> * -> *)
(g :: * -> *) (f :: * -> *) a.
(Free c ff, c g) =>
(forall x. f x -> g x) -> ff f a -> g a
runFree (Union es f x -> f x
Union es ~~> f
i (Union es f x -> f x)
-> (Union es (Eff ff es) x -> Union es f x)
-> Union es (Eff ff es) x
-> f x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Eff ff es ~> f) -> Union es (Eff ff es) x -> Union es f x
forall (f :: * -> *) (g :: * -> *) (es :: [(* -> *) -> * -> *]) a.
(forall x. f x -> g x) -> Union es f a -> Union es g a
hfmapUnion Eff ff es x -> f x
Eff ff es ~> f
go) (ff (Union es (Eff ff es)) x -> f x)
-> (Eff ff es x -> ff (Union es (Eff ff es)) x)
-> Eff ff es x
-> f x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Eff ff es x -> ff (Union es (Eff ff es)) x
forall (ff :: (* -> *) -> * -> *) (es :: [(* -> *) -> * -> *]) a.
Eff ff es a -> ff (Union es (Eff ff es)) a
unEff
{-# INLINE iterAllEff #-}