{-# LANGUAGE DeriveDataTypeable #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Data.Semigroup
-- Copyright   :  (C) 2011 Edward Kmett,
-- License     :  BSD-style (see the file LICENSE)
--
-- Maintainer  :  Edward Kmett <ekmett@gmail.com>
-- Stability   :  provisional
-- Portability :  portable
--
----------------------------------------------------------------------------
module Data.Semigroup ( 
    Semigroup(..)
  -- * Semigroups
  , Min(..)
  , Max(..)
  , First(..)
  , Last(..)
  , WrappedMonoid(..)
  -- * Monoids from Data.Monoid 
  , Dual(..)
  , Endo(..)
  , All(..)
  , Any(..)
  , Sum(..)
  , Product(..)
  -- * New Monoids
  , Option(..)
  , option
  ) where

import Prelude hiding (foldr1)
import Data.Monoid hiding (First(..), Last(..))
import qualified Data.Monoid as Monoid
import Data.Data

infixl 4 <> 

class Semigroup a where
  (<>) :: a -> a -> a

-- Semigroups from Data.Monoid

instance Semigroup a => Semigroup (Dual a) where
  Dual a <> Dual b = Dual (b <> a)

instance Semigroup (Endo a) where
  Endo f <> Endo g = Endo (f . g) 

instance Semigroup All where
  All a <> All b = All (a && b)

instance Semigroup Any where
  Any a <> Any b = Any (a || b)

instance Num a => Semigroup (Sum a) where
  Sum a <> Sum b = Sum (a + b)

instance Num a => Semigroup (Product a) where
  Product a <> Product b = Product (a * b)

instance Semigroup (Monoid.First a) where
  Monoid.First Nothing <> b = b
  a             <> _ = a

instance Semigroup (Monoid.Last a) where
  a <> Monoid.Last Nothing = a
  _ <> b            = b

-- * Other Semigroups

newtype Min a = Min { getMin :: a } 
  deriving (Eq,Ord,Bounded,Show,Read,Data,Typeable)

instance Ord a => Semigroup (Min a) where
  Min a <> Min b = Min (a `min` b)

instance (Ord a, Bounded a) => Monoid (Min a) where
  mempty = maxBound
  mappend = (<>) 

newtype Max a = Max { getMax :: a } 
  deriving (Eq,Ord,Bounded,Show,Read,Data,Typeable)

instance Ord a => Semigroup (Max a) where
  Max a <> Max b = Max (a `min` b)

instance (Ord a, Bounded a) => Monoid (Max a) where
  mempty = minBound
  mappend = (<>) 

-- | Use Option (First a) -- to get the behavior of Data.Monoid.First
newtype First a = First { getFirst :: a }
  deriving (Eq,Ord,Bounded,Show,Read,Data,Typeable)

instance Semigroup (First a) where
  a <> _ = a

-- | Use Option (Last a) -- to get the behavior of Data.Monoid.Last
newtype Last a = Last { getLast :: a }
  deriving (Eq,Ord,Bounded,Show,Read,Data,Typeable)

instance Semigroup (Last a) where
  _ <> b = b

-- (==)/XNOR on Bool forms a Semigroup, but has no good name

newtype WrappedMonoid m = WrapMonoid { unwrapMonoid :: m } 
  deriving (Data, Typeable, Show, Read, Eq, Ord)

instance Monoid m => Semigroup (WrappedMonoid m) where
  WrapMonoid a <> WrapMonoid b = WrapMonoid (a `mappend` b)

instance Monoid m => Monoid (WrappedMonoid m) where
  mempty = WrapMonoid mempty
  WrapMonoid a `mappend` WrapMonoid b = WrapMonoid (a `mappend` b)

newtype Option a = Option { getOption :: Maybe a } 
  deriving (Data, Typeable, Show, Read, Eq, Ord)

option :: b -> (a -> b) -> Option a -> b
option n j (Option m) = maybe n j m

instance Semigroup a => Semigroup (Option a) where
  Option Nothing <> b = b
  a <> Option Nothing = a
  Option (Just a) <> Option (Just b) = Option (Just (a <> b))

instance Semigroup a => Monoid (Option a) where
  mempty = Option Nothing

  Option Nothing `mappend` b = b
  a `mappend` Option Nothing = a
  Option (Just a) `mappend` Option (Just b) = Option (Just (a <> b))