{-# LANGUAGE PatternGuards #-} module Main where import NoSlow.Analyse.Table import NoSlow.Util.Tag import qualified NoSlow.Util.Opts as O import Criterion.Measurement ( secs ) import Text.Read import System.Console.GetOpt import System.Environment ( getArgs, getProgName ) import Data.Version ( showVersion ) import Control.Monad ( liftM, foldM ) import Text.Printf ( printf ) import System.IO import Paths_NoSlow main = do args <- getArgs case args of arg : args' | arg == "-d" || arg == "--diff" -> doDiff args' _ -> doTable args data Opts = Opts { optOutputFile :: FilePath , optOutput :: FilePath -> Table -> IO () , optTransTable :: Table -> Table } defaultTableOpts = Opts { optOutputFile = "" , optOutput = outputHTML , optTransTable = id } type OptM = O.OptM Opts tbl :: (Table -> Table) -> Opts -> Opts tbl f opts@(Opts { optTransTable = g }) = opts { optTransTable = f . g } raw :: Table -> Table raw t = t { tShowCell = printf "%f" } commonOptions :: [OptDescr OptM] commonOptions = [ Option ['b'] ["bench"] (O.listArg return (tbl . sel_rows) "LIST") "only process some benchmarks" , Option ['l'] ["lib"] (O.selArg O.matchLib (tbl . filterTags) "LIST") "only process the specified libraries" , Option ['g'] ["group"] (O.selArg O.matchGroup (tbl . filterTags) "LIST") "only process benchmarks from the specified group" , Option ['o'] ["output"] (O.reqArg (\s opt -> opt { optOutputFile = s }) "FILE") "store the output in this file" , Option [] ["raw"] (O.noArg $ tbl raw) "output the raw data" , Option [] ["html"] (O.noArg $ \opt -> opt { optOutput = outputHTML }) "output a HTML table" , Option [] ["csv"] (O.noArg $ \opt -> opt { optOutput = outputCSV }) "output a CSV table" , Option ['V'] ["version"] (O.helpArg printVersion) "output version, then exit" , Option ['h','?'] ["help"] (O.helpArg printUsage) "output help" ] where sel_rows ss = filterRows (\s -> s `elem` ss) printVersion :: IO () printVersion = putStrLn (showVersion version) printUsage :: IO () printUsage = do p <- getProgName putStrLn (usageInfo ("Usage: " ++ p ++ " [OPTION | FILE] ...\n" ++ " " ++ p ++ " [-d | --diff] FILE1 FILE2 [OPTIONS]") commonOptions) doTable args = do (opts, rest) <- O.parse defaultTableOpts commonOptions args ts <- mapM readLog $ if null rest then ["-"] else rest output opts $ optTransTable opts $ foldr1 union ts doDiff args = do (opts, rest) <- O.parse defaultTableOpts commonOptions args case rest of [file1,file2] -> do t1 <- readLog file1 t2 <- readLog file2 output opts $ optTransTable opts $ intersect ratio cmp t1 t2 _ | length rest > 2 -> O.printError "too many arguments" | otherwise -> O.printError "not enough arguments" where ratio d = printf "%.3f" d cmp d1 d2 = d1 / d2 output :: Opts -> Table -> IO () output o = optOutput o (optOutputFile o) outputHTML :: FilePath -> Table -> IO () outputHTML file t = with_file file $ \h -> do hPutStrLn h "" hPutStrLn h (html $ prune t) hPutStrLn h "" where with_file "" f = f stdout with_file file f = withFile file WriteMode f outputCSV :: FilePath -> Table -> IO () outputCSV file t = with_file file $ \h -> hPutStrLn h (csv $ prune t) where with_file "" f = f stdout with_file file f = withFile file WriteMode f newtype Benchmark = Benchmark { unBenchmark :: (Tag, Double) } readLog :: FilePath -> IO Table readLog file = (table secs . proc_lines . lines) `liftM` read_file file where proc_lines (h : r) | h == header = map (unBenchmark . read) r | otherwise = error "Invalid file" header = "Name,Mean,MeanLB,MeanUB,Stddev,StddevLB,StddevUB" read_file "-" = getContents read_file file = readFile file instance Read Benchmark where readPrec = do tag <- readPrec comma mean <- readPrec comma readPrec :: ReadPrec Double -- meanlb comma readPrec :: ReadPrec Double -- meanub comma readPrec :: ReadPrec Double -- stddev comma readPrec :: ReadPrec Double -- stddevlb comma readPrec :: ReadPrec Double -- stddevub case reads tag of [(t, "")] -> return $ Benchmark (t, mean) where comma = do c <- get if c == ',' then return () else pfail