module Crypto.Lol.Utils.PrettyPrint.Table
(prettyBenches
,defaultOpts
,Opts(..)
,Verb(..)) where
import Control.Monad (forM_, when)
import Criterion.Types
import Criterion.Measurement (secs)
import Crypto.Lol.Utils.PrettyPrint
import Data.List (nub, groupBy, transpose)
import System.IO
import Text.Printf
data Opts = Opts
{verb :: Verb,
level :: String,
benches :: [String],
params :: [String],
colWidth :: Int,
testNameWidth :: Int}
optsToInternal :: Opts -> Benchmark -> OptsInternal
optsToInternal Opts{..} bnch =
OptsInternal{params=if null params
then nub $ map getBenchParams $ benchNames bnch
else params,
levels=if null level
then nub $ map getBenchLvl $ benchNames bnch
else [level],
benches=if null benches
then nub $ map getBenchFunc $ benchNames bnch
else benches,
redThreshold = 0,
..}
defaultOpts :: Maybe String -> Opts
defaultOpts lvl =
case lvl of
Nothing -> go ""
(Just l) -> go l
where go level =
Opts {verb = Progress,
benches = [],
params = [],
colWidth = 30,
testNameWidth=20, ..}
prettyBenches :: Opts -> Benchmark-> IO ()
prettyBenches o bnch = do
hSetBuffering stdout NoBuffering
let o'@OptsInternal{..} = optsToInternal o bnch
rpts <- getReports o' bnch
when (verb == Progress) $ putStrLn ""
printTable o' $ reverse rpts
printTable :: OptsInternal -> [Report] -> IO ()
printTable _ [] = return ()
printTable o rpts = do
let colLbls = nub $ map (getBenchParams . reportName) rpts
exName = reportName $ head rpts
printf (testName o) $ (getTableName exName) ++ "/" ++ (getBenchLvl exName)
mapM_ (printf (col o)) colLbls
printf "\n"
let rpts' = transpose $ groupBy (\a b -> getBenchParams (reportName a) == getBenchParams (reportName b)) rpts
mapM_ (printRow o) rpts'
putStrLn ""
printRow :: OptsInternal -> [Report] -> IO ()
printRow o@OptsInternal{..} xs@(rpt : _) = do
printf (testName o) $ getBenchFunc $ reportName rpt
let times = map (secs . getRuntime) xs
forM_ times (printf (col o))
putStrLn ""