module Test.Validity.RelativeValidity
( relativeValiditySpec
, relativeValidityImpliesValidA
, relativeValidityImpliesValidB
) where
import Data.Data
import Data.GenRelativeValidity
import Data.GenValidity
import Test.Hspec
import Test.QuickCheck
import Test.Validity.Utils
relativeValiditySpec
:: forall a b.
( Typeable a
, Typeable b
, Show a
, Show b
, Validity a
, Validity b
, GenUnchecked a
, GenUnchecked b
, RelativeValidity a b
)
=> Spec
relativeValiditySpec =
parallel $ do
let nameOne = nameOf @a
nameTwo = nameOf @b
describe ("RelativeValidity " ++ nameOne ++ " " ++ nameTwo) $
describe
("isValidFor :: " ++ nameOne ++ " -> " ++ nameTwo ++ " -> Bool") $ do
it ("implies isValid " ++ nameOne ++ " for any " ++ nameTwo) $
relativeValidityImpliesValidA @a @b
it ("implies isValid " ++ nameTwo ++ " for any " ++ nameOne) $
relativeValidityImpliesValidB @a @b
relativeValidityImpliesValidA
:: forall a b.
( Show a
, Show b
, Validity a
, GenUnchecked a
, GenUnchecked b
, RelativeValidity a b
)
=> Property
relativeValidityImpliesValidA =
forAll genUnchecked $ \(a :: a) ->
forAll genUnchecked $ \(b :: b) -> (a `isValidFor` b) ===> isValid a
relativeValidityImpliesValidB
:: forall a b.
( Show a
, Show b
, Validity b
, GenUnchecked a
, GenUnchecked b
, RelativeValidity a b
)
=> Property
relativeValidityImpliesValidB =
forAll genUnchecked $ \(a :: a) ->
forAll genUnchecked $ \(b :: b) -> (a `isValidFor` b) ===> isValid b