QuickCheck: shrinking like tuples, writing like applicative

The QuickCheck documentation for Arbitrary says that

There is no generic arbitrary implementation included because we don't know how to make a high-quality one.

Though in practice I've found that very often it suffices to write one that uses the fact that Gen is an Applicative. For instance, this type

data Foo = Foo
    { tata :: Int
    , titi :: Double
    }

would get an implementation that looks like this

instance Arbitrary Foo where
    arbitrary = Foo <$> arbitrary <*> arbitrary

When it comes to writing the function for shrinking Foo it is possible to rely on a generic function and the documentation says that

The default implementation returns the empty list, so will not try to shrink the value. If your data type has no special invariants, you can enable shrinking by defining shrink = genericShrink, but by customising the behaviour of shrink you can often get simpler counterexamples.

Based on some manual testing it seems that genericShrink generates something like this for the type Foo above

instance Arbitrary Foo where
    shrink (Foo tata_ titi_) = Foo <$> shrink tata_ <*> shrink titi_

which means that if shrink tata_ generates a list of m elements and shrink titi_ generates a list of n elements, then shrink foo will generate a list of m×n elements. It's clear that the size can become problematic with more fields. It also means that it's very easy to get an empty list – if shrink v results in an empty list, then shrink foo is also empty. Oh, and shrink Nothing is []!

A colleague pointed out that tuples have a rather efficient implementation of shrink that grows linearly with the number of elements and doesn't reduce to the empty list as easily. I could use it for Foo like this

instance Arbitrary Foo where
    shrink (Foo tata_ titi_) = uncurry Foo <$> shrink (tata_, titi_)

However, that doesn't scale that well to more fields. Up to a point I can use list comprehensions, but it gets a bit difficult to read, I find. On top of that, the largest tuple with an Arbitrary instance has 10 elements, and then I'll have to either define more or use inner tuples.

Wouldn't it be nice to write shrink in something that looks Applicative, but behaves like tuples?

Here's one approach to this.

First a type to hold information about what's being shrunk, or in this case waned

data Wane a = Wane a [a]
    deriving (Generic, Show)

instance Functor Wane where
    fmap f (Wane a as) = Wane (f a) (f <$> as)

Then a couple of functions to bring values in and out, unWane to get the list of values out and wane to wrap a value in Wane

unWane :: Wane a -> [a]
unWane (Wane _ as) = as

wane :: (Arbitrary a) => a -> Wane a
wane a = Wane a (shrink a)

Finally a way to combine two Wane values is needed, and here I was inspired by the implementation of Arbitrary for (a,b)

infixl 4 \*/

(\*/) ::  Wane (a -> b) -> Wane a -> Wane b
(\*/) (Wane f fs) (Wane a as) =  Wane (f a) ([f a' | a' <- as] <> [f' a| f' <- fs])

It's now possible to write shrink for Foo like this

instance Arbitrary Foo where
    shrink (Foo tata_ titi_) = unWane $ Foo <$> wane tata_ \*/ wane titi_

That scales to more fields just as nicely as applicative style, and the result matches what the variant using tuples produces (same elements, but the order is different).