module Test.Validity
( module Data.GenValidity
, Proxy(Proxy)
, arbitrarySpec
, arbitraryGeneratesOnlyValid
, shrinkProducesOnlyValids
, genValiditySpec
, genValidityValidGeneratesValid
, genValidityInvalidGeneratesInvalid
, relativeValiditySpec
, relativeValidityImpliesValidA
, relativeValidityImpliesValidB
, genRelativeValiditySpec
, genRelativeValidityValidGeneratesValid
, genRelativeValidityInvalidGeneratesInvalid
, producesValidsOnGen
, alwaysProducesValid
, producesValidsOnValids
, producesValidsOnGens2
, alwaysProducesValid2
, producesValidsOnValids2
, CanFail(..)
, succeedsOnGen
, succeedsOnValidInput
, failsOnGen
, failsOnInvalidInput
, validIfSucceedsOnGen
, validIfSucceeds
) where
import Data.Proxy
import Data.Data
import Data.GenValidity
import Data.GenRelativeValidity
import Test.Hspec
import Test.QuickCheck
arbitrarySpec
:: (Typeable a, Show a, Validity a, Arbitrary a)
=> Proxy a
-> Spec
arbitrarySpec proxy = do
let name = nameOf proxy
describe ("Arbitrary " ++ name) $ do
it ("is instantiated such that 'arbitrary' only generates valid \'"
++ name
++ "\'s") $
arbitraryGeneratesOnlyValid proxy
it ("is instantiated such that 'shrink' only produces valid \'"
++ name
++ "\'s") $ do
forAll arbitrary $ \a ->
shrink (a `asProxyTypeOf` proxy) `shouldSatisfy` all isValid
arbitraryGeneratesOnlyValid
:: (Show a, Validity a, Arbitrary a)
=> Proxy a
-> Property
arbitraryGeneratesOnlyValid proxy =
forAll arbitrary $ \a ->
(a `asProxyTypeOf` proxy) `shouldSatisfy` isValid
shrinkProducesOnlyValids
:: (Show a, Validity a, Arbitrary a)
=> Proxy a
-> Property
shrinkProducesOnlyValids proxy =
forAll arbitrary $ \a ->
shrink (a `asProxyTypeOf` proxy) `shouldSatisfy` all isValid
genValiditySpec
:: (Typeable a, Show a, GenValidity a)
=> Proxy a
-> Spec
genValiditySpec proxy = do
let name = nameOf proxy
describe ("GenValidity " ++ name) $ do
describe ("genValid :: Gen " ++ name) $
it ("only generates valid \'" ++ name ++ "\'s") $
genValidityValidGeneratesValid proxy
describe ("genInvalid :: Gen " ++ name) $
it ("only generates invalid \'" ++ name ++ "\'s") $
genValidityInvalidGeneratesInvalid proxy
genValidityValidGeneratesValid
:: (Show a, GenValidity a)
=> Proxy a
-> Property
genValidityValidGeneratesValid proxy =
forAll genValid $ \a ->
(a `asProxyTypeOf` proxy) `shouldSatisfy` isValid
genValidityInvalidGeneratesInvalid
:: (Show a, GenValidity a)
=> Proxy a
-> Property
genValidityInvalidGeneratesInvalid proxy =
forAll genInvalid $ \a ->
(a `asProxyTypeOf` proxy) `shouldNotSatisfy` isValid
relativeValiditySpec
:: (Typeable a, Typeable b,
Data a, Data b,
Show a, Show b,
GenValidity a, GenValidity b, GenRelativeValidity a b)
=> Proxy a
-> Proxy b
-> Spec
relativeValiditySpec one two = do
let nameOne = nameOf one
nameTwo = nameOf two
describe ("RelativeValidity " ++ nameOne ++ " " ++ nameTwo) $ do
describe ("isValidFor :: "
++ nameOne
++ " -> "
++ nameTwo
++ " -> Bool") $ do
it ("implies isValid " ++ nameOne ++ " for any " ++ nameTwo) $
relativeValidityImpliesValidA one two
it ("implies isValid " ++ nameTwo ++ " for any " ++ nameOne) $
relativeValidityImpliesValidB one two
relativeValidityImpliesValidA
:: (Show a, Show b,
GenValidity a, GenValidity b, RelativeValidity a b)
=> Proxy a
-> Proxy b
-> Property
relativeValidityImpliesValidA one two =
forAll genUnchecked $ \a ->
forAll genUnchecked $ \b ->
not ((a `asProxyTypeOf` one) `isValidFor` (b `asProxyTypeOf` two))
|| isValid a
relativeValidityImpliesValidB
:: (Show a, Show b,
GenValidity a, GenValidity b, RelativeValidity a b)
=> Proxy a
-> Proxy b
-> Property
relativeValidityImpliesValidB one two =
forAll genUnchecked $ \a ->
forAll genUnchecked $ \b ->
not ((a `asProxyTypeOf` one) `isValidFor` (b `asProxyTypeOf` two))
|| isValid b
genRelativeValiditySpec
:: (Typeable a, Typeable b,
Show a, Show b,
GenValidity a, GenValidity b,
RelativeValidity a b,
GenRelativeValidity a b)
=> Proxy a
-> Proxy b
-> Spec
genRelativeValiditySpec one two = do
let nameOne = nameOf one
let nameTwo = nameOf two
describe ("GenRelativeValidity " ++ nameOne ++ " " ++ nameTwo) $ do
describe ("genValidFor :: " ++ nameTwo ++ " -> Gen " ++ nameOne) $
it ("only generates valid \'"
++ nameOne
++ "\'s for the "
++ nameTwo) $
genRelativeValidityValidGeneratesValid one two
describe ("genInvalidFor :: " ++ nameTwo ++ " -> Gen " ++ nameOne) $
it ("only generates invalid \'"
++ nameOne
++ "\'s for the "
++ nameTwo) $
genRelativeValidityInvalidGeneratesInvalid one two
genRelativeValidityValidGeneratesValid
:: (Show a, Show b,
GenValidity a, GenValidity b,
RelativeValidity a b,
GenRelativeValidity a b)
=> Proxy a
-> Proxy b
-> Property
genRelativeValidityValidGeneratesValid one two =
forAll genValid $ \b ->
forAll (genValidFor b) $ \a ->
(a `asProxyTypeOf` one)
`shouldSatisfy` (`isValidFor` (b `asProxyTypeOf` two))
genRelativeValidityInvalidGeneratesInvalid
:: (Show a, Show b,
GenValidity a, GenValidity b,
RelativeValidity a b,
GenRelativeValidity a b)
=> Proxy a
-> Proxy b
-> Property
genRelativeValidityInvalidGeneratesInvalid one two =
forAll genUnchecked $ \b ->
forAll (genInvalidFor b) $ \a ->
(a `asProxyTypeOf` one)
`shouldNotSatisfy` (`isValidFor` (b `asProxyTypeOf` two))
class CanFail f where
hasFailed :: f a -> Bool
resultIfSucceeded :: f a -> Maybe a
instance CanFail Maybe where
hasFailed Nothing = True
hasFailed _ = False
resultIfSucceeded Nothing = Nothing
resultIfSucceeded (Just r) = Just r
instance CanFail (Either e) where
hasFailed (Left _) = True
hasFailed _ = False
resultIfSucceeded (Left _) = Nothing
resultIfSucceeded (Right r) = Just r
producesValidsOnGen
:: (Show a, Show b, Validity b)
=> (a -> b)
-> Gen a
-> Property
producesValidsOnGen func gen
= forAll gen $ \a -> func a `shouldSatisfy` isValid
alwaysProducesValid
:: (Show a, Show b, GenValidity a, Validity b)
=> (a -> b)
-> Property
alwaysProducesValid = (`producesValidsOnGen` genUnchecked)
producesValidsOnValids
:: (Show a, Show b, GenValidity a, Validity b)
=> (a -> b)
-> Property
producesValidsOnValids = (`producesValidsOnGen` genValid)
producesValidsOnGens2
:: (Show a, Show b, Show c, Validity c)
=> (a -> b -> c)
-> Gen a -> Gen b
-> Property
producesValidsOnGens2 func gen1 gen2
= forAll gen1 $ \a ->
forAll gen2 $ \b ->
func a b `shouldSatisfy` isValid
alwaysProducesValid2
:: (Show a, Show b, Show c, GenValidity a, GenValidity b, Validity c)
=> (a -> b -> c)
-> Property
alwaysProducesValid2 func
= producesValidsOnGens2 func genUnchecked genUnchecked
producesValidsOnValids2
:: (Show a, Show b, Show c, GenValidity a, GenValidity b, Validity c)
=> (a -> b -> c)
-> Property
producesValidsOnValids2 func
= producesValidsOnGens2 func genValid genValid
succeedsOnGen
:: (Show a, Show b, Show (f b), CanFail f)
=> (a -> f b)
-> Gen a
-> Property
succeedsOnGen func gen
= forAll gen $ \a -> func a `shouldNotSatisfy` hasFailed
succeedsOnValidInput
:: (Show a, Show b, Show (f b), GenValidity a, CanFail f)
=> (a -> f b)
-> Property
succeedsOnValidInput = (`succeedsOnGen` genValid)
failsOnGen
:: (Show a, Show b, Show (f b), CanFail f)
=> (a -> f b)
-> Gen a
-> Property
failsOnGen func gen
= forAll gen $ \a -> func a `shouldSatisfy` hasFailed
failsOnInvalidInput
:: (Show a, Show b, Show (f b), GenValidity a, CanFail f)
=> (a -> f b)
-> Property
failsOnInvalidInput = (`failsOnGen` genInvalid)
validIfSucceedsOnGen
:: (Show a, Show b, Show (f b), Validity b, CanFail f)
=> (a -> f b)
-> Gen a
-> Property
validIfSucceedsOnGen func gen
= forAll gen $ \a ->
case resultIfSucceeded (func a) of
Nothing -> return ()
Just res -> res `shouldSatisfy` isValid
validIfSucceeds
:: (Show a, Show b, Show (f b), GenValidity a, Validity b, CanFail f)
=> (a -> f b)
-> Property
validIfSucceeds = (`validIfSucceedsOnGen` genUnchecked)
nameOf :: Typeable a => Proxy a -> String
nameOf proxy =
let (_, [ty]) = splitTyConApp $ typeOf proxy
in show ty