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

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

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

#if __GLASGOW_HASKELL__ >= 710
{-# LANGUAGE Safe #-}
#elif __GLASGOW_HASKELL__ >= 701
{-# LANGUAGE Trustworthy #-}
#endif

module Generics.Deriving.Semigroup.Internal (
  -- * 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,6,0)
import Data.Ord (Down)
#else
import GHC.Exts (Down)
#endif

#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
#endif

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

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

instance GSemigroup' U1 where
  gsappend' :: forall (x :: k). U1 x -> U1 x -> U1 x
gsappend' U1 x
U1 U1 x
U1 = forall k (p :: k). U1 p
U1

instance GSemigroup a => GSemigroup' (K1 i a) where
  gsappend' :: forall (x :: k). K1 i a x -> K1 i a x -> K1 i a x
gsappend' (K1 a
x) (K1 a
y) = forall k i c (p :: k). c -> K1 i c p
K1 (forall a. GSemigroup a => a -> a -> a
gsappend a
x a
y)

instance GSemigroup' f => GSemigroup' (M1 i c f) where
  gsappend' :: forall (x :: k). M1 i c f x -> M1 i c f x -> M1 i c f x
gsappend' (M1 f x
x) (M1 f x
y) = forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (forall {k} (f :: k -> *) (x :: k).
GSemigroup' f =>
f x -> f x -> f x
gsappend' f x
x f x
y)

instance (GSemigroup' f, GSemigroup' g) => GSemigroup' (f :*: g) where
  gsappend' :: forall (x :: k). (:*:) f g x -> (:*:) f g x -> (:*:) f g x
gsappend' (f x
x1 :*: g x
y1) (f x
x2 :*: g x
y2) = forall {k} (f :: k -> *) (x :: k).
GSemigroup' f =>
f x -> f x -> f x
gsappend' f x
x1 f x
x2 forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: forall {k} (f :: k -> *) (x :: k).
GSemigroup' f =>
f x -> f x -> f x
gsappend' g x
y1 g x
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 = forall a. (Generic a, GSemigroup' (Rep a)) => a -> a -> a
gsappenddefault
#endif

  gstimes :: Integral b => b -> a -> a
  gstimes b
y0 a
x0
    | b
y0 forall a. Ord a => a -> a -> Bool
<= b
0   = forall a. HasCallStack => [Char] -> a
error [Char]
"gstimes: positive multiplier expected"
    | Bool
otherwise = forall {a} {t}. (Integral a, GSemigroup t) => t -> a -> t
f a
x0 b
y0
    where
      f :: t -> a -> t
f t
x a
y
        | forall a. Integral a => a -> Bool
even a
y = t -> a -> t
f (forall a. GSemigroup a => a -> a -> a
gsappend t
x t
x) (a
y forall a. Integral a => a -> a -> a
`quot` a
2)
        | a
y forall a. Eq a => a -> a -> Bool
== a
1 = t
x
        | Bool
otherwise = forall {a} {t}. (Integral a, GSemigroup t) => t -> a -> t -> t
g (forall a. GSemigroup a => a -> a -> a
gsappend t
x t
x) (forall a. Enum a => a -> a
pred a
y  forall a. Integral a => a -> a -> a
`quot` a
2) t
x
      g :: t -> a -> t -> t
g t
x a
y t
z
        | forall a. Integral a => a -> Bool
even a
y = t -> a -> t -> t
g (forall a. GSemigroup a => a -> a -> a
gsappend t
x t
x) (a
y forall a. Integral a => a -> a -> a
`quot` a
2) t
z
        | a
y forall a. Eq a => a -> a -> Bool
== a
1 = forall a. GSemigroup a => a -> a -> a
gsappend t
x t
z
        | Bool
otherwise = t -> a -> t -> t
g (forall a. GSemigroup a => a -> a -> a
gsappend t
x t
x) (forall a. Enum a => a -> a
pred a
y forall a. Integral a => a -> a -> a
`quot` a
2) (forall a. GSemigroup a => a -> a -> a
gsappend t
x t
z)

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

infixr 6 `gsappenddefault`
gsappenddefault :: (Generic a, GSemigroup' (Rep a)) => a -> a -> a
gsappenddefault :: forall a. (Generic a, GSemigroup' (Rep a)) => a -> a -> a
gsappenddefault a
x a
y = forall a x. Generic a => Rep a x -> a
to (forall {k} (f :: k -> *) (x :: k).
GSemigroup' f =>
f x -> f x -> f x
gsappend' (forall a x. Generic a => a -> Rep a x
from a
x) (forall a x. Generic a => a -> Rep a x
from a
y))

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

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

-- Handwritten instances
instance GSemigroup a => GSemigroup (Dual a) where
  gsappend :: Dual a -> Dual a -> Dual a
gsappend (Dual a
x) (Dual a
y) = forall a. a -> Dual a
Dual (forall a. GSemigroup a => a -> a -> a
gsappend a
y a
x)
instance GSemigroup a => GSemigroup (Maybe a) where
  gsappend :: Maybe a -> Maybe a -> Maybe a
gsappend Maybe a
Nothing  Maybe a
x        = Maybe a
x
  gsappend Maybe a
x        Maybe a
Nothing  = Maybe a
x
  gsappend (Just a
x) (Just a
y) = forall a. a -> Maybe a
Just (forall a. GSemigroup a => a -> a -> a
gsappend a
x a
y)
instance GSemigroup b => GSemigroup (a -> b) where
  gsappend :: (a -> b) -> (a -> b) -> a -> b
gsappend a -> b
f a -> b
g a
x = forall a. GSemigroup a => a -> a -> a
gsappend (a -> b
f a
x) (a -> b
g a
x)
instance GSemigroup a => GSemigroup (Const a b) where
  gsappend :: Const a b -> Const a b -> Const a b
gsappend = forall a. (Generic a, GSemigroup' (Rep a)) => a -> a -> a
gsappenddefault
instance GSemigroup a => GSemigroup (Down a) where
  gsappend :: Down a -> Down a -> Down a
gsappend = forall a. (Generic a, GSemigroup' (Rep a)) => a -> a -> a
gsappenddefault
instance GSemigroup (Either a b) where
  gsappend :: Either a b -> Either a b -> Either a b
gsappend Left{} Either a b
b = Either a b
b
  gsappend Either a b
a      Either a b
_ = Either a b
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 :: Proxy s -> Proxy s -> Proxy s
gsappend    = forall a. (Generic a, GSemigroup' (Rep a)) => a -> a -> a
gsappenddefault
#endif

#if MIN_VERSION_base(4,8,0)
instance GSemigroup a => GSemigroup (Identity a) where
  gsappend :: Identity a -> Identity a -> Identity a
gsappend = forall a. (Generic a, GSemigroup' (Rep a)) => a -> a -> a
gsappenddefault

instance GSemigroup Void where
  gsappend :: Void -> Void -> Void
gsappend Void
a Void
_ = Void
a
#endif

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

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

instance Ord a => GSemigroup (Max a) where
  gsappend :: Max a -> Max a -> Max a
gsappend = forall a. Semigroup a => a -> a -> a
(<>)

instance Ord a => GSemigroup (Min a) where
  gsappend :: Min a -> Min a -> Min a
gsappend = forall a. Semigroup a => a -> a -> a
(<>)

instance GSemigroup (NonEmpty a) where
  gsappend :: NonEmpty a -> NonEmpty a -> NonEmpty a
gsappend = forall a. Semigroup a => a -> a -> a
(<>)
#endif

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