{-# LANGUAGE DerivingVia #-}{-# LANGUAGE FlexibleInstances #-}{-# LANGUAGE FunctionalDependencies #-}{-# LANGUAGE KindSignatures #-}{-# LANGUAGE ScopedTypeVariables #-}{-# LANGUAGE StandaloneDeriving #-}{-# LANGUAGE Trustworthy #-}{-# LANGUAGE TupleSections #-}{-# LANGUAGE UndecidableInstances #-}-- Later GHCs infer DerivingVia as not Safe-- We just downgrade to Trustworthy and go fish{-# OPTIONS_GHC -Wno-trustworthy-safe #-}-- | Module: Control.Monad.Accum-- Copyright: (C) Koz Ross 2022, Manuel Bärenz 2021-- License: BSD-3-Clause (see the LICENSE file)-- Maintainer: koz.ross@retro-freedom.nz-- Stability: Experimental-- Portability: GHC only---- [Computation type:] Accumulation (either append-only state, or writer with-- the ability to read all previous input).---- [Binding strategy:] Binding a function to a monadic value monoidally-- accumulates the subcomputations (that is, using '<>').---- [Useful for:] Logging, patch-style tracking.---- [Zero and plus:] None.---- [Example type:] @'Control.Monad.Trans.Accum.Accum' w a@---- = A note on commutativity---- Some effects are /commutative/: it doesn't matter which you resolve first, as-- all possible orderings of commutative effects are isomorphic. Consider, for-- example, the reader and state effects, as exemplified by 'ReaderT' and-- 'StrictState.StateT' respectively. If we have-- @'ReaderT' r ('StrictState.State' s) a@, this is-- effectively @r -> 'StrictState.State' s a ~ r -> s -> (a, s)@; if we instead have-- @'StrictState.StateT' s ('Control.Monad.Trans.Reader.Reader' r) a@, this is effectively-- @s -> 'Control.Monad.Trans.Reader' r (a, s) ~ s -> r -> (a, s)@. Since we-- can always reorder function arguments (for example, using 'flip', as in-- this case) without changing the result, these are-- isomorphic, showing that reader and state are /commutative/, or, more-- precisely, /commute with each other/.---- However, this isn't generally the case. Consider instead the error and state-- effects, as exemplified by 'MaybeT' and 'StrictState.StateT' respectively.-- If we have @'MaybeT' ('Control.Monad.Trans.State.Strict.State' s) a@, this-- is effectively @'State' s ('Maybe' a) ~ s -> ('Maybe' a, s)@: put simply,-- the error can occur only in the /result/, but-- not the state, which always \'survives\'. On the other hand, if we have-- @'StrictState.StateT' s 'Maybe' a@, this is instead @s -> 'Maybe' (a, s)@: here,-- if we error, we lose /both/ the state and the result! Thus, error and state effects-- do /not/ commute with each other.---- As the MTL is capability-based, we support any ordering of non-commutative-- effects on an equal footing. Indeed, if you wish to use-- 'Control.Monad.State.Class.MonadState', for-- example, whether your final monadic stack ends up being @'MaybeT'-- ('Control.Monad.Trans.State.Strict.State' s)-- a@, @'StrictState.StateT' s 'Maybe' a@, or anything else, you will be able to write your-- desired code without having to consider such differences. However, the way we-- /implement/ these capabilities for any given transformer (or rather, any-- given transformed stack) /is/ affected by this ordering unless the effects in-- question are commutative.---- We note in this module which effects the accumulation effect does and doesn't-- commute with; we also note on implementations with non-commutative-- transformers what the outcome will be. Note that, depending on how the-- \'inner monad\' is structured, this may be more complex than we note: we-- describe only what impact the \'outer effect\' has, not what else might be in-- the stack.---- = Commutativity of accumulation---- The accumulation effect commutes with the identity effect ('IdentityT'),-- reader, writer or state effects ('ReaderT', 'StrictWriter.WriterT', 'StrictState.StateT' and any-- combination, including 'StrictRWS.RWST' for example) and with itself. It does /not/-- commute with anything else.moduleControl.Monad.Accum(-- * Type classMonadAccum (..),-- * Lifting helper typeLiftingAccum (..),-- * Other functionslooks ,)whereimportControl.Monad.Trans.Accum(AccumT)importqualifiedControl.Monad.Trans.AccumasAccumimportControl.Monad.Trans.Class(MonadTrans(lift))importControl.Monad.Trans.Cont(ContT)importControl.Monad.Trans.Except(ExceptT)importControl.Monad.Trans.Identity(IdentityT)importControl.Monad.Trans.Maybe(MaybeT)importqualifiedControl.Monad.Trans.RWS.CPSasCPSRWSimportqualifiedControl.Monad.Trans.RWS.LazyasLazyRWSimportqualifiedControl.Monad.Trans.RWS.StrictasStrictRWSimportControl.Monad.Trans.Reader(ReaderT)importControl.Monad.Trans.Select(SelectT)importqualifiedControl.Monad.Trans.State.LazyasLazyStateimportqualifiedControl.Monad.Trans.State.StrictasStrictStateimportqualifiedControl.Monad.Trans.Writer.CPSasCPSWriterimportqualifiedControl.Monad.Trans.Writer.LazyasLazyWriterimportqualifiedControl.Monad.Trans.Writer.StrictasStrictWriterimportData.Functor(($>))importData.Functor.Identity(Identity)importData.Kind(Type)-- | The capability to accumulate. This can be seen in one of two ways:---- * A 'Control.Monad.State.Class.MonadState' which can only append (using '<>'); or-- * A 'Control.Monad.Writer.Class.MonadWriter' (limited to-- 'Control.Monad.Writer.Class.tell') with the ability to view the result of all previous-- 'Control.Monad.Writer.Class.tell's.---- = Laws---- 'accum' should obey the following:---- 1. @'accum' ('const' (x, 'mempty'))@ @=@ @'pure' x@-- 2. @'accum' f '*>' 'accum' g@ @=@-- @'accum' '$' \acc -> let (_, v) = f acc-- (res, w) = g (acc '<>' v) in (res, v '<>' w)@---- If you choose to define 'look' and 'add' instead, their definitions must obey-- the following:---- 1. @'look' '*>' 'look'@ @=@ @'look'@-- 2. @'add' 'mempty'@ @=@ @'pure' ()@-- 3. @'add' x '*>' 'add' y@ @=@ @'add' (x '<>' y)@-- 4. @'add' x '*>' 'look'@ @=@ @'look' '>>=' \w -> 'add' x '$>' w '<>' x@---- If you want to define both, the relationship between them is as follows.-- These are also the default definitions.---- 1. @'look'@ @=@ @'accum' '$' \acc -> (acc, mempty)@-- 2. @'add' x@ @=@ @'accum' '$' \acc -> ('()', x)@-- 3. @'accum' f@ @=@ @'look' >>= \acc -> let (res, v) = f acc in 'add' v '$>' res@---- @since 2.3class(Monoidw ,Monadm )=>MonadAccum w m |m ->w where-- | Retrieve the accumulated result so far.look ::m w look =forall w (m :: * -> *) a. MonadAccum w m => (w -> (a, w)) -> m a
accum (,forall a. Monoid a => a
mempty)-- | Append a value to the result.add ::w ->m ()add w
x =forall w (m :: * -> *) a. MonadAccum w m => (w -> (a, w)) -> m a
accum forall a b. (a -> b) -> a -> b
$forall a b. a -> b -> a
const((),w
x )-- | Embed a simple accumulation action into the monad.accum ::(w ->(a ,w ))->m a accum w -> (a, w)
f =forall w (m :: * -> *). MonadAccum w m => m w
look forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=\w
acc ->let(a
res ,w
v )=w -> (a, w)
f w
acc inforall w (m :: * -> *). MonadAccum w m => w -> m ()
add w
v forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$>a
res {-# MINIMALaccum |look ,add #-}-- | @since 2.3instance(Monoidw )=>MonadAccum w (AccumTw Identity)wherelook :: AccumT w Identity w
look =forall w (m :: * -> *). (Monoid w, Monad m) => AccumT w m w
Accum.lookadd :: w -> AccumT w Identity ()
add =forall (m :: * -> *) w. Monad m => w -> AccumT w m ()
Accum.addaccum :: forall a. (w -> (a, w)) -> AccumT w Identity a
accum =forall (m :: * -> *) w a. Monad m => (w -> (a, w)) -> AccumT w m a
Accum.accum-- | The accumulated value \'survives\' an error: even if the-- computation fails to deliver a result, we still have an accumulated value.---- @since 2.3derivingvia(LiftingAccum MaybeTm )instance(MonadAccum w m )=>MonadAccum w (MaybeTm )-- | The continuation can see, and interact with, the accumulated value.---- @since 2.3derivingvia(LiftingAccum (ContTr )m )instance(MonadAccum w m )=>MonadAccum w (ContTr m )-- | The accumulated value \'survives\' an exception: even if the computation-- fails to deliver a result, we still have an accumulated value.---- @since 2.3derivingvia(LiftingAccum (ExceptTe )m )instance(MonadAccum w m )=>MonadAccum w (ExceptTe m )-- | @since 2.3derivingvia(LiftingAccum IdentityTm )instance(MonadAccum w m )=>MonadAccum w (IdentityTm )-- | @since 2.3derivingvia(LiftingAccum (CPSRWS.RWSTr w s )m )instance(MonadAccum w' m )=>MonadAccum w' (CPSRWS.RWSTr w s m )-- | @since 2.3derivingvia(LiftingAccum (LazyRWS.RWSTr w s )m )instance(MonadAccum w' m ,Monoidw )=>MonadAccum w' (LazyRWS.RWSTr w s m )-- | @since 2.3derivingvia(LiftingAccum (StrictRWS.RWSTr w s )m )instance(MonadAccum w' m ,Monoidw )=>MonadAccum w' (StrictRWS.RWSTr w s m )-- | @since 2.3derivingvia(LiftingAccum (ReaderTr )m )instance(MonadAccum w m )=>MonadAccum w (ReaderTr m )-- | The \'ranking\' function gains the ability to accumulate @w@s each time it-- is called. The final result will include the entire log of all such calls.---- @since 2.3derivingvia(LiftingAccum (SelectTr )m )instance(MonadAccum w m )=>MonadAccum w (SelectTr m )-- | @since 2.3derivingvia(LiftingAccum (LazyState.StateTs )m )instance(MonadAccum w m )=>MonadAccum w (LazyState.StateTs m )-- | @since 2.3derivingvia(LiftingAccum (StrictState.StateTs )m )instance(MonadAccum w m )=>MonadAccum w (StrictState.StateTs m )-- | @since 2.3derivingvia(LiftingAccum (CPSWriter.WriterTw )m )instance(MonadAccum w' m )=>MonadAccum w' (CPSWriter.WriterTw m )-- | @since 2.3derivingvia(LiftingAccum (LazyWriter.WriterTw )m )instance(MonadAccum w' m ,Monoidw )=>MonadAccum w' (LazyWriter.WriterTw m )-- | @since 2.3derivingvia(LiftingAccum (StrictWriter.WriterTw )m )instance(MonadAccum w' m ,Monoidw )=>MonadAccum w' (StrictWriter.WriterTw m )-- | A helper type to decrease boilerplate when defining new transformer-- instances of 'MonadAccum'.---- Most of the instances in this module are derived using this method; for-- example, our instance of 'ExceptT' is derived as follows:---- > deriving via (LiftingAccum (ExceptT e) m) instance (MonadAccum w m) =>-- > MonadAccum w (ExceptT e m)---- @since 2.3newtypeLiftingAccum (t ::(Type->Type)->Type->Type)(m ::Type->Type)(a ::Type)=LiftingAccum (t m a )deriving(-- | @since 2.3forall a b. a -> LiftingAccum t m b -> LiftingAccum t m a
forall a b. (a -> b) -> LiftingAccum t m a -> LiftingAccum t m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a b.
Functor (t m) =>
a -> LiftingAccum t m b -> LiftingAccum t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a b.
Functor (t m) =>
(a -> b) -> LiftingAccum t m a -> LiftingAccum t m b
<$ :: forall a b. a -> LiftingAccum t m b -> LiftingAccum t m a
$c<$ :: forall (t :: (* -> *) -> * -> *) (m :: * -> *) a b.
Functor (t m) =>
a -> LiftingAccum t m b -> LiftingAccum t m a
fmap :: forall a b. (a -> b) -> LiftingAccum t m a -> LiftingAccum t m b
$cfmap :: forall (t :: (* -> *) -> * -> *) (m :: * -> *) a b.
Functor (t m) =>
(a -> b) -> LiftingAccum t m a -> LiftingAccum t m b
Functor,-- | @since 2.3forall a. a -> LiftingAccum t m a
forall a b.
LiftingAccum t m a -> LiftingAccum t m b -> LiftingAccum t m a
forall a b.
LiftingAccum t m a -> LiftingAccum t m b -> LiftingAccum t m b
forall a b.
LiftingAccum t m (a -> b)
-> LiftingAccum t m a -> LiftingAccum t m b
forall a b c.
(a -> b -> c)
-> LiftingAccum t m a -> LiftingAccum t m b -> LiftingAccum t m c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
forall {t :: (* -> *) -> * -> *} {m :: * -> *}.
Applicative (t m) =>
Functor (LiftingAccum t m)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
Applicative (t m) =>
a -> LiftingAccum t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a b.
Applicative (t m) =>
LiftingAccum t m a -> LiftingAccum t m b -> LiftingAccum t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a b.
Applicative (t m) =>
LiftingAccum t m a -> LiftingAccum t m b -> LiftingAccum t m b
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a b.
Applicative (t m) =>
LiftingAccum t m (a -> b)
-> LiftingAccum t m a -> LiftingAccum t m b
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a b c.
Applicative (t m) =>
(a -> b -> c)
-> LiftingAccum t m a -> LiftingAccum t m b -> LiftingAccum t m c
<* :: forall a b.
LiftingAccum t m a -> LiftingAccum t m b -> LiftingAccum t m a
$c<* :: forall (t :: (* -> *) -> * -> *) (m :: * -> *) a b.
Applicative (t m) =>
LiftingAccum t m a -> LiftingAccum t m b -> LiftingAccum t m a
*> :: forall a b.
LiftingAccum t m a -> LiftingAccum t m b -> LiftingAccum t m b
$c*> :: forall (t :: (* -> *) -> * -> *) (m :: * -> *) a b.
Applicative (t m) =>
LiftingAccum t m a -> LiftingAccum t m b -> LiftingAccum t m b
liftA2 :: forall a b c.
(a -> b -> c)
-> LiftingAccum t m a -> LiftingAccum t m b -> LiftingAccum t m c
$cliftA2 :: forall (t :: (* -> *) -> * -> *) (m :: * -> *) a b c.
Applicative (t m) =>
(a -> b -> c)
-> LiftingAccum t m a -> LiftingAccum t m b -> LiftingAccum t m c
<*> :: forall a b.
LiftingAccum t m (a -> b)
-> LiftingAccum t m a -> LiftingAccum t m b
$c<*> :: forall (t :: (* -> *) -> * -> *) (m :: * -> *) a b.
Applicative (t m) =>
LiftingAccum t m (a -> b)
-> LiftingAccum t m a -> LiftingAccum t m b
pure :: forall a. a -> LiftingAccum t m a
$cpure :: forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
Applicative (t m) =>
a -> LiftingAccum t m a
Applicative,-- | @since 2.3forall a. a -> LiftingAccum t m a
forall a b.
LiftingAccum t m a -> LiftingAccum t m b -> LiftingAccum t m b
forall a b.
LiftingAccum t m a
-> (a -> LiftingAccum t m b) -> LiftingAccum t m b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
forall {t :: (* -> *) -> * -> *} {m :: * -> *}.
Monad (t m) =>
Applicative (LiftingAccum t m)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
Monad (t m) =>
a -> LiftingAccum t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a b.
Monad (t m) =>
LiftingAccum t m a -> LiftingAccum t m b -> LiftingAccum t m b
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a b.
Monad (t m) =>
LiftingAccum t m a
-> (a -> LiftingAccum t m b) -> LiftingAccum t m b
return :: forall a. a -> LiftingAccum t m a
$creturn :: forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
Monad (t m) =>
a -> LiftingAccum t m a
>> :: forall a b.
LiftingAccum t m a -> LiftingAccum t m b -> LiftingAccum t m b
$c>> :: forall (t :: (* -> *) -> * -> *) (m :: * -> *) a b.
Monad (t m) =>
LiftingAccum t m a -> LiftingAccum t m b -> LiftingAccum t m b
>>= :: forall a b.
LiftingAccum t m a
-> (a -> LiftingAccum t m b) -> LiftingAccum t m b
$c>>= :: forall (t :: (* -> *) -> * -> *) (m :: * -> *) a b.
Monad (t m) =>
LiftingAccum t m a
-> (a -> LiftingAccum t m b) -> LiftingAccum t m b
Monad)via(t m )-- | @since 2.3instance(MonadTranst ,Monad(t m ),MonadAccum w m )=>MonadAccum w (LiftingAccum t m )wherelook :: LiftingAccum t m w
look =forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
t m a -> LiftingAccum t m a
LiftingAccum forall b c a. (b -> c) -> (a -> b) -> a -> c
.forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
liftforall a b. (a -> b) -> a -> b
$forall w (m :: * -> *). MonadAccum w m => m w
look add :: w -> LiftingAccum t m ()
add w
x =forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
t m a -> LiftingAccum t m a
LiftingAccum forall b c a. (b -> c) -> (a -> b) -> a -> c
.forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
liftforall a b. (a -> b) -> a -> b
$forall w (m :: * -> *). MonadAccum w m => w -> m ()
add w
x accum :: forall a. (w -> (a, w)) -> LiftingAccum t m a
accum w -> (a, w)
f =forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
t m a -> LiftingAccum t m a
LiftingAccum forall b c a. (b -> c) -> (a -> b) -> a -> c
.forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
liftforall a b. (a -> b) -> a -> b
$forall w (m :: * -> *) a. MonadAccum w m => (w -> (a, w)) -> m a
accum w -> (a, w)
f -- | Retrieve a function of the accumulated value.---- @since 2.3looks ::forall(a ::Type)(m ::Type->Type)(w ::Type).(MonadAccum w m )=>(w ->a )->m a looks :: forall a (m :: * -> *) w. MonadAccum w m => (w -> a) -> m a
looks w -> a
f =w -> a
f forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>forall w (m :: * -> *). MonadAccum w m => m w
look