import Control.Monad (when) import System.Cmd -- ideally this should use System.Process in the future, but for the sake of a first version this will do. import System.Exit import System.Console.GetOpt import System.Environment import Data.Maybe (maybe, isJust, fromMaybe) import Test.Maybench optList :: [OptDescr (String, String)] optList = [Option [] ["setup"] (ReqArg (\x -> ("setup",x)) "CMD") "Command to be run prior to benchmarking to prepare the environment.", Option [] ["setup1"] (ReqArg (\x -> ("setup1",x)) "CMD") "Command to be run prior to first benchmark to prepare the environment.", Option [] ["setup2"] (ReqArg (\x -> ("setup2",x)) "CMD") "Command to be run prior to second benchmark to prepare the environment.", Option [] ["cleanup"] (ReqArg (\x -> ("cleanup",x)) "CMD") "Command to be run post benchmarking to cleanup the environment.", Option [] ["cleanup1"] (ReqArg (\x -> ("cleanup1",x)) "CMD") "Command to be run post first benchmark to cleanup the environment.", Option [] ["cleanup2"] (ReqArg (\x -> ("cleanup2",x)) "CMD") "Command to be run post second benchmark to cleanup the environment.", Option ['n'] ["repetitions"] (ReqArg (\x -> ("repetitions",x)) "NUMBER") "Number of trials to run and average.", Option ['h'] ["help"] (NoArg ("help","help")) "Display usage information."] optsDef :: [String] -> ([([Char], String)], [String], [String]) optsDef = getOpt Permute optList help :: IO () help = do p <- getProgName putStrLn $ usageInfo (p ++ " cmd1 cmd2") optList exitWith ExitSuccess return () main :: IO () main = do args <- getArgs let opts = optsDef args lookupOpt opt = lookup opt . fst3 $ opts setup i = fromMaybe "true" (lookupOpt ("setup" ++ show i)) cleanup i = fromMaybe "true" (lookupOpt ("cleanup" ++ show i)) iters = maybe 1 read $ lookupOpt "repetitions" test n c = averageTime c (setup n) (cleanup n) iters case opts of (_,[cmd1,cmd2],_) -> do when (isJust $ lookupOpt "help") help -- this exits system $ setup "" time1 <- test (1::Int) cmd1 time2 <- test (2::Int) cmd2 system $ cleanup "" maybe (return ()) putStrLn (compareTimes (cmd1, time1) (cmd2, time2)) _ -> help where fst3 (x,_,_) = x