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

-- | Tests for shrinking functions
module Test.Validity.Shrinking.Property
  ( shrinkPreservesValidOnGenValid,
    shrinkValidPreservesValid,
    shrinkingStaysValid,
    shrinkingStaysValidWithLimit,
    shrinkingPreserves,
    shrinkingPreservesWithLimit,
    shrinkDoesNotShrinkToItself,
    shrinkDoesNotShrinkToItselfWithLimit,
    shrinkDoesNotShrinkToItselfOnValid,
    shrinkDoesNotShrinkToItselfOnValidWithLimit,
    doesNotShrinkToItself,
    doesNotShrinkToItselfWithLimit,
  )
where

import Data.GenValidity
import Test.QuickCheck

-- |
--
-- prop> shrinkPreservesValidOnGenValid ((:[]) :: Int -> [Int])
shrinkPreservesValidOnGenValid ::
  forall a.
  (Show a, GenValid a) =>
  (a -> [a]) ->
  Property
shrinkPreservesValidOnGenValid :: (a -> [a]) -> Property
shrinkPreservesValidOnGenValid = Gen a -> (a -> [a]) -> Property
forall a. (Show a, Validity a) => Gen a -> (a -> [a]) -> Property
shrinkingStaysValid Gen a
forall a. GenValid a => Gen a
genValid

-- |
--
-- prop> shrinkValidPreservesValid (pure 5 :: Gen Rational)
shrinkValidPreservesValid ::
  forall a.
  (Show a, GenValid a) =>
  Gen a ->
  Property
shrinkValidPreservesValid :: Gen a -> Property
shrinkValidPreservesValid Gen a
gen = Gen a -> (a -> [a]) -> Property
forall a. (Show a, Validity a) => Gen a -> (a -> [a]) -> Property
shrinkingStaysValid Gen a
gen a -> [a]
forall a. GenValid a => a -> [a]
shrinkValid

-- |
--
-- prop> shrinkingStaysValid (pure 5 :: Gen Double) (\d -> [d - 1, d - 2])
shrinkingStaysValid ::
  forall a.
  (Show a, Validity a) =>
  Gen a ->
  (a -> [a]) ->
  Property
shrinkingStaysValid :: Gen a -> (a -> [a]) -> Property
shrinkingStaysValid Gen a
gen a -> [a]
s = Gen a -> (a -> [a]) -> (a -> Bool) -> Property
forall a. Show a => Gen a -> (a -> [a]) -> (a -> Bool) -> Property
shrinkingPreserves Gen a
gen a -> [a]
s a -> Bool
forall a. Validity a => a -> Bool
isValid

-- |
--
-- prop> shrinkingStaysValidWithLimit (pure 5 :: Gen Double) (\d -> [d - 1, read "NaN"]) 1
shrinkingStaysValidWithLimit ::
  forall a.
  (Show a, Validity a) =>
  Gen a ->
  (a -> [a]) ->
  Int ->
  Property
shrinkingStaysValidWithLimit :: Gen a -> (a -> [a]) -> Int -> Property
shrinkingStaysValidWithLimit Gen a
gen a -> [a]
s Int
l =
  Gen a -> (a -> [a]) -> Int -> (a -> Bool) -> Property
forall a.
Show a =>
Gen a -> (a -> [a]) -> Int -> (a -> Bool) -> Property
shrinkingPreservesWithLimit Gen a
gen a -> [a]
s Int
l a -> Bool
forall a. Validity a => a -> Bool
isValid

-- |
--
-- prop> shrinkingPreserves (pure 5 :: Gen Int) (:[]) (== 5)
shrinkingPreserves ::
  forall a.
  Show a =>
  Gen a ->
  (a -> [a]) ->
  (a -> Bool) ->
  Property
shrinkingPreserves :: Gen a -> (a -> [a]) -> (a -> Bool) -> Property
shrinkingPreserves Gen a
gen a -> [a]
s a -> Bool
p = Gen a -> (a -> Bool) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll Gen a
gen ((a -> Bool) -> Property) -> (a -> Bool) -> Property
forall a b. (a -> b) -> a -> b
$ \a
d -> Bool -> Bool
not (a -> Bool
p a
d) Bool -> Bool -> Bool
|| (a -> Bool) -> [a] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all a -> Bool
p (a -> [a]
s a
d)

-- |
--
-- prop> shrinkingPreservesWithLimit (pure 4) (:[]) 100 (== 4)
shrinkingPreservesWithLimit ::
  forall a.
  Show a =>
  Gen a ->
  (a -> [a]) ->
  Int ->
  (a -> Bool) ->
  Property
shrinkingPreservesWithLimit :: Gen a -> (a -> [a]) -> Int -> (a -> Bool) -> Property
shrinkingPreservesWithLimit Gen a
gen a -> [a]
s Int
l a -> Bool
p =
  Gen a -> (a -> Bool) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll Gen a
gen ((a -> Bool) -> Property) -> (a -> Bool) -> Property
forall a b. (a -> b) -> a -> b
$ \a
d -> Bool -> Bool
not (a -> Bool
p a
d) Bool -> Bool -> Bool
|| (a -> Bool) -> [a] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all a -> Bool
p (Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
take Int
l ([a] -> [a]) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$ a -> [a]
s a
d)

-- |
--
-- prop> shrinkDoesNotShrinkToItself (shrinkValid :: Double -> [Double])
shrinkDoesNotShrinkToItself ::
  forall a.
  (Show a, Eq a, GenValid a) =>
  (a -> [a]) ->
  Property
shrinkDoesNotShrinkToItself :: (a -> [a]) -> Property
shrinkDoesNotShrinkToItself = Gen a -> (a -> [a]) -> Property
forall a. (Show a, Eq a) => Gen a -> (a -> [a]) -> Property
doesNotShrinkToItself Gen a
forall a. GenValid a => Gen a
genValid

-- |
--
-- prop> shrinkDoesNotShrinkToItselfWithLimit (shrinkValid :: Double -> [Double]) 100
shrinkDoesNotShrinkToItselfWithLimit ::
  forall a.
  (Show a, Eq a, GenValid a) =>
  (a -> [a]) ->
  Int ->
  Property
shrinkDoesNotShrinkToItselfWithLimit :: (a -> [a]) -> Int -> Property
shrinkDoesNotShrinkToItselfWithLimit =
  Gen a -> (a -> [a]) -> Int -> Property
forall a. (Show a, Eq a) => Gen a -> (a -> [a]) -> Int -> Property
doesNotShrinkToItselfWithLimit Gen a
forall a. GenValid a => Gen a
genValid

-- |
--
-- prop> shrinkDoesNotShrinkToItselfOnValid (shrinkValid ::  Rational -> [Rational])
shrinkDoesNotShrinkToItselfOnValid ::
  forall a.
  (Show a, Eq a, GenValid a) =>
  (a -> [a]) ->
  Property
shrinkDoesNotShrinkToItselfOnValid :: (a -> [a]) -> Property
shrinkDoesNotShrinkToItselfOnValid = Gen a -> (a -> [a]) -> Property
forall a. (Show a, Eq a) => Gen a -> (a -> [a]) -> Property
doesNotShrinkToItself Gen a
forall a. GenValid a => Gen a
genValid

-- |
--
-- prop> shrinkDoesNotShrinkToItselfOnValidWithLimit (shrinkValid :: Rational -> [Rational]) 100
shrinkDoesNotShrinkToItselfOnValidWithLimit ::
  forall a.
  (Show a, Eq a, GenValid a) =>
  (a -> [a]) ->
  Int ->
  Property
shrinkDoesNotShrinkToItselfOnValidWithLimit :: (a -> [a]) -> Int -> Property
shrinkDoesNotShrinkToItselfOnValidWithLimit =
  Gen a -> (a -> [a]) -> Int -> Property
forall a. (Show a, Eq a) => Gen a -> (a -> [a]) -> Int -> Property
doesNotShrinkToItselfWithLimit Gen a
forall a. GenValid a => Gen a
genValid

-- |
--
-- prop> doesNotShrinkToItself (pure 5 :: Gen Double) shrinkValid
doesNotShrinkToItself ::
  forall a.
  (Show a, Eq a) =>
  Gen a ->
  (a -> [a]) ->
  Property
doesNotShrinkToItself :: Gen a -> (a -> [a]) -> Property
doesNotShrinkToItself Gen a
gen a -> [a]
s = Gen a -> (a -> Bool) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll Gen a
gen ((a -> Bool) -> Property) -> (a -> Bool) -> Property
forall a b. (a -> b) -> a -> b
$ \a
a -> a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
notElem a
a ([a] -> Bool) -> [a] -> Bool
forall a b. (a -> b) -> a -> b
$ a -> [a]
s a
a

-- |
--
-- prop> doesNotShrinkToItselfWithLimit (pure 5 :: Gen Double) shrinkValid 100
doesNotShrinkToItselfWithLimit ::
  forall a.
  (Show a, Eq a) =>
  Gen a ->
  (a -> [a]) ->
  Int ->
  Property
doesNotShrinkToItselfWithLimit :: Gen a -> (a -> [a]) -> Int -> Property
doesNotShrinkToItselfWithLimit Gen a
gen a -> [a]
s Int
l =
  Gen a -> (a -> Bool) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll Gen a
gen ((a -> Bool) -> Property) -> (a -> Bool) -> Property
forall a b. (a -> b) -> a -> b
$ \a
a -> a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
notElem a
a ([a] -> Bool) -> [a] -> Bool
forall a b. (a -> b) -> a -> b
$ Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
take Int
l ([a] -> [a]) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$ a -> [a]
s a
a