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

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

    #if __GLASGOW_HASKELL__ >= 705
    {-# LANGUAGE PolyKinds #-}
    #endif

    module Generics.Deriving.Semigroup (
      -- * Generic semigroup class
        GSemigroup(..)

      -- * Default definition
      , gsappenddefault

      -- * Internal semigroup class
      , GSemigroup'(..)

      ) where

    import Control.Applicative
    import Data.Monoid as Monoid
    #if MIN_VERSION_base(4,5,0)
      hiding ((<>))
    #endif
    import Generics.Deriving.Base

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

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

    #if MIN_VERSION_base(4,9,0)
    import Data.List.NonEmpty (NonEmpty(..))
    import Data.Semigroup as Semigroup
    import Generics.Deriving.Monoid (GMonoid(..))
    #endif

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

    infixr 6 `gsappend'`
    class GSemigroup' f where
      gsappend' :: f x -> f x -> f x

    instance GSemigroup' U1 where
      gsappend' U1 U1 = U1

    instance GSemigroup a => GSemigroup' (K1 i a) where
      gsappend' (K1 x) (K1 y) = K1 (gsappend x y)

    instance GSemigroup' f => GSemigroup' (M1 i c f) where
      gsappend' (M1 x) (M1 y) = M1 (gsappend' x y)

    instance (GSemigroup' f, GSemigroup' g) => GSemigroup' (f :*: g) where
      gsappend' (x1 :*: y1) (x2 :*: y2) = gsappend' x1 x2 :*: gsappend' y1 y2

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

    infixr 6 `gsappend`
    class GSemigroup a where
      gsappend :: a -> a -> a
    #if __GLASGOW_HASKELL__ >= 701
      default gsappend :: (Generic a, GSemigroup' (Rep a)) => a -> a -> a
      gsappend = gsappenddefault
    #endif

      gstimes :: Integral b => b -> a -> a
      gstimes y0 x0
        | y0 <= 0   = error "gstimes: positive multiplier expected"
        | otherwise = f x0 y0
        where
          f x y
            | even y = f (gsappend x x) (y `quot` 2)
            | y == 1 = x
            | otherwise = g (gsappend x x) (pred y  `quot` 2) x
          g x y z
            | even y = g (gsappend x x) (y `quot` 2) z
            | y == 1 = gsappend x z
            | otherwise = g (gsappend x x) (pred y `quot` 2) (gsappend x z)

    #if MIN_VERSION_base(4,9,0)
      -- | Only available with @base-4.9@ or later
      gsconcat :: NonEmpty a -> a
      gsconcat (a :| as) = go a as where
        go b (c:cs) = gsappend b (go c cs)
        go b []     = b
    #endif

    infixr 6 `gsappenddefault`
    gsappenddefault :: (Generic a, GSemigroup' (Rep a)) => a -> a -> a
    gsappenddefault x y = to (gsappend' (from x) (from y))

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

    -- Instances that reuse Monoid
    instance GSemigroup Ordering where
      gsappend = mappend
    instance GSemigroup () where
      gsappend = mappend
    instance GSemigroup Any where
      gsappend = mappend
    instance GSemigroup All where
      gsappend = mappend
    instance GSemigroup (Monoid.First a) where
      gsappend = mappend
    instance GSemigroup (Monoid.Last a) where
      gsappend = mappend
    instance Num a => GSemigroup (Sum a) where
      gsappend = mappend
    instance Num a => GSemigroup (Product a) where
      gsappend = mappend
    instance GSemigroup [a] where
      gsappend = mappend
    instance GSemigroup (Endo a) where
      gsappend = mappend
    #if MIN_VERSION_base(4,8,0)
    instance Alternative f => GSemigroup (Alt f a) where
      gsappend = mappend
    #endif

    -- Handwritten instances
    instance GSemigroup a => GSemigroup (Dual a) where
      gsappend (Dual x) (Dual y) = Dual (gsappend y x)
    instance GSemigroup a => GSemigroup (Maybe a) where
      gsappend Nothing  x        = x
      gsappend x        Nothing  = x
      gsappend (Just x) (Just y) = Just (gsappend x y)
    instance GSemigroup b => GSemigroup (a -> b) where
      gsappend f g x = gsappend (f x) (g x)
    instance GSemigroup a => GSemigroup (Const a b) where
      gsappend = gsappenddefault
    instance GSemigroup (Either a b) where
      gsappend Left{} b = b
      gsappend a      _ = a

    #if MIN_VERSION_base(4,7,0)
    instance GSemigroup
    # if MIN_VERSION_base(4,9,0)
                     (Proxy s)
    # else
                     (Proxy (s :: *))
    # endif
                     where
      gsappend    = gsappenddefault
    #endif

    #if MIN_VERSION_base(4,8,0)
    instance GSemigroup a => GSemigroup (Identity a) where
      gsappend = gsappenddefault

    instance GSemigroup Void where
      gsappend a _ = a
    #endif

    #if MIN_VERSION_base(4,9,0)
    instance GSemigroup (Semigroup.First a) where
      gsappend = (<>)

    instance GSemigroup (Semigroup.Last a) where
      gsappend = (<>)

    instance Ord a => GSemigroup (Max a) where
      gsappend = (<>)

    instance Ord a => GSemigroup (Min a) where
      gsappend = (<>)

    instance GSemigroup (NonEmpty a) where
      gsappend = (<>)

    instance GSemigroup a => GSemigroup (Option a) where
      gsappend (Option a) (Option b) = Option (gsappend a b)

    instance GMonoid m => GSemigroup (WrappedMonoid m) where
      gsappend (WrapMonoid a) (WrapMonoid b) = WrapMonoid (gmappend a b)
    #endif

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