    {-# LANGUAGE CPP #-}
    {-# LANGUAGE FlexibleContexts #-}
    {-# LANGUAGE TypeOperators #-}

    #if __GLASGOW_HASKELL__ >= 701
    {-# LANGUAGE DefaultSignatures #-}
    #endif

    -- | This module provides two main features:
    --
    --     1. 'GMonoid', a generic version of the 'Monoid' type class, including instances
    --     of the types from "Data.Monoid"
    --
    --     2. Default generic definitions for the 'Monoid' methods 'mempty' and 'mappend'
    --
    -- The generic defaults only work for types without alternatives (i.e. they have
    -- only one constructor). We cannot in general know how to deal with different
    -- constructors.

    module Generics.Deriving.Monoid (

      -- * GMonoid type class
      GMonoid(..),

      -- * Default definitions
      -- ** GMonoid
      gmemptydefault,
      gmappenddefault,

      -- ** Monoid
      -- | These functions can be used in a 'Monoid' instance. For example:
      --
      -- @
      -- -- LANGUAGE DeriveGeneric
      --
      -- import Generics.Deriving.Base (Generic)
      -- import Generics.Deriving.Monoid
      --
      -- data T a = C a (Maybe a) deriving Generic
      --
      -- instance Monoid a => Monoid (T a) where
      --   mempty  = memptydefault
      --   mappend = mappenddefault
      -- @
      memptydefault,
      mappenddefault,

      -- * The Monoid module
      -- | This is exported for convenient access to the various wrapper types.
      module Data.Monoid,

      ) where

    --------------------------------------------------------------------------------

    import Control.Applicative
    import Data.Monoid
    import Generics.Deriving.Base
    import Generics.Deriving.Instances ()

    #if MIN_VERSION_base(4,7,0)
    import Data.Proxy (Proxy)
    #endif

    #if MIN_VERSION_base(4,8,0)
    import Data.Functor.Identity (Identity)
    #endif

    --------------------------------------------------------------------------------

    class GMonoid' f where
      gmempty'  :: f x
      gmappend' :: f x -> f x -> f x

    instance GMonoid' U1 where
      gmempty' = U1
      gmappend' U1 U1 = U1

    instance GMonoid a => GMonoid' (K1 i a) where
      gmempty' = K1 gmempty
      gmappend' (K1 x) (K1 y) = K1 (x `gmappend` y)

    instance GMonoid' f => GMonoid' (M1 i c f) where
      gmempty' = M1 gmempty'
      gmappend' (M1 x) (M1 y) = M1 (x `gmappend'` y)

    instance (GMonoid' f, GMonoid' h) => GMonoid' (f :*: h) where
      gmempty' = gmempty' :*: gmempty'
      gmappend' (x1 :*: y1) (x2 :*: y2) = gmappend' x1 x2 :*: gmappend' y1 y2

    --------------------------------------------------------------------------------

    gmemptydefault :: (Generic a, GMonoid' (Rep a)) => a
    gmemptydefault = to gmempty'

    gmappenddefault :: (Generic a, GMonoid' (Rep a)) => a -> a -> a
    gmappenddefault x y = to (gmappend' (from x) (from y))

    --------------------------------------------------------------------------------

    class Monoid' f where
      mempty'  :: f x
      mappend' :: f x -> f x -> f x

    instance Monoid' U1 where
      mempty' = U1
      mappend' U1 U1 = U1

    instance Monoid a => Monoid' (K1 i a) where
      mempty' = K1 mempty
      mappend' (K1 x) (K1 y) = K1 (x `mappend` y)

    instance Monoid' f => Monoid' (M1 i c f) where
      mempty' = M1 mempty'
      mappend' (M1 x) (M1 y) = M1 (x `mappend'` y)

    instance (Monoid' f, Monoid' h) => Monoid' (f :*: h) where
      mempty' = mempty' :*: mempty'
      mappend' (x1 :*: y1) (x2 :*: y2) = mappend' x1 x2 :*: mappend' y1 y2

    --------------------------------------------------------------------------------

    memptydefault :: (Generic a, Monoid' (Rep a)) => a
    memptydefault = to mempty'

    mappenddefault :: (Generic a, Monoid' (Rep a)) => a -> a -> a
    mappenddefault x y = to (mappend' (from x) (from y))

    --------------------------------------------------------------------------------

    class GMonoid a where

      -- | Generic 'mempty'
      gmempty  :: a

      -- | Generic 'mappend'
      gmappend :: a -> a -> a

      -- | Generic 'mconcat'
      gmconcat :: [a] -> a
      gmconcat = foldr gmappend gmempty

    #if __GLASGOW_HASKELL__ >= 701
      default gmempty :: (Generic a, GMonoid' (Rep a)) => a
      gmempty = to gmempty'

      default gmappend :: (Generic a, GMonoid' (Rep a)) => a -> a -> a
      gmappend x y = to (gmappend' (from x) (from y))
    #endif

    --------------------------------------------------------------------------------

    -- Instances that reuse Monoid
    instance GMonoid Ordering where
      gmempty = mempty
      gmappend = mappend
    instance GMonoid () where
      gmempty = mempty
      gmappend = mappend
    instance GMonoid Any where
      gmempty = mempty
      gmappend = mappend
    instance GMonoid All where
      gmempty = mempty
      gmappend = mappend
    instance GMonoid (First a) where
      gmempty = mempty
      gmappend = mappend
    instance GMonoid (Last a) where
      gmempty = mempty
      gmappend = mappend
    instance Num a => GMonoid (Sum a) where
      gmempty = mempty
      gmappend = mappend
    instance Num a => GMonoid (Product a) where
      gmempty = mempty
      gmappend = mappend
    instance GMonoid [a] where
      gmempty  = mempty
      gmappend = mappend
    instance GMonoid (Endo a) where
      gmempty = mempty
      gmappend = mappend

    -- Handwritten instances
    instance GMonoid a => GMonoid (Dual a) where
      gmempty = Dual gmempty
      gmappend (Dual x) (Dual y) = Dual (gmappend y x)
    instance GMonoid a => GMonoid (Maybe a) where
      gmempty = Nothing
      gmappend Nothing  x        = x
      gmappend x        Nothing  = x
      gmappend (Just x) (Just y) = Just (gmappend x y)
    instance GMonoid b => GMonoid (a -> b) where
      gmempty _ = gmempty
      gmappend f g x = gmappend (f x) (g x)
    instance GMonoid a => GMonoid (Const a b) where
      gmempty  = gmemptydefault
      gmappend = gmappenddefault

    #if MIN_VERSION_base(4,7,0)
    instance GMonoid (Proxy s) where
      gmempty  = memptydefault
      gmappend = mappenddefault
    #endif

    #if MIN_VERSION_base(4,8,0)
    instance GMonoid a => GMonoid (Identity a) where
      gmempty  = gmemptydefault
      gmappend = gmappenddefault
    #endif

    -- Tuple instances
    instance (GMonoid a,GMonoid b) => GMonoid (a,b) where
      gmempty = (gmempty,gmempty)
      gmappend (a1,b1) (a2,b2) =
        (gmappend a1 a2,gmappend b1 b2)
    instance (GMonoid a,GMonoid b,GMonoid c) => GMonoid (a,b,c) where
      gmempty = (gmempty,gmempty,gmempty)
      gmappend (a1,b1,c1) (a2,b2,c2) =
        (gmappend a1 a2,gmappend b1 b2,gmappend c1 c2)
    instance (GMonoid a,GMonoid b,GMonoid c,GMonoid d) => GMonoid (a,b,c,d) where
      gmempty = (gmempty,gmempty,gmempty,gmempty)
      gmappend (a1,b1,c1,d1) (a2,b2,c2,d2) =
        (gmappend a1 a2,gmappend b1 b2,gmappend c1 c2,gmappend d1 d2)
    instance (GMonoid a,GMonoid b,GMonoid c,GMonoid d,GMonoid e) => GMonoid (a,b,c,d,e) where
      gmempty = (gmempty,gmempty,gmempty,gmempty,gmempty)
      gmappend (a1,b1,c1,d1,e1) (a2,b2,c2,d2,e2) =
        (gmappend a1 a2,gmappend b1 b2,gmappend c1 c2,gmappend d1 d2,gmappend e1 e2)
    instance (GMonoid a,GMonoid b,GMonoid c,GMonoid d,GMonoid e,GMonoid f) => GMonoid (a,b,c,d,e,f) where
      gmempty = (gmempty,gmempty,gmempty,gmempty,gmempty,gmempty)
      gmappend (a1,b1,c1,d1,e1,f1) (a2,b2,c2,d2,e2,f2) =
        (gmappend a1 a2,gmappend b1 b2,gmappend c1 c2,gmappend d1 d2,gmappend e1 e2,gmappend f1 f2)
    instance (GMonoid a,GMonoid b,GMonoid c,GMonoid d,GMonoid e,GMonoid f,GMonoid g) => GMonoid (a,b,c,d,e,f,g) where
      gmempty = (gmempty,gmempty,gmempty,gmempty,gmempty,gmempty,gmempty)
      gmappend (a1,b1,c1,d1,e1,f1,g1) (a2,b2,c2,d2,e2,f2,g2) =
        (gmappend a1 a2,gmappend b1 b2,gmappend c1 c2,gmappend d1 d2,gmappend e1 e2,gmappend f1 f2,gmappend g1 g2)
    instance (GMonoid a,GMonoid b,GMonoid c,GMonoid d,GMonoid e,GMonoid f,GMonoid g,GMonoid h) => GMonoid (a,b,c,d,e,f,g,h) where
      gmempty = (gmempty,gmempty,gmempty,gmempty,gmempty,gmempty,gmempty,gmempty)
      gmappend (a1,b1,c1,d1,e1,f1,g1,h1) (a2,b2,c2,d2,e2,f2,g2,h2) =
        (gmappend a1 a2,gmappend b1 b2,gmappend c1 c2,gmappend d1 d2,gmappend e1 e2,gmappend f1 f2,gmappend g1 g2,gmappend h1 h2)