Validity.hs

{-# 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 func gen s = forAllShrink gen s $ shouldBeValid . 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 f = producesValidsOnGen f genValid 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 f = producesValidsOnGen f arbitrary shrink

producesValidsOnGens2 ::
  (Show a, Show b, Show c, Validity c) =>
  (a -> b -> c) ->
  Gen (a, b) ->
  ((a, b) -> [(a, b)]) ->
  Property
producesValidsOnGens2 func gen s =
  forAllShrink gen s $ \(a, b) -> shouldBeValid $ func a b

producesValid2 ::
  (Show a, Show b, Show c, GenValid a, GenValid b, Validity c) =>
  (a -> b -> c) ->
  Property
producesValid2 func = producesValidsOnGens2 func genValid shrinkValid

producesValidsOnArbitrary2 ::
  (Show a, Show b, Show c, Arbitrary a, Arbitrary b, Validity c) =>
  (a -> b -> c) ->
  Property
producesValidsOnArbitrary2 func = producesValidsOnGens2 func arbitrary 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 func gen s =
  forAllShrink gen s $ \(a, b, c) -> shouldBeValid $ func a b c

producesValid3 ::
  ( Show a,
    Show b,
    Show c,
    Show d,
    GenValid a,
    GenValid b,
    GenValid c,
    Validity d
  ) =>
  (a -> b -> c -> d) ->
  Property
producesValid3 func = producesValidsOnGens3 func genValid shrinkValid

producesValidsOnArbitrary3 ::
  ( Show a,
    Show b,
    Show c,
    Show d,
    Arbitrary a,
    Arbitrary b,
    Arbitrary c,
    Validity d
  ) =>
  (a -> b -> c -> d) ->
  Property
producesValidsOnArbitrary3 func = producesValidsOnGens3 func arbitrary shrink