{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
module Test.Validity.Eq
( eqSpec,
eqSpecOnArbitrary,
eqSpecOnGen,
)
where
import Data.Data
import Data.GenValidity
import Test.Hspec
import Test.QuickCheck
import Test.Validity.Functions
import Test.Validity.Relations
import Test.Validity.Utils
eqTypeStr ::
forall a.
Typeable a =>
String
eqTypeStr :: forall a. Typeable a => String
eqTypeStr = forall {k} (a :: k). Typeable a => String -> String
binRelStr @a String
"=="
neqTypeStr ::
forall a.
Typeable a =>
String
neqTypeStr :: forall a. Typeable a => String
neqTypeStr = forall {k} (a :: k). Typeable a => String -> String
binRelStr @a String
"/="
eqSpec ::
forall a.
(Show a, Eq a, Typeable a, GenValid a) =>
Spec
eqSpec :: forall a. (Show a, Eq a, Typeable a, GenValid a) => Spec
eqSpec = forall a.
(Show a, Eq a, Typeable a) =>
Gen a -> String -> (a -> [a]) -> Spec
eqSpecOnGen @a forall a. GenValid a => Gen a
genValid String
"valid" forall a. GenValid a => a -> [a]
shrinkValid
eqSpecOnArbitrary ::
forall a.
(Show a, Eq a, Typeable a, Arbitrary a) =>
Spec
eqSpecOnArbitrary :: forall a. (Show a, Eq a, Typeable a, Arbitrary a) => Spec
eqSpecOnArbitrary = forall a.
(Show a, Eq a, Typeable a) =>
Gen a -> String -> (a -> [a]) -> Spec
eqSpecOnGen @a forall a. Arbitrary a => Gen a
arbitrary String
"arbitrary" forall a. Arbitrary a => a -> [a]
shrink
eqSpecOnGen ::
forall a.
(Show a, Eq a, Typeable a) =>
Gen a ->
String ->
(a -> [a]) ->
Spec
eqSpecOnGen :: forall a.
(Show a, Eq a, Typeable a) =>
Gen a -> String -> (a -> [a]) -> Spec
eqSpecOnGen Gen a
gen String
genname a -> [a]
s =
forall a. SpecWith a -> SpecWith a
parallel forall a b. (a -> b) -> a -> b
$ do
let name :: String
name = forall {k} (a :: k). Typeable a => String
nameOf @a
funeqstr :: String
funeqstr = forall a. Typeable a => String
eqTypeStr @a
funneqstr :: String
funneqstr = forall a. Typeable a => String
neqTypeStr @a
gen2 :: Gen (a, a)
gen2 = (,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen a
gen forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen a
gen
gen3 :: Gen (a, a, a)
gen3 = (,,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen a
gen forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen a
gen forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen a
gen
s2 :: (a, a) -> [(a, a)]
s2 = forall a. (a -> [a]) -> (a, a) -> [(a, a)]
shrinkT2 a -> [a]
s
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe (String
"Eq " forall a. [a] -> [a] -> [a]
++ String
name) forall a b. (a -> b) -> a -> b
$ do
let eq :: a -> a -> Bool
eq = forall a. Eq a => a -> a -> Bool
(==) @a
neq :: a -> a -> Bool
neq = forall a. Eq a => a -> a -> Bool
(/=) @a
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
funeqstr forall a b. (a -> b) -> a -> b
$ do
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it
( [String] -> String
unwords
[ String
"is reflexive for",
String
"\"" forall a. [a] -> [a] -> [a]
++ String
genname,
String
name forall a. [a] -> [a] -> [a]
++ String
"\"" forall a. [a] -> [a] -> [a]
++ String
"s"
]
)
forall a b. (a -> b) -> a -> b
$ forall a.
Show a =>
(a -> a -> Bool) -> Gen a -> (a -> [a]) -> Property
reflexivityOnGen a -> a -> Bool
eq Gen a
gen a -> [a]
s
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it
( [String] -> String
unwords
[ String
"is symmetric for",
String
"\"" forall a. [a] -> [a] -> [a]
++ String
genname,
String
name forall a. [a] -> [a] -> [a]
++ String
"\"" forall a. [a] -> [a] -> [a]
++ String
"s"
]
)
forall a b. (a -> b) -> a -> b
$ forall a.
Show a =>
(a -> a -> Bool) -> Gen (a, a) -> (a -> [a]) -> Property
symmetryOnGens a -> a -> Bool
eq Gen (a, a)
gen2 a -> [a]
s
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it
( [String] -> String
unwords
[ String
"is transitive for",
String
"\"" forall a. [a] -> [a] -> [a]
++ String
genname,
String
name forall a. [a] -> [a] -> [a]
++ String
"\"" forall a. [a] -> [a] -> [a]
++ String
"s"
]
)
forall a b. (a -> b) -> a -> b
$ forall a.
Show a =>
(a -> a -> Bool) -> Gen (a, a, a) -> (a -> [a]) -> Property
transitivityOnGens a -> a -> Bool
eq Gen (a, a, a)
gen3 a -> [a]
s
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it
( [String] -> String
unwords
[ String
"is equivalent to (\\a b -> not $ a /= b) for",
String
"\"" forall a. [a] -> [a] -> [a]
++ String
genname,
String
name forall a. [a] -> [a] -> [a]
++ String
"\"" forall a. [a] -> [a] -> [a]
++ String
"s"
]
)
forall a b. (a -> b) -> a -> b
$ forall a b c.
(Show a, Show b, Show c, Eq c) =>
(a -> b -> c)
-> (a -> b -> c) -> Gen (a, b) -> ((a, b) -> [(a, b)]) -> Property
equivalentOnGens2 a -> a -> Bool
eq (\a
a a
b -> Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ a
a a -> a -> Bool
`neq` a
b) Gen (a, a)
gen2 (a, a) -> [(a, a)]
s2
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
funneqstr forall a b. (a -> b) -> a -> b
$ do
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it
( [String] -> String
unwords
[ String
"is antireflexive for",
String
"\"" forall a. [a] -> [a] -> [a]
++ String
genname,
String
name forall a. [a] -> [a] -> [a]
++ String
"\"" forall a. [a] -> [a] -> [a]
++ String
"s"
]
)
forall a b. (a -> b) -> a -> b
$ forall a.
Show a =>
(a -> a -> Bool) -> Gen a -> (a -> [a]) -> Property
antireflexivityOnGen a -> a -> Bool
neq Gen a
gen a -> [a]
s
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it
( [String] -> String
unwords
[ String
"is equivalent to (\\a b -> not $ a == b) for",
String
"\"" forall a. [a] -> [a] -> [a]
++ String
genname,
String
name forall a. [a] -> [a] -> [a]
++ String
"\"" forall a. [a] -> [a] -> [a]
++ String
"s"
]
)
forall a b. (a -> b) -> a -> b
$ forall a b c.
(Show a, Show b, Show c, Eq c) =>
(a -> b -> c)
-> (a -> b -> c) -> Gen (a, b) -> ((a, b) -> [(a, b)]) -> Property
equivalentOnGens2 a -> a -> Bool
neq (\a
a a
b -> Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ a
a a -> a -> Bool
`eq` a
b) Gen (a, a)
gen2 (a, a) -> [(a, a)]
s2