SmokeTest Data Generation with QuickCheck

SmokeTest.hs

{-# LANGUAGE FlexibleInstances, UndecidableInstances#-}
module SmokeTest where

import Control.Monad
import Control.Applicative
import System.IO
import Test.QuickCheck
import Test.QuickCheck.Poly

class Variant a where
    valid :: Gen a
    invalid :: Gen a

instance Variant a => Arbitrary a where
    arbitrary = oneof [valid, invalid]

data Record = InputRecord Name Number
            | OutputRecord Name Number OutputType deriving Show
data Number = Number String deriving Show
data Name = Name String deriving Show
data OutputType = OutputType String deriving Show

instance Variant Name where
    valid = Name <$> elements ["correctName"]
    invalid = Name <$> elements ["outName"]

instance Variant Number where
    valid = Number <$> elements ["correctNum"]
    invalid = Number <$> elements ["outNum"]

instance Variant OutputType where
    valid = OutputType <$> elements ["correctOutput"]
    invalid = OutputType <$> elements ["outOutput"]

instance Variant Record where
    valid = oneof [ InputRecord <$> valid <*> valid
                  , OutputRecord <$> valid <*> valid <*> valid
                  ]
    invalid = oneof [ InputRecord <$> valid <*> invalid
                    , OutputRecord <$> valid <*> valid <*> invalid
                    ]

data DataDefinition = DataDefinition Name Record deriving Show

main =
  do
    let num = 200
    let config = [ ("All_Valid", "txt", num, (valid , valid)) ]
    mapM_ create_test_set config

create_test_set (fname, ext, count, gens) =
  do
    test_set <- sample' $ vectorOf count (mkDataDef gens)
    zipWithM_ (writeToFile fname ext) [1..] test_set
      where
        mkDataDef (gen_name, gen_rec) = DataDefinition <$> gen_name <*> gen_rec

writeToFile name_prefix suffix n x =
  do 
    h <- openFile (name_prefix ++ "_" ++ pad n ++ "." ++ suffix) WriteMode
    hPutStrLn h $ show x
    hClose h
      where
        pad n = reverse $ take 4 $ (reverse $ show n) ++ (repeat '0')