{-# LANGUAGE CPP #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE UndecidableInstances #-}
#if __GLASGOW_HASKELL__ >= 704
{-# LANGUAGE Safe #-}
#else
{-# LANGUAGE Trustworthy #-}
#endif
module Data.Semigroup.Generic
(
gmappend, gmempty
, GenericSemigroupMonoid(..)
, GSemigroup, GMonoid
) where
#if !(MIN_VERSION_base(4,8,0))
import Data.Monoid (Monoid(..))
#endif
#if !(MIN_VERSION_base(4,11,0))
import Data.Semigroup (Semigroup(..))
#endif
import GHC.Generics
gmappend :: (Generic a, GSemigroup (Rep a)) => a -> a -> a
gmappend :: a -> a -> a
gmappend a
x a
y = Rep a Any -> a
forall a x. Generic a => Rep a x -> a
to (Rep a Any -> Rep a Any -> Rep a Any
forall (f :: * -> *) p. GSemigroup f => f p -> f p -> f p
gmappend' (a -> Rep a Any
forall a x. Generic a => a -> Rep a x
from a
x) (a -> Rep a Any
forall a x. Generic a => a -> Rep a x
from a
y))
class GSemigroup f where
gmappend' :: f p -> f p -> f p
instance GSemigroup U1 where
gmappend' :: U1 p -> U1 p -> U1 p
gmappend' U1 p
_ U1 p
_ = U1 p
forall k (p :: k). U1 p
U1
instance GSemigroup V1 where
gmappend' :: V1 p -> V1 p -> V1 p
gmappend' V1 p
x V1 p
y = V1 p
x V1 p -> V1 p -> V1 p
`seq` V1 p
y V1 p -> V1 p -> V1 p
`seq` [Char] -> V1 p
forall a. HasCallStack => [Char] -> a
error [Char]
"GSemigroup.V1: gmappend'"
instance Semigroup a => GSemigroup (K1 i a) where
gmappend' :: K1 i a p -> K1 i a p -> K1 i a p
gmappend' (K1 a
x) (K1 a
y) = a -> K1 i a p
forall k i c (p :: k). c -> K1 i c p
K1 (a
x a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
y)
instance GSemigroup f => GSemigroup (M1 i c f) where
gmappend' :: M1 i c f p -> M1 i c f p -> M1 i c f p
gmappend' (M1 f p
x) (M1 f p
y) = f p -> M1 i c f p
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (f p -> f p -> f p
forall (f :: * -> *) p. GSemigroup f => f p -> f p -> f p
gmappend' f p
x f p
y)
instance (GSemigroup f, GSemigroup g) => GSemigroup (f :*: g) where
gmappend' :: (:*:) f g p -> (:*:) f g p -> (:*:) f g p
gmappend' (f p
x1 :*: g p
x2) (f p
y1 :*: g p
y2) = f p -> f p -> f p
forall (f :: * -> *) p. GSemigroup f => f p -> f p -> f p
gmappend' f p
x1 f p
y1 f p -> g p -> (:*:) f g p
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: g p -> g p -> g p
forall (f :: * -> *) p. GSemigroup f => f p -> f p -> f p
gmappend' g p
x2 g p
y2
gmempty :: (Generic a, GMonoid (Rep a)) => a
gmempty :: a
gmempty = Rep a Any -> a
forall a x. Generic a => Rep a x -> a
to Rep a Any
forall (f :: * -> *) p. GMonoid f => f p
gmempty'
class GSemigroup f => GMonoid f where
gmempty' :: f p
instance GMonoid U1 where
gmempty' :: U1 p
gmempty' = U1 p
forall k (p :: k). U1 p
U1
instance (Semigroup a, Monoid a) => GMonoid (K1 i a) where
gmempty' :: K1 i a p
gmempty' = a -> K1 i a p
forall k i c (p :: k). c -> K1 i c p
K1 a
forall a. Monoid a => a
mempty
instance GMonoid f => GMonoid (M1 i c f) where
gmempty' :: M1 i c f p
gmempty' = f p -> M1 i c f p
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 f p
forall (f :: * -> *) p. GMonoid f => f p
gmempty'
instance (GMonoid f, GMonoid g) => GMonoid (f :*: g) where
gmempty' :: (:*:) f g p
gmempty' = f p
forall (f :: * -> *) p. GMonoid f => f p
gmempty' f p -> g p -> (:*:) f g p
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: g p
forall (f :: * -> *) p. GMonoid f => f p
gmempty'
newtype GenericSemigroupMonoid a =
GenericSemigroupMonoid { GenericSemigroupMonoid a -> a
getGenericSemigroupMonoid :: a }
instance (Generic a, GSemigroup (Rep a)) => Semigroup (GenericSemigroupMonoid a) where
GenericSemigroupMonoid a
x <> :: GenericSemigroupMonoid a
-> GenericSemigroupMonoid a -> GenericSemigroupMonoid a
<> GenericSemigroupMonoid a
y =
a -> GenericSemigroupMonoid a
forall a. a -> GenericSemigroupMonoid a
GenericSemigroupMonoid (a -> a -> a
forall a. (Generic a, GSemigroup (Rep a)) => a -> a -> a
gmappend a
x a
y)
instance (Generic a, GMonoid (Rep a)) => Monoid (GenericSemigroupMonoid a) where
mempty :: GenericSemigroupMonoid a
mempty = a -> GenericSemigroupMonoid a
forall a. a -> GenericSemigroupMonoid a
GenericSemigroupMonoid a
forall a. (Generic a, GMonoid (Rep a)) => a
gmempty
#if !(MIN_VERSION_base(4,11,0))
mappend = (<>)
#endif