data-effects-0.4.2.0: A basic framework for effect systems based on effects represented by GADTs.
Copyright(c) 2016 Allele Dev; 2017 Ixperta Solutions s.r.o.; 2017 Alexis King
(c) 2023-2025 Sayo contributors
LicenseMPL-2.0 (see the file LICENSE)
Maintainerymdfield@outlook.jp
Safe HaskellNone
LanguageGHC2021

Data.Effect.Coroutine

Description

This module provides effects for the coroutine, comes from Control.Monad.Freer.Coroutine in the freer-simple package (The continuation part (b -> c) has been removed. If necessary, please manually compose the Coyoneda) .

Synopsis

Documentation

data Yield a b (c :: Type -> Type) d where Source #

An effect for coroutines. Realizes an operation that transfers control to the caller of the computation with coroutines along with a value of type a, and receives a value of type b from the caller.

Constructors

Yield :: forall a b (c :: Type -> Type). a -> Yield a b c b

Transfers control to the caller of the computation with coroutines along with a value of type a, and receives a value of type b from the caller.

Instances

Instances details
FirstOrder (Yield a b) Source # 
Instance details

Defined in Data.Effect.Coroutine

PolyHFunctor (Yield a b) Source # 
Instance details

Defined in Data.Effect.Coroutine

HFunctor (Yield a b) Source # 
Instance details

Defined in Data.Effect.Coroutine

Methods

hfmap :: (forall x. f x -> g x) -> Yield a b f a0 -> Yield a b g a0 #

type FormOf (Yield a b) Source # 
Instance details

Defined in Data.Effect.Coroutine

type FormOf (Yield a b) = 'Polynomial
type LabelOf (Yield a b) Source # 
Instance details

Defined in Data.Effect.Coroutine

type LabelOf (Yield a b) = YieldLabel
type OrderOf (Yield a b) Source # 
Instance details

Defined in Data.Effect.Coroutine

type OrderOf (Yield a b) = 'FirstOrder

yield :: forall a b f (es :: [Effect]) (ff :: (Type -> Type) -> Type -> Type) (c :: (Type -> Type) -> Constraint). (Free c ff, f ~ Eff ff es, Yield a b :> es) => a -> f b Source #

Transfers control to the caller of the computation with coroutines along with a value of type a, and receives a value of type b from the caller.

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

Transfers control to the caller of the computation with coroutines along with a value of type a, and receives a value of type b from the caller.

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

Transfers control to the caller of the computation with coroutines along with a value of type a, and receives a value of type b from the caller.

yield'_ :: forall a b f (es :: [Effect]) (ff :: (Type -> Type) -> Type -> Type) (c :: (Type -> Type) -> Constraint). (Free c ff, f ~ Eff ff es, In (Yield a b) es) => a -> f b Source #

Transfers control to the caller of the computation with coroutines along with a value of type a, and receives a value of type b from the caller.

data Status (f :: Type -> Type) a b r Source #

The execution result when handling a computation that includes the Yield effect. A computation that may include suspension. If the computation does not include yield, the completed result of the computation is obtained as Done. If the computation includes yield, execution is suspended at that point, and the value of type a thrown by yield and the continuation of the computation from the point of yield are obtained as Continue. By re-executing this continuation, you can resume the computation.

Constructors

Done r

The computation has completely finished

Continue a (b -> f (Status f a b r))

The computation has been suspended by yield

Instances

Instances details
Functor f => Functor (Status f a b) Source # 
Instance details

Defined in Data.Effect.Coroutine

Methods

fmap :: (a0 -> b0) -> Status f a b a0 -> Status f a b b0 #

(<$) :: a0 -> Status f a b b0 -> Status f a b a0 #

continueStatus Source #

Arguments

:: Monad m 
=> (x -> m (Status m a b r))

Additional continuation

-> Status m a b x

Computation status to extend

-> m (Status m a b r) 

Extends the computation result by appending the specified continuation.

loopStatus Source #

Arguments

:: Monad m 
=> (a -> m b)

Handler to resume computation from a suspended state.

-> Status m a b r

A computation that may include suspension.

-> m r 

Repeats the computation until the final result is obtained by continuing the computation using the specified handler each time it suspends.

inputToYield :: forall i (f :: Type -> Type) a. Input i f a -> Yield () i f a Source #

Converts the Input effect into the coroutine's Yield effect.

outputToYield :: forall o (f :: Type -> Type) a. Output o f a -> Yield o () f a Source #

Converts the Output effect into the coroutine's Yield effect.