module Distribution.Compat.Semigroup
( Semigroup((<>))
, Mon.Monoid(..)
, All(..)
, Any(..)
, Last'(..)
, gmappend
, gmempty
) where
import Distribution.Compat.Binary (Binary)
import Control.Applicative as App
import GHC.Generics
#if __GLASGOW_HASKELL__ >= 711
import Data.Semigroup
import qualified Data.Monoid as Mon
#else
import Data.Monoid as Mon (Monoid(..), All(..), Any(..), Dual(..))
import Data.Set (Set)
import Data.IntSet (IntSet)
import Data.Map (Map)
import Data.IntMap (IntMap)
class Semigroup a where
(<>) :: a -> a -> a
instance Semigroup () where
_ <> _ = ()
instance Semigroup [a] where
(<>) = (++)
instance Semigroup a => Semigroup (Dual a) where
Dual a <> Dual b = Dual (b <> a)
instance Semigroup a => Semigroup (Maybe a) where
Nothing <> b = b
a <> Nothing = a
Just a <> Just b = Just (a <> b)
instance Semigroup (Either a b) where
Left _ <> b = b
a <> _ = a
instance Semigroup Ordering where
LT <> _ = LT
EQ <> y = y
GT <> _ = GT
instance Semigroup b => Semigroup (a -> b) where
f <> g = \a -> f a <> g a
instance Semigroup All where
All a <> All b = All (a && b)
instance Semigroup Any where
Any a <> Any b = Any (a || b)
instance (Semigroup a, Semigroup b) => Semigroup (a, b) where
(a,b) <> (a',b') = (a<>a',b<>b')
instance (Semigroup a, Semigroup b, Semigroup c)
=> Semigroup (a, b, c) where
(a,b,c) <> (a',b',c') = (a<>a',b<>b',c<>c')
instance (Semigroup a, Semigroup b, Semigroup c, Semigroup d)
=> Semigroup (a, b, c, d) where
(a,b,c,d) <> (a',b',c',d') = (a<>a',b<>b',c<>c',d<>d')
instance (Semigroup a, Semigroup b, Semigroup c, Semigroup d, Semigroup e)
=> Semigroup (a, b, c, d, e) where
(a,b,c,d,e) <> (a',b',c',d',e') = (a<>a',b<>b',c<>c',d<>d',e<>e')
instance Semigroup IntSet where
(<>) = mappend
instance Ord a => Semigroup (Set a) where
(<>) = mappend
instance Semigroup (IntMap v) where
(<>) = mappend
instance Ord k => Semigroup (Map k v) where
(<>) = mappend
#endif
newtype Last' a = Last' { getLast' :: Maybe a }
deriving (Eq, Ord, Read, Show, Binary,
Functor, App.Applicative, Generic)
instance Semigroup (Last' a) where
x <> Last' Nothing = x
_ <> x = x
instance Monoid (Last' a) where
mempty = Last' Nothing
mappend = (<>)
gmappend :: (Generic a, GSemigroup (Rep a)) => a -> a -> a
gmappend x y = to (gmappend' (from x) (from y))
class GSemigroup f where
gmappend' :: f p -> f p -> f p
instance Semigroup a => GSemigroup (K1 i a) where
gmappend' (K1 x) (K1 y) = K1 (x <> y)
instance GSemigroup f => GSemigroup (M1 i c f) where
gmappend' (M1 x) (M1 y) = M1 (gmappend' x y)
instance (GSemigroup f, GSemigroup g) => GSemigroup (f :*: g) where
gmappend' (x1 :*: x2) (y1 :*: y2) = gmappend' x1 y1 :*: gmappend' x2 y2
gmempty :: (Generic a, GMonoid (Rep a)) => a
gmempty = to gmempty'
class GSemigroup f => GMonoid f where
gmempty' :: f p
instance (Semigroup a, Monoid a) => GMonoid (K1 i a) where
gmempty' = K1 mempty
instance GMonoid f => GMonoid (M1 i c f) where
gmempty' = M1 gmempty'
instance (GMonoid f, GMonoid g) => GMonoid (f :*: g) where
gmempty' = gmempty' :*: gmempty'