{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Test.Syd.Validity.Functions.Validity
( producesValidsOnGen
, producesValidsOnValids
, producesValid
, producesValidsOnArbitrary
, producesValidsOnGens2
, producesValidsOnValids2
, producesValid2
, producesValidsOnArbitrary2
, producesValidsOnGens3
, producesValidsOnValids3
, producesValid3
, producesValidsOnArbitrary3
) where
import Data.GenValidity
import Test.QuickCheck
import Test.Syd.Validity.Property.Utils
producesValidsOnGen ::
forall a b. (Show a, Show b, Validity b)
=> (a -> b)
-> Gen a
-> (a -> [a])
-> Property
producesValidsOnGen :: (a -> b) -> Gen a -> (a -> [a]) -> Property
producesValidsOnGen a -> b
func Gen a
gen a -> [a]
s = Gen a -> (a -> [a]) -> (a -> Expectation) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> [a]) -> (a -> prop) -> Property
forAllShrink Gen a
gen a -> [a]
s ((a -> Expectation) -> Property) -> (a -> Expectation) -> Property
forall a b. (a -> b) -> a -> b
$ b -> Expectation
forall a. (Show a, Validity a) => a -> Expectation
shouldBeValid (b -> Expectation) -> (a -> b) -> a -> Expectation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
func
producesValidsOnValids ::
(Show a, Show b, GenValid a, Validity b) => (a -> b) -> Property
producesValidsOnValids :: (a -> b) -> Property
producesValidsOnValids a -> b
f = (a -> b) -> Gen a -> (a -> [a]) -> Property
forall a b.
(Show a, Show b, Validity b) =>
(a -> b) -> Gen a -> (a -> [a]) -> Property
producesValidsOnGen a -> b
f Gen a
forall a. GenValid a => Gen a
genValid a -> [a]
forall a. GenValid a => a -> [a]
shrinkValid
producesValid ::
(Show a, Show b, GenUnchecked a, Validity b) => (a -> b) -> Property
producesValid :: (a -> b) -> Property
producesValid a -> b
f = (a -> b) -> Gen a -> (a -> [a]) -> Property
forall a b.
(Show a, Show b, Validity b) =>
(a -> b) -> Gen a -> (a -> [a]) -> Property
producesValidsOnGen a -> b
f Gen a
forall a. GenUnchecked a => Gen a
genUnchecked a -> [a]
forall a. GenUnchecked a => a -> [a]
shrinkUnchecked
producesValidsOnArbitrary ::
(Show a, Show b, Arbitrary a, Validity b) => (a -> b) -> Property
producesValidsOnArbitrary :: (a -> b) -> Property
producesValidsOnArbitrary a -> b
f = (a -> b) -> Gen a -> (a -> [a]) -> Property
forall a b.
(Show a, Show b, Validity b) =>
(a -> b) -> Gen a -> (a -> [a]) -> Property
producesValidsOnGen a -> b
f Gen a
forall a. Arbitrary a => Gen a
arbitrary a -> [a]
forall a. Arbitrary a => a -> [a]
shrink
producesValidsOnGens2 ::
(Show a, Show b, Show c, Validity c)
=> (a -> b -> c)
-> Gen (a, b)
-> ((a, b) -> [(a, b)])
-> Property
producesValidsOnGens2 :: (a -> b -> c) -> Gen (a, b) -> ((a, b) -> [(a, b)]) -> Property
producesValidsOnGens2 a -> b -> c
func Gen (a, b)
gen (a, b) -> [(a, b)]
s =
Gen (a, b)
-> ((a, b) -> [(a, b)]) -> ((a, b) -> Expectation) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> [a]) -> (a -> prop) -> Property
forAllShrink Gen (a, b)
gen (a, b) -> [(a, b)]
s (((a, b) -> Expectation) -> Property)
-> ((a, b) -> Expectation) -> Property
forall a b. (a -> b) -> a -> b
$ \(a
a, b
b) -> c -> Expectation
forall a. (Show a, Validity a) => a -> Expectation
shouldBeValid (c -> Expectation) -> c -> Expectation
forall a b. (a -> b) -> a -> b
$ a -> b -> c
func a
a b
b
producesValidsOnValids2 ::
(Show a, Show b, Show c, GenValid a, GenValid b, Validity c)
=> (a -> b -> c)
-> Property
producesValidsOnValids2 :: (a -> b -> c) -> Property
producesValidsOnValids2 a -> b -> c
func = (a -> b -> c) -> Gen (a, b) -> ((a, b) -> [(a, b)]) -> Property
forall a b c.
(Show a, Show b, Show c, Validity c) =>
(a -> b -> c) -> Gen (a, b) -> ((a, b) -> [(a, b)]) -> Property
producesValidsOnGens2 a -> b -> c
func Gen (a, b)
forall a. GenValid a => Gen a
genValid (a, b) -> [(a, b)]
forall a. GenValid a => a -> [a]
shrinkValid
producesValid2 ::
(Show a, Show b, Show c, GenUnchecked a, GenUnchecked b, Validity c)
=> (a -> b -> c)
-> Property
producesValid2 :: (a -> b -> c) -> Property
producesValid2 a -> b -> c
func = (a -> b -> c) -> Gen (a, b) -> ((a, b) -> [(a, b)]) -> Property
forall a b c.
(Show a, Show b, Show c, Validity c) =>
(a -> b -> c) -> Gen (a, b) -> ((a, b) -> [(a, b)]) -> Property
producesValidsOnGens2 a -> b -> c
func Gen (a, b)
forall a. GenUnchecked a => Gen a
genUnchecked (a, b) -> [(a, b)]
forall a. GenUnchecked a => a -> [a]
shrinkUnchecked
producesValidsOnArbitrary2 ::
(Show a, Show b, Show c, Arbitrary a, Arbitrary b, Validity c)
=> (a -> b -> c)
-> Property
producesValidsOnArbitrary2 :: (a -> b -> c) -> Property
producesValidsOnArbitrary2 a -> b -> c
func = (a -> b -> c) -> Gen (a, b) -> ((a, b) -> [(a, b)]) -> Property
forall a b c.
(Show a, Show b, Show c, Validity c) =>
(a -> b -> c) -> Gen (a, b) -> ((a, b) -> [(a, b)]) -> Property
producesValidsOnGens2 a -> b -> c
func Gen (a, b)
forall a. Arbitrary a => Gen a
arbitrary (a, b) -> [(a, b)]
forall a. Arbitrary a => a -> [a]
shrink
producesValidsOnGens3 ::
(Show a, Show b, Show c, Show d, Validity d)
=> (a -> b -> c -> d)
-> Gen (a, b, c)
-> ((a, b, c) -> [(a, b, c)])
-> Property
producesValidsOnGens3 :: (a -> b -> c -> d)
-> Gen (a, b, c) -> ((a, b, c) -> [(a, b, c)]) -> Property
producesValidsOnGens3 a -> b -> c -> d
func Gen (a, b, c)
gen (a, b, c) -> [(a, b, c)]
s =
Gen (a, b, c)
-> ((a, b, c) -> [(a, b, c)])
-> ((a, b, c) -> Expectation)
-> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> [a]) -> (a -> prop) -> Property
forAllShrink Gen (a, b, c)
gen (a, b, c) -> [(a, b, c)]
s (((a, b, c) -> Expectation) -> Property)
-> ((a, b, c) -> Expectation) -> Property
forall a b. (a -> b) -> a -> b
$ \(a
a, b
b, c
c) -> d -> Expectation
forall a. (Show a, Validity a) => a -> Expectation
shouldBeValid (d -> Expectation) -> d -> Expectation
forall a b. (a -> b) -> a -> b
$ a -> b -> c -> d
func a
a b
b c
c
producesValidsOnValids3 ::
( Show a
, Show b
, Show c
, Show d
, GenValid a
, GenValid b
, GenValid c
, Validity d
)
=> (a -> b -> c -> d)
-> Property
producesValidsOnValids3 :: (a -> b -> c -> d) -> Property
producesValidsOnValids3 a -> b -> c -> d
func = (a -> b -> c -> d)
-> Gen (a, b, c) -> ((a, b, c) -> [(a, b, c)]) -> Property
forall a b c d.
(Show a, Show b, Show c, Show d, Validity d) =>
(a -> b -> c -> d)
-> Gen (a, b, c) -> ((a, b, c) -> [(a, b, c)]) -> Property
producesValidsOnGens3 a -> b -> c -> d
func Gen (a, b, c)
forall a. GenValid a => Gen a
genValid (a, b, c) -> [(a, b, c)]
forall a. GenValid a => a -> [a]
shrinkValid
producesValid3 ::
( Show a
, Show b
, Show c
, Show d
, GenUnchecked a
, GenUnchecked b
, GenUnchecked c
, Validity d
)
=> (a -> b -> c -> d)
-> Property
producesValid3 :: (a -> b -> c -> d) -> Property
producesValid3 a -> b -> c -> d
func = (a -> b -> c -> d)
-> Gen (a, b, c) -> ((a, b, c) -> [(a, b, c)]) -> Property
forall a b c d.
(Show a, Show b, Show c, Show d, Validity d) =>
(a -> b -> c -> d)
-> Gen (a, b, c) -> ((a, b, c) -> [(a, b, c)]) -> Property
producesValidsOnGens3 a -> b -> c -> d
func Gen (a, b, c)
forall a. GenUnchecked a => Gen a
genUnchecked (a, b, c) -> [(a, b, c)]
forall a. GenUnchecked a => a -> [a]
shrinkUnchecked
producesValidsOnArbitrary3 ::
( Show a
, Show b
, Show c
, Show d
, Arbitrary a
, Arbitrary b
, Arbitrary c
, Validity d
)
=> (a -> b -> c -> d)
-> Property
producesValidsOnArbitrary3 :: (a -> b -> c -> d) -> Property
producesValidsOnArbitrary3 a -> b -> c -> d
func = (a -> b -> c -> d)
-> Gen (a, b, c) -> ((a, b, c) -> [(a, b, c)]) -> Property
forall a b c d.
(Show a, Show b, Show c, Show d, Validity d) =>
(a -> b -> c -> d)
-> Gen (a, b, c) -> ((a, b, c) -> [(a, b, c)]) -> Property
producesValidsOnGens3 a -> b -> c -> d
func Gen (a, b, c)
forall a. Arbitrary a => Gen a
arbitrary (a, b, c) -> [(a, b, c)]
forall a. Arbitrary a => a -> [a]
shrink