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

-- | Tests for shrinking functions
module Test.Syd.Validity.Shrinking.Property
    ( shrinkPreservesValidOnGenValid
    , shrinkPreservesInvalidOnGenInvalid
    , shrinkValidPreservesValid
    , shrinkInvalidPreservesInvalid
    , shrinkingStaysValid
    , shrinkingStaysValidWithLimit
    , shrinkingStaysInvalid
    , shrinkingPreserves
    , shrinkingPreservesWithLimit
    , shrinkDoesNotShrinkToItself
    , shrinkDoesNotShrinkToItselfWithLimit
    , shrinkDoesNotShrinkToItselfOnValid
    , shrinkDoesNotShrinkToItselfOnValidWithLimit
    , shrinkDoesNotShrinkToItselfOnInvalid
    , shrinkDoesNotShrinkToItselfOnInvalidWithLimit
    , 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> shrinkPreservesInvalidOnGenInvalid ((:[]) :: Rational -> [Rational])
shrinkPreservesInvalidOnGenInvalid ::
       forall a. (Show a, GenInvalid a)
    => (a -> [a])
    -> Property
shrinkPreservesInvalidOnGenInvalid :: (a -> [a]) -> Property
shrinkPreservesInvalidOnGenInvalid = Gen a -> (a -> [a]) -> Property
forall a. (Show a, Validity a) => Gen a -> (a -> [a]) -> Property
shrinkingStaysValid Gen a
forall a. GenInvalid a => Gen a
genInvalid

-- |
--
-- 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

-- |
--
shrinkInvalidPreservesInvalid ::
       forall a. (Show a, GenInvalid a)
    => Gen a
    -> Property
shrinkInvalidPreservesInvalid :: Gen a -> Property
shrinkInvalidPreservesInvalid 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. GenInvalid a => a -> [a]
shrinkInvalid

-- |
--
-- 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> shrinkingStaysInvalid (pure (1/0) :: Gen Double) (:[])
shrinkingStaysInvalid ::
       forall a. (Show a, Validity a)
    => Gen a
    -> (a -> [a])
    -> Property
shrinkingStaysInvalid :: Gen a -> (a -> [a]) -> Property
shrinkingStaysInvalid 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
isInvalid

-- |
--
-- 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 (shrinkUnchecked :: Double -> [Double])
shrinkDoesNotShrinkToItself ::
       forall a. (Show a, Eq a, GenUnchecked 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. GenUnchecked a => Gen a
genUnchecked

-- |
--
-- prop> shrinkDoesNotShrinkToItselfWithLimit (shrinkUnchecked :: Double -> [Double]) 100
shrinkDoesNotShrinkToItselfWithLimit ::
       forall a. (Show a, Eq a, GenUnchecked 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. GenUnchecked a => Gen a
genUnchecked

-- |
--
-- 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> shrinkDoesNotShrinkToItselfOnInvalid (shrinkInvalid :: Rational -> [Rational])
shrinkDoesNotShrinkToItselfOnInvalid ::
       forall a. (Show a, Eq a, GenInvalid a)
    => (a -> [a])
    -> Property
shrinkDoesNotShrinkToItselfOnInvalid :: (a -> [a]) -> Property
shrinkDoesNotShrinkToItselfOnInvalid = Gen a -> (a -> [a]) -> Property
forall a. (Show a, Eq a) => Gen a -> (a -> [a]) -> Property
doesNotShrinkToItself Gen a
forall a. GenInvalid a => Gen a
genInvalid

-- |
--
-- prop> shrinkDoesNotShrinkToItselfOnInvalidWithLimit (shrinkInvalid :: Rational -> [Rational]) 100
shrinkDoesNotShrinkToItselfOnInvalidWithLimit ::
       forall a. (Show a, Eq a, GenInvalid a)
    => (a -> [a])
    -> Int
    -> Property
shrinkDoesNotShrinkToItselfOnInvalidWithLimit :: (a -> [a]) -> Int -> Property
shrinkDoesNotShrinkToItselfOnInvalidWithLimit =
    Gen a -> (a -> [a]) -> Int -> Property
forall a. (Show a, Eq a) => Gen a -> (a -> [a]) -> Int -> Property
doesNotShrinkToItselfWithLimit Gen a
forall a. GenInvalid a => Gen a
genInvalid

-- |
--
-- prop> doesNotShrinkToItself (pure 5 :: Gen Double) shrinkUnchecked
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 -> Bool) -> [a] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
a) ([a] -> Bool) -> [a] -> Bool
forall a b. (a -> b) -> a -> b
$ a -> [a]
s a
a

-- |
--
-- prop> doesNotShrinkToItselfWithLimit (pure 5 :: Gen Double) shrinkUnchecked 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 -> Bool) -> [a] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= 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