{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Test.Syd.Validity.Shrinking
( shrinkValiditySpec
, shrinkValidSpec
, shrinkValidSpecWithLimit
, shrinkInvalidSpec
, shrinkValidPreservesValidOnGenValid
, shrinkValidPreservesValidOnGenValidWithLimit
, shrinkInvalidPreservesInvalidOnGenInvalid
, shrinkPreservesValidOnGenValid
, shrinkPreservesInvalidOnGenInvalid
, shrinkValidPreservesValid
, shrinkInvalidPreservesInvalid
, shrinkingStaysValid
, shrinkingStaysInvalid
, shrinkingPreserves
, shrinkUncheckedDoesNotShrinkToItself
, shrinkUncheckedDoesNotShrinkToItselfWithLimit
, shrinkValidDoesNotShrinkToItself
, shrinkValidDoesNotShrinkToItselfWithLimit
, shrinkInvalidDoesNotShrinkToItself
, shrinkInvalidDoesNotShrinkToItselfWithLimit
) where
import Data.Data
import Data.GenValidity
import Control.Monad
import Test.Syd
import Test.QuickCheck
import Test.Syd.Validity.Shrinking.Property
import Test.Syd.Validity.Utils
shrinkValiditySpec ::
forall a. (Show a, Eq a, Typeable a, GenValid a, GenInvalid a)
=> Spec
shrinkValiditySpec :: Spec
shrinkValiditySpec = do
(Show a, Eq a, Typeable a, GenValid a) => Spec
forall a. (Show a, Eq a, Typeable a, GenValid a) => Spec
shrinkValidSpec @a
(Show a, Typeable a, GenInvalid a) => Spec
forall a. (Show a, Typeable a, GenInvalid a) => Spec
shrinkInvalidSpec @a
shrinkValidSpec ::
forall a. (Show a, Eq a, Typeable a, GenValid a)
=> Spec
shrinkValidSpec :: Spec
shrinkValidSpec =
String -> Spec -> Spec
forall (outers :: [*]) inner.
String -> TestDefM outers inner () -> TestDefM outers inner ()
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 -> Spec
forall (outers :: [*]) inner test.
(HasCallStack, IsTest test, Arg1 test ~ (), Arg2 test ~ inner) =>
String -> test -> TestDefM outers inner ()
it String
"preserves validity" (Property -> Spec) -> Property -> Spec
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 -> Spec
forall (outers :: [*]) inner test.
(HasCallStack, IsTest test, Arg1 test ~ (), Arg2 test ~ inner) =>
String -> test -> TestDefM outers inner ()
it String
"never shrinks to itself for valid values" (Property -> Spec) -> Property -> Spec
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 (outers :: [*]) inner.
String -> TestDefM outers inner () -> TestDefM outers inner ()
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 -> Spec
forall (outers :: [*]) inner test.
(HasCallStack, IsTest test, Arg1 test ~ (), Arg2 test ~ inner) =>
String -> test -> TestDefM outers inner ()
it ([String] -> String
unwords [String
"preserves validity for the first", Int -> String
forall a. Show a => a -> String
show Int
l, String
"elements"]) (Property -> Spec) -> Property -> Spec
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 -> Spec
forall (outers :: [*]) inner test.
(HasCallStack, IsTest test, Arg1 test ~ (), Arg2 test ~ inner) =>
String -> test -> TestDefM outers inner ()
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 -> Spec) -> Property -> Spec
forall a b. (a -> b) -> a -> b
$
Int -> Property
forall a. (Show a, Eq a, GenValid a) => Int -> Property
shrinkValidDoesNotShrinkToItselfWithLimit @a Int
l
shrinkInvalidSpec ::
forall a. (Show a, Typeable a, GenInvalid a)
=> Spec
shrinkInvalidSpec :: Spec
shrinkInvalidSpec =
String -> Spec -> Spec
forall (outers :: [*]) inner.
String -> TestDefM outers inner () -> TestDefM outers inner ()
describe (String
"shrinkInvalid :: " 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 -> Spec
forall (outers :: [*]) inner test.
(HasCallStack, IsTest test, Arg1 test ~ (), Arg2 test ~ inner) =>
String -> test -> TestDefM outers inner ()
it String
"preserves invalidity" (Property -> Spec) -> Property -> Spec
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 (GenInvalid a => Gen a
forall a. GenInvalid a => Gen a
genInvalid @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. GenInvalid a => a -> [a]
shrinkInvalid a
a) a -> IO ()
forall a. (Show a, Validity a) => a -> IO ()
shouldBeInvalid
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
shrinkInvalidPreservesInvalidOnGenInvalid ::
forall a. (Show a, GenInvalid a)
=> Property
shrinkInvalidPreservesInvalidOnGenInvalid :: Property
shrinkInvalidPreservesInvalidOnGenInvalid =
Gen a -> (a -> [a]) -> Property
forall a. (Show a, Validity a) => Gen a -> (a -> [a]) -> Property
shrinkingStaysInvalid @a Gen a
forall a. GenInvalid a => Gen a
genInvalid a -> [a]
forall a. GenInvalid a => a -> [a]
shrinkInvalid
shrinkUncheckedDoesNotShrinkToItself ::
forall a. (Show a, Eq a, GenUnchecked a)
=> Property
shrinkUncheckedDoesNotShrinkToItself :: Property
shrinkUncheckedDoesNotShrinkToItself =
(a -> [a]) -> Property
forall a. (Show a, Eq a, GenUnchecked a) => (a -> [a]) -> Property
shrinkDoesNotShrinkToItself @a a -> [a]
forall a. GenUnchecked a => a -> [a]
shrinkUnchecked
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
shrinkDoesNotShrinkToItselfOnValid @a a -> [a]
forall a. GenValid a => a -> [a]
shrinkValid
shrinkInvalidDoesNotShrinkToItself ::
forall a. (Show a, Eq a, GenInvalid a)
=> Property
shrinkInvalidDoesNotShrinkToItself :: Property
shrinkInvalidDoesNotShrinkToItself =
(a -> [a]) -> Property
forall a. (Show a, Eq a, GenInvalid a) => (a -> [a]) -> Property
shrinkDoesNotShrinkToItselfOnInvalid @a a -> [a]
forall a. GenInvalid a => a -> [a]
shrinkInvalid
shrinkInvalidDoesNotShrinkToItselfWithLimit ::
forall a. (Show a, Eq a, GenInvalid a)
=> Int
-> Property
shrinkInvalidDoesNotShrinkToItselfWithLimit :: Int -> Property
shrinkInvalidDoesNotShrinkToItselfWithLimit =
(a -> [a]) -> Int -> Property
forall a.
(Show a, Eq a, GenInvalid a) =>
(a -> [a]) -> Int -> Property
shrinkDoesNotShrinkToItselfOnInvalidWithLimit @a a -> [a]
forall a. GenInvalid a => a -> [a]
shrinkInvalid
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
shrinkUncheckedDoesNotShrinkToItselfWithLimit ::
forall a. (Show a, Eq a, GenUnchecked a)
=> Int
-> Property
shrinkUncheckedDoesNotShrinkToItselfWithLimit :: Int -> Property
shrinkUncheckedDoesNotShrinkToItselfWithLimit =
(a -> [a]) -> Int -> Property
forall a.
(Show a, Eq a, GenUnchecked a) =>
(a -> [a]) -> Int -> Property
shrinkDoesNotShrinkToItselfWithLimit @a a -> [a]
forall a. GenUnchecked a => a -> [a]
shrinkUnchecked