    {-# LANGUAGE CPP                   #-}
    {-# LANGUAGE FlexibleInstances     #-}
    {-# LANGUAGE MultiParamTypeClasses #-}
    {-# LANGUAGE TupleSections         #-}

    module Data.Monoid.SemiDirectProduct
           ( Semi, unSemi, tag, inject, untag, embed, quotient
           ) where

    #if !MIN_VERSION_base(4,8,0)
    import           Data.Monoid        (Monoid(..))
    #endif
    import           Data.Semigroup     (Semigroup(..))

    import           Data.Monoid.Action

    -- | The semi-direct product of monoids @s@ and @m@, which is a monoid
    --   when @m@ acts on @s@. Structurally, the semi-direct product is
    --   just a pair @(s,m)@.  However, the monoid instance is different.
    --   In particular, we have
    --
    -- > (s1,m1) <> (s2,m2) = (s1 <> (m1 `act` s2), m1 <> m2)
    --
    --   We think of the @m@ values as a "tag" decorating the @s@ values,
    --   which also affect the way the @s@ values combine.
    --
    --   We call the monoid @m@ the quotient monoid and the monoid @s@ the
    --   sub-monoid of the semi-direct product. The semi-direct product
    --   @Semi s m@ is an extension of the monoid @s@ with @m@ being the
    --   quotient.
    newtype Semi s m = Semi { forall s m. Semi s m -> (s, m)
    unSemi :: (s,m) }

    instance (Semigroup m, Semigroup s, Action m s) => Semigroup (Semi s m) where
      Semi s m
    x <> :: Semi s m -> Semi s m -> Semi s m
    <> Semi s m
    y = (s, m) -> Semi s m
    forall s m. (s, m) -> Semi s m
    Semi (s
    xs s -> s -> s
    forall a. Semigroup a => a -> a -> a
    <> (m
    xm m -> s -> s
    forall m s. Action m s => m -> s -> s
    `act` s
    ys), m
    xm m -> m -> m
    forall a. Semigroup a => a -> a -> a
    <> m
    ym)
        where (s
    xs, m
    xm) = Semi s m -> (s, m)
    forall s m. Semi s m -> (s, m)
    unSemi Semi s m
    x
              (s
    ys, m
    ym) = Semi s m -> (s, m)
    forall s m. Semi s m -> (s, m)
    unSemi Semi s m
    y
      {-# INLINE (<>) #-}

    #if MIN_VERSION_base(4,8,0)
      sconcat :: NonEmpty (Semi s m) -> Semi s m
    sconcat = (Semi s m -> Semi s m -> Semi s m)
    -> NonEmpty (Semi s m) -> Semi s m
    forall a. (a -> a -> a) -> NonEmpty a -> a
    forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
    foldr1 Semi s m -> Semi s m -> Semi s m
    forall a. Semigroup a => a -> a -> a
    (<>)
      {-# INLINE sconcat #-}
    #endif

    instance (Monoid m, Monoid s, Action m s) => Monoid (Semi s m) where
      mempty :: Semi s m
    mempty      = (s, m) -> Semi s m
    forall s m. (s, m) -> Semi s m
    Semi (s
    forall a. Monoid a => a
    mempty, m
    forall a. Monoid a => a
    mempty)
      {-# INLINE mempty #-}

    #if !MIN_VERSION_base(4,11,0)
      mappend x y = Semi (xs `mappend` (xm `act` ys), xm `mappend` ym)
        where (xs, xm) = unSemi x
              (ys, ym) = unSemi y

      {-# INLINE mappend #-}
    #endif

      mconcat :: [Semi s m] -> Semi s m
    mconcat     = (Semi s m -> Semi s m -> Semi s m)
    -> Semi s m -> [Semi s m] -> Semi s m
    forall a b. (a -> b -> b) -> b -> [a] -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr Semi s m -> Semi s m -> Semi s m
    forall a. Monoid a => a -> a -> a
    mappend Semi s m
    forall a. Monoid a => a
    mempty
      {-# INLINE mconcat #-}

    -- | Tag an @s@ value with an @m@ value to create an element of the
    --   semi-direct product.
    tag :: s -> m -> Semi s m
    tag :: forall s m. s -> m -> Semi s m
    tag s
    s m
    m = (s, m) -> Semi s m
    forall s m. (s, m) -> Semi s m
    Semi (s
    s,m
    m)

    -- | The injection map, /i.e./ give an @s@ value a trivial tag.
    inject :: Monoid m => s -> Semi s m
    inject :: forall m s. Monoid m => s -> Semi s m
    inject = (s, m) -> Semi s m
    forall s m. (s, m) -> Semi s m
    Semi ((s, m) -> Semi s m) -> (s -> (s, m)) -> s -> Semi s m
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (,m
    forall a. Monoid a => a
    mempty)

    -- | Forget the monoidal tag.  Of course, @untag . inject = id@, and
    --   @untag (tag s m) = s@.
    untag :: Semi s m -> s
    untag :: forall s m. Semi s m -> s
    untag = (s, m) -> s
    forall a b. (a, b) -> a
    fst ((s, m) -> s) -> (Semi s m -> (s, m)) -> Semi s m -> s
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Semi s m -> (s, m)
    forall s m. Semi s m -> (s, m)
    unSemi

    -- | Embed a "tag" value as a value of type @Semi s m@.  Note that
    --
    --   @inject s <> embed m = tag s m@
    --
    --   and
    --
    --   @embed m <> inject s@ = tag (act m s) m@
    --
    --   The semi-direct product gives a split extension of @s@ by
    --   @m@. This allows us to embed @m@ into the semi-direct
    --   product. This is the embedding map. The quotient and embed maps
    --   should satisfy the equation @quotient . embed = id@.
    embed :: Monoid s => m -> Semi s m
    embed :: forall s m. Monoid s => m -> Semi s m
    embed = (s, m) -> Semi s m
    forall s m. (s, m) -> Semi s m
    Semi ((s, m) -> Semi s m) -> (m -> (s, m)) -> m -> Semi s m
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (s
    forall a. Monoid a => a
    mempty,)

    -- | The quotient map, /i.e./ retrieve the monoidal tag value.
    quotient :: Semi s m -> m
    quotient :: forall s m. Semi s m -> m
    quotient = (s, m) -> m
    forall a b. (a, b) -> b
    snd ((s, m) -> m) -> (Semi s m -> (s, m)) -> Semi s m -> m
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Semi s m -> (s, m)
    forall s m. Semi s m -> (s, m)
    unSemi