I have been using both `hedgehog`

and `QuickCheck`

based property-based testing
frameworks, I’m fairly comfortable in writing tests and generators in both.
Theoretical aspects aside, for a user, I feel like `hedgehog`

is more
ergonomic as it does automatic shrinking *and* does away with typeclasses. The
former is important as writing good shrinkers is hard, remembering to write
shrinkers is even harder. The latter is important when you need to modify your
generation for some tests.

In this post, I’ll show that using `DerivingVia`

extension and generic
coercions can help you write almost as ergonomic `Arbitrary`

definitions for
`QuickCheck`

. The initial idea is taken from the
Deriving Via paper,
but taken a little bit further. This post assumes some level of understanding
of type level programming.

For the examples, we’re using a `Person`

as shown in the examples below. The
test we’ll implement will be the `tripping`

property. For the *expected*
values, the `name`

is something name-like and `age`

is a range between 1-99.

I’ll use `hedgehog`

to write the ideal case. The generator is light-weight, but
has been customized for the business case. I’m using the `hedgehog-corpus`

package for the name-like generation.

```
import GHC.Generics (Generic)
import Data.Text (Text)
import qualified Data.Aeson as A
import Hedgehog
import qualified Hedgehog.Gen as Gen
import qualified Hedgehog.Range as Range
import qualified Hedgehog.Corpus as Corpus
data Person
= Person { name :: Text
age :: Int
,
}deriving stock (Show, Eq, Generic)
deriving anyclass (A.ToJSON, A.FromJSON)
genValidPerson :: Gen Person
=
genValidPerson Person <$> Gen.element Corpus.simpsons
<*> Gen.integral (Range.linear 0 99)
prop_encoding :: Property
= property $ do
prop_encoding <- forAll genValidPerson
p pure p === A.eitherDecode (A.encode p)
```

For comparison, this is what I would write with QuickCheck without any helpers. There’s quite a bit of added complexity, especially in the shrinker, and only with two fields.

```
import GHC.Generics (Generic)
import Data.Text (Text)
import qualified Data.Aeson as A
import Test.QuickCheck
data Person
= Person { name :: Text
age :: Int
,
}deriving stock (Show, Eq, Generic)
deriving anyclass (A.ToJSON, A.FromJSON)
instance Arbitrary Person where
= Person <$> elements simpsons <*> choose (1,99)
arbitrary where
= ["bart", "marge", "homer", "lisa", "ned"]
simpsons Person{name,age} =
shrink Person name' age'
[| name' <- [name]
<- shrinkIntegral age
, age' >= 1
, age' <= 99
, age'
]
prop_encoding :: Person -> Property
= pure p === A.eitherDecode (A.encode p) prop_encoding p
```

Good, now that the base is done, let’s see what we can do about making
`QuickCheck`

more ergonomic. The solution I’m outlining here relies on these
features.

`DerivingVia`

extension which can automatically generate instances for you if two types are`Coercible`

- Isomorphism between the
`Generic`

representation of two types. For example`(a,b)`

has a`Generic`

representation that is the same as`data Foo = Foo a b`

`QuickCheck`

modifiers, for example`PrintableString`

which modify the arbitrary generation

The paper defines this piece of code for deriving `Arbitrary`

instances for
anything that is generically isomorphic to something that is already an
instance.

```
newtype SameRepAs a b = SameRepAs a
instance
Generic a
( Generic b
, Arbitrary b
, Coercible (Rep a ()) (Rep b ())
,
)=> Arbitrary (a `SameRepAs` b) where
= SameRepAs . coerceViaRep <$> arbitrary
arbitrary where
coerceViaRep :: b -> a
=
coerceViaRep . (coerce :: Rep b () -> Rep a ()) . from to
```

For my implementation, I’ll be cleaning the code from the paper. I’m swapping
the type parameters of the newtype and extract the coercion function to
top-level so that I can define the `shrink`

as well.

```
newtype Isomorphic a b = Isomorphic b
type GenericCoercible a b =
Generic a
( Generic b
, Coercible (Rep a ()) (Rep b ())
,
)
genericCoerce :: forall a b. GenericCoercible a b => a -> b
=
genericCoerce . (coerce @(Rep a ()) @(Rep b ())) . from
to
instance
Arbitrary a
( GenericCoercible a b
,
)=> Arbitrary (a `Isomorphic` b) where
= Isomorphic . genericCoerce @a @b <$> arbitrary
arbitrary Isomorphic b) =
shrink (Isomorphic . genericCoerce @a @b
<$> shrink (genericCoerce @b @a b)
```

With this, we can now write `Arbitrary`

instances using the tuple
representation as an intermediary. At least as long as the child types have
their instances properly set.

```
data Person
= Person { name :: Text
age :: Int
,
}deriving stock (Show, Eq, Generic)
deriving anyclass (A.ToJSON, A.FromJSON)
deriving (Arbitrary) via ((Text, Int) `Isomorphic` Person)
```

This is already a marked improvement to the original `Arbitrary`

instance we
wrote, but this does not yet satisfy our original requirement of generating
only ‘valid’ persons. I would like to modify the instance generation on a more
ad-hoc fashion. For this to happen, I would need some *modifiers* that control
the arbitrary generation. I would like to write something like the instance
below.

```
type Simpsons = '["marge", "bart", "homer", "lisa", "ned"]
data Person
= Person { name :: Text
age :: Int
,
}deriving stock (Show, Eq, Generic)
deriving anyclass (A.ToJSON, A.FromJSON)
deriving (Arbitrary)
Corpus Simpsons Text, Range 1 99 Int) `Isomorphic` Person) via ((
```

Let’s start by defining the `Range`

as it’s more straightforward. This is just
a `newtype`

with a couple of phantom type variables, which is used in choosing
the range of the generator. Shrinking is already quite complex (and probably
not optimal!), I wouldn’t want to write this multiple times.

```
newtype Range (from :: Nat) (to :: Nat) a = Range a
instance
KnownNat from
( KnownNat to
, Num a
, Ord a
, Integral a
, => Arbitrary (Range from to a) where
) = Range . fromInteger <$> choose (natVal $ Proxy @from, natVal $ Proxy @to)
arbitrary Range x) = Range <$> shrunk
shrink (where
=
shrunk
[ x'| x' <- shrinkIntegral x
>= fromInteger (natVal $ Proxy @from)
, x <= fromInteger (natVal $ Proxy @to)
, x ]
```

Then the corpus. Just like the `Range`

it’s a `newtype`

with a phantom
variable, providing the input for the random generation. There’s an extra
typeclass involved to act as a typelevel function.

```
newtype Corpus (corpus :: [Symbol]) a = Corpus a
class FromCorpus (corpus :: [Symbol]) where
fromCorpus :: [String]
instance FromCorpus '[] where
= []
fromCorpus
instance (KnownSymbol x, FromCorpus xs) => FromCorpus (x ': xs) where
= symbolVal (Proxy @x) : fromCorpus @xs
fromCorpus
instance (FromCorpus corpus, IsString x) => Arbitrary (Corpus corpus x) where
= Corpus . fromString <$> elements (fromCorpus @corpus) arbitrary
```

With these instances out of the way, we can redo our original test with automatic instances.

```
import GHC.Generics (Generic)
import Data.Text (Text)
import qualified Data.Aeson as A
import Test.QuickCheck
import Isomorphic
data Person
= Person { name :: Text
age :: Int
,
}deriving stock (Show, Eq, Generic)
deriving anyclass (A.ToJSON, A.FromJSON)
deriving Arbitrary via ((Corpus Simpsons Text, Range 1 99 Int) `Isomorphic` Person)
prop_encoding :: Person -> Property
= pure p === A.eitherDecode (A.encode p) prop_encoding p
```