{-# OPTIONS_GHC -Wno-partial-type-signatures #-}
{-# LANGUAGE PartialTypeSignatures #-}
{-# LANGUAGE TemplateHaskell #-}
{-|
    Module      :  Numeric.MixedType.Eq
    Description :  Bottom-up typed equality comparisons
    Copyright   :  (c) Michal Konecny
    License     :  BSD3

    Maintainer  :  mikkonecny@gmail.com
    Stability   :  experimental
    Portability :  portable
-}

module Numeric.MixedTypes.Eq
(
  -- * Equality checks
  HasEq,  HasEqAsymmetric(..), (==), (/=)
  , HasEqCertainly, HasEqCertainlyAsymmetric
  , notCertainlyDifferentFrom, certainlyEqualTo, certainlyNotEqualTo
  , (?==?), (!==!), (!/=!)
  -- ** Tests
  , specHasEq, specHasEqNotMixed
  , specConversion
  -- ** Specific comparisons
  , CanTestValid(..), specResultIsValid1, specResultIsValid2, specResultIsValid1Pre, specResultIsValid2Pre
  , CanTestNaN(..)
  , CanTestFinite(..)
  , CanTestInteger(..)
  , CanTestZero(..), specCanTestZero
  , CanPickNonZero(..), specCanPickNonZero
)
where

import Utils.TH.DeclForTypes

import Numeric.MixedTypes.PreludeHiding
import qualified Prelude as P
import Text.Printf
import Data.Ratio

import Test.Hspec
import Test.QuickCheck as QC

import Control.CollectErrors ( CollectErrors, CanBeErrors )
import qualified Control.CollectErrors as CE

import Numeric.MixedTypes.Literals
import Numeric.MixedTypes.Bool

infix  4  ==, /=
infix 4 ?==?
infix 4 !==!, !/=!

{---- Equality tests -----}

type HasEq t1 t2 =
    (HasEqAsymmetric t1 t2,  HasEqAsymmetric t2 t1,
     EqCompareType t1 t2 ~ EqCompareType t2 t1)

type HasEqCertainlyAsymmetric t1 t2 =
    (HasEqAsymmetric t1 t2, CanTestCertainly (EqCompareType t1 t2))

type HasEqCertainly t1 t2 =
  (HasEq t1 t2, CanTestCertainly (EqCompareType t1 t2))

class (IsBool (EqCompareType a b)) => HasEqAsymmetric a b where
    type EqCompareType a b
    type EqCompareType a b = Bool -- default
    equalTo :: a -> b -> (EqCompareType a b)
    -- default equalToA via Prelude for (->) and Bool:
    default equalTo :: (EqCompareType a b ~ Bool, a~b, P.Eq a) => a -> b -> EqCompareType a b
    equalTo = forall a. Eq a => a -> a -> Bool
(P.==)
    notEqualTo :: a -> b -> (EqCompareType a b)
    -- default notEqualToA via equalToA for Bool:
    default notEqualTo ::
        (CanNegSameType (EqCompareType a b)) =>
        a -> b -> (EqCompareType a b)
    notEqualTo a
a b
b = forall t. CanNeg t => t -> NegType t
not forall a b. (a -> b) -> a -> b
$ forall a b. HasEqAsymmetric a b => a -> b -> EqCompareType a b
equalTo a
a b
b

(==) :: (HasEqAsymmetric a b) => a -> b -> EqCompareType a b
== :: forall a b. HasEqAsymmetric a b => a -> b -> EqCompareType a b
(==) = forall a b. HasEqAsymmetric a b => a -> b -> EqCompareType a b
equalTo
(/=) :: (HasEqAsymmetric a b) => a -> b -> EqCompareType a b
/= :: forall a b. HasEqAsymmetric a b => a -> b -> EqCompareType a b
(/=) = forall a b. HasEqAsymmetric a b => a -> b -> EqCompareType a b
notEqualTo

certainlyEqualTo :: (HasEqCertainlyAsymmetric a b) => a -> b -> Bool
certainlyEqualTo :: forall a b. HasEqCertainlyAsymmetric a b => a -> b -> Bool
certainlyEqualTo a
a b
b = forall t. CanTestCertainly t => t -> Bool
isCertainlyTrue forall a b. (a -> b) -> a -> b
$ a
a forall a b. HasEqAsymmetric a b => a -> b -> EqCompareType a b
== b
b
certainlyNotEqualTo :: (HasEqCertainlyAsymmetric a b) => a -> b -> Bool
certainlyNotEqualTo :: forall a b. HasEqCertainlyAsymmetric a b => a -> b -> Bool
certainlyNotEqualTo a
a b
b = forall t. CanTestCertainly t => t -> Bool
isCertainlyTrue forall a b. (a -> b) -> a -> b
$ a
a forall a b. HasEqAsymmetric a b => a -> b -> EqCompareType a b
/= b
b
notCertainlyDifferentFrom :: (HasEqCertainlyAsymmetric a b) => a -> b -> Bool
notCertainlyDifferentFrom :: forall a b. HasEqCertainlyAsymmetric a b => a -> b -> Bool
notCertainlyDifferentFrom a
a b
b = forall t. CanTestCertainly t => t -> Bool
isNotFalse forall a b. (a -> b) -> a -> b
$ a
a forall a b. HasEqAsymmetric a b => a -> b -> EqCompareType a b
== b
b

(?==?) :: (HasEqCertainlyAsymmetric a b) => a -> b -> Bool
?==? :: forall a b. HasEqCertainlyAsymmetric a b => a -> b -> Bool
(?==?) = forall a b. HasEqCertainlyAsymmetric a b => a -> b -> Bool
notCertainlyDifferentFrom

(!==!) :: (HasEqCertainlyAsymmetric a b) => a -> b -> Bool
!==! :: forall a b. HasEqCertainlyAsymmetric a b => a -> b -> Bool
(!==!) = forall a b. HasEqCertainlyAsymmetric a b => a -> b -> Bool
certainlyEqualTo

(!/=!) :: (HasEqCertainlyAsymmetric a b) => a -> b -> Bool
!/=! :: forall a b. HasEqCertainlyAsymmetric a b => a -> b -> Bool
(!/=!) = forall a b. HasEqCertainlyAsymmetric a b => a -> b -> Bool
certainlyNotEqualTo

{-|
  HSpec properties that each implementation of HasEq should satisfy.
 -}
specHasEq :: 
  _ => T t1 -> T t2 -> T t3 -> Spec
specHasEq :: T t1 -> T t2 -> T t3 -> Spec
specHasEq (T String
typeName1 :: T t1) (T String
typeName2 :: T t2) (T String
typeName3 :: T t3) =
  forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe (forall r. PrintfType r => String -> r
printf String
"HasEq %s %s, HasEq %s %s" String
typeName1 String
typeName2 String
typeName2 String
typeName3) forall a b. (a -> b) -> a -> b
$ do
    forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"has reflexive ==" forall a b. (a -> b) -> a -> b
$ do
      forall prop. Testable prop => prop -> Property
property forall a b. (a -> b) -> a -> b
$ \ (t1
x :: t1) -> forall t. CanNeg t => t -> NegType t
not forall a b. (a -> b) -> a -> b
$ forall t. CanTestCertainly t => t -> Bool
isCertainlyFalse (t1
x forall a b. HasEqAsymmetric a b => a -> b -> EqCompareType a b
== t1
x)
    forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"has anti-reflexive /=" forall a b. (a -> b) -> a -> b
$ do
      forall prop. Testable prop => prop -> Property
property forall a b. (a -> b) -> a -> b
$ \ (t1
x :: t1) -> forall t. CanNeg t => t -> NegType t
not forall a b. (a -> b) -> a -> b
$ forall t. CanTestCertainly t => t -> Bool
isCertainlyTrue (t1
x forall a b. HasEqAsymmetric a b => a -> b -> EqCompareType a b
/= t1
x)
    forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"has stronly commutative ==" forall a b. (a -> b) -> a -> b
$ do
      forall prop. Testable prop => prop -> Property
property forall a b. (a -> b) -> a -> b
$ \ (t1
x :: t1) (t2
y :: t2) -> (t1
x forall a b. HasEqAsymmetric a b => a -> b -> EqCompareType a b
== t2
y) forall t1 t2.
(CanTestCertainly t1, CanTestCertainly t2) =>
t1 -> t2 -> Bool
`stronglyEquivalentTo` (t2
y forall a b. HasEqAsymmetric a b => a -> b -> EqCompareType a b
== t1
x)
    forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"has stronly commutative /=" forall a b. (a -> b) -> a -> b
$ do
      forall prop. Testable prop => prop -> Property
property forall a b. (a -> b) -> a -> b
$ \ (t1
x :: t1) (t2
y :: t2) -> (t1
x forall a b. HasEqAsymmetric a b => a -> b -> EqCompareType a b
/= t2
y) forall t1 t2.
(CanTestCertainly t1, CanTestCertainly t2) =>
t1 -> t2 -> Bool
`stronglyEquivalentTo` (t2
y forall a b. HasEqAsymmetric a b => a -> b -> EqCompareType a b
/= t1
x)
    forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"has stronly transitive ==" forall a b. (a -> b) -> a -> b
$ do
      forall prop. Testable prop => prop -> Property
property forall a b. (a -> b) -> a -> b
$ \ (t1
x :: t1) (t2
y :: t2) (t3
z :: t3) -> ((t1
x forall a b. HasEqAsymmetric a b => a -> b -> EqCompareType a b
== t2
y) forall a b. CanAndOrAsymmetric a b => a -> b -> AndOrType a b
&& (t2
y forall a b. HasEqAsymmetric a b => a -> b -> EqCompareType a b
== t3
z)) forall t1 t2.
(CanTestCertainly t1, CanTestCertainly t2) =>
t1 -> t2 -> Bool
`stronglyImplies` (t2
y forall a b. HasEqAsymmetric a b => a -> b -> EqCompareType a b
== t3
z)

{-|
  HSpec properties that each implementation of HasEq should satisfy.
 -}
specHasEqNotMixed ::
  _ => T t -> Spec
specHasEqNotMixed :: T t -> Spec
specHasEqNotMixed (T t
t :: T t) = forall t1 t2 t3.
(Arbitrary t1, Arbitrary t2, Arbitrary t3, Show t1, Show t2,
 Show t3,
 CanTestCertainly
   (AndOrType (EqCompareType t1 t2) (EqCompareType t2 t3)),
 CanTestCertainly (EqCompareType t1 t1),
 CanTestCertainly (EqCompareType t1 t2),
 CanTestCertainly (EqCompareType t2 t1),
 CanTestCertainly (EqCompareType t2 t3), HasEqAsymmetric t1 t1,
 HasEqAsymmetric t1 t2, HasEqAsymmetric t2 t1,
 HasEqAsymmetric t2 t3,
 CanAndOrAsymmetric (EqCompareType t1 t2) (EqCompareType t2 t3)) =>
T t1 -> T t2 -> T t3 -> Spec
specHasEq T t
t T t
t T t
t

{-|
  HSpec property of there-and-back conversion.
-}
specConversion :: -- this definition cannot be in Literals because it needs HasEq
  (Arbitrary t1, Show t1, HasEqCertainly t1 t1) =>
  T t1 -> T t2 -> (t1 -> t2) -> (t2 -> t1) ->  Spec
specConversion :: forall t1 t2.
(Arbitrary t1, Show t1, HasEqCertainly t1 t1) =>
T t1 -> T t2 -> (t1 -> t2) -> (t2 -> t1) -> Spec
specConversion (T String
typeName1 :: T t1) (T String
typeName2 :: T t2) t1 -> t2
conv12 t2 -> t1
conv21 =
  forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"conversion" forall a b. (a -> b) -> a -> b
$ do
    forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it (forall r. PrintfType r => String -> r
printf String
"%s -> %s -> %s" String
typeName1 String
typeName2 String
typeName1) forall a b. (a -> b) -> a -> b
$ do
      forall prop. Testable prop => prop -> Property
property forall a b. (a -> b) -> a -> b
$ \ (t1
x1 :: t1) ->
        t1
x1 forall a b. HasEqCertainlyAsymmetric a b => a -> b -> Bool
?==? (t2 -> t1
conv21 forall a b. (a -> b) -> a -> b
$ t1 -> t2
conv12 t1
x1)

instance HasEqAsymmetric () ()
instance HasEqAsymmetric Bool Bool
instance HasEqAsymmetric Char Char

instance HasEqAsymmetric Int Int
instance HasEqAsymmetric Integer Integer
instance HasEqAsymmetric Rational Rational
instance HasEqAsymmetric Double Double

instance HasEqAsymmetric Int Integer where
  equalTo :: Int -> Integer -> EqCompareType Int Integer
equalTo = forall a b c.
ConvertibleExactly a b =>
(b -> b -> c) -> a -> b -> c
convertFirst forall a b. HasEqAsymmetric a b => a -> b -> EqCompareType a b
equalTo
instance HasEqAsymmetric Integer Int where
  equalTo :: Integer -> Int -> EqCompareType Integer Int
equalTo = forall b a c.
ConvertibleExactly b a =>
(a -> a -> c) -> a -> b -> c
convertSecond forall a b. HasEqAsymmetric a b => a -> b -> EqCompareType a b
equalTo

instance HasEqAsymmetric Int Rational where
  equalTo :: Int -> Rational -> EqCompareType Int Rational
equalTo = forall a b c.
ConvertibleExactly a b =>
(b -> b -> c) -> a -> b -> c
convertFirst forall a b. HasEqAsymmetric a b => a -> b -> EqCompareType a b
equalTo
instance HasEqAsymmetric Rational Int where
  equalTo :: Rational -> Int -> EqCompareType Rational Int
equalTo = forall b a c.
ConvertibleExactly b a =>
(a -> a -> c) -> a -> b -> c
convertSecond forall a b. HasEqAsymmetric a b => a -> b -> EqCompareType a b
equalTo

instance HasEqAsymmetric Integer Rational where
  equalTo :: Integer -> Rational -> EqCompareType Integer Rational
equalTo = forall a b c.
ConvertibleExactly a b =>
(b -> b -> c) -> a -> b -> c
convertFirst forall a b. HasEqAsymmetric a b => a -> b -> EqCompareType a b
equalTo
instance HasEqAsymmetric Rational Integer where
  equalTo :: Rational -> Integer -> EqCompareType Rational Integer
equalTo = forall b a c.
ConvertibleExactly b a =>
(a -> a -> c) -> a -> b -> c
convertSecond forall a b. HasEqAsymmetric a b => a -> b -> EqCompareType a b
equalTo

instance HasEqAsymmetric Integer Double where
  equalTo :: Integer -> Double -> EqCompareType Integer Double
equalTo Integer
n Double
d = ((forall a b. (RealFrac a, Integral b) => a -> b
P.floor Double
d :: Integer) forall a b. HasEqAsymmetric a b => a -> b -> EqCompareType a b
== Integer
n) forall a b. CanAndOrAsymmetric a b => a -> b -> AndOrType a b
&& (Integer
n forall a b. HasEqAsymmetric a b => a -> b -> EqCompareType a b
== (forall a b. (RealFrac a, Integral b) => a -> b
P.ceiling Double
d :: Integer))
instance HasEqAsymmetric Double Integer where
  equalTo :: Double -> Integer -> EqCompareType Double Integer
equalTo Double
d Integer
n = ((forall a b. (RealFrac a, Integral b) => a -> b
P.floor Double
d :: Integer) forall a b. HasEqAsymmetric a b => a -> b -> EqCompareType a b
== Integer
n) forall a b. CanAndOrAsymmetric a b => a -> b -> AndOrType a b
&& (Integer
n forall a b. HasEqAsymmetric a b => a -> b -> EqCompareType a b
== (forall a b. (RealFrac a, Integral b) => a -> b
P.ceiling Double
d :: Integer))

instance HasEqAsymmetric Int Double where
  equalTo :: Int -> Double -> EqCompareType Int Double
equalTo Int
n Double
d = forall a b. HasEqAsymmetric a b => a -> b -> EqCompareType a b
equalTo (forall t. CanBeInteger t => t -> Integer
integer Int
n) Double
d
instance HasEqAsymmetric Double Int where
  equalTo :: Double -> Int -> EqCompareType Double Int
equalTo Double
d Int
n = forall a b. HasEqAsymmetric a b => a -> b -> EqCompareType a b
equalTo (forall t. CanBeInteger t => t -> Integer
integer Int
n) Double
d

instance
  (HasEqAsymmetric a1 b1,
   HasEqAsymmetric a2 b2,
   CanAndOrAsymmetric (EqCompareType a1 b1) (EqCompareType a2 b2),
   IsBool (AndOrType (EqCompareType a1 b1) (EqCompareType a2 b2))
  ) =>
  HasEqAsymmetric (a1,a2) (b1,b2) where
  type EqCompareType (a1,a2) (b1,b2) =
    AndOrType (EqCompareType a1 b1) (EqCompareType a2 b2)
  equalTo :: (a1, a2) -> (b1, b2) -> EqCompareType (a1, a2) (b1, b2)
equalTo (a1
a1,a2
a2) (b1
b1,b2
b2) =
    (a1
a1 forall a b. HasEqAsymmetric a b => a -> b -> EqCompareType a b
== b1
b1) forall a b. CanAndOrAsymmetric a b => a -> b -> AndOrType a b
&& (a2
a2 forall a b. HasEqAsymmetric a b => a -> b -> EqCompareType a b
== b2
b2)

instance
  (HasEqAsymmetric ((a1,a2), a3) ((b1,b2), b3))
  =>
  HasEqAsymmetric (a1,a2,a3) (b1,b2,b3) where
  type EqCompareType (a1,a2,a3) (b1,b2,b3) =
    EqCompareType ((a1,a2), a3) ((b1,b2), b3)
  equalTo :: (a1, a2, a3)
-> (b1, b2, b3) -> EqCompareType (a1, a2, a3) (b1, b2, b3)
equalTo (a1
a1,a2
a2,a3
a3) (b1
b1,b2
b2,b3
b3) =
    ((a1
a1,a2
a2), a3
a3) forall a b. HasEqAsymmetric a b => a -> b -> EqCompareType a b
== ((b1
b1,b2
b2), b3
b3)

instance
  (HasEqAsymmetric ((a1,a2,a3), a4) ((b1,b2,b3), b4))
  =>
  HasEqAsymmetric (a1,a2,a3,a4) (b1,b2,b3,b4) where
  type EqCompareType (a1,a2,a3,a4) (b1,b2,b3,b4) =
    EqCompareType ((a1,a2,a3), a4) ((b1,b2,b3), b4)
  equalTo :: (a1, a2, a3, a4)
-> (b1, b2, b3, b4)
-> EqCompareType (a1, a2, a3, a4) (b1, b2, b3, b4)
equalTo (a1
a1,a2
a2,a3
a3,a4
a4) (b1
b1,b2
b2,b3
b3,b4
b4) =
    ((a1
a1,a2
a2,a3
a3), a4
a4) forall a b. HasEqAsymmetric a b => a -> b -> EqCompareType a b
== ((b1
b1,b2
b2,b3
b3), b4
b4)

instance
  (HasEqAsymmetric ((a1,a2,a3,a4), a5) ((b1,b2,b3,b4), b5))
  =>
  HasEqAsymmetric (a1,a2,a3,a4,a5) (b1,b2,b3,b4,b5) where
  type EqCompareType (a1,a2,a3,a4,a5) (b1,b2,b3,b4,b5) =
    EqCompareType ((a1,a2,a3,a4), a5) ((b1,b2,b3,b4), b5)
  equalTo :: (a1, a2, a3, a4, a5)
-> (b1, b2, b3, b4, b5)
-> EqCompareType (a1, a2, a3, a4, a5) (b1, b2, b3, b4, b5)
equalTo (a1
a1,a2
a2,a3
a3,a4
a4,a5
a5) (b1
b1,b2
b2,b3
b3,b4
b4,b5
b5) =
    ((a1
a1,a2
a2,a3
a3,a4
a4), a5
a5) forall a b. HasEqAsymmetric a b => a -> b -> EqCompareType a b
== ((b1
b1,b2
b2,b3
b3,b4
b4), b5
b5)

instance (HasEqAsymmetric a b) => HasEqAsymmetric [a] [b] where
  type EqCompareType [a] [b] = EqCompareType a b
  equalTo :: [a] -> [b] -> EqCompareType [a] [b]
equalTo [] [] = forall t1 t2. ConvertibleExactly t1 t2 => t1 -> t2
convertExactly Bool
True
  equalTo (a
x:[a]
xs) (b
y:[b]
ys) = (a
x forall a b. HasEqAsymmetric a b => a -> b -> EqCompareType a b
== b
y) forall a b. CanAndOrAsymmetric a b => a -> b -> AndOrType a b
&& ([a]
xs forall a b. HasEqAsymmetric a b => a -> b -> EqCompareType a b
== [b]
ys)
  equalTo [a]
_ [b]
_ = forall t1 t2. ConvertibleExactly t1 t2 => t1 -> t2
convertExactly Bool
False

instance (HasEqAsymmetric a b) => HasEqAsymmetric (Maybe a) (Maybe b) where
  type EqCompareType (Maybe a) (Maybe b) = EqCompareType a b
  equalTo :: Maybe a -> Maybe b -> EqCompareType (Maybe a) (Maybe b)
equalTo Maybe a
Nothing Maybe b
Nothing = forall t1 t2. ConvertibleExactly t1 t2 => t1 -> t2
convertExactly Bool
True
  equalTo (Just a
x) (Just b
y) = (a
x forall a b. HasEqAsymmetric a b => a -> b -> EqCompareType a b
== b
y)
  equalTo Maybe a
_ Maybe b
_ = forall t1 t2. ConvertibleExactly t1 t2 => t1 -> t2
convertExactly Bool
False

instance
  (HasEqAsymmetric a b, CanBeErrors es, CanTestCertainly (EqCompareType a b))
  =>
  HasEqAsymmetric (CollectErrors es a) (CollectErrors es  b)
  where
  type EqCompareType (CollectErrors es  a) (CollectErrors es  b) =
    CollectErrors es (EqCompareType a b)
  equalTo :: CollectErrors es a
-> CollectErrors es b
-> EqCompareType (CollectErrors es a) (CollectErrors es b)
equalTo = forall es a b c.
Monoid es =>
(a -> b -> c)
-> CollectErrors es a -> CollectErrors es b -> CollectErrors es c
CE.lift2 forall a b. HasEqAsymmetric a b => a -> b -> EqCompareType a b
equalTo

$(declForTypes
  [[t| Bool |], [t| Maybe Bool |], [t| Integer |], [t| Int |], [t| Rational |], [t| Double |]]
  (\ t -> [d|

    instance
      (HasEqAsymmetric $t b, CanBeErrors es, CanTestCertainly (EqCompareType $t b))
      =>
      HasEqAsymmetric $t (CollectErrors es  b)
      where
      type EqCompareType $t (CollectErrors es  b) =
        CollectErrors es (EqCompareType $t b)
      equalTo = CE.liftT1 equalTo

    instance
      (HasEqAsymmetric a $t, CanBeErrors es, CanTestCertainly (EqCompareType a $t))
      =>
      HasEqAsymmetric (CollectErrors es a) $t
      where
      type EqCompareType (CollectErrors es  a) $t =
        CollectErrors es (EqCompareType a $t)
      equalTo = CE.lift1T equalTo

  |]))


{---- Checking whether it is valid / finite -----}

class CanTestValid t where
  isValid :: t -> Bool

{-|
  HSpec property checking the validity of unary operations' results.
 -}
specResultIsValid1 ::
  (Arbitrary t1, Show t1, CanTestValid t1, CanTestValid t2)
  =>
  (t1 -> t2) -> String -> T t1 -> Spec
specResultIsValid1 :: forall t1 t2.
(Arbitrary t1, Show t1, CanTestValid t1, CanTestValid t2) =>
(t1 -> t2) -> String -> T t1 -> Spec
specResultIsValid1 = forall t1 t2.
(Arbitrary t1, Show t1, CanTestValid t1, CanTestValid t2) =>
(t1 -> Bool) -> (t1 -> t2) -> String -> T t1 -> Spec
specResultIsValid1Pre (forall a b. a -> b -> a
const Bool
True)

specResultIsValid1Pre ::
  (Arbitrary t1, Show t1, CanTestValid t1, CanTestValid t2)
  =>
  (t1 -> Bool) -> (t1 -> t2) -> String -> T t1 -> Spec
specResultIsValid1Pre :: forall t1 t2.
(Arbitrary t1, Show t1, CanTestValid t1, CanTestValid t2) =>
(t1 -> Bool) -> (t1 -> t2) -> String -> T t1 -> Spec
specResultIsValid1Pre t1 -> Bool
pre t1 -> t2
f String
fName (T String
tName1 :: T t1) =
  forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it (forall r. PrintfType r => String -> r
printf String
"Function %s returns a valid result for valid %s inputs" String
fName String
tName1) forall a b. (a -> b) -> a -> b
$ do
    forall prop. Testable prop => prop -> Property
property forall a b. (a -> b) -> a -> b
$ \ (t1
x :: t1) -> forall t. CanTestValid t => t -> Bool
isValid t1
x forall a b. CanAndOrAsymmetric a b => a -> b -> AndOrType a b
&& t1 -> Bool
pre t1
x forall prop. Testable prop => Bool -> prop -> Property
==> forall t. CanTestValid t => t -> Bool
isValid (t1 -> t2
f t1
x)

{-|
  HSpec properties that check validity of operations' results.
 -}
specResultIsValid2 ::
  (Arbitrary t1, Show t1, Arbitrary t2, Show t2, CanTestValid t1, CanTestValid t2, CanTestValid t3)
  =>
  (t1 -> t2 -> t3) -> String -> T t1 -> T t2 -> Spec
specResultIsValid2 :: forall t1 t2 t3.
(Arbitrary t1, Show t1, Arbitrary t2, Show t2, CanTestValid t1,
 CanTestValid t2, CanTestValid t3) =>
(t1 -> t2 -> t3) -> String -> T t1 -> T t2 -> Spec
specResultIsValid2 = forall t1 t2 t3.
(Arbitrary t1, Show t1, Arbitrary t2, Show t2, CanTestValid t1,
 CanTestValid t2, CanTestValid t3) =>
(t1 -> t2 -> Bool)
-> (t1 -> t2 -> t3) -> String -> T t1 -> T t2 -> Spec
specResultIsValid2Pre (\t1
_ t2
_ -> Bool
True)

specResultIsValid2Pre ::
  (Arbitrary t1, Show t1, Arbitrary t2, Show t2, CanTestValid t1, CanTestValid t2, CanTestValid t3)
  =>
  (t1 -> t2 -> Bool) -> (t1 -> t2 -> t3) -> String -> T t1 -> T t2 -> Spec
specResultIsValid2Pre :: forall t1 t2 t3.
(Arbitrary t1, Show t1, Arbitrary t2, Show t2, CanTestValid t1,
 CanTestValid t2, CanTestValid t3) =>
(t1 -> t2 -> Bool)
-> (t1 -> t2 -> t3) -> String -> T t1 -> T t2 -> Spec
specResultIsValid2Pre t1 -> t2 -> Bool
pre t1 -> t2 -> t3
f String
fName (T String
t1Name :: T t1) (T String
t2Name :: T t2) =
  forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it (forall r. PrintfType r => String -> r
printf String
"Function %s returns a valid result for valid %s, %s inputs" String
fName String
t1Name String
t2Name) forall a b. (a -> b) -> a -> b
$ do
    forall prop. Testable prop => prop -> Property
property forall a b. (a -> b) -> a -> b
$ \ (t1
x :: t1) (t2
y :: t2) -> forall t. CanTestValid t => t -> Bool
isValid t1
x forall a b. CanAndOrAsymmetric a b => a -> b -> AndOrType a b
&& forall t. CanTestValid t => t -> Bool
isValid t2
y forall a b. CanAndOrAsymmetric a b => a -> b -> AndOrType a b
&& t1 -> t2 -> Bool
pre t1
x t2
y forall prop. Testable prop => Bool -> prop -> Property
==> forall t. CanTestValid t => t -> Bool
isValid (t1 -> t2 -> t3
f t1
x t2
y)

class CanTestNaN t where
  isNaN :: t -> Bool
  default isNaN :: (P.RealFloat t) => t -> Bool
  isNaN = forall a. RealFloat a => a -> Bool
P.isNaN

class CanTestFinite t where
  isInfinite :: t -> Bool
  default isInfinite :: (P.RealFloat t) => t -> Bool
  isInfinite = forall a. RealFloat a => a -> Bool
P.isInfinite
  isFinite :: t -> Bool
  default isFinite :: (P.RealFloat t) => t -> Bool
  isFinite t
x = (forall t. CanNeg t => t -> NegType t
not forall a b. (a -> b) -> a -> b
$ forall a. RealFloat a => a -> Bool
P.isNaN t
x) forall a b. CanAndOrAsymmetric a b => a -> b -> AndOrType a b
&& (forall t. CanNeg t => t -> NegType t
not forall a b. (a -> b) -> a -> b
$ forall a. RealFloat a => a -> Bool
P.isInfinite t
x)

instance CanTestNaN Double
instance CanTestFinite Double

instance CanTestNaN Integer where
  isNaN :: Integer -> Bool
isNaN = forall a b. a -> b -> a
const Bool
False
instance CanTestNaN Rational where
  isNaN :: Rational -> Bool
isNaN = forall a b. a -> b -> a
const Bool
False
instance CanTestFinite Int where
  isInfinite :: Int -> Bool
isInfinite = forall a b. a -> b -> a
const Bool
False
  isFinite :: Int -> Bool
isFinite = forall a b. a -> b -> a
const Bool
True
instance CanTestFinite Integer where
  isInfinite :: Integer -> Bool
isInfinite = forall a b. a -> b -> a
const Bool
False
  isFinite :: Integer -> Bool
isFinite = forall a b. a -> b -> a
const Bool
True
instance CanTestFinite Rational where
  isInfinite :: Rational -> Bool
isInfinite = forall a b. a -> b -> a
const Bool
False
  isFinite :: Rational -> Bool
isFinite = forall a b. a -> b -> a
const Bool
True

instance (CanTestNaN t, CanBeErrors es) => (CanTestNaN (CollectErrors es t)) where
  isNaN :: CollectErrors es t -> Bool
isNaN = forall es t v.
CanBeErrors es =>
(es -> t) -> (v -> t) -> CollectErrors es v -> t
CE.withErrorOrValue (forall a b. a -> b -> a
const Bool
False) forall t. CanTestNaN t => t -> Bool
isNaN

instance (CanTestFinite t, CanBeErrors es) => (CanTestFinite (CollectErrors es t)) where
  isInfinite :: CollectErrors es t -> Bool
isInfinite = forall es t v.
CanBeErrors es =>
(es -> t) -> (v -> t) -> CollectErrors es v -> t
CE.withErrorOrValue (forall a b. a -> b -> a
const Bool
False) forall t. CanTestFinite t => t -> Bool
isInfinite
  isFinite :: CollectErrors es t -> Bool
isFinite = forall es t v.
CanBeErrors es =>
(es -> t) -> (v -> t) -> CollectErrors es v -> t
CE.withErrorOrValue (forall a b. a -> b -> a
const Bool
False) forall t. CanTestFinite t => t -> Bool
isFinite

{---- Checking whether it is an integer -----}

class CanTestInteger t where
  certainlyNotInteger :: t -> Bool
  certainlyInteger :: t -> Bool
  certainlyInteger t
s = case forall t. CanTestInteger t => t -> Maybe Integer
certainlyIntegerGetIt t
s of Just Integer
_ -> Bool
True; Maybe Integer
_ -> Bool
False
  certainlyIntegerGetIt :: t -> Maybe Integer

instance CanTestInteger Integer where
  certainlyNotInteger :: Integer -> Bool
certainlyNotInteger Integer
_ = Bool
False
  certainlyInteger :: Integer -> Bool
certainlyInteger Integer
_ = Bool
True
  certainlyIntegerGetIt :: Integer -> Maybe Integer
certainlyIntegerGetIt Integer
n = forall a. a -> Maybe a
Just Integer
n

instance CanTestInteger Int where
  certainlyNotInteger :: Int -> Bool
certainlyNotInteger Int
_ = Bool
False
  certainlyInteger :: Int -> Bool
certainlyInteger Int
_ = Bool
True
  certainlyIntegerGetIt :: Int -> Maybe Integer
certainlyIntegerGetIt Int
n = forall a. a -> Maybe a
Just (forall t. CanBeInteger t => t -> Integer
integer Int
n)

instance CanTestInteger Rational where
  certainlyNotInteger :: Rational -> Bool
certainlyNotInteger Rational
q = (forall a. Ratio a -> a
denominator Rational
q forall a b. HasEqAsymmetric a b => a -> b -> EqCompareType a b
/= Integer
1)
  certainlyInteger :: Rational -> Bool
certainlyInteger Rational
q = (forall a. Ratio a -> a
denominator Rational
q forall a b. HasEqAsymmetric a b => a -> b -> EqCompareType a b
== Integer
1)
  certainlyIntegerGetIt :: Rational -> Maybe Integer
certainlyIntegerGetIt Rational
q
    | forall a. Ratio a -> a
denominator Rational
q forall a b. HasEqAsymmetric a b => a -> b -> EqCompareType a b
== Integer
1 = forall a. a -> Maybe a
Just (forall a. Ratio a -> a
numerator Rational
q)
    | Bool
otherwise = forall a. Maybe a
Nothing

instance CanTestInteger Double where
  certainlyNotInteger :: Double -> Bool
certainlyNotInteger Double
d =
    forall t. CanTestFinite t => t -> Bool
isInfinite Double
d forall a b. CanAndOrAsymmetric a b => a -> b -> AndOrType a b
|| forall t. CanTestNaN t => t -> Bool
isNaN Double
d forall a b. CanAndOrAsymmetric a b => a -> b -> AndOrType a b
||
      (forall a b. (RealFrac a, Integral b) => a -> b
P.floor Double
d :: Integer) forall a. Ord a => a -> a -> Bool
P.< forall a b. (RealFrac a, Integral b) => a -> b
P.ceiling Double
d
  certainlyIntegerGetIt :: Double -> Maybe Integer
certainlyIntegerGetIt Double
d
    | forall t. CanTestFinite t => t -> Bool
isFinite Double
d forall a b. CanAndOrAsymmetric a b => a -> b -> AndOrType a b
&& (Integer
dF forall a. Eq a => a -> a -> Bool
P.== Integer
dC) = forall a. a -> Maybe a
Just Integer
dF
    | Bool
otherwise = forall a. Maybe a
Nothing
    where
      dF :: Integer
dF = forall a b. (RealFrac a, Integral b) => a -> b
P.floor Double
d
      dC :: Integer
dC = forall a b. (RealFrac a, Integral b) => a -> b
P.ceiling Double
d

instance (CanTestInteger t, CanBeErrors es) => (CanTestInteger (CollectErrors es t)) where
  certainlyNotInteger :: CollectErrors es t -> Bool
certainlyNotInteger = forall es t v.
CanBeErrors es =>
(es -> t) -> (v -> t) -> CollectErrors es v -> t
CE.withErrorOrValue (forall a b. a -> b -> a
const Bool
False) forall t. CanTestInteger t => t -> Bool
certainlyNotInteger
  certainlyIntegerGetIt :: CollectErrors es t -> Maybe Integer
certainlyIntegerGetIt = forall es t v.
CanBeErrors es =>
(es -> t) -> (v -> t) -> CollectErrors es v -> t
CE.withErrorOrValue (forall a b. a -> b -> a
const forall a. Maybe a
Nothing) forall t. CanTestInteger t => t -> Maybe Integer
certainlyIntegerGetIt

{---- Checking whether it is zero -----}

class CanTestZero t where
  isCertainlyZero :: t -> Bool
  isCertainlyNonZero :: t -> Bool
  default isCertainlyZero :: (HasEqCertainly t Integer) => t -> Bool
  isCertainlyZero t
a = forall t. CanTestCertainly t => t -> Bool
isCertainlyTrue (t
a forall a b. HasEqAsymmetric a b => a -> b -> EqCompareType a b
== Integer
0)
  default isCertainlyNonZero :: (HasEqCertainly t Integer) => t -> Bool
  isCertainlyNonZero t
a = forall t. CanTestCertainly t => t -> Bool
isCertainlyTrue (t
a forall a b. HasEqAsymmetric a b => a -> b -> EqCompareType a b
/= Integer
0)

{-|
  HSpec properties that each implementation of CanTestZero should satisfy.
 -}
specCanTestZero ::
  (CanTestZero t, ConvertibleExactly Integer t)
  =>
  T t -> Spec
specCanTestZero :: forall t.
(CanTestZero t, ConvertibleExactly Integer t) =>
T t -> Spec
specCanTestZero (T String
typeName :: T t) =
  forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe (forall r. PrintfType r => String -> r
printf String
"CanTestZero %s" String
typeName) forall a b. (a -> b) -> a -> b
$ do
    forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"converted non-zero Integer is not isCertainlyZero" forall a b. (a -> b) -> a -> b
$ do
      forall prop. Testable prop => prop -> Property
property forall a b. (a -> b) -> a -> b
$ \ (Integer
x :: Integer) ->
        Integer
x forall a b. HasEqAsymmetric a b => a -> b -> EqCompareType a b
/= Integer
0 forall prop. Testable prop => Bool -> prop -> Property
==> (forall t. CanNeg t => t -> NegType t
not forall a b. (a -> b) -> a -> b
$ forall t. CanTestZero t => t -> Bool
isCertainlyZero (forall t1 t2. ConvertibleExactly t1 t2 => t1 -> t2
convertExactly Integer
x :: t))
    forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"converted non-zero Integer is isCertainlyNonZero" forall a b. (a -> b) -> a -> b
$ do
      forall prop. Testable prop => prop -> Property
property forall a b. (a -> b) -> a -> b
$ \ (Integer
x :: Integer) ->
        Integer
x forall a b. HasEqAsymmetric a b => a -> b -> EqCompareType a b
/= Integer
0 forall prop. Testable prop => Bool -> prop -> Property
==> (forall t. CanTestZero t => t -> Bool
isCertainlyNonZero (forall t1 t2. ConvertibleExactly t1 t2 => t1 -> t2
convertExactly Integer
x :: t))
    forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"converted 0.0 is not isCertainlyNonZero" forall a b. (a -> b) -> a -> b
$ do
      (forall t. CanTestZero t => t -> Bool
isCertainlyNonZero (forall t1 t2. ConvertibleExactly t1 t2 => t1 -> t2
convertExactly Integer
0 :: t)) forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` Bool
False

instance CanTestZero Int
instance CanTestZero Integer
instance CanTestZero Rational
instance CanTestZero Double

instance (CanTestZero t, CanBeErrors es) => (CanTestZero (CollectErrors es t)) where
  isCertainlyZero :: CollectErrors es t -> Bool
isCertainlyZero = forall es t v.
CanBeErrors es =>
(es -> t) -> (v -> t) -> CollectErrors es v -> t
CE.withErrorOrValue (forall a b. a -> b -> a
const Bool
False) forall t. CanTestZero t => t -> Bool
isCertainlyZero
  isCertainlyNonZero :: CollectErrors es t -> Bool
isCertainlyNonZero = forall es t v.
CanBeErrors es =>
(es -> t) -> (v -> t) -> CollectErrors es v -> t
CE.withErrorOrValue (forall a b. a -> b -> a
const Bool
False) forall t. CanTestZero t => t -> Bool
isCertainlyNonZero


class CanPickNonZero t where
  {-|
    Given a list @[(a1,b1),(a2,b2),...]@ and assuming that
    at least one of @a1,a2,...@ is non-zero, pick one of them
    and return the corresponding pair @(ai,bi)@.

    If none of @a1,a2,...@ is zero, either throws an exception
    or loops forever.

    The default implementation is based on a `CanTestZero` instance
    and is not parallel.
   -}
  pickNonZero :: [(t,s)] -> Maybe (t,s)
  default pickNonZero :: (CanTestZero t, Show t) => [(t,s)] -> Maybe (t,s)
  pickNonZero [(t, s)]
list = forall {a} {b}. CanTestZero a => [(a, b)] -> Maybe (a, b)
aux [(t, s)]
list
    where
      aux :: [(a, b)] -> Maybe (a, b)
aux ((a
a,b
b):[(a, b)]
rest)
        | forall t. CanTestZero t => t -> Bool
isCertainlyNonZero a
a = forall a. a -> Maybe a
Just (a
a,b
b)
        | Bool
otherwise = [(a, b)] -> Maybe (a, b)
aux [(a, b)]
rest
      aux [] = forall a. Maybe a
Nothing

{-|
  HSpec properties that each implementation of CanPickNonZero should satisfy.
 -}
specCanPickNonZero ::
  (CanPickNonZero t, CanTestZero t, ConvertibleExactly Integer t, Show t, Arbitrary t)
  =>
  T t -> Spec
specCanPickNonZero :: forall t.
(CanPickNonZero t, CanTestZero t, ConvertibleExactly Integer t,
 Show t, Arbitrary t) =>
T t -> Spec
specCanPickNonZero (T String
typeName :: T t) =
  forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe (forall r. PrintfType r => String -> r
printf String
"CanPickNonZero %s" String
typeName) forall a b. (a -> b) -> a -> b
$ do
    forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"picks a non-zero element if there is one" forall a b. (a -> b) -> a -> b
$ do
      forall prop. Testable prop => prop -> Property
property forall a b. (a -> b) -> a -> b
$ \ ([(t, ())]
xs :: [(t, ())]) ->
        forall t. (CanAndOrSameType t, CanTestCertainly t) => [t] -> t
or (forall a b. (a -> b) -> [a] -> [b]
map (forall t. CanTestZero t => t -> Bool
isCertainlyNonZero forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) [(t, ())]
xs) -- if at least one is non-zero
        forall prop. Testable prop => Bool -> prop -> Property
==>
        (case forall t s. CanPickNonZero t => [(t, s)] -> Maybe (t, s)
pickNonZero [(t, ())]
xs of
          Just (t
v, ()
_) -> forall t. CanTestZero t => t -> Bool
isCertainlyNonZero t
v
          Maybe (t, ())
_ -> Bool
False)
    forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"returns Nothing when all the elements are 0" forall a b. (a -> b) -> a -> b
$ do
      case forall t s. CanPickNonZero t => [(t, s)] -> Maybe (t, s)
pickNonZero [(forall t1 t2. ConvertibleExactly t1 t2 => t1 -> t2
convertExactly Integer
i :: t, ()) | Integer
i <- [Integer
0,Integer
0,Integer
0]] of
        Maybe (t, ())
Nothing -> Bool
True
        Maybe (t, ())
_ -> Bool
False

instance CanPickNonZero Int
instance CanPickNonZero Integer
instance CanPickNonZero Rational

instance (CanPickNonZero a, CanBeErrors es) => (CanPickNonZero (CollectErrors es a)) where
  pickNonZero :: forall s.
[(CollectErrors es a, s)] -> Maybe (CollectErrors es a, s)
pickNonZero =
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(a
v,s
s) -> (forall (f :: * -> *) a. Applicative f => a -> f a
pure a
v,s
s))
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t s. CanPickNonZero t => [(t, s)] -> Maybe (t, s)
pickNonZero
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall es v. CanBeErrors es => [CollectErrors es v] -> [v]
CE.filterValuesWithoutError
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a b. (a -> b) -> [a] -> [b]
map (\(CollectErrors es a
vCN,s
s) -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\a
v -> (a
v,s
s)) CollectErrors es a
vCN))