-- |
-- Module      : BenchShow.Internal.Report
-- Copyright   : (c) 2018 Composewell Technologies
--
-- License     : BSD3
-- Maintainer  : harendra.kumar@gmail.com
-- Stability   : experimental
-- Portability : GHC
--

{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TupleSections #-}

module BenchShow.Internal.Report
    (
      report
    ) where

import Control.Applicative (ZipList(..))
import Control.Monad (forM_)
import Data.Maybe (fromMaybe)
import Statistics.Types (Estimate(..))
import Text.Printf (printf)

import BenchShow.Internal.Common
import BenchShow.Internal.Analysis
import BenchShow.Internal.Pretty

multiplesToPercentDiff :: Double -> Double
multiplesToPercentDiff :: Double -> Double
multiplesToPercentDiff Double
x = (if Double
x Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
0 then Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
1 else Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
1) Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
100

colorCode :: Word -> Double -> Doc -> Doc
colorCode :: Word -> Double -> Doc -> Doc
colorCode Word
thresh Double
x =
    if Double
x Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Word -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
thresh
    then Doc -> Doc
dullred
    else if Double
x Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< (-Double
1) Double -> Double -> Double
forall a. Num a => a -> a -> a
* Word -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
thresh
         then Doc -> Doc
dullgreen
         else Doc -> Doc
forall a. a -> a
id

-- XXX in comparative reports render lower than baseline in green and higher
-- than baseline in red
genGroupReport :: RawReport -> Config -> IO ()
genGroupReport :: RawReport -> Config -> IO ()
genGroupReport RawReport{String
[String]
[ReportColumn]
Maybe String
Maybe [[Estimator]]
reportEstimators :: RawReport -> Maybe [[Estimator]]
reportColumns :: RawReport -> [ReportColumn]
reportRowIds :: RawReport -> [String]
reportIdentifier :: RawReport -> String
reportOutputFile :: RawReport -> Maybe String
reportEstimators :: Maybe [[Estimator]]
reportColumns :: [ReportColumn]
reportRowIds :: [String]
reportIdentifier :: String
reportOutputFile :: Maybe String
..} cfg :: Config
cfg@Config{Bool
[(String, FieldTick)]
[(String, Double, Double)]
[TitleAnnotation]
Maybe String
Maybe (String -> String)
Word
Estimator
DiffStrategy
Presentation
String -> Maybe (String, String)
[String] -> [String]
[(String, Int)] -> [(String, Int)]
(SortColumn
 -> Maybe GroupStyle -> Either String [(String, Double)])
-> [String]
selectBenchmarks :: Config
-> (SortColumn
    -> Maybe GroupStyle -> Either String [(String, Double)])
-> [String]
selectGroups :: Config -> [(String, Int)] -> [(String, Int)]
classifyBenchmark :: Config -> String -> Maybe (String, String)
fieldTicks :: Config -> [(String, FieldTick)]
fieldRanges :: Config -> [(String, Double, Double)]
selectFields :: Config -> [String] -> [String]
omitBaseline :: Config -> Bool
diffStrategy :: Config -> DiffStrategy
threshold :: Config -> Word
estimator :: Config -> Estimator
presentation :: Config -> Presentation
titleAnnotations :: Config -> [TitleAnnotation]
title :: Config -> Maybe String
mkTitle :: Config -> Maybe (String -> String)
outputDir :: Config -> Maybe String
verbose :: Config -> Bool
selectBenchmarks :: (SortColumn
 -> Maybe GroupStyle -> Either String [(String, Double)])
-> [String]
selectGroups :: [(String, Int)] -> [(String, Int)]
classifyBenchmark :: String -> Maybe (String, String)
fieldTicks :: [(String, FieldTick)]
fieldRanges :: [(String, Double, Double)]
selectFields :: [String] -> [String]
omitBaseline :: Bool
diffStrategy :: DiffStrategy
threshold :: Word
estimator :: Estimator
presentation :: Presentation
titleAnnotations :: [TitleAnnotation]
title :: Maybe String
mkTitle :: Maybe (String -> String)
outputDir :: Maybe String
verbose :: Bool
..} = do
    let diffStr :: Maybe String
diffStr =
            if [ReportColumn] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ReportColumn]
reportColumns Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1
            then Presentation -> DiffStrategy -> Maybe String
diffString Presentation
presentation DiffStrategy
diffStrategy
            else Maybe String
forall a. Maybe a
Nothing
    case Maybe (String -> String)
mkTitle of
        Just String -> String
f -> String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> String
f String
reportIdentifier
        Maybe (String -> String)
Nothing -> String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Maybe String -> Config -> String
makeTitle String
reportIdentifier Maybe String
diffStr Config
cfg

    let benchcol :: [String]
benchcol  = String
"Benchmark" String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
reportRowIds
        groupcols :: [[Doc]]
groupcols =
            let ReportColumn
firstCol : [ReportColumn]
tailCols = [ReportColumn]
reportColumns
                colorCol :: ReportColumn -> [Doc -> Doc]
colorCol ReportColumn{String
[Double]
[AnalyzedField]
RelativeUnit
colAnalyzed :: ReportColumn -> [AnalyzedField]
colValues :: ReportColumn -> [Double]
colUnit :: ReportColumn -> RelativeUnit
colName :: ReportColumn -> String
colAnalyzed :: [AnalyzedField]
colValues :: [Double]
colUnit :: RelativeUnit
colName :: String
..} =
                    let f :: Double -> Doc -> Doc
f Double
x = case Presentation
presentation of
                                Groups GroupStyle
Diff ->
                                    if Double
x Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
0 then Doc -> Doc
dullred else Doc -> Doc
dullgreen
                                Groups GroupStyle
PercentDiff -> Word -> Double -> Doc -> Doc
colorCode Word
threshold Double
x
                                Groups GroupStyle
Multiples ->
                                    let y :: Double
y = Double -> Double
multiplesToPercentDiff Double
x
                                    in Word -> Double -> Doc -> Doc
colorCode Word
threshold Double
y
                                Presentation
_ -> Doc -> Doc
forall a. a -> a
id
                    in (Double -> Doc -> Doc) -> [Double] -> [Doc -> Doc]
forall a b. (a -> b) -> [a] -> [b]
map Double -> Doc -> Doc
f [Double]
colValues
                renderTailCols :: Maybe [Estimator] -> ReportColumn -> [Doc]
renderTailCols Maybe [Estimator]
estimators ReportColumn
col =
                    let regular :: [Doc]
regular = [String] -> [Doc]
renderGroupCol ([String] -> [Doc]) -> [String] -> [Doc]
forall a b. (a -> b) -> a -> b
$ ReportColumn -> Maybe [Estimator] -> [String]
showCol ReportColumn
col Maybe [Estimator]
forall a. Maybe a
Nothing
                        colored :: [Doc]
colored = ((Doc -> Doc) -> Doc -> Doc) -> [Doc -> Doc] -> [Doc] -> [Doc]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
($) (Doc -> Doc
forall a. a -> a
id (Doc -> Doc) -> [Doc -> Doc] -> [Doc -> Doc]
forall a. a -> [a] -> [a]
: Doc -> Doc
forall a. a -> a
id (Doc -> Doc) -> [Doc -> Doc] -> [Doc -> Doc]
forall a. a -> [a] -> [a]
: ReportColumn -> [Doc -> Doc]
colorCol ReportColumn
col)
                                    ([Doc] -> [Doc]) -> [Doc] -> [Doc]
forall a b. (a -> b) -> a -> b
$ [String] -> [Doc]
renderGroupCol
                                    ([String] -> [Doc]) -> [String] -> [Doc]
forall a b. (a -> b) -> a -> b
$ ReportColumn -> Maybe [Estimator] -> [String]
showCol ReportColumn
col Maybe [Estimator]
estimators
                    in case Presentation
presentation of
                        Groups GroupStyle
Diff        -> [Doc]
colored
                        Groups GroupStyle
PercentDiff -> [Doc]
colored
                        Groups GroupStyle
Multiples   -> [Doc]
colored
                        Presentation
_ -> [Doc]
regular
            in [String] -> [Doc]
renderGroupCol (ReportColumn -> [String]
showFirstCol ReportColumn
firstCol)
             [Doc] -> [[Doc]] -> [[Doc]]
forall a. a -> [a] -> [a]
: case Maybe [[Estimator]]
reportEstimators of
                Just [[Estimator]]
ests -> ZipList [Doc] -> [[Doc]]
forall a. ZipList a -> [a]
getZipList (ZipList [Doc] -> [[Doc]]) -> ZipList [Doc] -> [[Doc]]
forall a b. (a -> b) -> a -> b
$
                            Maybe [Estimator] -> ReportColumn -> [Doc]
renderTailCols
                        (Maybe [Estimator] -> ReportColumn -> [Doc])
-> ZipList (Maybe [Estimator]) -> ZipList (ReportColumn -> [Doc])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Maybe [Estimator]] -> ZipList (Maybe [Estimator])
forall a. [a] -> ZipList a
ZipList (([Estimator] -> Maybe [Estimator])
-> [[Estimator]] -> [Maybe [Estimator]]
forall a b. (a -> b) -> [a] -> [b]
map [Estimator] -> Maybe [Estimator]
forall a. a -> Maybe a
Just ([[Estimator]] -> [Maybe [Estimator]])
-> [[Estimator]] -> [Maybe [Estimator]]
forall a b. (a -> b) -> a -> b
$ [[Estimator]] -> [[Estimator]]
forall a. [a] -> [a]
tail [[Estimator]]
ests)
                        ZipList (ReportColumn -> [Doc])
-> ZipList ReportColumn -> ZipList [Doc]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [ReportColumn] -> ZipList ReportColumn
forall a. [a] -> ZipList a
ZipList [ReportColumn]
tailCols
                Maybe [[Estimator]]
Nothing ->  ZipList [Doc] -> [[Doc]]
forall a. ZipList a -> [a]
getZipList (ZipList [Doc] -> [[Doc]]) -> ZipList [Doc] -> [[Doc]]
forall a b. (a -> b) -> a -> b
$
                            Maybe [Estimator] -> ReportColumn -> [Doc]
renderTailCols
                        (Maybe [Estimator] -> ReportColumn -> [Doc])
-> ZipList (Maybe [Estimator]) -> ZipList (ReportColumn -> [Doc])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe [Estimator] -> ZipList (Maybe [Estimator])
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe [Estimator]
forall a. Maybe a
Nothing
                        ZipList (ReportColumn -> [Doc])
-> ZipList ReportColumn -> ZipList [Doc]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [ReportColumn] -> ZipList ReportColumn
forall a. [a] -> ZipList a
ZipList [ReportColumn]
tailCols
        rows :: [Doc]
rows = ([Doc] -> [Doc] -> [Doc]) -> [Doc] -> [[Doc]] -> [Doc]
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl ((Doc -> Doc -> Doc) -> [Doc] -> [Doc] -> [Doc]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Doc -> Doc -> Doc
(<+>)) ([String] -> [Doc]
renderCol [String]
benchcol) [[Doc]]
groupcols
    Doc -> IO ()
putDoc (Doc -> IO ()) -> Doc -> IO ()
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
vcat [Doc]
rows
    String -> IO ()
putStrLn String
"\n"

    where

    renderCol :: [String] -> [Doc]
renderCol [] = String -> [Doc]
forall a. HasCallStack => String -> a
error String
"Bug: header row missing"
    renderCol col :: [String]
col@(String
h : [String]
rows) =
        let maxlen :: Int
maxlen = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ((String -> Int) -> [String] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
col)
        in (String -> Doc) -> [String] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Doc -> Doc
fill Int
maxlen (Doc -> Doc) -> (String -> Doc) -> String -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Doc
text) (String
h String -> [String] -> [String]
forall a. a -> [a] -> [a]
: Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
maxlen Char
'-' String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
rows)

    renderGroupCol :: [String] -> [Doc]
renderGroupCol [] = String -> [Doc]
forall a. HasCallStack => String -> a
error
        String
"Bug: There has to be at least one column in raw report"
    renderGroupCol col :: [String]
col@(String
h : [String]
rows) =
        let maxlen :: Int
maxlen = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ((String -> Int) -> [String] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
col)
        in (String -> Doc) -> [String] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (\String
x -> Int -> Doc -> Doc
indent (Int
maxlen Int -> Int -> Int
forall a. Num a => a -> a -> a
- String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
x) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
x)
               (String
h String -> [String] -> [String]
forall a. a -> [a] -> [a]
: Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
maxlen Char
'-' String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
rows)

    showEstimator :: Estimator -> p
showEstimator Estimator
est =
        case Estimator
est of
            Estimator
Mean       -> p
"(mean)"
            Estimator
Median     -> p
"(medi)"
            Estimator
Regression -> p
"(regr)"

    showEstVal :: AnalyzedField -> Estimator -> p
showEstVal AnalyzedField
estvals Estimator
est =
        case Estimator
est of
            Estimator
Mean ->
                let sd :: Double
sd = AnalyzedField -> Double
analyzedStdDev AnalyzedField
estvals
                    val :: Double
val = AnalyzedField -> Double
analyzedMean AnalyzedField
estvals
                in
                   if Double
val Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
/= Double
0
                   then String -> Double -> p
forall r. PrintfType r => String -> r
printf String
"(%.2f)" (Double -> p) -> Double -> p
forall a b. (a -> b) -> a -> b
$ Double
sd Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double -> Double
forall a. Num a => a -> a
abs Double
val
                   else p
""
            Estimator
Median ->
                let x :: Double
x = OutlierVariance -> Double
ovFraction (OutlierVariance -> Double) -> OutlierVariance -> Double
forall a b. (a -> b) -> a -> b
$ AnalyzedField -> OutlierVariance
analyzedOutlierVar AnalyzedField
estvals
                in String -> Double -> p
forall r. PrintfType r => String -> r
printf String
"(%.2f)" Double
x
            Estimator
Regression ->
                case AnalyzedField -> Maybe (Estimate ConfInt Double)
analyzedRegRSq AnalyzedField
estvals of
                    Just Estimate ConfInt Double
rsq -> String -> Double -> p
forall r. PrintfType r => String -> r
printf String
"(%.2f)" (Estimate ConfInt Double -> Double
forall (e :: * -> *) a. Estimate e a -> a
estPoint Estimate ConfInt Double
rsq)
                    Maybe (Estimate ConfInt Double)
Nothing -> p
""

    showFirstCol :: ReportColumn -> [String]
showFirstCol ReportColumn{String
[Double]
[AnalyzedField]
RelativeUnit
colAnalyzed :: [AnalyzedField]
colValues :: [Double]
colUnit :: RelativeUnit
colName :: String
colAnalyzed :: ReportColumn -> [AnalyzedField]
colValues :: ReportColumn -> [Double]
colUnit :: ReportColumn -> RelativeUnit
colName :: ReportColumn -> String
..} =
        let showVal :: Double -> String
showVal = String -> Double -> String
forall r. PrintfType r => String -> r
printf String
"%.2f"
            withEstimator :: Double -> AnalyzedField -> String
withEstimator Double
val AnalyzedField
estvals =
                Double -> String
showVal Double
val String -> String -> String
forall a. [a] -> [a] -> [a]
++
                    if Bool
verbose
                    then AnalyzedField -> Estimator -> String
forall p.
(PrintfType p, IsString p) =>
AnalyzedField -> Estimator -> p
showEstVal AnalyzedField
estvals Estimator
estimator
                    else String
""
            withEstVal :: [String]
withEstVal =
                (Double -> AnalyzedField -> String)
-> [Double] -> [AnalyzedField] -> [String]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Double -> AnalyzedField -> String
withEstimator [Double]
colValues [AnalyzedField]
colAnalyzed
        in String
colName String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
withEstVal

    showCol :: ReportColumn -> Maybe [Estimator] -> [String]
showCol ReportColumn{String
[Double]
[AnalyzedField]
RelativeUnit
colAnalyzed :: [AnalyzedField]
colValues :: [Double]
colUnit :: RelativeUnit
colName :: String
colAnalyzed :: ReportColumn -> [AnalyzedField]
colValues :: ReportColumn -> [Double]
colUnit :: ReportColumn -> RelativeUnit
colName :: ReportColumn -> String
..} Maybe [Estimator]
estimators = String
colName String -> [String] -> [String]
forall a. a -> [a] -> [a]
:
        let showVal :: a -> p
showVal a
val =
                let showDiff :: p
showDiff =
                        if a
val a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
0
                        then String -> a -> p
forall r. PrintfType r => String -> r
printf String
"+%.2f" a
val
                        else String -> a -> p
forall r. PrintfType r => String -> r
printf String
"%.2f" a
val
                in case Presentation
presentation of
                        Groups GroupStyle
Diff        -> p
showDiff
                        Groups GroupStyle
PercentDiff -> p
showDiff
                        Groups GroupStyle
Multiples ->
                            if a
val a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
0
                            then String -> a -> p
forall r. PrintfType r => String -> r
printf String
"%.2f" a
val
                            else String -> a -> p
forall r. PrintfType r => String -> r
printf String
"1/%.2f" (a -> a
forall a. Num a => a -> a
negate a
val)
                        Presentation
_ -> String -> a -> p
forall r. PrintfType r => String -> r
printf String
"%.2f" a
val

            showEstAnnot :: Estimator -> p
showEstAnnot Estimator
est =
                case Presentation
presentation of
                    Groups GroupStyle
Diff        -> Estimator -> p
forall p. IsString p => Estimator -> p
showEstimator Estimator
est
                    Groups GroupStyle
PercentDiff -> Estimator -> p
forall p. IsString p => Estimator -> p
showEstimator Estimator
est
                    Groups GroupStyle
Multiples   -> Estimator -> p
forall p. IsString p => Estimator -> p
showEstimator Estimator
est
                    Presentation
_ -> p
""

        in case Maybe [Estimator]
estimators of
            Just [Estimator]
ests ->
                let withAnnot :: a -> AnalyzedField -> Estimator -> String
withAnnot a
val AnalyzedField
estvals Estimator
est =
                           a -> String
forall a p. (Ord a, Num a, PrintfArg a, PrintfType p) => a -> p
showVal a
val
                        String -> String -> String
forall a. [a] -> [a] -> [a]
++ if Bool
verbose
                           then AnalyzedField -> Estimator -> String
forall p.
(PrintfType p, IsString p) =>
AnalyzedField -> Estimator -> p
showEstVal AnalyzedField
estvals Estimator
est
                                String -> String -> String
forall a. [a] -> [a] -> [a]
++ Estimator -> String
forall p. IsString p => Estimator -> p
showEstAnnot Estimator
est
                           else String
""
                in ZipList String -> [String]
forall a. ZipList a -> [a]
getZipList (ZipList String -> [String]) -> ZipList String -> [String]
forall a b. (a -> b) -> a -> b
$
                        Double -> AnalyzedField -> Estimator -> String
forall a.
(PrintfArg a, Num a, Ord a) =>
a -> AnalyzedField -> Estimator -> String
withAnnot
                    (Double -> AnalyzedField -> Estimator -> String)
-> ZipList Double -> ZipList (AnalyzedField -> Estimator -> String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Double] -> ZipList Double
forall a. [a] -> ZipList a
ZipList [Double]
colValues
                    ZipList (AnalyzedField -> Estimator -> String)
-> ZipList AnalyzedField -> ZipList (Estimator -> String)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [AnalyzedField] -> ZipList AnalyzedField
forall a. [a] -> ZipList a
ZipList [AnalyzedField]
colAnalyzed
                    ZipList (Estimator -> String)
-> ZipList Estimator -> ZipList String
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Estimator] -> ZipList Estimator
forall a. [a] -> ZipList a
ZipList [Estimator]
ests

            Maybe [Estimator]
Nothing ->
                let withEstVal :: a -> AnalyzedField -> Estimator -> String
withEstVal a
val AnalyzedField
estvals Estimator
est =
                           a -> String
forall a p. (Ord a, Num a, PrintfArg a, PrintfType p) => a -> p
showVal a
val
                        String -> String -> String
forall a. [a] -> [a] -> [a]
++ if Bool
verbose then AnalyzedField -> Estimator -> String
forall p.
(PrintfType p, IsString p) =>
AnalyzedField -> Estimator -> p
showEstVal AnalyzedField
estvals Estimator
est else String
""
                in ZipList String -> [String]
forall a. ZipList a -> [a]
getZipList (ZipList String -> [String]) -> ZipList String -> [String]
forall a b. (a -> b) -> a -> b
$
                        Double -> AnalyzedField -> Estimator -> String
forall a.
(PrintfArg a, Num a, Ord a) =>
a -> AnalyzedField -> Estimator -> String
withEstVal
                    (Double -> AnalyzedField -> Estimator -> String)
-> ZipList Double -> ZipList (AnalyzedField -> Estimator -> String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Double] -> ZipList Double
forall a. [a] -> ZipList a
ZipList [Double]
colValues
                    ZipList (AnalyzedField -> Estimator -> String)
-> ZipList AnalyzedField -> ZipList (Estimator -> String)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [AnalyzedField] -> ZipList AnalyzedField
forall a. [a] -> ZipList a
ZipList [AnalyzedField]
colAnalyzed
                    ZipList (Estimator -> String)
-> ZipList Estimator -> ZipList String
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Estimator -> ZipList Estimator
forall (f :: * -> *) a. Applicative f => a -> f a
pure Estimator
estimator

-- | Presents the benchmark results in a CSV input file as text reports
-- according to the provided configuration.  The first parameter is the input
-- file name. The second parameter, when specified using 'Just', is the name
-- prefix for the output SVG image file(s). One or more output files may be
-- generated with the given prefix depending on the 'Presentation' setting.
-- When the second parameter is 'Nothing' the reports are printed on the
-- console. The last parameter is the configuration to customize the report,
-- you can start with 'defaultConfig' as the base and override any of the
-- fields that you may want to change.
--
-- For example:
--
-- @
-- report "bench-results.csv" Nothing 'defaultConfig'
-- @
--
-- @since 0.2.0
report :: FilePath -> Maybe FilePath -> Config -> IO ()
report :: String -> Maybe String -> Config -> IO ()
report String
inputFile Maybe String
outputFile cfg :: Config
cfg@Config{Bool
[(String, FieldTick)]
[(String, Double, Double)]
[TitleAnnotation]
Maybe String
Maybe (String -> String)
Word
Estimator
DiffStrategy
Presentation
String -> Maybe (String, String)
[String] -> [String]
[(String, Int)] -> [(String, Int)]
(SortColumn
 -> Maybe GroupStyle -> Either String [(String, Double)])
-> [String]
selectBenchmarks :: (SortColumn
 -> Maybe GroupStyle -> Either String [(String, Double)])
-> [String]
selectGroups :: [(String, Int)] -> [(String, Int)]
classifyBenchmark :: String -> Maybe (String, String)
fieldTicks :: [(String, FieldTick)]
fieldRanges :: [(String, Double, Double)]
selectFields :: [String] -> [String]
omitBaseline :: Bool
diffStrategy :: DiffStrategy
threshold :: Word
estimator :: Estimator
presentation :: Presentation
titleAnnotations :: [TitleAnnotation]
title :: Maybe String
mkTitle :: Maybe (String -> String)
outputDir :: Maybe String
verbose :: Bool
selectBenchmarks :: Config
-> (SortColumn
    -> Maybe GroupStyle -> Either String [(String, Double)])
-> [String]
selectGroups :: Config -> [(String, Int)] -> [(String, Int)]
classifyBenchmark :: Config -> String -> Maybe (String, String)
fieldTicks :: Config -> [(String, FieldTick)]
fieldRanges :: Config -> [(String, Double, Double)]
selectFields :: Config -> [String] -> [String]
omitBaseline :: Config -> Bool
diffStrategy :: Config -> DiffStrategy
threshold :: Config -> Word
estimator :: Config -> Estimator
presentation :: Config -> Presentation
titleAnnotations :: Config -> [TitleAnnotation]
title :: Config -> Maybe String
mkTitle :: Config -> Maybe (String -> String)
outputDir :: Config -> Maybe String
verbose :: Config -> Bool
..} = do
    let dir :: String
dir = String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"." Maybe String
outputDir
    (CSV
csvlines, [String]
fields) <- String -> Config -> IO (CSV, [String])
prepareToReport String
inputFile Config
cfg
    (Int
runs, [GroupMatrix]
matrices) <- Config -> String -> CSV -> [String] -> IO (Int, [GroupMatrix])
prepareGroupMatrices Config
cfg String
inputFile CSV
csvlines [String]
fields
    case Presentation
presentation of
        Groups GroupStyle
style ->
            [String] -> (String -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [String]
fields ((String -> IO ()) -> IO ()) -> (String -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$
                GroupStyle
-> String
-> Maybe String
-> ReportType
-> Int
-> Config
-> (RawReport -> Config -> IO ())
-> [GroupMatrix]
-> String
-> IO ()
reportComparingGroups GroupStyle
style String
dir Maybe String
outputFile ReportType
TextReport Int
runs
                               Config
cfg RawReport -> Config -> IO ()
genGroupReport [GroupMatrix]
matrices
        Presentation
Fields -> do
            [GroupMatrix] -> (GroupMatrix -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [GroupMatrix]
matrices ((GroupMatrix -> IO ()) -> IO ())
-> (GroupMatrix -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$
                String
-> Maybe String
-> ReportType
-> Config
-> (RawReport -> Config -> IO ())
-> GroupMatrix
-> IO ()
reportPerGroup String
dir Maybe String
outputFile ReportType
TextReport Config
cfg RawReport -> Config -> IO ()
genGroupReport
        Presentation
Solo ->
            let funcs :: [String -> IO ()]
funcs = (GroupMatrix -> String -> IO ())
-> [GroupMatrix] -> [String -> IO ()]
forall a b. (a -> b) -> [a] -> [b]
map
                    (\GroupMatrix
mx -> GroupStyle
-> String
-> Maybe String
-> ReportType
-> Int
-> Config
-> (RawReport -> Config -> IO ())
-> [GroupMatrix]
-> String
-> IO ()
reportComparingGroups GroupStyle
Absolute String
dir
                        ((String -> String) -> Maybe String -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"-" String -> String -> String
forall a. [a] -> [a] -> [a]
++ GroupMatrix -> String
groupName GroupMatrix
mx) Maybe String
outputFile)
                        ReportType
TextReport Int
runs Config
cfg RawReport -> Config -> IO ()
genGroupReport [GroupMatrix
mx])
                    [GroupMatrix]
matrices
             in [IO ()] -> IO ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ ([IO ()] -> IO ()) -> [IO ()] -> IO ()
forall a b. (a -> b) -> a -> b
$ [String -> IO ()]
funcs [String -> IO ()] -> [String] -> [IO ()]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [String]
fields