effectful-core-2.2.2.2: An easy to use, performant extensible effects library.
Safe HaskellSafe-Inferred
LanguageHaskell2010

Effectful.Internal.Monad

Description

The Eff monad.

This module is intended for internal use only, and may change without warning in subsequent releases.

Synopsis

The Eff monad

data Eff (es :: [Effect]) a Source #

The Eff monad provides the implementation of a computation that performs an arbitrary set of effects. In Eff es a, es is a type-level list that contains all the effects that the computation may perform. For example, a computation that produces an Integer by consuming a String from the global environment and acting upon a single mutable value of type Bool would have the following type:

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

Abstracting over the list of effects with (:>):

  • Allows the computation to be used in functions that may perform other effects.
  • Allows the effects to be handled in any order.

Instances

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

Instance included for compatibility with existing code, usage of withRunInIO is preferrable.

Instance details

Defined in Effectful.Internal.Monad

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 #

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

Instance included for compatibility with existing code, usage of liftIO is preferrable.

Instance details

Defined in Effectful.Internal.Monad

Methods

liftBase :: IO α -> Eff es α #

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

Defined in Effectful.Internal.Monad

Methods

fail :: String -> Eff es a #

MonadFix (Eff es) Source # 
Instance details

Defined in Effectful.Internal.Monad

Methods

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

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

Defined in Effectful.Internal.Monad

Methods

liftIO :: IO a -> Eff es a #

NonDet :> es => Alternative (Eff es) Source #

Since: 2.2.0.0

Instance details

Defined in Effectful.Internal.Monad

Methods

empty :: Eff es a #

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

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

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

Applicative (Eff es) Source # 
Instance details

Defined in Effectful.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 #

Functor (Eff es) Source # 
Instance details

Defined in Effectful.Internal.Monad

Methods

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

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

Monad (Eff es) Source # 
Instance details

Defined in Effectful.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 #

NonDet :> es => MonadPlus (Eff es) Source #

Since: 2.2.0.0

Instance details

Defined in Effectful.Internal.Monad

Methods

mzero :: Eff es a #

mplus :: Eff es a -> Eff es a -> Eff es a #

MonadCatch (Eff es) Source # 
Instance details

Defined in Effectful.Internal.Monad

Methods

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

MonadMask (Eff es) Source # 
Instance details

Defined in Effectful.Internal.Monad

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) #

MonadThrow (Eff es) Source # 
Instance details

Defined in Effectful.Internal.Monad

Methods

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

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

Defined in Effectful.Internal.Monad

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 #

Use withEffToIO if you want accurate stack traces on errors.

Instance details

Defined in Effectful.Internal.Monad

Methods

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

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

Defined in Effectful.Internal.Monad

Methods

mempty :: Eff es a #

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

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

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

Defined in Effectful.Internal.Monad

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 #

type PrimState (Eff es) Source # 
Instance details

Defined in Effectful.Internal.Monad

type StM (Eff es) a Source # 
Instance details

Defined in Effectful.Internal.Monad

type StM (Eff es) a = a

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

Run a pure Eff computation.

For running computations with side effects see runEff.

Access to the internal representation

unEff :: Eff es a -> Env es -> IO a Source #

Peel off the constructor of Eff.

unsafeEff :: (Env es -> IO a) -> Eff es a Source #

Access the underlying IO monad along with the environment.

This function is unsafe because it can be used to introduce arbitrary IO actions into pure Eff computations.

unsafeEff_ :: IO a -> Eff es a Source #

Access the underlying IO monad.

This function is unsafe because it can be used to introduce arbitrary IO actions into pure Eff computations.

NonDet

data NonDet :: Effect where Source #

Provide the ability to use the Alternative and MonadPlus instance of Eff.

Since: 2.2.0.0

Constructors

Empty :: NonDet m a 
(:<|>:) :: m a -> m a -> NonDet m a 

Instances

Instances details
type DispatchOf NonDet Source # 
Instance details

Defined in Effectful.Internal.Monad

Fail

data Fail :: Effect where Source #

Provide the ability to use the MonadFail instance of Eff.

Constructors

Fail :: String -> Fail m a 

Instances

Instances details
type DispatchOf Fail Source # 
Instance details

Defined in Effectful.Internal.Monad

IO

data IOE :: Effect Source #

Run arbitrary IO computations via MonadIO or MonadUnliftIO.

Note: it is not recommended to use this effect in application code as it is too liberal. Ideally, this is only used in handlers of more fine-grained effects.

Instances

Instances details
type DispatchOf IOE Source # 
Instance details

Defined in Effectful.Internal.Monad

newtype StaticRep IOE Source # 
Instance details

Defined in Effectful.Internal.Monad

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

Run an Eff computation with side effects.

For running pure computations see runPureEff.

Prim

data Prim :: Effect Source #

Provide the ability to perform primitive state-transformer actions.

Instances

Instances details
type DispatchOf Prim Source # 
Instance details

Defined in Effectful.Internal.Monad

data StaticRep Prim Source # 
Instance details

Defined in Effectful.Internal.Monad

data PrimStateEff Source #

PrimState token for Eff. Used instead of RealWorld to prevent the Prim effect from executing arbitrary IO actions via ioToPrim.

runPrim :: IOE :> es => Eff (Prim ': es) a -> Eff es a Source #

Run an Eff computation with primitive state-transformer actions.

Lifting

raise :: Eff es a -> Eff (e ': es) a Source #

Lift an Eff computation into an effect stack with one more effect.

raiseWith Source #

Arguments

:: HasCallStack 
=> UnliftStrategy 
-> ((forall r. Eff (e ': es) r -> Eff es r) -> Eff es a)

Continuation with the unlifting function in scope.

-> Eff (e ': es) a 

Lift an Eff computation into an effect stack with one more effect and create an unlifting function with the given strategy.

Since: 1.2.0.0

subsume :: e :> es => Eff (e ': es) a -> Eff es a Source #

Eliminate a duplicate effect from the top of the effect stack.

inject :: Subset xs es => Eff xs a -> Eff es a Source #

Allow for running an effect stack xs within es as long as xs is a permutation (with possible duplicates) of a subset of es.

Generalizes raise and subsume.

>>> data E1 :: Effect
>>> data E2 :: Effect
>>> data E3 :: Effect

It makes it possible to rearrange the effect stack however you like:

>>> :{
  shuffle :: Eff (E3 : E1 : E2 : es) a -> Eff (E1 : E2 : E3 : es) a
  shuffle = inject
:}

It can also turn a monomorphic effect stack into a polymorphic one:

>>> :{
  toPoly :: (E1 :> es, E2 :> es, E3 :> es) => Eff [E1, E2, E3] a -> Eff es a
  toPoly = inject
:}

Moreover, it allows for hiding specific effects from downstream:

>>> :{
  onlyE1 :: Eff (E1 : es) a -> Eff (E1 : E2 : E3 : es) a
  onlyE1 = inject
:}
>>> :{
  onlyE2 :: Eff (E2 : es) a -> Eff (E1 : E2 : E3 : es) a
  onlyE2 = inject
:}
>>> :{
  onlyE3 :: Eff (E3 : es) a -> Eff (E1 : E2 : E3 : es) a
  onlyE3 = inject
:}

However, it's not possible to inject a computation into an incompatible effect stack:

>>> :{
  coerceEs :: Eff es1 a -> Eff es2 a
  coerceEs = inject
:}
...
...Couldn't match type ‘es1’ with ‘es2’
...

class KnownPrefix es => Subset (xs :: [Effect]) (es :: [Effect]) Source #

Provide evidence that xs is a subset of es.

Instances

Instances details
(KnownPrefix es, IsUnknownSuffixOf xs es) => Subset xs es Source # 
Instance details

Defined in Effectful.Internal.Effect

KnownPrefix es => Subset ('[] :: [Effect]) es Source # 
Instance details

Defined in Effectful.Internal.Effect

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

Defined in Effectful.Internal.Effect

Unlifting

data UnliftStrategy Source #

The strategy to use when unlifting Eff computations via withEffToIO, withRunInIO or the localUnlift family.

Constructors

SeqUnlift

The fastest strategy and a default setting for IOE. An attempt to call the unlifting function in threads distinct from its creator will result in a runtime error.

ConcUnlift !Persistence !Limit

A strategy that makes it possible for the unlifting function to be called in threads distinct from its creator. See Persistence and Limit settings for more information.

Instances

Instances details
Generic UnliftStrategy Source # 
Instance details

Defined in Effectful.Internal.Unlift

Associated Types

type Rep UnliftStrategy :: Type -> Type #

Show UnliftStrategy Source # 
Instance details

Defined in Effectful.Internal.Unlift

Eq UnliftStrategy Source # 
Instance details

Defined in Effectful.Internal.Unlift

Ord UnliftStrategy Source # 
Instance details

Defined in Effectful.Internal.Unlift

type Rep UnliftStrategy Source # 
Instance details

Defined in Effectful.Internal.Unlift

type Rep UnliftStrategy = D1 ('MetaData "UnliftStrategy" "Effectful.Internal.Unlift" "effectful-core-2.2.2.2-3ZnPMiMlFXL41oNodyVfOb" 'False) (C1 ('MetaCons "SeqUnlift" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "ConcUnlift" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Persistence) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Limit)))

data Persistence Source #

Persistence setting for the ConcUnlift strategy.

Different functions require different persistence strategies. Examples:

  • Lifting pooledMapConcurrentlyN from the unliftio library requires the Ephemeral strategy as we don't want jobs to share environment changes made by previous jobs run in the same worker thread.
  • Lifting forkIOWithUnmask requires the Persistent strategy, otherwise the unmasking function would start with a fresh environment each time it's called.

Constructors

Ephemeral

Don't persist the environment between calls to the unlifting function in threads distinct from its creator.

Persistent

Persist the environment between calls to the unlifting function within a particular thread.

Instances

Instances details
Generic Persistence Source # 
Instance details

Defined in Effectful.Internal.Unlift

Associated Types

type Rep Persistence :: Type -> Type #

Show Persistence Source # 
Instance details

Defined in Effectful.Internal.Unlift

Eq Persistence Source # 
Instance details

Defined in Effectful.Internal.Unlift

Ord Persistence Source # 
Instance details

Defined in Effectful.Internal.Unlift

type Rep Persistence Source # 
Instance details

Defined in Effectful.Internal.Unlift

type Rep Persistence = D1 ('MetaData "Persistence" "Effectful.Internal.Unlift" "effectful-core-2.2.2.2-3ZnPMiMlFXL41oNodyVfOb" 'False) (C1 ('MetaCons "Ephemeral" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "Persistent" 'PrefixI 'False) (U1 :: Type -> Type))

data Limit Source #

Limit setting for the ConcUnlift strategy.

Constructors

Limited !Int

Behavior dependent on the Persistence setting.

For Ephemeral, it limits the amount of uses of the unlifting function in threads distinct from its creator to N. The unlifting function will create N copies of the environment when called N times and K+1 copies when called K < N times.

For Persistent, it limits the amount of threads, distinct from the creator of the unlifting function, it can be called in to N. The amount of calls to the unlifting function within a particular threads is unlimited. The unlifting function will create N copies of the environment when called in N threads and K+1 copies when called in K < N threads.

Unlimited

Unlimited use of the unlifting function.

Instances

Instances details
Generic Limit Source # 
Instance details

Defined in Effectful.Internal.Unlift

Associated Types

type Rep Limit :: Type -> Type #

Methods

from :: Limit -> Rep Limit x #

to :: Rep Limit x -> Limit #

Show Limit Source # 
Instance details

Defined in Effectful.Internal.Unlift

Methods

showsPrec :: Int -> Limit -> ShowS #

show :: Limit -> String #

showList :: [Limit] -> ShowS #

Eq Limit Source # 
Instance details

Defined in Effectful.Internal.Unlift

Methods

(==) :: Limit -> Limit -> Bool #

(/=) :: Limit -> Limit -> Bool #

Ord Limit Source # 
Instance details

Defined in Effectful.Internal.Unlift

Methods

compare :: Limit -> Limit -> Ordering #

(<) :: Limit -> Limit -> Bool #

(<=) :: Limit -> Limit -> Bool #

(>) :: Limit -> Limit -> Bool #

(>=) :: Limit -> Limit -> Bool #

max :: Limit -> Limit -> Limit #

min :: Limit -> Limit -> Limit #

type Rep Limit Source # 
Instance details

Defined in Effectful.Internal.Unlift

type Rep Limit = D1 ('MetaData "Limit" "Effectful.Internal.Unlift" "effectful-core-2.2.2.2-3ZnPMiMlFXL41oNodyVfOb" 'False) (C1 ('MetaCons "Limited" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Int)) :+: C1 ('MetaCons "Unlimited" 'PrefixI 'False) (U1 :: Type -> Type))

withUnliftStrategy :: IOE :> es => UnliftStrategy -> Eff es a -> Eff es a Source #

Locally override the UnliftStrategy with the given value.

withEffToIO Source #

Arguments

:: (HasCallStack, IOE :> es) 
=> ((forall r. Eff es r -> IO r) -> IO a)

Continuation with the unlifting function in scope.

-> Eff es a 

Create an unlifting function with the current UnliftStrategy.

This function is equivalent to withRunInIO, but has a HasCallStack constraint for accurate stack traces in case an insufficiently powerful UnliftStrategy is used and the unlifting function fails.

withSeqEffToIO Source #

Arguments

:: (HasCallStack, IOE :> es) 
=> ((forall r. Eff es r -> IO r) -> IO a)

Continuation with the unlifting function in scope.

-> Eff es a 

Create an unlifting function with the SeqUnlift strategy.

Since: 2.2.2.0

withConcEffToIO Source #

Arguments

:: (HasCallStack, IOE :> es) 
=> Persistence 
-> Limit 
-> ((forall r. Eff es r -> IO r) -> IO a)

Continuation with the unlifting function in scope.

-> Eff es a 

Create an unlifting function with the ConcUnlift strategy.

Since: 2.2.2.0

Low-level unlifts

seqUnliftIO Source #

Arguments

:: HasCallStack 
=> Env es

The environment.

-> ((forall r. Eff es r -> IO r) -> IO a)

Continuation with the unlifting function in scope.

-> IO a 

Create an unlifting function with the SeqUnlift strategy.

concUnliftIO Source #

Arguments

:: HasCallStack 
=> Env es

The environment.

-> Persistence 
-> Limit 
-> ((forall r. Eff es r -> IO r) -> IO a)

Continuation with the unlifting function in scope.

-> IO a 

Create an unlifting function with the ConcUnlift strategy.

Dispatch

Dynamic dispatch

type EffectHandler e es Source #

Arguments

 = forall a localEs. (HasCallStack, e :> localEs) 
=> LocalEnv localEs es

Capture of the local environment for handling local Eff computations when e is a higher order effect.

-> e (Eff localEs) a

The effect performed in the local environment.

-> Eff es a 

Type signature of the effect handler.

newtype LocalEnv (localEs :: [Effect]) (handlerEs :: [Effect]) Source #

Opaque representation of the Eff environment at the point of calling the send function, i.e. right before the control is passed to the effect handler.

The second type variable represents effects of a handler and is needed for technical reasons to guarantee soundness (see SharedSuffix for more information).

Constructors

LocalEnv (Env localEs) 

data Handler :: Effect -> Type where Source #

An internal representation of dynamically dispatched effects, i.e. the effect handler bundled with its environment.

Constructors

Handler :: !(Env handlerEs) -> !(EffectHandler e handlerEs) -> Handler e 

runHandler :: DispatchOf e ~ Dynamic => Handler e -> Eff (e ': es) a -> Eff es a Source #

Run a dynamically dispatched effect with the given handler.

send Source #

Arguments

:: (HasCallStack, DispatchOf e ~ Dynamic, e :> es) 
=> e (Eff es) a

The effect.

-> Eff es a 

Send an operation of the given effect to its handler for execution.

Static dispatch

data family StaticRep (e :: Effect) :: Type Source #

Internal representations of statically dispatched effects.

Instances

Instances details
newtype StaticRep IOE Source # 
Instance details

Defined in Effectful.Internal.Monad

data StaticRep Prim Source # 
Instance details

Defined in Effectful.Internal.Monad

newtype StaticRep (Error e) Source # 
Instance details

Defined in Effectful.Error.Static

newtype StaticRep (Error e) = Error ErrorId
newtype StaticRep (Reader r) Source # 
Instance details

Defined in Effectful.Reader.Static

newtype StaticRep (Reader r) = Reader r
newtype StaticRep (State s) Source # 
Instance details

Defined in Effectful.State.Static.Local

newtype StaticRep (State s) = State s
newtype StaticRep (State s) Source # 
Instance details

Defined in Effectful.State.Static.Shared

newtype StaticRep (State s) = State (MVar' s)
newtype StaticRep (Writer w) Source # 
Instance details

Defined in Effectful.Writer.Static.Local

newtype StaticRep (Writer w) = Writer w
newtype StaticRep (Writer w) Source # 
Instance details

Defined in Effectful.Writer.Static.Shared

newtype StaticRep (Writer w) = Writer (MVar' w)

type family MaybeIOE (sideEffects :: SideEffects) (es :: [Effect]) :: Constraint where ... Source #

Require the IOE effect for running statically dispatched effects whose operations perform side effects.

runStaticRep Source #

Arguments

:: (DispatchOf e ~ Static sideEffects, MaybeIOE sideEffects es) 
=> StaticRep e

The initial representation.

-> Eff (e ': es) a 
-> Eff es (a, StaticRep e) 

Run a statically dispatched effect with the given initial representation and return the final value along with the final representation.

evalStaticRep Source #

Arguments

:: (DispatchOf e ~ Static sideEffects, MaybeIOE sideEffects es) 
=> StaticRep e

The initial representation.

-> Eff (e ': es) a 
-> Eff es a 

Run a statically dispatched effect with the given initial representation and return the final value, discarding the final representation.

execStaticRep Source #

Arguments

:: (DispatchOf e ~ Static sideEffects, MaybeIOE sideEffects es) 
=> StaticRep e

The initial representation.

-> Eff (e ': es) a 
-> Eff es (StaticRep e) 

Run a statically dispatched effect with the given initial representation and return the final representation, discarding the final value.

getStaticRep :: (DispatchOf e ~ Static sideEffects, e :> es) => Eff es (StaticRep e) Source #

Fetch the current representation of the effect.

putStaticRep :: (DispatchOf e ~ Static sideEffects, e :> es) => StaticRep e -> Eff es () Source #

Set the current representation of the effect to the given value.

stateStaticRep Source #

Arguments

:: (DispatchOf e ~ Static sideEffects, e :> es) 
=> (StaticRep e -> (a, StaticRep e))

The function to modify the representation.

-> Eff es a 

Apply the function to the current representation of the effect and return a value.

stateStaticRepM Source #

Arguments

:: (DispatchOf e ~ Static sideEffects, e :> es) 
=> (StaticRep e -> Eff es (a, StaticRep e))

The function to modify the representation.

-> Eff es a 

Apply the monadic function to the current representation of the effect and return a value.

localStaticRep Source #

Arguments

:: (DispatchOf e ~ Static sideEffects, e :> es) 
=> (StaticRep e -> StaticRep e)

The function to temporarily modify the representation.

-> Eff es a 
-> Eff es a 

Execute a computation with a temporarily modified representation of the effect.

Primitive operations

consEnv Source #

Arguments

:: EffectRep (DispatchOf e) e

The representation of the effect.

-> Relinker (EffectRep (DispatchOf e)) e 
-> Env es 
-> IO (Env (e ': es)) 

Extend the environment with a new data type.

getEnv Source #

Arguments

:: forall e es. e :> es 
=> Env es

The environment.

-> IO (EffectRep (DispatchOf e) e) 

Extract a specific data type from the environment.

putEnv Source #

Arguments

:: forall e es. e :> es 
=> Env es

The environment.

-> EffectRep (DispatchOf e) e 
-> IO () 

Replace the data type in the environment with a new value (in place).

stateEnv Source #

Arguments

:: forall e es a. e :> es 
=> Env es

The environment.

-> (EffectRep (DispatchOf e) e -> IO (a, EffectRep (DispatchOf e) e)) 
-> IO a 

Modify the data type in the environment and return a value (in place).

modifyEnv Source #

Arguments

:: forall e es. e :> es 
=> Env es

The environment.

-> (EffectRep (DispatchOf e) e -> IO (EffectRep (DispatchOf e) e)) 
-> IO () 

Modify the data type in the environment (in place).