genvalidity-hspec-1.0.0.3: Standard spec's for GenValidity instances
Safe HaskellSafe-Inferred
LanguageHaskell2010

Test.Validity

Description

To use the Spec functions in this module, you will need TypeApplications.

The most interesting functions in this module for most uses are:

Synopsis

Writing properties

Cheap generation with shrinking

forAllValid :: (Show a, GenValid a, Testable prop) => (a -> prop) -> Property #

Cheap assertions

Tests for GenValidity instances

genValidSpec :: forall a. (Typeable a, Show a, GenValid a) => Spec Source #

A Spec that specifies that genValid only generates valid data.

In general it is a good idea to add this spec to your test suite if you write a custom implementation of genValid.

Example usage:

genValidSpec @Int

genValidGeneratesValid :: forall a. (Show a, GenValid a) => Property Source #

genValid only generates valid data

genValidGeneratesValid @()
genValidGeneratesValid @Bool
genValidGeneratesValid @Ordering
genValidGeneratesValid @Char
genValidGeneratesValid @Int
genValidGeneratesValid @Float
genValidGeneratesValid @Double
genValidGeneratesValid @Integer
genValidGeneratesValid @(Maybe Int)
genValidGeneratesValid @[Int]

genGeneratesValid :: (Show a, Validity a) => Gen a -> Property #

shrinkValidSpec :: forall a. (Show a, Eq a, Typeable a, GenValid a) => Spec Source #

shrinkValidSpecWithLimit :: forall a. (Show a, Eq a, Typeable a, GenValid a) => Int -> Spec Source #

shrinkValidPreservesValidOnGenValid :: forall a. (Show a, GenValid a) => Property Source #

shrinkPreservesValidOnGenValid :: (Show a, GenValid a) => (a -> [a]) -> Property #

shrinkValidPreservesValid :: (Show a, GenValid a) => Gen a -> Property #

shrinkingStaysValid :: (Show a, Validity a) => Gen a -> (a -> [a]) -> Property #

shrinkingPreserves :: Show a => Gen a -> (a -> [a]) -> (a -> Bool) -> Property #

Tests for Arbitrary instances involving Validity

arbitrarySpec :: forall a. (Typeable a, Show a, Validity a, Arbitrary a) => Spec Source #

A Spec that specifies that arbitrary only generates data that satisfy isValid

Example usage:

arbitrarySpec @Int

arbitraryGeneratesOnlyValid :: forall a. (Show a, Validity a, Arbitrary a) => Property Source #

arbitrary only generates valid data

arbitraryGeneratesOnlyValid @Int

Standard tests involving functions

Standard tests involving validity

producesValidsOnGen :: (Show a, Show b, Validity b) => (a -> b) -> Gen a -> (a -> [a]) -> Property #

producesValid :: (Show a, Show b, GenValid a, Validity b) => (a -> b) -> Property #

producesValidsOnArbitrary :: (Show a, Show b, Arbitrary a, Validity b) => (a -> b) -> Property #

producesValidsOnGens2 :: (Show a, Show b, Show c, Validity c) => (a -> b -> c) -> Gen (a, b) -> ((a, b) -> [(a, b)]) -> Property #

producesValid2 :: (Show a, Show b, Show c, GenValid a, GenValid b, Validity c) => (a -> b -> c) -> Property #

producesValidsOnArbitrary2 :: (Show a, Show b, Show c, Arbitrary a, Arbitrary b, Validity c) => (a -> b -> c) -> Property #

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 #

producesValid3 :: (Show a, Show b, Show c, Show d, GenValid a, GenValid b, GenValid c, Validity d) => (a -> b -> c -> d) -> Property #

producesValidsOnArbitrary3 :: (Show a, Show b, Show c, Show d, Arbitrary a, Arbitrary b, Arbitrary c, Validity d) => (a -> b -> c -> d) -> Property #

Standard tests involving functions that can fail

class CanFail (f :: Type -> Type) where #

Methods

hasFailed :: f a -> Bool #

resultIfSucceeded :: f a -> Maybe a #

Instances

Instances details
CanFail Maybe 
Instance details

Defined in Test.Validity.Types

CanFail (Either e) 
Instance details

Defined in Test.Validity.Types

Methods

hasFailed :: Either e a -> Bool #

resultIfSucceeded :: Either e a -> Maybe a #

succeedsOnGen :: (Show a, Show (f b), CanFail f) => (a -> f b) -> Gen a -> (a -> [a]) -> Property #

succeeds :: (Show a, Show (f b), GenValid a, CanFail f) => (a -> f b) -> Property #

succeedsOnArbitrary :: (Show a, Show (f b), Arbitrary a, CanFail f) => (a -> f b) -> Property #

succeedsOnGens2 :: (Show a, Show b, Show (f c), CanFail f) => (a -> b -> f c) -> Gen (a, b) -> ((a, b) -> [(a, b)]) -> Property #

succeeds2 :: (Show a, Show b, Show (f c), GenValid a, GenValid b, CanFail f) => (a -> b -> f c) -> Property #

succeedsOnArbitrary2 :: (Show a, Show b, Show (f c), Arbitrary a, Arbitrary b, CanFail f) => (a -> b -> f c) -> Property #

failsOnGen :: (Show a, Show (f b), CanFail f) => (a -> f b) -> Gen a -> (a -> [a]) -> Property #

failsOnGens2 :: (Show a, Show b, Show (f c), CanFail f) => (a -> b -> f c) -> Gen a -> (a -> [a]) -> Gen b -> (b -> [b]) -> Property #

validIfSucceedsOnGen :: (Show a, Show b, Validity b, CanFail f) => (a -> f b) -> Gen a -> (a -> [a]) -> Property #

validIfSucceedsOnArbitrary :: (Show a, Show b, Arbitrary a, Validity b, CanFail f) => (a -> f b) -> Property #

validIfSucceeds :: (Show a, Show b, GenValid a, Validity b, CanFail f) => (a -> f b) -> Property #

validIfSucceedsOnGens2 :: (Show a, Show b, Show c, Validity c, CanFail f) => (a -> b -> f c) -> Gen (a, b) -> ((a, b) -> [(a, b)]) -> Property #

validIfSucceeds2 :: (Show a, Show b, Show c, GenValid a, GenValid b, Validity c, CanFail f) => (a -> b -> f c) -> Property #

validIfSucceedsOnArbitrary2 :: (Show a, Show b, Show c, Arbitrary a, Arbitrary b, Validity c, CanFail f) => (a -> b -> f c) -> Property #

validIfSucceedsOnGens3 :: (Show a, Show b, Show c, Show d, Validity d, CanFail f) => (a -> b -> c -> f d) -> Gen (a, b, c) -> ((a, b, c) -> [(a, b, c)]) -> Property #

validIfSucceeds3 :: (Show a, Show b, Show c, Show d, GenValid a, GenValid b, GenValid c, Validity d, CanFail f) => (a -> b -> c -> f d) -> Property #

validIfSucceedsOnArbitrary3 :: (Show a, Show b, Show c, Show d, Arbitrary a, Arbitrary b, Arbitrary c, Validity d, CanFail f) => (a -> b -> c -> f d) -> Property #

Standard tests involving equivalence of functions

Simple functions

One argument

equivalentOnGen :: (Show a, Show b, Eq b) => (a -> b) -> (a -> b) -> Gen a -> (a -> [a]) -> Property #

equivalent :: (Show a, GenValid a, Show b, Eq b) => (a -> b) -> (a -> b) -> Property #

equivalentOnArbitrary :: (Show a, Arbitrary a, Show b, Eq b) => (a -> b) -> (a -> b) -> Property #

Two arguments

equivalentOnGens2 :: (Show a, Show b, Show c, Eq c) => (a -> b -> c) -> (a -> b -> c) -> Gen (a, b) -> ((a, b) -> [(a, b)]) -> Property #

equivalent2 :: (Show a, GenValid a, Show b, GenValid b, Show c, Eq c) => (a -> b -> c) -> (a -> b -> c) -> Property #

equivalentOnArbitrary2 :: (Show a, Arbitrary a, Show b, Arbitrary b, Show c, Eq c) => (a -> b -> c) -> (a -> b -> c) -> Property #

Three arguments

equivalentOnGens3 :: (Show a, Show b, Show c, Show d, Eq d) => (a -> b -> c -> d) -> (a -> b -> c -> d) -> Gen (a, b, c) -> ((a, b, c) -> [(a, b, c)]) -> Property #

equivalent3 :: (Show a, GenValid a, Show b, GenValid b, Show c, GenValid c, Show d, Eq d) => (a -> b -> c -> d) -> (a -> b -> c -> d) -> Property #

equivalentOnArbitrary3 :: (Show a, Arbitrary a, Show b, Arbitrary b, Show c, Arbitrary c, Show d, Eq d) => (a -> b -> c -> d) -> (a -> b -> c -> d) -> Property #

First function can fail

One argument

equivalentWhenFirstSucceedsOnGen :: (Show a, Show b, Eq b, CanFail f) => (a -> f b) -> (a -> b) -> Gen a -> (a -> [a]) -> Property #

equivalentWhenFirstSucceeds :: (Show a, GenValid a, Show b, Eq b, CanFail f) => (a -> f b) -> (a -> b) -> Property #

equivalentWhenFirstSucceedsOnArbitrary :: (Show a, Arbitrary a, Show b, Eq b, CanFail f) => (a -> f b) -> (a -> b) -> Property #

Two arguments

equivalentWhenFirstSucceedsOnGens2 :: (Show a, Show b, Show c, Eq c, CanFail f) => (a -> b -> f c) -> (a -> b -> c) -> Gen (a, b) -> ((a, b) -> [(a, b)]) -> Property #

equivalentWhenFirstSucceeds2 :: (Show a, GenValid a, Show b, GenValid b, Show c, Eq c, CanFail f) => (a -> b -> f c) -> (a -> b -> c) -> Property #

equivalentWhenFirstSucceedsOnArbitrary2 :: (Show a, Arbitrary a, Show b, Arbitrary b, Show c, Eq c, CanFail f) => (a -> b -> f c) -> (a -> b -> c) -> Property #

Second function can fail

One argument

equivalentWhenSecondSucceedsOnGen :: (Show a, Show b, Eq b, CanFail f) => (a -> b) -> (a -> f b) -> Gen a -> (a -> [a]) -> Property #

equivalentWhenSecondSucceeds :: (Show a, GenValid a, Show b, Eq b, CanFail f) => (a -> b) -> (a -> f b) -> Property #

equivalentWhenSecondSucceedsOnArbitrary :: (Show a, Arbitrary a, Show b, Eq b, CanFail f) => (a -> b) -> (a -> f b) -> Property #

Two arguments

equivalentWhenSecondSucceedsOnGens2 :: (Show a, Show b, Show c, Eq c, CanFail f) => (a -> b -> c) -> (a -> b -> f c) -> Gen (a, b) -> ((a, b) -> [(a, b)]) -> Property #

equivalentWhenSecondSucceeds2 :: (Show a, GenValid a, Show b, GenValid b, Show c, Eq c, CanFail f) => (a -> b -> c) -> (a -> b -> f c) -> Property #

equivalentWhenSecondSucceedsOnArbitrary2 :: (Show a, Arbitrary a, Show b, Arbitrary b, Show c, Eq c, CanFail f) => (a -> b -> c) -> (a -> b -> f c) -> Property #

Both functions can fail

One argument

equivalentWhenSucceedOnGen :: (Show a, Show b, Eq b, CanFail f) => (a -> f b) -> (a -> f b) -> Gen a -> (a -> [a]) -> Property #

equivalentWhenSucceed :: (Show a, GenValid a, Show b, Eq b, CanFail f) => (a -> f b) -> (a -> f b) -> Property #

equivalentWhenSucceedOnArbitrary :: (Show a, Arbitrary a, Show b, Eq b, CanFail f) => (a -> f b) -> (a -> f b) -> Property #

Two arguments

equivalentWhenSucceedOnGens2 :: (Show a, Show b, Show c, Eq c, CanFail f) => (a -> b -> f c) -> (a -> b -> f c) -> Gen (a, b) -> ((a, b) -> [(a, b)]) -> Property #

equivalentWhenSucceed2 :: (Show a, GenValid a, Show b, GenValid b, Show c, Eq c, CanFail f) => (a -> b -> f c) -> (a -> b -> f c) -> Property #

equivalentWhenSucceedOnArbitrary2 :: (Show a, Arbitrary a, Show b, Arbitrary b, Show c, Eq c, CanFail f) => (a -> b -> f c) -> (a -> b -> f c) -> Property #

Standard tests involving inverse functions

inverseFunctionsOnGen :: (Show a, Eq a) => (a -> b) -> (b -> a) -> Gen a -> (a -> [a]) -> Property #

inverseFunctions :: (Show a, Eq a, GenValid a) => (a -> b) -> (b -> a) -> Property #

inverseFunctionsOnArbitrary :: (Show a, Eq a, Arbitrary a) => (a -> b) -> (b -> a) -> Property #

inverseFunctionsIfFirstSucceedsOnGen :: (Show a, Eq a, CanFail f) => (a -> f b) -> (b -> a) -> Gen a -> (a -> [a]) -> Property #

inverseFunctionsIfFirstSucceeds :: (Show a, Eq a, GenValid a, CanFail f) => (a -> f b) -> (b -> a) -> Property #

inverseFunctionsIfFirstSucceedsOnArbitrary :: (Show a, Eq a, Arbitrary a, CanFail f) => (a -> f b) -> (b -> a) -> Property #

inverseFunctionsIfSecondSucceedsOnGen :: (Show a, Eq a, CanFail f) => (a -> b) -> (b -> f a) -> Gen a -> (a -> [a]) -> Property #

inverseFunctionsIfSecondSucceeds :: (Show a, Eq a, GenValid a, CanFail f) => (a -> b) -> (b -> f a) -> Property #

inverseFunctionsIfSecondSucceedsOnArbitrary :: (Show a, Eq a, Arbitrary a, CanFail f) => (a -> b) -> (b -> f a) -> Property #

inverseFunctionsIfSucceedOnGen :: (Show a, Eq a, CanFail f, CanFail g) => (a -> f b) -> (b -> g a) -> Gen a -> (a -> [a]) -> Property #

inverseFunctionsIfSucceed :: (Show a, Eq a, GenValid a, CanFail f, CanFail g) => (a -> f b) -> (b -> g a) -> Property #

inverseFunctionsIfSucceedOnArbitrary :: (Show a, Eq a, Arbitrary a, CanFail f, CanFail g) => (a -> f b) -> (b -> g a) -> Property #

Properties involving idempotence

idempotentOnGen :: (Show a, Eq a) => (a -> a) -> Gen a -> (a -> [a]) -> Property #

idempotent :: (Show a, Eq a, GenValid a) => (a -> a) -> Property #

idempotentOnArbitrary :: (Show a, Eq a, Arbitrary a) => (a -> a) -> Property #

Properties of relations

Reflexivity

reflexiveOnElem :: (a -> a -> Bool) -> a -> Bool #

reflexivityOnGen :: Show a => (a -> a -> Bool) -> Gen a -> (a -> [a]) -> Property #

reflexivity :: (Show a, GenValid a) => (a -> a -> Bool) -> Property #

reflexivityOnArbitrary :: (Show a, Arbitrary a) => (a -> a -> Bool) -> Property #

Transitivity

transitiveOnElems :: (a -> a -> Bool) -> a -> a -> a -> Bool #

transitivityOnGens :: Show a => (a -> a -> Bool) -> Gen (a, a, a) -> (a -> [a]) -> Property #

transitivity :: (Show a, GenValid a) => (a -> a -> Bool) -> Property #

transitivityOnArbitrary :: (Show a, Arbitrary a) => (a -> a -> Bool) -> Property #

Antisymmetry

antisymmetricOnElemsWithEquality :: (a -> a -> Bool) -> (a -> a -> Bool) -> a -> a -> Bool #

antisymmetryOnGensWithEquality :: Show a => (a -> a -> Bool) -> Gen (a, a) -> (a -> a -> Bool) -> (a -> [a]) -> Property #

antisymmetryOnGens :: (Show a, Eq a) => (a -> a -> Bool) -> Gen (a, a) -> (a -> [a]) -> Property #

antisymmetry :: (Show a, Eq a, GenValid a) => (a -> a -> Bool) -> Property #

antisymmetryOnArbitrary :: (Show a, Eq a, Arbitrary a) => (a -> a -> Bool) -> Property #

Antireflexivity

antireflexiveOnElem :: (a -> a -> Bool) -> a -> Bool #

antireflexivityOnGen :: Show a => (a -> a -> Bool) -> Gen a -> (a -> [a]) -> Property #

antireflexivity :: (Show a, GenValid a) => (a -> a -> Bool) -> Property #

antireflexivityOnArbitrary :: (Show a, Arbitrary a) => (a -> a -> Bool) -> Property #

Symmetry

symmetricOnElems :: (a -> a -> Bool) -> a -> a -> Bool #

symmetryOnGens :: Show a => (a -> a -> Bool) -> Gen (a, a) -> (a -> [a]) -> Property #

symmetry :: (Show a, GenValid a) => (a -> a -> Bool) -> Property #

symmetryOnArbitrary :: (Show a, Arbitrary a) => (a -> a -> Bool) -> Property #

Properties of operations

Identity element

Left Identity

leftIdentityOnElemWithEquality :: (b -> a -> a) -> (a -> a -> Bool) -> b -> a -> Bool #

leftIdentityOnGenWithEquality :: Show a => (b -> a -> a) -> (a -> a -> Bool) -> b -> Gen a -> (a -> [a]) -> Property #

leftIdentityOnGen :: (Show a, Eq a) => (b -> a -> a) -> b -> Gen a -> (a -> [a]) -> Property #

leftIdentity :: (Show a, Eq a, GenValid a) => (b -> a -> a) -> b -> Property #

leftIdentityOnArbitrary :: (Show a, Eq a, Arbitrary a) => (b -> a -> a) -> b -> Property #

Right Identity

rightIdentityOnElemWithEquality :: (a -> b -> a) -> (a -> a -> Bool) -> b -> a -> Bool #

rightIdentityOnGenWithEquality :: Show a => (a -> b -> a) -> (a -> a -> Bool) -> b -> Gen a -> (a -> [a]) -> Property #

rightIdentityOnGen :: (Show a, Eq a) => (a -> b -> a) -> b -> Gen a -> (a -> [a]) -> Property #

rightIdentity :: (Show a, Eq a, GenValid a) => (a -> b -> a) -> b -> Property #

rightIdentityOnArbitrary :: (Show a, Eq a, Arbitrary a) => (a -> b -> a) -> b -> Property #

Identity

identityOnGen :: (Show a, Eq a) => (a -> a -> a) -> a -> Gen a -> (a -> [a]) -> Property #

identity :: (Show a, Eq a, GenValid a) => (a -> a -> a) -> a -> Property #

identityOnArbitrary :: (Show a, Eq a, Arbitrary a) => (a -> a -> a) -> a -> Property #

Associativity

associativeOnGens :: (Show a, Eq a) => (a -> a -> a) -> Gen (a, a, a) -> ((a, a, a) -> [(a, a, a)]) -> Property #

associative :: (Show a, Eq a, GenValid a) => (a -> a -> a) -> Property #

associativeOnArbitrary :: (Show a, Eq a, Arbitrary a) => (a -> a -> a) -> Property #

Commutativity

commutativeOnGens :: (Show a, Show b, Eq b) => (a -> a -> b) -> Gen (a, a) -> ((a, a) -> [(a, a)]) -> Property #

commutative :: (Show a, Show b, Eq b, GenValid a) => (a -> a -> b) -> Property #

commutativeOnArbitrary :: (Show a, Show b, Eq b, Arbitrary a) => (a -> a -> b) -> Property #

Show and Read properties

showReadSpec :: forall a. (Show a, Eq a, Read a, Typeable a, GenValid a) => Spec Source #

Standard test spec for properties of Show and Read instances for valid values

Example usage:

showReadSpec @Int

showReadSpecOnArbitrary :: forall a. (Show a, Eq a, Read a, Typeable a, Arbitrary a) => Spec Source #

Standard test spec for properties of Show and Read instances for arbitrary values

Example usage:

showReadSpecOnArbitrary @Double

showReadSpecOnGen :: forall a. (Show a, Eq a, Read a, Typeable a) => Gen a -> String -> (a -> [a]) -> Spec Source #

Standard test spec for properties of Show and Read instances for values generated by a custom generator

Example usage:

showReadSpecOnGen ((* 2) <$> genValid @Int) "even" (const [])

Eq properties

eqSpec :: forall a. (Show a, Eq a, Typeable a, GenValid a) => Spec Source #

Standard test spec for properties of Eq instances for valid values

Example usage:

eqSpec @Int

eqSpecOnArbitrary :: forall a. (Show a, Eq a, Typeable a, Arbitrary a) => Spec Source #

Standard test spec for properties of Eq instances for arbitrary values

Example usage:

eqSpecOnArbitrary @Int

eqSpecOnGen :: forall a. (Show a, Eq a, Typeable a) => Gen a -> String -> (a -> [a]) -> Spec Source #

Standard test spec for properties of Eq instances for values generated by a given generator (and name for that generator).

Example usage:

eqSpecOnGen ((* 2) <$> genValid @Int) "even"

Ord properties

ordSpecOnGen :: forall a. (Show a, Ord a, Typeable a) => Gen a -> String -> (a -> [a]) -> Spec Source #

Standard test spec for properties of Ord instances for values generated by a given generator (and name for that generator).

Example usage:

ordSpecOnGen ((* 2) <$> genValid @Int) "even"

ordSpec :: forall a. (Show a, Ord a, Typeable a, GenValid a) => Spec Source #

Standard test spec for properties of Ord instances for valid values

Example usage:

ordSpec @Int

ordSpecOnArbitrary :: forall a. (Show a, Ord a, Typeable a, Arbitrary a) => Spec Source #

Standard test spec for properties of Ord instances for arbitrary values

Example usage:

ordSpecOnArbitrary @Int

Monoid properties

monoidSpec :: forall a. (Show a, Eq a, Monoid a, Typeable a, GenValid a) => Spec Source #

Standard test spec for properties of Monoid instances for valid values

Example usage:

monoidSpec @[Int]

monoidSpecOnArbitrary :: forall a. (Show a, Eq a, Monoid a, Typeable a, Arbitrary a) => Spec Source #

Standard test spec for properties of Monoid instances for arbitrary values

Example usage:

monoidSpecOnArbitrary @[Int]

monoidSpecOnGen :: forall a. (Show a, Eq a, Monoid a, Typeable a) => Gen a -> String -> (a -> [a]) -> Spec Source #

Standard test spec for properties of Monoid instances for values generated by a given generator (and name for that generator).

Example usage:

monoidSpecOnGen (pure "a") "singleton list of 'a'"

Functor properties

functorSpec :: forall (f :: Type -> Type). (Eq (f Int), Show (f Int), Functor f, Typeable f, GenValid (f Int)) => Spec Source #

Standard test spec for properties of Functor instances for values generated with GenValid instances

Example usage:

functorSpecOnArbitrary @[]

functorSpecOnArbitrary :: forall (f :: Type -> Type). (Eq (f Int), Show (f Int), Functor f, Typeable f, Arbitrary (f Int)) => Spec Source #

Standard test spec for properties of Functor instances for values generated with Arbitrary instances

Example usage:

functorSpecOnArbitrary @[]

functorSpecOnGens :: forall (f :: Type -> Type) (a :: Type) (b :: Type) (c :: Type). (Show a, Show (f a), Show (f c), Eq (f a), Eq (f c), Functor f, Typeable f, Typeable a, Typeable b, Typeable c) => Gen a -> String -> Gen (f a) -> String -> Gen (b -> c) -> String -> Gen (a -> b) -> String -> Spec Source #

Standard test spec for properties of Functor instances for values generated by given generators (and names for those generator).

Example usage:

functorSpecOnGens
    @[]
    @Int
    (pure 4) "four"
    (genListOf $ pure 5) "list of fives"
    ((+) <$> genValid) "additions"
    ((*) <$> genValid) "multiplications"

Applicative properties

applicativeSpec :: forall (f :: Type -> Type). (HasCallStack, Eq (f Int), Show (f Int), Applicative f, Typeable f, GenValid (f Int)) => Spec Source #

Standard test spec for properties of Applicative instances for values generated with GenValid instances

Example usage:

applicativeSpecOnArbitrary @[]

applicativeSpecOnArbitrary :: forall (f :: Type -> Type). (HasCallStack, Eq (f Int), Show (f Int), Applicative f, Typeable f, Arbitrary (f Int)) => Spec Source #

Standard test spec for properties of Applicative instances for values generated with Arbitrary instances

Example usage:

applicativeSpecOnArbitrary @[]

applicativeSpecOnGens :: forall (f :: Type -> Type) (a :: Type) (b :: Type) (c :: Type). (HasCallStack, Show a, Show (f a), Eq (f a), Show (f b), Eq (f b), Show (f c), Eq (f c), Applicative f, Typeable f, Typeable a, Typeable b, Typeable c) => Gen a -> String -> Gen (f a) -> String -> Gen (f b) -> String -> Gen (a -> b) -> String -> Gen (f (a -> b)) -> String -> Gen (f (b -> c)) -> String -> Spec Source #

Standard test spec for properties of Applicative instances for values generated by given generators (and names for those generator).

Unless you are building a specific regression test, you probably want to use the other applicativeSpec functions.

Example usage:

applicativeSpecOnGens
    @Maybe
    @String
    (pure "ABC")
    "ABC"
    (Just <$> pure "ABC")
    "Just an ABC"
    (pure Nothing)
    "purely Nothing"
    ((++) <$> genValid)
    "prepends"
    (pure <$> ((++) <$> genValid))
    "prepends in a Just"
    (pure <$> (flip (++) <$> genValid))
    "appends in a Just"

Monad properties

monadSpec :: forall (f :: Type -> Type). (Eq (f Int), Show (f Int), Monad f, Typeable f, GenValid (f Int)) => Spec Source #

Standard test spec for properties of Monad instances for values generated with GenValid instances

Example usage:

monadSpec @[]

monadSpecOnArbitrary :: forall (f :: Type -> Type). (Eq (f Int), Show (f Int), Monad f, Typeable f, Arbitrary (f Int)) => Spec Source #

Standard test spec for properties of Monad instances for values generated with Arbitrary instances

Example usage:

monadSpecOnArbitrary @[]

monadSpecOnGens :: forall (f :: Type -> Type) (a :: Type) (b :: Type) (c :: Type). (Show a, Show (f a), Show (f b), Show (f c), Eq (f a), Eq (f b), Eq (f c), Monad f, Typeable f, Typeable a, Typeable b, Typeable c) => Gen a -> String -> Gen (f a) -> String -> Gen (f b) -> String -> Gen (a -> b) -> String -> Gen (a -> f b) -> String -> Gen (b -> f c) -> String -> Gen (f (a -> b)) -> String -> Spec Source #

Standard test spec for properties of Monad instances for values generated by given generators (and names for those generator).

Example usage:

monadSpecOnGens
    @[]
    @Int
    (pure 4)
    "four"
    (genListOf $ pure 5)
    "list of fives"
    (genListOf $ pure 6)
    "list of sixes"
    ((*) <$> genValid)
    "factorisations"
    (pure $ \a -> [a])
    "singletonisation"
    (pure $ \a -> [a])
    "singletonisation"
    (pure $ pure (+ 1))
    "increment in list"

Re-exports