diff --git a/genvalidity-hspec.cabal b/genvalidity-hspec.cabal
--- a/genvalidity-hspec.cabal
+++ b/genvalidity-hspec.cabal
@@ -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
diff --git a/src/Test/Validity.hs b/src/Test/Validity.hs
--- a/src/Test/Validity.hs
+++ b/src/Test/Validity.hs
@@ -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
+
diff --git a/src/Test/Validity/Applicative.hs b/src/Test/Validity/Applicative.hs
--- a/src/Test/Validity/Applicative.hs
+++ b/src/Test/Validity/Applicative.hs
@@ -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
diff --git a/src/Test/Validity/Arbitrary.hs b/src/Test/Validity/Arbitrary.hs
--- a/src/Test/Validity/Arbitrary.hs
+++ b/src/Test/Validity/Arbitrary.hs
@@ -44,4 +44,4 @@
     :: forall a.
        (Show a, Validity a, Arbitrary a)
     => Property
-arbitraryGeneratesOnlyValid = genGeneratesValid @a arbitrary
+arbitraryGeneratesOnlyValid = genGeneratesValid @a arbitrary shrink
diff --git a/src/Test/Validity/Eq.hs b/src/Test/Validity/Eq.hs
--- a/src/Test/Validity/Eq.hs
+++ b/src/Test/Validity/Eq.hs
@@ -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
diff --git a/src/Test/Validity/Functor.hs b/src/Test/Validity/Functor.hs
--- a/src/Test/Validity/Functor.hs
+++ b/src/Test/Validity/Functor.hs
@@ -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
diff --git a/src/Test/Validity/GenRelativeValidity.hs b/src/Test/Validity/GenRelativeValidity.hs
--- a/src/Test/Validity/GenRelativeValidity.hs
+++ b/src/Test/Validity/GenRelativeValidity.hs
@@ -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)
diff --git a/src/Test/Validity/GenValidity.hs b/src/Test/Validity/GenValidity.hs
--- a/src/Test/Validity/GenValidity.hs
+++ b/src/Test/Validity/GenValidity.hs
@@ -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
diff --git a/src/Test/Validity/Monad.hs b/src/Test/Validity/Monad.hs
--- a/src/Test/Validity/Monad.hs
+++ b/src/Test/Validity/Monad.hs
@@ -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
diff --git a/src/Test/Validity/Monoid.hs b/src/Test/Validity/Monoid.hs
--- a/src/Test/Validity/Monoid.hs
+++ b/src/Test/Validity/Monoid.hs
@@ -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
diff --git a/src/Test/Validity/Ord.hs b/src/Test/Validity/Ord.hs
--- a/src/Test/Validity/Ord.hs
+++ b/src/Test/Validity/Ord.hs
@@ -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
diff --git a/src/Test/Validity/RelativeValidity.hs b/src/Test/Validity/RelativeValidity.hs
--- a/src/Test/Validity/RelativeValidity.hs
+++ b/src/Test/Validity/RelativeValidity.hs
@@ -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
diff --git a/src/Test/Validity/Shrinking.hs b/src/Test/Validity/Shrinking.hs
new file mode 100644
--- /dev/null
+++ b/src/Test/Validity/Shrinking.hs
@@ -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
diff --git a/src/Test/Validity/Utils.hs b/src/Test/Validity/Utils.hs
--- a/src/Test/Validity/Utils.hs
+++ b/src/Test/Validity/Utils.hs
@@ -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
diff --git a/test/Test/Validity/EqSpec.hs b/test/Test/Validity/EqSpec.hs
--- a/test/Test/Validity/EqSpec.hs
+++ b/test/Test/Validity/EqSpec.hs
@@ -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 _ = []
diff --git a/test/Test/Validity/FunctorSpec.hs b/test/Test/Validity/FunctorSpec.hs
--- a/test/Test/Validity/FunctorSpec.hs
+++ b/test/Test/Validity/FunctorSpec.hs
@@ -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
diff --git a/test/Test/Validity/GenRelativeValiditySpec.hs b/test/Test/Validity/GenRelativeValiditySpec.hs
--- a/test/Test/Validity/GenRelativeValiditySpec.hs
+++ b/test/Test/Validity/GenRelativeValiditySpec.hs
@@ -1,5 +1,3 @@
-{-# LANGUAGE TypeApplications #-}
-
 module Test.Validity.GenRelativeValiditySpec where
 
 import Test.Hspec
diff --git a/test/Test/Validity/MonadSpec.hs b/test/Test/Validity/MonadSpec.hs
--- a/test/Test/Validity/MonadSpec.hs
+++ b/test/Test/Validity/MonadSpec.hs
@@ -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"
diff --git a/test/Test/Validity/MonoidSpec.hs b/test/Test/Validity/MonoidSpec.hs
--- a/test/Test/Validity/MonoidSpec.hs
+++ b/test/Test/Validity/MonoidSpec.hs
@@ -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 [])
diff --git a/test/Test/Validity/OrdSpec.hs b/test/Test/Validity/OrdSpec.hs
--- a/test/Test/Validity/OrdSpec.hs
+++ b/test/Test/Validity/OrdSpec.hs
@@ -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 [])
diff --git a/test/Test/Validity/RelativeValiditySpec.hs b/test/Test/Validity/RelativeValiditySpec.hs
--- a/test/Test/Validity/RelativeValiditySpec.hs
+++ b/test/Test/Validity/RelativeValiditySpec.hs
@@ -1,5 +1,3 @@
-{-# LANGUAGE TypeApplications #-}
-
 module Test.Validity.RelativeValiditySpec where
 
 import Test.Hspec
diff --git a/test/Test/Validity/ShrinkingSpec.hs b/test/Test/Validity/ShrinkingSpec.hs
new file mode 100644
--- /dev/null
+++ b/test/Test/Validity/ShrinkingSpec.hs
@@ -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]
diff --git a/test/Test/Validity/TestUtils.hs b/test/Test/Validity/TestUtils.hs
deleted file mode 100644
--- a/test/Test/Validity/TestUtils.hs
+++ /dev/null
@@ -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
-        }