{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}

-- | Standard tests involving validity
module Test.Validity.Functions.Validity
  ( producesValidsOnGen,
    producesValid,
    producesValidsOnArbitrary,
    producesValidsOnGens2,
    producesValid2,
    producesValidsOnArbitrary2,
    producesValidsOnGens3,
    producesValid3,
    producesValidsOnArbitrary3,
  )
where

import Data.GenValidity
import Test.QuickCheck
import Test.Validity.Property.Utils

-- | The function produces valid output when the input is generated as
-- specified by the given generator.
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

-- | The function produces valid output when the input is generated by
-- @genValid@
producesValid ::
  (Show a, Show b, GenValid 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. GenValid a => Gen a
genValid a -> [a]
forall a. GenValid a => a -> [a]
shrinkValid

-- | The function produces valid output when the input is generated by
-- @arbitrary@
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

producesValid2 ::
  (Show a, Show b, Show c, GenValid a, GenValid 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. GenValid a => Gen a
genValid (a, b) -> [(a, b)]
forall a. GenValid a => a -> [a]
shrinkValid

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

producesValid3 ::
  ( Show a,
    Show b,
    Show c,
    Show d,
    GenValid a,
    GenValid b,
    GenValid 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. GenValid a => Gen a
genValid (a, b, c) -> [(a, b, c)]
forall a. GenValid a => a -> [a]
shrinkValid

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