{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
-- | Ord properties
--
-- You will need @TypeApplications@ to use these.
module Test.Validity.Ord
( ordSpecOnGen
, ordSpecOnValid
, 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
{-# ANN module "HLint: ignore Use <=" #-}
{-# ANN module "HLint: ignore Use >=" #-}
{-# ANN module "HLint: ignore Use <" #-}
{-# ANN module "HLint: ignore Use >" #-}
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 ">"
-- | Standard test spec for properties of Ord instances for valid values
--
-- Example usage:
--
-- > ordSpecOnValid @Double
ordSpecOnValid
:: forall a.
(Show a, Ord a, Typeable a, Arbitrary a)
=> Spec
ordSpecOnValid = ordSpecOnGen @a arbitrary "unchecked"
-- | Standard test spec for properties of Ord instances for unchecked values
--
-- Example usage:
--
-- > ordSpec @Int
ordSpec
:: forall a.
(Show a, Ord a, Typeable a, GenUnchecked a)
=> Spec
ordSpec = ordSpecOnGen @a genUnchecked "unchecked"
-- | Standard test spec for properties of Ord instances for arbitrary values
--
-- Example usage:
--
-- > ordSpecOnArbitrary @Int
ordSpecOnArbitrary
:: forall a.
(Show a, Ord a, Typeable a, Arbitrary a)
=> Spec
ordSpecOnArbitrary = ordSpecOnGen @a arbitrary "unchecked"
-- | Standard test spec for properties of Ord instances for values generated by a given generator (and name for that generator).
--
-- Example usage:
--
-- > ordSpecOnGen ((* 2) <$> genValid @Int) "even"
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