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

-- | Compatibility layer for "Data.Semigroup"
module Distribution.Compat.Semigroup
  ( Semigroup ((<>))
  , Mon.Monoid (..)
  , All (..)
  , Any (..)
  , First' (..)
  , Last' (..)
  , Option' (..)
  , gmappend
  , gmempty
  ) where

import Data.Typeable (Typeable)
import Distribution.Compat.Binary (Binary)
import Distribution.Utils.Structured (Structured)

import GHC.Generics

-- Data.Semigroup is available since GHC 8.0/base-4.9 in `base`
-- for older GHC/base, it's provided by `semigroups`

import qualified Data.Monoid as Mon
import Data.Semigroup

-- | A copy of 'Data.Semigroup.First'.
newtype First' a = First' {forall a. First' a -> a
getFirst' :: a}
  deriving (First' a -> First' a -> Bool
(First' a -> First' a -> Bool)
-> (First' a -> First' a -> Bool) -> Eq (First' a)
forall a. Eq a => First' a -> First' a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => First' a -> First' a -> Bool
== :: First' a -> First' a -> Bool
$c/= :: forall a. Eq a => First' a -> First' a -> Bool
/= :: First' a -> First' a -> Bool
Eq, Eq (First' a)
Eq (First' a) =>
(First' a -> First' a -> Ordering)
-> (First' a -> First' a -> Bool)
-> (First' a -> First' a -> Bool)
-> (First' a -> First' a -> Bool)
-> (First' a -> First' a -> Bool)
-> (First' a -> First' a -> First' a)
-> (First' a -> First' a -> First' a)
-> Ord (First' a)
First' a -> First' a -> Bool
First' a -> First' a -> Ordering
First' a -> First' a -> First' 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 (First' a)
forall a. Ord a => First' a -> First' a -> Bool
forall a. Ord a => First' a -> First' a -> Ordering
forall a. Ord a => First' a -> First' a -> First' a
$ccompare :: forall a. Ord a => First' a -> First' a -> Ordering
compare :: First' a -> First' a -> Ordering
$c< :: forall a. Ord a => First' a -> First' a -> Bool
< :: First' a -> First' a -> Bool
$c<= :: forall a. Ord a => First' a -> First' a -> Bool
<= :: First' a -> First' a -> Bool
$c> :: forall a. Ord a => First' a -> First' a -> Bool
> :: First' a -> First' a -> Bool
$c>= :: forall a. Ord a => First' a -> First' a -> Bool
>= :: First' a -> First' a -> Bool
$cmax :: forall a. Ord a => First' a -> First' a -> First' a
max :: First' a -> First' a -> First' a
$cmin :: forall a. Ord a => First' a -> First' a -> First' a
min :: First' a -> First' a -> First' a
Ord, Int -> First' a -> ShowS
[First' a] -> ShowS
First' a -> String
(Int -> First' a -> ShowS)
-> (First' a -> String) -> ([First' a] -> ShowS) -> Show (First' a)
forall a. Show a => Int -> First' a -> ShowS
forall a. Show a => [First' a] -> ShowS
forall a. Show a => First' a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> First' a -> ShowS
showsPrec :: Int -> First' a -> ShowS
$cshow :: forall a. Show a => First' a -> String
show :: First' a -> String
$cshowList :: forall a. Show a => [First' a] -> ShowS
showList :: [First' a] -> ShowS
Show)

instance Semigroup (First' a) where
  First' a
a <> :: First' a -> First' a -> First' a
<> First' a
_ = First' a
a

-- | A copy of 'Data.Semigroup.Last'.
newtype Last' a = Last' {forall a. Last' a -> a
getLast' :: 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
$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
/= :: 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
$ccompare :: forall a. Ord a => Last' a -> Last' a -> Ordering
compare :: Last' a -> Last' a -> Ordering
$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
>= :: Last' a -> Last' a -> Bool
$cmax :: forall a. Ord a => Last' a -> Last' a -> Last' a
max :: Last' a -> Last' a -> Last' a
$cmin :: forall a. Ord a => Last' a -> Last' a -> Last' a
min :: Last' a -> Last' a -> 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
$creadsPrec :: forall a. Read a => Int -> ReadS (Last' a)
readsPrec :: Int -> ReadS (Last' a)
$creadList :: forall a. Read a => ReadS [Last' a]
readList :: ReadS [Last' a]
$creadPrec :: forall a. Read a => ReadPrec (Last' a)
readPrec :: ReadPrec (Last' a)
$creadListPrec :: forall a. Read a => ReadPrec [Last' a]
readListPrec :: ReadPrec [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
$cshowsPrec :: forall a. Show a => Int -> Last' a -> ShowS
showsPrec :: Int -> Last' a -> ShowS
$cshow :: forall a. Show a => Last' a -> String
show :: Last' a -> String
$cshowList :: forall a. Show a => [Last' a] -> ShowS
showList :: [Last' a] -> ShowS
Show, (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
$cfrom :: forall a x. Last' a -> Rep (Last' a) x
from :: forall x. Last' a -> Rep (Last' a) x
$cto :: forall a x. Rep (Last' a) x -> Last' a
to :: forall x. Rep (Last' a) x -> Last' a
Generic, 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
$cput :: forall a. Binary a => Last' a -> Put
put :: Last' a -> Put
$cget :: forall a. Binary a => Get (Last' a)
get :: Get (Last' a)
$cputList :: forall a. Binary a => [Last' a] -> Put
putList :: [Last' a] -> Put
Binary, Typeable)

instance Structured a => Structured (Last' a)

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

instance Functor Last' where
  fmap :: forall a b. (a -> b) -> Last' a -> Last' b
fmap a -> b
f (Last' a
x) = b -> Last' b
forall a. a -> Last' a
Last' (a -> b
f a
x)

-- | A wrapper around 'Maybe', providing the 'Semigroup' and 'Monoid' instances
-- implemented for 'Maybe' since @base-4.11@.
newtype Option' a = Option' {forall a. Option' a -> Maybe a
getOption' :: Maybe a}
  deriving (Option' a -> Option' a -> Bool
(Option' a -> Option' a -> Bool)
-> (Option' a -> Option' a -> Bool) -> Eq (Option' a)
forall a. Eq a => Option' a -> Option' a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => Option' a -> Option' a -> Bool
== :: Option' a -> Option' a -> Bool
$c/= :: forall a. Eq a => Option' a -> Option' a -> Bool
/= :: Option' a -> Option' a -> Bool
Eq, Eq (Option' a)
Eq (Option' a) =>
(Option' a -> Option' a -> Ordering)
-> (Option' a -> Option' a -> Bool)
-> (Option' a -> Option' a -> Bool)
-> (Option' a -> Option' a -> Bool)
-> (Option' a -> Option' a -> Bool)
-> (Option' a -> Option' a -> Option' a)
-> (Option' a -> Option' a -> Option' a)
-> Ord (Option' a)
Option' a -> Option' a -> Bool
Option' a -> Option' a -> Ordering
Option' a -> Option' a -> Option' 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 (Option' a)
forall a. Ord a => Option' a -> Option' a -> Bool
forall a. Ord a => Option' a -> Option' a -> Ordering
forall a. Ord a => Option' a -> Option' a -> Option' a
$ccompare :: forall a. Ord a => Option' a -> Option' a -> Ordering
compare :: Option' a -> Option' a -> Ordering
$c< :: forall a. Ord a => Option' a -> Option' a -> Bool
< :: Option' a -> Option' a -> Bool
$c<= :: forall a. Ord a => Option' a -> Option' a -> Bool
<= :: Option' a -> Option' a -> Bool
$c> :: forall a. Ord a => Option' a -> Option' a -> Bool
> :: Option' a -> Option' a -> Bool
$c>= :: forall a. Ord a => Option' a -> Option' a -> Bool
>= :: Option' a -> Option' a -> Bool
$cmax :: forall a. Ord a => Option' a -> Option' a -> Option' a
max :: Option' a -> Option' a -> Option' a
$cmin :: forall a. Ord a => Option' a -> Option' a -> Option' a
min :: Option' a -> Option' a -> Option' a
Ord, ReadPrec [Option' a]
ReadPrec (Option' a)
Int -> ReadS (Option' a)
ReadS [Option' a]
(Int -> ReadS (Option' a))
-> ReadS [Option' a]
-> ReadPrec (Option' a)
-> ReadPrec [Option' a]
-> Read (Option' a)
forall a. Read a => ReadPrec [Option' a]
forall a. Read a => ReadPrec (Option' a)
forall a. Read a => Int -> ReadS (Option' a)
forall a. Read a => ReadS [Option' a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: forall a. Read a => Int -> ReadS (Option' a)
readsPrec :: Int -> ReadS (Option' a)
$creadList :: forall a. Read a => ReadS [Option' a]
readList :: ReadS [Option' a]
$creadPrec :: forall a. Read a => ReadPrec (Option' a)
readPrec :: ReadPrec (Option' a)
$creadListPrec :: forall a. Read a => ReadPrec [Option' a]
readListPrec :: ReadPrec [Option' a]
Read, Int -> Option' a -> ShowS
[Option' a] -> ShowS
Option' a -> String
(Int -> Option' a -> ShowS)
-> (Option' a -> String)
-> ([Option' a] -> ShowS)
-> Show (Option' a)
forall a. Show a => Int -> Option' a -> ShowS
forall a. Show a => [Option' a] -> ShowS
forall a. Show a => Option' a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> Option' a -> ShowS
showsPrec :: Int -> Option' a -> ShowS
$cshow :: forall a. Show a => Option' a -> String
show :: Option' a -> String
$cshowList :: forall a. Show a => [Option' a] -> ShowS
showList :: [Option' a] -> ShowS
Show, Get (Option' a)
[Option' a] -> Put
Option' a -> Put
(Option' a -> Put)
-> Get (Option' a) -> ([Option' a] -> Put) -> Binary (Option' a)
forall a. Binary a => Get (Option' a)
forall a. Binary a => [Option' a] -> Put
forall a. Binary a => Option' a -> Put
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
$cput :: forall a. Binary a => Option' a -> Put
put :: Option' a -> Put
$cget :: forall a. Binary a => Get (Option' a)
get :: Get (Option' a)
$cputList :: forall a. Binary a => [Option' a] -> Put
putList :: [Option' a] -> Put
Binary, (forall x. Option' a -> Rep (Option' a) x)
-> (forall x. Rep (Option' a) x -> Option' a)
-> Generic (Option' a)
forall x. Rep (Option' a) x -> Option' a
forall x. Option' a -> Rep (Option' a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (Option' a) x -> Option' a
forall a x. Option' a -> Rep (Option' a) x
$cfrom :: forall a x. Option' a -> Rep (Option' a) x
from :: forall x. Option' a -> Rep (Option' a) x
$cto :: forall a x. Rep (Option' a) x -> Option' a
to :: forall x. Rep (Option' a) x -> Option' a
Generic, (forall a b. (a -> b) -> Option' a -> Option' b)
-> (forall a b. a -> Option' b -> Option' a) -> Functor Option'
forall a b. a -> Option' b -> Option' a
forall a b. (a -> b) -> Option' a -> Option' b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Option' a -> Option' b
fmap :: forall a b. (a -> b) -> Option' a -> Option' b
$c<$ :: forall a b. a -> Option' b -> Option' a
<$ :: forall a b. a -> Option' b -> Option' a
Functor, Typeable)

instance Structured a => Structured (Option' a)

instance Semigroup a => Semigroup (Option' a) where
  Option' (Just a
a) <> :: Option' a -> Option' a -> Option' a
<> Option' (Just a
b) = Maybe a -> Option' a
forall a. Maybe a -> Option' a
Option' (a -> Maybe a
forall a. a -> Maybe a
Just (a
a a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
b))
  Option' Maybe a
Nothing <> Option' a
b = Option' a
b
  Option' a
a <> Option' Maybe a
Nothing = Option' a
a

instance Semigroup a => Monoid (Option' a) where
  mempty :: Option' a
mempty = Maybe a -> Option' a
forall a. Maybe a -> Option' a
Option' Maybe a
forall a. Maybe a
Nothing
  mappend :: Option' a -> Option' a -> Option' a
mappend = Option' a -> Option' a -> Option' 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 :: forall a. (Generic a, GSemigroup (Rep a)) => a -> a -> a
gmappend a
x a
y = Rep a Any -> a
forall a x. Generic a => Rep a x -> a
forall x. Rep a x -> a
to (Rep a Any -> Rep a Any -> Rep a Any
forall p. Rep a p -> Rep a p -> Rep a p
forall (f :: * -> *) p. GSemigroup f => f p -> f p -> f p
gmappend' (a -> Rep a Any
forall x. a -> Rep a x
forall a x. Generic a => a -> Rep a x
from a
x) (a -> Rep a Any
forall x. a -> Rep a x
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' :: forall p. K1 i a p -> K1 i a p -> K1 i a p
gmappend' (K1 a
x) (K1 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' :: forall p. M1 i c f p -> M1 i c f p -> M1 i c f p
gmappend' (M1 f p
x) (M1 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 p. 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' :: forall p. (:*:) f g p -> (:*:) f g p -> (:*:) f g p
gmappend' (f p
x1 :*: g p
x2) (f p
y1 :*: g p
y2) = f p -> f p -> f p
forall p. 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 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 :: forall a. (Generic a, GMonoid (Rep a)) => a
gmempty = Rep a Any -> a
forall a x. Generic a => Rep a x -> a
forall x. Rep a x -> a
to Rep a Any
forall p. Rep a p
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' :: forall p. 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' :: forall p. 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 p. f p
forall (f :: * -> *) p. GMonoid f => f p
gmempty'

instance (GMonoid f, GMonoid g) => GMonoid (f :*: g) where
  gmempty' :: forall p. (:*:) f g p
gmempty' = f p
forall p. 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 p. g p
forall (f :: * -> *) p. GMonoid f => f p
gmempty'