Safe Haskell | None |
---|---|
Language | Haskell2010 |
Synopsis
- data Tell o :: Effect where
- data Listen o :: Effect where
- newtype Pass o :: Effect where
- type Writer o = Bundle '[Tell o, Listen o, Pass o]
- tell :: Eff (Tell o) m => o -> m ()
- listen :: Eff (Listen o) m => m a -> m (o, a)
- pass :: Eff (Pass o) m => m (o -> o, a) -> m a
- censor :: Eff (Pass o) m => (o -> o) -> m a -> m a
- runTell :: forall o m a p. (Monoid o, Carrier m, Threaders '[WriterThreads] m p) => TellC o m a -> m (o, a)
- runTellLazy :: forall o m a p. (Monoid o, Carrier m, Threaders '[WriterLazyThreads] m p) => TellLazyC o m a -> m (o, a)
- runTellList :: forall o m a p. (Carrier m, Threaders '[WriterThreads] m p) => TellListC o m a -> m ([o], a)
- runTellListLazy :: forall o m a p. (Carrier m, Threaders '[WriterLazyThreads] m p) => TellListLazyC o m a -> m ([o], a)
- tellToIO :: forall o m a. (Monoid o, Eff (Embed IO) m) => InterpretReifiedC (Tell o) m a -> m (o, a)
- runTellIORef :: forall o m a. (Monoid o, Eff (Embed IO) m) => IORef o -> InterpretReifiedC (Tell o) m a -> m a
- runTellTVar :: forall o m a. (Monoid o, Eff (Embed IO) m) => TVar o -> InterpretReifiedC (Tell o) m a -> m a
- runTellAction :: forall o m a. Carrier m => (o -> m ()) -> InterpretReifiedC (Tell o) m a -> m a
- tellIntoEndoTell :: (Monoid o, HeadEff (Tell (Endo o)) m) => TellIntoEndoTellC o m a -> m a
- tellToTell :: forall o o' m a. Eff (Tell o') m => (o -> o') -> InterpretReifiedC (Tell o) m a -> m a
- tellIntoTell :: forall o o' m a. HeadEff (Tell o') m => (o -> o') -> ReinterpretReifiedC (Tell o) '[Tell o'] m a -> m a
- ignoreTell :: forall o m a. Carrier m => IgnoreTellC o m a -> m a
- tellToIOSimple :: forall o m a p. (Monoid o, Eff (Embed IO) m, Threaders '[ReaderThreads] m p) => InterpretSimpleC (Tell o) m a -> m (o, a)
- runTellIORefSimple :: forall o m a p. (Monoid o, Eff (Embed IO) m, Threaders '[ReaderThreads] m p) => IORef o -> InterpretSimpleC (Tell o) m a -> m a
- runTellTVarSimple :: forall o m a p. (Monoid o, Eff (Embed IO) m, Threaders '[ReaderThreads] m p) => TVar o -> InterpretSimpleC (Tell o) m a -> m a
- runTellActionSimple :: forall o m a p. (Carrier m, Threaders '[ReaderThreads] m p) => (o -> m ()) -> InterpretSimpleC (Tell o) m a -> m a
- tellToTellSimple :: forall o o' m a p. (Eff (Tell o') m, Threaders '[ReaderThreads] m p) => (o -> o') -> InterpretSimpleC (Tell o) m a -> m a
- tellIntoTellSimple :: forall o o' m a p. (HeadEff (Tell o') m, Threaders '[ReaderThreads] m p) => (o -> o') -> ReinterpretSimpleC (Tell o) '[Tell o'] m a -> m a
- runListen :: forall o m a p. (Monoid o, Carrier m, Threaders '[WriterThreads] m p) => ListenC o m a -> m (o, a)
- runListenLazy :: forall o m a p. (Monoid o, Carrier m, Threaders '[WriterThreads] m p) => ListenLazyC o m a -> m (o, a)
- listenToIO :: forall o m a p. (Monoid o, Eff (Embed IO) m, MonadMask m, Threaders '[ReaderThreads] m p) => ListenTVarC o m a -> m (o, a)
- runListenTVar :: forall o m a p. (Monoid o, Eff (Embed IO) m, MonadMask m, Threaders '[ReaderThreads] m p) => TVar o -> ListenTVarC o m a -> m a
- listenIntoEndoListen :: (Monoid o, HeadEffs '[Listen (Endo o), Tell (Endo o)] m) => ListenIntoEndoListenC o m a -> m a
- runWriter :: forall o m a p. (Monoid o, Carrier m, Threaders '[WriterThreads] m p) => WriterC o m a -> m (o, a)
- runWriterLazy :: forall o m a p. (Monoid o, Carrier m, Threaders '[WriterLazyThreads] m p) => WriterLazyC o m a -> m (o, a)
- writerToIO :: forall o m a p. (Monoid o, Eff (Embed IO) m, MonadMask m, Threaders '[ReaderThreads] m p) => WriterTVarC o m a -> m (o, a)
- runWriterTVar :: forall o m a p. (Monoid o, Eff (Embed IO) m, MonadMask m, Threaders '[ReaderThreads] m p) => TVar o -> WriterTVarC o m a -> m a
- writerToBracket :: forall o m a p. (Monoid o, Effs [Embed IO, Bracket] m, Threaders '[ReaderThreads] m p) => WriterToBracketC o m a -> m (o, a)
- writerToBracketTVar :: forall o m a p. (Monoid o, Effs [Embed IO, Bracket] m, Threaders '[ReaderThreads] m p) => TVar o -> WriterToBracketC o m a -> m a
- writerIntoEndoWriter :: (Monoid o, HeadEffs '[Pass (Endo o), Listen (Endo o), Tell (Endo o)] m) => WriterIntoEndoWriterC o m a -> m a
- fromEndoWriter :: (Monoid o, Functor f) => f (Endo o, a) -> f (o, a)
- class (forall o. Monoid o => Threads (WriterT o) p) => WriterThreads p
- class (forall o. Monoid o => Threads (WriterT o) p) => WriterLazyThreads p
- class MonadCatch m => MonadMask (m :: Type -> Type)
- data TellC o m a
- data TellLazyC o m a
- type TellListC o = CompositionC '[ReinterpretC TellListH (Tell o) '[Tell (Dual [o])], TellC (Dual [o])]
- type TellListLazyC o = CompositionC '[ReinterpretC TellListLazyH (Tell o) '[Tell (Endo [o])], TellLazyC (Endo [o])]
- type TellIntoEndoTellC o = ReinterpretC WriterToEndoWriterH (Tell o) '[Tell (Endo o)]
- type IgnoreTellC o = InterpretC IgnoreTellH (Tell o)
- data ListenC o m a
- data ListenLazyC o m a
- type ListenTVarC o = CompositionC '[IntroC '[Listen o, Tell o] '[ListenPrim o, Local (o -> STM ()), Ask (o -> STM ())], InterpretC WriterTVarH (Listen o), InterpretC WriterTVarH (Tell o), InterpretPrimC WriterTVarH (ListenPrim o), ReaderC (o -> STM ())]
- type ListenIntoEndoListenC o = CompositionC '[IntroC '[Listen o, Tell o] '[Listen (Endo o), Tell (Endo o)], InterpretC WriterToEndoWriterH (Listen o), InterpretC WriterToEndoWriterH (Tell o)]
- data WriterC o m a
- data WriterLazyC o m a
- type WriterTVarC o = CompositionC '[IntroC '[Pass o, Listen o, Tell o] '[ListenPrim o, WriterPrim o, Local (o -> STM ()), Ask (o -> STM ())], InterpretC WriterTVarH (Pass o), InterpretC WriterTVarH (Listen o), InterpretC WriterTVarH (Tell o), InterpretC WriterTVarH (ListenPrim o), InterpretPrimC WriterTVarH (WriterPrim o), ReaderC (o -> STM ())]
- type WriterToBracketC o = CompositionC '[IntroC '[Pass o, Listen o, Tell o] '[Local (o -> STM ()), Ask (o -> STM ())], InterpretC WriterToBracketH (Pass o), InterpretC WriterToBracketH (Listen o), InterpretC WriterTVarH (Tell o), ReaderC (o -> STM ())]
- type WriterIntoEndoWriterC o = CompositionC '[IntroC '[Pass o, Listen o, Tell o] '[Pass (Endo o), Listen (Endo o), Tell (Endo o)], InterpretC WriterToEndoWriterH (Pass o), InterpretC WriterToEndoWriterH (Listen o), InterpretC WriterToEndoWriterH (Tell o)]
Effects
data Tell o :: Effect where Source #
An effect for arbitrary output.
Instances
(Monoid w, Carrier m, Threaders '[SteppedThreads] m p) => PrimHandler ListenSteppedH (ListenPrim w) (SteppedC (Tell w) m) Source # | |
Defined in Control.Effect.Internal.Intercept effPrimHandler :: EffPrimHandler (ListenPrim w) (SteppedC (Tell w) m) Source # |
data Listen o :: Effect where Source #
An effect for hearing what a computation
has to tell
.
Instances
Eff (ListenPrim w) m => Handler ListenSteppedH (Listen w) m Source # | |
Defined in Control.Effect.Internal.Intercept effHandler :: EffHandler (Listen w) m Source # |
Actions
Interpretations for Tell
runTell :: forall o m a p. (Monoid o, Carrier m, Threaders '[WriterThreads] m p) => TellC o m a -> m (o, a) Source #
Run a
effect, where Tell
oo
is a Monoid
, by accumulating
all the uses of tell
.
You may want to combine this with tellIntoTell
.
Unlike runListen
and runWriter
, this does not provide the ability to
interact with the tell
s through listen
and pass
; but also doesn't
impose any primitive effects, meaning runTell
doesn't restrict what
interpreters are run before it.
Derivs
(TellC
o m) =Tell
o ':Derivs
m
Prims
(TellC
o m) =Prims
m
This produces the final accumulation o
strictly. See runTellLazy
for a
lazy variant of this.
runTellLazy :: forall o m a p. (Monoid o, Carrier m, Threaders '[WriterLazyThreads] m p) => TellLazyC o m a -> m (o, a) Source #
Run a
effect, where Tell
oo
is a Monoid
, by accumulating all the
uses of tell
lazily.
Derivs
(TellLazyC
o m) =Tell
o ':Derivs
m
Prims
(TellLazyC
o m) =Prims
m
This is a variant of runTell
that produces the final accumulation
lazily. Use this only if you need
the laziness, as this would otherwise incur an unneccesary space leak.
runTellList :: forall o m a p. (Carrier m, Threaders '[WriterThreads] m p) => TellListC o m a -> m ([o], a) Source #
runTellListLazy :: forall o m a p. (Carrier m, Threaders '[WriterLazyThreads] m p) => TellListLazyC o m a -> m ([o], a) Source #
Run a
by gathering the Tell
otell
s into a list.
Derivs
(TellListLazyC
o m) =Tell
o ':Derivs
m
Prims
(TellListLazyC
o m) =Prims
m
This is a variant of runTellList
that produces the
final list lazily. Use this only if you need
the laziness, as this would otherwise incur an unneccesary space leak.
tellToIO :: forall o m a. (Monoid o, Eff (Embed IO) m) => InterpretReifiedC (Tell o) m a -> m (o, a) Source #
Run a
effect where Tell
oo
is a Monoid
by accumulating uses of
tell
through atomic operations in IO
.
You may want to combine this with tellIntoTell
.
This has a higher-rank type, as it makes use of InterpretReifiedC
.
This makes tellToIO
very difficult to use partially applied.
In particular, it can't be composed using
..
If performance is secondary, consider using the slower
tellToIOSimple
, which doesn't have a higher-rank type.
runTellIORef :: forall o m a. (Monoid o, Eff (Embed IO) m) => IORef o -> InterpretReifiedC (Tell o) m a -> m a Source #
Run a
effect where Tell
oo
is a Monoid
by accumulating uses of
tell
through using atomic operations in IO
over the provided IORef
.
This has a higher-rank type, as it makes use of InterpretReifiedC
.
This makes runTellIORef
very difficult to use partially applied.
In particular, it can't be composed using
..
If performance is secondary, consider using the slower
runTellIORefSimple
, which doesn't have a higher-rank type.
runTellTVar :: forall o m a. (Monoid o, Eff (Embed IO) m) => TVar o -> InterpretReifiedC (Tell o) m a -> m a Source #
Run a
effect where Tell
oo
is a Monoid
by accumulating uses of
tell
through using atomic operations in IO
over the provided TVar
.
This has a higher-rank type, as it makes use of InterpretReifiedC
.
This makes runTellTVar
very difficult to use partially applied.
In particular, it can't be composed using
..
If performance is secondary, consider using the slower
runTellTVarSimple
, which doesn't have a higher-rank type.
runTellAction :: forall o m a. Carrier m => (o -> m ()) -> InterpretReifiedC (Tell o) m a -> m a Source #
Run a Tell
effect by providing an action to be executed
at each use of tell
.
This has a higher-rank type, as it makes use of InterpretReifiedC
.
This makes runTellAction
very difficult to use partially applied.
In particular, it can't be composed using
..
If performance is secondary, consider using the slower runTellActionSimple
,
which doesn't have a higher-rank type.
tellIntoEndoTell :: (Monoid o, HeadEff (Tell (Endo o)) m) => TellIntoEndoTellC o m a -> m a Source #
Rewrite a
effect into a Tell
o
effect.Tell
(Endo
o)
This effectively right-associates all uses of tell
, which
asymptotically improves performance if the time complexity of <>
for the
Monoid
depends only on the size of the first argument.
In particular, you should use this (if you can be bothered) if the monoid
is a list, such as String
.
Usage is to combine this with the Tell
interpreter of your choice, followed
by fromEndoWriter
, like this:
run
$ ... $fromEndoWriter
$runTell
$tellIntoEndoTell
@String -- TheMonoid
must be specified $ ...
tellToTell :: forall o o' m a. Eff (Tell o') m => (o -> o') -> InterpretReifiedC (Tell o) m a -> m a Source #
Transform a Tell
effect into another Tell
effect by providing a function
to transform the type told.
This is useful to transform a
effect where Tell
oo
isn't a Monoid
into a
effect where Tell
o'o'
is a Monoid
, and thus can be
interpreted using the various Monoid
al Tell
interpreters.
This has a higher-rank type, as it makes use of InterpretReifiedC
.
This makes tellToTell
very difficult to use partially applied.
In particular, it can't be composed using
..
If performance is secondary, consider using the slower
tellToTellSimple
, which doesn't have a higher-rank type.
tellIntoTell :: forall o o' m a. HeadEff (Tell o') m => (o -> o') -> ReinterpretReifiedC (Tell o) '[Tell o'] m a -> m a Source #
Rewrite a Tell
effect into another Tell
effect on top of the effect
stack by providing a function to transform the type told.
This is useful to rewrite a
effect where Tell
oo
isn't a Monoid
into a
effect where Tell
tt
is a Monoid
, and thus can be
interpreted using the various Monoid
al Tell
interpreters.
This has a higher-rank type, as it makes use of InterpretReifiedC
.
This makes tellToTell
very difficult to use partially applied.
In particular, it can't be composed using
..
If performance is secondary, consider using the slower
tellIntoTellSimple
, which doesn't have a higher-rank type.
ignoreTell :: forall o m a. Carrier m => IgnoreTellC o m a -> m a Source #
Run a Tell
effect by ignoring it, doing no output at all.
Simple variants of interpretations for Tell
tellToIOSimple :: forall o m a p. (Monoid o, Eff (Embed IO) m, Threaders '[ReaderThreads] m p) => InterpretSimpleC (Tell o) m a -> m (o, a) Source #
runTellIORefSimple :: forall o m a p. (Monoid o, Eff (Embed IO) m, Threaders '[ReaderThreads] m p) => IORef o -> InterpretSimpleC (Tell o) m a -> m a Source #
runTellTVarSimple :: forall o m a p. (Monoid o, Eff (Embed IO) m, Threaders '[ReaderThreads] m p) => TVar o -> InterpretSimpleC (Tell o) m a -> m a Source #
runTellActionSimple :: forall o m a p. (Carrier m, Threaders '[ReaderThreads] m p) => (o -> m ()) -> InterpretSimpleC (Tell o) m a -> m a Source #
Run a Tell
effect by providing an action to be executed
at each use of tell
.
This is a less performant version of runTellAction
that doesn't have
a higher-rank type, making it much easier to use partially applied.
tellToTellSimple :: forall o o' m a p. (Eff (Tell o') m, Threaders '[ReaderThreads] m p) => (o -> o') -> InterpretSimpleC (Tell o) m a -> m a Source #
Transform a Tell
effect into another Tell
effect by providing a function
to transform the type told.
This is useful to transform a
where Tell
oo
isn't a Monoid
into a
effect where Tell
pp
is a Monoid
, and thus can be interpreted using
the various Monoid
al Tell
interpreters.
This is a less performant version of tellToTell
that doesn't have
a higher-rank type, making it much easier to use partially applied.
tellIntoTellSimple :: forall o o' m a p. (HeadEff (Tell o') m, Threaders '[ReaderThreads] m p) => (o -> o') -> ReinterpretSimpleC (Tell o) '[Tell o'] m a -> m a Source #
Rewrite a Tell
effect into another Tell
effect on top of the effect
stack by providing a function to transform the type told.
This is useful to rewrite a
effect where Tell
oo
isn't a Monoid
into a
effect where Tell
o'o'
is a Monoid
, and thus can be
interpreted using the various Monoid
al Tell
interpreters.
This is a less performant version of tellIntoTell
that doesn't have
a higher-rank type, making it much easier to use partially applied.
Interpretations for Tell
+ Listen
runListen :: forall o m a p. (Monoid o, Carrier m, Threaders '[WriterThreads] m p) => ListenC o m a -> m (o, a) Source #
Run connected
and Listen
o
effects, where Tell
oo
is a Monoid
,
by accumulating all the uses of tell
.
Unlike runWriter
, this does not provide the power of pass
; but because
of that, it also doesn't impose Pass
as a primitive effect, meaning
a larger variety of interpreters may be run before runListen
compared to
runWriter
.
Derivs
(ListenC
o m) =Listen
o ':Tell
o ':Derivs
m
Prims
(ListenC
o m) =ListenPrim
o ':Prims
m
This produces the final accumulation strictly. See runListenLazy
for a
lazy variant of this.
runListenLazy :: forall o m a p. (Monoid o, Carrier m, Threaders '[WriterThreads] m p) => ListenLazyC o m a -> m (o, a) Source #
Run connected
and Listen
o
effects,
where Tell
oo
is a Monoid
, by accumulating all the uses of tell
lazily.
Derivs
(ListenLazyC
o m) =Listen
o ':Tell
o ':Derivs
m
Prims
(ListenLazyC
o m) =ListenPrim
o ':Prims
m
This is a variant of runListen
that produces the
final accumulation lazily. Use this only if you need
the laziness, as this would otherwise incur an unneccesary space leak.
listenToIO :: forall o m a p. (Monoid o, Eff (Embed IO) m, MonadMask m, Threaders '[ReaderThreads] m p) => ListenTVarC o m a -> m (o, a) Source #
Run connected
and Listen
o
effects by accumulating uses of
Tell
otell
through using atomic operations in IO
.
Derivs
(ListenTVarC
o m) =Listen
o ':Tell
o ':Derivs
m
Prims
(ListenTVarC
o m) =ListenPrim
o ':ReaderPrim
(o -> STM ()) ':Prims
m
Note that unlike tellToIO
, this does not have a higher-rank type.
runListenTVar :: forall o m a p. (Monoid o, Eff (Embed IO) m, MonadMask m, Threaders '[ReaderThreads] m p) => TVar o -> ListenTVarC o m a -> m a Source #
Run connected
and Listen
o
effects by accumulating uses of
Tell
otell
through using atomic operations in IO
over the provided TVar
.
Derivs
(ListenTVarC
o m) =Listen
o :Tell
o ':Derivs
m
Prims
(ListenTVarC
o m) =ListenPrim
o ':ReaderPrim
(o -> STM ()) ':Prims
m
Note that unlike runTellTVar
, this does not have a higher-rank type.
listenIntoEndoListen :: (Monoid o, HeadEffs '[Listen (Endo o), Tell (Endo o)] m) => ListenIntoEndoListenC o m a -> m a Source #
Rewrite connected
and Listen
o
effects into
connected Tell
o
and Listen
(Endo
o)
effects.Tell
(Endo
o)
This effectively right-associates all uses of tell
, which
asymptotically improves performance if the time complexity of <>
for the
Monoid
depends only on the size of the first argument.
In particular, you should use this (if you can be bothered) if the monoid
is a list, such as String.
Usage is to combine this with the Listen
interpreter of your choice,
followed by fromEndoWriter
, like this:
run
$ ... $fromEndoWriter
$runListen
$listenIntoEndoListen
@String -- TheMonoid
must be specified $ ...
Interpretations for Writer
(Tell
+ Listen
+ Pass
)
runWriter :: forall o m a p. (Monoid o, Carrier m, Threaders '[WriterThreads] m p) => WriterC o m a -> m (o, a) Source #
Run connected
, Pass
o
and Listen
o
effects,
-- i.e. Tell
o
-- where Writer
oo
is a Monoid
, by accumulating all the
uses of tell
.
is a fairly restrictive primitive effect. Notably,
Pass
orunCont
can't be used before runWriter
.
If you don't need pass
, consider using runTell
or runListen
instead.
Derivs
(WriterC
o m) =Pass
o ':Listen
o ':Tell
o ':Derivs
m
Prims
(WriterC
o m) =WriterPrim
o ':Prims
m
This produces the final accumulation strictly. See runWriterLazy
for a
lazy variant of this.
runWriterLazy :: forall o m a p. (Monoid o, Carrier m, Threaders '[WriterLazyThreads] m p) => WriterLazyC o m a -> m (o, a) Source #
Run connected
, Pass
o
and Listen
o
effects,
-- i.e. Tell
o
-- where Writer
oo
is a Monoid
,
by accumulating all the uses of tell
lazily.
Derivs
(ListenLazyC
o m) =Pass
o ':Listen
o ':Tell
o ':Derivs
m
Prims
(ListenLazyC
o m) =WriterPrim
o ':Prims
m
This is a variant of runListen
that produces the
final accumulation lazily. Use this only if you need
the laziness, as this would otherwise incur an unneccesary space leak.
writerToIO :: forall o m a p. (Monoid o, Eff (Embed IO) m, MonadMask m, Threaders '[ReaderThreads] m p) => WriterTVarC o m a -> m (o, a) Source #
Run connected
, Pass
o
and Listen
o
effects
-- i.e. Tell
o
-- by accumulating uses of Writer
otell
through using atomic
operations in IO
.
Derivs
(WriterTVarC
o m) =Pass
o ':Listen
o :Tell
o ':Derivs
m
Prims
(WriterTVarC
o m) =WriterPrim
o ':ReaderPrim
(o -> STM ()) ':Prims
m
Note that unlike tellToIO
, this does not have a higher-rank type.
runWriterTVar :: forall o m a p. (Monoid o, Eff (Embed IO) m, MonadMask m, Threaders '[ReaderThreads] m p) => TVar o -> WriterTVarC o m a -> m a Source #
Run connected
, Pass
o
and Listen
o
effects
-- i.e. Tell
o
-- by accumulating uses of Writer
otell
through using atomic
operations in IO
over a TVar
.
Derivs
(WriterTVarC
o m) =Pass
o ':Listen
o :Tell
o ':Derivs
m
Prims
(WriterTVarC
o m) =WriterPrim
o ':ReaderPrim
(o -> STM ()) ':Prims
m
Note that unlike runTellTVar
, this does not have a higher-rank type.
writerToBracket :: forall o m a p. (Monoid o, Effs [Embed IO, Bracket] m, Threaders '[ReaderThreads] m p) => WriterToBracketC o m a -> m (o, a) Source #
Run connected
, Pass
o
and Listen
o
effects
-- i.e. Tell
o
-- by accumulating uses of Writer
otell
through using atomic
operations in IO
, relying on the provided protection of Bracket
for
the implementation.
Derivs
(WriterToBracketC
o m) =Pass
o ':Listen
o :Tell
o ':Derivs
m
Prims
(WriterToBracketC
o m) =ReaderPrim
(o -> STM ()) ':Prims
m
Note that unlike tellToIO
, this does not have a higher-rank type.
writerToBracketTVar :: forall o m a p. (Monoid o, Effs [Embed IO, Bracket] m, Threaders '[ReaderThreads] m p) => TVar o -> WriterToBracketC o m a -> m a Source #
Run connected
, Pass
o
and Listen
o
effects
-- i.e. Tell
o
-- by accumulating uses of Writer
otell
through using atomic
operations in IO
over a TVar
, relying on the provided protection
of Bracket
for the implementation.
Derivs
(WriterToBracketC
o m) =Pass
o ':Listen
o :Tell
o ':Derivs
m
Prims
(WriterToBracketC
o m) =ReaderPrim
(o -> STM ()) ':Prims
m
Note that unlike runTellTVar
, this does not have a higher-rank type.
writerIntoEndoWriter :: (Monoid o, HeadEffs '[Pass (Endo o), Listen (Endo o), Tell (Endo o)] m) => WriterIntoEndoWriterC o m a -> m a Source #
Rewrite connected
, Pass
o
and Listen
o
effects
-- i.e. Tell
o
-- into connected Writer
o
,
Pass
(Endo
o)
and Listen
(Endo
o)
effects on top of the effect
stack -- i.e. Tell
(Endo
o)
.Writer
(Endo
o)
This effectively right-associates all uses of tell
, which
asymptotically improves performance if the time complexity of <>
for the
Monoid
depends only on the size of the first argument.
In particular, you should use this (if you can be bothered) if the
monoid is a list, such as String.
Usage is to combine this with the Writer
interpreter of your choice,
followed by fromEndoWriter
, like this:
run
$ ... $fromEndoWriter
$runWriter
$writerIntoEndoWriter
@String -- TheMonoid
must be specified $ ...
Other utilities
Threading constraints
class (forall o. Monoid o => Threads (WriterT o) p) => WriterThreads p Source #
WriterThreads
accepts the following primitive effects:
Regional
s
Optional
s
(whens
is a functor)BaseControl
b
ListenPrim
o
(wheno
is aMonoid
)WriterPrim
o
(wheno
is aMonoid
)ReaderPrim
i
Mask
Bracket
Fix
Split
Instances
(forall o. Monoid o => Threads (WriterT o) p) => WriterThreads p Source # | |
Defined in Control.Effect.Internal.Writer |
class (forall o. Monoid o => Threads (WriterT o) p) => WriterLazyThreads p Source #
WriterLazyThreads
accepts the following primitive effects:
Regional
s
Optional
s
(whens
is a functor)BaseControl
b
ListenPrim
o
(wheno
is aMonoid
)WriterPrim
o
(wheno
is aMonoid
)ReaderPrim
i
Mask
Bracket
Fix
Split
Instances
(forall o. Monoid o => Threads (WriterT o) p) => WriterLazyThreads p Source # | |
Defined in Control.Effect.Internal.Writer |
MonadMask
class MonadCatch m => MonadMask (m :: Type -> Type) #
A class for monads which provide for the ability to account for all possible exit points from a computation, and to mask asynchronous exceptions. Continuation-based monads are invalid instances of this class.
Instances should ensure that, in the following code:
fg = f `finally` g
The action g
is called regardless of what occurs within f
, including
async exceptions. Some monads allow f
to abort the computation via other
effects than throwing an exception. For simplicity, we will consider aborting
and throwing an exception to be two forms of "throwing an error".
If f
and g
both throw an error, the error thrown by fg
depends on which
errors we're talking about. In a monad transformer stack, the deeper layers
override the effects of the inner layers; for example, ExceptT e1 (Except
e2) a
represents a value of type Either e2 (Either e1 a)
, so throwing both
an e1
and an e2
will result in Left e2
. If f
and g
both throw an
error from the same layer, instances should ensure that the error from g
wins.
Effects other than throwing an error are also overriden by the deeper layers.
For example, StateT s Maybe a
represents a value of type s -> Maybe (a,
s)
, so if an error thrown from f
causes this function to return Nothing
,
any changes to the state which f
also performed will be erased. As a
result, g
will see the state as it was before f
. Once g
completes,
f
's error will be rethrown, so g
' state changes will be erased as well.
This is the normal interaction between effects in a monad transformer stack.
By contrast, lifted-base's
version of finally
always discards all of g
's non-IO effects, and g
never sees any of f
's non-IO effects, regardless of the layer ordering and
regardless of whether f
throws an error. This is not the result of
interacting effects, but a consequence of MonadBaseControl
's approach.
Instances
Carriers
Instances
Instances
type TellListC o = CompositionC '[ReinterpretC TellListH (Tell o) '[Tell (Dual [o])], TellC (Dual [o])] Source #
type TellListLazyC o = CompositionC '[ReinterpretC TellListLazyH (Tell o) '[Tell (Endo [o])], TellLazyC (Endo [o])] Source #
type TellIntoEndoTellC o = ReinterpretC WriterToEndoWriterH (Tell o) '[Tell (Endo o)] Source #
type IgnoreTellC o = InterpretC IgnoreTellH (Tell o) Source #
Instances
data ListenLazyC o m a Source #
Instances
type ListenTVarC o = CompositionC '[IntroC '[Listen o, Tell o] '[ListenPrim o, Local (o -> STM ()), Ask (o -> STM ())], InterpretC WriterTVarH (Listen o), InterpretC WriterTVarH (Tell o), InterpretPrimC WriterTVarH (ListenPrim o), ReaderC (o -> STM ())] Source #
type ListenIntoEndoListenC o = CompositionC '[IntroC '[Listen o, Tell o] '[Listen (Endo o), Tell (Endo o)], InterpretC WriterToEndoWriterH (Listen o), InterpretC WriterToEndoWriterH (Tell o)] Source #
Instances
data WriterLazyC o m a Source #
Instances
type WriterTVarC o = CompositionC '[IntroC '[Pass o, Listen o, Tell o] '[ListenPrim o, WriterPrim o, Local (o -> STM ()), Ask (o -> STM ())], InterpretC WriterTVarH (Pass o), InterpretC WriterTVarH (Listen o), InterpretC WriterTVarH (Tell o), InterpretC WriterTVarH (ListenPrim o), InterpretPrimC WriterTVarH (WriterPrim o), ReaderC (o -> STM ())] Source #
type WriterToBracketC o = CompositionC '[IntroC '[Pass o, Listen o, Tell o] '[Local (o -> STM ()), Ask (o -> STM ())], InterpretC WriterToBracketH (Pass o), InterpretC WriterToBracketH (Listen o), InterpretC WriterTVarH (Tell o), ReaderC (o -> STM ())] Source #
type WriterIntoEndoWriterC o = CompositionC '[IntroC '[Pass o, Listen o, Tell o] '[Pass (Endo o), Listen (Endo o), Tell (Endo o)], InterpretC WriterToEndoWriterH (Pass o), InterpretC WriterToEndoWriterH (Listen o), InterpretC WriterToEndoWriterH (Tell o)] Source #