{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
module Test.Validity.Shrinking
( shrinkValidSpec,
shrinkValidSpecWithLimit,
shrinkValidPreservesValidOnGenValid,
shrinkValidPreservesValidOnGenValidWithLimit,
shrinkPreservesValidOnGenValid,
shrinkValidPreservesValid,
shrinkingStaysValid,
shrinkingPreserves,
shrinkValidDoesNotShrinkToItself,
shrinkValidDoesNotShrinkToItselfWithLimit,
)
where
import Control.Monad
import Data.Data
import Data.GenValidity
import Test.Hspec
import Test.QuickCheck
import Test.Validity.Shrinking.Property
import Test.Validity.Utils
shrinkValidSpec ::
forall a.
(Show a, Eq a, Typeable a, GenValid a) =>
Spec
shrinkValidSpec :: Spec
shrinkValidSpec =
String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe (String
"shrinkValid :: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Typeable (a -> [a]) => String
forall k (a :: k). Typeable a => String
nameOf @(a -> [a])) (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
String -> Property -> SpecWith (Arg Property)
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"preserves validity" (Property -> SpecWith (Arg Property))
-> Property -> SpecWith (Arg Property)
forall a b. (a -> b) -> a -> b
$
Gen a -> (a -> IO ()) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll (GenValid a => Gen a
forall a. GenValid a => Gen a
genValid @a) ((a -> IO ()) -> Property) -> (a -> IO ()) -> Property
forall a b. (a -> b) -> a -> b
$ \a
a -> [a] -> (a -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (a -> [a]
forall a. GenValid a => a -> [a]
shrinkValid a
a) a -> IO ()
forall a. (Show a, Validity a) => a -> IO ()
shouldBeValid
String -> Property -> SpecWith (Arg Property)
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"never shrinks to itself for valid values" (Property -> SpecWith (Arg Property))
-> Property -> SpecWith (Arg Property)
forall a b. (a -> b) -> a -> b
$
(Show a, Eq a, GenValid a) => Property
forall a. (Show a, Eq a, GenValid a) => Property
shrinkValidDoesNotShrinkToItself @a
shrinkValidSpecWithLimit ::
forall a.
(Show a, Eq a, Typeable a, GenValid a) =>
Int ->
Spec
shrinkValidSpecWithLimit :: Int -> Spec
shrinkValidSpecWithLimit Int
l =
String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe (String
"shrinkValid :: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Typeable (a -> [a]) => String
forall k (a :: k). Typeable a => String
nameOf @(a -> [a])) (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
String -> Property -> SpecWith (Arg Property)
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it ([String] -> String
unwords [String
"preserves validity for the first", Int -> String
forall a. Show a => a -> String
show Int
l, String
"elements"]) (Property -> SpecWith (Arg Property))
-> Property -> SpecWith (Arg Property)
forall a b. (a -> b) -> a -> b
$
Gen a -> (a -> IO ()) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll (GenValid a => Gen a
forall a. GenValid a => Gen a
genValid @a) ((a -> IO ()) -> Property) -> (a -> IO ()) -> Property
forall a b. (a -> b) -> a -> b
$ \a
a ->
[a] -> (a -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
take Int
l ([a] -> [a]) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$ a -> [a]
forall a. GenValid a => a -> [a]
shrinkValid a
a) a -> IO ()
forall a. (Show a, Validity a) => a -> IO ()
shouldBeValid
String -> Property -> SpecWith (Arg Property)
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it
( [String] -> String
unwords
[ String
"never shrinks to itself for valid values for the first",
Int -> String
forall a. Show a => a -> String
show Int
l,
String
"elements"
]
)
(Property -> SpecWith (Arg Property))
-> Property -> SpecWith (Arg Property)
forall a b. (a -> b) -> a -> b
$ Int -> Property
forall a. (Show a, Eq a, GenValid a) => Int -> Property
shrinkValidDoesNotShrinkToItselfWithLimit @a Int
l
shrinkValidPreservesValidOnGenValid ::
forall a.
(Show a, GenValid a) =>
Property
shrinkValidPreservesValidOnGenValid :: Property
shrinkValidPreservesValidOnGenValid =
Gen a -> (a -> [a]) -> Property
forall a. (Show a, Validity a) => Gen a -> (a -> [a]) -> Property
shrinkingStaysValid @a Gen a
forall a. GenValid a => Gen a
genValid a -> [a]
forall a. GenValid a => a -> [a]
shrinkValid
shrinkValidPreservesValidOnGenValidWithLimit ::
forall a.
(Show a, GenValid a) =>
Int ->
Property
shrinkValidPreservesValidOnGenValidWithLimit :: Int -> Property
shrinkValidPreservesValidOnGenValidWithLimit =
Gen a -> (a -> [a]) -> Int -> Property
forall a.
(Show a, Validity a) =>
Gen a -> (a -> [a]) -> Int -> Property
shrinkingStaysValidWithLimit @a Gen a
forall a. GenValid a => Gen a
genValid a -> [a]
forall a. GenValid a => a -> [a]
shrinkValid
shrinkValidDoesNotShrinkToItself ::
forall a.
(Show a, Eq a, GenValid a) =>
Property
shrinkValidDoesNotShrinkToItself :: Property
shrinkValidDoesNotShrinkToItself =
(a -> [a]) -> Property
forall a. (Show a, Eq a, GenValid a) => (a -> [a]) -> Property
shrinkDoesNotShrinkToItself @a a -> [a]
forall a. GenValid a => a -> [a]
shrinkValid
shrinkValidDoesNotShrinkToItselfWithLimit ::
forall a.
(Show a, Eq a, GenValid a) =>
Int ->
Property
shrinkValidDoesNotShrinkToItselfWithLimit :: Int -> Property
shrinkValidDoesNotShrinkToItselfWithLimit =
(a -> [a]) -> Int -> Property
forall a.
(Show a, Eq a, GenValid a) =>
(a -> [a]) -> Int -> Property
shrinkDoesNotShrinkToItselfOnValidWithLimit @a a -> [a]
forall a. GenValid a => a -> [a]
shrinkValid