module Data.Monoid.RightAction where

-- base
import Data.Maybe (fromMaybe)
import Data.Monoid (Dual (..), Endo (..), Last (..))
import Data.Void (Void)

-- monoid-extras
import Data.Monoid.Action (Action (..), Regular (Regular))

{- | A [right action](https://en.wikipedia.org/wiki/Group_action#Right_group_action) of @m@ on @s@.

Imagine @s@ to be a type of states, and @m@ a type of changes to @s@.

Laws:

* When @m@ is a 'Semigroup': @s \`actRight\` m1 \`actRight\` m2 == s \`actRight\` (m1 <> m2)@
* When @m@ is a 'Monoid': @s \`actRight\` 'mempty' == s@

The default implementation is the trivial action which leaves @s@ unchanged.

See also 'Action' from @monoid-extras@, which is a /left/ action.
-}
class RightAction m s where
  actRight :: s -> m -> s
  actRight s
s m
_ = s
s

infixl 5 `actRight`

instance RightAction () s

instance RightAction m ()

instance RightAction Void s

instance RightAction (Last s) s where
  actRight :: s -> Last s -> s
actRight s
s (Last Maybe s
ms) = s -> Maybe s -> s
forall a. a -> Maybe a -> a
fromMaybe s
s Maybe s
ms

instance (Action m s) => RightAction (Dual m) s where
  actRight :: s -> Dual m -> s
actRight s
s (Dual m
m) = m -> s -> s
forall m s. Action m s => m -> s -> s
act m
m s
s

instance (Semigroup m) => RightAction m (Regular m) where
  actRight :: Regular m -> m -> Regular m
actRight (Regular m
m1) m
m2 = m -> Regular m
forall m. m -> Regular m
Regular (m -> Regular m) -> m -> Regular m
forall a b. (a -> b) -> a -> b
$ m
m1 m -> m -> m
forall a. Semigroup a => a -> a -> a
<> m
m2

instance (RightAction m s) => RightAction (Maybe m) s where
  actRight :: s -> Maybe m -> s
actRight s
s = s -> (m -> s) -> Maybe m -> s
forall b a. b -> (a -> b) -> Maybe a -> b
maybe s
s (s -> m -> s
forall m s. RightAction m s => s -> m -> s
actRight s
s)

{- | Endomorphism type with reverse 'Monoid' instance.

The standard 'Endo' type has a left action on @s@ since its composition is defined as @Endo f <> Endo g = Endo (f . g).@
The "Right Endomorphism" type, on the other hand, has a right action.
Intuitively, it behaves like the 'Data.Function.&' operator:

@
s & f & g == s \`'actRight'\` rEndo f <> rEndo g
@
-}
type REndo s = Dual (Endo s)

-- | Create an endomorphism monoid that has a right action on @s.@
rEndo :: (s -> s) -> REndo s
rEndo :: forall s. (s -> s) -> REndo s
rEndo = Endo s -> Dual (Endo s)
forall a. a -> Dual a
Dual (Endo s -> Dual (Endo s))
-> ((s -> s) -> Endo s) -> (s -> s) -> Dual (Endo s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (s -> s) -> Endo s
forall a. (a -> a) -> Endo a
Endo