| Safe Haskell | None |
|---|---|
| Language | Haskell2010 |
Data.GenValidity
Description
GenValidity exists to make tests involving Validity types easier and speed
up the generation of data for them.
Let's use the example from Data.Validity again: A datatype that represents
primes.
To implement tests for this datatype, we would have to be able to generate
both primes and non-primes. We could do this with
(Prime $ arbitrary)
but this is tedious and inefficient.suchThat isValid
The GenValid type class allows you to specify how to (efficiently)
generate valid data of the given type to allow for easier and quicker testing.
Just instantiating GenUnchecked already gives you access to a default instance
of GenValid and GenInvalid but writing custom implementations of these functions
may speed up the generation of data.
For example, to generate primes, we don't have to consider even numbers other than 2. A more efficient implementation could then look as follows:
instance GenUnchecked Prime where
genUnchecked = Prime <$> arbitraryinstance GenValid Prime where
genValid = Prime <$>
(oneof
[ pure 2
, ((\y -> 2 * abs y + 1) <$> arbitrary) `suchThat` isPrime)
])Typical examples of tests involving validity could look as follows:
it "succeeds when given valid input" $ do
forAllValid $ \input ->
myFunction input `shouldSatisfy` isRightit "produces valid output when it succeeds" $ do
forAllUnchecked $ \input ->
case myFunction input of
Nothing -> return () -- Can happen
Just output -> output `shouldSatisfy` isValidDefinitely also look at the genvalidity-property and genvalidity-hspec packages for more info on how to use this package.
Synopsis
- class GenUnchecked a where
- genUnchecked :: Gen a
- shrinkUnchecked :: a -> [a]
- class Validity a => GenValid a where
- genValid :: Gen a
- shrinkValid :: a -> [a]
- class Validity a => GenInvalid a where
- genInvalid :: Gen a
- shrinkInvalid :: a -> [a]
- genValidStructurally :: (Validity a, Generic a, GGenValid (Rep a)) => Gen a
- genValidStructurallyWithoutExtraChecking :: (Generic a, GGenValid (Rep a)) => Gen a
- shrinkValidStructurally :: (Validity a, Generic a, GValidRecursivelyShrink (Rep a), GValidSubterms (Rep a) a) => a -> [a]
- shrinkValidStructurallyWithoutExtraFiltering :: (Generic a, GValidRecursivelyShrink (Rep a), GValidSubterms (Rep a) a) => a -> [a]
- module Data.GenValidity.Utils
- genUtf16SurrogateCodePoint :: Gen Char
- module Data.Validity
- genericGenUnchecked :: (Generic a, GGenUnchecked (Rep a)) => Gen a
- class GGenUnchecked f where
- gGenUnchecked :: Gen (f a)
- genericShrinkUnchecked :: (Generic a, GUncheckedRecursivelyShrink (Rep a), GUncheckedSubterms (Rep a) a) => a -> [a]
- uncheckedRecursivelyShrink :: (Generic a, GUncheckedRecursivelyShrink (Rep a)) => a -> [a]
- class GUncheckedRecursivelyShrink f where
- gUncheckedRecursivelyShrink :: f a -> [f a]
- uncheckedSubterms :: (Generic a, GUncheckedSubterms (Rep a) a) => a -> [a]
- class GUncheckedSubterms f a where
- gUncheckedSubterms :: f a -> [a]
- class GUncheckedSubtermsIncl f a where
- gUncheckedSubtermsIncl :: f a -> [a]
- class GGenValid f where
- class GValidRecursivelyShrink f where
- gValidRecursivelyShrink :: f a -> [f a]
- structurallyValidSubterms :: (Generic a, GValidSubterms (Rep a) a) => a -> [a]
- class GValidSubterms f a where
- gValidSubterms :: f a -> [a]
- class GValidSubtermsIncl f a where
- gValidSubtermsIncl :: f a -> [a]
Documentation
class GenUnchecked a where Source #
A class of types for which truly arbitrary values can be generated.
How to instantiate GenUnchecked
Step 1: Try to instantiate GenUnchecked via Generic.
this is probably what you want
An instance of this class can be made automatically if the type in question
has a Generic instance. This instance will try to use genUnchecked to
generate all structural sub-parts of the value that is being generated.
Example:
{-# LANGUAGE DeriveGeneric #-}
data MyType = MyType Rational String
deriving (Show, Eq, Generic)
instance GenUnchecked MyTypegenerates something like:
instance GenUnchecked MyType where
genUnchecked = MyType <$> genUnchecked <*> genUncheckedIf this is not possible because there is no GenUnchecked instance available for one of the
sub-parts of your type, then do not instantiate GenUnchecked for your type.
Just continue with GenValid instead.
Step 2: If an instatiation via Generic is not possible, then you should emulate what
genericGenUnchecked does.
This means that all sub-parts should be generated using genUnchecked.
Make sure to generate any possible value, valid or not, that can exist at runtime
even when taking the existence of unsafeCoerce into account.
Warning: Invalid values can be funky
Some types have serious validity constraints. See Rational for example.
These can behave very strangely when they are not valid.
In that case, do not override GenUnchecked such that genUnchecked only generates valid values.
In that case, do not override genUnchecked at all.
Instead, use genValid from GenValid (see below) instead and consider not instantiating GenUnchecked at all.
Minimal complete definition
Nothing
Methods
genUnchecked :: Gen a Source #
genUnchecked :: (Generic a, GGenUnchecked (Rep a)) => Gen a Source #
shrinkUnchecked :: a -> [a] Source #
shrinkUnchecked :: (Generic a, GUncheckedRecursivelyShrink (Rep a), GUncheckedSubterms (Rep a) a) => a -> [a] Source #
Instances
class Validity a => GenValid a where Source #
A class of types for which valid values can be generated.
How to instantiate GenValid
Step 1: Try to instantiate GenValid without overriding any functions.
This is only possible if your type has a GenUnchecked instance.
If it doesn't, go to step 2.
It is possible that, if few values are valid or if validity
checking is expensive, that the resulting generator is too slow.
In that case, go to Step 2.
Step 2: Try to instantiate GenValid using the helper functions via Generic
This involves using genValidStructurally to override genValid and
using shrinkValidStructurally to override shrinkValid.
Every time you override genValid, you should also override shrinkValid
Step 3: If the above is not possible due to lack of a Generic instance,
then you should emulate what genValidStructurally does.
This means that all sub-parts should be generated using genValid.
Make sure to generate any possible valid value, but only valid values.
A note about Arbitrary
If you also write Arbitrary instances for GenValid types, it may be
best to simply use
arbitrary = genValid shrink = shrinkValid
Minimal complete definition
Nothing
Methods
Generate a valid datum, this should cover all possible valid values in the type
The default implementation is as follows:
genValid = genUnchecked `suchThat` isValid
To speed up testing, it may be a good idea to implement this yourself. If you do, make sure that it is possible to generate all possible valid data, otherwise your testing may not cover all cases.
genValid :: GenUnchecked a => Gen a Source #
Generate a valid datum, this should cover all possible valid values in the type
The default implementation is as follows:
genValid = genUnchecked `suchThat` isValid
To speed up testing, it may be a good idea to implement this yourself. If you do, make sure that it is possible to generate all possible valid data, otherwise your testing may not cover all cases.
shrinkValid :: a -> [a] Source #
Shrink a valid value.
The default implementation is as follows:
shrinkValid = filter isValid . shrinkUnchecked
It is important that this shrinking function only shrinks values to valid values.
If shrinkValid ever shrinks a value to an invalid value, the test that is being shrunk for
might fail for a different reason than for the reason that it originally failed.
This would lead to very confusing error messages.
shrinkValid :: GenUnchecked a => a -> [a] Source #
Shrink a valid value.
The default implementation is as follows:
shrinkValid = filter isValid . shrinkUnchecked
It is important that this shrinking function only shrinks values to valid values.
If shrinkValid ever shrinks a value to an invalid value, the test that is being shrunk for
might fail for a different reason than for the reason that it originally failed.
This would lead to very confusing error messages.
Instances
class Validity a => GenInvalid a where Source #
A class of types for which invalid values can be generated.
How to instantiate GenInvalid
Step 1: Realise that you probably do not want to.
It makes no sense, and serves no purpose, to instantiate GenInvalid for types
which contain no invalid values. (In fact, the default implementation will go into
an infinite loop for such types.)
You should only instantiate GenInvalid if you explicitly want to use it
to write tests that deal with invalid values, or if you are writing a container
for parametric values.
Step 2: Instantiate GenInvalid without overriding any functions.
Minimal complete definition
Nothing
Methods
genInvalid :: Gen a Source #
Generate an invalid datum, this should cover all possible invalid values
genInvalid = genUnchecked `suchThat` isInvalid
To speed up testing, it may be a good idea to implement this yourself. If you do, make sure that it is possible to generate all possible invalid data, otherwise your testing may not cover all cases.
genInvalid :: GenUnchecked a => Gen a Source #
Generate an invalid datum, this should cover all possible invalid values
genInvalid = genUnchecked `suchThat` isInvalid
To speed up testing, it may be a good idea to implement this yourself. If you do, make sure that it is possible to generate all possible invalid data, otherwise your testing may not cover all cases.
shrinkInvalid :: a -> [a] Source #
shrinkInvalid :: GenUnchecked a => a -> [a] Source #
Instances
| (GenUnchecked a, GenInvalid a) => GenInvalid [a] Source # | This instance ensures that the generated list contains at least one element
that satisfies |
Defined in Data.GenValidity | |
| GenInvalid a => GenInvalid (Maybe a) Source # | |
Defined in Data.GenValidity | |
| (Integral a, Num a, Ord a, Validity a, GenUnchecked a) => GenInvalid (Ratio a) Source # | |
Defined in Data.GenValidity | |
| (GenUnchecked a, GenInvalid a) => GenInvalid (NonEmpty a) Source # | |
Defined in Data.GenValidity | |
| (GenInvalid a, GenInvalid b) => GenInvalid (Either a b) Source # | This instance ensures that the generated tupse contains at least one invalid element. The other element is unchecked. |
Defined in Data.GenValidity | |
| (GenUnchecked a, GenInvalid a, GenUnchecked b, GenInvalid b) => GenInvalid (a, b) Source # | |
Defined in Data.GenValidity | |
| (GenUnchecked a, GenUnchecked b, GenUnchecked c, GenInvalid a, GenInvalid b, GenInvalid c) => GenInvalid (a, b, c) Source # | This instance ensures that the generated triple contains at least one invalid element. The other two are unchecked. |
Defined in Data.GenValidity | |
| (GenUnchecked a, GenUnchecked b, GenUnchecked c, GenUnchecked d, GenInvalid a, GenInvalid b, GenInvalid c, GenInvalid d) => GenInvalid (a, b, c, d) Source # | This instance ensures that the generated triple contains at least one invalid element. The other two are unchecked. |
Defined in Data.GenValidity Methods genInvalid :: Gen (a, b, c, d) Source # shrinkInvalid :: (a, b, c, d) -> [(a, b, c, d)] Source # | |
| (GenUnchecked a, GenUnchecked b, GenUnchecked c, GenUnchecked d, GenUnchecked e, GenInvalid a, GenInvalid b, GenInvalid c, GenInvalid d, GenInvalid e) => GenInvalid (a, b, c, d, e) Source # | This instance ensures that the generated triple contains at least one invalid element. The other two are unchecked. |
Defined in Data.GenValidity Methods genInvalid :: Gen (a, b, c, d, e) Source # shrinkInvalid :: (a, b, c, d, e) -> [(a, b, c, d, e)] Source # | |
Helper functions
genValidStructurally :: (Validity a, Generic a, GGenValid (Rep a)) => Gen a Source #
Generate a valid value by generating all the sub parts using the Generic instance,
and trying that until a valid value has been generated
genValidStructurally = genValidStructurallyWithoutExtraChecking `suchThat` isValid
This is probably the function that you are looking for.
If you do use this function to override genValid, you probably also want to use
shrinkValidStructurally to override shrinkValid.
genValidStructurallyWithoutExtraChecking :: (Generic a, GGenValid (Rep a)) => Gen a Source #
Generate a valid value by generating all the sub parts using the Generic instance,
This generator is _not_ guaranteed to generate a valid value.
This is probably _not_ the function that you are looking for when overriding
genValid _unless_ the type in question has no _extra_ validity constraints on top of
the validity of its sub parts.
shrinkValidStructurally :: (Validity a, Generic a, GValidRecursivelyShrink (Rep a), GValidSubterms (Rep a) a) => a -> [a] Source #
Shrink a term to any of its immediate valid subterms, and also recursively shrink all subterms, and then filtering out the results that are not valid.
shrinkValidStructurally = filter isValid . shrinkValidStructurallyWithoutExtraFiltering
This is probably the function that you are looking for.
shrinkValidStructurallyWithoutExtraFiltering :: (Generic a, GValidRecursivelyShrink (Rep a), GValidSubterms (Rep a) a) => a -> [a] Source #
Shrink a term to any of its immediate valid subterms, and also recursively shrink all subterms.
This shrinking function is _not_ guaranteed to shrink to valid values.
This is probably _not_ the function that you are looking for when overriding
shrinkValid _unless_ the type in question has no _extra_ validity constraints on top of
the validity of its sub parts.
module Data.GenValidity.Utils
Strange, possibly useful functions
Re-exports
module Data.Validity
The Generics magic
genericGenUnchecked :: (Generic a, GGenUnchecked (Rep a)) => Gen a Source #
class GGenUnchecked f where Source #
Methods
gGenUnchecked :: Gen (f a) Source #
Instances
| GGenUnchecked (U1 :: Type -> Type) Source # | |
Defined in Data.GenValidity Methods gGenUnchecked :: Gen (U1 a) Source # | |
| GenUnchecked a => GGenUnchecked (K1 i a :: Type -> Type) Source # | |
Defined in Data.GenValidity Methods gGenUnchecked :: Gen (K1 i a a0) Source # | |
| (GGenUnchecked a, GGenUnchecked b) => GGenUnchecked (a :+: b) Source # | |
Defined in Data.GenValidity Methods gGenUnchecked :: Gen ((a :+: b) a0) Source # | |
| (GGenUnchecked a, GGenUnchecked b) => GGenUnchecked (a :*: b) Source # | |
Defined in Data.GenValidity Methods gGenUnchecked :: Gen ((a :*: b) a0) Source # | |
| GGenUnchecked a => GGenUnchecked (M1 i c a) Source # | |
Defined in Data.GenValidity Methods gGenUnchecked :: Gen (M1 i c a a0) Source # | |
genericShrinkUnchecked :: (Generic a, GUncheckedRecursivelyShrink (Rep a), GUncheckedSubterms (Rep a) a) => a -> [a] Source #
Shrink a term to any of its immediate subterms, and also recursively shrink all subterms.
uncheckedRecursivelyShrink :: (Generic a, GUncheckedRecursivelyShrink (Rep a)) => a -> [a] Source #
Recursively shrink all immediate uncheckedSubterms.
class GUncheckedRecursivelyShrink f where Source #
Methods
gUncheckedRecursivelyShrink :: f a -> [f a] Source #
Instances
uncheckedSubterms :: (Generic a, GUncheckedSubterms (Rep a) a) => a -> [a] Source #
All immediate uncheckedSubterms of a term.
class GUncheckedSubterms f a where Source #
Methods
gUncheckedSubterms :: f a -> [a] Source #
Instances
| GUncheckedSubterms (V1 :: Type -> Type) a Source # | |
Defined in Data.GenValidity Methods gUncheckedSubterms :: V1 a -> [a] Source # | |
| GUncheckedSubterms (U1 :: Type -> Type) a Source # | |
Defined in Data.GenValidity Methods gUncheckedSubterms :: U1 a -> [a] Source # | |
| GUncheckedSubterms (K1 i a :: Type -> Type) b Source # | |
Defined in Data.GenValidity Methods gUncheckedSubterms :: K1 i a b -> [b] Source # | |
| (GUncheckedSubtermsIncl f a, GUncheckedSubtermsIncl g a) => GUncheckedSubterms (f :+: g) a Source # | |
Defined in Data.GenValidity Methods gUncheckedSubterms :: (f :+: g) a -> [a] Source # | |
| (GUncheckedSubtermsIncl f a, GUncheckedSubtermsIncl g a) => GUncheckedSubterms (f :*: g) a Source # | |
Defined in Data.GenValidity Methods gUncheckedSubterms :: (f :*: g) a -> [a] Source # | |
| GUncheckedSubterms f a => GUncheckedSubterms (M1 i c f) a Source # | |
Defined in Data.GenValidity Methods gUncheckedSubterms :: M1 i c f a -> [a] Source # | |
class GUncheckedSubtermsIncl f a where Source #
Methods
gUncheckedSubtermsIncl :: f a -> [a] Source #
Instances
class GValidRecursivelyShrink f where Source #
Methods
gValidRecursivelyShrink :: f a -> [f a] Source #
Instances
structurallyValidSubterms :: (Generic a, GValidSubterms (Rep a) a) => a -> [a] Source #
All immediate validSubterms of a term.
class GValidSubterms f a where Source #
Methods
gValidSubterms :: f a -> [a] Source #
Instances
| GValidSubterms (V1 :: Type -> Type) a Source # | |
Defined in Data.GenValidity Methods gValidSubterms :: V1 a -> [a] Source # | |
| GValidSubterms (U1 :: Type -> Type) a Source # | |
Defined in Data.GenValidity Methods gValidSubterms :: U1 a -> [a] Source # | |
| GValidSubterms (K1 i a :: Type -> Type) b Source # | |
Defined in Data.GenValidity Methods gValidSubterms :: K1 i a b -> [b] Source # | |
| (GValidSubtermsIncl f a, GValidSubtermsIncl g a) => GValidSubterms (f :+: g) a Source # | |
Defined in Data.GenValidity Methods gValidSubterms :: (f :+: g) a -> [a] Source # | |
| (GValidSubtermsIncl f a, GValidSubtermsIncl g a) => GValidSubterms (f :*: g) a Source # | |
Defined in Data.GenValidity Methods gValidSubterms :: (f :*: g) a -> [a] Source # | |
| GValidSubterms f a => GValidSubterms (M1 i c f) a Source # | |
Defined in Data.GenValidity Methods gValidSubterms :: M1 i c f a -> [a] Source # | |
class GValidSubtermsIncl f a where Source #
Methods
gValidSubtermsIncl :: f a -> [a] Source #