Lets suppose you’ve got two similar recursive types that differ only in their “payload”. For example, you want a binary tree of boolean operations to store a Char and another similar tree to store a set of Char. Let’s call them Tree and STree. Something like in the following, non-working, code
data Tree = And Tree Tree | Or Tree Tree | Leaf Char data STree = And STree STree | Or STree STree | Leaf (Set Char)
We’re repeating a lot of boiler plate here. It’d be great if I could parameterise the tree, which I can.
data MTree t = And (MTree t) (MTree t) | Or (MTree t) (MTree t) | Leaf t
This is great, it removes boilerplate, and gives me less code to test.
Take our Tree as defined above. It’s easy to create an Arbitrary Tree. The following code creates an arbitrary tree with a maximum branch depth (generally for efficiency reasons you don’t want test trees that are either (arbitrary :: Int) or infinitely deep)
import Test.QuickCheck
import Control.Monad
data Tree = And Tree Tree
| Or Tree Tree
| Leaf Char
deriving Show
arbitraryTree :: Int -> Gen Tree
arbitraryTree 0 =
do
c <- arbitrary
return (Leaf c)
arbitraryTree maxDepth =
do
t <- oneof [arbitraryTree 0,
liftM2 And (arbitraryTree depth') (arbitraryTree depth'),
liftM2 Or (arbitraryTree depth') (arbitraryTree depth')]
return t
where
depth' = maxDepth -1
instance Arbitrary Tree where
arbitrary = do
maxDepth <- choose (1, 10)
t <- arbitraryTree maxDepth
return t
So how do you create an arbitrary MTree? The following code makes it all work.
import Test.QuickCheck
import Control.Monad
data MTree t = And (MTree t) (MTree t)
| Or (MTree t) (MTree t)
| Leaf t
deriving Show
arbitraryMTree :: Arbitrary t => Int -> Gen (MTree t)
arbitraryMTree 0 =
do
c <- arbitrary
return (Leaf c)
arbitraryMTree maxDepth =
do
tr <- oneof [arbitraryMTree 0,
liftM2 And (arbitraryMTree depth') (arbitraryMTree depth'),
liftM2 Or (arbitraryMTree depth') (arbitraryMTree depth')]
return tr
where
depth' = maxDepth -1
instance Arbitrary t => Arbitrary (MTree t) where
arbitrary = do
maxDepth <- choose (1, 10)
tr <- arbitraryMTree maxDepth
return tr
This is remarkably neat. QuickCheck, for me, is the killer feature of functional programming!
Returning to the Squad example from the other day. We can create Arbitrary instances of Squad.
import Data.Set
import Data.List
import Test.QuickCheck
import Control.Monad
data Squad a = Squad { players :: (Set a), team :: a}
instance (Ord a, Arbitrary a) => Arbitrary (Squad a) where
arbitrary =
do
ps <- listOf1 arbitrary
t <- elements ps
return (Squad (fromList ps) t)
But now I have a complication (and this is where the Squad metaphor breaks down, but please bare with me). Suppose I want a Squad of players where I can in some instances choose a subset of them to play, and in other instances only choose one of them to play. So the Squad still constains a set of players, but the team can sometimes be a subset of the players, and sometimes is a single player. We’ve got to allow instances of TypeSynonyms:
{-# LANGUAGE TypeSynonymInstances #-}
import Data.Set
import Data.List
import Test.QuickCheck
import Control.Monad
data Squad a b = Squad { players :: (Set a), team :: b}
type SetSquad = Squad Char (Set Char)
type SingleSquad = Squad Char Char
instance Arbitrary SetSquad where
arbitrary =
do
ps <- listOf1 arbitrary
t <- elements (subsequences ps)
return (Squad (fromList ps) (fromList t))
instance Arbitrary SingleSquad where
arbitrary =
do
ps <- listOf1 arbitrary
t <- elements ps
return (Squad (fromList ps) t)
Which is awesome.
Mad props to my homeboy Eric (I’ve been told that’s how one addresses a USian) for listening to my overtired ramblings last night, and for pointing me at numerous ways to implement what I wanted to.