3
votes

I am struggling on Real World Haskell Chapter 11 quickCheck generator implementation for a an algebraic data type.

Following the book implementation (which was published in 2008), I came up with the following:

-- file: ch11/Prettify2.hs
module Prettify2(
    Doc(..)
) where

data Doc = Empty
         | Char Char
         | Text String
         | Line
         | Concat Doc Doc
         | Union Doc Doc
         deriving (Show, Eq)

And my Arbitrary implementation:

-- file: ch11/Arbitrary.hs

import System.Random
import Test.QuickCheck.Gen
import qualified Test.QuickCheck.Arbitrary


class Arbitrary a where
    arbitrary :: Gen a
    -- elements' :: [a] => Gen a {- Expected a constraint, but ‘[a]’ has kind ‘*’ -}
    -- choose' :: Random a => (a, a) -> Gen a
    -- oneof' :: [Gen a] -> a

data Ternary = Yes
             | No
             | Unknown
             deriving(Eq, Show)

instance Arbitrary Ternary where
    arbitrary = do
        n <- choose (0, 2) :: Gen Int
        return $ case n of
                      0 -> Yes
                      1 -> No
                      _ -> Unknown

instance (Arbitrary a, Arbitrary b) => Arbitrary (a, b) where
  arbitrary = do
      x <- arbitrary
      y <- arbitrary
      return (x, y)

instance Arbitrary Char where
    arbitrary = elements (['A'..'Z'] ++ ['a' .. 'z'] ++ " ~!@#$%^&*()")

I tried the two following implementation with no success:

import Prettify2
import Control.Monad( liftM, liftM2 )

instance Arbitrary Doc where
    arbitrary = do
        n <- choose (1,6) :: Gen Int
        case n of
            1 -> return Empty
            2 -> do x <- arbitrary
                    return (Char x)
            3 -> do x <- arbitrary
                    return (Text x)
            4 -> return Line
            5 -> do x <- arbitrary
                    y <- arbitrary
                    return (Concat x y)
            6 -> do x <- arbitrary
                    y <- arbitrary
                    return (Union x y)

instance Arbitrary Doc where
    arbitrary =
        oneof [ return Empty
              , liftM Char arbitrary
              , liftM Text arbitrary
              , return Line
              , liftM2 Concat arbitrary arbitrary
              , liftM2 Union arbitrary arbitrary ]

But it doesn't compile since No instance for (Arbitrary String)

I tried then to implement the instance for Arbitrary String in the following ways:

  • import qualified Test.QuickCheck.Arbitrary but it does not implement Arbitrary String neither
  • installing Test.RandomStrings hackage link

    instance Arbitrary String where arbitrary = do n <- choose (8, 16) :: Gen Int return $ randomWord randomASCII n :: Gen String

With the following backtrace:

$ ghci
GHCi, version 7.10.3: http://www.haskell.org/ghc/  :? for help
Prelude> :l Arbitrary.hs
[1 of 2] Compiling Prettify2        ( Prettify2.hs, interpreted )
[2 of 2] Compiling Main             ( Arbitrary.hs, interpreted )

Arbitrary.hs:76:9:
    The last statement in a 'do' block must be an expression
      return <- randomWord randomASCII n :: Gen String
Failed, modules loaded: Prettify2

Would you have any good suggestion about how to implement this particular generator and - more in general - how to proceed in these cases?

Thank you in advance

1

1 Answers

4
votes

Don't define a new Arbitrary type class, import Test.QuickCheck instead. It defines most of these instances for you. Also be careful about the version of quickcheck, RWH assumes version 1.

The resulting full implementation will be:

-- file: ch11/Arbitrary.hs

import Test.QuickCheck
import Prettify2
import Control.Monad( liftM, liftM2 )

data Ternary = Yes
             | No
             | Unknown
             deriving(Eq, Show)

instance Arbitrary Ternary where
    arbitrary = do
        n <- choose (0, 2) :: Gen Int
        return $ case n of
                      0 -> Yes
                      1 -> No
                      _ -> Unknown


instance Arbitrary Doc where
    arbitrary =
        oneof [ return Empty
              , liftM Char arbitrary
              , liftM Text arbitrary
              , return Line
              , liftM2 Concat arbitrary arbitrary
              , liftM2 Union arbitrary arbitrary ]