Class.hs

{-# LANGUAGE UndecidableInstances #-}

-- | A type class generalising the API of 'Control.Monad.Trans.Changeset.ChangesetT'.
module Control.Monad.Changeset.Class where

-- transformers
import Control.Monad.Trans.Class (MonadTrans (..))

-- mmorph
import Control.Monad.Morph (MFunctor (..))

-- changeset
import Data.Monoid.RightAction (RightAction, RightTorsor (differenceRight))

{- | Monads containing changeset state.

This usually implies that the 'Control.Monad.Trans.Changeset.ChangesetT' monad transformer is part of the monad transformer stack of @m@.
See its documentation for details.

Two laws for these methods boil down to the requirement that 'change' and 'current' are special cases of 'changeset':

@
  'change' w = 'changeset' $ 'const' ((), w)
  'current' = 'changeset' (, 'mempty')
@

The central law ensures that future states are affected by the past changes through right action:

@
f :: s -> (a, w)
g :: a -> s -> (b, w)

'changeset' f >>= ('changeset' . g)
  =
'changeset' $ \s -> let (a, w) = f s in g a $ s \`'Data.Monoid.RightAction.actRight'\` w
@

This law has several easier to grasp corollaries:

@
--  Applying a change and then observing the state is the same as observing the state, updating it, and applying the change.
'change' w >> 'current' = do
  s <- 'current'
  'change' w
  'return' $ s \`'Data.Monoid.RightAction.actRight'\` w

-- Changes are combined through the semigroup product
'change' w1 >> 'change' w2 = 'change' (w1 <> w2)

-- current has no effect other than returning the current state
'current' >> 'current' = 'current'
@
-}
class (Monad m, Monoid w, RightAction w s) => MonadChangeset s w m | m -> s, m -> w where
  -- | Apply a changeset to the state.
  changeset ::
    -- | Receives the current state and has to output a value and a change.
    (s -> (a, w)) ->
    m a

  {- | Apply a change to the state.

  The 'RightAction' instance is used to mutate the state.

  This is a special case of 'changeset' where the current state is disregarded.
  -}
  change :: w -> m ()
  change w = changeset $ const ((), w)

  {- | Observe the current state.

  This is a special case of 'changeset' where the state is not changed.
  -}
  current :: m s
  current = changeset (,mempty)

instance {-# OVERLAPPABLE #-} (Monad m, Monad (t m), MonadTrans t, MFunctor t, MonadChangeset s w m) => MonadChangeset s w (t m) where
  changeset = lift . changeset
  change = lift . change
  current = lift current

{- | Calculate the difference from the current state to the explicitly given state, and return it.

Also see 'update'.
-}
diff :: (RightTorsor w s, MonadChangeset s w m) => s -> m w
diff s = (`differenceRight` s) <$> current

{- | Update to a specific state.

Uses 'diff' to calculate the missing change to the intended state.
This is only possible if the change is also a /torsor/, that is, there is a way to calculate a change as a difference between states.

With a lawful @'RightTorsor' w s@ instance, it can be expected that after applying @'update' s@, the state is @s@.
-}
update :: (MonadChangeset s w m, RightTorsor w s) => s -> m ()
update s = diff s >>= change