module Distribution.Compat.Semigroup
( Semigroup((<>))
, Mon.Monoid(..)
, All(..)
, Any(..)
, First'(..)
, Last'(..)
, Option'(..)
, gmappend
, gmempty
) where
import Distribution.Compat.Binary (Binary)
import Distribution.Utils.Structured (Structured)
import Data.Typeable (Typeable)
import GHC.Generics
import Data.Semigroup
import qualified Data.Monoid as Mon
newtype First' a = First' { getFirst' :: a }
deriving (Eq, Ord, Show)
instance Semigroup (First' a) where
a <> _ = a
newtype Last' a = Last' { getLast' :: a }
deriving (Eq, Ord, Read, Show, Generic, Binary, Typeable)
instance Structured a => Structured (Last' a)
instance Semigroup (Last' a) where
_ <> b = b
instance Functor Last' where
fmap f (Last' x) = Last' (f x)
newtype Option' a = Option' { getOption' :: Maybe a }
deriving (Eq, Ord, Read, Show, Binary, Generic, Functor, Typeable)
instance Structured a => Structured (Option' a)
instance Semigroup a => Semigroup (Option' a) where
Option' (Just a) <> Option' (Just b) = Option' (Just (a <> b))
Option' Nothing <> b = b
a <> Option' Nothing = a
instance Semigroup a => Monoid (Option' a) where
mempty = Option' 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'