{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Test.Validity.GenRelativeValidity
( genRelativeValiditySpec
, genRelativeValidSpec
, genRelativeInvalidSpec
, genRelativeValidGeneratesValid
, genRelativeInvalidGeneratesInvalid
) 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
genRelativeValiditySpec ::
forall a b.
( Typeable a
, Typeable b
, Show a
, Show b
, GenUnchecked b
, GenValid b
, GenRelativeValid a b
, GenRelativeInvalid a b
)
=> Spec
genRelativeValiditySpec = do
genRelativeValidSpec @a @b
genRelativeInvalidSpec @a @b
genRelativeValidSpec ::
forall a b.
( Typeable a
, Typeable b
, Show a
, Show b
, GenValid a
, GenValid b
, RelativeValidity a b
, GenRelativeValid a b
)
=> Spec
genRelativeValidSpec =
parallel $ do
let nameOne = nameOf @a
let nameTwo = nameOf @a
describe ("GenRelativeValidity " ++ nameOne ++ " " ++ nameTwo) $
describe ("genValidFor :: " ++ nameTwo ++ " -> Gen " ++ nameOne) $
it
("only generates valid \'" ++
nameOne ++ "\'s for the " ++ nameTwo) $
genRelativeValidGeneratesValid @a @b
genRelativeInvalidSpec ::
forall a b.
( Typeable a
, Typeable b
, Show a
, Show b
, GenValid a
, GenUnchecked b
, GenValid b
, RelativeValidity a b
, GenRelativeInvalid a b
)
=> Spec
genRelativeInvalidSpec =
parallel $ do
let nameOne = nameOf @a
let nameTwo = nameOf @a
describe ("GenRelativeInvalid " ++ nameOne ++ " " ++ nameTwo) $
describe ("genInvalidFor :: " ++ nameTwo ++ " -> Gen " ++ nameOne) $
it
("only generates invalid \'" ++
nameOne ++ "\'s for the " ++ nameTwo) $
genRelativeInvalidGeneratesInvalid @a @b
genRelativeValidGeneratesValid ::
forall a b.
(Show a, Show b, GenValid b, RelativeValidity a b, GenRelativeValid a b)
=> Property
genRelativeValidGeneratesValid =
forAllValid $ \(b :: b) ->
forAll (genValidFor b) $ \(a :: a) -> a `shouldSatisfy` (`isValidFor` b)
genRelativeInvalidGeneratesInvalid ::
forall a b.
( Show a
, Show b
, GenUnchecked b
, RelativeValidity a b
, GenRelativeInvalid a b
)
=> Property
genRelativeInvalidGeneratesInvalid =
forAllUnchecked $ \(b :: b) ->
forAll (genInvalidFor b) $ \(a :: a) ->
a `shouldNotSatisfy` (`isValidFor` b)