Is it possible to pass and retrieve a state in a quickcheck generator

Question

I would like to create a quickcheck generator to generate a data structure like a tree. Due to the specifics caracteristics of this structure I would like the value to be generated according to its depth in the structure and store tags generated at one place to reuse them at another place. So I would like to pass a state to my generators (like in the with State monad with put and get).

Is there a function in the quickcheck library to do that or should I combine a StateT monad with the Gen monad ? Can quickcheck-transformer be a solution ?

Answer 1

It is possible to create a quickcheck generator with a state. This state can then be used to tweak the generators according to embedded values.

it requires the modules :

import           Control.Monad
import           Control.Monad.Trans.Class
import           Control.Monad.Trans.State
import           Test.QuickCheck
import           Test.QuickCheck.Gen

Example

Considering this data structure:

data MyElem = Header String
              | Upper [MyElem]
              | Str [String]
              | Tag String
              deriving(Show)

Suppose that we want to generate a random structure with a limited depth, beginning with a header and without duplicate tag.

We create the following state data structure:

data MyState = MyState
    { lastHeader :: Maybe String -- ^ The title of the last header (If a header is passed).
    , level      :: Int          -- ^ The level (depth) where we are in the structure.
    , usedTags   :: [String]     -- ^ The list of laready used tags.
    }

initState = MyState
    { lastHeader = Nothing
    , level = 1
    , usedTags = []
    }

We use the StateT modifier to create a state with the embedded MyState and with the inner Gen monad (from the quickcheck library)

type MyGen t = StateT MyState Gen t

We can define generator with a state depending behavior for each elements of the MyElem data structure. In these function, we will use the lift function to use quickcheck functions in top of the MyGen monad and retrieve their results.

genUpper :: MyGen MyElem
genUpper = do
    modify (\st -> st { level = level st + 1 })
    es <- genBase
    modify (\st -> st { level = level st - 1 })
    return $ Upper es


genElems :: MyGen [MyElem]
genElems = do
    l <- gets level
    if l == 1
        then vectorOfM 6 $ oneofM [genStr, genHeader, genUpper, genTag]
        else if l > 4 -- Limit the depth to 4
            then vectorOfM 3 $ oneofM [genStr, genTag]
            else vectorOfM 4 $ oneofM [genStr, genUpper, genTag]


genStr :: MyGen MyElem
genStr = do
    l <- gets level
    v <- lift $ case l of -- Set the maximum string length according to the level of the structure.
        1 -> choose (5, 10)
        2 -> choose (3, 7)
        _ -> choose (1, 5)
    s <- lift $ vectorOf v $ elements ["Lorem", "Ispum", "Dolor", "Sit", "Amet", "Elit", "Duis", "Sagittis", "Tortor"]
    return $ Str s

genHeader :: MyGen MyElem
genHeader = do
    h <- lift $ elements ["A header", "Another header", "Still another header", "No more header"]
    modify (\st -> st { lastHeader = Just h })
    return $ Header h

genTag :: MyGen MyElem
genTag = do
    tgs <- gets usedTags
    let tag = head $ filter (`notElem` tgs) $ map (\i -> "TAG" ++ show i) [1 ..]
    modify (\st -> st { usedTags = tag : usedTags st }) -- Set the already used tags
    return $ Tag tag


genBase = do
    stat <- get
    case lastHeader stat of
        Nothing -> do -- Force the first element to be a Header.
            e  <- genHeader
            es <- genBase
            return $ e : es

        Just _ -> do
            genElems

It is necessary to make specific versions of some transformers of the quickcheck library to make it work with the new monad MyGen. You will have to rewrite some of the functions described in the source file Test.QuickCheck.Gen

vectorOfM :: Int -> MyGen t -> MyGen [t]
vectorOfM = replicateM

oneofM :: [MyGen t] -> MyGen t
oneofM [] = error "oneofM used with empty list"
oneofM gs = do
    v <- lift $ choose (0, length gs - 1)
    gs !! v

Then you can use the new generator with both the generate and the evalStateT function.

main = do
    struct <- generate $ evalStateT genBase initState
    print struct