diff --git a/CHANGELOG.md b/CHANGELOG.md
new file mode 100644
--- /dev/null
+++ b/CHANGELOG.md
@@ -0,0 +1,5 @@
+# Changelog for `quickcheck-helpers`
+
+## 1.0.0
+
+First release.
diff --git a/LICENSE.md b/LICENSE.md
new file mode 100644
--- /dev/null
+++ b/LICENSE.md
@@ -0,0 +1,20 @@
+# The MIT License (MIT)
+
+Copyright © 2026 MLabs
+
+Permission is hereby granted, free of charge, to any person obtaining a copy of
+this software and associated documentation files (the “Software”), to deal in
+the Software without restriction, including without limitation the rights to
+use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of
+the Software, and to permit persons to whom the Software is furnished to do so,
+subject to the following conditions:
+
+The above copyright notice and this permission notice shall be included in all
+copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED “AS IS”, WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS
+FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR
+COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER
+IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
+CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
diff --git a/README.md b/README.md
new file mode 100644
--- /dev/null
+++ b/README.md
@@ -0,0 +1,129 @@
+# `quickcheck-helpers`
+
+## What is this?
+
+Consider a typical product type:
+
+```haskell
+data Pair a = Pair a a
+```
+
+To use `Pair` in QuickCheck tests, you need an `Arbitrary` instance. For product
+types, the `arbitrary` method is easy to define:
+
+```haskell
+instance Arbitrary a => Arbitrary (Pair a) where
+    arbitrary = Pair <$> arbitrary <*> arbitrary
+```
+
+However, if we try to define `shrink` similarly, we will get serious issues:
+
+```haskell
+instance Arbitrary a => Arbitrary (Pair a) where
+    -- Fine
+    arbitrary = Pair <$> arbitrary <*> arbitrary
+    -- Very not fine
+    shrink (Pair x y) = Pair <$> shrink x <*> shrink y
+```
+
+Why? Consider `Pair 0 6 :: Pair Int`. We expect that this should still shrink:
+even though the first field is not shrinkable, the second one still is. If we
+try to shrink, however, we get an unpleasant surprise:
+
+```
+>>> shrink (Pair 0 6 :: Pair Int)
+[]
+```
+
+In general, if we define shrinkers for product types in the way shown above,
+shrinking will stop when _any_ field is non-shrinkable. This is not a
+consequence of the syntax per se: even if we rewrite it monadically, this still
+happens.
+
+To avoid this, we have two options. One is to manually write the shrinker in a
+very specific way:
+
+```haskell
+instance Arbitrary a => Arbitrary (Pair a) where
+    -- No change
+    arbitrary = Pair <$> arbitrary <*> arbitrary
+    -- Fix, but at what cost?
+    shrink (Pair x y) = (Pair <$> pure x <*> shrink y) <|>
+                        (Pair <$> shrink x <*> pure y)
+```
+
+This will solve the problem, but it's tedious, error-prone and very long.
+
+Another option is to derive `Generic` for your type, then use `genericShrink`
+from QuickCheck:
+
+```haskell
+data Pair a = Pair a a
+    deriving stock (Generic)
+
+instance Arbitrary a => Arbitrary (Pair a) where
+    -- No change
+    arbitrary = Pair <$> arbitrary <*> arbitrary
+    shrink = genericShrink
+```
+
+This will also solve the problem, but comes at significant costs in compile-time
+performance, run-time performance and a complete and utter lack of clarity about
+what actual code gets generated. These are all problems typical of `Generic`
+use. However, there is also a deeper problem with this solution. Consider the
+following data type:
+
+```haskell
+data CountedList a = CountedList Int [a]
+    deriving stock (Generic)
+```
+
+This data type requires maintaining a _non-structural_ invariant about the `Int`
+field. Specifically, the `Int` field must be exactly the length of the `[a]`
+field. However, if we attempt to use `genericShrink` with this type:
+
+```haskell
+instance Arbitrary a => Arbitrary (CountedList a) where
+    arbitrary = do
+        NonNegative len <- arbitrary
+        CountedList len <$> vectorOf len
+    shrink = genericShrink
+```
+
+you will end up with many nonsensical shrinks:
+
+```
+shrink (CountedList 2 [1, 3] :: CountedList Int)
+>>> [CountedList 0 [1,3],CountedList 1 [1,3],CountedList 2 [],CountedList 2 [3],CountedList 2 [1],CountedList 2 [0,3],CountedList 2 [1,0],CountedList 2 [1,2]]
+```
+
+Thus, both solutions are in some way inadequate.
+
+`quickcheck-helpers` solves this problem, allowing both concise definitions of
+`shrink` for product types (mirroring `arbitrary`) while also giving full
+control if necessary.
+
+## How do I use it?
+
+For the `Pair` example above:
+
+```
+import Test.QuickCheck.Helpers (toShrink, neShrink)
+
+data Pair a = Pair a a
+
+instance Arbitrary a => Arbitrary (Pair a) where
+    -- No change
+    arbitrary = Pair <$> arbitrary <*> arbitrary
+    -- Using the new functionality
+    shrink (Pair x y) = toShrink (Pair <$> neShrink x <*> neShrink y)
+```
+
+This solution has both the conciseness of the original (and wrong) shrinkers,
+while also giving the improved shrinks of either of the naive solutions, without
+the downsides.
+
+## What can I do with this?
+
+This library is licensed under the MIT license. See the `LICENSE.md` file for
+details.
diff --git a/quickcheck-helpers.cabal b/quickcheck-helpers.cabal
new file mode 100644
--- /dev/null
+++ b/quickcheck-helpers.cabal
@@ -0,0 +1,56 @@
+cabal-version: 3.0
+name: quickcheck-helpers
+version: 1.0.0
+synopsis: Helpers for writing shrinkers.
+description:
+  Provides a way to write shrinkers both concisely and easily, while
+  not sacrificing effectiveness.
+
+license: MIT
+author: Koz Ross
+maintainer: koz@mlabs.city
+copyright: (C) MLabs 2026
+category: Test
+build-type: Simple
+tested-with: ghc =={9.8.4, 9.10.3, 9.12.4, 9.14.1}
+extra-source-files:
+  CHANGELOG.md
+  LICENSE.md
+  README.md
+
+common lang
+  build-depends: base >=4.19.0.0 && <5
+  ghc-options:
+    -Wmissing-export-lists
+    -Wall
+    -Wcompat
+    -Wincomplete-record-updates
+    -Wincomplete-uni-patterns
+    -Wredundant-constraints
+    -Wmissing-deriving-strategies
+    -Wredundant-bang-patterns
+
+  default-language: Haskell2010
+
+library
+  import: lang
+  exposed-modules: Test.QuickCheck.Helpers
+  build-depends: QuickCheck ^>=2.18.0.0
+  hs-source-dirs: src
+
+test-suite tests
+  import: lang
+  type: exitcode-stdio-1.0
+  ghc-options:
+    -threaded
+    -rtsopts
+    -with-rtsopts=-N
+
+  main-is: Main.hs
+  hs-source-dirs: test
+  build-depends:
+    QuickCheck,
+    quickcheck-helpers,
+    tasty ^>=1.5.5,
+    tasty-quickcheck ^>=0.11.1,
+    tasty-quickcheck-laws ^>=0.0.3,
diff --git a/src/Test/QuickCheck/Helpers.hs b/src/Test/QuickCheck/Helpers.hs
new file mode 100644
--- /dev/null
+++ b/src/Test/QuickCheck/Helpers.hs
@@ -0,0 +1,254 @@
+{-# LANGUAGE AllowAmbiguousTypes #-}
+{-# LANGUAGE DeriveFunctor #-}
+{-# LANGUAGE DerivingVia #-}
+{-# LANGUAGE KindSignatures #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
+
+-- |
+-- Module: Test.QuickCheck.Helpers
+-- Description: Some functions to help define shrinkers.
+-- Copyright: MLabs (C) 2026
+-- License: MIT
+-- Maintainer: koz@mlabs.city
+--
+-- = Why we need this
+--
+-- Consider the following data type:
+--
+-- > data Pair a = Pair a a
+--
+-- If we want to define an 'Arbitrary' instance for this type, the 'arbitrary'
+-- method is straightforward:
+--
+-- > instance Arbitrary a => Arbitrary (Pair a) where
+-- >     arbitrary = Pair <$> arbitrary <*> arbitrary
+--
+-- In particular, we can use the applicative syntax to describe 'arbitrary' over
+-- @Pair@, which is essentially a product type, both clearly and concisely. One
+-- would naturally then believe that 'shrink' would be quite similar:
+--
+-- > instance Arbitrary a => Arbitrary (Pair a) where
+-- >     -- totally fine
+-- >     arbitrary = Pair <$> arbitrary <*> arbitrary
+-- >     -- very much not fine
+-- >     shrink (Pair x y) = Pair <$> shrink x <*> shrink y
+--
+-- It is, however, very much /not/ similar, nor the right approach. To see why,
+-- consider @x = Pair 0 6 :: Pair Int@. We expect that @x@ shrinks; however,
+-- using our definition, this will not happen:
+--
+-- >>> shrink (Pair 0 6 :: Pair Int)
+-- []
+--
+-- This stems from the behaviour of @[]@ as the non-determinism effect: once we
+-- get an empty list, the entire computation is \'cut off\'. Thus, in a
+-- definition like the one above, a non-shrinking value in /any/ part of a
+-- @Pair@ term will block the entire shrink:
+--
+-- >>> shrink (Pair 6 0 :: Pair Int)
+-- []
+-- >>> shrink (Pair 0 0 :: Pair Int)
+-- []
+--
+-- While this doesn't violate any of the implicit requirements of shrinking, it
+-- is definitely suboptimal: we end up failing to shrink too soon, potentially
+-- leaving us with very complex counter-examples.
+--
+-- The correct way to write a \'product shrinker\' would be something akin to
+-- the following:
+--
+-- > instance Arbitrary a => Arbitrary (Pair a) where
+-- >     arbitrary = Pair <$> arbitrary <*> arbitrary
+-- >     shrink (Pair x y) = (Pair <$> pure x <*> shrink y) <|>
+--                           (Pair <$> shrink x <*> pure y)
+--
+-- Thus, for an @n@-ary product type, we have to write @n@-many entries between
+-- @<|>@, each with @n@-many fields, shrinking exactly one each time. This is
+-- long, tedious, and error-prone, especially on larger products.
+--
+-- = Why not use @Generic@?
+--
+-- If @Pair@ was given an instance of @Generic@, we could avoid this tedium:
+--
+-- > data Pair a = Pair a a
+-- >     deriving stock (Generic)
+-- >
+-- > instance Arbitrary a => Arbitrary (Pair a) where
+-- >     arbitrary = Pair <$> arbitrary <*> arbitrary
+-- >     shrink = genericShrink
+--
+-- However, setting aside the lack of code clarity and performance issues of
+-- @Generic@, this method is not suitable for any type with \'internal
+-- invariants\'. More specifically, 'Test.Quickcheck.genericShrink' is purely structural, and
+-- will not maintain any invariant that isn't enforced by the type system
+-- directly. For example, consider the following:
+--
+-- > data CountedList a = CountedList Int [a]
+--
+-- Here, the @Int@ field has to obey the following invariants:
+--
+-- * Must be non-negative; and
+-- * Must be the same as the length of the @[a]@ field.
+--
+-- If we were to implement 'Arbitrary' for @CountedList@ using 'Test.QuickCheck.genericShrink'
+-- for the shrinker, we would end up with nonsensical shrinks that violate these
+-- invariants. This could cause test failures that would never reflect realistic
+-- use of this type: we expect that its API would maintain these invariants, and
+-- thus, such situations should not arise.
+--
+-- Thus, in any situation where we have invariants that aren't \'purely
+-- structural\', this method is incorrect and cannot be used.
+--
+-- = Our solution
+--
+-- We want to ensure that for a product type, shrinking only fails if /all/
+-- fields fail to shrink, rather than if /any/ fields fail to shrink. For this,
+-- we have 'Shrink', which is essentially @[]@ with the added ability to
+-- remember what term we asked it to shrink. This allows us to avoid the \'early
+-- failure\' problem of @[]@ described earlier. We can use 'neShrink' to
+-- \'promote\' regular shrinkers for fields into 'Shrink'. Once we're finished
+-- with our product type, we can use 'runShrink' to \'return\' back to @[]@.
+--
+-- If we use 'Shrink' via 'neShrink' and 'runShrink' to define @Pair@'s
+-- 'Arbitrary' instance, we get the following:
+--
+-- > data Pair a = Pair a a
+-- >
+-- > instance Arbitrary a => Arbitrary (Pair a) where
+-- >     arbitrary = Pair <$> arbitrary <*> arbitrary
+-- >     shrink (Pair x y) = 'runShrink' (Pair <$> 'neShrink' x <*> 'neShrink' y)
+--
+-- We now can have a similar level of clarity and conciseness to the 'arbitrary'
+-- method, but /without/ the undesirable behaviour we saw before:
+--
+-- >>> shrink (Pair 0 6 :: Pair Int)
+-- [Pair 0 5, Pair 0 3, Pair 0 0]
+-- >>> shrink (Pair 6 0 :: Pair Int)
+-- [Pair 5 0, Pair 3 0, Pair 0 0]
+-- >>> shrink (Pair 0 0 :: Pair Int)
+-- []
+--
+-- @since 1.0.0
+module Test.QuickCheck.Helpers
+  ( Shrink,
+    neShrink,
+    neShrinkOver,
+    neShrinkWhen,
+    runShrink,
+    toShrink,
+  )
+where
+
+import Data.Coerce (Coercible, coerce)
+import Data.Kind (Type)
+import Data.List.NonEmpty (NonEmpty ((:|)))
+import Test.QuickCheck (Arbitrary (arbitrary, shrink), oneof)
+
+-- | A \'non-empty\' shrinking effect. Unlike shrinkers implemented in @[]@,
+-- 'Shrink' remembers what value it was asked to shrink, and can produce it if
+-- no shrinks are available.
+--
+-- @since 1.0.0
+data Shrink (a :: Type)
+  = NonShrinking a
+  | Shrinking (NonEmpty a)
+  deriving stock
+    ( -- | @since 1.0.0
+      Eq,
+      -- | @since 1.0.0
+      Show,
+      -- | @since 1.0.0
+      Functor
+    )
+
+-- | @since 1.0.0
+instance Applicative Shrink where
+  pure = NonShrinking
+  fs <*> xs = case fs of
+    NonShrinking f -> case xs of
+      NonShrinking x -> NonShrinking (f x)
+      Shrinking xs' -> Shrinking (fmap f xs')
+    Shrinking fs' -> case xs of
+      NonShrinking x -> Shrinking (fmap ($ x) fs')
+      Shrinking xs' -> Shrinking (fs' <*> xs')
+
+-- | @since 1.0.0
+instance (Arbitrary a) => Arbitrary (Shrink a) where
+  arbitrary = oneof [NonShrinking <$> arbitrary, Shrinking <$> arbitrary]
+  shrink = \case
+    NonShrinking _ -> []
+    Shrinking xs -> Shrinking <$> shrink xs
+
+-- | Convert a 'Shrink' into an expected QuickCheck shrinker result.
+-- Specifically, if a 'Shrink' has no valid shrink targets, 'runShrink' will
+-- produce an empty list; otherwise, it will produce a list of targets.
+--
+-- @since 1.0.0
+runShrink ::
+  forall (a :: Type).
+  Shrink a ->
+  [a]
+runShrink = \case
+  NonShrinking _ -> []
+  Shrinking (y :| ys) -> y : ys
+
+-- | As 'runShrink', but instead of converting a 'Shrink', it will convert a
+-- function producing a shrink into a valid implementation of the 'shrink' type
+-- class method of 'Arbitrary'.
+--
+-- @since 1.0.0
+toShrink ::
+  forall (a :: Type).
+  (a -> Shrink a) ->
+  a ->
+  [a]
+toShrink f x = runShrink (f x)
+
+-- | \'Promotes\' an implementation of 'shrink' into 'Shrink'.
+--
+-- @since 1.0.0
+neShrink ::
+  forall (a :: Type).
+  (Arbitrary a) => a -> Shrink a
+neShrink x = case shrink x of
+  [] -> NonShrinking x
+  (y : ys) -> Shrinking (y :| ys)
+
+-- | As 'neShrink', but by way of a \'wrapper\' we can 'coerce' through. Useful
+-- with modifiers, as it means you don't have to manually unwrap and re-wrap
+-- them.
+--
+-- = Note
+--
+-- This function is ambiguously typed, and expects a type argument to determine
+-- what \'wrapper\' to use. The type signature is designed to allow easy use of
+-- @TypeApplications@ for this:
+--
+-- > -- Wraps a value into NonNegative for shrinking, then unwraps
+-- > neShrinkOver @(NonNegative Integer) x
+--
+-- @since 1.0.0
+neShrinkOver ::
+  forall (b :: Type) (a :: Type).
+  (Arbitrary b, Coercible a b) =>
+  a -> Shrink a
+neShrinkOver x = case coerce . shrink @b . coerce $ x of
+  [] -> NonShrinking x
+  (y : ys) -> Shrinking (y :| ys)
+
+-- | As 'neShrink', but allows adding a condition that any shrunk results must
+-- satisfy. This is needed because 'Shrink' cannot be an instance of
+-- 'Control.Applicative.Alternative'.
+--
+-- @since 1.0.0
+neShrinkWhen ::
+  forall (a :: Type).
+  (Arbitrary a) =>
+  (a -> Bool) ->
+  a ->
+  Shrink a
+neShrinkWhen cond x = case filter cond . shrink $ x of
+  [] -> NonShrinking x
+  (y : ys) -> Shrinking (y :| ys)
diff --git a/test/Main.hs b/test/Main.hs
new file mode 100644
--- /dev/null
+++ b/test/Main.hs
@@ -0,0 +1,84 @@
+{-# LANGUAGE DerivingVia #-}
+{-# LANGUAGE KindSignatures #-}
+{-# LANGUAGE NumericUnderscores #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE TypeApplications #-}
+{-# OPTIONS_GHC -Wno-orphans #-}
+
+module Main (main) where
+
+import Data.Kind (Type)
+import Data.Proxy (Proxy (Proxy))
+import Test.QuickCheck
+  ( Arbitrary (arbitrary, shrink),
+    Gen,
+    Property,
+    forAll,
+    (.&&.),
+    (===),
+  )
+import Test.QuickCheck.Helpers (Shrink, neShrink, toShrink)
+import Test.QuickCheck.Poly (A)
+import Test.Tasty (adjustOption, defaultMain, testGroup)
+import Test.Tasty.QuickCheck (QuickCheckTests, testProperty)
+import Test.Tasty.QuickCheck.Laws (Checkable)
+import Test.Tasty.QuickCheck.Laws.Applicative (testApplicativeLaws1)
+
+main :: IO ()
+main =
+  defaultMain . adjustOption moreTests . testGroup "Tests" $
+    [ adjustOption fewerTests $ testApplicativeLaws1 (Proxy @Shrink) (Proxy @()) (Proxy @A) (const (==)),
+      testProperty "Shrink with <*>" propBadShrink,
+      testProperty "neShrink with <*> (left non-shrinking)" propGoodShrinkLeft,
+      testProperty "neShrink with <*> (right non-shrinking)" propGoodShrinkRight
+    ]
+  where
+    moreTests :: QuickCheckTests -> QuickCheckTests
+    moreTests = max 10_000
+    -- Needed because the test for Applicative's associativity takes forever
+    -- otherwise
+    fewerTests :: QuickCheckTests -> QuickCheckTests
+    fewerTests x = x `quot` 8
+
+-- Properties
+
+propBadShrink :: Property
+propBadShrink = forAll ((,) <$> genPairLeft @Int <*> genPairRight @Int) $ \(pLeft, pRight) ->
+  [] === badShrink pLeft .&&. [] === badShrink pRight
+
+propGoodShrinkLeft :: Property
+propGoodShrinkLeft = forAll @(Pair Int) genPairLeft $ \p@(Pair x y) ->
+  (Pair x <$> shrink y) === goodShrink p
+
+propGoodShrinkRight :: Property
+propGoodShrinkRight = forAll @(Pair Int) genPairRight $ \p@(Pair x y) ->
+  (Pair <$> shrink x <*> pure y) === goodShrink p
+
+-- Helpers
+
+data Pair (a :: Type) = Pair a a
+  deriving stock (Eq, Show)
+
+genPairLeft ::
+  forall (a :: Type).
+  (Arbitrary a, Num a) => Gen (Pair a)
+genPairLeft = Pair 0 <$> arbitrary
+
+genPairRight ::
+  forall (a :: Type).
+  (Arbitrary a, Num a) => Gen (Pair a)
+genPairRight = Pair <$> arbitrary <*> pure 0
+
+badShrink ::
+  forall (a :: Type).
+  (Arbitrary a) => Pair a -> [Pair a]
+badShrink (Pair x y) = Pair <$> shrink x <*> shrink y
+
+goodShrink ::
+  forall (a :: Type).
+  (Arbitrary a) => Pair a -> [Pair a]
+goodShrink = toShrink (\(Pair x y) -> Pair <$> neShrink x <*> neShrink y)
+
+-- Ugh
+deriving via Integer instance Checkable A