cleff-0.3.2.0: Fast and concise extensible effects
Copyright(c) 2021 Xy Ren
LicenseBSD3
Maintainerxy.r@outlook.com
Stabilityunstable
Portabilitynon-portable (GHC only)
Safe HaskellNone
LanguageHaskell2010

Cleff.Internal.Monad

Description

This module contains the definition of the Eff monad. Most of the times, you won't need to use this module directly; user-facing functionalities are all exported via the Cleff module.

This is an internal module and its API may change even between minor versions. Therefore you should be extra careful if you're to depend on this module.

Synopsis

The Eff monad

newtype InternalHandler e Source #

The internal representation of effect handlers. This is just a natural transformation from the effect type e (Eff es) to the effect monad Eff es for any effect stack es.

In interpreting functions (see Cleff.Internal.Interpret), the user-facing Handler type is transformed into this type.

Constructors

InternalHandler 

Fields

newtype Eff es a Source #

The extensible effects monad. The monad Eff es is capable of performing any effect in the effect stack es, which is a type-level list that holds all effects available.

The best practice is to always use a polymorphic type variable for the effect stack es, and then use the type operators (:>) and (:>>) in constraints to indicate what effects are available in the stack. For example,

(Reader String :> es, State Bool :> es) => Eff es Integer

means you can perform operations of the Reader String effect and the State Bool effect in a computation returning an Integer. The reason why you should always use a polymorphic effect stack as opposed to a concrete list of effects are that

  • it can contain other effects that are used by computations other than the current one, and
  • it does not require you to run the effects in any particular order.

Constructors

Eff

The effect monad receives an effect environment Env that contains all effect handlers and produces an IO action.

Fields

Instances

Instances details
IOE :> es => MonadBase IO (Eff es) Source #

Compatibility instance; use MonadIO if possible.

Instance details

Defined in Cleff.Internal.Base

Methods

liftBase :: IO α -> Eff es α #

IOE :> es => MonadBaseControl IO (Eff es) Source #

Compatibility instance; use MonadUnliftIO if possible.

Instance details

Defined in Cleff.Internal.Base

Associated Types

type StM (Eff es) a #

Methods

liftBaseWith :: (RunInBase (Eff es) IO -> IO a) -> Eff es a #

restoreM :: StM (Eff es) a -> Eff es a #

Monad (Eff es) Source # 
Instance details

Defined in Cleff.Internal.Monad

Methods

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

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

return :: a -> Eff es a #

Functor (Eff es) Source # 
Instance details

Defined in Cleff.Internal.Monad

Methods

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

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

MonadFix (Eff es) Source # 
Instance details

Defined in Cleff.Internal.Monad

Methods

mfix :: (a -> Eff es a) -> Eff es a #

Fail :> es => MonadFail (Eff es) Source # 
Instance details

Defined in Cleff.Fail

Methods

fail :: String -> Eff es a #

Applicative (Eff es) Source # 
Instance details

Defined in Cleff.Internal.Monad

Methods

pure :: a -> Eff es a #

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

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

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

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

MonadZip (Eff es) Source #

Compatibility instance for MonadComprehensions.

Since: 0.2.1.0

Instance details

Defined in Cleff.Internal.Instances

Methods

mzip :: Eff es a -> Eff es b -> Eff es (a, b) #

mzipWith :: (a -> b -> c) -> Eff es a -> Eff es b -> Eff es c #

munzip :: Eff es (a, b) -> (Eff es a, Eff es b) #

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

Defined in Cleff.Internal.Base

Methods

liftIO :: IO a -> Eff es a #

IOE :> es => MonadThrow (Eff es) Source # 
Instance details

Defined in Cleff.Internal.Base

Methods

throwM :: Exception e => e -> Eff es a #

IOE :> es => MonadCatch (Eff es) Source # 
Instance details

Defined in Cleff.Internal.Base

Methods

catch :: Exception e => Eff es a -> (e -> Eff es a) -> Eff es a #

IOE :> es => MonadMask (Eff es) Source # 
Instance details

Defined in Cleff.Internal.Base

Methods

mask :: ((forall a. Eff es a -> Eff es a) -> Eff es b) -> Eff es b #

uninterruptibleMask :: ((forall a. Eff es a -> Eff es a) -> Eff es b) -> Eff es b #

generalBracket :: Eff es a -> (a -> ExitCase b -> Eff es c) -> (a -> Eff es b) -> Eff es (b, c) #

IOE :> es => PrimMonad (Eff es) Source # 
Instance details

Defined in Cleff.Internal.Base

Associated Types

type PrimState (Eff es) #

Methods

primitive :: (State# (PrimState (Eff es)) -> (# State# (PrimState (Eff es)), a #)) -> Eff es a #

IOE :> es => MonadUnliftIO (Eff es) Source # 
Instance details

Defined in Cleff.Internal.Base

Methods

withRunInIO :: ((forall a. Eff es a -> IO a) -> IO b) -> Eff es b #

Bounded a => Bounded (Eff es a) Source #

Since: 0.2.1.0

Instance details

Defined in Cleff.Internal.Instances

Methods

minBound :: Eff es a #

maxBound :: Eff es a #

Floating a => Floating (Eff es a) Source #

Since: 0.2.1.0

Instance details

Defined in Cleff.Internal.Instances

Methods

pi :: Eff es a #

exp :: Eff es a -> Eff es a #

log :: Eff es a -> Eff es a #

sqrt :: Eff es a -> Eff es a #

(**) :: Eff es a -> Eff es a -> Eff es a #

logBase :: Eff es a -> Eff es a -> Eff es a #

sin :: Eff es a -> Eff es a #

cos :: Eff es a -> Eff es a #

tan :: Eff es a -> Eff es a #

asin :: Eff es a -> Eff es a #

acos :: Eff es a -> Eff es a #

atan :: Eff es a -> Eff es a #

sinh :: Eff es a -> Eff es a #

cosh :: Eff es a -> Eff es a #

tanh :: Eff es a -> Eff es a #

asinh :: Eff es a -> Eff es a #

acosh :: Eff es a -> Eff es a #

atanh :: Eff es a -> Eff es a #

log1p :: Eff es a -> Eff es a #

expm1 :: Eff es a -> Eff es a #

log1pexp :: Eff es a -> Eff es a #

log1mexp :: Eff es a -> Eff es a #

Fractional a => Fractional (Eff es a) Source #

Since: 0.2.1.0

Instance details

Defined in Cleff.Internal.Instances

Methods

(/) :: Eff es a -> Eff es a -> Eff es a #

recip :: Eff es a -> Eff es a #

fromRational :: Rational -> Eff es a #

Num a => Num (Eff es a) Source #

Since: 0.2.1.0

Instance details

Defined in Cleff.Internal.Instances

Methods

(+) :: Eff es a -> Eff es a -> Eff es a #

(-) :: Eff es a -> Eff es a -> Eff es a #

(*) :: Eff es a -> Eff es a -> Eff es a #

negate :: Eff es a -> Eff es a #

abs :: Eff es a -> Eff es a #

signum :: Eff es a -> Eff es a #

fromInteger :: Integer -> Eff es a #

IsString a => IsString (Eff es a) Source #

Since: 0.2.1.0

Instance details

Defined in Cleff.Internal.Instances

Methods

fromString :: String -> Eff es a #

Semigroup a => Semigroup (Eff es a) Source #

Since: 0.2.1.0

Instance details

Defined in Cleff.Internal.Instances

Methods

(<>) :: Eff es a -> Eff es a -> Eff es a #

sconcat :: NonEmpty (Eff es a) -> Eff es a #

stimes :: Integral b => b -> Eff es a -> Eff es a #

Monoid a => Monoid (Eff es a) Source #

Since: 0.2.1.0

Instance details

Defined in Cleff.Internal.Instances

Methods

mempty :: Eff es a #

mappend :: Eff es a -> Eff es a -> Eff es a #

mconcat :: [Eff es a] -> Eff es a #

type PrimState (Eff es) Source # 
Instance details

Defined in Cleff.Internal.Base

type PrimState (Eff es) = RealWorld
type StM (Eff es) a Source # 
Instance details

Defined in Cleff.Internal.Base

type StM (Eff es) a = a

Effect environment

data Env (es :: [Effect]) Source #

The effect environment that corresponds effects in the stack to their respective InternalHandlers. This structure simulates memory: handlers are retrieved via pointers (HandlerPtrs), and for each effect in the stack we can either change what pointer it uses or change the handler the pointer points to. The former is used for global effect interpretation (reinterpretN) and the latter for local interpretation (toEffWith) in order to retain correct HO semantics. For more details on this see https://github.com/re-xyr/cleff/issues/5.

data HandlerPtr (e :: Effect) Source #

A pointer to an effect handler.

emptyEnv :: Env '[] Source #

Create an empty Env with no address allocated.

adjustEnv :: forall es' es. (Rec es -> Rec es') -> Env es -> Env es' Source #

Adjust the effect stack via an function over Rec.

allocaEnv :: forall e es. Env es -> (# HandlerPtr e, Env es #) Source #

Allocate a new, empty address for a handler. \( O(1) \).

readEnv :: forall e es. e :> es => Env es -> InternalHandler e Source #

Read the handler a pointer points to. \( O(1) \).

writeEnv :: forall e es. HandlerPtr e -> InternalHandler e -> Env es -> Env es Source #

Overwrite the handler a pointer points to. \( O(1) \).

replaceEnv :: forall e es. e :> es => HandlerPtr e -> InternalHandler e -> Env es -> Env es Source #

Replace the handler pointer of an effect in the stack. \( O(n) \).

appendEnv :: forall e es. HandlerPtr e -> InternalHandler e -> Env es -> Env (e ': es) Source #

Add a new effect to the stack with its corresponding handler pointer. \( O(n) \).

updateEnv :: forall es es'. Env es' -> Env es -> Env es Source #

Use the state of LHS as a newer version for RHS. \( O(1) \).

Constraints on effect stacks

class (e :: Effect) :> (es :: [Effect]) infix 0 Source #

e :> es means the effect e is present in the effect stack es, and therefore can be sended in an Eff es computation.

Instances

Instances details
(TypeError (ElemNotFound e) :: Constraint) => e :> ('[] :: [Effect]) Source # 
Instance details

Defined in Cleff.Internal.Rec

Methods

reifyIndex :: Int

e :> es => e :> (e' ': es) Source # 
Instance details

Defined in Cleff.Internal.Rec

Methods

reifyIndex :: Int

e :> (e ': es) Source #

The element closer to the head takes priority.

Instance details

Defined in Cleff.Internal.Rec

Methods

reifyIndex :: Int

type family xs :>> es :: Constraint where ... infix 0 Source #

xs :>> es means the list of effects xs are all present in the effect stack es. This is a convenient type alias for (e1 :> es, ..., en :> es).

Equations

'[] :>> _ = () 
(x ': xs) :>> es = (x :> es, xs :>> es) 

class KnownList (es :: [Effect]) Source #

KnownList es means the list es is concrete, i.e. is of the form '[a1, a2, ..., an] instead of a type variable.

Instances

Instances details
KnownList ('[] :: [Effect]) Source # 
Instance details

Defined in Cleff.Internal.Rec

Methods

reifyLen :: Int

KnownList es => KnownList (e ': es) Source # 
Instance details

Defined in Cleff.Internal.Rec

Methods

reifyLen :: Int

class KnownList es => Subset (es :: [Effect]) (es' :: [Effect]) Source #

es is a subset of es', i.e. all elements of es are in es'.

Instances

Instances details
Subset ('[] :: [Effect]) es Source # 
Instance details

Defined in Cleff.Internal.Rec

Methods

reifyIndices :: [Int]

(Subset es es', e :> es') => Subset (e ': es) es' Source # 
Instance details

Defined in Cleff.Internal.Rec

Methods

reifyIndices :: [Int]

Performing effect operations

send :: e :> es => e (Eff es) ~> Eff es Source #

Perform an effect operation, i.e. a value of an effect type e :: Effect. This requires e to be in the effect stack.

sendVia :: e :> es' => (Eff es ~> Eff es') -> e (Eff es) ~> Eff es' Source #

Perform an action in another effect stack via a transformation to that stack; in other words, this function "maps" the effect operation from effect stack es to es'. This is a largely generalized version of send; only use this if you are sure about what you're doing.

send = sendVia id

Since: 0.2.0.0