content: {-# LANGUAGE CPP #-}
  {-# LANGUAGE FlexibleContexts #-}
  {-# LANGUAGE Safe #-}
  {-# LANGUAGE TypeOperators #-}
  {-# LANGUAGE UndecidableInstances #-}
  -----------------------------------------------------------------------------
  -- |
  -- Module      :  Data.Semigroup.Generic
  -- Copyright   :  (C) 2014-2015 Edward Kmett, Eric Mertens
  -- License     :  BSD-style (see the file LICENSE)
  --
  -- Maintainer  :  Edward Kmett <ekmett@gmail.com>
  -- Stability   :  provisional
  -- Portability :  portable
  --
  -- This module provides generic deriving tools for monoids and semigroups for
  -- product-like structures.
  --
  ----------------------------------------------------------------------------
  module Data.Semigroup.Generic
    ( -- * Generic method implementations
      gmappend, gmempty
  
      -- * Adapter newtype
    , GenericSemigroupMonoid(..)
  
      -- * Internal classes
    , GSemigroup, GMonoid
    ) where
  
  #if !(MIN_VERSION_base(4,11,0))
  import Data.Semigroup (Semigroup(..))
  #endif
  import GHC.Generics
  
  -- | Generically generate a 'Semigroup' ('<>') operation for any type
  -- implementing 'Generic'. This operation will append two values
  -- by point-wise appending their component fields. It is only defined
  -- for product types.
  --
  -- @
  -- 'gmappend' a ('gmappend' b c) = 'gmappend' ('gmappend' a b) c
  -- @
  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 GSemigroup U1 where
    gmappend' _ _ = U1
  
  instance GSemigroup V1 where
    gmappend' x y = x `seq` y `seq` error "GSemigroup.V1: gmappend'"
  
  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
  
  -- | Generically generate a 'Monoid' 'mempty' for any product-like type
  -- implementing 'Generic'.
  --
  -- It is only defined for product types.
  --
  -- @
  -- 'gmappend' 'gmempty' a = a = 'gmappend' a 'gmempty'
  -- @
  
  gmempty :: (Generic a, GMonoid (Rep a)) => a
  gmempty = to gmempty'
  
  class GSemigroup f => GMonoid f where
    gmempty' :: f p
  
  instance GMonoid U1 where
    gmempty' = U1
  
  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'
  
  -- | An adapter newtype, suitable for @DerivingVia@. Its 'Semigroup' and
  -- 'Monoid' instances leverage the 'Generic'-based defaults defined by
  -- 'gmappend' and 'gmempty'. Here is an example of how to use it:
  --
  -- @
  -- &#123;-&#35; LANGUAGE DerivingVia &#35;-&#125;
  -- import "Data.Semigroup.Generic"
  --
  -- data Pair a = MkPair a a
  --   deriving ('Semigroup', 'Monoid') via ('GenericSemigroupMonoid' (Pair a))
  -- @
  --
  -- @since 0.19.1
  newtype GenericSemigroupMonoid a =
    GenericSemigroupMonoid { getGenericSemigroupMonoid :: a }
  
  instance (Generic a, GSemigroup (Rep a)) => Semigroup (GenericSemigroupMonoid a) where
    GenericSemigroupMonoid x <> GenericSemigroupMonoid y =
      GenericSemigroupMonoid (gmappend x y)
  instance (Generic a, GMonoid (Rep a)) => Monoid (GenericSemigroupMonoid a) where
    mempty = GenericSemigroupMonoid gmempty
  #if !(MIN_VERSION_base(4,11,0))
    mappend = (<>)
  #endif
  