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

-- | Tests for Shrinking functions
--
-- You will need @TypeApplications@ to use these.
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 :: forall a. (Show a, Eq a, Typeable a, GenValid a) => Spec
shrinkValidSpec =
  forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe (String
"shrinkValid :: " forall a. [a] -> [a] -> [a]
++ forall {k} (a :: k). Typeable a => String
nameOf @(a -> [a])) forall a b. (a -> b) -> a -> b
$ do
    forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"preserves validity" forall a b. (a -> b) -> a -> b
$
      forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll (forall a. GenValid a => Gen a
genValid @a) forall a b. (a -> b) -> a -> b
$
        \a
a -> forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (forall a. GenValid a => a -> [a]
shrinkValid a
a) forall a. (Show a, Validity a) => a -> IO ()
shouldBeValid
    forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"never shrinks to itself for valid values" forall a b. (a -> b) -> a -> b
$
      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 :: forall a. (Show a, Eq a, Typeable a, GenValid a) => Int -> Spec
shrinkValidSpecWithLimit Int
l =
  forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe (String
"shrinkValid :: " forall a. [a] -> [a] -> [a]
++ forall {k} (a :: k). Typeable a => String
nameOf @(a -> [a])) forall a b. (a -> b) -> a -> b
$ do
    forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it ([String] -> String
unwords [String
"preserves validity for the first", forall a. Show a => a -> String
show Int
l, String
"elements"]) forall a b. (a -> b) -> a -> b
$
      forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll (forall a. GenValid a => Gen a
genValid @a) forall a b. (a -> b) -> a -> b
$ \a
a ->
        forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (forall a. Int -> [a] -> [a]
take Int
l forall a b. (a -> b) -> a -> b
$ forall a. GenValid a => a -> [a]
shrinkValid a
a) forall a. (Show a, Validity a) => a -> IO ()
shouldBeValid
    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",
            forall a. Show a => a -> String
show Int
l,
            String
"elements"
          ]
      )
      forall a b. (a -> b) -> a -> b
$ forall a. (Show a, Eq a, GenValid a) => Int -> Property
shrinkValidDoesNotShrinkToItselfWithLimit @a Int
l

shrinkValidPreservesValidOnGenValid ::
  forall a.
  (Show a, GenValid a) =>
  Property
shrinkValidPreservesValidOnGenValid :: forall a. (Show a, GenValid a) => Property
shrinkValidPreservesValidOnGenValid =
  forall a. (Show a, Validity a) => Gen a -> (a -> [a]) -> Property
shrinkingStaysValid @a forall a. GenValid a => Gen a
genValid forall a. GenValid a => a -> [a]
shrinkValid

shrinkValidPreservesValidOnGenValidWithLimit ::
  forall a.
  (Show a, GenValid a) =>
  Int ->
  Property
shrinkValidPreservesValidOnGenValidWithLimit :: forall a. (Show a, GenValid a) => Int -> Property
shrinkValidPreservesValidOnGenValidWithLimit =
  forall a.
(Show a, Validity a) =>
Gen a -> (a -> [a]) -> Int -> Property
shrinkingStaysValidWithLimit @a forall a. GenValid a => Gen a
genValid forall a. GenValid a => a -> [a]
shrinkValid

shrinkValidDoesNotShrinkToItself ::
  forall a.
  (Show a, Eq a, GenValid a) =>
  Property
shrinkValidDoesNotShrinkToItself :: forall a. (Show a, Eq a, GenValid a) => Property
shrinkValidDoesNotShrinkToItself =
  forall a. (Show a, Eq a, GenValid a) => (a -> [a]) -> Property
shrinkDoesNotShrinkToItself @a forall a. GenValid a => a -> [a]
shrinkValid

shrinkValidDoesNotShrinkToItselfWithLimit ::
  forall a.
  (Show a, Eq a, GenValid a) =>
  Int ->
  Property
shrinkValidDoesNotShrinkToItselfWithLimit :: forall a. (Show a, Eq a, GenValid a) => Int -> Property
shrinkValidDoesNotShrinkToItselfWithLimit =
  forall a.
(Show a, Eq a, GenValid a) =>
(a -> [a]) -> Int -> Property
shrinkDoesNotShrinkToItselfOnValidWithLimit @a forall a. GenValid a => a -> [a]
shrinkValid