module Test.Validity.Ord
( ordSpecOnGen
, ordSpecOnValid
, ordSpecOnInvalid
, ordSpec
, ordSpecOnArbitrary
) 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
leTypeStr
:: forall a.
Typeable a
=> String
leTypeStr = binRelStr @a "<="
geTypeStr
:: forall a.
Typeable a
=> String
geTypeStr = binRelStr @a ">="
ltTypeStr
:: forall a.
Typeable a
=> String
ltTypeStr = binRelStr @a "<"
gtTypeStr
:: forall a.
Typeable a
=> String
gtTypeStr = binRelStr @a ">"
ordSpecOnValid
:: forall a.
(Show a, Ord a, Typeable a, GenValid a)
=> Spec
ordSpecOnValid = ordSpecOnGen @a genUnchecked "unchecked"
ordSpecOnInvalid
:: forall a.
(Show a, Ord a, Typeable a, GenInvalid a)
=> Spec
ordSpecOnInvalid = ordSpecOnGen @a genInvalid "invalid"
ordSpec
:: forall a.
(Show a, Ord a, Typeable a, GenUnchecked a)
=> Spec
ordSpec = ordSpecOnGen @a genUnchecked "unchecked"
ordSpecOnArbitrary
:: forall a.
(Show a, Ord a, Typeable a, Arbitrary a)
=> Spec
ordSpecOnArbitrary = ordSpecOnGen @a arbitrary "unchecked"
ordSpecOnGen
:: forall a.
(Show a, Eq a, Ord a, Typeable a)
=> Gen a -> String -> Spec
ordSpecOnGen gen genname =
parallel $ do
let name = nameOf @a
funlestr = leTypeStr @a
fungestr = geTypeStr @a
funltstr = ltTypeStr @a
fungtstr = gtTypeStr @a
cmple = ((<=) @a)
cmpge = ((>=) @a)
cmplt = ((<) @a)
cmpgt = ((>) @a)
gen2 = (,) <$> gen <*> gen
gen3 = (,,) <$> gen <*> gen <*> gen
describe ("Ord " ++ name) $ do
describe funlestr $ do
it
(unwords
[ "is reflexive for"
, "\"" ++ genname
, name ++ "\"" ++ "'s"
]) $
reflexivityOnGen cmple gen
it
(unwords
[ "is antisymmetric for"
, "\"" ++ genname
, name ++ "\"" ++ "'s"
]) $
antisymmetryOnGens cmple gen2
it
(unwords
[ "is transitive for"
, "\"" ++ genname
, name ++ "\"" ++ "'s"
]) $
transitivityOnGens cmple gen3
it
(unwords
[ "is equivalent to (\\a b -> compare a b /= GT) for"
, "\"" ++ genname
, name ++ "\"" ++ "'s"
]) $
equivalentOnGens2 cmple (\a b -> compare a b /= GT) gen2
describe fungestr $ do
it
(unwords
[ "is reflexive for"
, "\"" ++ genname
, name ++ "\"" ++ "'s"
]) $
reflexivityOnGen cmpge gen
it
(unwords
[ "is antisymmetric for"
, "\"" ++ genname
, name ++ "\"" ++ "'s"
]) $
antisymmetryOnGens cmpge gen2
it
(unwords
[ "is transitive for"
, "\"" ++ genname
, name ++ "\"" ++ "'s"
]) $
transitivityOnGens cmpge gen3
it
(unwords
[ "is equivalent to (\\a b -> compare a b /= LT) for"
, "\"" ++ genname
, name ++ "\"" ++ "'s"
]) $
equivalentOnGens2 cmpge (\a b -> compare a b /= LT) gen2
describe funltstr $ do
it
(unwords
[ "is antireflexive for"
, "\"" ++ genname
, name ++ "\"" ++ "'s"
]) $
antireflexivityOnGen cmplt gen
it
(unwords
[ "is transitive for"
, "\"" ++ genname
, name ++ "\"" ++ "'s"
]) $
transitivityOnGens cmplt gen3
it
(unwords
[ "is equivalent to (\\a b -> compare a b == LT) for"
, "\"" ++ genname
, name ++ "\"" ++ "'s"
]) $
equivalentOnGens2 cmplt (\a b -> compare a b == LT) gen2
describe fungtstr $ do
it
(unwords
[ "is antireflexive for"
, "\"" ++ genname
, name ++ "\"" ++ "'s"
]) $
antireflexivityOnGen cmpgt gen
it
(unwords
[ "is transitive for"
, "\"" ++ genname
, name ++ "\"" ++ "'s"
]) $
transitivityOnGens cmpgt gen3
it
(unwords
[ "is equivalent to (\\a b -> compare a b == GT) for"
, "\"" ++ genname
, name ++ "\"" ++ "'s"
]) $
equivalentOnGens2 cmpgt (\a b -> compare a b == GT) gen2