packages feed

genvalidity-hspec 0.4.0.0 → 0.5.0.0

raw patch · 23 files changed

+464/−324 lines, 23 filesdep ~genvaliditydep ~genvalidity-propertydep ~validityPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: genvalidity, genvalidity-property, validity

API changes (from Hackage documentation)

- Test.Validity.Utils: (<==>) :: Bool -> Bool -> Bool
- Test.Validity.Utils: (===>) :: Bool -> Bool -> Bool
- Test.Validity.Utils: data Anon a
+ Test.Validity: forAllInvalid :: (Show a, GenInvalid a, Testable prop) => (a -> prop) -> Property
+ Test.Validity: forAllUnchecked :: (Show a, GenUnchecked a, Testable prop) => (a -> prop) -> Property
+ Test.Validity: forAllValid :: (Show a, GenValid a, Testable prop) => (a -> prop) -> Property
+ Test.Validity: shouldBeInvalid :: (Show a, Validity a) => a -> Expectation
+ Test.Validity: shouldBeValid :: (Show a, Validity a) => a -> Expectation
+ Test.Validity: shrinkInvalidPreservesInvalid :: (Show a, GenInvalid a) => Gen a -> Property
+ Test.Validity: shrinkInvalidPreservesInvalidOnGenInvalid :: forall a. (Show a, GenInvalid a) => Property
+ Test.Validity: shrinkInvalidSpec :: forall a. (Show a, Typeable a, GenInvalid a) => Spec
+ Test.Validity: shrinkPreservesInvalidOnGenInvalid :: (Show a, GenInvalid a) => (a -> [a]) -> Property
+ Test.Validity: shrinkPreservesValidOnGenValid :: (Show a, GenValid a) => (a -> [a]) -> Property
+ Test.Validity: shrinkValidPreservesValid :: (Show a, GenValid a) => Gen a -> Property
+ Test.Validity: shrinkValidPreservesValidOnGenValid :: forall a. (Show a, GenValid a) => Property
+ Test.Validity: shrinkValidSpec :: forall a. (Show a, Typeable a, GenValid a) => Spec
+ Test.Validity: shrinkValiditySpec :: forall a. (Show a, Typeable a, GenValid a, GenInvalid a) => Spec
+ Test.Validity: shrinkingPreserves :: Show a => Gen a -> (a -> [a]) -> (a -> Bool) -> Property
+ Test.Validity: shrinkingStaysInvalid :: (Show a, Validity a) => Gen a -> (a -> [a]) -> Property
+ Test.Validity: shrinkingStaysValid :: (Show a, Validity a) => Gen a -> (a -> [a]) -> Property
+ Test.Validity.Shrinking: shrinkInvalidPreservesInvalid :: (Show a, GenInvalid a) => Gen a -> Property
+ Test.Validity.Shrinking: shrinkInvalidPreservesInvalidOnGenInvalid :: forall a. (Show a, GenInvalid a) => Property
+ Test.Validity.Shrinking: shrinkInvalidSpec :: forall a. (Show a, Typeable a, GenInvalid a) => Spec
+ Test.Validity.Shrinking: shrinkPreservesInvalidOnGenInvalid :: (Show a, GenInvalid a) => (a -> [a]) -> Property
+ Test.Validity.Shrinking: shrinkPreservesValidOnGenValid :: (Show a, GenValid a) => (a -> [a]) -> Property
+ Test.Validity.Shrinking: shrinkValidPreservesValid :: (Show a, GenValid a) => Gen a -> Property
+ Test.Validity.Shrinking: shrinkValidPreservesValidOnGenValid :: forall a. (Show a, GenValid a) => Property
+ Test.Validity.Shrinking: shrinkValidSpec :: forall a. (Show a, Typeable a, GenValid a) => Spec
+ Test.Validity.Shrinking: shrinkValiditySpec :: forall a. (Show a, Typeable a, GenValid a, GenInvalid a) => Spec
+ Test.Validity.Shrinking: shrinkingPreserves :: Show a => Gen a -> (a -> [a]) -> (a -> Bool) -> Property
+ Test.Validity.Shrinking: shrinkingStaysInvalid :: (Show a, Validity a) => Gen a -> (a -> [a]) -> Property
+ Test.Validity.Shrinking: shrinkingStaysValid :: (Show a, Validity a) => Gen a -> (a -> [a]) -> Property
+ Test.Validity.Utils: failsBecause :: String -> SpecWith () -> SpecWith ()
+ Test.Validity.Utils: newtype Anon a
+ Test.Validity.Utils: shouldBeInvalid :: (Show a, Validity a) => a -> Expectation
+ Test.Validity.Utils: shouldBeValid :: (Show a, Validity a) => a -> Expectation
+ Test.Validity.Utils: shouldFail :: Property -> Property
- Test.Validity: antireflexivityOnGen :: Show a => (a -> a -> Bool) -> Gen a -> Property
+ Test.Validity: antireflexivityOnGen :: Show a => (a -> a -> Bool) -> Gen a -> (a -> [a]) -> Property
- Test.Validity: antisymmetryOnGens :: (Show a, Eq a) => (a -> a -> Bool) -> Gen (a, a) -> Property
+ Test.Validity: antisymmetryOnGens :: (Show a, Eq a) => (a -> a -> Bool) -> Gen (a, a) -> (a -> [a]) -> Property
- Test.Validity: antisymmetryOnGensWithEquality :: Show a => (a -> a -> Bool) -> Gen (a, a) -> (a -> a -> Bool) -> Property
+ Test.Validity: antisymmetryOnGensWithEquality :: Show a => (a -> a -> Bool) -> Gen (a, a) -> (a -> a -> Bool) -> (a -> [a]) -> Property
- Test.Validity: associativeOnGens :: (Show a, Eq a) => (a -> a -> a) -> Gen (a, a, a) -> Property
+ Test.Validity: associativeOnGens :: (Show a, Eq a) => (a -> a -> a) -> Gen (a, a, a) -> ((a, a, a) -> [(a, a, a)]) -> Property
- Test.Validity: commutativeOnGens :: (Show a, Eq a) => (a -> a -> a) -> Gen (a, a) -> Property
+ Test.Validity: commutativeOnGens :: (Show a, Eq a) => (a -> a -> a) -> Gen (a, a) -> ((a, a) -> [(a, a)]) -> Property
- Test.Validity: eqSpecOnGen :: forall a. (Show a, Eq a, Typeable a) => Gen a -> String -> Spec
+ Test.Validity: eqSpecOnGen :: forall a. (Show a, Eq a, Typeable a) => Gen a -> String -> (a -> [a]) -> Spec
- Test.Validity: equivalentOnGen :: (Show a, Eq a, Show b, Eq b) => (a -> b) -> (a -> b) -> Gen a -> Property
+ Test.Validity: equivalentOnGen :: (Show a, Eq a, Show b, Eq b) => (a -> b) -> (a -> b) -> Gen a -> (a -> [a]) -> Property
- Test.Validity: equivalentOnGens2 :: (Show a, Show b, Show c, Eq c) => (a -> b -> c) -> (a -> b -> c) -> Gen (a, b) -> Property
+ Test.Validity: equivalentOnGens2 :: (Show a, Show b, Show c, Eq c) => (a -> b -> c) -> (a -> b -> c) -> Gen (a, b) -> ((a, b) -> [(a, b)]) -> Property
- Test.Validity: equivalentOnGens3 :: (Show a, Show b, Show c, Show d, Eq d) => (a -> b -> c -> d) -> (a -> b -> c -> d) -> Gen (a, b, c) -> Property
+ Test.Validity: equivalentOnGens3 :: (Show a, Show b, Show c, Show d, Eq d) => (a -> b -> c -> d) -> (a -> b -> c -> d) -> Gen (a, b, c) -> ((a, b, c) -> [(a, b, c)]) -> Property
- Test.Validity: equivalentWhenFirstSucceedsOnGen :: (Show a, Eq a, Show b, Eq b, CanFail f) => (a -> f b) -> (a -> b) -> Gen a -> Property
+ Test.Validity: equivalentWhenFirstSucceedsOnGen :: (Show a, Eq a, Show b, Eq b, CanFail f) => (a -> f b) -> (a -> b) -> Gen a -> (a -> [a]) -> Property
- Test.Validity: equivalentWhenFirstSucceedsOnGens2 :: (Show a, Eq a, Show b, Eq b, Show c, Eq c, CanFail f) => (a -> b -> f c) -> (a -> b -> c) -> Gen (a, b) -> Property
+ Test.Validity: equivalentWhenFirstSucceedsOnGens2 :: (Show a, Eq a, Show b, Eq b, Show c, Eq c, CanFail f) => (a -> b -> f c) -> (a -> b -> c) -> Gen (a, b) -> ((a, b) -> [(a, b)]) -> Property
- Test.Validity: equivalentWhenSecondSucceedsOnGen :: (Show a, Eq a, Show b, Eq b, CanFail f) => (a -> b) -> (a -> f b) -> Gen a -> Property
+ Test.Validity: equivalentWhenSecondSucceedsOnGen :: (Show a, Eq a, Show b, Eq b, CanFail f) => (a -> b) -> (a -> f b) -> Gen a -> (a -> [a]) -> Property
- Test.Validity: equivalentWhenSecondSucceedsOnGens2 :: (Show a, Eq a, Show b, Eq b, Show c, Eq c, CanFail f) => (a -> b -> c) -> (a -> b -> f c) -> Gen (a, b) -> Property
+ Test.Validity: equivalentWhenSecondSucceedsOnGens2 :: (Show a, Eq a, Show b, Eq b, Show c, Eq c, CanFail f) => (a -> b -> c) -> (a -> b -> f c) -> Gen (a, b) -> ((a, b) -> [(a, b)]) -> Property
- Test.Validity: equivalentWhenSucceedOnGen :: (Show a, Eq a, Show b, Eq b, CanFail f) => (a -> f b) -> (a -> f b) -> Gen a -> Property
+ Test.Validity: equivalentWhenSucceedOnGen :: (Show a, Eq a, Show b, Eq b, CanFail f) => (a -> f b) -> (a -> f b) -> Gen a -> (a -> [a]) -> Property
- Test.Validity: equivalentWhenSucceedOnGens2 :: (Show a, Eq a, Show b, Eq b, Show c, Eq c, CanFail f) => (a -> b -> f c) -> (a -> b -> f c) -> Gen (a, b) -> Property
+ Test.Validity: equivalentWhenSucceedOnGens2 :: (Show a, Eq a, Show b, Eq b, Show c, Eq c, CanFail f) => (a -> b -> f c) -> (a -> b -> f c) -> Gen (a, b) -> ((a, b) -> [(a, b)]) -> Property
- Test.Validity: failsOnGen :: (Show a, Show b, Show (f b), CanFail f) => (a -> f b) -> Gen a -> Property
+ Test.Validity: failsOnGen :: (Show a, Show b, Show (f b), CanFail f) => (a -> f b) -> Gen a -> (a -> [a]) -> Property
- Test.Validity: failsOnGens2 :: (Show a, Show b, Show c, Show (f c), CanFail f) => (a -> b -> f c) -> Gen a -> Gen b -> Property
+ Test.Validity: failsOnGens2 :: (Show a, Show b, Show c, Show (f c), CanFail f) => (a -> b -> f c) -> Gen a -> (a -> [a]) -> Gen b -> (b -> [b]) -> Property
- Test.Validity: genGeneratesInvalid :: (Show a, Validity a) => Gen a -> Property
+ Test.Validity: genGeneratesInvalid :: (Show a, Validity a) => Gen a -> (a -> [a]) -> Property
- Test.Validity: genGeneratesValid :: (Show a, Validity a) => Gen a -> Property
+ Test.Validity: genGeneratesValid :: (Show a, Validity a) => Gen a -> (a -> [a]) -> Property
- Test.Validity: idempotentOnGen :: (Show a, Eq a) => (a -> a) -> Gen a -> Property
+ Test.Validity: idempotentOnGen :: (Show a, Eq a) => (a -> a) -> Gen a -> (a -> [a]) -> Property
- Test.Validity: identityOnGen :: (Show a, Eq a) => (a -> a -> a) -> a -> Gen a -> Property
+ Test.Validity: identityOnGen :: (Show a, Eq a) => (a -> a -> a) -> a -> Gen a -> (a -> [a]) -> Property
- Test.Validity: inverseFunctionsIfFirstSucceedsOnGen :: (Show a, Eq a, CanFail f) => (a -> f b) -> (b -> a) -> Gen a -> Property
+ Test.Validity: inverseFunctionsIfFirstSucceedsOnGen :: (Show a, Eq a, CanFail f) => (a -> f b) -> (b -> a) -> Gen a -> (a -> [a]) -> Property
- Test.Validity: inverseFunctionsIfSecondSucceedsOnGen :: (Show a, Eq a, CanFail f) => (a -> b) -> (b -> f a) -> Gen a -> Property
+ Test.Validity: inverseFunctionsIfSecondSucceedsOnGen :: (Show a, Eq a, CanFail f) => (a -> b) -> (b -> f a) -> Gen a -> (a -> [a]) -> Property
- Test.Validity: inverseFunctionsIfSucceedOnGen :: (Show a, Eq a, CanFail f, CanFail g) => (a -> f b) -> (b -> g a) -> Gen a -> Property
+ Test.Validity: inverseFunctionsIfSucceedOnGen :: (Show a, Eq a, CanFail f, CanFail g) => (a -> f b) -> (b -> g a) -> Gen a -> (a -> [a]) -> Property
- Test.Validity: inverseFunctionsOnGen :: (Show a, Eq a) => (a -> b) -> (b -> a) -> Gen a -> Property
+ Test.Validity: inverseFunctionsOnGen :: (Show a, Eq a) => (a -> b) -> (b -> a) -> Gen a -> (a -> [a]) -> Property
- Test.Validity: leftIdentityOnGen :: (Show a, Eq a) => (b -> a -> a) -> b -> Gen a -> Property
+ Test.Validity: leftIdentityOnGen :: (Show a, Eq a) => (b -> a -> a) -> b -> Gen a -> (a -> [a]) -> Property
- Test.Validity: leftIdentityOnGenWithEquality :: Show a => (b -> a -> a) -> (a -> a -> Bool) -> b -> Gen a -> Property
+ Test.Validity: leftIdentityOnGenWithEquality :: Show a => (b -> a -> a) -> (a -> a -> Bool) -> b -> Gen a -> (a -> [a]) -> Property
- Test.Validity: monoidSpecOnGen :: forall a. (Show a, Eq a, Monoid a, Typeable a) => Gen a -> String -> Spec
+ Test.Validity: monoidSpecOnGen :: forall a. (Show a, Eq a, Monoid a, Typeable a) => Gen a -> String -> (a -> [a]) -> Spec
- Test.Validity: ordSpecOnGen :: forall a. (Show a, Eq a, Ord a, Typeable a) => Gen a -> String -> Spec
+ Test.Validity: ordSpecOnGen :: forall a. (Show a, Eq a, Ord a, Typeable a) => Gen a -> String -> (a -> [a]) -> Spec
- Test.Validity: producesValidsOnGen :: (Show a, Show b, Validity b) => (a -> b) -> Gen a -> Property
+ Test.Validity: producesValidsOnGen :: (Show a, Show b, Validity b) => (a -> b) -> Gen a -> (a -> [a]) -> Property
- Test.Validity: producesValidsOnGens2 :: (Show a, Show b, Show c, Validity c) => (a -> b -> c) -> Gen (a, b) -> Property
+ Test.Validity: producesValidsOnGens2 :: (Show a, Show b, Show c, Validity c) => (a -> b -> c) -> Gen (a, b) -> ((a, b) -> [(a, b)]) -> Property
- Test.Validity: producesValidsOnGens3 :: (Show a, Show b, Show c, Show d, Validity d) => (a -> b -> c -> d) -> Gen (a, b, c) -> Property
+ Test.Validity: producesValidsOnGens3 :: (Show a, Show b, Show c, Show d, Validity d) => (a -> b -> c -> d) -> Gen (a, b, c) -> ((a, b, c) -> [(a, b, c)]) -> Property
- Test.Validity: reflexivityOnGen :: Show a => (a -> a -> Bool) -> Gen a -> Property
+ Test.Validity: reflexivityOnGen :: Show a => (a -> a -> Bool) -> Gen a -> (a -> [a]) -> Property
- Test.Validity: rightIdentityOnGen :: (Show a, Eq a) => (a -> b -> a) -> b -> Gen a -> Property
+ Test.Validity: rightIdentityOnGen :: (Show a, Eq a) => (a -> b -> a) -> b -> Gen a -> (a -> [a]) -> Property
- Test.Validity: rightIdentityOnGenWithEquality :: Show a => (a -> b -> a) -> (a -> a -> Bool) -> b -> Gen a -> Property
+ Test.Validity: rightIdentityOnGenWithEquality :: Show a => (a -> b -> a) -> (a -> a -> Bool) -> b -> Gen a -> (a -> [a]) -> Property
- Test.Validity: succeedsOnGen :: (Show a, Show b, Show (f b), CanFail f) => (a -> f b) -> Gen a -> Property
+ Test.Validity: succeedsOnGen :: (Show a, Show b, Show (f b), CanFail f) => (a -> f b) -> Gen a -> (a -> [a]) -> Property
- Test.Validity: succeedsOnGens2 :: (Show a, Show b, Show c, Show (f c), CanFail f) => (a -> b -> f c) -> Gen (a, b) -> Property
+ Test.Validity: succeedsOnGens2 :: (Show a, Show b, Show c, Show (f c), CanFail f) => (a -> b -> f c) -> Gen (a, b) -> ((a, b) -> [(a, b)]) -> Property
- Test.Validity: symmetryOnGens :: Show a => (a -> a -> Bool) -> Gen (a, a) -> Property
+ Test.Validity: symmetryOnGens :: Show a => (a -> a -> Bool) -> Gen (a, a) -> (a -> [a]) -> Property
- Test.Validity: transitivityOnGens :: Show a => (a -> a -> Bool) -> Gen (a, a, a) -> Property
+ Test.Validity: transitivityOnGens :: Show a => (a -> a -> Bool) -> Gen (a, a, a) -> (a -> [a]) -> Property
- Test.Validity: validIfSucceedsOnGen :: (Show a, Show b, Show (f b), Validity b, CanFail f) => (a -> f b) -> Gen a -> Property
+ Test.Validity: validIfSucceedsOnGen :: (Show a, Show b, Show (f b), Validity b, CanFail f) => (a -> f b) -> Gen a -> (a -> [a]) -> Property
- Test.Validity: validIfSucceedsOnGens2 :: (Show a, Show b, Show c, Show (f c), Validity c, CanFail f) => (a -> b -> f c) -> Gen (a, b) -> Property
+ Test.Validity: validIfSucceedsOnGens2 :: (Show a, Show b, Show c, Show (f c), Validity c, CanFail f) => (a -> b -> f c) -> Gen (a, b) -> ((a, b) -> [(a, b)]) -> Property
- Test.Validity: validIfSucceedsOnGens3 :: (Show a, Show b, Show c, Show d, Show (f d), Validity d, CanFail f) => (a -> b -> c -> f d) -> Gen (a, b, c) -> Property
+ Test.Validity: validIfSucceedsOnGens3 :: (Show a, Show b, Show c, Show d, Show (f d), Validity d, CanFail f) => (a -> b -> c -> f d) -> Gen (a, b, c) -> ((a, b, c) -> [(a, b, c)]) -> Property
- Test.Validity.Eq: eqSpecOnGen :: forall a. (Show a, Eq a, Typeable a) => Gen a -> String -> Spec
+ Test.Validity.Eq: eqSpecOnGen :: forall a. (Show a, Eq a, Typeable a) => Gen a -> String -> (a -> [a]) -> Spec
- Test.Validity.GenValidity: genGeneratesInvalid :: (Show a, Validity a) => Gen a -> Property
+ Test.Validity.GenValidity: genGeneratesInvalid :: (Show a, Validity a) => Gen a -> (a -> [a]) -> Property
- Test.Validity.GenValidity: genGeneratesValid :: (Show a, Validity a) => Gen a -> Property
+ Test.Validity.GenValidity: genGeneratesValid :: (Show a, Validity a) => Gen a -> (a -> [a]) -> Property
- Test.Validity.Monoid: monoidSpecOnGen :: forall a. (Show a, Eq a, Monoid a, Typeable a) => Gen a -> String -> Spec
+ Test.Validity.Monoid: monoidSpecOnGen :: forall a. (Show a, Eq a, Monoid a, Typeable a) => Gen a -> String -> (a -> [a]) -> Spec
- Test.Validity.Ord: ordSpecOnGen :: forall a. (Show a, Eq a, Ord a, Typeable a) => Gen a -> String -> Spec
+ Test.Validity.Ord: ordSpecOnGen :: forall a. (Show a, Eq a, Ord a, Typeable a) => Gen a -> String -> (a -> [a]) -> Spec

Files

genvalidity-hspec.cabal view
@@ -1,5 +1,5 @@ name: genvalidity-hspec-version: 0.4.0.0+version: 0.5.0.0 cabal-version: >=1.10 build-type: Simple license: MIT@@ -13,7 +13,11 @@     .     * <https://hackage.haskell.org/package/genvalidity-hspec-aeson genvalidity-hspec-aeson>     .+    * <https://hackage.haskell.org/package/genvalidity-hspec-binary genvalidity-hspec-binary>+    .     * <https://hackage.haskell.org/package/genvalidity-hspec-cereal genvalidity-hspec-cereal>+    .+    * <https://hackage.haskell.org/package/genvalidity-hspec-hashable genvalidity-hspec-hashable> category: Testing author: Tom Sydney Kerckhove @@ -34,14 +38,16 @@         Test.Validity.Monoid         Test.Validity.Ord         Test.Validity.RelativeValidity+        Test.Validity.Shrinking         Test.Validity.Utils     build-depends:-        base >= 4.9 && <5,-        validity >=0.3 && <0.4,-        genvalidity >=0.3 && <0.4,+        base >=4.9 && <5,         QuickCheck -any,+        genvalidity >=0.4 && <0.5,+        genvalidity-property >=0.1 && <0.2,         hspec >=2.2 && <2.5,-        genvalidity-property >= 0.0 && < 0.1+        hspec-core -any,+        validity >=0.4 && <0.5     default-language: Haskell2010     hs-source-dirs: src @@ -55,21 +61,19 @@     default-language: Haskell2010     hs-source-dirs: test     ghc-options: -threaded- test-suite genvalidity-hspec-test     type: exitcode-stdio-1.0     main-is: Spec.hs     build-depends:         base -any,-        genvalidity >=0.3 && <0.4,+        genvalidity -any,         genvalidity-hspec -any,-        hspec,-        hspec-core,-        QuickCheck+        hspec -any,+        hspec-core -any,+        QuickCheck -any     default-language: Haskell2010     hs-source-dirs: test/     other-modules:-        Test.Validity.TestUtils         Test.Validity.ApplicativeSpec         Test.Validity.ArbitrarySpec         Test.Validity.EqSpec@@ -80,4 +84,5 @@         Test.Validity.MonoidSpec         Test.Validity.OrdSpec         Test.Validity.RelativeValiditySpec+        Test.Validity.ShrinkingSpec     ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall
src/Test/Validity.hs view
@@ -4,6 +4,11 @@ -- | To use the 'Spec' functions in this module, you will need @TypeApplications@. module Test.Validity     ( module Data.GenValidity+    , forAllUnchecked+    , forAllValid+    , forAllInvalid+    , shouldBeValid+    , shouldBeInvalid       -- * Tests for Arbitrary instances involving Validity     , arbitrarySpec     , arbitraryGeneratesOnlyValid@@ -15,6 +20,18 @@     , genGeneratesValid     , genInvalidGeneratesInvalid     , genGeneratesInvalid+    , shrinkValiditySpec+    , shrinkValidSpec+    , shrinkInvalidSpec+    , shrinkValidPreservesValidOnGenValid+    , shrinkInvalidPreservesInvalidOnGenInvalid+    , shrinkPreservesValidOnGenValid+    , shrinkPreservesInvalidOnGenInvalid+    , shrinkValidPreservesValid+    , shrinkInvalidPreservesInvalid+    , shrinkingStaysValid+    , shrinkingStaysInvalid+    , shrinkingPreserves       -- * Tests for RelativeValidity instances     , relativeValiditySpec     , relativeValidityImpliesValidA@@ -246,6 +263,7 @@ import Test.Validity.Operations import Test.Validity.Ord import Test.Validity.Property-import Test.Validity.Relations+import Test.Validity.Shrinking import Test.Validity.RelativeValidity-import Test.Validity.Types+import Test.Validity.Utils+
src/Test/Validity/Applicative.hs view
@@ -24,15 +24,15 @@ import Test.Validity.Functions import Test.Validity.Utils -pureTypeStr-    :: forall (f :: * -> *).-       (Typeable f)+{-# ANN module "HLint: ignore Avoid lambda" #-}++pureTypeStr ::+       forall (f :: * -> *). (Typeable f)     => String pureTypeStr = unwords ["pure", "::", "a", "->", nameOf @f, "a"] -seqTypeStr-    :: forall (f :: * -> *).-       (Typeable f)+seqTypeStr ::+       forall (f :: * -> *). (Typeable f)     => String seqTypeStr =     unwords@@ -50,9 +50,8 @@         , "b"         ] -seqrTypeStr-    :: forall (f :: * -> *).-       (Typeable f)+seqrTypeStr ::+       forall (f :: * -> *). (Typeable f)     => String seqrTypeStr =     unwords@@ -68,9 +67,8 @@         , "b"         ] -seqlTypeStr-    :: forall (f :: * -> *).-       (Typeable f)+seqlTypeStr ::+       forall (f :: * -> *). (Typeable f)     => String seqlTypeStr =     unwords@@ -91,8 +89,8 @@ -- Example usage: -- -- > applicativeSpecOnArbitrary @[]-applicativeSpecOnValid-    :: forall (f :: * -> *).+applicativeSpecOnValid ::+       forall (f :: * -> *).        (Eq (f Int), Show (f Int), Applicative f, Typeable f, GenValid (f Int))     => Spec applicativeSpecOnValid = applicativeSpecWithInts @f genValid@@ -102,8 +100,8 @@ -- Example usage: -- -- > applicativeSpecOnArbitrary @[]-applicativeSpec-    :: forall (f :: * -> *).+applicativeSpec ::+       forall (f :: * -> *).        ( Eq (f Int)        , Show (f Int)        , Applicative f@@ -118,16 +116,17 @@ -- Example usage: -- -- > applicativeSpecOnArbitrary @[]-applicativeSpecOnArbitrary-    :: forall (f :: * -> *).+applicativeSpecOnArbitrary ::+       forall (f :: * -> *).        (Eq (f Int), Show (f Int), Applicative f, Typeable f, Arbitrary (f Int))     => Spec applicativeSpecOnArbitrary = applicativeSpecWithInts @f arbitrary -applicativeSpecWithInts-    :: forall (f :: * -> *).+applicativeSpecWithInts ::+       forall (f :: * -> *).        (Show (f Int), Eq (f Int), Applicative f, Typeable f)-    => Gen (f Int) -> Spec+    => Gen (f Int)+    -> Spec applicativeSpecWithInts gen =     applicativeSpecOnGens         @f@@ -166,8 +165,8 @@ -- >     "prepends in a Just" -- >     (pure <$> (flip (++) <$> genValid)) -- >     "appends in a Just"-applicativeSpecOnGens-    :: forall (f :: * -> *) (a :: *) (b :: *) (c :: *).+applicativeSpecOnGens ::+       forall (f :: * -> *) (a :: *) (b :: *) (c :: *).        ( Show a        , Eq a        , Show (f a)@@ -204,7 +203,7 @@                      [ "satisfy the identity law: 'pure id <*> v = v' for"                      , genDescr @(f a) genname                      ]) $-                equivalentOnGen (pure id <*>) id gen+                equivalentOnGen (pure id <*>) id gen shrinkNothing             it                 (unwords                      [ "satisfy the composition law: 'pure (.) <*> u <*> v <*> w = u <*> (v <*> w)' for"@@ -219,7 +218,7 @@                          pure (.) <*> (u :: f (b -> c)) <*> (v :: f (a -> b)) <*>                          (w :: f a) :: f c)                     (\(Anon u) (Anon v) w -> u <*> (v <*> w) :: f c)-                    ((,,) <$> (Anon <$> genffb) <*> (Anon <$> genffa) <*> gen)+                    ((,,) <$> (Anon <$> genffb) <*> (Anon <$> genffa) <*> gen) shrinkNothing             it                 (unwords                      [ "satisfy the homomorphism law: 'pure f <*> pure x = pure (f x)' for"@@ -230,7 +229,7 @@                 equivalentOnGens2                     (\(Anon f) x -> pure f <*> pure x :: f b)                     (\(Anon f) x -> pure $ f x :: f b)-                    ((,) <$> (Anon <$> genfa) <*> gena)+                    ((,) <$> (Anon <$> genfa) <*> gena) shrinkNothing             it                 (unwords                      [ "satisfy the interchange law: 'u <*> pure y = pure ($ y) <*> u' for"@@ -241,7 +240,7 @@                 equivalentOnGens2                     (\(Anon u) y -> u <*> pure y :: f b)                     (\(Anon u) y -> pure ($ y) <*> u :: f b)-                    ((,) <$> (Anon <$> genffa) <*> gena)+                    ((,) <$> (Anon <$> genffa) <*> gena) shrinkNothing             it                 (unwords                      [ "satisfy the law about the functor instance: fmap f x = pure f <*> x for"@@ -252,8 +251,8 @@                 equivalentOnGens2                     (\(Anon f) x -> fmap f x)                     (\(Anon f) x -> pure f <*> x)-                    ((,) <$> (Anon <$> genfa) <*> gen)-        describe (seqrTypeStr @f) $ do+                    ((,) <$> (Anon <$> genfa) <*> gen) shrinkNothing+        describe (seqrTypeStr @f) $             it                 (unwords                      [ "is equivalent to its default implementation 'u *> v = pure (const id) <*> u <*> v' for"@@ -264,8 +263,8 @@                 equivalentOnGens2                     (\u v -> u *> v)                     (\u v -> pure (const id) <*> u <*> v)-                    ((,) <$> gen <*> genb)-        describe (seqlTypeStr @f) $ do+                    ((,) <$> gen <*> genb) shrinkNothing+        describe (seqlTypeStr @f) $             it                 (unwords                      [ "is equivalent to its default implementation 'u <* v = pure const <*> u <*> v' for"@@ -276,4 +275,4 @@                 equivalentOnGens2                     (\u v -> u <* v)                     (\u v -> pure const <*> u <*> v)-                    ((,) <$> gen <*> genb)+                    ((,) <$> gen <*> genb) shrinkNothing
src/Test/Validity/Arbitrary.hs view
@@ -44,4 +44,4 @@     :: forall a.        (Show a, Validity a, Arbitrary a)     => Property-arbitraryGeneratesOnlyValid = genGeneratesValid @a arbitrary+arbitraryGeneratesOnlyValid = genGeneratesValid @a arbitrary shrink
src/Test/Validity/Eq.hs view
@@ -25,15 +25,13 @@ import Test.Validity.Relations import Test.Validity.Utils -eqTypeStr-    :: forall a.-       Typeable a+eqTypeStr ::+       forall a. Typeable a     => String eqTypeStr = binRelStr @a "==" -neqTypeStr-    :: forall a.-       Typeable a+neqTypeStr ::+       forall a. Typeable a     => String neqTypeStr = binRelStr @a "/=" @@ -42,61 +40,60 @@ -- Example usage: -- -- > eqSpecOnValid @Double-eqSpecOnValid-    :: forall a.-       (Show a, Eq a, Typeable a, GenValid a)+eqSpecOnValid ::+       forall a. (Show a, Eq a, Typeable a, GenValid a)     => Spec-eqSpecOnValid = eqSpecOnGen @a genValid "valid"+eqSpecOnValid = eqSpecOnGen @a genValid "valid" shrinkValid  -- | Standard test spec for properties of Eq instances for invalid values -- -- Example usage: -- -- > eqSpecOnInvalid @Double-eqSpecOnInvalid-    :: forall a.-       (Show a, Eq a, Typeable a, GenInvalid a)+eqSpecOnInvalid ::+       forall a. (Show a, Eq a, Typeable a, GenInvalid a)     => Spec-eqSpecOnInvalid = eqSpecOnGen @a genInvalid "invalid"+eqSpecOnInvalid = eqSpecOnGen @a genInvalid "invalid" shrinkInvalid  -- | Standard test spec for properties of Eq instances for unchecked values -- -- Example usage: -- -- > eqSpec @Int-eqSpec-    :: forall a.-       (Show a, Eq a, Typeable a, GenUnchecked a)+eqSpec ::+       forall a. (Show a, Eq a, Typeable a, GenUnchecked a)     => Spec-eqSpec = eqSpecOnGen @a genUnchecked "unchecked"+eqSpec = eqSpecOnGen @a genUnchecked "unchecked" shrinkUnchecked  -- | Standard test spec for properties of Eq instances for arbitrary values -- -- Example usage: -- -- > eqSpecOnArbitrary @Int-eqSpecOnArbitrary-    :: forall a.-       (Show a, Eq a, Typeable a, Arbitrary a)+eqSpecOnArbitrary ::+       forall a. (Show a, Eq a, Typeable a, Arbitrary a)     => Spec-eqSpecOnArbitrary = eqSpecOnGen @a arbitrary "arbitrary"+eqSpecOnArbitrary = eqSpecOnGen @a arbitrary "arbitrary" shrink  -- | Standard test spec for properties of Eq instances for values generated by a given generator (and name for that generator). -- -- Example usage: -- -- > eqSpecOnGen ((* 2) <$> genValid @Int) "even"-eqSpecOnGen-    :: forall a.-       (Show a, Eq a, Typeable a)-    => Gen a -> String -> Spec-eqSpecOnGen gen genname =+eqSpecOnGen ::+       forall a. (Show a, Eq a, Typeable a)+    => Gen a+    -> String+    -> (a -> [a])+    -> Spec+eqSpecOnGen gen genname s =     parallel $ do         let name = nameOf @a             funeqstr = eqTypeStr @a             funneqstr = neqTypeStr @a             gen2 = (,) <$> gen <*> gen             gen3 = (,,) <$> gen <*> gen <*> gen+            s2 = shrinkT2 s         describe ("Eq " ++ name) $ do             let eq = (==) @a                 neq = (/=) @a@@ -107,28 +104,28 @@                          , "\"" ++ genname                          , name ++ "\"" ++ "'s"                          ]) $-                    reflexivityOnGen eq gen+                    reflexivityOnGen eq gen s                 it                     (unwords                          [ "is symmetric for"                          , "\"" ++ genname                          , name ++ "\"" ++ "'s"                          ]) $-                    symmetryOnGens eq gen2+                    symmetryOnGens eq gen2 s                 it                     (unwords                          [ "is transitive for"                          , "\"" ++ genname                          , name ++ "\"" ++ "'s"                          ]) $-                    transitivityOnGens eq gen3+                    transitivityOnGens eq gen3 s                 it                     (unwords                          [ "is equivalent to (\\a b -> not $ a /= b) for"                          , "\"" ++ genname                          , name ++ "\"" ++ "'s"                          ]) $-                    equivalentOnGens2 eq (\a b -> not $ a `neq` b) gen2+                    equivalentOnGens2 eq (\a b -> not $ a `neq` b) gen2 s2             describe funneqstr $ do                 it                     (unwords@@ -136,11 +133,11 @@                          , "\"" ++ genname                          , name ++ "\"" ++ "'s"                          ]) $-                    antireflexivityOnGen neq gen+                    antireflexivityOnGen neq gen s                 it                     (unwords                          [ "is equivalent to (\\a b -> not $ a == b) for"                          , "\"" ++ genname                          , name ++ "\"" ++ "'s"                          ]) $-                    equivalentOnGens2 neq (\a b -> not $ a `eq` b) gen2+                    equivalentOnGens2 neq (\a b -> not $ a `eq` b) gen2 s2
src/Test/Validity/Functor.hs view
@@ -24,9 +24,10 @@ import Test.Validity.Functions import Test.Validity.Utils -fmapTypeStr-    :: forall (f :: * -> *).-       (Typeable f)+{-# ANN module "HLint: ignore Functor law" #-}++fmapTypeStr ::+       forall (f :: * -> *). (Typeable f)     => String fmapTypeStr =     unwords@@ -43,9 +44,8 @@         , "b"         ] -flTypeStr-    :: forall (f :: * -> *).-       (Typeable f)+flTypeStr ::+       forall (f :: * -> *). (Typeable f)     => String flTypeStr =     unwords ["(<$)", "::", "a", "->", nameOf @f, "b", "->", nameOf @f, "a"]@@ -55,8 +55,8 @@ -- Example usage: -- -- > functorSpecOnArbitrary @[]-functorSpecOnValid-    :: forall (f :: * -> *).+functorSpecOnValid ::+       forall (f :: * -> *).        (Eq (f Int), Show (f Int), Functor f, Typeable f, GenValid (f Int))     => Spec functorSpecOnValid = functorSpecWithInts @f genValid@@ -66,8 +66,8 @@ -- Example usage: -- -- > functorSpecOnArbitrary @[]-functorSpec-    :: forall (f :: * -> *).+functorSpec ::+       forall (f :: * -> *).        (Eq (f Int), Show (f Int), Functor f, Typeable f, GenUnchecked (f Int))     => Spec functorSpec = functorSpecWithInts @f genUnchecked@@ -77,16 +77,16 @@ -- Example usage: -- -- > functorSpecOnArbitrary @[]-functorSpecOnArbitrary-    :: forall (f :: * -> *).+functorSpecOnArbitrary ::+       forall (f :: * -> *).        (Eq (f Int), Show (f Int), Functor f, Typeable f, Arbitrary (f Int))     => Spec functorSpecOnArbitrary = functorSpecWithInts @f arbitrary -functorSpecWithInts-    :: forall (f :: * -> *).-       (Eq (f Int), Show (f Int), Functor f, Typeable f)-    => Gen (f Int) -> Spec+functorSpecWithInts ::+       forall (f :: * -> *). (Eq (f Int), Show (f Int), Functor f, Typeable f)+    => Gen (f Int)+    -> Spec functorSpecWithInts gen =     functorSpecOnGens         @f@@ -111,8 +111,8 @@ -- >     (genListOf $ pure 5) "list of fives" -- >     ((+) <$> genValid) "additions" -- >     ((*) <$> genValid) "multiplications"-functorSpecOnGens-    :: forall (f :: * -> *) (a :: *) (b :: *) (c :: *).+functorSpecOnGens ::+       forall (f :: * -> *) (a :: *) (b :: *) (c :: *).        ( Show a        , Show (f a)        , Show (f c)@@ -142,7 +142,7 @@                      [ "satisfies the first Fuctor law: 'fmap id == id' for"                      , genDescr @(f a) genname                      ]) $-                equivalentOnGen (fmap @f id) (id @(f a)) gen+                equivalentOnGen (fmap @f id) (id @(f a)) gen shrinkNothing             it                 (unwords                      [ "satisfieds the second Functor law: 'fmap (f . g) == fmap f . fmap g' for"@@ -155,7 +155,11 @@                      ]) $                 forAll (Anon <$> genf) $ \(Anon f) ->                     forAll (Anon <$> geng) $ \(Anon g) ->-                        equivalentOnGen (fmap (f . g)) (fmap f . fmap g) gen+                        equivalentOnGen+                            (fmap (f . g))+                            (fmap f . fmap g)+                            gen+                            shrinkNothing         describe (flTypeStr @f) $             it                 (unwords@@ -164,4 +168,5 @@                      , "and"                      , genDescr @(f a) genname                      ]) $-            forAll gena $ \a -> equivalentOnGen ((<$) a) (fmap $ const a) gen+            forAll gena $ \a ->+                equivalentOnGen (a <$) (fmap $ const a) gen shrinkNothing
src/Test/Validity/GenRelativeValidity.hs view
@@ -22,6 +22,7 @@ import Test.Hspec import Test.QuickCheck +import Test.Validity.Property.Utils import Test.Validity.Utils  -- | A @Spec@ that specifies that @genValidFor@ and @genInvalidFor@ work as@@ -33,8 +34,8 @@ -- Example usage: -- -- > relativeGenValiditySpec @MyDataFor @MyOtherData-genRelativeValiditySpec-    :: forall a b.+genRelativeValiditySpec ::+       forall a b.        ( Typeable a        , Typeable b        , Show a@@ -48,8 +49,8 @@     genRelativeValidSpec @a @b     genRelativeInvalidSpec @a @b -genRelativeValidSpec-    :: forall a b.+genRelativeValidSpec ::+       forall a b.        ( Typeable a        , Typeable b        , Show a@@ -64,15 +65,15 @@     parallel $ do         let nameOne = nameOf @a         let nameTwo = nameOf @a-        describe ("GenRelativeValidity " ++ nameOne ++ " " ++ nameTwo) $ do+        describe ("GenRelativeValidity " ++ nameOne ++ " " ++ nameTwo) $             describe ("genValidFor   :: " ++ nameTwo ++ " -> Gen " ++ nameOne) $-                it-                    ("only generates valid \'" ++-                     nameOne ++ "\'s for the " ++ nameTwo) $-                genRelativeValidGeneratesValid @a @b+            it+                ("only generates valid \'" +++                 nameOne ++ "\'s for the " ++ nameTwo) $+            genRelativeValidGeneratesValid @a @b -genRelativeInvalidSpec-    :: forall a b.+genRelativeInvalidSpec ::+       forall a b.        ( Typeable a        , Typeable b        , Show a@@ -87,25 +88,25 @@     parallel $ do         let nameOne = nameOf @a         let nameTwo = nameOf @a-        describe ("GenRelativeInvalid " ++ nameOne ++ " " ++ nameTwo) $ do+        describe ("GenRelativeInvalid " ++ nameOne ++ " " ++ nameTwo) $             describe ("genInvalidFor   :: " ++ nameTwo ++ " -> Gen " ++ nameOne) $-                it-                    ("only generates invalid \'" ++-                     nameOne ++ "\'s for the " ++ nameTwo) $-                genRelativeInvalidGeneratesInvalid @a @b+            it+                ("only generates invalid \'" +++                 nameOne ++ "\'s for the " ++ nameTwo) $+            genRelativeInvalidGeneratesInvalid @a @b  -- | @genValidFor b@ only generates values that satisfy @isValidFor b@-genRelativeValidGeneratesValid-    :: forall a b.+genRelativeValidGeneratesValid ::+       forall a b.        (Show a, Show b, GenValid b, RelativeValidity a b, GenRelativeValid a b)     => Property genRelativeValidGeneratesValid =-    forAll genValid $ \(b :: b) ->+    forAllValid $ \(b :: b) ->         forAll (genValidFor b) $ \(a :: a) -> a `shouldSatisfy` (`isValidFor` b)  -- | @genInvalidFor b@ only generates values that do not satisfy @isValidFor b@-genRelativeInvalidGeneratesInvalid-    :: forall a b.+genRelativeInvalidGeneratesInvalid ::+       forall a b.        ( Show a        , Show b        , GenUnchecked b@@ -114,6 +115,6 @@        )     => Property genRelativeInvalidGeneratesInvalid =-    forAll genUnchecked $ \(b :: b) ->+    forAllUnchecked $ \(b :: b) ->         forAll (genInvalidFor b) $ \(a :: a) ->             a `shouldNotSatisfy` (`isValidFor` b)
src/Test/Validity/GenValidity.hs view
@@ -34,9 +34,8 @@ -- Example usage: -- -- > genValiditySpec @Int-genValiditySpec-    :: forall a.-       (Typeable a, Show a, GenValid a, GenInvalid a)+genValiditySpec ::+       forall a. (Typeable a, Show a, GenValid a, GenInvalid a)     => Spec genValiditySpec = do     genValidSpec @a@@ -47,34 +46,32 @@ -- Example usage: -- -- > genValidSpec @Int-genValidSpec-    :: forall a.-       (Typeable a, Show a, GenValid a)+genValidSpec ::+       forall a. (Typeable a, Show a, GenValid a)     => Spec genValidSpec =     parallel $ do         let name = nameOf @a-        describe ("GenValid " ++ name) $ do+        describe ("GenValid " ++ name) $             describe ("genValid   :: Gen " ++ name) $-                it ("only generates valid \'" ++ name ++ "\'s") $-                genValidGeneratesValid @a+            it ("only generates valid \'" ++ name ++ "\'s") $+            genValidGeneratesValid @a  -- | A @Spec@ that specifies that @genInvalid@ only generates invalid data. -- -- Example usage: -- -- > genInvalidSpec @Double-genInvalidSpec-    :: forall a.-       (Typeable a, Show a, GenInvalid a)+genInvalidSpec ::+       forall a. (Typeable a, Show a, GenInvalid a)     => Spec genInvalidSpec =     parallel $ do         let name = nameOf @a-        describe ("GenInvalid " ++ name) $ do+        describe ("GenInvalid " ++ name) $             describe ("genInvalid :: Gen " ++ name) $-                it ("only generates invalid \'" ++ name ++ "\'s") $-                genInvalidGeneratesInvalid @a+            it ("only generates invalid \'" ++ name ++ "\'s") $+            genInvalidGeneratesInvalid @a  -- | @genValid@ only generates valid data --@@ -88,11 +85,10 @@ -- prop> genValidGeneratesValid @Integer -- prop> genValidGeneratesValid @(Maybe Int) -- prop> genValidGeneratesValid @[Int]-genValidGeneratesValid-    :: forall a.-       (Show a, GenValid a)+genValidGeneratesValid ::+       forall a. (Show a, GenValid a)     => Property-genValidGeneratesValid = genGeneratesValid @a genValid+genValidGeneratesValid = genGeneratesValid @a genValid shrinkValid  -- | @genValid@ only generates invalid data --@@ -100,8 +96,7 @@ -- prop> genInvalidGeneratesInvalid @Double -- prop> genInvalidGeneratesInvalid @(Maybe Double) -- prop> genInvalidGeneratesInvalid @[Double]-genInvalidGeneratesInvalid-    :: forall a.-       (Show a, GenInvalid a)+genInvalidGeneratesInvalid ::+       forall a. (Show a, GenInvalid a)     => Property-genInvalidGeneratesInvalid = genGeneratesInvalid @a genInvalid+genInvalidGeneratesInvalid = genGeneratesInvalid @a genInvalid shrinkInvalid
src/Test/Validity/Monad.hs view
@@ -27,15 +27,27 @@ import Test.Validity.Functions import Test.Validity.Utils -returnTypeStr-    :: forall (m :: * -> *).-       (Typeable m)+{-# ANN module "HLint: ignore Use fmap" #-}++{-# ANN module "HLint: ignore Use >=>" #-}++{-# ANN module "HLint: ignore Use id" #-}++{-# ANN module "HLint: ignore Monad law, left identity" #-}++{-# ANN module "HLint: ignore Monad law, right identity" #-}++{-# ANN module "HLint: ignore Avoid lambda" #-}++{-# ANN module "HLint: ignore Reduce duplication" #-}++returnTypeStr ::+       forall (m :: * -> *). (Typeable m)     => String returnTypeStr = unwords ["return", "::", "a", "->", nameOf @m, "a"] -bindTypeStr-    :: forall (m :: * -> *).-       (Typeable m)+bindTypeStr ::+       forall (m :: * -> *). (Typeable m)     => String bindTypeStr =     unwords@@ -58,8 +70,8 @@ -- Example usage: -- -- > monadSpecOnArbitrary @[]-monadSpecOnValid-    :: forall (f :: * -> *).+monadSpecOnValid ::+       forall (f :: * -> *).        (Eq (f Int), Show (f Int), Monad f, Typeable f, GenValid (f Int))     => Spec monadSpecOnValid = monadSpecWithInts @f genValid@@ -69,8 +81,8 @@ -- Example usage: -- -- > monadSpecOnArbitrary @[]-monadSpec-    :: forall (f :: * -> *).+monadSpec ::+       forall (f :: * -> *).        (Eq (f Int), Show (f Int), Monad f, Typeable f, GenUnchecked (f Int))     => Spec monadSpec = monadSpecWithInts @f genUnchecked@@ -80,16 +92,16 @@ -- Example usage: -- -- > monadSpecOnArbitrary @[]-monadSpecOnArbitrary-    :: forall (f :: * -> *).+monadSpecOnArbitrary ::+       forall (f :: * -> *).        (Eq (f Int), Show (f Int), Monad f, Typeable f, Arbitrary (f Int))     => Spec monadSpecOnArbitrary = monadSpecWithInts @f arbitrary -monadSpecWithInts-    :: forall (f :: * -> *).-       (Eq (f Int), Show (f Int), Monad f, Typeable f)-    => Gen (f Int) -> Spec+monadSpecWithInts ::+       forall (f :: * -> *). (Eq (f Int), Show (f Int), Monad f, Typeable f)+    => Gen (f Int)+    -> Spec monadSpecWithInts gen =     monadSpecOnGens         @f@@ -136,8 +148,8 @@ -- >     "singletonisation" -- >     (pure $ pure (+ 1)) -- >     "increment in list"-monadSpecOnGens-    :: forall (f :: * -> *) (a :: *) (b :: *) (c :: *).+monadSpecOnGens ::+       forall (f :: * -> *) (a :: *) (b :: *) (c :: *).        ( Show a        , Eq a        , Show (f a)@@ -182,12 +194,13 @@                     (\a (Anon k) -> return a >>= k)                     (\a (Anon k) -> k a)                     ((,) <$> gena <*> (Anon <$> genbf))+                    shrinkNothing             it                 (unwords                      [ "satisfy the second Monad law: 'm >>= return = m' for"                      , genDescr @(f a) genname                      ]) $-                equivalentOnGen (\m -> m >>= return) (\m -> m) gen+                equivalentOnGen (\m -> m >>= return) (\m -> m) gen shrinkNothing         describe (bindTypeStr @f) $             it                 (unwords@@ -201,15 +214,16 @@                 (\m (Anon k) (Anon h) -> m >>= (\x -> k x >>= h))                 (\m (Anon k) (Anon h) -> (m >>= k) >>= h)                 ((,,) <$> gen <*> (Anon <$> genbf) <*> (Anon <$> gencf))+                shrinkNothing         describe (unwords ["relation with Applicative", nameOf @f]) $ do             it                 (unwords                      ["satisfies 'pure = return' for", genDescr @(f a) genname]) $-                equivalentOnGen (pure @f) (return @f) gena+                equivalentOnGen (pure @f) (return @f) gena shrinkNothing             it                 (unwords                      [ "satisfies '(<*>) = ap' for"-                     , genDescr @(f (a -> b)) $ genfabname+                     , genDescr @(f (a -> b)) genfabname                      , "and"                      , genDescr @(f a) genname                      ]) $@@ -217,6 +231,7 @@                     (\(Anon a) b -> a <*> b)                     (\(Anon a) b -> ap a b)                     ((,) <$> (Anon <$> genfab) <*> gen)+                    shrinkNothing             it                 (unwords                      [ "satisfies '(>>) = (*>)' for"@@ -224,8 +239,8 @@                      , "and"                      , genDescr @(f b) genbname                      ]) $-                equivalentOnGens2 (>>) (*>) ((,) <$> gen <*> genb)-        describe (unwords ["relation with Functor", nameOf @f]) $ do+                equivalentOnGens2 (>>) (*>) ((,) <$> gen <*> genb) shrinkNothing+        describe (unwords ["relation with Functor", nameOf @f]) $             it                 (unwords                      [ "satisfies 'fmap f xs = xs >>= return . f' for"@@ -233,7 +248,8 @@                      , "and"                      , genDescr @(f a) genname                      ]) $-                equivalentOnGens2-                    (\(Anon f) xs -> fmap f xs)-                    (\(Anon f) xs -> xs >>= (return . f))-                    ((,) <$> (Anon <$> geng) <*> gen)+            equivalentOnGens2+                (\(Anon f) xs -> fmap f xs)+                (\(Anon f) xs -> xs >>= (return . f))+                ((,) <$> (Anon <$> geng) <*> gen)+                shrinkNothing
src/Test/Validity/Monoid.hs view
@@ -55,7 +55,7 @@     :: forall a.        (Show a, Eq a, Monoid a, Typeable a, GenValid a)     => Spec-monoidSpecOnValid = monoidSpecOnGen @a genValid "valid"+monoidSpecOnValid = monoidSpecOnGen @a genValid "valid" shrinkValid  -- | Standard test spec for properties of 'Monoid' instances for unchecked values --@@ -66,7 +66,7 @@     :: forall a.        (Show a, Eq a, Monoid a, Typeable a, GenUnchecked a)     => Spec-monoidSpec = monoidSpecOnGen @a genUnchecked "unchecked"+monoidSpec = monoidSpecOnGen @a genUnchecked "unchecked" shrinkUnchecked  -- | Standard test spec for properties of 'Monoid' instances for arbitrary values --@@ -77,7 +77,7 @@     :: forall a.        (Show a, Eq a, Monoid a, Typeable a, Arbitrary a)     => Spec-monoidSpecOnArbitrary = monoidSpecOnGen @a arbitrary "arbitrary"+monoidSpecOnArbitrary = monoidSpecOnGen @a arbitrary "arbitrary" shrink  -- | Standard test spec for properties of Monoid instances for values generated by a given generator (and name for that generator). --@@ -87,15 +87,17 @@ monoidSpecOnGen     :: forall a.        (Show a, Eq a, Monoid a, Typeable a)-    => Gen a -> String -> Spec-monoidSpecOnGen gen genname =+    => Gen a -> String -> (a -> [a])-> Spec+monoidSpecOnGen gen genname s =     parallel $ do         let name = nameOf @a             memptystr = memptyTypeStr @a             mappendstr = mappendTypeStr @a             mconcatstr = mconcatTypeStr @a             gen3 = (,,) <$> gen <*> gen <*> gen+            s3 (a,b,c) = (,,) <$> s a <*> s b <*> s c             genl = genListOf gen+            sl = shrinkList s         describe ("Monoid " ++ name) $ do             let mem = mempty @a                 mapp = mappend @a@@ -108,18 +110,18 @@                          , "for"                          , genDescr @a genname                          ]) $-                identityOnGen mapp mem gen+                identityOnGen mapp mem gen s             describe mappendstr $                 it                     (unwords                          [ "is an associative operation for"                          , genDescr @(a, a, a) genname                          ]) $-                associativeOnGens mapp gen3+                associativeOnGens mapp gen3 s3             describe mconcatstr $                 it                     (unwords                          [ "is equivalent to its default implementation for"                          , genDescr @[a] genname                          ]) $-                equivalentOnGen mcon (foldr mapp mem) genl+                equivalentOnGen mcon (foldr mapp mem) genl sl
src/Test/Validity/Ord.hs view
@@ -33,27 +33,23 @@  {-# ANN module "HLint: ignore Use >" #-} -leTypeStr-    :: forall a.-       Typeable a+leTypeStr ::+       forall a. Typeable a     => String leTypeStr = binRelStr @a "<=" -geTypeStr-    :: forall a.-       Typeable a+geTypeStr ::+       forall a. Typeable a     => String geTypeStr = binRelStr @a ">=" -ltTypeStr-    :: forall a.-       Typeable a+ltTypeStr ::+       forall a. Typeable a     => String ltTypeStr = binRelStr @a "<" -gtTypeStr-    :: forall a.-       Typeable a+gtTypeStr ::+       forall a. Typeable a     => String gtTypeStr = binRelStr @a ">" @@ -62,67 +58,66 @@ -- Example usage: -- -- > ordSpecOnValid @Double-ordSpecOnValid-    :: forall a.-       (Show a, Ord a, Typeable a, GenValid a)+ordSpecOnValid ::+       forall a. (Show a, Ord a, Typeable a, GenValid a)     => Spec-ordSpecOnValid = ordSpecOnGen @a genUnchecked "unchecked"+ordSpecOnValid = ordSpecOnGen @a genValid "valid" shrinkValid  -- | Standard test spec for properties of Ord instances for invalid values -- -- Example usage: -- -- > ordSpecOnInvalid @Double-ordSpecOnInvalid-    :: forall a.-       (Show a, Ord a, Typeable a, GenInvalid a)+ordSpecOnInvalid ::+       forall a. (Show a, Ord a, Typeable a, GenInvalid a)     => Spec-ordSpecOnInvalid = ordSpecOnGen @a genInvalid "invalid"+ordSpecOnInvalid = ordSpecOnGen @a genInvalid "invalid" shrinkInvalid  -- | Standard test spec for properties of Ord instances for unchecked values -- -- Example usage: -- -- > ordSpec @Int-ordSpec-    :: forall a.-       (Show a, Ord a, Typeable a, GenUnchecked a)+ordSpec ::+       forall a. (Show a, Ord a, Typeable a, GenUnchecked a)     => Spec-ordSpec = ordSpecOnGen @a genUnchecked "unchecked"+ordSpec = ordSpecOnGen @a genUnchecked "unchecked" shrinkUnchecked  -- | Standard test spec for properties of Ord instances for arbitrary values -- -- Example usage: -- -- > ordSpecOnArbitrary @Int-ordSpecOnArbitrary-    :: forall a.-       (Show a, Ord a, Typeable a, Arbitrary a)+ordSpecOnArbitrary ::+       forall a. (Show a, Ord a, Typeable a, Arbitrary a)     => Spec-ordSpecOnArbitrary = ordSpecOnGen @a arbitrary "unchecked"+ordSpecOnArbitrary = ordSpecOnGen @a arbitrary "arbitrary" shrink  -- | Standard test spec for properties of Ord instances for values generated by a given generator (and name for that generator). -- -- Example usage: -- -- > ordSpecOnGen ((* 2) <$> genValid @Int) "even"-ordSpecOnGen-    :: forall a.-       (Show a, Eq a, Ord a, Typeable a)-    => Gen a -> String -> Spec-ordSpecOnGen gen genname =+ordSpecOnGen ::+       forall a. (Show a, Eq a, Ord a, Typeable a)+    => Gen a+    -> String+    -> (a -> [a])+    -> Spec+ordSpecOnGen gen genname s =     parallel $ do         let name = nameOf @a             funlestr = leTypeStr @a             fungestr = geTypeStr @a             funltstr = ltTypeStr @a             fungtstr = gtTypeStr @a-            cmple = ((<=) @a)-            cmpge = ((>=) @a)-            cmplt = ((<) @a)-            cmpgt = ((>) @a)+            cmple = (<=) @a+            cmpge = (>=) @a+            cmplt = (<) @a+            cmpgt = (>) @a             gen2 = (,) <$> gen <*> gen             gen3 = (,,) <$> gen <*> gen <*> gen+            s2 = shrinkT2 s         describe ("Ord " ++ name) $ do             describe funlestr $ do                 it@@ -131,28 +126,28 @@                          , "\"" ++ genname                          , name ++ "\"" ++ "'s"                          ]) $-                    reflexivityOnGen cmple gen+                    reflexivityOnGen cmple gen s                 it                     (unwords                          [ "is antisymmetric for"                          , "\"" ++ genname                          , name ++ "\"" ++ "'s"                          ]) $-                    antisymmetryOnGens cmple gen2+                    antisymmetryOnGens cmple gen2 s                 it                     (unwords                          [ "is transitive for"                          , "\"" ++ genname                          , name ++ "\"" ++ "'s"                          ]) $-                    transitivityOnGens cmple gen3+                    transitivityOnGens cmple gen3 s                 it                     (unwords                          [ "is equivalent to (\\a b -> compare a b /= GT) for"                          , "\"" ++ genname                          , name ++ "\"" ++ "'s"                          ]) $-                    equivalentOnGens2 cmple (\a b -> compare a b /= GT) gen2+                    equivalentOnGens2 cmple (\a b -> compare a b /= GT) gen2 s2             describe fungestr $ do                 it                     (unwords@@ -160,28 +155,28 @@                          , "\"" ++ genname                          , name ++ "\"" ++ "'s"                          ]) $-                    reflexivityOnGen cmpge gen+                    reflexivityOnGen cmpge gen s                 it                     (unwords                          [ "is antisymmetric for"                          , "\"" ++ genname                          , name ++ "\"" ++ "'s"                          ]) $-                    antisymmetryOnGens cmpge gen2+                    antisymmetryOnGens cmpge gen2 s                 it                     (unwords                          [ "is transitive for"                          , "\"" ++ genname                          , name ++ "\"" ++ "'s"                          ]) $-                    transitivityOnGens cmpge gen3+                    transitivityOnGens cmpge gen3 s                 it                     (unwords                          [ "is equivalent to (\\a b -> compare a b /= LT) for"                          , "\"" ++ genname                          , name ++ "\"" ++ "'s"                          ]) $-                    equivalentOnGens2 cmpge (\a b -> compare a b /= LT) gen2+                    equivalentOnGens2 cmpge (\a b -> compare a b /= LT) gen2 s2             describe funltstr $ do                 it                     (unwords@@ -189,21 +184,21 @@                          , "\"" ++ genname                          , name ++ "\"" ++ "'s"                          ]) $-                    antireflexivityOnGen cmplt gen+                    antireflexivityOnGen cmplt gen s                 it                     (unwords                          [ "is transitive for"                          , "\"" ++ genname                          , name ++ "\"" ++ "'s"                          ]) $-                    transitivityOnGens cmplt gen3+                    transitivityOnGens cmplt gen3 s                 it                     (unwords                          [ "is equivalent to (\\a b -> compare a b == LT) for"                          , "\"" ++ genname                          , name ++ "\"" ++ "'s"                          ]) $-                    equivalentOnGens2 cmplt (\a b -> compare a b == LT) gen2+                    equivalentOnGens2 cmplt (\a b -> compare a b == LT) gen2 s2             describe fungtstr $ do                 it                     (unwords@@ -211,18 +206,18 @@                          , "\"" ++ genname                          , name ++ "\"" ++ "'s"                          ]) $-                    antireflexivityOnGen cmpgt gen+                    antireflexivityOnGen cmpgt gen s                 it                     (unwords                          [ "is transitive for"                          , "\"" ++ genname                          , name ++ "\"" ++ "'s"                          ]) $-                    transitivityOnGens cmpgt gen3+                    transitivityOnGens cmpgt gen3 s                 it                     (unwords                          [ "is equivalent to (\\a b -> compare a b == GT) for"                          , "\"" ++ genname                          , name ++ "\"" ++ "'s"                          ]) $-                    equivalentOnGens2 cmpgt (\a b -> compare a b == GT) gen2+                    equivalentOnGens2 cmpgt (\a b -> compare a b == GT) gen2 s2
src/Test/Validity/RelativeValidity.hs view
@@ -20,6 +20,7 @@ import Test.Hspec import Test.QuickCheck +import Test.Validity.Property.Utils import Test.Validity.Utils  -- | A @Spec@ that specifies that @isValidFor@ implies @isValid@@@ -30,8 +31,8 @@ -- Example usage: -- -- > relativeValiditySpec @MyDataFor @MyOtherData-relativeValiditySpec-    :: forall a b.+relativeValiditySpec ::+       forall a b.        ( Typeable a        , Typeable b        , Show a@@ -56,8 +57,8 @@                     relativeValidityImpliesValidB @a @b  -- | @isValidFor a b@ implies @isValid a@ for all @b@-relativeValidityImpliesValidA-    :: forall a b.+relativeValidityImpliesValidA ::+       forall a b.        ( Show a        , Show b        , Validity a@@ -67,12 +68,12 @@        )     => Property relativeValidityImpliesValidA =-    forAll genUnchecked $ \(a :: a) ->-        forAll genUnchecked $ \(b :: b) -> (a `isValidFor` b) ===> isValid a+    forAllUnchecked $ \(a :: a) ->+        forAllUnchecked $ \(b :: b) -> (a `isValidFor` b) ===> isValid a  -- | @isValidFor a b@ implies @isValid b@ for all @a@-relativeValidityImpliesValidB-    :: forall a b.+relativeValidityImpliesValidB ::+       forall a b.        ( Show a        , Show b        , Validity b@@ -82,5 +83,5 @@        )     => Property relativeValidityImpliesValidB =-    forAll genUnchecked $ \(a :: a) ->-        forAll genUnchecked $ \(b :: b) -> (a `isValidFor` b) ===> isValid b+    forAllUnchecked $ \(a :: a) ->+        forAllUnchecked $ \(b :: b) -> (a `isValidFor` b) ===> isValid b
+ src/Test/Validity/Shrinking.hs view
@@ -0,0 +1,65 @@+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE ScopedTypeVariables #-}++-- | Tests for Shrinking functions+--+-- You will need @TypeApplications@ to use these.+module Test.Validity.Shrinking+    ( shrinkValiditySpec+    , shrinkValidSpec+    , shrinkInvalidSpec+    , shrinkValidPreservesValidOnGenValid+    , shrinkInvalidPreservesInvalidOnGenInvalid+    , shrinkPreservesValidOnGenValid+    , shrinkPreservesInvalidOnGenInvalid+    , shrinkValidPreservesValid+    , shrinkInvalidPreservesInvalid+    , shrinkingStaysValid+    , shrinkingStaysInvalid+    , shrinkingPreserves+    ) where++import Data.Data++import Data.GenValidity++import Test.Hspec+import Test.QuickCheck++import Test.Validity.Shrinking.Property+import Test.Validity.Utils++shrinkValiditySpec ::+       forall a. (Show a, Typeable a, GenValid a, GenInvalid a)+    => Spec+shrinkValiditySpec = do+    shrinkValidSpec @a+    shrinkInvalidSpec @a++shrinkValidSpec ::+       forall a. (Show a, Typeable a, GenValid a)+    => Spec+shrinkValidSpec =+    describe ("shrinkValid :: " ++ nameOf @(a -> [a])) $+    it "preserves validity" $ shrinkValidPreservesValidOnGenValid @a++shrinkInvalidSpec ::+       forall a. (Show a, Typeable a, GenInvalid a)+    => Spec+shrinkInvalidSpec =+    describe ("shrinkInvalid :: " ++ nameOf @(a -> [a])) $+    it "preserves invalidity" $ shrinkInvalidPreservesInvalidOnGenInvalid @a++shrinkValidPreservesValidOnGenValid ::+       forall a. (Show a, GenValid a)+    => Property+shrinkValidPreservesValidOnGenValid =+    shrinkingStaysValid @a genValid shrinkValid++shrinkInvalidPreservesInvalidOnGenInvalid ::+       forall a. (Show a, GenInvalid a)+    => Property+shrinkInvalidPreservesInvalidOnGenInvalid =+    shrinkingStaysInvalid @a genInvalid shrinkInvalid
src/Test/Validity/Utils.hs view
@@ -3,44 +3,53 @@ {-# LANGUAGE TypeApplications #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE CPP #-}  -- | Utilities for defining your own validity 'Spec's -- -- You will need @TypeApplications@ to use these. module Test.Validity.Utils-    ( (<==>)-    , (===>)-    , nameOf+    ( nameOf     , genDescr     , binRelStr+    , shouldFail+    , failsBecause     , Anon(..)+    , shouldBeValid+    , shouldBeInvalid     ) where  import Data.Data+import Data.Validity -import Test.Validity.Property.Utils+import Control.Monad -nameOf-    :: forall a.-       Typeable a+import Test.Hspec+import Test.Hspec.Core.Formatters+import Test.Hspec.Core.Runner+import Test.Hspec.Core.Spec+import Test.QuickCheck.Property++nameOf ::+       forall a. Typeable a     => String nameOf = show $ typeRep (Proxy @a) -genDescr-    :: forall a.-       Typeable a-    => String -> String+genDescr ::+       forall a. Typeable a+    => String+    -> String genDescr genname = unwords ["\"" ++ genname, "::", nameOf @a ++ "\""] -binRelStr-    :: forall a.-       Typeable a-    => String -> String+binRelStr ::+       forall a. Typeable a+    => String+    -> String binRelStr op = unwords ["(" ++ op ++ ")", "::", name, "->", name, "->", "Bool"]   where     name = nameOf @a -data Anon a =+newtype Anon a =     Anon a  instance Show (Anon a) where@@ -48,3 +57,69 @@  instance Functor Anon where     fmap f (Anon a) = Anon (f a)++-- | Asserts that a given 'Spec' tree fails _somewhere_.+--+-- It also shows the given string when reporting that the tree unexpectedly+-- succeeded.+failsBecause :: String -> SpecWith () -> SpecWith ()+failsBecause s = mapSpecTree go+  where+    go :: SpecTree () -> SpecTree ()+    go sp =+        Leaf+            Item+            { itemRequirement = s+            , itemLocation = Nothing+            , itemIsParallelizable = False+            , itemExample =+                  \_ _ _ -> do+                      let conf = defaultConfig {configFormatter = Just silent}+                      r <- hspecWithResult conf $ fromSpecList [sp]+                      let succesful =+                              summaryExamples r > 0 && summaryFailures r > 0+                      pure $ produceResult succesful+            }+#if MIN_VERSION_hspec_core(2,4,0)+produceResult :: Bool -> Either a Test.Hspec.Core.Spec.Result+produceResult succesful =+    Right $+    if succesful+        then Success+        else Failure Nothing $ Reason "Should have failed but didn't."+#else+produceResult :: Bool -> Test.Hspec.Core.Spec.Result+produceResult succesful =+    if succesful+        then Success+        else Fail Nothing "Should have failed but didn't."+#endif+shouldFail :: Property -> Property+shouldFail =+    mapResult $ \res ->+        res+        { reason = unwords ["Should have failed:", reason res]+        , expect = not $ expect res+        }++shouldBeValid :: (Show a, Validity a) => a -> Expectation+shouldBeValid a = do+    case prettyValidation a of+        Right _ -> pure ()+        Left err ->+            expectationFailure $+            unlines+                [ "'validate' reported this value to be invalid: " ++ show a+                , err+                , ""+                ]+    unless (isValid a) $+        expectationFailure $+        unlines+            [ "isValid considered this value invalid: " ++ show a+            , "This is odd because 'validate' reported no issues."+            , "Are you sure 'Validity' is implemented correctly?"+            ]++shouldBeInvalid :: (Show a, Validity a) => a -> Expectation+shouldBeInvalid a = a `shouldNotSatisfy` isValid
test/Test/Validity/EqSpec.hs view
@@ -9,7 +9,7 @@  import Data.GenValidity import Test.Validity.Eq-import Test.Validity.TestUtils+import Test.Validity.Utils  spec :: Spec spec = do@@ -17,7 +17,7 @@     eqSpec @Int     failsBecause "reflexivity does not hold for NaN" $ eqSpecOnInvalid @Double     eqSpecOnArbitrary @Int-    eqSpecOnGen ((* 2) <$> genValid @Int) "even"+    eqSpecOnGen ((* 2) <$> genValid @Int) "even" (const [])     failsBecause "(/=) and (==) don't have opposite semantics" $         eqSpec @EqFuncMismatch @@ -31,3 +31,4 @@  instance GenUnchecked EqFuncMismatch where     genUnchecked = EqFuncMismatch <$> genUnchecked+    shrinkUnchecked _ = []
test/Test/Validity/FunctorSpec.hs view
@@ -6,7 +6,7 @@  import Data.GenValidity import Test.Validity.Functor-import Test.Validity.TestUtils+import Test.Validity.Utils  spec :: Spec spec = do@@ -39,15 +39,16 @@         "Just an ABC"         ((++) <$> genValid)         "prepends"-        ((flip (++)) <$> genValid)+        (flip (++) <$> genValid)         "appends" -data Fcks a =+newtype Fcks a =     Fcks Int     deriving (Show, Eq)  instance GenUnchecked (Fcks a) where     genUnchecked = Fcks <$> genUnchecked+    shrinkUnchecked (Fcks i) = Fcks <$> shrinkUnchecked i  instance Functor Fcks where     fmap _ (Fcks i) = Fcks $ i * 2
test/Test/Validity/GenRelativeValiditySpec.hs view
@@ -1,5 +1,3 @@-{-# LANGUAGE TypeApplications #-}- module Test.Validity.GenRelativeValiditySpec where  import Test.Hspec
test/Test/Validity/MonadSpec.hs view
@@ -7,6 +7,8 @@ import Data.GenValidity import Test.Validity.Monad +{-# ANN module "HLint: ignore Use :" #-}+ spec :: Spec spec = do     monadSpec @[]@@ -42,7 +44,7 @@         "Just an ABC"         (Just <$> pure "CDE")         "Just an ABC"-        ((flip (++)) <$> genValid)+        (flip (++) <$> genValid)         "appends"         (pure $ \a -> Just a)         "justisation"
test/Test/Validity/MonoidSpec.hs view
@@ -11,4 +11,4 @@     monoidSpecOnValid @[Double]     monoidSpec @[Int]     monoidSpecOnArbitrary @[Int]-    monoidSpecOnGen (pure "a") "singleton list of 'a'"+    monoidSpecOnGen (pure "a") "singleton list of 'a'" (const [])
test/Test/Validity/OrdSpec.hs view
@@ -6,7 +6,7 @@  import Data.GenValidity import Test.Validity.Ord-import Test.Validity.TestUtils+import Test.Validity.Utils  spec :: Spec spec = do@@ -14,4 +14,4 @@     failsBecause "NaN >= NaN is False" $ ordSpecOnInvalid @Double     ordSpec @Int     ordSpecOnArbitrary @Int-    ordSpecOnGen ((* 2) <$> genValid @Int) "even"+    ordSpecOnGen ((* 2) <$> genValid @Int) "even" (const [])
test/Test/Validity/RelativeValiditySpec.hs view
@@ -1,5 +1,3 @@-{-# LANGUAGE TypeApplications #-}- module Test.Validity.RelativeValiditySpec where  import Test.Hspec
+ test/Test/Validity/ShrinkingSpec.hs view
@@ -0,0 +1,20 @@+{-# LANGUAGE TypeApplications #-}++module Test.Validity.ShrinkingSpec where++import Test.Hspec++import Test.Validity.Shrinking++spec :: Spec+spec = do+    shrinkValiditySpec @Double+    shrinkValidSpec @Int+    shrinkInvalidSpec @Double+    describe "shrinkValidPreservesValidOnGenValid" $ do+        it "Int" $ shrinkValidPreservesValidOnGenValid @Int+        it "Double" $ shrinkValidPreservesValidOnGenValid @Double+        it "[Double]" $ shrinkValidPreservesValidOnGenValid @[Double]+    describe "shrinkInvalidPreservesInvalidOnGenInvalid" $ do+        it "Double" $ shrinkInvalidPreservesInvalidOnGenInvalid @Double+        it "[Double]" $ shrinkInvalidPreservesInvalidOnGenInvalid @[Double]
− test/Test/Validity/TestUtils.hs 
@@ -1,54 +0,0 @@-{-# LANGUAGE TypeApplications #-}-{-# LANGUAGE CPP #-}---- | Utilities to define your own validity-based 'Property's------ You will need @TypeApplications@ to use these.-module Test.Validity.TestUtils where--import Test.Hspec--import Data.GenValidity-import Test.Validity--import Test.Hspec.Core.Formatters-import Test.Hspec.Core.Runner-import Test.Hspec.Core.Spec-import Test.QuickCheck.Property--failsBecause :: String -> SpecWith () -> SpecWith ()-failsBecause s st = mapSpecTree go st-  where-    go :: SpecTree () -> SpecTree ()-    go sp =-        Leaf $-        Item-        { itemRequirement = s-        , itemLocation = Nothing-        , itemIsParallelizable = False-        , itemExample =-              \ps runner callback -> do-                  let conf = defaultConfig {configFormatter = Just silent}-                  r <- hspecWithResult conf $ fromSpecList [sp]-                  let succesful = summaryExamples r > 0 && summaryFailures r > 0-                  pure $ produceResult succesful-        }-#if MIN_VERSION_hspec_core(2,4,0)-produceResult succesful =-    Right $-    if succesful-        then Success-        else Failure Nothing $ Reason "Should have failed but didn't."-#else-produceResult succesful =-    if succesful-        then Success-        else Fail Nothing "Should have failed but didn't."-#endif-shouldFail :: Property -> Property-shouldFail =-    mapResult $ \res ->-        res-        { reason = unwords ["Should have failed:", reason res]-        , expect = not $ expect res-        }