{- |
Combination of @(==)@ and @if then else@
that can be instantiated for more types than @Eq@
or can be instantiated in a way
that allows more defined results (\"more total\" functions):

* Reader like types for representing a context
  like 'Number.ResidueClass.Reader'

* Expressions in an EDSL

* More generally every type based on an applicative functor

* Tuples and Vector types

* Positional and Peano numbers,
  a common prefix of two numbers can be emitted
  before the comparison is done.
  (This could also be done with an overloaded 'if',
   what we also do not have.)
-}
module Algebra.EqualityDecision where

import qualified NumericPrelude.Elementwise as Elem
import Control.Applicative (Applicative(pure, (<*>)), )
import Data.Tuple.HT (fst3, snd3, thd3, )
import Data.List (zipWith4, )


{- |
For atomic types this could be a superclass of 'Eq'.
However for composed types like tuples, lists, functions
we do elementwise comparison
which is incompatible with the complete comparison performed by '(==)'.
-}
class C a where
   {- |
   It holds

   > (a ==? b) eq noteq  ==  if a==b then eq else noteq

   for atomic types where the right hand side can be defined.
   -}
   (==?) :: a -> a -> a -> a -> a



{-# INLINE deflt #-}
deflt :: Eq a => a -> a -> a -> a -> a
deflt :: a -> a -> a -> a -> a
deflt a
a a
b a
eq a
noteq =
   if a
aa -> a -> Bool
forall a. Eq a => a -> a -> Bool
==a
b then a
eq else a
noteq



instance C Int where
   {-# INLINE (==?) #-}
   ==? :: Int -> Int -> Int -> Int -> Int
(==?) = Int -> Int -> Int -> Int -> Int
forall a. Eq a => a -> a -> a -> a -> a
deflt

instance C Integer where
   {-# INLINE (==?) #-}
   ==? :: Integer -> Integer -> Integer -> Integer -> Integer
(==?) = Integer -> Integer -> Integer -> Integer -> Integer
forall a. Eq a => a -> a -> a -> a -> a
deflt

instance C Float where
   {-# INLINE (==?) #-}
   ==? :: Float -> Float -> Float -> Float -> Float
(==?) = Float -> Float -> Float -> Float -> Float
forall a. Eq a => a -> a -> a -> a -> a
deflt

instance C Double where
   {-# INLINE (==?) #-}
   ==? :: Double -> Double -> Double -> Double -> Double
(==?) = Double -> Double -> Double -> Double -> Double
forall a. Eq a => a -> a -> a -> a -> a
deflt

instance C Bool where
   {-# INLINE (==?) #-}
   ==? :: Bool -> Bool -> Bool -> Bool -> Bool
(==?) = Bool -> Bool -> Bool -> Bool -> Bool
forall a. Eq a => a -> a -> a -> a -> a
deflt

instance C Ordering where
   {-# INLINE (==?) #-}
   ==? :: Ordering -> Ordering -> Ordering -> Ordering -> Ordering
(==?) = Ordering -> Ordering -> Ordering -> Ordering -> Ordering
forall a. Eq a => a -> a -> a -> a -> a
deflt



{-# INLINE element #-}
element ::
   (C x) =>
   (v -> x) -> Elem.T (v,v,v,v) x
element :: (v -> x) -> T (v, v, v, v) x
element v -> x
f =
   ((v, v, v, v) -> x) -> T (v, v, v, v) x
forall v a. (v -> a) -> T v a
Elem.element (\(v
x,v
y,v
eq,v
noteq) -> (v -> x
f v
x x -> x -> x -> x -> x
forall a. C a => a -> a -> a -> a -> a
==? v -> x
f v
y) (v -> x
f v
eq) (v -> x
f v
noteq))

{-# INLINE (<*>.==?) #-}
(<*>.==?) ::
   (C x) =>
   Elem.T (v,v,v,v) (x -> a) -> (v -> x) -> Elem.T (v,v,v,v) a
<*>.==? :: T (v, v, v, v) (x -> a) -> (v -> x) -> T (v, v, v, v) a
(<*>.==?) T (v, v, v, v) (x -> a)
f v -> x
acc =
   T (v, v, v, v) (x -> a)
f T (v, v, v, v) (x -> a) -> T (v, v, v, v) x -> T (v, v, v, v) a
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (v -> x) -> T (v, v, v, v) x
forall x v. C x => (v -> x) -> T (v, v, v, v) x
element v -> x
acc


instance (C a, C b) => C (a,b) where
   {-# INLINE (==?) #-}
   ==? :: (a, b) -> (a, b) -> (a, b) -> (a, b) -> (a, b)
(==?) = T ((a, b), (a, b), (a, b), (a, b)) (a, b)
-> (a, b) -> (a, b) -> (a, b) -> (a, b) -> (a, b)
forall x y z w a. T (x, y, z, w) a -> x -> y -> z -> w -> a
Elem.run4 (T ((a, b), (a, b), (a, b), (a, b)) (a, b)
 -> (a, b) -> (a, b) -> (a, b) -> (a, b) -> (a, b))
-> T ((a, b), (a, b), (a, b), (a, b)) (a, b)
-> (a, b)
-> (a, b)
-> (a, b)
-> (a, b)
-> (a, b)
forall a b. (a -> b) -> a -> b
$ (a -> b -> (a, b))
-> T ((a, b), (a, b), (a, b), (a, b)) (a -> b -> (a, b))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (,) T ((a, b), (a, b), (a, b), (a, b)) (a -> b -> (a, b))
-> ((a, b) -> a)
-> T ((a, b), (a, b), (a, b), (a, b)) (b -> (a, b))
forall x v a.
C x =>
T (v, v, v, v) (x -> a) -> (v -> x) -> T (v, v, v, v) a
<*>.==?  (a, b) -> a
forall a b. (a, b) -> a
fst T ((a, b), (a, b), (a, b), (a, b)) (b -> (a, b))
-> ((a, b) -> b) -> T ((a, b), (a, b), (a, b), (a, b)) (a, b)
forall x v a.
C x =>
T (v, v, v, v) (x -> a) -> (v -> x) -> T (v, v, v, v) a
<*>.==?  (a, b) -> b
forall a b. (a, b) -> b
snd

instance (C a, C b, C c) => C (a,b,c) where
   {-# INLINE (==?) #-}
   ==? :: (a, b, c) -> (a, b, c) -> (a, b, c) -> (a, b, c) -> (a, b, c)
(==?) = T ((a, b, c), (a, b, c), (a, b, c), (a, b, c)) (a, b, c)
-> (a, b, c) -> (a, b, c) -> (a, b, c) -> (a, b, c) -> (a, b, c)
forall x y z w a. T (x, y, z, w) a -> x -> y -> z -> w -> a
Elem.run4 (T ((a, b, c), (a, b, c), (a, b, c), (a, b, c)) (a, b, c)
 -> (a, b, c) -> (a, b, c) -> (a, b, c) -> (a, b, c) -> (a, b, c))
-> T ((a, b, c), (a, b, c), (a, b, c), (a, b, c)) (a, b, c)
-> (a, b, c)
-> (a, b, c)
-> (a, b, c)
-> (a, b, c)
-> (a, b, c)
forall a b. (a -> b) -> a -> b
$ (a -> b -> c -> (a, b, c))
-> T ((a, b, c), (a, b, c), (a, b, c), (a, b, c))
     (a -> b -> c -> (a, b, c))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (,,) T ((a, b, c), (a, b, c), (a, b, c), (a, b, c))
  (a -> b -> c -> (a, b, c))
-> ((a, b, c) -> a)
-> T ((a, b, c), (a, b, c), (a, b, c), (a, b, c))
     (b -> c -> (a, b, c))
forall x v a.
C x =>
T (v, v, v, v) (x -> a) -> (v -> x) -> T (v, v, v, v) a
<*>.==?  (a, b, c) -> a
forall a b c. (a, b, c) -> a
fst3 T ((a, b, c), (a, b, c), (a, b, c), (a, b, c))
  (b -> c -> (a, b, c))
-> ((a, b, c) -> b)
-> T ((a, b, c), (a, b, c), (a, b, c), (a, b, c)) (c -> (a, b, c))
forall x v a.
C x =>
T (v, v, v, v) (x -> a) -> (v -> x) -> T (v, v, v, v) a
<*>.==?  (a, b, c) -> b
forall a b c. (a, b, c) -> b
snd3 T ((a, b, c), (a, b, c), (a, b, c), (a, b, c)) (c -> (a, b, c))
-> ((a, b, c) -> c)
-> T ((a, b, c), (a, b, c), (a, b, c), (a, b, c)) (a, b, c)
forall x v a.
C x =>
T (v, v, v, v) (x -> a) -> (v -> x) -> T (v, v, v, v) a
<*>.==?  (a, b, c) -> c
forall a b c. (a, b, c) -> c
thd3

instance C a => C [a] where
   {-# INLINE (==?) #-}
   ==? :: [a] -> [a] -> [a] -> [a] -> [a]
(==?) = (a -> a -> a -> a -> a) -> [a] -> [a] -> [a] -> [a] -> [a]
forall a b c d e.
(a -> b -> c -> d -> e) -> [a] -> [b] -> [c] -> [d] -> [e]
zipWith4 a -> a -> a -> a -> a
forall a. C a => a -> a -> a -> a -> a
(==?)

instance (C a) => C (b -> a) where
   {-# INLINE (==?) #-}
   ==? :: (b -> a) -> (b -> a) -> (b -> a) -> (b -> a) -> b -> a
(==?) b -> a
x b -> a
y b -> a
eq b -> a
noteq b
c  =  (b -> a
x b
c a -> a -> a -> a -> a
forall a. C a => a -> a -> a -> a -> a
==? b -> a
y b
c) (b -> a
eq b
c) (b -> a
noteq b
c)