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

-- | Tests for Shrinking functions
--
-- You will need @TypeApplications@ to use these.
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