    {-# LANGUAGE DeriveDataTypeable    #-}
    {-# LANGUAGE FlexibleInstances     #-}
    {-# LANGUAGE MultiParamTypeClasses #-}
    {-# LANGUAGE TypeOperators         #-}
    {-# LANGUAGE LambdaCase #-}

    module Data.Semigroup.Coproduct
           ( (:+.)
           , inL, inR
           , cop
           , toAltList
           , toMonoid
           ) where

    import Data.Function (on)
    import Data.List.NonEmpty (NonEmpty(..))
    import Data.Typeable (Typeable)
    import Data.Semigroup (Endo(Endo, appEndo))
    import Data.Semigroup.Foldable (foldMap1)

    import Data.Monoid.Action (Action(..))
    import Data.Monoid.Coproduct ((:+:))
    import qualified Data.Monoid.Coproduct as M

    -- | @m :+. n@ is the coproduct of semigroups @m@ and @n@.  Values of
    --   type @m :+. n@ consist of alternating non-empty lists of @m@ and @n@
    --   values. Composition is list concatenation, with appropriate
    --   combining of adjacent elements
    newtype m :+. n = SCo { forall m n. (m :+. n) -> NonEmpty (Either m n)
    unSCo :: NonEmpty (Either m n) }
      deriving (Typeable, Int -> (m :+. n) -> ShowS
    [m :+. n] -> ShowS
    (m :+. n) -> String
    (Int -> (m :+. n) -> ShowS)
    -> ((m :+. n) -> String) -> ([m :+. n] -> ShowS) -> Show (m :+. n)
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    forall m n. (Show m, Show n) => Int -> (m :+. n) -> ShowS
    forall m n. (Show m, Show n) => [m :+. n] -> ShowS
    forall m n. (Show m, Show n) => (m :+. n) -> String
    $cshowsPrec :: forall m n. (Show m, Show n) => Int -> (m :+. n) -> ShowS
    showsPrec :: Int -> (m :+. n) -> ShowS
    $cshow :: forall m n. (Show m, Show n) => (m :+. n) -> String
    show :: (m :+. n) -> String
    $cshowList :: forall m n. (Show m, Show n) => [m :+. n] -> ShowS
    showList :: [m :+. n] -> ShowS
    Show)

    instance (Eq m, Eq n, Semigroup m, Semigroup n) => Eq (m :+. n) where
      == :: (m :+. n) -> (m :+. n) -> Bool
    (==) = NonEmpty (Either m n) -> NonEmpty (Either m n) -> Bool
    forall a. Eq a => a -> a -> Bool
    (==) (NonEmpty (Either m n) -> NonEmpty (Either m n) -> Bool)
    -> ((m :+. n) -> NonEmpty (Either m n))
    -> (m :+. n)
    -> (m :+. n)
    -> Bool
    forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
    `on` (NonEmpty (Either m n) -> NonEmpty (Either m n)
    forall m n.
    (Semigroup m, Semigroup n) =>
    NonEmpty (Either m n) -> NonEmpty (Either m n)
    normalize (NonEmpty (Either m n) -> NonEmpty (Either m n))
    -> ((m :+. n) -> NonEmpty (Either m n))
    -> (m :+. n)
    -> NonEmpty (Either m n)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (m :+. n) -> NonEmpty (Either m n)
    forall m n. (m :+. n) -> NonEmpty (Either m n)
    unSCo)

    -- | Extract a semigroup coproduct to a non-empty list of @Either@ values.
    --   The resulting list is guaranteed to be normalized, in the sense that
    --   it will strictly alternate between @Left@ and @Right@.
    toAltList :: (Semigroup m, Semigroup n) => (m :+. n) -> NonEmpty (Either m n)
    toAltList :: forall m n.
    (Semigroup m, Semigroup n) =>
    (m :+. n) -> NonEmpty (Either m n)
    toAltList (SCo NonEmpty (Either m n)
    ms) = NonEmpty (Either m n) -> NonEmpty (Either m n)
    forall m n.
    (Semigroup m, Semigroup n) =>
    NonEmpty (Either m n) -> NonEmpty (Either m n)
    normalize NonEmpty (Either m n)
    ms

    -- Normalize a list of @Either@ values by combining any consecutive
    -- values of the same type.
    normalize :: (Semigroup m, Semigroup n) => NonEmpty (Either m n) -> NonEmpty (Either m n)
    normalize :: forall m n.
    (Semigroup m, Semigroup n) =>
    NonEmpty (Either m n) -> NonEmpty (Either m n)
    normalize = \case
      Left m
    e1 :| Left m
    e2 : [Either m n]
    es -> NonEmpty (Either m n) -> NonEmpty (Either m n)
    forall m n.
    (Semigroup m, Semigroup n) =>
    NonEmpty (Either m n) -> NonEmpty (Either m n)
    normalize (m -> Either m n
    forall a b. a -> Either a b
    Left (m
    e1 m -> m -> m
    forall a. Semigroup a => a -> a -> a
    <> m
    e2) Either m n -> [Either m n] -> NonEmpty (Either m n)
    forall a. a -> [a] -> NonEmpty a
    :| [Either m n]
    es)
      Right n
    e1 :| Right n
    e2 : [Either m n]
    es -> NonEmpty (Either m n) -> NonEmpty (Either m n)
    forall m n.
    (Semigroup m, Semigroup n) =>
    NonEmpty (Either m n) -> NonEmpty (Either m n)
    normalize (n -> Either m n
    forall a b. b -> Either a b
    Right (n
    e1 n -> n -> n
    forall a. Semigroup a => a -> a -> a
    <> n
    e2) Either m n -> [Either m n] -> NonEmpty (Either m n)
    forall a. a -> [a] -> NonEmpty a
    :| [Either m n]
    es)
      Either m n
    e1 :| [Either m n]
    es1 -> case [Either m n]
    es1 of
        Either m n
    e2 : [Either m n]
    es2 -> (Either m n
    e1 Either m n -> [Either m n] -> NonEmpty (Either m n)
    forall a. a -> [a] -> NonEmpty a
    :| []) NonEmpty (Either m n)
    -> NonEmpty (Either m n) -> NonEmpty (Either m n)
    forall a. Semigroup a => a -> a -> a
    <> NonEmpty (Either m n) -> NonEmpty (Either m n)
    forall m n.
    (Semigroup m, Semigroup n) =>
    NonEmpty (Either m n) -> NonEmpty (Either m n)
    normalize (Either m n
    e2 Either m n -> [Either m n] -> NonEmpty (Either m n)
    forall a. a -> [a] -> NonEmpty a
    :| [Either m n]
    es2)
        [] -> Either m n
    e1 Either m n -> [Either m n] -> NonEmpty (Either m n)
    forall a. a -> [a] -> NonEmpty a
    :| []

    -- | Universal map of the coproduct. The name @cop@ is an abbreviation
    --   for copairing. Both functions in the signature should be semigroup
    --   homomorphisms. If they are general functions then the copairing may
    --   not be well defined in the sense that it may send equal elements to
    --   unequal elements. This is also the reason why @cop@ is not the
    --   @Data.Bifoldable1.bifoldMap1@ function even though they have the same
    --   signature.
    cop :: Semigroup k => (m -> k) -> (n -> k) -> (m :+. n) -> k
    m -> k
    f cop :: forall k m n. Semigroup k => (m -> k) -> (n -> k) -> (m :+. n) -> k
    `cop` n -> k
    g = (Either m n -> k) -> NonEmpty (Either m n) -> k
    forall m a. Semigroup m => (a -> m) -> NonEmpty a -> m
    forall (t :: * -> *) m a.
    (Foldable1 t, Semigroup m) =>
    (a -> m) -> t a -> m
    foldMap1 ((m -> k) -> (n -> k) -> Either m n -> k
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either m -> k
    f n -> k
    g) (NonEmpty (Either m n) -> k)
    -> ((m :+. n) -> NonEmpty (Either m n)) -> (m :+. n) -> k
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (m :+. n) -> NonEmpty (Either m n)
    forall m n. (m :+. n) -> NonEmpty (Either m n)
    unSCo

    -- | Injection from the left semigroup into a coproduct.
    inL :: m -> m :+. n
    inL :: forall m n. m -> m :+. n
    inL m
    m = NonEmpty (Either m n) -> m :+. n
    forall m n. NonEmpty (Either m n) -> m :+. n
    SCo (m -> Either m n
    forall a b. a -> Either a b
    Left m
    m Either m n -> [Either m n] -> NonEmpty (Either m n)
    forall a. a -> [a] -> NonEmpty a
    :| [])

    -- | Injection from the right semigroup into a coproduct.
    inR :: n -> m :+. n
    inR :: forall n m. n -> m :+. n
    inR n
    n = NonEmpty (Either m n) -> m :+. n
    forall m n. NonEmpty (Either m n) -> m :+. n
    SCo (n -> Either m n
    forall a b. b -> Either a b
    Right n
    n Either m n -> [Either m n] -> NonEmpty (Either m n)
    forall a. a -> [a] -> NonEmpty a
    :| [])

    -- | Given monoids @m@ and @n@, we can form their semigroup coproduct
    --   @m :+. n@. Every monoid homomorphism is a semigroup homomorphism.
    --   In particular the canonical inections of the monoid coproduct from
    --   @m@ and @n@ into @m :+: n@ are semigroup homomorphisms. By pairing
    --   them using the universal property of the semigroup coproduct we
    --   obtain a canonical semigroup homomorphism `toMonoid` from @m :+. n@
    --   to @m :+: n@.
    toMonoid :: (Monoid m, Monoid n) => m :+. n -> m :+: n
    toMonoid :: forall m n. (Monoid m, Monoid n) => (m :+. n) -> m :+: n
    toMonoid = m -> m :+: n
    forall m n. m -> m :+: n
    M.inL (m -> m :+: n) -> (n -> m :+: n) -> (m :+. n) -> m :+: n
    forall k m n. Semigroup k => (m -> k) -> (n -> k) -> (m :+. n) -> k
    `cop` n -> m :+: n
    forall n m. n -> m :+: n
    M.inR

    instance Semigroup (m :+. n) where
      (SCo NonEmpty (Either m n)
    es1) <> :: (m :+. n) -> (m :+. n) -> m :+. n
    <> (SCo NonEmpty (Either m n)
    es2) = NonEmpty (Either m n) -> m :+. n
    forall m n. NonEmpty (Either m n) -> m :+. n
    SCo (NonEmpty (Either m n)
    es1 NonEmpty (Either m n)
    -> NonEmpty (Either m n) -> NonEmpty (Either m n)
    forall a. Semigroup a => a -> a -> a
    <> NonEmpty (Either m n)
    es2)

    -- | Coproducts act on other things by having each of the components
    --   act individually.
    instance (Action m r, Action n r) => Action (m :+. n) r where
      act :: (m :+. n) -> r -> r
    act = Endo r -> r -> r
    forall a. Endo a -> a -> a
    appEndo (Endo r -> r -> r) -> ((m :+. n) -> Endo r) -> (m :+. n) -> r -> r
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (((r -> r) -> Endo r
    forall a. (a -> a) -> Endo a
    Endo ((r -> r) -> Endo r) -> (m -> r -> r) -> m -> Endo r
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . m -> r -> r
    forall m s. Action m s => m -> s -> s
    act) (m -> Endo r) -> (n -> Endo r) -> (m :+. n) -> Endo r
    forall k m n. Semigroup k => (m -> k) -> (n -> k) -> (m :+. n) -> k
    `cop` ((r -> r) -> Endo r
    forall a. (a -> a) -> Endo a
    Endo ((r -> r) -> Endo r) -> (n -> r -> r) -> n -> Endo r
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . n -> r -> r
    forall m s. Action m s => m -> s -> s
    act))