Safe Haskell | None |
---|---|
Language | Haskell2010 |
The ChronicleT
monad, a hybrid error/writer monad that allows
both accumulating outputs and aborting computation with a final
output.
Synopsis
- class Monad m => MonadChronicle c m | m -> c where
- type Chronicle c = ChronicleT c Identity
- runChronicle :: Chronicle c a -> These c a
- newtype ChronicleT c m a = ChronicleT {
- runChronicleT :: m (These c a)
- class Semigroup a => Monoid a where
- module Control.Monad
- module Control.Monad.Trans
Type class for Chronicle-style monads
class Monad m => MonadChronicle c m | m -> c where Source #
disclose :: Default a => c -> m a Source #
is an action that records the output disclose
cc
and returns a
value.Default
This is a convenience function for reporting non-fatal errors in one
branch a case
, or similar scenarios when there is no meaningful
result but a placeholder of sorts is needed in order to continue.
is an action that ends with a final record confess
cc
.
Equivalent to throwError
for the Error
monad.
memento :: m a -> m (Either c a) Source #
is an action that executes the action memento
mm
, returning either
its record if it ended with confess
, or its final value otherwise, with
any record added to the current record.
Similar to catchError
in the Error
monad, but with a notion of
non-fatal errors (which are accumulated) vs. fatal errors (which are caught
without accumulating).
absolve :: a -> m a -> m a Source #
is an action that executes the action absolve
x mm
and discards any
record it had. The default value x
will be used if m
ended via
confess
.
condemn :: m a -> m a Source #
is an action that executes the action condemn
mm
and keeps its value
only if it had no record. Otherwise, the value (if any) will be discarded
and only the record kept.
This can be seen as converting non-fatal errors into fatal ones.
retcon :: (c -> c) -> m a -> m a Source #
is an action that executes the action retcon
f mm
and applies the
function f
to its output, leaving the return value unchanged.
chronicle :: These c a -> m a Source #
lifts a plain 'These c a' value into a chronicle
mMonadChronicle
instance.
Instances
The ChronicleT monad transformer
type Chronicle c = ChronicleT c Identity Source #
runChronicle :: Chronicle c a -> These c a Source #
newtype ChronicleT c m a Source #
The ChronicleT
monad transformer.
The return
function produces a computation with no output, and >>=
combines multiple outputs with mappend
.
ChronicleT | |
|
Instances
class Semigroup a => Monoid a where #
The class of monoids (types with an associative binary operation that has an identity). Instances should satisfy the following laws:
x
<>
mempty
= xmempty
<>
x = xx
(<>
(y<>
z) = (x<>
y)<>
zSemigroup
law)mconcat
=foldr
'(<>)'mempty
The method names refer to the monoid of lists under concatenation, but there are many other instances.
Some types can be viewed as a monoid in more than one way,
e.g. both addition and multiplication on numbers.
In such cases we often define newtype
s and make those instances
of Monoid
, e.g. Sum
and Product
.
NOTE: Semigroup
is a superclass of Monoid
since base-4.11.0.0.
Identity of mappend
An associative operation
NOTE: This method is redundant and has the default
implementation
since base-4.11.0.0.mappend
= '(<>)'
Fold a list using the monoid.
For most types, the default definition for mconcat
will be
used, but the function is included in the class definition so
that an optimized version can be provided for specific types.
Instances
Monoid Ordering | Since: base-2.1 |
Monoid () | Since: base-2.1 |
Monoid ByteString | |
Defined in Data.ByteString.Internal mempty :: ByteString # mappend :: ByteString -> ByteString -> ByteString # mconcat :: [ByteString] -> ByteString # | |
Monoid ByteString | |
Defined in Data.ByteString.Lazy.Internal mempty :: ByteString # mappend :: ByteString -> ByteString -> ByteString # mconcat :: [ByteString] -> ByteString # | |
Monoid Builder | |
Monoid Series | |
Monoid More | |
Monoid All | Since: base-2.1 |
Monoid Any | Since: base-2.1 |
Monoid ShortByteString | |
Defined in Data.ByteString.Short.Internal mappend :: ShortByteString -> ShortByteString -> ShortByteString # mconcat :: [ShortByteString] -> ShortByteString # | |
Monoid IntSet | |
Monoid Doc | |
Monoid ByteArray | |
Monoid [a] | Since: base-2.1 |
Semigroup a => Monoid (Maybe a) | Lift a semigroup into Since 4.11.0: constraint on inner Since: base-2.1 |
Monoid a => Monoid (IO a) | Since: base-4.9.0.0 |
Monoid p => Monoid (Par1 p) | Since: base-4.12.0.0 |
Monoid (IResult a) | |
Monoid (Result a) | |
Monoid (Parser a) | |
(Ord a, Bounded a) => Monoid (Min a) | Since: base-4.9.0.0 |
(Ord a, Bounded a) => Monoid (Max a) | Since: base-4.9.0.0 |
Monoid m => Monoid (WrappedMonoid m) | Since: base-4.9.0.0 |
Defined in Data.Semigroup mempty :: WrappedMonoid m # mappend :: WrappedMonoid m -> WrappedMonoid m -> WrappedMonoid m # mconcat :: [WrappedMonoid m] -> WrappedMonoid m # | |
Semigroup a => Monoid (Option a) | Since: base-4.9.0.0 |
Monoid a => Monoid (Identity a) | Since: base-4.9.0.0 |
Monoid (First a) | Since: base-2.1 |
Monoid (Last a) | Since: base-2.1 |
Monoid a => Monoid (Dual a) | Since: base-2.1 |
Monoid (Endo a) | Since: base-2.1 |
Num a => Monoid (Sum a) | Since: base-2.1 |
Num a => Monoid (Product a) | Since: base-2.1 |
Monoid a => Monoid (Down a) | Since: base-4.11.0.0 |
Monoid (PutM ()) | |
Monoid (IntMap a) | |
Monoid (Seq a) | |
Ord a => Monoid (Set a) | |
Monoid (DList a) | |
Prim a => Monoid (Vector a) | |
Storable a => Monoid (Vector a) | |
(Hashable a, Eq a) => Monoid (HashSet a) | |
Monoid (Vector a) | |
Monoid (Doc a) | |
PrimUnlifted a => Monoid (UnliftedArray a) | Since: primitive-0.6.4.0 |
Defined in Data.Primitive.UnliftedArray mempty :: UnliftedArray a # mappend :: UnliftedArray a -> UnliftedArray a -> UnliftedArray a # mconcat :: [UnliftedArray a] -> UnliftedArray a # | |
Monoid (PrimArray a) | Since: primitive-0.6.4.0 |
Monoid (SmallArray a) | |
Defined in Data.Primitive.SmallArray mempty :: SmallArray a # mappend :: SmallArray a -> SmallArray a -> SmallArray a # mconcat :: [SmallArray a] -> SmallArray a # | |
Monoid (Array a) | |
Monoid (MergeSet a) | |
Monoid b => Monoid (a -> b) | Since: base-2.1 |
Monoid (U1 p) | Since: base-4.12.0.0 |
(Monoid a, Monoid b) => Monoid (a, b) | Since: base-2.1 |
Monoid a => Monoid (ST s a) | Since: base-4.11.0.0 |
(Eq k, Hashable k) => Monoid (HashMap k v) | |
Ord k => Monoid (Map k v) | |
Monoid (Parser i a) | |
Monoid (Proxy s) | Since: base-4.7.0.0 |
Monoid (ReifiedFold s a) | |
Defined in Control.Lens.Reified mempty :: ReifiedFold s a # mappend :: ReifiedFold s a -> ReifiedFold s a -> ReifiedFold s a # mconcat :: [ReifiedFold s a] -> ReifiedFold s a # | |
Monoid (Deepening i a) | This is an illegal |
Monoid (f a) => Monoid (Indexing f a) |
|
Monoid (f p) => Monoid (Rec1 f p) | Since: base-4.12.0.0 |
(Monoid a, Monoid b, Monoid c) => Monoid (a, b, c) | Since: base-2.1 |
Monoid a => Monoid (Const a b) | Since: base-4.9.0.0 |
(Applicative f, Monoid a) => Monoid (Ap f a) | Since: base-4.12.0.0 |
Alternative f => Monoid (Alt f a) | Since: base-4.8.0.0 |
Monoid (ReifiedIndexedFold i s a) | |
Defined in Control.Lens.Reified mempty :: ReifiedIndexedFold i s a # mappend :: ReifiedIndexedFold i s a -> ReifiedIndexedFold i s a -> ReifiedIndexedFold i s a # mconcat :: [ReifiedIndexedFold i s a] -> ReifiedIndexedFold i s a # | |
ArrowPlus p => Monoid (Tambara p a b) | |
Reifies s (ReifiedMonoid a) => Monoid (ReflectedMonoid a s) | |
Defined in Data.Reflection mempty :: ReflectedMonoid a s # mappend :: ReflectedMonoid a s -> ReflectedMonoid a s -> ReflectedMonoid a s # mconcat :: [ReflectedMonoid a s] -> ReflectedMonoid a s # | |
(Semigroup a, Monoid a) => Monoid (Tagged s a) | |
Monoid a => Monoid (Constant a b) | |
Monoid c => Monoid (K1 i c p) | Since: base-4.12.0.0 |
(Monoid (f p), Monoid (g p)) => Monoid ((f :*: g) p) | Since: base-4.12.0.0 |
(Monoid a, Monoid b, Monoid c, Monoid d) => Monoid (a, b, c, d) | Since: base-2.1 |
Monoid (f p) => Monoid (M1 i c f p) | Since: base-4.12.0.0 |
Monoid (f (g p)) => Monoid ((f :.: g) p) | Since: base-4.12.0.0 |
(Monoid a, Monoid b, Monoid c, Monoid d, Monoid e) => Monoid (a, b, c, d, e) | Since: base-2.1 |
module Control.Monad
module Control.Monad.Trans