    {-# 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 =
      String -> Spec -> Spec
    forall a. HasCallStack => String -> SpecWith a -> SpecWith a
    describe (String
    "shrinkValid :: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ forall a. Typeable 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 (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
    $
          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 =
      String -> Spec -> Spec
    forall a. HasCallStack => String -> SpecWith a -> SpecWith a
    describe (String
    "shrinkValid :: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ forall a. Typeable 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 (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
    $ 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 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 :: forall a. (Show a, GenValid a) => Int -> Property
    shrinkValidPreservesValidOnGenValidWithLimit =
      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 :: forall a. (Show a, Eq a, GenValid a) => Property
    shrinkValidDoesNotShrinkToItself =
      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 :: 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 a -> [a]
    forall a. GenValid a => a -> [a]
    shrinkValid