QuickCheck is awesome! But trying to figure out how to use it with custom data types could be hard for newbies like me. The documentation assumes that you are already fluent in Haskell and hardly provides explanations or code snippets. Hopefully, the following two examples will give you a glimpse of the syntax and help you make your way out of the numerous compiler errors.
Let’s start with defining a simple data type Point that holds two Int values:
module QCSamples where
import Test.QuickCheck
data Point = Pt Int Int
instance Show (Point) where
show (Pt x y) = "{" ++ show x ++ "," ++ show y ++ "}"
To use the Point data type in QuickCheck, we need to provide an implementation of Arbitrary:
instance Arbitrary Point where
arbitrary = do
x <- arbitrary
y <- arbitrary
return $ Pt x y
Note that in the above example we only need to say x<-arbitrary and y<-arbitrary to get the random Ints. Haskell will infer their type from the specification of Point and will provide the appropriate arbitrary implementation, i.e. Int. So, now we can let QuickCheck produce random Points.
*QCSamples> sample $ (arbitrary :: Gen Point)
{-1,1}
{0,-2}
{-1,1}
{8,-4}
{-19,8}
{-60,4}
{-126,-71}
{-87,156}
{307,-248}
{1977,322}
{1593,3628}
*QCSamples>
Now, let's have a look at a slightly harder example:
data Set a = Set [a]
instance (Show a) => Show (Set a) where
show s = showSet s where
showSet (Set []) = "{}"
showSet (Set (x:xs)) = "{" ++ show x ++ showSubSet xs ++ "}" where
showSubSet [] = ""
showSubSet (x:xs) = "," ++ show x ++ showSubSet xs
Here is the implementation of Arbitrary that will allow us to use the Set type in QuickCheck:
instance (Arbitrary a) => Arbitrary (Set a) where
arbitrary = do
list <- arbitrary
return $ Set list
Note that this time we have to have the typeclass (Arbitrary a) in the definition. With this addition we can create Sets of anything that provides implementation for Arbitrary, e.g. Set Int, Set String and Set Point!
*QCSamples> sample $ (arbitrary :: Gen (Set Int))
{}
{}
{}
{}
{-32,1,-28,-14,-22,-13}
{-12,36,6,-50,-36,-28,-49,-7}
{-98}
{183,-29,191,179,-152,94,-225,-19,28}
{-82,-562,385,-146,187,627,-825,-30,227}
{1184,-780,-1787,1720,-1204,-1382,450}
{-128,2874,-636,845,3477,699,2989,-3449,-2221,3587,1107,1365,-3792,357,-487}
*QCSamples>
*QCSamples> sample $ (arbitrary :: Gen (Set Point))
{}
{{2,-2},{-1,-1}}
{}
{}
{{3,-27}}
{{0,-28},{-61,19},{-52,-43},{41,8},{-43,-34},{-9,-33},{63,-62},{49,16},{-3,-3},{56,4}}
{{48,76},{-122,82}}
{{238,-28},{243,122},{3,189},{-79,-104}}
{{56,-862},{947,-712},{17,-566},{-229,-652},{836,568}}
{{-1883,-794},{1995,-1934}}
{{1265,-1564},{837,3327},{3197,-2594},{-2486,-1393}}
Thanks for this simple example. It helped me understand enough to be able to dig further – specifically for sum types such as `data Expr = Val Int + Div Expr Expr`.