New post, deriving quickcheck

rauhala.info/css/default.css

@@ -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;

rauhala.info/posts/2021-01-26-Tests-with-Deriving.md

@@ -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)
+```

rauhala.info/templates/default.html

@@ -25,8 +25,10 @@
         </header>
 
         <main role="main">
+          <div>
             <h1>$title$</h1>
             $body$
+          </div>
         </main>
 
         <footer>

rauhala.info/templates/post.html

@@ -1,8 +1,8 @@
 <article>
-    <section class="header">
+  <section class="header">
-        Posted on $date$
+    Posted on $date$
-    </section>
+  </section>
-    <section>
+  <section>
-        $body$
+    $body$
-    </section>
+  </section>
 </article>