module Crypto.Lol.Utils.PrettyPrint
(getTableName
,getBenchParams
,getBenchLvl
,getBenchFunc
,getReports
,getRuntime
,col
,testName
,OptsInternal(..)
,Verb(..)) where
import Control.Monad (foldM, when)
import Control.Monad.IO.Class (MonadIO, liftIO)
import Criterion.Internal (runAndAnalyseOne)
import Criterion.Main.Options (defaultConfig)
import Criterion.Measurement (secs)
import Criterion.Monad (Criterion, withConfig)
import Criterion.Types
import Data.List.Split
import qualified Data.Map as Map
import Data.Maybe
import Statistics.Resampling.Bootstrap (Estimate(..))
data Verb = Progress
| Abridged
| Full
deriving (Eq)
data OptsInternal = OptsInternal
{verb :: Verb,
levels :: [String],
benches :: [String],
params :: [String],
redThreshold :: Double,
colWidth :: Int,
testNameWidth :: Int}
col, testName :: OptsInternal -> String
testName OptsInternal{..} = "%-" ++ show testNameWidth ++ "s "
col OptsInternal{..} = "%-" ++ show colWidth ++ "s "
parseBenchName :: String -> [String]
parseBenchName = wordsBy (=='/')
getTableName :: String -> String
getTableName = (!! 0) . parseBenchName
getBenchParams :: String -> String
getBenchParams = (!! 1) . parseBenchName
getBenchLvl :: String -> String
getBenchLvl = (!! 2) . parseBenchName
getBenchFunc :: String -> String
getBenchFunc = (!! 3) . parseBenchName
getReports :: OptsInternal -> Benchmark -> IO [Report]
getReports o = withConfig (config o) . runAndAnalyse o
config :: OptsInternal -> Config
config OptsInternal{..} = defaultConfig {verbosity = if verb == Full then Normal else Quiet}
runAndAnalyse :: OptsInternal -> Benchmark -> Criterion [Report]
runAndAnalyse o@OptsInternal{..} bs = for o bs $ \idx desc bm -> do
when (verb == Abridged || verb == Full) $ liftIO $ putStr $ "benchmark " ++ desc
when (verb == Full) $ liftIO $ putStrLn ""
(Analysed rpt) <- runAndAnalyseOne idx desc bm
when (verb == Progress) $ liftIO $ putStr "."
when (verb == Abridged) $ liftIO $ putStrLn $ "..." ++ secs (getRuntime rpt)
return rpt
getRuntime :: Report -> Double
getRuntime Report{..} =
let SampleAnalysis{..} = reportAnalysis
(builtin, _) = splitAt 1 anRegress
mests = map (\Regression{..} -> Map.lookup "iters" regCoeffs) builtin
[Estimate{..}] = catMaybes mests
in estPoint
for :: MonadIO m => OptsInternal -> Benchmark -> (Int -> String -> Benchmarkable -> m a) -> m [a]
for OptsInternal{..} bs0 handle = snd <$> go (0::Int, []) ("", bs0)
where
select name =
let param = getBenchParams name
lvl = getBenchLvl name
func = getBenchFunc name
in (lvl `elem` levels) && (func `elem` benches) && (param `elem` params)
go (!idx, drs) (pfx, Benchmark desc b)
| select desc' = do
x <- handle idx desc' b;
return (idx + 1, x:drs)
| otherwise = do
liftIO $ putStrLn desc'
return (idx, drs)
where desc' = addPrefix pfx desc
go (!idx,drs) (pfx, BenchGroup desc bs) =
foldM go (idx,drs) [(addPrefix pfx desc, b) | b <- bs]