mariadb-haskell-0.1.0.0: validation/hs/Main.hs

{-# LANGUAGE ScopedTypeVariables #-}
module Main where

import Control.Exception
import Control.Monad
import Data.List (find, intercalate)
import System.Environment
import System.Exit
import System.IO
import Validation.Common
import qualified Validation.Protocol as Protocol
import qualified Validation.Functional as Functional
import qualified Validation.Reliability as Reliability
import qualified Validation.Security as Security
import qualified Validation.CDC as CDC
import qualified Validation.Benchmark as Benchmark
import qualified Validation.Supplementary as Supplementary
import qualified Validation.Stage1 as Stage1
import qualified Validation.Stage2 as Stage2
import qualified Validation.Stage3 as Stage3
import qualified Validation.Stage3Bench as Stage3Bench
import qualified Validation.Stage4 as Stage4
import qualified Validation.Stage4Bench as Stage4Bench
import qualified Validation.Stage5 as Stage5
import qualified Validation.Stage5Review as Stage5Review
import qualified Validation.Stage5Bench as Stage5Bench
import qualified Validation.Stage6 as Stage6
import qualified Validation.Stage6Bench as Stage6Bench
import qualified Validation.Stage6Review as Stage6Review
import qualified Validation.Stage7 as Stage7
import qualified Validation.Stage7Bench as Stage7Bench

allCases :: [Case]
allCases=Protocol.cases ++ Functional.cases ++ Reliability.cases ++ Security.cases ++ CDC.cases ++ Stage1.cases ++ Stage2.cases ++ Stage3.cases ++ Stage4.cases ++ Stage5.cases ++ Stage5Review.cases ++ Stage6.cases ++ Stage6Review.cases ++ Stage7.cases

main :: IO ()
main=do
    hSetBuffering stdout LineBuffering
    args <- getArgs
    run args `catches`
        [Handler (\(Unsupported msg) -> hPutStrLn stderr msg >> exitWith (ExitFailure 3))
        ,Handler (\(Unavailable msg) -> hPutStrLn stderr msg >> exitWith (ExitFailure 4))
        ,Handler (\(e :: SomeException) -> case fromException e of
            Just (code :: ExitCode) -> exitWith code
            Nothing -> hPutStrLn stderr (displayException e) >> exitFailure)]
  where
    run ["list"]=forM_ allCases $ \c -> putStrLn (intercalate "\t" [caseId c,caseArea c])
    run ["list-benchmarks"]=forM_ Benchmark.benchmarks $ \(ident,n) -> putStrLn (ident ++ "\t" ++ show n)
    run ["preflight"]=preflight
    run ["case",ident]=case find ((==ident) . caseId) allCases of
        Nothing -> throwIO (userError ("unknown test " ++ ident))
        Just c -> caseRun c >> putStrLn ("PASS\t" ++ ident)
    run ["stage5-bench",ident,n]=Stage5Bench.run ident (read n)
    run ["stage7-bench",ident,n]=Stage7Bench.run ident (read n)
    run ["stage6-bench",ident,n]=Stage6Bench.run ident (read n)
    run ["stage6-heap-control"]=Stage6Bench.retentionNegativeControl
    run ["stage4-bench",ident,n]=Stage4Bench.run ident (read n)
    run ["stage3-bench",ident,n]=Stage3Bench.run ident (read n)
    run ["stage1-bench",ident,n]=Supplementary.run ident (read n)
    run ["bench",ident,n]=Benchmark.runBenchmark ident (read n)
    run _=throwIO (userError "usage: mariadb-validation list | list-benchmarks | preflight | case ID | bench ID ITERATIONS | stage1-bench ID ITERATIONS | stage3-bench ID ITERATIONS")