heftia-effects-0.5.0.0: higher-order algebraic effects done right
Copyright(c) 2024 Sayo Koyoneda
LicenseMPL-2.0 (see the LICENSE file)
Maintainerymdfield@outlook.jp
Safe HaskellNone
LanguageGHC2021

Control.Monad.Hefty.Provider

Description

Interpreters for the Provider effects.

Synopsis

Documentation

type Provide (ctx :: k -> Type -> Type) (i :: k -> Type) (sh :: k -> EffectH) (sf :: k -> EffectF) (eh :: [EffectH]) (ef :: [EffectF]) = Provider ctx i (ProviderEff ctx i sh sf eh ef) Source #

newtype ProviderEff (ctx :: k -> Type -> Type) (i :: k -> Type) (sh :: k -> EffectH) (sf :: k -> EffectF) (eh :: [EffectH]) (ef :: [EffectF]) (p :: k) a Source #

Constructors

ProviderEff 

Fields

type Provide_ i (sh :: EffectH) (sf :: EffectF) (eh :: [EffectH]) (ef :: [EffectF]) = Provider (Const1 Identity :: () -> Type -> Type) (Const i :: () -> Type) (Const1 (ProviderEff_ i sh sf eh ef) :: () -> Type -> Type) Source #

newtype ProviderEff_ i (sh :: EffectH) (sf :: EffectF) (eh :: [EffectH]) (ef :: [EffectF]) a Source #

Constructors

ProviderEff_ 

Fields

runProvider :: forall {k} ctx i (sh :: k -> EffectH) (sf :: k -> EffectF) (eh :: [EffectH]) (ef :: [EffectF]). (forall (p :: k) x. i p -> Eff (sh p ': (Provide ctx i sh sf eh ef ': eh)) (sf p ': ef) x -> Eff (Provide ctx i sh sf eh ef ': eh) ef (ctx p x)) -> Eff (Provide ctx i sh sf eh ef ': eh) ef ~> Eff eh ef Source #

Interpret the Provider effect using the given effect interpreter.

runProvider_ :: forall i (sh :: (Type -> Type) -> Type -> Type) (sf :: EffectF) (eh :: [EffectH]) (ef :: [EffectF]). HFunctor sh => (forall x. i -> Eff (sh ': (Provide_ i sh sf eh ef ': eh)) (sf ': ef) x -> Eff (Provide_ i sh sf eh ef ': eh) ef x) -> Eff (Provide_ i sh sf eh ef ': eh) ef ~> Eff eh ef Source #

Interpret the Provider effect using the given effect interpreter. A version of runProvider where the type of Provider is simpler.

scope :: forall {k1} {k2} (key :: k1) ctx i (p :: k2) (eh :: [EffectH]) (ef :: [EffectF]) a (sh :: k2 -> EffectH) (sf :: k2 -> EffectF) (bh :: [EffectH]) (bf :: [EffectF]). (MemberHBy (ProviderKey ctx i) (Provider' ctx i (ProviderEff ctx i sh sf bh bf)) eh, HFunctor (sh p)) => i p -> ((Eff eh ef ~> Eff ((key ##> sh p) ': (Provide ctx i sh sf bh bf ': bh)) ((key #> sf p) ': bf)) -> Eff ((key ##> sh p) ': (Provide ctx i sh sf bh bf ': bh)) ((key #> sf p) ': bf) a) -> Eff eh ef (ctx p a) Source #

Introduces a new local scope that provides effects sh p and sf p parameterized by i p value and with results wrapped in ctx p.

scope_ :: forall {k1} {k2} (key :: k1) i (eh :: [EffectH]) (ef :: [EffectF]) a (sh :: EffectH) (sf :: EffectF) (bh :: [EffectH]) (bf :: [EffectF]). (MemberHBy (ProviderKey (Const1 Identity :: () -> Type -> Type) (Const i :: () -> Type)) (Provider' (Const1 Identity :: k2 -> Type -> Type) (Const i :: k2 -> Type) (Const1 (ProviderEff_ i sh sf bh bf) :: k2 -> Type -> Type)) eh, HFunctor sh) => i -> ((Eff eh ef ~> Eff ((key ##> sh) ': (Provide_ i sh sf bh bf ': bh)) ((key #> sf) ': bf)) -> Eff ((key ##> sh) ': (Provide_ i sh sf bh bf ': bh)) ((key #> sf) ': bf) a) -> Eff eh ef a Source #

Introduces a new local scope that provides effects sh and sf parameterized by i value.