-- | A semigroup is a binary associative operation.
module Data.Semigroup(
                     Semigroup((.++.)),
                     Identity,
                     (<++>)
                     ) where

import Data.Monoid
import Control.Applicative

-- | A binary operation that must satisfy associativity. Unlike a @Monoid@, an identity in not essential.
class Semigroup a where
  (.++.) :: a -> a -> a

-- | A wrapper used to construct a @Semigroup@ from a @Monoid@.
newtype Identity a = Identity { run :: a }

-- | A binary associative operation lifted into an applicative functor.
(<++>) :: (Applicative f, Semigroup a) => f a -> f a -> f a
(<++>) = liftA2 (.++.)

instance Functor Identity where
  fmap f (Identity a) = Identity (f a)

instance Applicative Identity where
  pure = Identity
  Identity f <*> Identity a = Identity (f a)

instance Monad Identity where
  return = Identity
  Identity a >>= f = f a

instance Monoid a => Semigroup (Identity a) where
  (.++.) = liftA2 mappend

instance Semigroup () where
  _ .++. _ = ()

instance Semigroup b => Semigroup (a -> b) where
  (.++.) = (<++>)

instance Semigroup a => Semigroup (IO a) where
  (.++.) = (<++>)

instance (Semigroup a, Semigroup b) => Semigroup (a, b) where
  (a1, b1) .++. (a2, b2) = (a1 .++. a2, b1 .++. b2)

instance (Semigroup a, Semigroup b, Semigroup c) => Semigroup (a, b, c) where
  (a1, b1, c1) .++. (a2, b2, c2) = (a1 .++. a2, b1 .++. b2, c1 .++. c2)

instance (Semigroup a, Semigroup b, Semigroup c, Semigroup d) => Semigroup (a, b, c, d) where
  (a1, b1, c1, d1) .++. (a2, b2, c2, d2) = (a1 .++. a2, b1 .++. b2, c1 .++. c2, d1 .++. d2)

instance (Semigroup a, Semigroup b, Semigroup c, Semigroup d, Semigroup e) => Semigroup (a, b, c, d, e) where
  (a1, b1, c1, d1, e1) .++. (a2, b2, c2, d2, e2) = (a1 .++. a2, b1 .++. b2, c1 .++. c2, d1 .++. d2, e1 .++. e2)

instance Semigroup Ordering where
  a .++. b = run (Identity a .++. Identity b)

instance Semigroup All where
  a .++. b = run (Identity a .++. Identity b)

instance Semigroup Any where
  a .++. b = run (Identity a .++. Identity b)

instance Semigroup a => Semigroup (Dual a) where
  Dual a .++. Dual b = Dual (b .++. a)

instance Semigroup (Endo a) where
  a .++. b = run (Identity a .++. Identity b)

instance Num a => Semigroup (Product a) where
  a .++. b = run (Identity a .++. Identity b)

instance Num a => Semigroup (Sum a) where
  a .++. b = run (Identity a .++. Identity b)

instance Semigroup a => Semigroup (Maybe a) where
  Nothing .++. b = b
  a .++. Nothing = a
  Just a .++. Just b = Just (a .++. b)

instance Semigroup (First a) where
  a .++. b = run (Identity a .++. Identity b)

instance Semigroup (Last a) where
  a .++. b = run (Identity a .++. Identity b)

instance Semigroup [a] where
  (.++.) = (++)