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

-- | Compatibility layer for "Data.Semigroup"
module Distribution.Compat.Semigroup
    ( Semigroup((<>))
    , Mon.Monoid(..)
    , All(..)
    , Any(..)

    , Last'(..)

    , gmappend
    , gmempty
    ) where

import Distribution.Compat.Binary (Binary)

import Control.Applicative as App
import GHC.Generics
#if __GLASGOW_HASKELL__ >= 711
-- Data.Semigroup is available since GHC 8.0/base-4.9
import Data.Semigroup
import qualified Data.Monoid as Mon
#else
-- provide internal simplified non-exposed class for older GHCs
import Data.Monoid as Mon (Monoid(..), All(..), Any(..), Dual(..))
-- containers
import Data.Set (Set)
import Data.IntSet (IntSet)
import Data.Map (Map)
import Data.IntMap (IntMap)


class Semigroup a where
    (<>) :: a -> a -> a

-- several primitive instances
instance Semigroup () where
    _ <> _ = ()

instance Semigroup [a] where
    (<>) = (++)

instance Semigroup a => Semigroup (Dual a) where
    Dual a <> Dual b = Dual (b <> a)

instance Semigroup a => Semigroup (Maybe a) where
    Nothing <> b       = b
    a       <> Nothing = a
    Just a  <> Just b  = Just (a <> b)

instance Semigroup (Either a b) where
    Left _ <> b = b
    a      <> _ = a

instance Semigroup Ordering where
    LT <> _ = LT
    EQ <> y = y
    GT <> _ = GT

instance Semigroup b => Semigroup (a -> b) where
    f <> g = \a -> f a <> g a

instance Semigroup All where
    All a <> All b = All (a && b)

instance Semigroup Any where
    Any a <> Any b = Any (a || b)

instance (Semigroup a, Semigroup b) => Semigroup (a, b) where
    (a,b) <> (a',b') = (a<>a',b<>b')

instance (Semigroup a, Semigroup b, Semigroup c)
         => Semigroup (a, b, c) where
    (a,b,c) <> (a',b',c') = (a<>a',b<>b',c<>c')

instance (Semigroup a, Semigroup b, Semigroup c, Semigroup d)
         => Semigroup (a, b, c, d) where
    (a,b,c,d) <> (a',b',c',d') = (a<>a',b<>b',c<>c',d<>d')

instance (Semigroup a, Semigroup b, Semigroup c, Semigroup d, Semigroup e)
         => Semigroup (a, b, c, d, e) where
    (a,b,c,d,e) <> (a',b',c',d',e') = (a<>a',b<>b',c<>c',d<>d',e<>e')

-- containers instances
instance Semigroup IntSet where
  (<>) = mappend

instance Ord a => Semigroup (Set a) where
  (<>) = mappend

instance Semigroup (IntMap v) where
  (<>) = mappend

instance Ord k => Semigroup (Map k v) where
  (<>) = mappend
#endif

-- | Cabal's own 'Data.Monoid.Last' copy to avoid requiring an orphan
-- 'Binary' instance.
--
-- Once the oldest `binary` version we support provides a 'Binary'
-- instance for 'Data.Monoid.Last' we can remove this one here.
--
-- NB: 'Data.Semigroup.Last' is defined differently and not a 'Monoid'
newtype Last' a = Last' { Last' a -> Maybe a
getLast' :: Maybe a }
                deriving (Last' a -> Last' a -> Bool
(Last' a -> Last' a -> Bool)
-> (Last' a -> Last' a -> Bool) -> Eq (Last' a)
forall a. Eq a => Last' a -> Last' a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Last' a -> Last' a -> Bool
$c/= :: forall a. Eq a => Last' a -> Last' a -> Bool
== :: Last' a -> Last' a -> Bool
$c== :: forall a. Eq a => Last' a -> Last' a -> Bool
Eq, Eq (Last' a)
Eq (Last' a) =>
(Last' a -> Last' a -> Ordering)
-> (Last' a -> Last' a -> Bool)
-> (Last' a -> Last' a -> Bool)
-> (Last' a -> Last' a -> Bool)
-> (Last' a -> Last' a -> Bool)
-> (Last' a -> Last' a -> Last' a)
-> (Last' a -> Last' a -> Last' a)
-> Ord (Last' a)
Last' a -> Last' a -> Bool
Last' a -> Last' a -> Ordering
Last' a -> Last' a -> Last' a
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (Last' a)
forall a. Ord a => Last' a -> Last' a -> Bool
forall a. Ord a => Last' a -> Last' a -> Ordering
forall a. Ord a => Last' a -> Last' a -> Last' a
min :: Last' a -> Last' a -> Last' a
$cmin :: forall a. Ord a => Last' a -> Last' a -> Last' a
max :: Last' a -> Last' a -> Last' a
$cmax :: forall a. Ord a => Last' a -> Last' a -> Last' a
>= :: Last' a -> Last' a -> Bool
$c>= :: forall a. Ord a => Last' a -> Last' a -> Bool
> :: Last' a -> Last' a -> Bool
$c> :: forall a. Ord a => Last' a -> Last' a -> Bool
<= :: Last' a -> Last' a -> Bool
$c<= :: forall a. Ord a => Last' a -> Last' a -> Bool
< :: Last' a -> Last' a -> Bool
$c< :: forall a. Ord a => Last' a -> Last' a -> Bool
compare :: Last' a -> Last' a -> Ordering
$ccompare :: forall a. Ord a => Last' a -> Last' a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (Last' a)
Ord, ReadPrec [Last' a]
ReadPrec (Last' a)
Int -> ReadS (Last' a)
ReadS [Last' a]
(Int -> ReadS (Last' a))
-> ReadS [Last' a]
-> ReadPrec (Last' a)
-> ReadPrec [Last' a]
-> Read (Last' a)
forall a. Read a => ReadPrec [Last' a]
forall a. Read a => ReadPrec (Last' a)
forall a. Read a => Int -> ReadS (Last' a)
forall a. Read a => ReadS [Last' a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Last' a]
$creadListPrec :: forall a. Read a => ReadPrec [Last' a]
readPrec :: ReadPrec (Last' a)
$creadPrec :: forall a. Read a => ReadPrec (Last' a)
readList :: ReadS [Last' a]
$creadList :: forall a. Read a => ReadS [Last' a]
readsPrec :: Int -> ReadS (Last' a)
$creadsPrec :: forall a. Read a => Int -> ReadS (Last' a)
Read, Int -> Last' a -> ShowS
[Last' a] -> ShowS
Last' a -> String
(Int -> Last' a -> ShowS)
-> (Last' a -> String) -> ([Last' a] -> ShowS) -> Show (Last' a)
forall a. Show a => Int -> Last' a -> ShowS
forall a. Show a => [Last' a] -> ShowS
forall a. Show a => Last' a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Last' a] -> ShowS
$cshowList :: forall a. Show a => [Last' a] -> ShowS
show :: Last' a -> String
$cshow :: forall a. Show a => Last' a -> String
showsPrec :: Int -> Last' a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Last' a -> ShowS
Show, Get (Last' a)
[Last' a] -> Put
Last' a -> Put
(Last' a -> Put)
-> Get (Last' a) -> ([Last' a] -> Put) -> Binary (Last' a)
forall a. Binary a => Get (Last' a)
forall a. Binary a => [Last' a] -> Put
forall a. Binary a => Last' a -> Put
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
putList :: [Last' a] -> Put
$cputList :: forall a. Binary a => [Last' a] -> Put
get :: Get (Last' a)
$cget :: forall a. Binary a => Get (Last' a)
put :: Last' a -> Put
$cput :: forall a. Binary a => Last' a -> Put
Binary,
                          a -> Last' b -> Last' a
(a -> b) -> Last' a -> Last' b
(forall a b. (a -> b) -> Last' a -> Last' b)
-> (forall a b. a -> Last' b -> Last' a) -> Functor Last'
forall a b. a -> Last' b -> Last' a
forall a b. (a -> b) -> Last' a -> Last' b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Last' b -> Last' a
$c<$ :: forall a b. a -> Last' b -> Last' a
fmap :: (a -> b) -> Last' a -> Last' b
$cfmap :: forall a b. (a -> b) -> Last' a -> Last' b
Functor, Functor Last'
a -> Last' a
Functor Last' =>
(forall a. a -> Last' a)
-> (forall a b. Last' (a -> b) -> Last' a -> Last' b)
-> (forall a b c. (a -> b -> c) -> Last' a -> Last' b -> Last' c)
-> (forall a b. Last' a -> Last' b -> Last' b)
-> (forall a b. Last' a -> Last' b -> Last' a)
-> Applicative Last'
Last' a -> Last' b -> Last' b
Last' a -> Last' b -> Last' a
Last' (a -> b) -> Last' a -> Last' b
(a -> b -> c) -> Last' a -> Last' b -> Last' c
forall a. a -> Last' a
forall a b. Last' a -> Last' b -> Last' a
forall a b. Last' a -> Last' b -> Last' b
forall a b. Last' (a -> b) -> Last' a -> Last' b
forall a b c. (a -> b -> c) -> Last' a -> Last' b -> Last' c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: Last' a -> Last' b -> Last' a
$c<* :: forall a b. Last' a -> Last' b -> Last' a
*> :: Last' a -> Last' b -> Last' b
$c*> :: forall a b. Last' a -> Last' b -> Last' b
liftA2 :: (a -> b -> c) -> Last' a -> Last' b -> Last' c
$cliftA2 :: forall a b c. (a -> b -> c) -> Last' a -> Last' b -> Last' c
<*> :: Last' (a -> b) -> Last' a -> Last' b
$c<*> :: forall a b. Last' (a -> b) -> Last' a -> Last' b
pure :: a -> Last' a
$cpure :: forall a. a -> Last' a
$cp1Applicative :: Functor Last'
App.Applicative, (forall x. Last' a -> Rep (Last' a) x)
-> (forall x. Rep (Last' a) x -> Last' a) -> Generic (Last' a)
forall x. Rep (Last' a) x -> Last' a
forall x. Last' a -> Rep (Last' a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (Last' a) x -> Last' a
forall a x. Last' a -> Rep (Last' a) x
$cto :: forall a x. Rep (Last' a) x -> Last' a
$cfrom :: forall a x. Last' a -> Rep (Last' a) x
Generic)

instance Semigroup (Last' a) where
    x :: Last' a
x <> :: Last' a -> Last' a -> Last' a
<> Last' Nothing = Last' a
x
    _ <> x :: Last' a
x             = Last' a
x

instance Monoid (Last' a) where
    mempty :: Last' a
mempty = Maybe a -> Last' a
forall a. Maybe a -> Last' a
Last' Maybe a
forall a. Maybe a
Nothing
    mappend :: Last' a -> Last' a -> Last' a
mappend = Last' a -> Last' a -> Last' a
forall a. Semigroup a => a -> a -> a
(<>)

-------------------------------------------------------------------------------
-------------------------------------------------------------------------------
-- Stolen from Edward Kmett's BSD3-licensed `semigroups` package

-- | 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 :: a -> a -> a
gmappend x :: a
x y :: 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 Semigroup a => GSemigroup (K1 i a) where
    gmappend' :: K1 i a p -> K1 i a p -> K1 i a p
gmappend' (K1 x :: a
x) (K1 y :: 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 x :: f p
x) (M1 y :: 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' (x1 :: f p
x1 :*: x2 :: g p
x2) (y1 :: f p
y1 :*: y2 :: 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

-- | 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 :: 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 (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'