{-# LANGUAGE UndecidableInstances #-}

{- | A general state monad transformer with separate types for the state and the possible changes, updates, commits, or diffs.

A typical example is a large state type (e.g., a user entry in a database of a webshop)
which only allows small changes (e.g., adding or deleting a delivery address):

@
data User = User
  { userName :: Text
  , password :: Hash
  , ...
  , addresses :: Map Text Address
  , ...
  }
@

When we want to be able to /restrict/ to specific changes (e.g., only the addresses should be changed),
and we want to be able to /inspect/ the changes,
then 'ChangesetT' is a good choice.
In our example, a general function on addresses, or even on the whole user, cannot be inspected.
But if we restrict to only adding or deleting addresses,
we can define a custom datatype such as:

@
data ChangeAddress
  -- | Add an address under a given key
  = Add Text Address
  -- | Delete the address for the given key
  | Delete Text
@

Changes for such a type (or rather, for the monoid @'Changes' ChangeAddress@) can be inspected.

'ChangesetT' is a very general state monad transformer.
It has all the standard state monads from @transformers@ as special cases:

+--------------------------+---------------+-------------+---------------------------------------------+
| Transformer special case | State type    | Monoid type | Intuition                                   |
+==========================+===============+=============+=============================================+
| @'WriterT' w@            | '()'          | @w@         | No possibility to observe the current state |
+--------------------------+---------------+-------------+---------------------------------------------+
| @'AccumT' w@             | @'Regular' w@ | @w@         | The state is the same type as the changes   |
+--------------------------+---------------+-------------+---------------------------------------------+
| @'StateT' s@             | @s@           | @First s@   | The change overwrites all previous changes  |
+--------------------------+---------------+-------------+---------------------------------------------+

The @changeset@ ecosystem has support for standard @containers@ and optics from @lens@
by providing the packages [@changeset-containers@](https://hackage.haskell.org/package/changeset-containers) and [@changeset-lens@](https://hackage.haskell.org/package/changeset-lens).

Orphan instances for newer (2.3) @mtl@ classes such as 'Control.Monad.Accum.MonadAccum' and 'Control.Monad.Selet.MonadSelect' can be found in "Control.Monad.Trans.Changeset.Orphan".
These are only provided for GHC >= 9.6.
-}
module Control.Monad.Trans.Changeset where

-- base
import Control.Applicative (Alternative (..))
import Control.Monad (MonadPlus)
import Data.Bifunctor (Bifunctor (..))
import Data.Foldable (Foldable (..))
import Data.Function ((&))
import Data.Functor ((<&>))
import Data.Functor.Identity (Identity (runIdentity))
import Data.Tuple (swap)
import Prelude hiding (Foldable ())

-- containers
import Data.Sequence (Seq, fromList, (|>))

-- transformers
import Control.Monad.Trans.Class

-- mtl
import Control.Monad.Error.Class (MonadError (..))
import Control.Monad.Morph (MFunctor (..), MMonad (..))
import Control.Monad.RWS.Class (MonadRWS)
import Control.Monad.Reader.Class (MonadReader (..))
import Control.Monad.State.Class (MonadState (..))
import Control.Monad.Writer.Class (MonadWriter (..))

-- witherable
import Witherable (Filterable (mapMaybe), Witherable (wither))

-- changeset
import Control.Monad.Changeset.Class
import Data.Kind (Type)
import Data.Monoid (Last (..))
import Data.Monoid.RightAction (RightAction, actRight)

-- * The 'ChangesetT' monad transformer

{- | Hold a state of type @s@, which is allowed to be mutated by an action of a monoid @w.@

The state @s@ has the role of the current state.
An @a@ is computed while performing a side effect in @m@,
and these can depend on the current state.

The type @w@ encodes /changes/ (or updates, edits, commits, diffs, patches ...) to the state @s.@
This relation is captured by the 'RightAction' type class from @monoid-extras.@
It contains a method, @'act' :: w -> s -> s@,
which implements the semantics of @w@ as the type of updates to @s.@

The standard example is that of a big record where we only want to change a small portion:

@
data User = User
  { name :: Text
  , password :: Hash
  , ...
  , addresses :: Map Text Address
  , ...
  }
@

If all changes that our business logic should be able to perform are adding or deleting an address,
it would be cumbersome to work in a @'State' User@ monad, since we only want to modify a small portion.
Instead, we define a type of /changes/ to @User@:

@
data ChangeAddress
  -- | Add an address under a given key
  = Add Text Address
  -- | Delete the address for the given key
  | Delete Text

instance RightAction ChangeAddress User where
  act = ...
@

Now we can conveniently work in the monad @'ChangesetT' User [ChangeAddress] m.@
(Note the list type which gives us a free 'Monoid' instance.)
Here we can perform operations like @'change' [Add "home" homeAddress]@ or @'change' [Delete "work"]@ to modify the addresses,
'current' to view the current state (containing all changes so far),
or apply a more complex function like @'revise' $ const $ filter (/= Delete "default")@ which would remove all changes that attempt to delete the @"default"@ address.

As a further example, if @s@ represents some type of time stamps, then @w@ can be a type of durations:
Two timestamps cannot be added, but two durations can.
A computation in @'ChangesetT' s w@ could then have access to some simulated notion of "current time",
while being able to add symbolic "delays".

Another class of examples arises operation based or commutative Conflict-free Replicated Data Type (CRDT).
Then @s@ is the internal state (the "payload") of the CRDT, and @w@ is the update operation.
For example @s = Int@, and for @w@ we would define @data Count = Increment | Decrement.@

The 'Monad' and 'Applicative' classes are defined by performing the first action,
then 'act'ing with the monoid output onto the state, and then perform the second action with the updated state.
So for example, @'change' Increment >> 'current'@ is different from @'current' >>= (\n -> 'change' Increment >> return n)@:
If we apply @'flip' 'evalChangeset' 0@ to each,
the first one would return 1, while the second returns 0.

So, if at any point in a @do@ notation we want to inspect the current state,
we can assume that all previous changes have been applied.
In that sense, this monad behaves very much like any other state monad transformer.
-}
newtype ChangesetT s w m a = ChangesetT
  { forall s w (m :: * -> *) a. ChangesetT s w m a -> s -> m (w, a)
getChangesetT :: s -> m (w, a)
  -- ^ Extract the changeset function without applying it to the state.
  }
  deriving ((forall a b. (a -> b) -> ChangesetT s w m a -> ChangesetT s w m b)
-> (forall a b. a -> ChangesetT s w m b -> ChangesetT s w m a)
-> Functor (ChangesetT s w m)
forall a b. a -> ChangesetT s w m b -> ChangesetT s w m a
forall a b. (a -> b) -> ChangesetT s w m a -> ChangesetT s w m b
forall s w (m :: * -> *) a b.
Functor m =>
a -> ChangesetT s w m b -> ChangesetT s w m a
forall s w (m :: * -> *) a b.
Functor m =>
(a -> b) -> ChangesetT s w m a -> ChangesetT s w m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall s w (m :: * -> *) a b.
Functor m =>
(a -> b) -> ChangesetT s w m a -> ChangesetT s w m b
fmap :: forall a b. (a -> b) -> ChangesetT s w m a -> ChangesetT s w m b
$c<$ :: forall s w (m :: * -> *) a b.
Functor m =>
a -> ChangesetT s w m b -> ChangesetT s w m a
<$ :: forall a b. a -> ChangesetT s w m b -> ChangesetT s w m a
Functor)

-- ** Running a 'ChangesetT' action

-- | Extract the changes that would be applied.
getChangeT :: (Functor m) => ChangesetT s w m a -> s -> m w
getChangeT :: forall (m :: * -> *) s w a.
Functor m =>
ChangesetT s w m a -> s -> m w
getChangeT ChangesetT {s -> m (w, a)
getChangesetT :: forall s w (m :: * -> *) a. ChangesetT s w m a -> s -> m (w, a)
getChangesetT :: s -> m (w, a)
getChangesetT} s
s = s -> m (w, a)
getChangesetT s
s m (w, a) -> ((w, a) -> w) -> m w
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (w, a) -> w
forall a b. (a, b) -> a
fst

-- | Run the action with an initial state and apply all resulting changes to it.
runChangesetT :: (Functor m, RightAction w s) => ChangesetT s w m a -> s -> m (a, s)
runChangesetT :: forall (m :: * -> *) w s a.
(Functor m, RightAction w s) =>
ChangesetT s w m a -> s -> m (a, s)
runChangesetT ChangesetT {s -> m (w, a)
getChangesetT :: forall s w (m :: * -> *) a. ChangesetT s w m a -> s -> m (w, a)
getChangesetT :: s -> m (w, a)
getChangesetT} s
s = s -> m (w, a)
getChangesetT s
s m (w, a) -> ((w, a) -> (a, s)) -> m (a, s)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \(w
w, a
a) -> (a
a, s -> w -> s
forall m s. RightAction m s => s -> m -> s
actRight s
s w
w)

-- | Run the action with an initial state and extract only the value.
evalChangesetT :: (Functor m, RightAction w s) => ChangesetT s w m a -> s -> m a
evalChangesetT :: forall (m :: * -> *) w s a.
(Functor m, RightAction w s) =>
ChangesetT s w m a -> s -> m a
evalChangesetT = (m (a, s) -> m a) -> (s -> m (a, s)) -> s -> m a
forall a b. (a -> b) -> (s -> a) -> s -> b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((a, s) -> a) -> m (a, s) -> m a
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, s) -> a
forall a b. (a, b) -> a
fst) ((s -> m (a, s)) -> s -> m a)
-> (ChangesetT s w m a -> s -> m (a, s))
-> ChangesetT s w m a
-> s
-> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChangesetT s w m a -> s -> m (a, s)
forall (m :: * -> *) w s a.
(Functor m, RightAction w s) =>
ChangesetT s w m a -> s -> m (a, s)
runChangesetT

-- | Run the action with an initial state and extract only the state.
execChangesetT :: (Functor m, RightAction w s) => ChangesetT s w m a -> s -> m s
execChangesetT :: forall (m :: * -> *) w s a.
(Functor m, RightAction w s) =>
ChangesetT s w m a -> s -> m s
execChangesetT = (m (a, s) -> m s) -> (s -> m (a, s)) -> s -> m s
forall a b. (a -> b) -> (s -> a) -> s -> b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((a, s) -> s) -> m (a, s) -> m s
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, s) -> s
forall a b. (a, b) -> b
snd) ((s -> m (a, s)) -> s -> m s)
-> (ChangesetT s w m a -> s -> m (a, s))
-> ChangesetT s w m a
-> s
-> m s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChangesetT s w m a -> s -> m (a, s)
forall (m :: * -> *) w s a.
(Functor m, RightAction w s) =>
ChangesetT s w m a -> s -> m (a, s)
runChangesetT

-- * 'ChangesetT' API with relaxed constraints

{- | See 'changeset'.

The @A@ suffix means that only 'Applicative' is required, not 'Monad'.
-}
changesetA :: (Applicative m) => (s -> (a, w)) -> ChangesetT s w m a
changesetA :: forall (m :: * -> *) s a w.
Applicative m =>
(s -> (a, w)) -> ChangesetT s w m a
changesetA = (s -> m (w, a)) -> ChangesetT s w m a
forall s w (m :: * -> *) a. (s -> m (w, a)) -> ChangesetT s w m a
ChangesetT ((s -> m (w, a)) -> ChangesetT s w m a)
-> ((s -> (a, w)) -> s -> m (w, a))
-> (s -> (a, w))
-> ChangesetT s w m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a, w) -> m (w, a)) -> (s -> (a, w)) -> s -> m (w, a)
forall a b. (a -> b) -> (s -> a) -> s -> b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((w, a) -> m (w, a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((w, a) -> m (w, a)) -> ((a, w) -> (w, a)) -> (a, w) -> m (w, a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, w) -> (w, a)
forall a b. (a, b) -> (b, a)
swap)

{- | See 'change'.

The @A@ suffix means that only 'Applicative' is required, not 'Monad'.
-}
changeA :: (Applicative m) => w -> ChangesetT s w m ()
changeA :: forall (m :: * -> *) w s. Applicative m => w -> ChangesetT s w m ()
changeA w
w = (s -> m (w, ())) -> ChangesetT s w m ()
forall s w (m :: * -> *) a. (s -> m (w, a)) -> ChangesetT s w m a
ChangesetT ((s -> m (w, ())) -> ChangesetT s w m ())
-> (s -> m (w, ())) -> ChangesetT s w m ()
forall a b. (a -> b) -> a -> b
$ m (w, ()) -> s -> m (w, ())
forall a b. a -> b -> a
const (m (w, ()) -> s -> m (w, ())) -> m (w, ()) -> s -> m (w, ())
forall a b. (a -> b) -> a -> b
$ (w, ()) -> m (w, ())
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (w
w, ())

{- | See 'current'.

The @A@ suffix means that only 'Applicative' is required, not 'Monad'.
-}
currentA :: (Applicative m, Monoid w) => ChangesetT s w m s
currentA :: forall (m :: * -> *) w s.
(Applicative m, Monoid w) =>
ChangesetT s w m s
currentA = (s -> m (w, s)) -> ChangesetT s w m s
forall s w (m :: * -> *) a. (s -> m (w, a)) -> ChangesetT s w m a
ChangesetT ((s -> m (w, s)) -> ChangesetT s w m s)
-> (s -> m (w, s)) -> ChangesetT s w m s
forall a b. (a -> b) -> a -> b
$ \s
s -> (w, s) -> m (w, s)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (w
forall a. Monoid a => a
mempty, s
s)

instance (RightAction w s, Monoid w, Monad m) => MonadChangeset s w (ChangesetT s w m) where
  change :: w -> ChangesetT s w m ()
change = w -> ChangesetT s w m ()
forall (m :: * -> *) w s. Applicative m => w -> ChangesetT s w m ()
changeA
  current :: ChangesetT s w m s
current = ChangesetT s w m s
forall (m :: * -> *) w s.
(Applicative m, Monoid w) =>
ChangesetT s w m s
currentA
  changeset :: forall a. (s -> (a, w)) -> ChangesetT s w m a
changeset = (s -> (a, w)) -> ChangesetT s w m a
forall (m :: * -> *) s a w.
Applicative m =>
(s -> (a, w)) -> ChangesetT s w m a
changesetA

-- | Like 'lift' from the 'MonadTrans' class, but with fewer constraints.
liftF :: (Functor m, Monoid w) => m a -> ChangesetT s w m a
liftF :: forall (m :: * -> *) w a s.
(Functor m, Monoid w) =>
m a -> ChangesetT s w m a
liftF = (s -> m (w, a)) -> ChangesetT s w m a
forall s w (m :: * -> *) a. (s -> m (w, a)) -> ChangesetT s w m a
ChangesetT ((s -> m (w, a)) -> ChangesetT s w m a)
-> (m a -> s -> m (w, a)) -> m a -> ChangesetT s w m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m (w, a) -> s -> m (w, a)
forall a b. a -> b -> a
const (m (w, a) -> s -> m (w, a))
-> (m a -> m (w, a)) -> m a -> s -> m (w, a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> (w, a)) -> m a -> m (w, a)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (w
forall a. Monoid a => a
mempty,)

instance (RightAction w s, Monoid w) => MonadTrans (ChangesetT s w) where
  lift :: forall (m :: * -> *) a. Monad m => m a -> ChangesetT s w m a
lift = m a -> ChangesetT s w m a
forall (m :: * -> *) w a s.
(Functor m, Monoid w) =>
m a -> ChangesetT s w m a
liftF

-- ** Transforming 'ChangesetT' operations

{- | Change the action that would be applied.

The function in the second position of the tuple receives the initial state and the change that would be applied.
It has to output the action that will be applied instead.
-}
revise :: (Functor m) => ChangesetT s w m (a, s -> w -> w) -> ChangesetT s w m a
revise :: forall (m :: * -> *) s w a.
Functor m =>
ChangesetT s w m (a, s -> w -> w) -> ChangesetT s w m a
revise ChangesetT {s -> m (w, (a, s -> w -> w))
getChangesetT :: forall s w (m :: * -> *) a. ChangesetT s w m a -> s -> m (w, a)
getChangesetT :: s -> m (w, (a, s -> w -> w))
getChangesetT} = (s -> m (w, a)) -> ChangesetT s w m a
forall s w (m :: * -> *) a. (s -> m (w, a)) -> ChangesetT s w m a
ChangesetT ((s -> m (w, a)) -> ChangesetT s w m a)
-> (s -> m (w, a)) -> ChangesetT s w m a
forall a b. (a -> b) -> a -> b
$ \s
s -> s -> m (w, (a, s -> w -> w))
getChangesetT s
s m (w, (a, s -> w -> w))
-> ((w, (a, s -> w -> w)) -> (w, a)) -> m (w, a)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \(w
w, (a
a, s -> w -> w
f)) -> (s -> w -> w
f s
s w
w, a
a)

-- | Adds the to-be-applied changes to the foreground value.
changelog :: (Functor m) => ChangesetT s w m a -> ChangesetT s w m (a, w)
changelog :: forall (m :: * -> *) s w a.
Functor m =>
ChangesetT s w m a -> ChangesetT s w m (a, w)
changelog ChangesetT {s -> m (w, a)
getChangesetT :: forall s w (m :: * -> *) a. ChangesetT s w m a -> s -> m (w, a)
getChangesetT :: s -> m (w, a)
getChangesetT} = (s -> m (w, (a, w))) -> ChangesetT s w m (a, w)
forall s w (m :: * -> *) a. (s -> m (w, a)) -> ChangesetT s w m a
ChangesetT ((s -> m (w, (a, w))) -> ChangesetT s w m (a, w))
-> (s -> m (w, (a, w))) -> ChangesetT s w m (a, w)
forall a b. (a -> b) -> a -> b
$ ((w, a) -> (w, (a, w))) -> m (w, a) -> m (w, (a, w))
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(w
w, a
a) -> (w
w, (a
a, w
w))) (m (w, a) -> m (w, (a, w)))
-> (s -> m (w, a)) -> s -> m (w, (a, w))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> m (w, a)
getChangesetT

-- | Precomposes the current state with a function to  before computing the change.
withCurrent :: (s2 -> s1) -> ChangesetT s1 w m a -> ChangesetT s2 w m a
withCurrent :: forall s2 s1 w (m :: * -> *) a.
(s2 -> s1) -> ChangesetT s1 w m a -> ChangesetT s2 w m a
withCurrent s2 -> s1
f = (s2 -> m (w, a)) -> ChangesetT s2 w m a
forall s w (m :: * -> *) a. (s -> m (w, a)) -> ChangesetT s w m a
ChangesetT ((s2 -> m (w, a)) -> ChangesetT s2 w m a)
-> (ChangesetT s1 w m a -> s2 -> m (w, a))
-> ChangesetT s1 w m a
-> ChangesetT s2 w m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((s1 -> m (w, a)) -> (s2 -> s1) -> s2 -> m (w, a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s2 -> s1
f) ((s1 -> m (w, a)) -> s2 -> m (w, a))
-> (ChangesetT s1 w m a -> s1 -> m (w, a))
-> ChangesetT s1 w m a
-> s2
-> m (w, a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChangesetT s1 w m a -> s1 -> m (w, a)
forall s w (m :: * -> *) a. ChangesetT s w m a -> s -> m (w, a)
getChangesetT

-- | Apply a function to the change.
mapChange :: (Functor m) => (w1 -> w2) -> ChangesetT s w1 m a -> ChangesetT s w2 m a
mapChange :: forall (m :: * -> *) w1 w2 s a.
Functor m =>
(w1 -> w2) -> ChangesetT s w1 m a -> ChangesetT s w2 m a
mapChange w1 -> w2
f = (s -> m (w2, a)) -> ChangesetT s w2 m a
forall s w (m :: * -> *) a. (s -> m (w, a)) -> ChangesetT s w m a
ChangesetT ((s -> m (w2, a)) -> ChangesetT s w2 m a)
-> (ChangesetT s w1 m a -> s -> m (w2, a))
-> ChangesetT s w1 m a
-> ChangesetT s w2 m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (m (w1, a) -> m (w2, a)) -> (s -> m (w1, a)) -> s -> m (w2, a)
forall a b. (a -> b) -> (s -> a) -> s -> b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((w1, a) -> (w2, a)) -> m (w1, a) -> m (w2, a)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((w1 -> w2) -> (w1, a) -> (w2, a)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first w1 -> w2
f)) ((s -> m (w1, a)) -> s -> m (w2, a))
-> (ChangesetT s w1 m a -> s -> m (w1, a))
-> ChangesetT s w1 m a
-> s
-> m (w2, a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChangesetT s w1 m a -> s -> m (w1, a)
forall s w (m :: * -> *) a. ChangesetT s w m a -> s -> m (w, a)
getChangesetT

-- ** Combining 'ChangesetT' operations

{- | Like '(<*>)' from 'Applicative', but ignore the change from the first action in the initial state for the second action.

This only needs an 'Applicative' constraint on @m@, not 'Monad'.
-}
(|*>) :: (Semigroup w, Applicative m) => ChangesetT s w m (a -> b) -> ChangesetT s w m a -> ChangesetT s w m b
ChangesetT s -> m (w, a -> b)
mf |*> :: forall w (m :: * -> *) s a b.
(Semigroup w, Applicative m) =>
ChangesetT s w m (a -> b)
-> ChangesetT s w m a -> ChangesetT s w m b
|*> ChangesetT s -> m (w, a)
ma = (s -> m (w, b)) -> ChangesetT s w m b
forall s w (m :: * -> *) a. (s -> m (w, a)) -> ChangesetT s w m a
ChangesetT ((s -> m (w, b)) -> ChangesetT s w m b)
-> (s -> m (w, b)) -> ChangesetT s w m b
forall a b. (a -> b) -> a -> b
$ \s
s -> (\(w
w1, a -> b
f) (w
w2, a
a) -> (w
w1 w -> w -> w
forall a. Semigroup a => a -> a -> a
<> w
w2, a -> b
f a
a)) ((w, a -> b) -> (w, a) -> (w, b))
-> m (w, a -> b) -> m ((w, a) -> (w, b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> m (w, a -> b)
mf s
s m ((w, a) -> (w, b)) -> m (w, a) -> m (w, b)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> s -> m (w, a)
ma s
s

-- | The @'Monad' m@ constraint is indeed necessary, since we need the log from the first action to change it to the state for the second action.
instance (Monoid w, RightAction w s, Monad m) => Applicative (ChangesetT s w m) where
  pure :: forall a. a -> ChangesetT s w m a
pure a
a = (s -> m (w, a)) -> ChangesetT s w m a
forall s w (m :: * -> *) a. (s -> m (w, a)) -> ChangesetT s w m a
ChangesetT ((s -> m (w, a)) -> ChangesetT s w m a)
-> (s -> m (w, a)) -> ChangesetT s w m a
forall a b. (a -> b) -> a -> b
$ m (w, a) -> s -> m (w, a)
forall a b. a -> b -> a
const (m (w, a) -> s -> m (w, a)) -> m (w, a) -> s -> m (w, a)
forall a b. (a -> b) -> a -> b
$ (w, a) -> m (w, a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (w
forall a. Monoid a => a
mempty, a
a)

  ChangesetT s -> m (w, a -> b)
mf <*> :: forall a b.
ChangesetT s w m (a -> b)
-> ChangesetT s w m a -> ChangesetT s w m b
<*> ChangesetT s -> m (w, a)
ma = (s -> m (w, b)) -> ChangesetT s w m b
forall s w (m :: * -> *) a. (s -> m (w, a)) -> ChangesetT s w m a
ChangesetT ((s -> m (w, b)) -> ChangesetT s w m b)
-> (s -> m (w, b)) -> ChangesetT s w m b
forall a b. (a -> b) -> a -> b
$ \s
s -> do
    (w
w1, a -> b
f) <- s -> m (w, a -> b)
mf s
s
    let !s' :: s
s' = s -> w -> s
forall m s. RightAction m s => s -> m -> s
actRight s
s w
w1
    (w
w2, a
a) <- s -> m (w, a)
ma s
s'
    (w, b) -> m (w, b)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (w
w1 w -> w -> w
forall a. Semigroup a => a -> a -> a
<> w
w2, a -> b
f a
a)

instance (RightAction w s, Monoid w, Monad m) => Monad (ChangesetT s w m) where
  ChangesetT s -> m (w, a)
ma >>= :: forall a b.
ChangesetT s w m a
-> (a -> ChangesetT s w m b) -> ChangesetT s w m b
>>= a -> ChangesetT s w m b
f = (s -> m (w, b)) -> ChangesetT s w m b
forall s w (m :: * -> *) a. (s -> m (w, a)) -> ChangesetT s w m a
ChangesetT ((s -> m (w, b)) -> ChangesetT s w m b)
-> (s -> m (w, b)) -> ChangesetT s w m b
forall a b. (a -> b) -> a -> b
$ \s
s -> do
    (w
w1, a
a) <- s -> m (w, a)
ma s
s
    let !s' :: s
s' = s -> w -> s
forall m s. RightAction m s => s -> m -> s
actRight s
s w
w1
    (w
w2, b
b) <- ChangesetT s w m b -> s -> m (w, b)
forall s w (m :: * -> *) a. ChangesetT s w m a -> s -> m (w, a)
getChangesetT (a -> ChangesetT s w m b
f a
a) s
s'
    (w, b) -> m (w, b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (w
w1 w -> w -> w
forall a. Semigroup a => a -> a -> a
<> w
w2, b
b)

instance (Alternative m, Monoid w, RightAction w s, Monad m) => Alternative (ChangesetT s w m) where
  empty :: forall a. ChangesetT s w m a
empty = m a -> ChangesetT s w m a
forall (m :: * -> *) w a s.
(Functor m, Monoid w) =>
m a -> ChangesetT s w m a
liftF m a
forall a. m a
forall (f :: * -> *) a. Alternative f => f a
empty
  ChangesetT s -> m (w, a)
ma1 <|> :: forall a.
ChangesetT s w m a -> ChangesetT s w m a -> ChangesetT s w m a
<|> ChangesetT s -> m (w, a)
ma2 = (s -> m (w, a)) -> ChangesetT s w m a
forall s w (m :: * -> *) a. (s -> m (w, a)) -> ChangesetT s w m a
ChangesetT ((s -> m (w, a)) -> ChangesetT s w m a)
-> (s -> m (w, a)) -> ChangesetT s w m a
forall a b. (a -> b) -> a -> b
$ \s
s -> s -> m (w, a)
ma1 s
s m (w, a) -> m (w, a) -> m (w, a)
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> s -> m (w, a)
ma2 s
s

instance (Alternative m, Monoid w, RightAction w s, Monad m) => MonadPlus (ChangesetT s w m)

instance MFunctor (ChangesetT s w) where
  hoist :: forall (m :: * -> *) (n :: * -> *) b.
Monad m =>
(forall a. m a -> n a) -> ChangesetT s w m b -> ChangesetT s w n b
hoist = (forall x. m x -> n x) -> ChangesetT s w m b -> ChangesetT s w n b
forall (m :: * -> *) (n :: * -> *) s w a.
(forall x. m x -> n x) -> ChangesetT s w m a -> ChangesetT s w n a
hoistF

-- | Like 'hoist' from the @mmorph@ package, but with no constraints.
hoistF :: (forall x. m x -> n x) -> ChangesetT s w m a -> ChangesetT s w n a
hoistF :: forall (m :: * -> *) (n :: * -> *) s w a.
(forall x. m x -> n x) -> ChangesetT s w m a -> ChangesetT s w n a
hoistF forall x. m x -> n x
morph ChangesetT s w m a
ma = (s -> n (w, a)) -> ChangesetT s w n a
forall s w (m :: * -> *) a. (s -> m (w, a)) -> ChangesetT s w m a
ChangesetT ((s -> n (w, a)) -> ChangesetT s w n a)
-> (s -> n (w, a)) -> ChangesetT s w n a
forall a b. (a -> b) -> a -> b
$ m (w, a) -> n (w, a)
forall x. m x -> n x
morph (m (w, a) -> n (w, a)) -> (s -> m (w, a)) -> s -> n (w, a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChangesetT s w m a -> s -> m (w, a)
forall s w (m :: * -> *) a. ChangesetT s w m a -> s -> m (w, a)
getChangesetT ChangesetT s w m a
ma

instance (RightAction w s, Monoid w) => MMonad (ChangesetT s w) where
  embed :: forall (n :: * -> *) (m :: * -> *) b.
Monad n =>
(forall a. m a -> ChangesetT s w n a)
-> ChangesetT s w m b -> ChangesetT s w n b
embed forall a. m a -> ChangesetT s w n a
f (ChangesetT s -> m (w, b)
g) = (s -> n (w, b)) -> ChangesetT s w n b
forall s w (m :: * -> *) a. (s -> m (w, a)) -> ChangesetT s w m a
ChangesetT ((s -> n (w, b)) -> ChangesetT s w n b)
-> (s -> n (w, b)) -> ChangesetT s w n b
forall a b. (a -> b) -> a -> b
$ \s
s ->
    s
s
      s -> (s -> m (w, b)) -> m (w, b)
forall a b. a -> (a -> b) -> b
& s -> m (w, b)
g
      m (w, b)
-> (m (w, b) -> ChangesetT s w n (w, b)) -> ChangesetT s w n (w, b)
forall a b. a -> (a -> b) -> b
& m (w, b) -> ChangesetT s w n (w, b)
forall a. m a -> ChangesetT s w n a
f
      ChangesetT s w n (w, b)
-> (ChangesetT s w n (w, b) -> n (w, (w, b))) -> n (w, (w, b))
forall a b. a -> (a -> b) -> b
& (ChangesetT s w n (w, b) -> s -> n (w, (w, b)))
-> s -> ChangesetT s w n (w, b) -> n (w, (w, b))
forall a b c. (a -> b -> c) -> b -> a -> c
flip ChangesetT s w n (w, b) -> s -> n (w, (w, b))
forall s w (m :: * -> *) a. ChangesetT s w m a -> s -> m (w, a)
getChangesetT s
s
      n (w, (w, b)) -> ((w, (w, b)) -> (w, b)) -> n (w, b)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \(w
w1, (w
w2, b
b)) -> (w
w1 w -> w -> w
forall a. Semigroup a => a -> a -> a
<> w
w2, b
b)

instance (MonadError e m, RightAction w s, Monoid w) => MonadError e (ChangesetT s w m) where
  throwError :: forall a. e -> ChangesetT s w m a
throwError = m a -> ChangesetT s w m a
forall (m :: * -> *) a. Monad m => m a -> ChangesetT s w m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> ChangesetT s w m a)
-> (e -> m a) -> e -> ChangesetT s w m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> m a
forall a. e -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError
  catchError :: forall a.
ChangesetT s w m a
-> (e -> ChangesetT s w m a) -> ChangesetT s w m a
catchError ChangesetT s w m a
ma e -> ChangesetT s w m a
handler = (s -> m (w, a)) -> ChangesetT s w m a
forall s w (m :: * -> *) a. (s -> m (w, a)) -> ChangesetT s w m a
ChangesetT ((s -> m (w, a)) -> ChangesetT s w m a)
-> (s -> m (w, a)) -> ChangesetT s w m a
forall a b. (a -> b) -> a -> b
$ \s
s -> ChangesetT s w m a -> s -> m (w, a)
forall s w (m :: * -> *) a. ChangesetT s w m a -> s -> m (w, a)
getChangesetT ChangesetT s w m a
ma s
s m (w, a) -> (e -> m (w, a)) -> m (w, a)
forall a. m a -> (e -> m a) -> m a
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
`catchError` (\e
e -> ChangesetT s w m a -> s -> m (w, a)
forall s w (m :: * -> *) a. ChangesetT s w m a -> s -> m (w, a)
getChangesetT (e -> ChangesetT s w m a
handler e
e) s
s)

instance (MonadReader r m, RightAction w s, Monoid w) => MonadReader r (ChangesetT s w m) where
  ask :: ChangesetT s w m r
ask = m r -> ChangesetT s w m r
forall (m :: * -> *) a. Monad m => m a -> ChangesetT s w m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m r
forall r (m :: * -> *). MonadReader r m => m r
ask
  local :: forall a. (r -> r) -> ChangesetT s w m a -> ChangesetT s w m a
local r -> r
f = (forall a. m a -> m a) -> ChangesetT s w m a -> ChangesetT s w m a
forall {k} (t :: (* -> *) -> k -> *) (m :: * -> *) (n :: * -> *)
       (b :: k).
(MFunctor t, Monad m) =>
(forall a. m a -> n a) -> t m b -> t n b
forall (m :: * -> *) (n :: * -> *) b.
Monad m =>
(forall a. m a -> n a) -> ChangesetT s w m b -> ChangesetT s w n b
hoist ((forall a. m a -> m a)
 -> ChangesetT s w m a -> ChangesetT s w m a)
-> (forall a. m a -> m a)
-> ChangesetT s w m a
-> ChangesetT s w m a
forall a b. (a -> b) -> a -> b
$ (r -> r) -> m a -> m a
forall a. (r -> r) -> m a -> m a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local r -> r
f

instance (MonadRWS r w s m, RightAction w' s', Monoid w') => MonadRWS r w s (ChangesetT s' w' m)

instance (MonadState s m, RightAction w' s', Monoid w') => MonadState s (ChangesetT s' w' m) where
  state :: forall a. (s -> (a, s)) -> ChangesetT s' w' m a
state = m a -> ChangesetT s' w' m a
forall (m :: * -> *) a. Monad m => m a -> ChangesetT s' w' m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> ChangesetT s' w' m a)
-> ((s -> (a, s)) -> m a) -> (s -> (a, s)) -> ChangesetT s' w' m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (s -> (a, s)) -> m a
forall a. (s -> (a, s)) -> m a
forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
state

instance (MonadWriter w m, RightAction w' s, Monoid w') => MonadWriter w (ChangesetT s w' m) where
  writer :: forall a. (a, w) -> ChangesetT s w' m a
writer = m a -> ChangesetT s w' m a
forall (m :: * -> *) a. Monad m => m a -> ChangesetT s w' m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> ChangesetT s w' m a)
-> ((a, w) -> m a) -> (a, w) -> ChangesetT s w' m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, w) -> m a
forall a. (a, w) -> m a
forall w (m :: * -> *) a. MonadWriter w m => (a, w) -> m a
writer
  listen :: forall a. ChangesetT s w' m a -> ChangesetT s w' m (a, w)
listen = (s -> m (w', (a, w))) -> ChangesetT s w' m (a, w)
forall s w (m :: * -> *) a. (s -> m (w, a)) -> ChangesetT s w m a
ChangesetT ((s -> m (w', (a, w))) -> ChangesetT s w' m (a, w))
-> (ChangesetT s w' m a -> s -> m (w', (a, w)))
-> ChangesetT s w' m a
-> ChangesetT s w' m (a, w)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (m (w', a) -> m (w', (a, w)))
-> (s -> m (w', a)) -> s -> m (w', (a, w))
forall a b. (a -> b) -> (s -> a) -> s -> b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((((w', a), w) -> (w', (a, w))) -> m ((w', a), w) -> m (w', (a, w))
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\((w'
w', a
a), w
w) -> (w'
w', (a
a, w
w))) (m ((w', a), w) -> m (w', (a, w)))
-> (m (w', a) -> m ((w', a), w)) -> m (w', a) -> m (w', (a, w))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m (w', a) -> m ((w', a), w)
forall a. m a -> m (a, w)
forall w (m :: * -> *) a. MonadWriter w m => m a -> m (a, w)
listen) ((s -> m (w', a)) -> s -> m (w', (a, w)))
-> (ChangesetT s w' m a -> s -> m (w', a))
-> ChangesetT s w' m a
-> s
-> m (w', (a, w))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChangesetT s w' m a -> s -> m (w', a)
forall s w (m :: * -> *) a. ChangesetT s w m a -> s -> m (w, a)
getChangesetT
  pass :: forall a. ChangesetT s w' m (a, w -> w) -> ChangesetT s w' m a
pass = (s -> m (w', a)) -> ChangesetT s w' m a
forall s w (m :: * -> *) a. (s -> m (w, a)) -> ChangesetT s w m a
ChangesetT ((s -> m (w', a)) -> ChangesetT s w' m a)
-> (ChangesetT s w' m (a, w -> w) -> s -> m (w', a))
-> ChangesetT s w' m (a, w -> w)
-> ChangesetT s w' m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (m (w', (a, w -> w)) -> m (w', a))
-> (s -> m (w', (a, w -> w))) -> s -> m (w', a)
forall a b. (a -> b) -> (s -> a) -> s -> b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (m ((w', a), w -> w) -> m (w', a)
forall a. m (a, w -> w) -> m a
forall w (m :: * -> *) a. MonadWriter w m => m (a, w -> w) -> m a
pass (m ((w', a), w -> w) -> m (w', a))
-> (m (w', (a, w -> w)) -> m ((w', a), w -> w))
-> m (w', (a, w -> w))
-> m (w', a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((w', (a, w -> w)) -> ((w', a), w -> w))
-> m (w', (a, w -> w)) -> m ((w', a), w -> w)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(w'
w', (a
a, w -> w
f)) -> ((w'
w', a
a), w -> w
f))) ((s -> m (w', (a, w -> w))) -> s -> m (w', a))
-> (ChangesetT s w' m (a, w -> w) -> s -> m (w', (a, w -> w)))
-> ChangesetT s w' m (a, w -> w)
-> s
-> m (w', a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChangesetT s w' m (a, w -> w) -> s -> m (w', (a, w -> w))
forall s w (m :: * -> *) a. ChangesetT s w m a -> s -> m (w, a)
getChangesetT

-- * Pure changesets

{- | A pure changeset acts in the 'Identity' monad.
The only effects it has are inspecting the current state, and adding a change.

@'Changeset' s w a@ is isomorphic to @s -> (w, a).@
-}
type Changeset s w = ChangesetT s w Identity

-- | Like 'getChangesetT'.
getChangeset :: Changeset s w a -> s -> (w, a)
getChangeset :: forall s w a. Changeset s w a -> s -> (w, a)
getChangeset Changeset s w a
swa s
s = Identity (w, a) -> (w, a)
forall a. Identity a -> a
runIdentity (Identity (w, a) -> (w, a)) -> Identity (w, a) -> (w, a)
forall a b. (a -> b) -> a -> b
$ Changeset s w a -> s -> Identity (w, a)
forall s w (m :: * -> *) a. ChangesetT s w m a -> s -> m (w, a)
getChangesetT Changeset s w a
swa s
s

-- | Like 'getChangeT'.
getChange :: Changeset s w a -> s -> w
getChange :: forall s w a. Changeset s w a -> s -> w
getChange Changeset s w a
swa s
s = Identity w -> w
forall a. Identity a -> a
runIdentity (Identity w -> w) -> Identity w -> w
forall a b. (a -> b) -> a -> b
$ Changeset s w a -> s -> Identity w
forall (m :: * -> *) s w a.
Functor m =>
ChangesetT s w m a -> s -> m w
getChangeT Changeset s w a
swa s
s

-- | Like 'runChangesetT'.
runChangeset :: (RightAction w s) => Changeset s w a -> s -> (a, s)
runChangeset :: forall w s a. RightAction w s => Changeset s w a -> s -> (a, s)
runChangeset Changeset s w a
swa s
s = Identity (a, s) -> (a, s)
forall a. Identity a -> a
runIdentity (Identity (a, s) -> (a, s)) -> Identity (a, s) -> (a, s)
forall a b. (a -> b) -> a -> b
$ Changeset s w a -> s -> Identity (a, s)
forall (m :: * -> *) w s a.
(Functor m, RightAction w s) =>
ChangesetT s w m a -> s -> m (a, s)
runChangesetT Changeset s w a
swa s
s

-- | Like 'evalChangesetT'.
evalChangeset :: (RightAction w s) => Changeset s w a -> s -> a
evalChangeset :: forall w s a. RightAction w s => Changeset s w a -> s -> a
evalChangeset Changeset s w a
swa s
s = Identity a -> a
forall a. Identity a -> a
runIdentity (Identity a -> a) -> Identity a -> a
forall a b. (a -> b) -> a -> b
$ Changeset s w a -> s -> Identity a
forall (m :: * -> *) w s a.
(Functor m, RightAction w s) =>
ChangesetT s w m a -> s -> m a
evalChangesetT Changeset s w a
swa s
s

-- | Like 'execChangesetT'.
execChangeset :: (RightAction w s) => Changeset s w a -> s -> s
execChangeset :: forall w s a. RightAction w s => Changeset s w a -> s -> s
execChangeset Changeset s w a
swa s
s = Identity s -> s
forall a. Identity a -> a
runIdentity (Identity s -> s) -> Identity s -> s
forall a b. (a -> b) -> a -> b
$ Changeset s w a -> s -> Identity s
forall (m :: * -> *) w s a.
(Functor m, RightAction w s) =>
ChangesetT s w m a -> s -> m s
execChangesetT Changeset s w a
swa s
s

-- * 'Changes': container for changes that don't have a 'Monoid' instance

{- | A collection of individual changes.

Often, we only want to define a type for single changes to a state.
In that case, 'Changes' is handy.
It serves as a container for changes that don't have a 'Monoid' or 'Semigroup' instance.
All changes are applied sequentially.

To inspect or edit 'Changes', see the type classes 'Functor', 'Foldable', 'Traversable', 'Filterable' and 'Witherable'.
-}
newtype Changes w = Changes {forall w. Changes w -> Seq w
getChanges :: Seq w}
  deriving (Int -> Changes w -> ShowS
[Changes w] -> ShowS
Changes w -> String
(Int -> Changes w -> ShowS)
-> (Changes w -> String)
-> ([Changes w] -> ShowS)
-> Show (Changes w)
forall w. Show w => Int -> Changes w -> ShowS
forall w. Show w => [Changes w] -> ShowS
forall w. Show w => Changes w -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall w. Show w => Int -> Changes w -> ShowS
showsPrec :: Int -> Changes w -> ShowS
$cshow :: forall w. Show w => Changes w -> String
show :: Changes w -> String
$cshowList :: forall w. Show w => [Changes w] -> ShowS
showList :: [Changes w] -> ShowS
Show, ReadPrec [Changes w]
ReadPrec (Changes w)
Int -> ReadS (Changes w)
ReadS [Changes w]
(Int -> ReadS (Changes w))
-> ReadS [Changes w]
-> ReadPrec (Changes w)
-> ReadPrec [Changes w]
-> Read (Changes w)
forall w. Read w => ReadPrec [Changes w]
forall w. Read w => ReadPrec (Changes w)
forall w. Read w => Int -> ReadS (Changes w)
forall w. Read w => ReadS [Changes w]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: forall w. Read w => Int -> ReadS (Changes w)
readsPrec :: Int -> ReadS (Changes w)
$creadList :: forall w. Read w => ReadS [Changes w]
readList :: ReadS [Changes w]
$creadPrec :: forall w. Read w => ReadPrec (Changes w)
readPrec :: ReadPrec (Changes w)
$creadListPrec :: forall w. Read w => ReadPrec [Changes w]
readListPrec :: ReadPrec [Changes w]
Read, Changes w -> Changes w -> Bool
(Changes w -> Changes w -> Bool)
-> (Changes w -> Changes w -> Bool) -> Eq (Changes w)
forall w. Eq w => Changes w -> Changes w -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall w. Eq w => Changes w -> Changes w -> Bool
== :: Changes w -> Changes w -> Bool
$c/= :: forall w. Eq w => Changes w -> Changes w -> Bool
/= :: Changes w -> Changes w -> Bool
Eq, Eq (Changes w)
Eq (Changes w) =>
(Changes w -> Changes w -> Ordering)
-> (Changes w -> Changes w -> Bool)
-> (Changes w -> Changes w -> Bool)
-> (Changes w -> Changes w -> Bool)
-> (Changes w -> Changes w -> Bool)
-> (Changes w -> Changes w -> Changes w)
-> (Changes w -> Changes w -> Changes w)
-> Ord (Changes w)
Changes w -> Changes w -> Bool
Changes w -> Changes w -> Ordering
Changes w -> Changes w -> Changes w
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall w. Ord w => Eq (Changes w)
forall w. Ord w => Changes w -> Changes w -> Bool
forall w. Ord w => Changes w -> Changes w -> Ordering
forall w. Ord w => Changes w -> Changes w -> Changes w
$ccompare :: forall w. Ord w => Changes w -> Changes w -> Ordering
compare :: Changes w -> Changes w -> Ordering
$c< :: forall w. Ord w => Changes w -> Changes w -> Bool
< :: Changes w -> Changes w -> Bool
$c<= :: forall w. Ord w => Changes w -> Changes w -> Bool
<= :: Changes w -> Changes w -> Bool
$c> :: forall w. Ord w => Changes w -> Changes w -> Bool
> :: Changes w -> Changes w -> Bool
$c>= :: forall w. Ord w => Changes w -> Changes w -> Bool
>= :: Changes w -> Changes w -> Bool
$cmax :: forall w. Ord w => Changes w -> Changes w -> Changes w
max :: Changes w -> Changes w -> Changes w
$cmin :: forall w. Ord w => Changes w -> Changes w -> Changes w
min :: Changes w -> Changes w -> Changes w
Ord)
  deriving newtype (NonEmpty (Changes w) -> Changes w
Changes w -> Changes w -> Changes w
(Changes w -> Changes w -> Changes w)
-> (NonEmpty (Changes w) -> Changes w)
-> (forall b. Integral b => b -> Changes w -> Changes w)
-> Semigroup (Changes w)
forall b. Integral b => b -> Changes w -> Changes w
forall w. NonEmpty (Changes w) -> Changes w
forall w. Changes w -> Changes w -> Changes w
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
forall w b. Integral b => b -> Changes w -> Changes w
$c<> :: forall w. Changes w -> Changes w -> Changes w
<> :: Changes w -> Changes w -> Changes w
$csconcat :: forall w. NonEmpty (Changes w) -> Changes w
sconcat :: NonEmpty (Changes w) -> Changes w
$cstimes :: forall w b. Integral b => b -> Changes w -> Changes w
stimes :: forall b. Integral b => b -> Changes w -> Changes w
Semigroup, Semigroup (Changes w)
Changes w
Semigroup (Changes w) =>
Changes w
-> (Changes w -> Changes w -> Changes w)
-> ([Changes w] -> Changes w)
-> Monoid (Changes w)
[Changes w] -> Changes w
Changes w -> Changes w -> Changes w
forall w. Semigroup (Changes w)
forall w. Changes w
forall a.
Semigroup a =>
a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
forall w. [Changes w] -> Changes w
forall w. Changes w -> Changes w -> Changes w
$cmempty :: forall w. Changes w
mempty :: Changes w
$cmappend :: forall w. Changes w -> Changes w -> Changes w
mappend :: Changes w -> Changes w -> Changes w
$cmconcat :: forall w. [Changes w] -> Changes w
mconcat :: [Changes w] -> Changes w
Monoid, (forall m. Monoid m => Changes m -> m)
-> (forall m a. Monoid m => (a -> m) -> Changes a -> m)
-> (forall m a. Monoid m => (a -> m) -> Changes a -> m)
-> (forall a b. (a -> b -> b) -> b -> Changes a -> b)
-> (forall a b. (a -> b -> b) -> b -> Changes a -> b)
-> (forall b a. (b -> a -> b) -> b -> Changes a -> b)
-> (forall b a. (b -> a -> b) -> b -> Changes a -> b)
-> (forall a. (a -> a -> a) -> Changes a -> a)
-> (forall a. (a -> a -> a) -> Changes a -> a)
-> (forall a. Changes a -> [a])
-> (forall a. Changes a -> Bool)
-> (forall a. Changes a -> Int)
-> (forall a. Eq a => a -> Changes a -> Bool)
-> (forall a. Ord a => Changes a -> a)
-> (forall a. Ord a => Changes a -> a)
-> (forall a. Num a => Changes a -> a)
-> (forall a. Num a => Changes a -> a)
-> Foldable Changes
forall a. Eq a => a -> Changes a -> Bool
forall a. Num a => Changes a -> a
forall a. Ord a => Changes a -> a
forall m. Monoid m => Changes m -> m
forall a. Changes a -> Bool
forall a. Changes a -> Int
forall a. Changes a -> [a]
forall a. (a -> a -> a) -> Changes a -> a
forall m a. Monoid m => (a -> m) -> Changes a -> m
forall b a. (b -> a -> b) -> b -> Changes a -> b
forall a b. (a -> b -> b) -> b -> Changes a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall m. Monoid m => Changes m -> m
fold :: forall m. Monoid m => Changes m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Changes a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> Changes a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Changes a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> Changes a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> Changes a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Changes a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Changes a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Changes a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Changes a -> b
foldl :: forall b a. (b -> a -> b) -> b -> Changes a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Changes a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> Changes a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> Changes a -> a
foldr1 :: forall a. (a -> a -> a) -> Changes a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Changes a -> a
foldl1 :: forall a. (a -> a -> a) -> Changes a -> a
$ctoList :: forall a. Changes a -> [a]
toList :: forall a. Changes a -> [a]
$cnull :: forall a. Changes a -> Bool
null :: forall a. Changes a -> Bool
$clength :: forall a. Changes a -> Int
length :: forall a. Changes a -> Int
$celem :: forall a. Eq a => a -> Changes a -> Bool
elem :: forall a. Eq a => a -> Changes a -> Bool
$cmaximum :: forall a. Ord a => Changes a -> a
maximum :: forall a. Ord a => Changes a -> a
$cminimum :: forall a. Ord a => Changes a -> a
minimum :: forall a. Ord a => Changes a -> a
$csum :: forall a. Num a => Changes a -> a
sum :: forall a. Num a => Changes a -> a
$cproduct :: forall a. Num a => Changes a -> a
product :: forall a. Num a => Changes a -> a
Foldable, (forall a b. (a -> b) -> Changes a -> Changes b)
-> (forall a b. a -> Changes b -> Changes a) -> Functor Changes
forall a b. a -> Changes b -> Changes a
forall a b. (a -> b) -> Changes a -> Changes b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Changes a -> Changes b
fmap :: forall a b. (a -> b) -> Changes a -> Changes b
$c<$ :: forall a b. a -> Changes b -> Changes a
<$ :: forall a b. a -> Changes b -> Changes a
Functor)
  deriving (Functor Changes
Foldable Changes
(Functor Changes, Foldable Changes) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> Changes a -> f (Changes b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    Changes (f a) -> f (Changes a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> Changes a -> m (Changes b))
-> (forall (m :: * -> *) a.
    Monad m =>
    Changes (m a) -> m (Changes a))
-> Traversable Changes
forall (t :: * -> *).
(Functor t, Foldable t) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => Changes (m a) -> m (Changes a)
forall (f :: * -> *) a.
Applicative f =>
Changes (f a) -> f (Changes a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Changes a -> m (Changes b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Changes a -> f (Changes b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Changes a -> f (Changes b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Changes a -> f (Changes b)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
Changes (f a) -> f (Changes a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
Changes (f a) -> f (Changes a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Changes a -> m (Changes b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Changes a -> m (Changes b)
$csequence :: forall (m :: * -> *) a. Monad m => Changes (m a) -> m (Changes a)
sequence :: forall (m :: * -> *) a. Monad m => Changes (m a) -> m (Changes a)
Traversable)

instance Filterable Changes where
  mapMaybe :: forall a b. (a -> Maybe b) -> Changes a -> Changes b
mapMaybe a -> Maybe b
f = Seq b -> Changes b
forall w. Seq w -> Changes w
Changes (Seq b -> Changes b)
-> (Changes a -> Seq b) -> Changes a -> Changes b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Maybe b) -> Seq a -> Seq b
forall a b. (a -> Maybe b) -> Seq a -> Seq b
forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
mapMaybe a -> Maybe b
f (Seq a -> Seq b) -> (Changes a -> Seq a) -> Changes a -> Seq b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Changes a -> Seq a
forall w. Changes w -> Seq w
getChanges

instance Witherable Changes where
  wither :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f (Maybe b)) -> Changes a -> f (Changes b)
wither a -> f (Maybe b)
f = (Seq b -> Changes b) -> f (Seq b) -> f (Changes b)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Seq b -> Changes b
forall w. Seq w -> Changes w
Changes (f (Seq b) -> f (Changes b))
-> (Changes a -> f (Seq b)) -> Changes a -> f (Changes b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> f (Maybe b)) -> Seq a -> f (Seq b)
forall (t :: * -> *) (f :: * -> *) a b.
(Witherable t, Applicative f) =>
(a -> f (Maybe b)) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f (Maybe b)) -> Seq a -> f (Seq b)
wither a -> f (Maybe b)
f (Seq a -> f (Seq b))
-> (Changes a -> Seq a) -> Changes a -> f (Seq b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Changes a -> Seq a
forall w. Changes w -> Seq w
getChanges

-- | Create 'Changes' from a list of changes.
changes :: [w] -> Changes w
changes :: forall w. [w] -> Changes w
changes = Seq w -> Changes w
forall w. Seq w -> Changes w
Changes (Seq w -> Changes w) -> ([w] -> Seq w) -> [w] -> Changes w
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [w] -> Seq w
forall a. [a] -> Seq a
fromList

{- | Append a single change.

When @'addChange' w cs@ acts on a state with 'actRight', @w@ will be applied last.
-}
addChange :: w -> Changes w -> Changes w
addChange :: forall w. w -> Changes w -> Changes w
addChange w
w = Seq w -> Changes w
forall w. Seq w -> Changes w
Changes (Seq w -> Changes w)
-> (Changes w -> Seq w) -> Changes w -> Changes w
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Seq w -> w -> Seq w
forall a. Seq a -> a -> Seq a
|> w
w) (Seq w -> Seq w) -> (Changes w -> Seq w) -> Changes w -> Seq w
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Changes w -> Seq w
forall w. Changes w -> Seq w
getChanges

-- | Create a 'Changes' from a single change.
singleChange :: w -> Changes w
singleChange :: forall w. w -> Changes w
singleChange = Seq w -> Changes w
forall w. Seq w -> Changes w
Changes (Seq w -> Changes w) -> (w -> Seq w) -> w -> Changes w
forall b c a. (b -> c) -> (a -> b) -> a -> c
. w -> Seq w
forall a. a -> Seq a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

-- | Apply a single change.
changeSingle :: (MonadChangeset s (Changes w) m) => w -> m ()
changeSingle :: forall s w (m :: * -> *).
MonadChangeset s (Changes w) m =>
w -> m ()
changeSingle = Changes w -> m ()
forall s w (m :: * -> *). MonadChangeset s w m => w -> m ()
change (Changes w -> m ()) -> (w -> Changes w) -> w -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. w -> Changes w
forall w. w -> Changes w
singleChange

-- | Apply all changes sequentially
instance (RightAction w s) => RightAction (Changes w) s where
  actRight :: s -> Changes w -> s
actRight s
s Changes {Seq w
getChanges :: forall w. Changes w -> Seq w
getChanges :: Seq w
getChanges} = (s -> w -> s) -> s -> Seq w -> s
forall b a. (b -> a -> b) -> b -> Seq a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' s -> w -> s
forall m s. RightAction m s => s -> m -> s
actRight s
s Seq w
getChanges

-- * Change examples

-- ** Changing lists

{- | A list can be changed by prepending an element, or removing one.

To change an element of a list, see the indexed changes from [@changeset-lens@](hackage.haskell.org/package/changeset-lens).
-}
data ListChange a
  = -- | Prepend an element
    Cons a
  | -- | Remove the first element (noop on an empty list)
    Pop
  deriving (ListChange a -> ListChange a -> Bool
(ListChange a -> ListChange a -> Bool)
-> (ListChange a -> ListChange a -> Bool) -> Eq (ListChange a)
forall a. Eq a => ListChange a -> ListChange a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => ListChange a -> ListChange a -> Bool
== :: ListChange a -> ListChange a -> Bool
$c/= :: forall a. Eq a => ListChange a -> ListChange a -> Bool
/= :: ListChange a -> ListChange a -> Bool
Eq, Int -> ListChange a -> ShowS
[ListChange a] -> ShowS
ListChange a -> String
(Int -> ListChange a -> ShowS)
-> (ListChange a -> String)
-> ([ListChange a] -> ShowS)
-> Show (ListChange a)
forall a. Show a => Int -> ListChange a -> ShowS
forall a. Show a => [ListChange a] -> ShowS
forall a. Show a => ListChange a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> ListChange a -> ShowS
showsPrec :: Int -> ListChange a -> ShowS
$cshow :: forall a. Show a => ListChange a -> String
show :: ListChange a -> String
$cshowList :: forall a. Show a => [ListChange a] -> ShowS
showList :: [ListChange a] -> ShowS
Show)

instance RightAction (ListChange a) [a] where
  actRight :: [a] -> ListChange a -> [a]
actRight [a]
as (Cons a
a) = a
a a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
as
  actRight [a]
as ListChange a
Pop = Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop Int
1 [a]
as

-- ** Changing integers

-- | An integer can be incremented by 1.
data Count = Increment
  deriving (Count -> Count -> Bool
(Count -> Count -> Bool) -> (Count -> Count -> Bool) -> Eq Count
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Count -> Count -> Bool
== :: Count -> Count -> Bool
$c/= :: Count -> Count -> Bool
/= :: Count -> Count -> Bool
Eq, Int -> Count -> ShowS
[Count] -> ShowS
Count -> String
(Int -> Count -> ShowS)
-> (Count -> String) -> ([Count] -> ShowS) -> Show Count
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Count -> ShowS
showsPrec :: Int -> Count -> ShowS
$cshow :: Count -> String
show :: Count -> String
$cshowList :: [Count] -> ShowS
showList :: [Count] -> ShowS
Show)

instance RightAction Count Int where
  actRight :: Int -> Count -> Int
actRight Int
count Count
Increment = Int
count Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1

-- ** Changing 'Maybe's

-- | Change a 'Maybe' by either deleting the value or forcing it to be present.
newtype MaybeChange a = MaybeChange {forall a. MaybeChange a -> Last (Maybe a)
getMaybeChange :: Last (Maybe a)}
  deriving newtype (MaybeChange a -> MaybeChange a -> Bool
(MaybeChange a -> MaybeChange a -> Bool)
-> (MaybeChange a -> MaybeChange a -> Bool) -> Eq (MaybeChange a)
forall a. Eq a => MaybeChange a -> MaybeChange a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => MaybeChange a -> MaybeChange a -> Bool
== :: MaybeChange a -> MaybeChange a -> Bool
$c/= :: forall a. Eq a => MaybeChange a -> MaybeChange a -> Bool
/= :: MaybeChange a -> MaybeChange a -> Bool
Eq, Eq (MaybeChange a)
Eq (MaybeChange a) =>
(MaybeChange a -> MaybeChange a -> Ordering)
-> (MaybeChange a -> MaybeChange a -> Bool)
-> (MaybeChange a -> MaybeChange a -> Bool)
-> (MaybeChange a -> MaybeChange a -> Bool)
-> (MaybeChange a -> MaybeChange a -> Bool)
-> (MaybeChange a -> MaybeChange a -> MaybeChange a)
-> (MaybeChange a -> MaybeChange a -> MaybeChange a)
-> Ord (MaybeChange a)
MaybeChange a -> MaybeChange a -> Bool
MaybeChange a -> MaybeChange a -> Ordering
MaybeChange a -> MaybeChange a -> MaybeChange a
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (MaybeChange a)
forall a. Ord a => MaybeChange a -> MaybeChange a -> Bool
forall a. Ord a => MaybeChange a -> MaybeChange a -> Ordering
forall a. Ord a => MaybeChange a -> MaybeChange a -> MaybeChange a
$ccompare :: forall a. Ord a => MaybeChange a -> MaybeChange a -> Ordering
compare :: MaybeChange a -> MaybeChange a -> Ordering
$c< :: forall a. Ord a => MaybeChange a -> MaybeChange a -> Bool
< :: MaybeChange a -> MaybeChange a -> Bool
$c<= :: forall a. Ord a => MaybeChange a -> MaybeChange a -> Bool
<= :: MaybeChange a -> MaybeChange a -> Bool
$c> :: forall a. Ord a => MaybeChange a -> MaybeChange a -> Bool
> :: MaybeChange a -> MaybeChange a -> Bool
$c>= :: forall a. Ord a => MaybeChange a -> MaybeChange a -> Bool
>= :: MaybeChange a -> MaybeChange a -> Bool
$cmax :: forall a. Ord a => MaybeChange a -> MaybeChange a -> MaybeChange a
max :: MaybeChange a -> MaybeChange a -> MaybeChange a
$cmin :: forall a. Ord a => MaybeChange a -> MaybeChange a -> MaybeChange a
min :: MaybeChange a -> MaybeChange a -> MaybeChange a
Ord, Int -> MaybeChange a -> ShowS
[MaybeChange a] -> ShowS
MaybeChange a -> String
(Int -> MaybeChange a -> ShowS)
-> (MaybeChange a -> String)
-> ([MaybeChange a] -> ShowS)
-> Show (MaybeChange a)
forall a. Show a => Int -> MaybeChange a -> ShowS
forall a. Show a => [MaybeChange a] -> ShowS
forall a. Show a => MaybeChange a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> MaybeChange a -> ShowS
showsPrec :: Int -> MaybeChange a -> ShowS
$cshow :: forall a. Show a => MaybeChange a -> String
show :: MaybeChange a -> String
$cshowList :: forall a. Show a => [MaybeChange a] -> ShowS
showList :: [MaybeChange a] -> ShowS
Show, ReadPrec [MaybeChange a]
ReadPrec (MaybeChange a)
Int -> ReadS (MaybeChange a)
ReadS [MaybeChange a]
(Int -> ReadS (MaybeChange a))
-> ReadS [MaybeChange a]
-> ReadPrec (MaybeChange a)
-> ReadPrec [MaybeChange a]
-> Read (MaybeChange a)
forall a. Read a => ReadPrec [MaybeChange a]
forall a. Read a => ReadPrec (MaybeChange a)
forall a. Read a => Int -> ReadS (MaybeChange a)
forall a. Read a => ReadS [MaybeChange a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: forall a. Read a => Int -> ReadS (MaybeChange a)
readsPrec :: Int -> ReadS (MaybeChange a)
$creadList :: forall a. Read a => ReadS [MaybeChange a]
readList :: ReadS [MaybeChange a]
$creadPrec :: forall a. Read a => ReadPrec (MaybeChange a)
readPrec :: ReadPrec (MaybeChange a)
$creadListPrec :: forall a. Read a => ReadPrec [MaybeChange a]
readListPrec :: ReadPrec [MaybeChange a]
Read, NonEmpty (MaybeChange a) -> MaybeChange a
MaybeChange a -> MaybeChange a -> MaybeChange a
(MaybeChange a -> MaybeChange a -> MaybeChange a)
-> (NonEmpty (MaybeChange a) -> MaybeChange a)
-> (forall b. Integral b => b -> MaybeChange a -> MaybeChange a)
-> Semigroup (MaybeChange a)
forall b. Integral b => b -> MaybeChange a -> MaybeChange a
forall a. NonEmpty (MaybeChange a) -> MaybeChange a
forall a. MaybeChange a -> MaybeChange a -> MaybeChange a
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
forall a b. Integral b => b -> MaybeChange a -> MaybeChange a
$c<> :: forall a. MaybeChange a -> MaybeChange a -> MaybeChange a
<> :: MaybeChange a -> MaybeChange a -> MaybeChange a
$csconcat :: forall a. NonEmpty (MaybeChange a) -> MaybeChange a
sconcat :: NonEmpty (MaybeChange a) -> MaybeChange a
$cstimes :: forall a b. Integral b => b -> MaybeChange a -> MaybeChange a
stimes :: forall b. Integral b => b -> MaybeChange a -> MaybeChange a
Semigroup, Semigroup (MaybeChange a)
MaybeChange a
Semigroup (MaybeChange a) =>
MaybeChange a
-> (MaybeChange a -> MaybeChange a -> MaybeChange a)
-> ([MaybeChange a] -> MaybeChange a)
-> Monoid (MaybeChange a)
[MaybeChange a] -> MaybeChange a
MaybeChange a -> MaybeChange a -> MaybeChange a
forall a. Semigroup (MaybeChange a)
forall a. MaybeChange a
forall a.
Semigroup a =>
a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
forall a. [MaybeChange a] -> MaybeChange a
forall a. MaybeChange a -> MaybeChange a -> MaybeChange a
$cmempty :: forall a. MaybeChange a
mempty :: MaybeChange a
$cmappend :: forall a. MaybeChange a -> MaybeChange a -> MaybeChange a
mappend :: MaybeChange a -> MaybeChange a -> MaybeChange a
$cmconcat :: forall a. [MaybeChange a] -> MaybeChange a
mconcat :: [MaybeChange a] -> MaybeChange a
Monoid)

instance RightAction (MaybeChange a) (Maybe a) where
  actRight :: Maybe a -> MaybeChange a -> Maybe a
actRight Maybe a
aMaybe MaybeChange {Last (Maybe a)
getMaybeChange :: forall a. MaybeChange a -> Last (Maybe a)
getMaybeChange :: Last (Maybe a)
getMaybeChange} = Maybe a -> Last (Maybe a) -> Maybe a
forall m s. RightAction m s => s -> m -> s
actRight Maybe a
aMaybe Last (Maybe a)
getMaybeChange

-- | Set the state to the given 'Maybe' value.
setMaybe :: Maybe a -> MaybeChange a
setMaybe :: forall a. Maybe a -> MaybeChange a
setMaybe = Last (Maybe a) -> MaybeChange a
forall a. Last (Maybe a) -> MaybeChange a
MaybeChange (Last (Maybe a) -> MaybeChange a)
-> (Maybe a -> Last (Maybe a)) -> Maybe a -> MaybeChange a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (Maybe a) -> Last (Maybe a)
forall a. Maybe a -> Last a
Last (Maybe (Maybe a) -> Last (Maybe a))
-> (Maybe a -> Maybe (Maybe a)) -> Maybe a -> Last (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe a -> Maybe (Maybe a)
forall a. a -> Maybe a
Just

-- | Set the state to 'Just'.
setJust :: a -> MaybeChange a
setJust :: forall a. a -> MaybeChange a
setJust = Maybe a -> MaybeChange a
forall a. Maybe a -> MaybeChange a
setMaybe (Maybe a -> MaybeChange a) -> (a -> Maybe a) -> a -> MaybeChange a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Maybe a
forall a. a -> Maybe a
Just

-- | Set the state to 'Nothing'.
setNothing :: MaybeChange a
setNothing :: forall a. MaybeChange a
setNothing = Maybe a -> MaybeChange a
forall a. Maybe a -> MaybeChange a
setMaybe Maybe a
forall a. Maybe a
Nothing

-- ** Changing 'Functor's

-- | Change a 'Functor' structure by applying a change for every element through 'fmap'.
newtype FmapChange (f :: Type -> Type) w = FmapChange {forall (f :: * -> *) w. FmapChange f w -> w
getFmapChange :: w}
  deriving (FmapChange f w -> FmapChange f w -> Bool
(FmapChange f w -> FmapChange f w -> Bool)
-> (FmapChange f w -> FmapChange f w -> Bool)
-> Eq (FmapChange f w)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (f :: * -> *) w.
Eq w =>
FmapChange f w -> FmapChange f w -> Bool
$c== :: forall (f :: * -> *) w.
Eq w =>
FmapChange f w -> FmapChange f w -> Bool
== :: FmapChange f w -> FmapChange f w -> Bool
$c/= :: forall (f :: * -> *) w.
Eq w =>
FmapChange f w -> FmapChange f w -> Bool
/= :: FmapChange f w -> FmapChange f w -> Bool
Eq, Eq (FmapChange f w)
Eq (FmapChange f w) =>
(FmapChange f w -> FmapChange f w -> Ordering)
-> (FmapChange f w -> FmapChange f w -> Bool)
-> (FmapChange f w -> FmapChange f w -> Bool)
-> (FmapChange f w -> FmapChange f w -> Bool)
-> (FmapChange f w -> FmapChange f w -> Bool)
-> (FmapChange f w -> FmapChange f w -> FmapChange f w)
-> (FmapChange f w -> FmapChange f w -> FmapChange f w)
-> Ord (FmapChange f w)
FmapChange f w -> FmapChange f w -> Bool
FmapChange f w -> FmapChange f w -> Ordering
FmapChange f w -> FmapChange f w -> FmapChange f w
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall (f :: * -> *) w. Ord w => Eq (FmapChange f w)
forall (f :: * -> *) w.
Ord w =>
FmapChange f w -> FmapChange f w -> Bool
forall (f :: * -> *) w.
Ord w =>
FmapChange f w -> FmapChange f w -> Ordering
forall (f :: * -> *) w.
Ord w =>
FmapChange f w -> FmapChange f w -> FmapChange f w
$ccompare :: forall (f :: * -> *) w.
Ord w =>
FmapChange f w -> FmapChange f w -> Ordering
compare :: FmapChange f w -> FmapChange f w -> Ordering
$c< :: forall (f :: * -> *) w.
Ord w =>
FmapChange f w -> FmapChange f w -> Bool
< :: FmapChange f w -> FmapChange f w -> Bool
$c<= :: forall (f :: * -> *) w.
Ord w =>
FmapChange f w -> FmapChange f w -> Bool
<= :: FmapChange f w -> FmapChange f w -> Bool
$c> :: forall (f :: * -> *) w.
Ord w =>
FmapChange f w -> FmapChange f w -> Bool
> :: FmapChange f w -> FmapChange f w -> Bool
$c>= :: forall (f :: * -> *) w.
Ord w =>
FmapChange f w -> FmapChange f w -> Bool
>= :: FmapChange f w -> FmapChange f w -> Bool
$cmax :: forall (f :: * -> *) w.
Ord w =>
FmapChange f w -> FmapChange f w -> FmapChange f w
max :: FmapChange f w -> FmapChange f w -> FmapChange f w
$cmin :: forall (f :: * -> *) w.
Ord w =>
FmapChange f w -> FmapChange f w -> FmapChange f w
min :: FmapChange f w -> FmapChange f w -> FmapChange f w
Ord, ReadPrec [FmapChange f w]
ReadPrec (FmapChange f w)
Int -> ReadS (FmapChange f w)
ReadS [FmapChange f w]
(Int -> ReadS (FmapChange f w))
-> ReadS [FmapChange f w]
-> ReadPrec (FmapChange f w)
-> ReadPrec [FmapChange f w]
-> Read (FmapChange f w)
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
forall (f :: * -> *) w. Read w => ReadPrec [FmapChange f w]
forall (f :: * -> *) w. Read w => ReadPrec (FmapChange f w)
forall (f :: * -> *) w. Read w => Int -> ReadS (FmapChange f w)
forall (f :: * -> *) w. Read w => ReadS [FmapChange f w]
$creadsPrec :: forall (f :: * -> *) w. Read w => Int -> ReadS (FmapChange f w)
readsPrec :: Int -> ReadS (FmapChange f w)
$creadList :: forall (f :: * -> *) w. Read w => ReadS [FmapChange f w]
readList :: ReadS [FmapChange f w]
$creadPrec :: forall (f :: * -> *) w. Read w => ReadPrec (FmapChange f w)
readPrec :: ReadPrec (FmapChange f w)
$creadListPrec :: forall (f :: * -> *) w. Read w => ReadPrec [FmapChange f w]
readListPrec :: ReadPrec [FmapChange f w]
Read, Int -> FmapChange f w -> ShowS
[FmapChange f w] -> ShowS
FmapChange f w -> String
(Int -> FmapChange f w -> ShowS)
-> (FmapChange f w -> String)
-> ([FmapChange f w] -> ShowS)
-> Show (FmapChange f w)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (f :: * -> *) w. Show w => Int -> FmapChange f w -> ShowS
forall (f :: * -> *) w. Show w => [FmapChange f w] -> ShowS
forall (f :: * -> *) w. Show w => FmapChange f w -> String
$cshowsPrec :: forall (f :: * -> *) w. Show w => Int -> FmapChange f w -> ShowS
showsPrec :: Int -> FmapChange f w -> ShowS
$cshow :: forall (f :: * -> *) w. Show w => FmapChange f w -> String
show :: FmapChange f w -> String
$cshowList :: forall (f :: * -> *) w. Show w => [FmapChange f w] -> ShowS
showList :: [FmapChange f w] -> ShowS
Show, NonEmpty (FmapChange f w) -> FmapChange f w
FmapChange f w -> FmapChange f w -> FmapChange f w
(FmapChange f w -> FmapChange f w -> FmapChange f w)
-> (NonEmpty (FmapChange f w) -> FmapChange f w)
-> (forall b. Integral b => b -> FmapChange f w -> FmapChange f w)
-> Semigroup (FmapChange f w)
forall b. Integral b => b -> FmapChange f w -> FmapChange f w
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
forall (f :: * -> *) w.
Semigroup w =>
NonEmpty (FmapChange f w) -> FmapChange f w
forall (f :: * -> *) w.
Semigroup w =>
FmapChange f w -> FmapChange f w -> FmapChange f w
forall (f :: * -> *) w b.
(Semigroup w, Integral b) =>
b -> FmapChange f w -> FmapChange f w
$c<> :: forall (f :: * -> *) w.
Semigroup w =>
FmapChange f w -> FmapChange f w -> FmapChange f w
<> :: FmapChange f w -> FmapChange f w -> FmapChange f w
$csconcat :: forall (f :: * -> *) w.
Semigroup w =>
NonEmpty (FmapChange f w) -> FmapChange f w
sconcat :: NonEmpty (FmapChange f w) -> FmapChange f w
$cstimes :: forall (f :: * -> *) w b.
(Semigroup w, Integral b) =>
b -> FmapChange f w -> FmapChange f w
stimes :: forall b. Integral b => b -> FmapChange f w -> FmapChange f w
Semigroup, Semigroup (FmapChange f w)
FmapChange f w
Semigroup (FmapChange f w) =>
FmapChange f w
-> (FmapChange f w -> FmapChange f w -> FmapChange f w)
-> ([FmapChange f w] -> FmapChange f w)
-> Monoid (FmapChange f w)
[FmapChange f w] -> FmapChange f w
FmapChange f w -> FmapChange f w -> FmapChange f w
forall a.
Semigroup a =>
a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
forall (f :: * -> *) w. Monoid w => Semigroup (FmapChange f w)
forall (f :: * -> *) w. Monoid w => FmapChange f w
forall (f :: * -> *) w.
Monoid w =>
[FmapChange f w] -> FmapChange f w
forall (f :: * -> *) w.
Monoid w =>
FmapChange f w -> FmapChange f w -> FmapChange f w
$cmempty :: forall (f :: * -> *) w. Monoid w => FmapChange f w
mempty :: FmapChange f w
$cmappend :: forall (f :: * -> *) w.
Monoid w =>
FmapChange f w -> FmapChange f w -> FmapChange f w
mappend :: FmapChange f w -> FmapChange f w -> FmapChange f w
$cmconcat :: forall (f :: * -> *) w.
Monoid w =>
[FmapChange f w] -> FmapChange f w
mconcat :: [FmapChange f w] -> FmapChange f w
Monoid, (forall a b. (a -> b) -> FmapChange f a -> FmapChange f b)
-> (forall a b. a -> FmapChange f b -> FmapChange f a)
-> Functor (FmapChange f)
forall a b. a -> FmapChange f b -> FmapChange f a
forall a b. (a -> b) -> FmapChange f a -> FmapChange f b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
forall (f :: * -> *) a b. a -> FmapChange f b -> FmapChange f a
forall (f :: * -> *) a b.
(a -> b) -> FmapChange f a -> FmapChange f b
$cfmap :: forall (f :: * -> *) a b.
(a -> b) -> FmapChange f a -> FmapChange f b
fmap :: forall a b. (a -> b) -> FmapChange f a -> FmapChange f b
$c<$ :: forall (f :: * -> *) a b. a -> FmapChange f b -> FmapChange f a
<$ :: forall a b. a -> FmapChange f b -> FmapChange f a
Functor)

instance (Functor f, RightAction w s) => RightAction (FmapChange f w) (f s) where
  actRight :: f s -> FmapChange f w -> f s
actRight f s
fs FmapChange {w
getFmapChange :: forall (f :: * -> *) w. FmapChange f w -> w
getFmapChange :: w
getFmapChange} = (s -> w -> s) -> w -> s -> s
forall a b c. (a -> b -> c) -> b -> a -> c
flip s -> w -> s
forall m s. RightAction m s => s -> m -> s
actRight w
getFmapChange (s -> s) -> f s -> f s
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f s
fs

-- *** Changing 'Maybe's as 'Functor's

-- | Apply changes only to 'Just' values.
type JustChange = FmapChange Maybe

-- | Apply changes only to 'Just' values.
justChange :: w -> JustChange w
justChange :: forall w. w -> JustChange w
justChange = w -> FmapChange Maybe w
forall (f :: * -> *) w. w -> FmapChange f w
FmapChange