One of the key ingredients of randomised property testing is the shrinker. The shrinker turns the output of a failed property test from “your function has a bug” to “here is a small actionable example where your function fails to meet the specification”. Specifically, after a randomised test has found a counterexample, the shrinker will kick in and recursively try smaller potential counterexamples until it can’t find a way to reduce the counterexample anymore.

Roll your own shrinker

When it comes to writing a shrinker for a particular generator, my advice is:

• If you are using QuickCheck and you can use genericShrink, do so.
• Otherwise, give Hedgehog a try

Hedgehog will automatically generate shrinkers for you, even for the most complex types. They are far from perfect, but in most cases, writing a shrinker manually is too hard to be worth it.

Nevertheless, there are some exceptions to everything. And you may find yourself in a situation where you have to write something which is much like a QuickCheck shrinker, but not quite. I have. If it happens to you, this blog post provides a tool to add to your tool belt.

Applicative functors

I really like applicative functors. If only because of how easy they make it to write traversals.

data T a
  = MkT1 a
  | MkT2 a (T a)
  | MkT3 a (T a) a

instance Traversable T where
  traverse f (MkT1 a) = MkT1 <$> f a
  traverse f (MkT2 a as) = MkT2 <$> f a <*> traverse f as
  traverse f (MkT3 a1 as a2) = MkT3 <$> f a1 <*> traverse f as <*> f a2

There is a zen to it, really: we’re just repeating the definition. Just slightly accented.

So when defining a shrinker, I want to reach for an applicative functor.

Let’s look at the type of shrink: from a counterexample, shrink proposes a list of smaller candidate counterexample to check:

shrink :: a -> [a]

Ah, great! [] is already an applicative functor. So we can go and define

shrink :: (a, b) -> [(a, b)]
shrink = (,) <$> shrink a <*> shrink b
-- Which expands to:
shrink = [(a, b) | a <- shrink a, b <- shrink b]

But if I compare this definition with the actual shrinker for (a, b) in Quickcheck:

shrink :: (a, b) -> [(a, b)]
shrink (x, y) =
     [ (x', y) | x' <- shrink x ]
  ++ [ (x, y') | y' <- shrink y ]

I can see that it’s a bit different. My list-applicative based implementation shrinks too fast: it shrinks both components of the pair at the same time, while Quickcheck’s hand-written shrinker is more prudent and shrinks in one component at a time.

The Shrinks applicative

At this point I could say that it’s good enough: I will miss some shrinks, but it’s a price I’m willing to pay. Yet, I can have my cake and eat it too.

The problem of using the list applicative is that I can’t construct all the valid shrinks of (x, y) based solely on shrink x and shrink y: I also need x and y. The solution is simply to carry the original x and y around.

Let’s define our Shrinks applicative:

data Shrinks a = Shrinks { original :: a, shrinks :: [a] }
  deriving (Functor)

-- | Class laws:
-- * `original . shrinkA = id`
-- * `shrinks . shrinkA = shrink`
class Shrinkable a where
  shrinkA :: a -> Shrinks a
  shrinkA x = Shrinks { original=x, shrinks=shrink x}

  shrink :: a -> [a]
  shrink x = shrinks (shrinkA x)
  {-# MINIMAL shrinkA | shrink #-}

All we need to do is to give to Shrinks an Applicative instance. Which we can base on the Quickcheck implementation of shrink on pairs:

instance Applicative Shrinks where
  pure x = Shrinks { original=x, shrinks=[] }

  fs <*> xs = Shrinks
    { original = (original fs) (original xs)
    , shrinks = [f (original xs) | f <- shrinks fs] ++ [(original fs) x | x <- shrinks xs]
    }

It is a simple exercise to verify the applicative laws. In the process you will prove that

shrinkA :: (a, b, c) -> Shrinks (a, b, c)
shrinkA (x, y, z) = (,,) <$> shrinkA x <*> shrinkA y <*> shrinkA z

does indeed shrink one component at a time.

A word of caution

Using a traversal-style definition is precisely what we want for fixed-shaped data types. But, in general, shrinkers require a bit more thought to maximise their usefulness. For instance, in a list, you will typically want to reduce the size of the list. Here is a possible shrinker for lists:

instance Shrinkable a => Shrinkable [a] where
  shrink xs =
    -- Remove one element
    [ take k xs ++ drop (k+1) xs | k <- [0 .. length xs]]
    -- or, shrink one element
    ++ shrinks (traverse shrinkA xs)