{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
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.Property.Utils
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 =
forAllUnchecked $ \(a :: a) ->
forAllUnchecked $ \(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 =
forAllUnchecked $ \(a :: a) ->
forAllUnchecked $ \(b :: b) -> (a `isValidFor` b) ===> isValid b