{-# LANGUAGE TupleSections #-}
module Main where
import Test
import Config
import Benchmark
import Prelude hiding (catch)
import Data.List
import Data.Maybe
import Control.Arrow
import Control.Monad
import System.Environment
import System.Console.CmdArgs (cmdArgs, getVerbosity, Verbosity(..))
-- Process command line options, prepare selected test programs for benchmarking
-- or verification
--
processArgs :: IO (Config, [Test])
processArgs = do
testInfo <- map (title &&& description) `fmap` allTests undefined
config <- cmdArgs $ defaultConfig testInfo
tests <- filter (selected config) `fmap` allTests config
--
return (config, tests)
where
selected a = case cfgArgs a of
[] -> const True
ps -> \x -> any (\p -> p `isPrefixOf` title x) ps
-- Verify results with the chosen backend, turning exceptions into failures.
-- Pass back the tests which succeeded.
--
runVerify :: Config -> [Test] -> IO [Test]
runVerify cfg tests = do
results <- forM tests $ \t -> (t,) `fmap` verifyTest cfg t
return . map fst
$ filter (\(_,r) -> r `elem` [Ok, Skipped]) results
-- Run criterion timing tests in the chosen backend
--
runTiming :: Config -> [Test] -> IO ()
runTiming cfg tests = do
verbose <- getVerbosity
unless (verbose == Quiet) $ putStrLn ""
let args = [ maybe "" (\ci -> "--ci=" ++ show ci) (cfgConfidence cfg)
, maybe "" (\r -> "--resamples=" ++ show r) (cfgResamples cfg)
, maybe "" (\f -> "--summary=" ++ f) (cfgSummaryFile cfg)
, if cfgPerformGC cfg then "-g" else "-G"
, case verbose of
Loud -> "--verbose"
Quiet -> "--quiet"
Normal -> ""
]
--
withArgs args
. runBenchmark
. catMaybes
$ map (benchmarkTest cfg) tests
-- Main
-- ====
main :: IO ()
main = do
(config, tests) <- processArgs
valid <- runVerify config tests
--
unless (null valid || cfgVerify config) $ runTiming config valid