{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
module Test.Validity.Eq
( eqSpecOnValid
, eqSpecOnInvalid
, 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 = binRelStr @a "=="
neqTypeStr ::
forall a. Typeable a
=> String
neqTypeStr = binRelStr @a "/="
eqSpecOnValid ::
forall a. (Show a, Eq a, Typeable a, GenValid a)
=> Spec
eqSpecOnValid = eqSpecOnGen @a genValid "valid" shrinkValid
eqSpecOnInvalid ::
forall a. (Show a, Eq a, Typeable a, GenInvalid a)
=> Spec
eqSpecOnInvalid = eqSpecOnGen @a genInvalid "invalid" shrinkInvalid
eqSpec ::
forall a. (Show a, Eq a, Typeable a, GenUnchecked a)
=> Spec
eqSpec = eqSpecOnGen @a genUnchecked "unchecked" shrinkUnchecked
eqSpecOnArbitrary ::
forall a. (Show a, Eq a, Typeable a, Arbitrary a)
=> Spec
eqSpecOnArbitrary = eqSpecOnGen @a arbitrary "arbitrary" shrink
eqSpecOnGen ::
forall a. (Show a, Eq a, Typeable a)
=> Gen a
-> String
-> (a -> [a])
-> Spec
eqSpecOnGen gen genname s =
parallel $ do
let name = nameOf @a
funeqstr = eqTypeStr @a
funneqstr = neqTypeStr @a
gen2 = (,) <$> gen <*> gen
gen3 = (,,) <$> gen <*> gen <*> gen
s2 = shrinkT2 s
describe ("Eq " ++ name) $ do
let eq = (==) @a
neq = (/=) @a
describe funeqstr $ do
it
(unwords
[ "is reflexive for"
, "\"" ++ genname
, name ++ "\"" ++ "s"
]) $
reflexivityOnGen eq gen s
it
(unwords
[ "is symmetric for"
, "\"" ++ genname
, name ++ "\"" ++ "s"
]) $
symmetryOnGens eq gen2 s
it
(unwords
[ "is transitive for"
, "\"" ++ genname
, name ++ "\"" ++ "s"
]) $
transitivityOnGens eq gen3 s
it
(unwords
[ "is equivalent to (\\a b -> not $ a /= b) for"
, "\"" ++ genname
, name ++ "\"" ++ "s"
]) $
equivalentOnGens2 eq (\a b -> not $ a `neq` b) gen2 s2
describe funneqstr $ do
it
(unwords
[ "is antireflexive for"
, "\"" ++ genname
, name ++ "\"" ++ "s"
]) $
antireflexivityOnGen neq gen s
it
(unwords
[ "is equivalent to (\\a b -> not $ a == b) for"
, "\"" ++ genname
, name ++ "\"" ++ "s"
]) $
equivalentOnGens2 neq (\a b -> not $ a `eq` b) gen2 s2