f0e2dc249be9be8ca958d11004858d1966aef281Christian Maeder#!/home/linux-bkb/bin/runhugs
f0e2dc249be9be8ca958d11004858d1966aef281Christian Maeder-- $Id$
f0e2dc249be9be8ca958d11004858d1966aef281Christian Maeder-- This file defines a command
f0e2dc249be9be8ca958d11004858d1966aef281Christian Maeder-- quickCheck <options> <files>
f0e2dc249be9be8ca958d11004858d1966aef281Christian Maeder-- which invokes quickCheck on all properties defined in the files given as
f0e2dc249be9be8ca958d11004858d1966aef281Christian Maeder-- arguments, by generating an input script for hugs and then invoking it.
f0e2dc249be9be8ca958d11004858d1966aef281Christian Maeder-- quickCheck recognises the options
f0e2dc249be9be8ca958d11004858d1966aef281Christian Maeder-- +names print the name of each property before checking it
f0e2dc249be9be8ca958d11004858d1966aef281Christian Maeder-- -names do not print property names (the default)
f0e2dc249be9be8ca958d11004858d1966aef281Christian Maeder-- Other options (beginning with + or -) are passed unchanged to hugs.
f0e2dc249be9be8ca958d11004858d1966aef281Christian Maeder--
f0e2dc249be9be8ca958d11004858d1966aef281Christian Maeder-- Change the first line of this file to the location of runhugs on your
f0e2dc249be9be8ca958d11004858d1966aef281Christian Maeder-- system.
f0e2dc249be9be8ca958d11004858d1966aef281Christian Maeder-- Make the file executable.
f0e2dc249be9be8ca958d11004858d1966aef281Christian Maeder--
f0e2dc249be9be8ca958d11004858d1966aef281Christian Maeder-- TODO:
f0e2dc249be9be8ca958d11004858d1966aef281Christian Maeder-- someone on #haskell asked about supporting QC tests inside LaTeX, ex. \{begin} \{end}, how?
f0e2dc249be9be8ca958d11004858d1966aef281Christian Maeder-- add a verbosity switch that uses verboseCheck instead of quickCheck
f0e2dc249be9be8ca958d11004858d1966aef281Christian Maeder
f0e2dc249be9be8ca958d11004858d1966aef281Christian Maederimport System
f0e2dc249be9be8ca958d11004858d1966aef281Christian Maederimport List
f0e2dc249be9be8ca958d11004858d1966aef281Christian Maeder
f0e2dc249be9be8ca958d11004858d1966aef281Christian Maedermain :: IO ()
f0e2dc249be9be8ca958d11004858d1966aef281Christian Maedermain = do as<-getArgs
f0e2dc249be9be8ca958d11004858d1966aef281Christian Maeder sequence_ (map (process (filter isOption as))
f0e2dc249be9be8ca958d11004858d1966aef281Christian Maeder (filter (not.isOption) as))
f0e2dc249be9be8ca958d11004858d1966aef281Christian Maeder
f0e2dc249be9be8ca958d11004858d1966aef281Christian Maederprocess opts file =
f0e2dc249be9be8ca958d11004858d1966aef281Christian Maeder let (namesOpt,opts') = getOption "names" "-names" opts in
f0e2dc249be9be8ca958d11004858d1966aef281Christian Maeder do xs<-readFile file
f0e2dc249be9be8ca958d11004858d1966aef281Christian Maeder let names = nub$ filter (\x -> "prop_" `isPrefixOf` x)
f0e2dc249be9be8ca958d11004858d1966aef281Christian Maeder (map (\ s -> case lex s of
f0e2dc249be9be8ca958d11004858d1966aef281Christian Maeder (r, _) : _ -> r
f0e2dc249be9be8ca958d11004858d1966aef281Christian Maeder _ -> error s) (lines xs))
f0e2dc249be9be8ca958d11004858d1966aef281Christian Maeder if null names then
f0e2dc249be9be8ca958d11004858d1966aef281Christian Maeder putStr (file++": no properties to check\n")
f0e2dc249be9be8ca958d11004858d1966aef281Christian Maeder else do writeFile "hugsin"$
f0e2dc249be9be8ca958d11004858d1966aef281Christian Maeder unlines ((":l "++file):
f0e2dc249be9be8ca958d11004858d1966aef281Christian Maeder [(if namesOpt=="+names" then
f0e2dc249be9be8ca958d11004858d1966aef281Christian Maeder "putStr \""++p++": \" >> "
f0e2dc249be9be8ca958d11004858d1966aef281Christian Maeder else "") ++
f0e2dc249be9be8ca958d11004858d1966aef281Christian Maeder "Test.QuickCheck.quickCheck "++p | p<-names])
f0e2dc249be9be8ca958d11004858d1966aef281Christian Maeder system ("ghci "++options opts'++" <hugsin")
f0e2dc249be9be8ca958d11004858d1966aef281Christian Maeder return ()
f0e2dc249be9be8ca958d11004858d1966aef281Christian Maeder
f0e2dc249be9be8ca958d11004858d1966aef281Christian MaederisOption xs = head xs `elem` "-+"
f0e2dc249be9be8ca958d11004858d1966aef281Christian Maeder
f0e2dc249be9be8ca958d11004858d1966aef281Christian Maederoptions opts = unwords ["\""++opt++"\"" | opt<-opts]
f0e2dc249be9be8ca958d11004858d1966aef281Christian Maeder
f0e2dc249be9be8ca958d11004858d1966aef281Christian MaedergetOption name def opts =
f0e2dc249be9be8ca958d11004858d1966aef281Christian Maeder let opt = head [opt | opt<-opts++[def], isPrefixOf name (drop 1 opt)] in
f0e2dc249be9be8ca958d11004858d1966aef281Christian Maeder (opt, filter (/=opt) opts)