New post, deriving quickcheck
This commit is contained in:
parent
f8bd7e928d
commit
95e9b07f31
@ -45,6 +45,11 @@ h2 {
|
||||
justify-content: space-between;
|
||||
}
|
||||
|
||||
article.blog {
|
||||
/* display: flex; */
|
||||
/* align-items: center; */
|
||||
}
|
||||
|
||||
|
||||
article .header {
|
||||
font-size: 1.4rem;
|
||||
@ -145,6 +150,10 @@ article .header {
|
||||
article {
|
||||
width: 60rem;
|
||||
}
|
||||
main {
|
||||
display: flex;
|
||||
justify-content: center;
|
||||
}
|
||||
header {
|
||||
margin: 0 0 3rem;
|
||||
padding: 1.2rem 0;
|
||||
|
||||
254
rauhala.info/posts/2021-01-26-Tests-with-Deriving.md
Normal file
254
rauhala.info/posts/2021-01-26-Tests-with-Deriving.md
Normal file
@ -0,0 +1,254 @@
|
||||
---
|
||||
title: Tests with Deriving Via
|
||||
tags: haskell, testing, pbt
|
||||
---
|
||||
|
||||
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](https://www.kosmikus.org/DerivingVia/deriving-via-paper.pdf) 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.
|
||||
|
||||
``` haskell
|
||||
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
|
||||
prop_encoding = property $ do
|
||||
p <- forAll genValidPerson
|
||||
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.
|
||||
|
||||
``` haskell
|
||||
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
|
||||
arbitrary = Person <$> elements simpsons <*> choose (1,99)
|
||||
where
|
||||
simpsons = ["bart", "marge", "homer", "lisa", "ned"]
|
||||
shrink Person{name,age} =
|
||||
[Person name' age'
|
||||
| name' <- [name]
|
||||
, age' <- shrinkIntegral age
|
||||
, age' >= 1
|
||||
, age' <= 99
|
||||
]
|
||||
|
||||
prop_encoding :: Person -> Property
|
||||
prop_encoding p = pure p === A.eitherDecode (A.encode 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.
|
||||
|
||||
``` haskell
|
||||
newtype SameRepAs a b = SameRepAs a
|
||||
|
||||
instance
|
||||
( Generic a
|
||||
, Generic b
|
||||
, Arbitrary b
|
||||
, Coercible (Rep a ()) (Rep b ())
|
||||
)
|
||||
=> Arbitrary (a `SameRepAs` b) where
|
||||
arbitrary = SameRepAs . coerceViaRep <$> arbitrary
|
||||
where
|
||||
coerceViaRep :: b -> a
|
||||
coerceViaRep =
|
||||
to . (coerce :: Rep b () -> Rep a ()) . from
|
||||
```
|
||||
|
||||
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.
|
||||
|
||||
``` haskell
|
||||
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 =
|
||||
to . (coerce @(Rep a ()) @(Rep b ())) . from
|
||||
|
||||
instance
|
||||
( Arbitrary a
|
||||
, GenericCoercible a b
|
||||
)
|
||||
=> Arbitrary (a `Isomorphic` b) where
|
||||
arbitrary = Isomorphic . genericCoerce @a @b <$> arbitrary
|
||||
shrink (Isomorphic b) =
|
||||
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.
|
||||
|
||||
``` haskell
|
||||
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.
|
||||
|
||||
``` haskell
|
||||
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)
|
||||
via ((Corpus Simpsons Text, Range 1 99 Int) `Isomorphic` Person)
|
||||
```
|
||||
|
||||
|
||||
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.
|
||||
|
||||
``` haskell
|
||||
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
|
||||
arbitrary = Range . fromInteger <$> choose (natVal $ Proxy @from, natVal $ Proxy @to)
|
||||
shrink (Range x) = Range <$> shrunk
|
||||
where
|
||||
shrunk =
|
||||
[ x'
|
||||
| x' <- shrinkIntegral x
|
||||
, x >= fromInteger (natVal $ Proxy @from)
|
||||
, x <= fromInteger (natVal $ Proxy @to)
|
||||
]
|
||||
```
|
||||
|
||||
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.
|
||||
|
||||
``` haskell
|
||||
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
|
||||
fromCorpus = symbolVal (Proxy @x) : fromCorpus @xs
|
||||
|
||||
instance (FromCorpus corpus, IsString x) => Arbitrary (Corpus corpus x) where
|
||||
arbitrary = Corpus . fromString <$> elements (fromCorpus @corpus)
|
||||
```
|
||||
|
||||
With these instances out of the way, we can redo our original test with
|
||||
automatic instances.
|
||||
|
||||
``` haskell
|
||||
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
|
||||
prop_encoding p = pure p === A.eitherDecode (A.encode p)
|
||||
```
|
||||
@ -25,8 +25,10 @@
|
||||
</header>
|
||||
|
||||
<main role="main">
|
||||
<div>
|
||||
<h1>$title$</h1>
|
||||
$body$
|
||||
</div>
|
||||
</main>
|
||||
|
||||
<footer>
|
||||
|
||||
Loading…
Reference in New Issue
Block a user