-- | Instances for some classes from @base@.
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MonoLocalBinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Data.Override.Instances where

import Data.Coerce (Coercible, coerce)
import Data.Function (on)
import GHC.Generics (Generic(Rep, from, to))

import Data.Override.Internal

-- The @foo `on` from'@ idiom is taken from @generic-data@ by Li-yao Xia.
from' :: Generic a => a -> Rep a ()
from' :: a -> Rep a ()
from' = a -> Rep a ()
forall a x. Generic a => a -> Rep a x
from

to' :: Generic a => Rep a () -> a
to' :: Rep a () -> a
to' = Rep a () -> a
forall a x. Generic a => Rep a x -> a
to

-- Eq

instance
  ( Generic (Override a xs)
  , Eq (Rep (Override a xs) ())
  ) => Eq (Override a xs)
  where
  == :: Override a xs -> Override a xs -> Bool
(==) = OverrideRep xs (Rep a) () -> OverrideRep xs (Rep a) () -> Bool
forall a. Eq a => a -> a -> Bool
(==) (OverrideRep xs (Rep a) () -> OverrideRep xs (Rep a) () -> Bool)
-> (Override a xs -> OverrideRep xs (Rep a) ())
-> Override a xs
-> Override a xs
-> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Override a xs -> OverrideRep xs (Rep a) ()
forall a. Generic a => a -> Rep a ()
from'

instance
  ( Coercible a (Using ms a xs)
  , Eq (Using ms a xs)
  ) => Eq (Overridden ms a xs)
  where
  Overridden ms a xs
x == :: Overridden ms a xs -> Overridden ms a xs -> Bool
== Overridden ms a xs
y = Using ms a xs -> Using ms a xs -> Bool
forall a. Eq a => a -> a -> Bool
(==) @(Using ms a xs) (Overridden ms a xs -> Using ms a xs
coerce Overridden ms a xs
x) (Overridden ms a xs -> Using ms a xs
coerce Overridden ms a xs
y)

-- Ord

instance
  ( Generic (Override a xs)
  , Ord (Rep (Override a xs) ())
  ) => Ord (Override a xs)
  where
  compare :: Override a xs -> Override a xs -> Ordering
compare = OverrideRep xs (Rep a) () -> OverrideRep xs (Rep a) () -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (OverrideRep xs (Rep a) ()
 -> OverrideRep xs (Rep a) () -> Ordering)
-> (Override a xs -> OverrideRep xs (Rep a) ())
-> Override a xs
-> Override a xs
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Override a xs -> OverrideRep xs (Rep a) ()
forall a. Generic a => a -> Rep a ()
from'

instance
  ( Coercible a (Using ms a xs)
  , Ord (Using ms a xs)
  ) => Ord (Overridden ms a xs)
  where
  compare :: Overridden ms a xs -> Overridden ms a xs -> Ordering
compare Overridden ms a xs
x Overridden ms a xs
y = Using ms a xs -> Using ms a xs -> Ordering
forall a. Ord a => a -> a -> Ordering
compare @(Using ms a xs) (Overridden ms a xs -> Using ms a xs
coerce Overridden ms a xs
x) (Overridden ms a xs -> Using ms a xs
coerce Overridden ms a xs
y)


-- Semigroup

instance
  ( Generic (Override a xs)
  , Semigroup (Rep (Override a xs) ())
  ) => Semigroup (Override a xs)
  where
  Override a xs
x <> :: Override a xs -> Override a xs -> Override a xs
<> Override a xs
y = Rep (Override a xs) () -> Override a xs
forall a x. Generic a => Rep a x -> a
to (Override a xs -> Rep (Override a xs) ()
forall a. Generic a => a -> Rep a ()
from' Override a xs
x OverrideRep xs (Rep a) ()
-> OverrideRep xs (Rep a) () -> OverrideRep xs (Rep a) ()
forall a. Semigroup a => a -> a -> a
<> Override a xs -> Rep (Override a xs) ()
forall a. Generic a => a -> Rep a ()
from' Override a xs
y)

instance
  ( Coercible a (Using ms a xs)
  , Semigroup (Using ms a xs)
  ) => Semigroup (Overridden ms a xs)
  where
  Overridden ms a xs
x <> :: Overridden ms a xs -> Overridden ms a xs -> Overridden ms a xs
<> Overridden ms a xs
y = Using ms a xs -> Overridden ms a xs
coerce (Using ms a xs -> Overridden ms a xs)
-> Using ms a xs -> Overridden ms a xs
forall a b. (a -> b) -> a -> b
$ Using ms a xs -> Using ms a xs -> Using ms a xs
forall a. Semigroup a => a -> a -> a
(<>) @(Using ms a xs) (Overridden ms a xs -> Using ms a xs
coerce Overridden ms a xs
x) (Overridden ms a xs -> Using ms a xs
coerce Overridden ms a xs
y)

-- Monoid

instance
  ( Generic (Override a xs)
  , Monoid (Rep (Override a xs) ())
  ) => Monoid (Override a xs)
  where
  mempty :: Override a xs
mempty = Rep (Override a xs) () -> Override a xs
forall a. Generic a => Rep a () -> a
to' Rep (Override a xs) ()
forall a. Monoid a => a
mempty
  Override a xs
x mappend :: Override a xs -> Override a xs -> Override a xs
`mappend` Override a xs
y = Rep (Override a xs) () -> Override a xs
forall a x. Generic a => Rep a x -> a
to (Override a xs -> Rep (Override a xs) ()
forall a. Generic a => a -> Rep a ()
from' Override a xs
x OverrideRep xs (Rep a) ()
-> OverrideRep xs (Rep a) () -> OverrideRep xs (Rep a) ()
forall a. Monoid a => a -> a -> a
`mappend` Override a xs -> Rep (Override a xs) ()
forall a. Generic a => a -> Rep a ()
from' Override a xs
y)

instance
  ( Coercible a (Using ms a xs)
  , Monoid (Using ms a xs)
  ) => Monoid (Overridden ms a xs)
  where
  mempty :: Overridden ms a xs
mempty = Using ms a xs -> Overridden ms a xs
coerce (Using ms a xs -> Overridden ms a xs)
-> Using ms a xs -> Overridden ms a xs
forall a b. (a -> b) -> a -> b
$ Monoid (Using ms a xs) => Using ms a xs
forall a. Monoid a => a
mempty @(Using ms a xs)
  Overridden ms a xs
x mappend :: Overridden ms a xs -> Overridden ms a xs -> Overridden ms a xs
`mappend` Overridden ms a xs
y = Using ms a xs -> Overridden ms a xs
coerce (Using ms a xs -> Overridden ms a xs)
-> Using ms a xs -> Overridden ms a xs
forall a b. (a -> b) -> a -> b
$ Using ms a xs -> Using ms a xs -> Using ms a xs
forall a. Monoid a => a -> a -> a
mappend @(Using ms a xs) (Overridden ms a xs -> Using ms a xs
coerce Overridden ms a xs
x) (Overridden ms a xs -> Using ms a xs
coerce Overridden ms a xs
y)