Safe Haskell | None |
---|---|
Language | Haskell2010 |
avail
is a companion to monad transformers that allows you to add effect management to concrete monads,
i.e. specify what effects a piece of code can perform.
Traditionally, in order to manage effects, the effect typeclasses are placed on a polymorphic monad type
m
so that other details of the monad type is not known at that point, effectively limiting what a function can do:
(MonadWriter Log m, MonadState Store m, MonadReader Env m) => m ()
While this works well, it has inevitable performance drawback because of the polymorphic m
. GHC doesn't know the
implementation of m
, hence cannot perform much optimization. On the other hand, if we use a concrete monad stack
that supports all the effects we need, we will not be able to restrict the effects that can be performed.
avail
addresses this by a monad transformer M
. For any monad m
, the monad type
adds effect
management on top of it. Specifically, for an effect typeclass M
mc
(such as MonadIO
or
), its methods can be used on MonadReader
r
only if:M
m
- The monad
m
actually supports the effect, i.e. has an instancec m
of the effect typeclass; - The effect is available in current context, i.e. a phantom constraint
(which doesn't contain any information) is added to the function signature.Eff
c
This pattern was first outlined in the blog post
Effect is a phantom.
In avail
, it allows you to manage effects via the phantom Eff
constraint while still using a
concrete monad stack; the Eff
constarint is not tied to the stack anyhow. Finally, Eff
has no instances,
and can only be removed all at once via the runM
function, obtaining the underlying monad.
avail
supports libraries including mtl
, unliftio
, monad-control
and capability
out of the box, so there
should be near-zero boilerplate to get started with avail
. For other effect typeclasses, the avail
support
of them can be easily derived via the TH functions in Avail.Derive.
You need these language extensions when using this module:
DataKinds FlexibleContexts FlexibleInstances RankNTypes TypeApplications
You need more extensions when using Avail.Derive; see documentation in that module.
Synopsis
- data M m a
- type Effect = (Type -> Type) -> Constraint
- class KnownList (Superclasses e) => IsEff (e :: Effect) where
- type Superclasses e :: [Effect]
- type Eff (e :: Effect) = (Eff' e, Effs (Superclasses e))
- type family Effs (es :: [Effect]) :: Constraint where ...
- class KnownList (es :: [Effect])
- unM :: M m a -> m a
- runM :: forall es m a. KnownList es => (Effs es => M m a) -> m a
Documentation
The M
monad transformer acts as a barrier of effects. For example, for a monad type App
and any
effect typeclass MonadOvO
that App
has an instance of, the constraint Eff MonadOvO
is required to perform
the methods of MonadOvO
in the monad
as defined for the M
AppApp
monad.
In particular, M
is expected to be used on a concrete monad instead of a polymorphic one. This is
particularly good in terms of program performance, and generally means instead of writing this:
f ::MonadState
Int
m => m ()
You should write
f ::Eff
(MonadState
Int
) =>M
App ()
where App
is a monad stack of your choice that has support of
. This also
means there is no MonadState
Int
MonadTrans
instance for M
.
Note: you should not define instances of M
for effect typeclasses directly by hand as that is error-prone
and may create holes in effect management. For defining instances of effect typeclasses for M
, check out
the Avail.Derive module and specifically the avail
and avail'
TH functions.
Also keep in mind that typeclasses inside mtl
, exceptions
, unliftio
, monad-control
and capability
work
with M
out-of-the-box so no instance for them is needed to be defined on M
by you.
Instances
type Effect = (Type -> Type) -> Constraint Source #
The kind of effect typeclasses, i.e. those that define a set of operations on a monad. Examples include
MonadIO
and MonadReader
.
This type is the same as the Capability
type in capability
.
class KnownList (Superclasses e) => IsEff (e :: Effect) Source #
Any Effect
being used with avail
should have an instance of this class. Specifically, this class stores
the superclasses of effect typeclasses. For example, MonadUnliftIO
has a superclass
MonadIO
.
You won't need to define instances of this by hand; instead, use the avail'
Template Haskell function.
type Superclasses e :: [Effect] Source #
The superclasses of this typeclass.
Instances
type Eff (e :: Effect) = (Eff' e, Effs (Superclasses e)) Source #
The constraint that indicates an effect is available for use, i.e. you can perform methods defined by instances
of the effect typeclass e
in a M
monad.
type family Effs (es :: [Effect]) :: Constraint where ... Source #
class KnownList (es :: [Effect]) Source #
The list of effect typeclasses es
is known at compile time. This is required for functions like runM
.
runM :: forall es m a. KnownList es => (Effs es => M m a) -> m a Source #
Unwrap the M
monad into the underlying concrete monad and also eliminating Eff
constraints. You need
TypeApplications
in order to specify the list of Effect
s you want to eliminate Eff
constraints for:
runM
@'[MonadReader Env, MonadState Store, MonadError MyErr] app
Note that functions like (&)
generally does not work with this function; either apply directly or
use ($)
only.