eff-0.0.0.0
Safe HaskellNone
LanguageHaskell2010

Control.Effect.Internal

Synopsis

Documentation

axiom :: a :~: b Source #

pattern Any :: forall a. a -> Any Source #

A restricted form of unsafeCoerce that only works for converting to/from Any. Still just as unsafe, but makes it slightly more difficult to accidentally misuse.

anyCo :: forall a. Coercion a Any Source #

null# :: Any Source #

Used to explicitly overwrite references to values that should not be retained by the GC.

data Dict c Source #

Constructors

c => Dict 

type family DictRep c Source #

Instances

Instances details
type DictRep (effs1 :<< effs2) Source # 
Instance details

Defined in Control.Effect.Internal

type DictRep (effs1 :<< effs2) = Int
type DictRep (eff :< effs) Source # 
Instance details

Defined in Control.Effect.Internal

type DictRep (eff :< effs) = Int

newtype WithDict c r Source #

Constructors

WithDict 

Fields

reflectDict :: forall c r. DictRep c -> (c => r) -> r Source #

type Effect = (Type -> Type) -> Type -> Type Source #

The kind of effects.

class eff :< effs where Source #

Instances

Instances details
eff :< effs => eff :< (eff' ': effs) Source # 
Instance details

Defined in Control.Effect.Internal

eff :< (eff ': effs) Source # 
Instance details

Defined in Control.Effect.Internal

type DictRep (eff :< effs) Source # 
Instance details

Defined in Control.Effect.Internal

type DictRep (eff :< effs) = Int

class effs1 :<< effs2 where Source #

Instances

Instances details
(effs2 ~ (eff ': effs3), effs1 :<< effs3) => effs1 :<< effs2 Source # 
Instance details

Defined in Control.Effect.Internal

effs :<< effs Source # 
Instance details

Defined in Control.Effect.Internal

type DictRep (effs1 :<< effs2) Source # 
Instance details

Defined in Control.Effect.Internal

type DictRep (effs1 :<< effs2) = Int

newtype eff :<# effs Source #

Constructors

ReflectIndex# 

Fields

pattern IndexDict# :: forall eff effs. () => eff :< effs => eff :<# effs Source #

newtype Eff effs a Source #

All eff computations operate in the Eff monad. Eff computations are parameterized by a type-level list that specifies which effects they are allowed to perform. For example, a computation of type Eff '[Error e, Reader r, State s] a can raise exceptions of type e, can access a global environment of type r, and can read and modify a single cell of mutable state of type s.

To run an Eff computation that performs effects, the effects must be explicitly handled. Functions that handle effects are called effect handlers, and they usually have types like the following:

runX :: Eff (X ': effs) a -> Eff effs a

Note that the argument to runX can perform the X effect, but the result cannot! Any X operations have been handled by runX, which interprets their meaning. Examples of effect handlers include runError, runReader, and runState.

After all effects have been handled, the resulting computation will have type Eff '[] a, a computation that performs no effects. A computation with this type is pure, so it can be converted to an ordinary value using run.

Some effects cannot be handled locally, but instead require performing I/O. These effects will delegate to the IOE effect, which provides low-level interop with Haskell’s built-in IO monad. After all other effects have been handled, a computation of type Eff '[IOE] a can be converted to an ordinary IO a computation using runIO.

Constructors

Eff# 

Fields

Instances

Instances details
Monad (Eff effs) Source # 
Instance details

Defined in Control.Effect.Internal

Methods

(>>=) :: Eff effs a -> (a -> Eff effs b) -> Eff effs b #

(>>) :: Eff effs a -> Eff effs b -> Eff effs b #

return :: a -> Eff effs a #

Functor (Eff effs) Source # 
Instance details

Defined in Control.Effect.Internal

Methods

fmap :: (a -> b) -> Eff effs a -> Eff effs b #

(<$) :: a -> Eff effs b -> Eff effs a #

Applicative (Eff effs) Source # 
Instance details

Defined in Control.Effect.Internal

Methods

pure :: a -> Eff effs a #

(<*>) :: Eff effs (a -> b) -> Eff effs a -> Eff effs b #

liftA2 :: (a -> b -> c) -> Eff effs a -> Eff effs b -> Eff effs c #

(*>) :: Eff effs a -> Eff effs b -> Eff effs b #

(<*) :: Eff effs a -> Eff effs b -> Eff effs a #

IOE :< effs => MonadIO (Eff effs) Source # 
Instance details

Defined in Control.Effect.Internal

Methods

liftIO :: IO a -> Eff effs a #

NonDet :< effs => Alternative (Eff effs) Source # 
Instance details

Defined in Control.Effect.Internal

Methods

empty :: Eff effs a #

(<|>) :: Eff effs a -> Eff effs a -> Eff effs a #

some :: Eff effs a -> Eff effs [a] #

many :: Eff effs a -> Eff effs [a] #

pattern Eff :: (Registers -> IO (Registers, a)) -> Eff effs a Source #

newtype EVM a Source #

Constructors

EVM# 

Fields

Instances

Instances details
Monad EVM Source # 
Instance details

Defined in Control.Effect.Internal

Methods

(>>=) :: EVM a -> (a -> EVM b) -> EVM b #

(>>) :: EVM a -> EVM b -> EVM b #

return :: a -> EVM a #

Functor EVM Source # 
Instance details

Defined in Control.Effect.Internal

Methods

fmap :: (a -> b) -> EVM a -> EVM b #

(<$) :: a -> EVM b -> EVM a #

Applicative EVM Source # 
Instance details

Defined in Control.Effect.Internal

Methods

pure :: a -> EVM a #

(<*>) :: EVM (a -> b) -> EVM a -> EVM b #

liftA2 :: (a -> b -> c) -> EVM a -> EVM b -> EVM c #

(*>) :: EVM a -> EVM b -> EVM b #

(<*) :: EVM a -> EVM b -> EVM a #

MonadIO EVM Source # 
Instance details

Defined in Control.Effect.Internal

Methods

liftIO :: IO a -> EVM a #

data Result a Source #

Constructors

Result Registers# ~a 

pattern EVM :: (Registers -> IO (Registers, a)) -> EVM a Source #

newtype Registers# Source #

Constructors

Registers# (# PromptId, Targets# #) 

newtype PromptId Source #

Constructors

PromptId# Int# 

pattern PromptId :: Int -> PromptId Source #

data Capture a where Source #

Constructors

Capture 

Fields

  • :: PromptId

    The prompt to capture up to.

  • -> CaptureMode
     
  • -> ((b -> EVM c) -> EVM d)

    The replacement continuation passed by the user to the original call to control. This should be invoked with the fully-composed continuation after capturing is complete.

  • -> (b -> EVM a)

    The composed continuation captured so far.

  • -> Capture a
     

data CaptureMode Source #

Constructors

IncludePrompt

The captured continuation should include the prompt being captured up to. This mode corresponds to the control operator.

ExcludePrompt

The captured continuation should include frames up to the the prompt, but not the prompt itself. This mode corresponds to the control0 operator.

captureVM :: forall a b. Capture a -> IO b Source #

promptVM Source #

Arguments

:: IO (Registers, a) 
-> (a -> IO b)

return handler

-> (PromptId -> Any -> IO b)

abort handler

-> (Capture a -> IO b)

capture handler

-> IO b 

Runs an EVM action with a new prompt installed. The arguments specify what happens when control exits the action.

promptVM_ Source #

Arguments

:: IO (Registers, a) 
-> Registers

registers to restore on normal return

-> (Capture a -> IO (Registers, a))

capture handler

-> IO (Registers, a) 

Like promptVM, but for prompts that cannot be the target of a capture or abort (that is, prompts that only install winders/unwinders).

controlVM :: ((a -> EVM b) -> IO (Registers, b)) -> IO (Registers, a) Source #

newtype Targets# Source #

Constructors

Targets# (SmallArray# Any) 

newtype Targets Source #

Constructors

Targets (SmallArray Any) 

lookupTarget :: forall effs eff. (DebugCallStack, eff :< effs) => Targets -> Handler eff Source #

run :: Eff '[] a -> a Source #

Runs a pure Eff computation to produce a value.

>>> run $ pure 42
42
>>> run $ runError $ throw "bang"
Left "bang"

newtype Handle eff effs i r effs' a Source #

The monad that effect handlers run in.

  • The eff parameter is the effect being handled, and the effs parameter includes the other effects in scope at the point of the handle call (used by liftH).
  • The i parameter is the return type of the handled computation before the exit handler has been applied (used by control0).
  • The r parameter is the final return type of the handled computation (used by abort, control, and control0).
  • The effs' parameter is the list of effects in scope at the point of the originating send call (used by locally).

See handle for more details.

Constructors

Handle# 

Fields

Instances

Instances details
Monad (Handle eff effs i r effs') Source # 
Instance details

Defined in Control.Effect.Internal

Methods

(>>=) :: Handle eff effs i r effs' a -> (a -> Handle eff effs i r effs' b) -> Handle eff effs i r effs' b #

(>>) :: Handle eff effs i r effs' a -> Handle eff effs i r effs' b -> Handle eff effs i r effs' b #

return :: a -> Handle eff effs i r effs' a #

Functor (Handle eff effs i r effs') Source # 
Instance details

Defined in Control.Effect.Internal

Methods

fmap :: (a -> b) -> Handle eff effs i r effs' a -> Handle eff effs i r effs' b #

(<$) :: a -> Handle eff effs i r effs' b -> Handle eff effs i r effs' a #

Applicative (Handle eff effs i r effs') Source # 
Instance details

Defined in Control.Effect.Internal

Methods

pure :: a -> Handle eff effs i r effs' a #

(<*>) :: Handle eff effs i r effs' (a -> b) -> Handle eff effs i r effs' a -> Handle eff effs i r effs' b #

liftA2 :: (a -> b -> c) -> Handle eff effs i r effs' a -> Handle eff effs i r effs' b -> Handle eff effs i r effs' c #

(*>) :: Handle eff effs i r effs' a -> Handle eff effs i r effs' b -> Handle eff effs i r effs' b #

(<*) :: Handle eff effs i r effs' a -> Handle eff effs i r effs' b -> Handle eff effs i r effs' a #

pattern Handle :: (Registers -> Eff effs' a) -> Handle eff effs i r effs' a Source #

newtype Handler eff Source #

Constructors

Handler# 

Fields

newtype WrappedHandler eff Source #

Constructors

WrapHandler (forall effs a. eff :< effs => eff (Eff effs) a -> Eff effs a) 

pattern Handler :: (forall effs a. eff :< effs => eff (Eff effs) a -> Eff effs a) -> Handler eff Source #

send :: forall eff a effs. eff :< effs => eff (Eff effs) a -> Eff effs a Source #

handle Source #

Arguments

:: (a -> Eff effs r)

The exit handler, aka the action to take on normal returns (often just pure).

-> (forall effs' b. eff :< effs' => eff (Eff effs') b -> Handle eff effs a r effs' b)

The handler function.

-> Eff (eff ': effs) a

The action to handle.

-> Eff effs r 

Handles the topmost effect in an Eff computation. The given handler function must provide an interpretation for each effectful operation. The handler runs in the restrictive Handle monad, which generally uses one of the following core Handle operations:

  • liftH — Runs an action in the context of the original handle call. This is the most common way to handle an effect.
  • abort — Aborts the computation to the handle call and returns a value directly. This is usually used to implement exception-like operations.
  • control — Captures the current continuation up to and including the handle call and aborts, passing the captured continuation to the handler. This can be used to implement complex control operators such as coroutines or resumable exceptions.
  • control0 — Like control, but does not include the handle call itself in the captured continuation, so a different handler may be installed before resuming the computation.
  • locally — Runs an action directly in the context of the originating send call. This can be used to implement “scoped” operations like local and catch.

See the documentation for each of the above functions for examples and more details.

handleVM :: forall eff a r effs. (a -> Eff effs r) -> (Registers# -> Handler eff) -> Eff (eff ': effs) a -> Eff effs r Source #

locally :: Eff effs' a -> Handle eff effs i r effs' a Source #

liftH :: Eff (eff ': effs) a -> Handle eff effs i r effs' a Source #

abort :: r -> Handle eff effs i r effs' a Source #

control :: ((a -> Eff effs r) -> Eff effs r) -> Handle eff effs i r effs' a Source #

control0 :: ((a -> Eff (eff ': effs) i) -> Eff effs r) -> Handle eff effs i r effs' a Source #

class Lift effs1 effs2 where Source #

Instances

Instances details
effs1 :<< effs2 => Lift effs1 effs2 Source # 
Instance details

Defined in Control.Effect.Internal

Lift ('[] :: [Effect]) effs Source # 
Instance details

Defined in Control.Effect.Internal

(eff :< effs2, Lift effs1 effs2) => Lift (eff ': effs1) effs2 Source # 
Instance details

Defined in Control.Effect.Internal

lift :: forall effs1 effs2 a. Lift effs1 effs2 => Eff effs1 a -> Eff effs2 a Source #

Lifts an Eff computation into one that performs all the same effects, and possibly more. For example, if you have a computation

m :: Eff '[Foo, Bar] ()

then lift will transform it into a polymorphic computation with the following type:

lift m :: (Foo :< effs, Bar :< effs) => Eff effs ()

This type is much more general, and effs can now be instantiated at many different types. Generally, lift can manipulate the list of effects in any of the following ways:

  • Effects can be reordered.
  • New effects can be inserted anywhere in the list.
  • Duplicate effects can be collapsed.

More generally, the list of effects doesn’t need to be entirely concrete in order for lift to work. For example, if you have a computation

n :: Eff (Foo ': Bar ': effs1) ()

then lift n will have the following type:

lift n :: (Foo :< effs2, Bar :< effs2, effs1 :<< effs2) => Eff effs2 ()

This type is extremely general, and it allows lift to manipulate the head of the effects list even if the entire list is not completely known.

The Lift typeclass provides some type-level programming machinery to implement lift, but it should be treated as an implementation detail. In most situations, the machinery should “just work,” but if it doesn’t, the type errors can be somewhat inscrutable. In those situations, adding some explicit type annotations (or using TypeApplications) can improve the type errors significantly.

lift1 :: forall eff effs a. Eff effs a -> Eff (eff ': effs) a Source #

Like lift, but restricted to introducing a single additional effect in the result. This is behaviorally identical to just using lift, but the restricted type can produce better type inference.

data IOE :: Effect where Source #

An effect used to run IO operations via liftIO. Handled by the special runIO handler.

Constructors

LiftIO :: IO a -> IOE m a 

unsafeIOToEff :: IO a -> Eff effs a Source #

runIO :: Eff '[IOE] a -> IO a Source #

Converts an Eff computation to IO. Unlike most handlers, IOE must be the final effect handled, and runIO completely replaces the call to run.

data State s :: Effect where Source #

The State s effect provides access to a single cell of mutable state of type s.

Constructors

Get :: State s m s 
Put :: ~s -> State s m () 

evalState :: s -> Eff (State s ': effs) a -> Eff effs a Source #

data NonDet :: Effect where Source #

The NonDet effect provides so-called nondeterministic execution, which runs all branches of a computation and collects some or all of their results. Actual execution is not usually truly nondeterministic in the sense that it is somehow random; rather, NonDet models nondeterministic binary choice by executing both possibilities rather than choosing just one.

Constructors

Empty :: NonDet m a 
Choose :: NonDet m Bool