{-# OPTIONS_GHC -Wno-partial-type-signatures #-}
{-# LANGUAGE PartialTypeSignatures #-}
{-# LANGUAGE TemplateHaskell #-}
module Numeric.MixedTypes.Eq
(
HasEq, HasEqAsymmetric(..), (==), (/=)
, HasEqCertainly, HasEqCertainlyAsymmetric
, notCertainlyDifferentFrom, certainlyEqualTo, certainlyNotEqualTo
, (?==?), (!==!), (!/=!)
, specHasEq, specHasEqNotMixed
, specConversion
, 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 !==!, !/=!
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
equalTo :: a -> b -> (EqCompareType a b)
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 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
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)
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
specConversion ::
(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
|]))
class CanTestValid t where
isValid :: t -> Bool
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)
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
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
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)
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
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
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)
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))