data-effects-0.4.2.0: A basic framework for effect systems based on effects represented by GADTs.
Copyright(c) 2025 Sayo contributors
LicenseMPL-2.0 (see the LICENSE file)
Maintainerymdfield@outlook.jp
Safe HaskellNone
LanguageGHC2021

Data.Effect.Shift

Description

 

Documentation

data Shift ans (ref :: Type -> Type) (a :: Type -> Type) b where Source #

Constructors

SubShiftFork :: forall ans (ref :: Type -> Type) (a :: Type -> Type) a1. Shift ans ref a (Either (ref a1) a1) 
Call :: forall (ref :: Type -> Type) a1 ans (a :: Type -> Type). ref a1 -> a1 -> Shift ans ref a ans 
Abort :: forall ans (ref :: Type -> Type) (a :: Type -> Type) b. ans -> Shift ans ref a b 

Instances

Instances details
FirstOrder (Shift ans ref) Source # 
Instance details

Defined in Data.Effect.Shift

PolyHFunctor (Shift ans ref) Source # 
Instance details

Defined in Data.Effect.Shift

HFunctor (Shift ans ref) Source # 
Instance details

Defined in Data.Effect.Shift

Methods

hfmap :: (forall x. f x -> g x) -> Shift ans ref f a -> Shift ans ref g a #

type FormOf (Shift ans ref) Source # 
Instance details

Defined in Data.Effect.Shift

type FormOf (Shift ans ref) = 'Polynomial
type LabelOf (Shift ans ref) Source # 
Instance details

Defined in Data.Effect.Shift

type LabelOf (Shift ans ref) = ShiftLabel
type OrderOf (Shift ans ref) Source # 
Instance details

Defined in Data.Effect.Shift

type OrderOf (Shift ans ref) = 'FirstOrder

subShiftFork :: forall ans ref a f (es :: [Effect]) (ff :: (Type -> Type) -> Type -> Type) (c :: (Type -> Type) -> Constraint). (Free c ff, f ~ Eff ff es, Shift ans ref :> es) => f (Either (ref a) a) Source #

subShiftFork' :: forall {k} (key :: k) ans ref a f (es :: [Effect]) (ff :: (Type -> Type) -> Type -> Type) (c :: (Type -> Type) -> Constraint). (Free c ff, f ~ Eff ff es, Has key (Shift ans ref) es) => f (Either (ref a) a) Source #

subShiftFork'' :: forall {k} (tag :: k) ans ref a f (es :: [Effect]) (ff :: (Type -> Type) -> Type -> Type) (c :: (Type -> Type) -> Constraint). (Free c ff, f ~ Eff ff es, Tagged tag (Shift ans ref) :> es) => f (Either (ref a) a) Source #

subShiftFork'_ :: forall ans ref a f (es :: [Effect]) (ff :: (Type -> Type) -> Type -> Type) (c :: (Type -> Type) -> Constraint). (Free c ff, f ~ Eff ff es, In (Shift ans ref) es) => f (Either (ref a) a) Source #

call :: forall ref a ans f (es :: [Effect]) (ff :: (Type -> Type) -> Type -> Type) (c :: (Type -> Type) -> Constraint). (Free c ff, f ~ Eff ff es, Shift ans ref :> es) => ref a -> a -> f ans Source #

call' :: forall {k} (key :: k) ref a ans f (es :: [Effect]) (ff :: (Type -> Type) -> Type -> Type) (c :: (Type -> Type) -> Constraint). (Free c ff, f ~ Eff ff es, Has key (Shift ans ref) es) => ref a -> a -> f ans Source #

call'' :: forall {k} (tag :: k) ref a ans f (es :: [Effect]) (ff :: (Type -> Type) -> Type -> Type) (c :: (Type -> Type) -> Constraint). (Free c ff, f ~ Eff ff es, Tagged tag (Shift ans ref) :> es) => ref a -> a -> f ans Source #

call'_ :: forall ref a ans f (es :: [Effect]) (ff :: (Type -> Type) -> Type -> Type) (c :: (Type -> Type) -> Constraint). (Free c ff, f ~ Eff ff es, In (Shift ans ref) es) => ref a -> a -> f ans Source #

abort :: forall ans (ref :: Type -> Type) a f (es :: [Effect]) (ff :: (Type -> Type) -> Type -> Type) (c :: (Type -> Type) -> Constraint). (Free c ff, f ~ Eff ff es, Shift ans ref :> es) => ans -> f a Source #

abort' :: forall {k} (key :: k) ans (ref :: Type -> Type) a f (es :: [Effect]) (ff :: (Type -> Type) -> Type -> Type) (c :: (Type -> Type) -> Constraint). (Free c ff, f ~ Eff ff es, Has key (Shift ans ref) es) => ans -> f a Source #

abort'' :: forall {k} (tag :: k) ans (ref :: Type -> Type) a f (es :: [Effect]) (ff :: (Type -> Type) -> Type -> Type) (c :: (Type -> Type) -> Constraint). (Free c ff, f ~ Eff ff es, Tagged tag (Shift ans ref) :> es) => ans -> f a Source #

abort'_ :: forall ans (ref :: Type -> Type) a f (es :: [Effect]) (ff :: (Type -> Type) -> Type -> Type) (c :: (Type -> Type) -> Constraint). (Free c ff, f ~ Eff ff es, In (Shift ans ref) es) => ans -> f a Source #

subShift :: forall a b (es :: [Effect]) ans ref (ff :: (Type -> Type) -> Type -> Type) (c :: (Type -> Type) -> Constraint). (Shift ans ref :> es, Monad (Eff ff es), Free c ff) => (ref a -> Eff ff es b) -> (a -> Eff ff es b) -> Eff ff es b Source #

shift :: forall a (es :: [Effect]) ans (ref :: Type -> Type) (ff :: (Type -> Type) -> Type -> Type) (c :: (Type -> Type) -> Constraint). (Shift ans ref :> es, Monad (Eff ff es), Free c ff) => ((a -> Eff ff es ans) -> Eff ff es ans) -> Eff ff es a Source #

getShiftCC :: forall (es :: [Effect]) ans (ref :: Type -> Type) (ff :: (Type -> Type) -> Type -> Type) (c :: (Type -> Type) -> Constraint). (Shift ans ref :> es, Monad (Eff ff es), Free c ff) => Eff ff es (Eff ff es ans) Source #

runCCAsShift :: forall a (es :: [Effect]) ans (ref :: Type -> Type) (ff :: (Type -> Type) -> Type -> Type) (c :: (Type -> Type) -> Constraint). (Shift ans ref :> es, Monad (Eff ff es), Free c ff) => Eff ff (CC ref ': es) a -> Eff ff es a Source #

runCCOnShift :: forall a (es :: [Effect]) ans (ref :: Type -> Type) (ff :: (Type -> Type) -> Type -> Type) (c :: (Type -> Type) -> Constraint). (Shift ans ref :> es, Monad (Eff ff es), Free c ff) => Eff ff (CC (Op (Eff ff es ans)) ': es) a -> Eff ff es a Source #