-- |
-- Module      : BenchShow.Internal.Common
-- 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.Common
    ( Presentation(..)
    , GroupStyle(..)
    , FieldTick (..)
    , SortColumn (..)
    , RelativeUnit (..)
    , Estimator (..)
    , DiffStrategy (..)
    , TitleAnnotation (..)
    , Config(..)
    , defaultConfig

    , getFieldRange
    , getFieldTick

    , GroupMatrix(..)
    , prepareGroupMatrices

    , ReportColumn(..)
    , RawReport(..)
    , ReportType(..)
    , diffString
    , makeTitle
    , prepareToReport
    , reportComparingGroups
    , reportPerGroup
    ) where

import Control.Applicative (ZipList(..))
import Control.Arrow (second)
import Control.Exception (assert)
import Control.Monad (when, unless)
import Data.Char (toLower)
import Data.Foldable (foldl')
import Data.Function ((&), on)
import Data.List
       (transpose, groupBy, (\\), find, sortBy, elemIndex, intersect,
        intersectBy)
import Data.List.Split (linesBy)
import Data.Maybe (fromMaybe, mapMaybe)
import Data.Ord (comparing)
import Debug.Trace (trace)
import Statistics.Types (Estimate(..), ConfInt(..))
import System.Directory (createDirectoryIfMissing)
import System.FilePath ((</>))
import Text.CSV (CSV, parseCSVFromFile)
import Text.Read (readMaybe)

import BenchShow.Internal.Analysis

-------------------------------------------------------------------------------
-- Utilities
-------------------------------------------------------------------------------

filterSanity :: (Eq a, Show a) => String -> [a] -> [a] -> IO ()
filterSanity :: String -> [a] -> [a] -> IO ()
filterSanity String
label [a]
old [a]
new = do
    let added :: [a]
added = [a]
new [a] -> [a] -> [a]
forall a. Eq a => [a] -> [a] -> [a]
\\ [a]
old

    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
new) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
forall a. HasCallStack => String -> a
error (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$
        String
label String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" must select at least one item from the list: "
        String -> String -> String
forall a. [a] -> [a] -> [a]
++ [a] -> String
forall a. Show a => a -> String
show [a]
old

    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
added) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
forall a. HasCallStack => String -> a
error (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$
        String
label String -> String -> String
forall a. [a] -> [a] -> [a]
++
        String
" must not add any new items to the original list. The \
        \following items were added: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [a] -> String
forall a. Show a => a -> String
show [a]
added
        String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\nOriginal groups: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [a] -> String
forall a. Show a => a -> String
show [a]
old
        String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\nNew groups: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [a] -> String
forall a. Show a => a -> String
show [a]
new

-------------------------------------------------------------------------------

data ReportType = TextReport | GraphicalChart

-- | How to show the results for multiple benchmark groups presented in columns
-- or bar chart clusters. In relative comparisons, the first group is
-- considered as the baseline and the subsequent groups are compared against
-- the baseline.
--
-- /Definition changed in 0.3.0/
-- @since 0.2.0
data GroupStyle =
      Absolute    -- ^ Show absolute values of the field for all groups
    | Diff        -- ^ Show baseline group as absolute values and values for
                  -- the subsequent groups as difference from the baseline
    | PercentDiff -- ^ If the value of the group being compared is higher than
                  -- the baseline then display the difference as percentage of
                  -- baseline otherwise display the difference as a percentage
                  -- of the group being compared.
    | Multiples   -- ^ If the value of the group being compared is higher than
                  -- the baseline then display @+(value / baseline value)@
                  -- otherwise display @-(baseline value / value)@. This
                  -- provides a normalized comparison independent of the
                  -- absolute value of a benchmark. Note that 'Multiples' can
                  -- be directly computed using 'PercentDiff' and vice-versa.
    deriving (GroupStyle -> GroupStyle -> Bool
(GroupStyle -> GroupStyle -> Bool)
-> (GroupStyle -> GroupStyle -> Bool) -> Eq GroupStyle
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GroupStyle -> GroupStyle -> Bool
$c/= :: GroupStyle -> GroupStyle -> Bool
== :: GroupStyle -> GroupStyle -> Bool
$c== :: GroupStyle -> GroupStyle -> Bool
Eq, Int -> GroupStyle -> String -> String
[GroupStyle] -> String -> String
GroupStyle -> String
(Int -> GroupStyle -> String -> String)
-> (GroupStyle -> String)
-> ([GroupStyle] -> String -> String)
-> Show GroupStyle
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [GroupStyle] -> String -> String
$cshowList :: [GroupStyle] -> String -> String
show :: GroupStyle -> String
$cshow :: GroupStyle -> String
showsPrec :: Int -> GroupStyle -> String -> String
$cshowsPrec :: Int -> GroupStyle -> String -> String
Show, ReadPrec [GroupStyle]
ReadPrec GroupStyle
Int -> ReadS GroupStyle
ReadS [GroupStyle]
(Int -> ReadS GroupStyle)
-> ReadS [GroupStyle]
-> ReadPrec GroupStyle
-> ReadPrec [GroupStyle]
-> Read GroupStyle
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GroupStyle]
$creadListPrec :: ReadPrec [GroupStyle]
readPrec :: ReadPrec GroupStyle
$creadPrec :: ReadPrec GroupStyle
readList :: ReadS [GroupStyle]
$creadList :: ReadS [GroupStyle]
readsPrec :: Int -> ReadS GroupStyle
$creadsPrec :: Int -> ReadS GroupStyle
Read)

-- | How to present the reports or graphs. Each report presents a number of
-- benchmarks as rows, it may have, (1) a single column presenting the values
-- for a single field, (2) multiple columns presenting values for different
-- fields, or (3) multiple columns presenting values of the same field for
-- different groups.
--
-- @since 0.2.0
data Presentation =
      Solo              -- ^ Reports are generated for each group and for
                        -- each field selected by the configuration. Each
                        -- report presents benchmarks in a single group with a
                        -- single column presenting a single field.  If there
                        -- are @m@ fields and @n@ groups selected by the
                        -- configuration then a total of @m x n@ reports are
                        -- generated.  Output files are named using
                        -- @-estimator-groupname-fieldname@ as suffix.
    | Groups GroupStyle -- ^ One report is generated for each field selected by
                        -- the configuration. Each report presents a field
                        -- with all the groups selected by the configuration as
                        -- columns or clusters. Output files are named using
                        -- @-estimator-fieldname@ as suffix.
    | Fields            -- ^ One report is generated for each group selected by
                        -- the configuration. Each report presents a group
                        -- with all the fields selected by the configuration as
                        -- columns or clusters. Output files are named using
                        -- @-estimator-groupname@ as suffix.
    deriving (Presentation -> Presentation -> Bool
(Presentation -> Presentation -> Bool)
-> (Presentation -> Presentation -> Bool) -> Eq Presentation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Presentation -> Presentation -> Bool
$c/= :: Presentation -> Presentation -> Bool
== :: Presentation -> Presentation -> Bool
$c== :: Presentation -> Presentation -> Bool
Eq, Int -> Presentation -> String -> String
[Presentation] -> String -> String
Presentation -> String
(Int -> Presentation -> String -> String)
-> (Presentation -> String)
-> ([Presentation] -> String -> String)
-> Show Presentation
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Presentation] -> String -> String
$cshowList :: [Presentation] -> String -> String
show :: Presentation -> String
$cshow :: Presentation -> String
showsPrec :: Int -> Presentation -> String -> String
$cshowsPrec :: Int -> Presentation -> String -> String
Show, ReadPrec [Presentation]
ReadPrec Presentation
Int -> ReadS Presentation
ReadS [Presentation]
(Int -> ReadS Presentation)
-> ReadS [Presentation]
-> ReadPrec Presentation
-> ReadPrec [Presentation]
-> Read Presentation
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Presentation]
$creadListPrec :: ReadPrec [Presentation]
readPrec :: ReadPrec Presentation
$creadPrec :: ReadPrec Presentation
readList :: ReadS [Presentation]
$creadList :: ReadS [Presentation]
readsPrec :: Int -> ReadS Presentation
$creadsPrec :: Int -> ReadS Presentation
Read)

-- | FieldTick is used only in visual charts to generate the major ticks on
-- the y-axis. You can specify either the size of a tick ('TickSize') or the
-- total number of ticks ('TickCount').
--
-- @since 0.2.0
data FieldTick =
      TickSize Int  -- ^ Size of a tick, the unit is microseconds for time
                     -- fields, and bytes for space fields.
    | TickCount Int -- ^ Total number of ticks in the range spread.

-- | When sorting and filtering the benchmarks using 'selectBenchmarks' we can
-- choose a column as a sort criterion.  'selectBenchmarks' is provided with
-- the data for the corresponding column which can be used for sorting the
-- benchmarks. The column could be a group or a field depending on the
-- 'Presentation'.
--
-- @since 0.2.0
data SortColumn =
      ColumnIndex Int -- ^ Specify the index of the sort column. Index 0
        -- corresponds to the first @value@ column. In a textual report, the
        -- very first column consists of benchmark names, therefore index 0
        -- addresses the second column of the report.
    | ColumnName (Either String (String, Int)) -- ^ Specify the column using
        -- the name of the group or the field it represents, and the @runId@.
        -- When just the name is enough to uniquely identify the sort column
        -- the 'Left' constructor can be used, otherwise the 'Right'
        -- constructor is used which can use the @runId@ to disambiguate.  In a
        -- 'Fields' presentation, just the field name is enough.  In a 'Groups'
        -- presentation, when there is a single benchmark run in the input
        -- file, just the group name is enough to identify the group, the
        -- @runId@ defaults to 0.  However, when there are multiple runs, a
        -- group needs to specify a @runId@ as well.

-- | Strategy to compute the difference between two groups of benchmarks being
-- compared.
--
-- @since 0.2.0
data DiffStrategy =
      SingleEstimator -- ^ Use a single estimator to compute the difference
                      -- between the baseline and the candidate. The estimator
                      -- that is provided in the 'Config' is used.
    | MinEstimator    -- ^ Use 'Mean', 'Median' and 'Regression' estimators for
                      -- both baseline and candidate, and report the estimator
                      -- that shows the minimum difference. This is more robust
                      -- against random variations.
    {-
    | WorstBest
    | BestBest
    -}
    deriving (Int -> DiffStrategy -> String -> String
[DiffStrategy] -> String -> String
DiffStrategy -> String
(Int -> DiffStrategy -> String -> String)
-> (DiffStrategy -> String)
-> ([DiffStrategy] -> String -> String)
-> Show DiffStrategy
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [DiffStrategy] -> String -> String
$cshowList :: [DiffStrategy] -> String -> String
show :: DiffStrategy -> String
$cshow :: DiffStrategy -> String
showsPrec :: Int -> DiffStrategy -> String -> String
$cshowsPrec :: Int -> DiffStrategy -> String -> String
Show, ReadPrec [DiffStrategy]
ReadPrec DiffStrategy
Int -> ReadS DiffStrategy
ReadS [DiffStrategy]
(Int -> ReadS DiffStrategy)
-> ReadS [DiffStrategy]
-> ReadPrec DiffStrategy
-> ReadPrec [DiffStrategy]
-> Read DiffStrategy
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DiffStrategy]
$creadListPrec :: ReadPrec [DiffStrategy]
readPrec :: ReadPrec DiffStrategy
$creadPrec :: ReadPrec DiffStrategy
readList :: ReadS [DiffStrategy]
$creadList :: ReadS [DiffStrategy]
readsPrec :: Int -> ReadS DiffStrategy
$creadsPrec :: Int -> ReadS DiffStrategy
Read)

-- | Additional annotations that can be optionally added to the title of the
-- report or graph.
--
-- @since 0.2.2
{-# DEPRECATED TitleAnnotation "Please use mkTitle to make a custom title" #-}
data TitleAnnotation = TitleField | TitleEstimator | TitleDiff
    deriving (TitleAnnotation -> TitleAnnotation -> Bool
(TitleAnnotation -> TitleAnnotation -> Bool)
-> (TitleAnnotation -> TitleAnnotation -> Bool)
-> Eq TitleAnnotation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TitleAnnotation -> TitleAnnotation -> Bool
$c/= :: TitleAnnotation -> TitleAnnotation -> Bool
== :: TitleAnnotation -> TitleAnnotation -> Bool
$c== :: TitleAnnotation -> TitleAnnotation -> Bool
Eq, Int -> TitleAnnotation -> String -> String
[TitleAnnotation] -> String -> String
TitleAnnotation -> String
(Int -> TitleAnnotation -> String -> String)
-> (TitleAnnotation -> String)
-> ([TitleAnnotation] -> String -> String)
-> Show TitleAnnotation
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [TitleAnnotation] -> String -> String
$cshowList :: [TitleAnnotation] -> String -> String
show :: TitleAnnotation -> String
$cshow :: TitleAnnotation -> String
showsPrec :: Int -> TitleAnnotation -> String -> String
$cshowsPrec :: Int -> TitleAnnotation -> String -> String
Show, ReadPrec [TitleAnnotation]
ReadPrec TitleAnnotation
Int -> ReadS TitleAnnotation
ReadS [TitleAnnotation]
(Int -> ReadS TitleAnnotation)
-> ReadS [TitleAnnotation]
-> ReadPrec TitleAnnotation
-> ReadPrec [TitleAnnotation]
-> Read TitleAnnotation
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [TitleAnnotation]
$creadListPrec :: ReadPrec [TitleAnnotation]
readPrec :: ReadPrec TitleAnnotation
$creadPrec :: ReadPrec TitleAnnotation
readList :: ReadS [TitleAnnotation]
$creadList :: ReadS [TitleAnnotation]
readsPrec :: Int -> ReadS TitleAnnotation
$creadsPrec :: Int -> ReadS TitleAnnotation
Read)

-- | Configuration governing generation of chart. See 'defaultConfig' for the
-- default values of these fields.
--
-- @since 0.2.0
data Config = Config
    {
    -- | Provide more details in the report, especially the standard deviation,
    -- outlier variance, R-square estimate and an annotation to indicate the
    -- actual method used when using 'MinEstimator' are reported.
      Config -> Bool
verbose :: Bool

    -- | The directory where the output graph or report file should be placed.
    , Config -> Maybe String
outputDir   :: Maybe FilePath

    -- | Function to make a title for the report. The argument to the function
    -- is the benchmark field name for which the report is being made.
    , Config -> Maybe (String -> String)
mkTitle  :: Maybe (String -> String)

    -- | /DEPRECATED: Please use 'mkTitle' instead./
    --
    -- Report title, more information like the plotted field name or
    -- the presentation style may be added to it.
    , Config -> Maybe String
title  :: Maybe String

    -- | /DEPRECATED: Please use 'mkTitle' instead./
    --
    -- Additional annotations to be added to the title
    , Config -> [TitleAnnotation]
titleAnnotations :: [TitleAnnotation]

    -- | How to determine the layout of the report or the chart.
    , Config -> Presentation
presentation :: Presentation

    -- | The estimator used for the report.
    , Config -> Estimator
estimator    :: Estimator

    -- | The minimum percentage difference between two runs of a benchmark
    -- beyond which the benchmark is flagged to have regressed or improved.
    , Config -> Word
threshold :: Word

    -- | Strategy to compare two runs or groups of benchmarks.
    , Config -> DiffStrategy
diffStrategy  :: DiffStrategy

    -- | Omit the baseline group in normalized relative comparisons i.e.
    -- when the 'GroupStyle' is 'PercentDiff' or 'Multiples'.
    , Config -> Bool
omitBaseline :: Bool

    ---------------------------------------------------------------------------
    -- Fields (Columns)
    ---------------------------------------------------------------------------

    -- | Filter and reorder the benchmarking fields. It is invoked with a list
    -- of all available benchmarking fields. Only those fields present in the
    -- output of this function are plotted and in that order.
    , Config -> [String] -> [String]
selectFields :: [String] -> [String]

    -- | The values in the tuple are @(fieldName, RangeMin, RangeMax)@.
    -- Specify the min and max range of benchmarking fields. If the field
    -- value is outside the range it is clipped to the range limit.
    -- For time fields, the range values are in microseconds, and for space
    -- fields they are in bytes. The minimum of the range is used to determine
    -- the unit for the field.
    , Config -> [(String, Double, Double)]
fieldRanges :: [(String, Double, Double)]

    -- | The values in the tuple are @(fieldName, tick)@.  Specify the
    -- tick size of the fields to be used for the graphical reports.
    , Config -> [(String, FieldTick)]
fieldTicks :: [(String, FieldTick)]

    ---------------------------------------------------------------------------
    -- Groups (Row Grouping)
    ---------------------------------------------------------------------------

    -- | Filter, group and translate benchmark names. This function is invoked
    -- once for all benchmark names found in the results. It produces a tuple
    -- @(groupname, benchname)@, where @groupname@ is the name of the group the
    -- benchmark should be placed in, and @benchname@ is the translated
    -- benchmark name to be used in the report.  If it returns 'Nothing' for a
    -- benchmark, that benchmark is omitted from the results.
    , Config -> String -> Maybe (String, String)
classifyBenchmark :: String -> Maybe (String, String)

    -- | Filter and reorder the benchmark group names. A benchmark group may be
    -- assigned using 'classifyBenchmark'; when not assigned, all benchmarks
    -- are placed in the @default@ group. The input to this function is a list
    -- of tuples with benchmark group names and the @runId@s.  The output
    -- produced by this function is a filtered and reordered subset of the
    -- input.  Only those benchmark groups present in the output are rendered
    -- and are presented in that order.
    , Config -> [(String, Int)] -> [(String, Int)]
selectGroups :: [(String, Int)] -> [(String, Int)]

    ---------------------------------------------------------------------------
    -- Benchmarks (Rows)
    ---------------------------------------------------------------------------

    -- | Filter and reorder benchmarks. 'selectBenchmarks' takes a function
    -- argument, the function is invoked with a sorting column name or index
    -- and a 'GroupStyle'. The output of the function is either a 'Right' value
    -- consisting of tuples of the benchmark names and values corresponding to
    -- the given column and style or a 'Left' value indicating an error.
    -- 'selectBenchmarks' can inspect these benchmarks and their values to
    -- produce a filtered and sorted list of benchmark names that are to be
    -- rendered.
    --
    -- The style argument is ignored when the report presentation is not
    -- 'Groups'. When style is 'Nothing', the presentation setting specified in
    -- the configuration is used.
    --
    -- /Signature changed in 0.3.0/
    , Config
-> (SortColumn
    -> Maybe GroupStyle -> Either String [(String, Double)])
-> [String]
selectBenchmarks
        :: (SortColumn -> Maybe GroupStyle -> Either String [(String, Double)])
        -> [String]
    }

-- IMPORTANT: If you change the defaults, please change the defaults in the CLI
-- help as well.
--
-- | Default configuration. Use this as the base configuration and modify the
-- required fields. The defaults are:
--
-- @
--  verbose           = False
--  mkTitle           = Nothing
--  titleAnnotations  = [TitleField]
--  outputDir         = Nothing
--  presentation      = Groups Absolute
--  estimator         = Median
--  threshold         = 3
--  diffStrategy      = SingleEstimator
--  omitBaseline      = False
--  selectFields      = filter (flip elem ["time", "mean", "maxrss"] . map toLower)
--  fieldRanges       = []
--  fieldTicks        = []
--  classifyBenchmark = Just . ("default",)
--  selectGroups      = id
--  selectBenchmarks  = \f -> either error (map fst) $ f (ColumnIndex 0) Nothing
-- @
--
-- @since 0.2.0
defaultConfig :: Config
defaultConfig :: Config
defaultConfig = Config :: Bool
-> Maybe String
-> Maybe (String -> String)
-> Maybe String
-> [TitleAnnotation]
-> Presentation
-> Estimator
-> Word
-> DiffStrategy
-> Bool
-> ([String] -> [String])
-> [(String, Double, Double)]
-> [(String, FieldTick)]
-> (String -> Maybe (String, String))
-> ([(String, Int)] -> [(String, Int)])
-> ((SortColumn
     -> Maybe GroupStyle -> Either String [(String, Double)])
    -> [String])
-> Config
Config
    { verbose :: Bool
verbose           = Bool
False
    , mkTitle :: Maybe (String -> String)
mkTitle           = Maybe (String -> String)
forall a. Maybe a
Nothing
    , title :: Maybe String
title             = Maybe String
forall a. Maybe a
Nothing
    , titleAnnotations :: [TitleAnnotation]
titleAnnotations  = [TitleAnnotation
TitleField]
    , outputDir :: Maybe String
outputDir         = Maybe String
forall a. Maybe a
Nothing
    , presentation :: Presentation
presentation      = GroupStyle -> Presentation
Groups GroupStyle
Absolute
    , estimator :: Estimator
estimator         = Estimator
Median
    , threshold :: Word
threshold         = Word
3
    , diffStrategy :: DiffStrategy
diffStrategy      = DiffStrategy
SingleEstimator
    , omitBaseline :: Bool
omitBaseline      = Bool
False
    , selectFields :: [String] -> [String]
selectFields      = (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter ((String -> [String] -> Bool) -> [String] -> String -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem [String
"time", String
"mean", String
"maxrss"] (String -> Bool) -> (String -> String) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower)
    , fieldRanges :: [(String, Double, Double)]
fieldRanges       = []
    , fieldTicks :: [(String, FieldTick)]
fieldTicks        = []
    , classifyBenchmark :: String -> Maybe (String, String)
classifyBenchmark = (String, String) -> Maybe (String, String)
forall a. a -> Maybe a
Just ((String, String) -> Maybe (String, String))
-> (String -> (String, String)) -> String -> Maybe (String, String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"default",)
    , selectGroups :: [(String, Int)] -> [(String, Int)]
selectGroups      = [(String, Int)] -> [(String, Int)]
forall a. a -> a
id
    , selectBenchmarks :: (SortColumn
 -> Maybe GroupStyle -> Either String [(String, Double)])
-> [String]
selectBenchmarks  = \SortColumn -> Maybe GroupStyle -> Either String [(String, Double)]
f -> (String -> [String])
-> ([(String, Double)] -> [String])
-> Either String [(String, Double)]
-> [String]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> [String]
forall a. HasCallStack => String -> a
error (((String, Double) -> String) -> [(String, Double)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, Double) -> String
forall a b. (a, b) -> a
fst) (Either String [(String, Double)] -> [String])
-> Either String [(String, Double)] -> [String]
forall a b. (a -> b) -> a -> b
$ SortColumn -> Maybe GroupStyle -> Either String [(String, Double)]
f (Int -> SortColumn
ColumnIndex Int
0) Maybe GroupStyle
forall a. Maybe a
Nothing
    }

-------------------------------------------------------------------------------
-- Benchmarking field types
-------------------------------------------------------------------------------

timeFields :: [String]
timeFields :: [String]
timeFields = (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ((Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower)
    [ String
"time"
    , String
"mean"
    , String
"cpuTime"
    , String
"utime"
    , String
"stime"
    , String
"mutatorWallSeconds"
    , String
"mutatorCpuSeconds"
    , String
"gcWallSeconds"
    , String
"gcCpuSeconds"
    ]

isTimeField :: String -> Bool
isTimeField :: String -> Bool
isTimeField String
fieldName = (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
fieldName String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
timeFields

allocFields :: [String]
allocFields :: [String]
allocFields = (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ((Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower) [String
"allocated", String
"bytesCopied", String
"maxrss"]

isAllocationField :: String -> Bool
isAllocationField :: String -> Bool
isAllocationField String
fieldName = (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
fieldName String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
allocFields

predictorFields :: [String]
predictorFields :: [String]
predictorFields = (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ((Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower)
    [ String
"iters"
    -- , "minflt"
    -- , "majflt"
    -- , "nvcsw"
    -- , "nivcsw"
    ]

isPredictorField :: String -> Bool
isPredictorField :: String -> Bool
isPredictorField String
fieldName = (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
fieldName String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
predictorFields

-------------------------------------------------------------------------------
-- Units
-------------------------------------------------------------------------------

-- | Describe a relative unit i.e. a unit in terms of another unit. A relative
-- unit has a label and a ratio which when multiplied with the unit gives us
-- the other unit. For example, if the known time unit is seconds, we can
-- describe a millisecond as @Unit "ms" (1/1000)@.
data RelativeUnit = RelativeUnit String Double deriving Int -> RelativeUnit -> String -> String
[RelativeUnit] -> String -> String
RelativeUnit -> String
(Int -> RelativeUnit -> String -> String)
-> (RelativeUnit -> String)
-> ([RelativeUnit] -> String -> String)
-> Show RelativeUnit
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [RelativeUnit] -> String -> String
$cshowList :: [RelativeUnit] -> String -> String
show :: RelativeUnit -> String
$cshow :: RelativeUnit -> String
showsPrec :: Int -> RelativeUnit -> String -> String
$cshowsPrec :: Int -> RelativeUnit -> String -> String
Show

getTimeUnit :: Double -> RelativeUnit
getTimeUnit :: Double -> RelativeUnit
getTimeUnit Double
k
    | Double
k Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
0      = Double -> RelativeUnit
getTimeUnit (-Double
k)
    | Double
k Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
1     = String -> Double -> RelativeUnit
RelativeUnit String
"s" Double
1
    | Double
k Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
1e-3  = String -> Double -> RelativeUnit
RelativeUnit String
"ms" Double
1e-3
    | Double
k Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
1e-6  = String -> Double -> RelativeUnit
RelativeUnit String
"μs" Double
1e-6
    | Bool
otherwise  = String -> Double -> RelativeUnit
RelativeUnit String
"ns" Double
1e-9

getSpaceUnit :: Double -> RelativeUnit
getSpaceUnit :: Double -> RelativeUnit
getSpaceUnit Double
k
    | Double
k Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
0             = Double -> RelativeUnit
getSpaceUnit (-Double
k)
    | Double
k Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
2Double -> Int -> Double
forall a b. (Num a, Integral b) => a -> b -> a
^(Int
30 ::Int) = String -> Double -> RelativeUnit
RelativeUnit String
"GiB" (Double
2Double -> Int -> Double
forall a b. (Num a, Integral b) => a -> b -> a
^(Int
30 :: Int))
    | Double
k Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
2Double -> Int -> Double
forall a b. (Num a, Integral b) => a -> b -> a
^(Int
20 ::Int) = String -> Double -> RelativeUnit
RelativeUnit String
"MiB" (Double
2Double -> Int -> Double
forall a b. (Num a, Integral b) => a -> b -> a
^(Int
20 :: Int))
    | Double
k Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
2Double -> Int -> Double
forall a b. (Num a, Integral b) => a -> b -> a
^(Int
10 ::Int) = String -> Double -> RelativeUnit
RelativeUnit String
"KiB" (Double
2Double -> Int -> Double
forall a b. (Num a, Integral b) => a -> b -> a
^(Int
10 :: Int))
    | Bool
otherwise         = String -> Double -> RelativeUnit
RelativeUnit String
"Bytes" Double
1

getUnitByFieldName :: String -> Double -> RelativeUnit
getUnitByFieldName :: String -> Double -> RelativeUnit
getUnitByFieldName String
fieldName Double
fieldMin =
    case String -> Bool
isTimeField String
fieldName of
        Bool
True -> Double -> RelativeUnit
getTimeUnit Double
fieldMin
        Bool
False -> case String -> Bool
isAllocationField String
fieldName of
            Bool
True -> Double -> RelativeUnit
getSpaceUnit Double
fieldMin
            Bool
False -> String -> Double -> RelativeUnit
RelativeUnit String
"" Double
1

-- returns (multiplier, units)
fieldUnits :: String -> Double -> GroupStyle -> RelativeUnit
fieldUnits :: String -> Double -> GroupStyle -> RelativeUnit
fieldUnits String
fieldName Double
fieldMin GroupStyle
style =
    case GroupStyle
style of
        GroupStyle
Multiples   -> String -> Double -> RelativeUnit
RelativeUnit String
"x" Double
1
        GroupStyle
PercentDiff -> String -> Double -> RelativeUnit
RelativeUnit String
"%" Double
1
        GroupStyle
_ -> String -> Double -> RelativeUnit
getUnitByFieldName String
fieldName Double
fieldMin

-------------------------------------------------------------------------------
-- Comparison
-------------------------------------------------------------------------------

absoluteDiff :: Num a => a -> a -> a
absoluteDiff :: a -> a -> a
absoluteDiff a
v1 a
v2 = a
v2 a -> a -> a
forall a. Num a => a -> a -> a
- a
v1

percentDiff :: (Fractional a, Num a, Ord a) => a -> a -> a
percentDiff :: a -> a -> a
percentDiff a
v1 a
v2 = ((a
v2 a -> a -> a
forall a. Num a => a -> a -> a
- a
v1) a -> a -> a
forall a. Num a => a -> a -> a
* a
100) a -> a -> a
forall a. Fractional a => a -> a -> a
/ a -> a -> a
forall a. Ord a => a -> a -> a
min a
v1 a
v2

-- We map a fraction x between 0 and 1 to a negative 1/x for plotting on an
-- equal and opposite scale.
fraction :: (Fractional a, Num a, Ord a, Show a) => a -> a -> a
fraction :: a -> a -> a
fraction a
v1 a
v2 =
    let val :: a
val = a
v2 a -> a -> a
forall a. Fractional a => a -> a -> a
/ a
v1
    in case a
val of
            a
x | a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
0 -> String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ String
"BenchShow.Internal.Common.fraction: negative: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
x
            a
x | a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
1 -> a -> a
forall a. Num a => a -> a
negate (a
1 a -> a -> a
forall a. Fractional a => a -> a -> a
/ a
x)
            a
x | a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
1 -> a
x
            a
x -> String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ String
"BenchShow.Internal.Common.fraction: unhandled: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
x

cmpTransformColumns :: ReportType
                    -> GroupStyle
                    -> Estimator
                    -> DiffStrategy
                    -- XXX we do not really need the benchmark name here
                    -> [[(String, AnalyzedField)]]
                    -> (Maybe [[Estimator]], [[(String, Double)]])
cmpTransformColumns :: ReportType
-> GroupStyle
-> Estimator
-> DiffStrategy
-> [[(String, AnalyzedField)]]
-> (Maybe [[Estimator]], [[(String, Double)]])
cmpTransformColumns ReportType
rtype GroupStyle
style Estimator
estimator DiffStrategy
diffStrategy [[(String, AnalyzedField)]]
cols =
    let cmpWith :: (Double -> Double -> b) -> [[(String, b)]]
cmpWith Double -> Double -> b
diff =
            let firstCol :: [(String, Double)]
firstCol = [[(String, Double)]] -> [(String, Double)]
forall a. [a] -> a
head [[(String, Double)]]
columns
                colTransform :: [(String, Double)] -> [(String, b)]
colTransform [(String, Double)]
col =
                    let mkDiff :: (a, Double) -> (a, Double) -> (a, b)
mkDiff (a
n1, Double
v1) (a
n2,Double
v2) =
                            Bool -> (a, b) -> (a, b)
forall p. Bool -> p -> p
verify (a
n1 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
n2) (a
n2, Double -> Double -> b
diff Double
v1 Double
v2)
                    in ((String, Double) -> (String, Double) -> (String, b))
-> [(String, Double)] -> [(String, Double)] -> [(String, b)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (String, Double) -> (String, Double) -> (String, b)
forall a. Eq a => (a, Double) -> (a, Double) -> (a, b)
mkDiff [(String, Double)]
firstCol [(String, Double)]
col
            in ([(String, Double)] -> [(String, b)])
-> [[(String, Double)]] -> [[(String, b)]]
forall a b. (a -> b) -> [a] -> [b]
map [(String, Double)] -> [(String, b)]
colTransform ([[(String, Double)]] -> [[(String, Double)]]
forall a. [a] -> [a]
tail [[(String, Double)]]
columns)

        cmpMinWith :: (Double -> Double -> a) -> [[(Estimator, (String, a))]]
cmpMinWith Double -> Double -> a
diff =
            let firstCol :: [(String, AnalyzedField)]
firstCol = [[(String, AnalyzedField)]] -> [(String, AnalyzedField)]
forall a. [a] -> a
head [[(String, AnalyzedField)]]
cols
                colTransform :: [(String, AnalyzedField)] -> [(Estimator, (String, a))]
colTransform [(String, AnalyzedField)]
col = ((String, AnalyzedField)
 -> (String, AnalyzedField) -> (Estimator, (String, a)))
-> [(String, AnalyzedField)]
-> [(String, AnalyzedField)]
-> [(Estimator, (String, a))]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith ((Double -> Double -> a)
-> (String, AnalyzedField)
-> (String, AnalyzedField)
-> (Estimator, (String, a))
forall a a.
(Ord a, Num a, Eq a) =>
(Double -> Double -> a)
-> (a, AnalyzedField) -> (a, AnalyzedField) -> (Estimator, (a, a))
mkMinDiff Double -> Double -> a
diff) [(String, AnalyzedField)]
firstCol [(String, AnalyzedField)]
col
            in ([(String, AnalyzedField)] -> [(Estimator, (String, a))])
-> [[(String, AnalyzedField)]] -> [[(Estimator, (String, a))]]
forall a b. (a -> b) -> [a] -> [b]
map [(String, AnalyzedField)] -> [(Estimator, (String, a))]
colTransform ([[(String, AnalyzedField)]] -> [[(String, AnalyzedField)]]
forall a. [a] -> [a]
tail [[(String, AnalyzedField)]]
cols)

        diffWith :: (Double -> Double -> Double)
-> (Maybe [[Estimator]], [[(String, Double)]])
diffWith Double -> Double -> Double
f =
                case DiffStrategy
diffStrategy of
                    DiffStrategy
MinEstimator ->
                        let ([[Estimator]]
ests, [[(String, Double)]]
vals) = [([Estimator], [(String, Double)])]
-> ([[Estimator]], [[(String, Double)]])
forall a b. [(a, b)] -> ([a], [b])
unzip ([([Estimator], [(String, Double)])]
 -> ([[Estimator]], [[(String, Double)]]))
-> [([Estimator], [(String, Double)])]
-> ([[Estimator]], [[(String, Double)]])
forall a b. (a -> b) -> a -> b
$ ([(Estimator, (String, Double))]
 -> ([Estimator], [(String, Double)]))
-> [[(Estimator, (String, Double))]]
-> [([Estimator], [(String, Double)])]
forall a b. (a -> b) -> [a] -> [b]
map [(Estimator, (String, Double))]
-> ([Estimator], [(String, Double)])
forall a b. [(a, b)] -> ([a], [b])
unzip ((Double -> Double -> Double) -> [[(Estimator, (String, Double))]]
forall a.
(Ord a, Num a) =>
(Double -> Double -> a) -> [[(Estimator, (String, a))]]
cmpMinWith Double -> Double -> Double
f)
                        in ( [[Estimator]] -> Maybe [[Estimator]]
forall a. a -> Maybe a
Just ([[Estimator]] -> Maybe [[Estimator]])
-> [[Estimator]] -> Maybe [[Estimator]]
forall a b. (a -> b) -> a -> b
$ ((String, AnalyzedField) -> Estimator)
-> [(String, AnalyzedField)] -> [Estimator]
forall a b. (a -> b) -> [a] -> [b]
map (Estimator -> (String, AnalyzedField) -> Estimator
forall a b. a -> b -> a
const Estimator
estimator) ([[(String, AnalyzedField)]] -> [(String, AnalyzedField)]
forall a. [a] -> a
head [[(String, AnalyzedField)]]
cols) [Estimator] -> [[Estimator]] -> [[Estimator]]
forall a. a -> [a] -> [a]
: [[Estimator]]
ests
                           , [[(String, Double)]] -> [(String, Double)]
forall a. [a] -> a
head [[(String, Double)]]
columns [(String, Double)] -> [[(String, Double)]] -> [[(String, Double)]]
forall a. a -> [a] -> [a]
: [[(String, Double)]]
vals
                           )
                    DiffStrategy
SingleEstimator ->
                        (Maybe [[Estimator]]
forall a. Maybe a
Nothing, [[(String, Double)]] -> [(String, Double)]
forall a. [a] -> a
head [[(String, Double)]]
columns [(String, Double)] -> [[(String, Double)]] -> [[(String, Double)]]
forall a. a -> [a] -> [a]
: (Double -> Double -> Double) -> [[(String, Double)]]
forall b. (Double -> Double -> b) -> [[(String, b)]]
cmpWith Double -> Double -> Double
f)

        relativeDiffWith :: Double
-> (Double -> Double -> Double)
-> (Maybe [[Estimator]], [[(String, Double)]])
relativeDiffWith Double
baseVal Double -> Double -> Double
f =
            -- In a comparative graphical chart we cannot show the absolute
            -- values in the baseline column as the units won't match for
            -- the baseline and the diff clusters.
            let baseCol :: [(String, Double)]
baseCol =
                    case ReportType
rtype of
                        ReportType
TextReport -> [[(String, Double)]] -> [(String, Double)]
forall a. [a] -> a
head [[(String, Double)]]
columns
                        ReportType
GraphicalChart | [[(String, Double)]] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[(String, Double)]]
columns Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 ->
                            [[(String, Double)]] -> [(String, Double)]
forall a. [a] -> a
head [[(String, Double)]]
columns
                        ReportType
GraphicalChart ->
                            ((String, Double) -> (String, Double))
-> [(String, Double)] -> [(String, Double)]
forall a b. (a -> b) -> [a] -> [b]
map (\(String
n,Double
_) -> (String
n,Double
baseVal)) ([[(String, Double)]] -> [(String, Double)]
forall a. [a] -> a
head [[(String, Double)]]
columns)
            in case DiffStrategy
diffStrategy of
                DiffStrategy
MinEstimator ->
                    let ([[Estimator]]
ests, [[(String, Double)]]
vals) = [([Estimator], [(String, Double)])]
-> ([[Estimator]], [[(String, Double)]])
forall a b. [(a, b)] -> ([a], [b])
unzip ([([Estimator], [(String, Double)])]
 -> ([[Estimator]], [[(String, Double)]]))
-> [([Estimator], [(String, Double)])]
-> ([[Estimator]], [[(String, Double)]])
forall a b. (a -> b) -> a -> b
$ ([(Estimator, (String, Double))]
 -> ([Estimator], [(String, Double)]))
-> [[(Estimator, (String, Double))]]
-> [([Estimator], [(String, Double)])]
forall a b. (a -> b) -> [a] -> [b]
map [(Estimator, (String, Double))]
-> ([Estimator], [(String, Double)])
forall a b. [(a, b)] -> ([a], [b])
unzip ((Double -> Double -> Double) -> [[(Estimator, (String, Double))]]
forall a.
(Ord a, Num a) =>
(Double -> Double -> a) -> [[(Estimator, (String, a))]]
cmpMinWith Double -> Double -> Double
f)
                    in ( [[Estimator]] -> Maybe [[Estimator]]
forall a. a -> Maybe a
Just ([[Estimator]] -> Maybe [[Estimator]])
-> [[Estimator]] -> Maybe [[Estimator]]
forall a b. (a -> b) -> a -> b
$ ((String, AnalyzedField) -> Estimator)
-> [(String, AnalyzedField)] -> [Estimator]
forall a b. (a -> b) -> [a] -> [b]
map (Estimator -> (String, AnalyzedField) -> Estimator
forall a b. a -> b -> a
const Estimator
estimator) ([[(String, AnalyzedField)]] -> [(String, AnalyzedField)]
forall a. [a] -> a
head [[(String, AnalyzedField)]]
cols) [Estimator] -> [[Estimator]] -> [[Estimator]]
forall a. a -> [a] -> [a]
: [[Estimator]]
ests
                       , [(String, Double)]
baseCol [(String, Double)] -> [[(String, Double)]] -> [[(String, Double)]]
forall a. a -> [a] -> [a]
: [[(String, Double)]]
vals
                       )
                DiffStrategy
SingleEstimator ->
                   (Maybe [[Estimator]]
forall a. Maybe a
Nothing, [(String, Double)]
baseCol [(String, Double)] -> [[(String, Double)]] -> [[(String, Double)]]
forall a. a -> [a] -> [a]
: (Double -> Double -> Double) -> [[(String, Double)]]
forall b. (Double -> Double -> b) -> [[(String, b)]]
cmpWith Double -> Double -> Double
f)
    in case GroupStyle
style of
            GroupStyle
Absolute    -> (Double -> Double -> Double)
-> (Maybe [[Estimator]], [[(String, Double)]])
diffWith (\Double
_ Double
x -> Double
x)
            GroupStyle
Diff        -> (Double -> Double -> Double)
-> (Maybe [[Estimator]], [[(String, Double)]])
diffWith Double -> Double -> Double
forall a. Num a => a -> a -> a
absoluteDiff
            GroupStyle
PercentDiff -> Double
-> (Double -> Double -> Double)
-> (Maybe [[Estimator]], [[(String, Double)]])
relativeDiffWith Double
100 Double -> Double -> Double
forall a. (Fractional a, Num a, Ord a) => a -> a -> a
percentDiff
            GroupStyle
Multiples   -> Double
-> (Double -> Double -> Double)
-> (Maybe [[Estimator]], [[(String, Double)]])
relativeDiffWith Double
1 Double -> Double -> Double
forall a. (Fractional a, Num a, Ord a, Show a) => a -> a -> a
fraction
    where
        verify :: Bool -> p -> p
verify Bool
a p
b = if Bool
a then p
b else String -> p
forall a. HasCallStack => String -> a
error String
"bug: benchmark names mismatch"
        transformVals :: [[(d, AnalyzedField)]] -> [[(d, Double)]]
transformVals = ([(d, AnalyzedField)] -> [(d, Double)])
-> [[(d, AnalyzedField)]] -> [[(d, Double)]]
forall a b. (a -> b) -> [a] -> [b]
map (((d, AnalyzedField) -> (d, Double))
-> [(d, AnalyzedField)] -> [(d, Double)]
forall a b. (a -> b) -> [a] -> [b]
map ((AnalyzedField -> Double) -> (d, AnalyzedField) -> (d, Double)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second (Estimator -> AnalyzedField -> Double
getAnalyzedValue Estimator
estimator)))
        columns :: [[(String, Double)]]
columns = [[(String, AnalyzedField)]] -> [[(String, Double)]]
forall d. [[(d, AnalyzedField)]] -> [[(d, Double)]]
transformVals [[(String, AnalyzedField)]]
cols

        -- Find which estimator gives us the minimum diff
        mkMinDiff :: (Double -> Double -> a)
-> (a, AnalyzedField) -> (a, AnalyzedField) -> (Estimator, (a, a))
mkMinDiff Double -> Double -> a
diff (a
n1, AnalyzedField
v1) (a
n2,AnalyzedField
v2) = Bool -> (Estimator, (a, a)) -> (Estimator, (a, a))
forall p. Bool -> p -> p
verify (a
n1 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
n2) ((Estimator, (a, a)) -> (Estimator, (a, a)))
-> (Estimator, (a, a)) -> (Estimator, (a, a))
forall a b. (a -> b) -> a -> b
$
            let meanDiff :: a
meanDiff = Double -> Double -> a
diff (Estimator -> AnalyzedField -> Double
getAnalyzedValue Estimator
Mean AnalyzedField
v1)
                                (Estimator -> AnalyzedField -> Double
getAnalyzedValue Estimator
Mean AnalyzedField
v2)
                medDiff :: a
medDiff = Double -> Double -> a
diff (Estimator -> AnalyzedField -> Double
getAnalyzedValue Estimator
Median AnalyzedField
v1)
                               (Estimator -> AnalyzedField -> Double
getAnalyzedValue Estimator
Median AnalyzedField
v2)
                regDiff :: a
regDiff = Double -> Double -> a
diff (Estimator -> AnalyzedField -> Double
getAnalyzedValue Estimator
Regression AnalyzedField
v1)
                               (Estimator -> AnalyzedField -> Double
getAnalyzedValue Estimator
Regression AnalyzedField
v2)
            in if a -> a
forall a. Num a => a -> a
abs a
medDiff a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a -> a
forall a. Num a => a -> a
abs a
meanDiff
               then if a -> a
forall a. Num a => a -> a
abs a
medDiff a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a -> a
forall a. Num a => a -> a
abs a
regDiff
                    then (Estimator
Median, (a
n2, a
medDiff))
                    else (Estimator
Regression, (a
n2, a
regDiff))
                else if a -> a
forall a. Num a => a -> a
abs a
meanDiff a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a -> a
forall a. Num a => a -> a
abs a
regDiff
                     then (Estimator
Mean, (a
n2, a
meanDiff))
                     else (Estimator
Regression, (a
n2, a
regDiff))

columnNameByStyle :: GroupStyle -> [ReportColumn] -> [ReportColumn]
columnNameByStyle :: GroupStyle -> [ReportColumn] -> [ReportColumn]
columnNameByStyle GroupStyle
_ [] = []
columnNameByStyle GroupStyle
style columns :: [ReportColumn]
columns@(ReportColumn
h:[ReportColumn]
t) =
    let withDiff :: (String -> String) -> [ReportColumn]
withDiff String -> String
name = (String -> String) -> ReportColumn -> ReportColumn
colSuffix String -> String
forall a. a -> a
baseName ReportColumn
h ReportColumn -> [ReportColumn] -> [ReportColumn]
forall a. a -> [a] -> [a]
: (ReportColumn -> ReportColumn) -> [ReportColumn] -> [ReportColumn]
forall a b. (a -> b) -> [a] -> [b]
map ((String -> String) -> ReportColumn -> ReportColumn
colSuffix String -> String
name) [ReportColumn]
t
    in case GroupStyle
style of
            GroupStyle
Diff        | [ReportColumn] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ReportColumn]
columns Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1 -> (String -> String) -> [ReportColumn]
withDiff String -> String
diffName
            GroupStyle
Multiples   | [ReportColumn] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ReportColumn]
columns Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1 -> (String -> String) -> [ReportColumn]
withDiff String -> String
fracName
            GroupStyle
PercentDiff | [ReportColumn] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ReportColumn]
columns Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1 -> (String -> String) -> [ReportColumn]
withDiff String -> String
diffName
            GroupStyle
_ -> [ReportColumn]
columns

    where
    colSuffix :: (String -> String) -> ReportColumn -> ReportColumn
colSuffix String -> String
xl ReportColumn
col = ReportColumn
col { colName :: String
colName = String -> String
xl (ReportColumn -> String
colName ReportColumn
col) }
    baseName :: a -> a
baseName        = a -> a
forall a. a -> a
id -- (++ "(base)")
    diffName :: String -> String
diffName        = (String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" - " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ReportColumn -> String
colName ReportColumn
h) -- "(-base)")
    fracName :: String -> String
fracName        = (String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"/" String -> String -> String
forall a. [a] -> [a] -> [a]
++ ReportColumn -> String
colName ReportColumn
h) -- "/base")

columnNameByUnit :: [RelativeUnit] -> [ReportColumn] -> [ReportColumn]
columnNameByUnit :: [RelativeUnit] -> [ReportColumn] -> [ReportColumn]
columnNameByUnit [RelativeUnit]
units [ReportColumn]
columns =
    let applyUnit :: ReportColumn -> RelativeUnit -> ReportColumn
applyUnit ReportColumn
col (RelativeUnit String
label Double
_) =
            ReportColumn
col { colName :: String
colName = ReportColumn -> String
colName ReportColumn
col String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
inParens String
label }
    in (ReportColumn -> RelativeUnit -> ReportColumn)
-> [ReportColumn] -> [RelativeUnit] -> [ReportColumn]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith ReportColumn -> RelativeUnit -> ReportColumn
applyUnit [ReportColumn]
columns [RelativeUnit]
units

-- Represents the data for a single benchmark run
data GroupMatrix = GroupMatrix
    { GroupMatrix -> Int
groupIndex :: Int
    , GroupMatrix -> String
groupName   :: String
    , GroupMatrix -> [(String, String)]
groupBenches :: [(String, String)] -- (newname, origname)
    , GroupMatrix -> BenchmarkMatrix
groupMatrix :: BenchmarkMatrix
    } deriving Int -> GroupMatrix -> String -> String
[GroupMatrix] -> String -> String
GroupMatrix -> String
(Int -> GroupMatrix -> String -> String)
-> (GroupMatrix -> String)
-> ([GroupMatrix] -> String -> String)
-> Show GroupMatrix
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [GroupMatrix] -> String -> String
$cshowList :: [GroupMatrix] -> String -> String
show :: GroupMatrix -> String
$cshow :: GroupMatrix -> String
showsPrec :: Int -> GroupMatrix -> String -> String
$cshowsPrec :: Int -> GroupMatrix -> String -> String
Show

-- Each run may be split into multiple groups of benchmarks.  Benchmarks can be
-- renamed by the classifier. Sanity checks:
-- Two original benchmarks cannot map to the same target benchmark
--
-- When using a comparative style report, after filtering and sorting:
-- Same original benchmark cannot belong to multiple groups
-- All groups must have exactly the same benchmark names
splitGroup :: (String -> Maybe (String, String))
           -> (Int, BenchmarkMatrix)
           -> [GroupMatrix]
splitGroup :: (String -> Maybe (String, String))
-> (Int, BenchmarkMatrix) -> [GroupMatrix]
splitGroup String -> Maybe (String, String)
classify (Int
serial, matrix :: BenchmarkMatrix
matrix@BenchmarkMatrix{[String]
[(String, [AnalyzedField])]
rowValues :: BenchmarkMatrix -> [(String, [AnalyzedField])]
colNames :: BenchmarkMatrix -> [String]
rowValues :: [(String, [AnalyzedField])]
colNames :: [String]
..}) =
    let classified :: [((String, String), String)]
classified = (String -> Maybe ((String, String), String))
-> [String] -> [((String, String), String)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\String
x -> ((String, String) -> ((String, String), String))
-> Maybe (String, String) -> Maybe ((String, String), String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (,String
x) (Maybe (String, String) -> Maybe ((String, String), String))
-> Maybe (String, String) -> Maybe ((String, String), String)
forall a b. (a -> b) -> a -> b
$ String -> Maybe (String, String)
classify String
x) (((String, [AnalyzedField]) -> String)
-> [(String, [AnalyzedField])] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, [AnalyzedField]) -> String
forall a b. (a, b) -> a
fst [(String, [AnalyzedField])]
rowValues)
    in if [((String, String), String)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [((String, String), String)]
classified
       then String -> [GroupMatrix]
forall a. HasCallStack => String -> a
error String
"No benchmarks were selected by \"classifyBenchmark\""
       else
          (((String, String), String)
 -> ((String, String), String) -> Ordering)
-> [((String, String), String)] -> [((String, String), String)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy ((((String, String), String) -> String)
-> ((String, String), String)
-> ((String, String), String)
-> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing ((String, String) -> String
forall a b. (a, b) -> a
fst ((String, String) -> String)
-> (((String, String), String) -> (String, String))
-> ((String, String), String)
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String, String), String) -> (String, String)
forall a b. (a, b) -> a
fst)) [((String, String), String)]
classified
        [((String, String), String)]
-> ([((String, String), String)] -> [[((String, String), String)]])
-> [[((String, String), String)]]
forall a b. a -> (a -> b) -> b
& (((String, String), String) -> ((String, String), String) -> Bool)
-> [((String, String), String)] -> [[((String, String), String)]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
(==) (String -> String -> Bool)
-> (((String, String), String) -> String)
-> ((String, String), String)
-> ((String, String), String)
-> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` ((String, String) -> String
forall a b. (a, b) -> a
fst ((String, String) -> String)
-> (((String, String), String) -> (String, String))
-> ((String, String), String)
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String, String), String) -> (String, String)
forall a b. (a, b) -> a
fst))
        [[((String, String), String)]]
-> ([[((String, String), String)]]
    -> [(String, [(String, String)])])
-> [(String, [(String, String)])]
forall a b. a -> (a -> b) -> b
& ([((String, String), String)] -> (String, [(String, String)]))
-> [[((String, String), String)]] -> [(String, [(String, String)])]
forall a b. (a -> b) -> [a] -> [b]
map ((((String, String), String)
 -> (String, [(String, String)]) -> (String, [(String, String)]))
-> (String, [(String, String)])
-> [((String, String), String)]
-> (String, [(String, String)])
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((String, String), String)
-> (String, [(String, String)]) -> (String, [(String, String)])
forall a a b a. ((a, a), b) -> (a, [(a, b)]) -> (a, [(a, b)])
foldGroup (String
"",[]))
        [(String, [(String, String)])]
-> ([(String, [(String, String)])]
    -> [(String, [(String, String)])])
-> [(String, [(String, String)])]
forall a b. a -> (a -> b) -> b
& ((String, [(String, String)]) -> (String, [(String, String)]))
-> [(String, [(String, String)])] -> [(String, [(String, String)])]
forall a b. (a -> b) -> [a] -> [b]
map (String, [(String, String)]) -> (String, [(String, String)])
forall a a b.
(Show a, Ord a, Show a, Show b) =>
(a, [(a, b)]) -> (a, [(a, b)])
sanityCheckGroup
        [(String, [(String, String)])]
-> ([(String, [(String, String)])] -> [GroupMatrix])
-> [GroupMatrix]
forall a b. a -> (a -> b) -> b
& ((String, [(String, String)]) -> GroupMatrix)
-> [(String, [(String, String)])] -> [GroupMatrix]
forall a b. (a -> b) -> [a] -> [b]
map (\(String
name, [(String, String)]
benches) ->
            GroupMatrix :: Int
-> String -> [(String, String)] -> BenchmarkMatrix -> GroupMatrix
GroupMatrix
            { groupIndex :: Int
groupIndex  = Int
serial
            , groupName :: String
groupName    = String
name
            , groupBenches :: [(String, String)]
groupBenches = [(String, String)]
benches
            , groupMatrix :: BenchmarkMatrix
groupMatrix  = BenchmarkMatrix
matrix
            })

    where

    foldGroup :: ((a, a), b) -> (a, [(a, b)]) -> (a, [(a, b)])
foldGroup ((a
grp, a
bench), b
srcBench) (a
_, [(a, b)]
tuples) =
        (a
grp, (a
bench, b
srcBench) (a, b) -> [(a, b)] -> [(a, b)]
forall a. a -> [a] -> [a]
: [(a, b)]
tuples)

    sanityCheckGroup :: (a, [(a, b)]) -> (a, [(a, b)])
sanityCheckGroup orig :: (a, [(a, b)])
orig@(a
grp, [(a, b)]
tuples) =
        let duplicated :: [[(a, b)]]
duplicated =
                  ((a, b) -> (a, b) -> Ordering) -> [(a, b)] -> [(a, b)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (((a, b) -> a) -> (a, b) -> (a, b) -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (a, b) -> a
forall a b. (a, b) -> a
fst) [(a, b)]
tuples
                [(a, b)] -> ([(a, b)] -> [[(a, b)]]) -> [[(a, b)]]
forall a b. a -> (a -> b) -> b
& ((a, b) -> (a, b) -> Bool) -> [(a, b)] -> [[(a, b)]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy (a -> a -> Bool
forall a. Eq a => a -> a -> Bool
(==) (a -> a -> Bool) -> ((a, b) -> a) -> (a, b) -> (a, b) -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (a, b) -> a
forall a b. (a, b) -> a
fst)
                [[(a, b)]] -> ([[(a, b)]] -> [[(a, b)]]) -> [[(a, b)]]
forall a b. a -> (a -> b) -> b
& ([(a, b)] -> Bool) -> [[(a, b)]] -> [[(a, b)]]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>Int
1) (Int -> Bool) -> ([(a, b)] -> Int) -> [(a, b)] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(a, b)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length)
        in if Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [[(a, b)]] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[(a, b)]]
duplicated
           then
            let msg :: String
msg = [String] -> String
unlines (([(a, b)] -> String) -> [[(a, b)]] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map [(a, b)] -> String
forall a. Show a => a -> String
show [[(a, b)]]
duplicated)
            in String -> (a, [(a, b)])
forall a. HasCallStack => String -> a
error (String -> (a, [(a, b)])) -> String -> (a, [(a, b)])
forall a b. (a -> b) -> a -> b
$ String
"Two benchmarks must not map to the same target \
               \benchmark. Please check your 'classifyBenchmark' operation. \
               \In group " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
grp String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", the following target benchmarks \
               \are mapped to more than one source benchmarks:\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
msg
            else (a, [(a, b)])
orig

-------------------------------------------------------------------------------
-- sort the benchmark groups
-------------------------------------------------------------------------------

findGroup :: [GroupMatrix] -> (String, Int) -> Maybe GroupMatrix
findGroup :: [GroupMatrix] -> (String, Int) -> Maybe GroupMatrix
findGroup [GroupMatrix]
matrices (String
name, Int
i) =
    (GroupMatrix -> Bool) -> [GroupMatrix] -> Maybe GroupMatrix
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\GroupMatrix
x -> GroupMatrix -> String
groupName GroupMatrix
x String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
name Bool -> Bool -> Bool
&& GroupMatrix -> Int
groupIndex GroupMatrix
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
i) [GroupMatrix]
matrices

sortGroups :: Config -> [GroupMatrix] -> IO [GroupMatrix]
sortGroups :: Config -> [GroupMatrix] -> IO [GroupMatrix]
sortGroups 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
..} [GroupMatrix]
matrices = do
    let origGroups :: [(String, Int)]
origGroups = (GroupMatrix -> (String, Int)) -> [GroupMatrix] -> [(String, Int)]
forall a b. (a -> b) -> [a] -> [b]
map (\GroupMatrix
x -> (GroupMatrix -> String
groupName GroupMatrix
x, GroupMatrix -> Int
groupIndex GroupMatrix
x)) [GroupMatrix]
matrices
        newGroups :: [(String, Int)]
newGroups = [(String, Int)] -> [(String, Int)]
selectGroups [(String, Int)]
origGroups

    String -> [(String, Int)] -> [(String, Int)] -> IO ()
forall a. (Eq a, Show a) => String -> [a] -> [a] -> IO ()
filterSanity String
"selectGroups" [(String, Int)]
origGroups [(String, Int)]
newGroups
    [GroupMatrix] -> IO [GroupMatrix]
forall (m :: * -> *) a. Monad m => a -> m a
return ([GroupMatrix] -> IO [GroupMatrix])
-> [GroupMatrix] -> IO [GroupMatrix]
forall a b. (a -> b) -> a -> b
$ ((String, Int) -> Maybe GroupMatrix)
-> [(String, Int)] -> [GroupMatrix]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ([GroupMatrix] -> (String, Int) -> Maybe GroupMatrix
findGroup [GroupMatrix]
matrices) [(String, Int)]
newGroups

-------------------------------------------------------------------------------
-- sort the benchmarks
-------------------------------------------------------------------------------

extractColumn :: String -> GroupMatrix -> [(String, AnalyzedField)]
extractColumn :: String -> GroupMatrix -> [(String, AnalyzedField)]
extractColumn String
field GroupMatrix{Int
String
[(String, String)]
BenchmarkMatrix
groupMatrix :: BenchmarkMatrix
groupBenches :: [(String, String)]
groupName :: String
groupIndex :: Int
groupMatrix :: GroupMatrix -> BenchmarkMatrix
groupBenches :: GroupMatrix -> [(String, String)]
groupName :: GroupMatrix -> String
groupIndex :: GroupMatrix -> Int
..} =
    let idx :: Maybe Int
idx = String -> [String] -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
elemIndex String
field (BenchmarkMatrix -> [String]
colNames BenchmarkMatrix
groupMatrix)
        vals :: [AnalyzedField]
vals = case Maybe Int
idx of
            Just Int
i -> ([AnalyzedField] -> AnalyzedField)
-> [[AnalyzedField]] -> [AnalyzedField]
forall a b. (a -> b) -> [a] -> [b]
map ([AnalyzedField] -> Int -> AnalyzedField
forall a. [a] -> Int -> a
!! Int
i) (((String, [AnalyzedField]) -> [AnalyzedField])
-> [(String, [AnalyzedField])] -> [[AnalyzedField]]
forall a b. (a -> b) -> [a] -> [b]
map (String, [AnalyzedField]) -> [AnalyzedField]
forall a b. (a, b) -> b
snd (BenchmarkMatrix -> [(String, [AnalyzedField])]
rowValues BenchmarkMatrix
groupMatrix))
            Maybe Int
Nothing -> String -> [AnalyzedField]
forall a. HasCallStack => String -> a
error (String -> [AnalyzedField]) -> String -> [AnalyzedField]
forall a b. (a -> b) -> a -> b
$ String
"Field [" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
field
                String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"] does not exist in group ["
                String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
groupName String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"] and run id [" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
groupIndex String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"]"
    in [String] -> [AnalyzedField] -> [(String, AnalyzedField)]
forall a b. [a] -> [b] -> [(a, b)]
zip (((String, String) -> String) -> [(String, String)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, String) -> String
forall a b. (a, b) -> a
fst [(String, String)]
groupBenches) [AnalyzedField]
vals

extractColumnValue :: String -> GroupMatrix -> Estimator -> [(String, Double)]
extractColumnValue :: String -> GroupMatrix -> Estimator -> [(String, Double)]
extractColumnValue String
field GroupMatrix
matrix Estimator
estimator =
    ((String, AnalyzedField) -> (String, Double))
-> [(String, AnalyzedField)] -> [(String, Double)]
forall a b. (a -> b) -> [a] -> [b]
map ((AnalyzedField -> Double)
-> (String, AnalyzedField) -> (String, Double)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second (Estimator -> AnalyzedField -> Double
getAnalyzedValue Estimator
estimator)) ([(String, AnalyzedField)] -> [(String, Double)])
-> [(String, AnalyzedField)] -> [(String, Double)]
forall a b. (a -> b) -> a -> b
$ String -> GroupMatrix -> [(String, AnalyzedField)]
extractColumn String
field GroupMatrix
matrix

benchmarkCompareSanity :: [String] -> GroupMatrix -> [String]
benchmarkCompareSanity :: [String] -> GroupMatrix -> [String]
benchmarkCompareSanity [String]
benchmarks GroupMatrix{Int
String
[(String, String)]
BenchmarkMatrix
groupMatrix :: BenchmarkMatrix
groupBenches :: [(String, String)]
groupName :: String
groupIndex :: Int
groupMatrix :: GroupMatrix -> BenchmarkMatrix
groupBenches :: GroupMatrix -> [(String, String)]
groupName :: GroupMatrix -> String
groupIndex :: GroupMatrix -> Int
..} = do
    let benches :: [String]
benches = ((String, String) -> String) -> [(String, String)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, String) -> String
forall a b. (a, b) -> a
fst [(String, String)]
groupBenches
    let absent :: [String]
absent = [String]
benchmarks [String] -> [String] -> [String]
forall a. Eq a => [a] -> [a] -> [a]
\\ [String]
benches
    let msg :: String
msg =
            String
"selectBenchmarks: Group [" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
groupName String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"] run id ["
            String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
groupIndex
            String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"] does not contain the following selected benchmarks; \
            \ignoring them: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
forall a. Show a => a -> String
show [String]
absent
            String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\nAvailable benchmarks in this group are: "
            String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
forall a. Show a => a -> String
show [String]
benches

    if ([String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
absent)
    then [String]
benchmarks
    else String -> [String] -> [String]
forall a. String -> a -> a
trace String
msg ([String]
benchmarks [String] -> [String] -> [String]
forall a. Eq a => [a] -> [a] -> [a]
\\ [String]
absent)

selectBenchmarksByField :: Config
                        -> [GroupMatrix]
                        -> [[(String, Double)]]
                        -> (GroupStyle -> [[(String, Double)]])
                        -> [String]
selectBenchmarksByField :: Config
-> [GroupMatrix]
-> [[(String, Double)]]
-> (GroupStyle -> [[(String, Double)]])
-> [String]
selectBenchmarksByField 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
..} [GroupMatrix]
matrices [[(String, Double)]]
columns GroupStyle -> [[(String, Double)]]
colsByStyle =
    let bmnames :: [String]
bmnames = (SortColumn
 -> Maybe GroupStyle -> Either String [(String, Double)])
-> [String]
selectBenchmarks SortColumn -> Maybe GroupStyle -> Either String [(String, Double)]
extractGroup
     in ([String] -> GroupMatrix -> [String])
-> [String] -> [GroupMatrix] -> [String]
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl [String] -> GroupMatrix -> [String]
benchmarkCompareSanity [String]
bmnames [GroupMatrix]
matrices

    where

    grpNames :: [(String, Int)]
grpNames =
        let getName :: GroupMatrix -> (String, Int)
getName GroupMatrix
x = (GroupMatrix -> String
groupName GroupMatrix
x, GroupMatrix -> Int
groupIndex GroupMatrix
x)
        in (GroupMatrix -> (String, Int)) -> [GroupMatrix] -> [(String, Int)]
forall a b. (a -> b) -> [a] -> [b]
map GroupMatrix -> (String, Int)
getName [GroupMatrix]
matrices

    -- columns are benchmark groups in this case
    extractGroup :: SortColumn -> Maybe GroupStyle -> Either String [(String, Double)]
extractGroup SortColumn
colSelector Maybe GroupStyle
style =
            let cols :: [[(String, Double)]]
cols = case Maybe GroupStyle
style of
                    Maybe GroupStyle
Nothing -> [[(String, Double)]]
columns
                    Just s -> GroupStyle -> [[(String, Double)]]
colsByStyle GroupStyle
s
            in case SortColumn
colSelector of
                ColumnName (Left String
name) ->
                    let len :: Int
len = [[(String, Double)]] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[(String, Double)]]
cols
                    in if Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
1
                       then SortColumn -> Maybe GroupStyle -> Either String [(String, Double)]
extractGroup (Either String (String, Int) -> SortColumn
ColumnName ((String, Int) -> Either String (String, Int)
forall a b. b -> Either a b
Right (String
name, Int
0))) Maybe GroupStyle
style
                       else String -> Either String [(String, Double)]
forall a b. a -> Either a b
Left (String -> Either String [(String, Double)])
-> String -> Either String [(String, Double)]
forall a b. (a -> b) -> a -> b
$ String
"selectBenchmarks: there are " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
len
                            String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" runs in the input data, please specify the run \
                            \index [0-" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
                            String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"] along with the group name."
                ColumnName (Right (String
name, Int
runId)) ->
                    String
-> Int -> Maybe GroupStyle -> Either String [(String, Double)]
extractColumnByGroupName String
name Int
runId Maybe GroupStyle
style
                ColumnIndex Int
n -> Int -> [[(String, Double)]] -> Either String [(String, Double)]
forall a. Int -> [a] -> Either String a
extractColumnByGroupIndex Int
n [[(String, Double)]]
cols

    -- The benchmark field is constant.  Extract all benchmark values for the
    -- given field and for the given group.
    findColumnIndex :: t GroupMatrix -> (String, Int) -> (a, Bool)
findColumnIndex t GroupMatrix
mxs (String
name, Int
runId) =
        let foldFunc :: (a, Bool) -> GroupMatrix -> (a, Bool)
foldFunc res :: (a, Bool)
res@(a
idx, Bool
found) GroupMatrix
grp =
                case Bool
found of
                    Bool
False ->
                        if GroupMatrix -> String
groupName GroupMatrix
grp String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
name Bool -> Bool -> Bool
&& GroupMatrix -> Int
groupIndex GroupMatrix
grp Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
runId
                        then (a
idx, Bool
True)
                        else (a
idx a -> a -> a
forall a. Num a => a -> a -> a
+ a
1, Bool
found)
                    Bool
True -> (a, Bool)
res
        in ((a, Bool) -> GroupMatrix -> (a, Bool))
-> (a, Bool) -> t GroupMatrix -> (a, Bool)
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (a, Bool) -> GroupMatrix -> (a, Bool)
forall a. Num a => (a, Bool) -> GroupMatrix -> (a, Bool)
foldFunc (a
0, Bool
False) t GroupMatrix
mxs

    extractColumnByGroupName :: String
-> Int -> Maybe GroupStyle -> Either String [(String, Double)]
extractColumnByGroupName String
name Int
runId Maybe GroupStyle
style =
            case [GroupMatrix] -> (String, Int) -> (Int, Bool)
forall (t :: * -> *) a.
(Foldable t, Num a) =>
t GroupMatrix -> (String, Int) -> (a, Bool)
findColumnIndex [GroupMatrix]
matrices (String
name, Int
runId) of
                (Int
_, Bool
False) -> String -> Either String [(String, Double)]
forall a b. a -> Either a b
Left (String -> Either String [(String, Double)])
-> String -> Either String [(String, Double)]
forall a b. (a -> b) -> a -> b
$ String
"Benchmark group name [" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name
                            String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"] and index [" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
runId
                            String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"] not found. Available groups are: "
                            String -> String -> String
forall a. [a] -> [a] -> [a]
++ [(String, Int)] -> String
forall a. Show a => a -> String
show [(String, Int)]
grpNames
                (Int
i, Bool
True) -> SortColumn -> Maybe GroupStyle -> Either String [(String, Double)]
extractGroup (Int -> SortColumn
ColumnIndex Int
i) Maybe GroupStyle
style

    extractColumnByGroupIndex :: Int -> [a] -> Either String a
extractColumnByGroupIndex Int
idx [a]
cols =
        let len :: Int
len = [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
cols
        in if Int
idx Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
len
           then String -> Either String a
forall a b. a -> Either a b
Left (String -> Either String a) -> String -> Either String a
forall a b. (a -> b) -> a -> b
$ String
"Column index must be in the range [0-"
                String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"]"
           else a -> Either String a
forall a b. b -> Either a b
Right (a -> Either String a) -> a -> Either String a
forall a b. (a -> b) -> a -> b
$ [a]
cols [a] -> Int -> a
forall a. [a] -> Int -> a
!! Int
idx

selectBenchmarksByGroup :: Config -> GroupMatrix -> [String]
selectBenchmarksByGroup :: Config -> GroupMatrix -> [String]
selectBenchmarksByGroup 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
..} grp :: GroupMatrix
grp@GroupMatrix{Int
String
[(String, String)]
BenchmarkMatrix
groupMatrix :: BenchmarkMatrix
groupBenches :: [(String, String)]
groupName :: String
groupIndex :: Int
groupMatrix :: GroupMatrix -> BenchmarkMatrix
groupBenches :: GroupMatrix -> [(String, String)]
groupName :: GroupMatrix -> String
groupIndex :: GroupMatrix -> Int
..} =
    -- XXX this is common to ByField and ByGroup
    let bmnames :: [String]
bmnames = (SortColumn
 -> Maybe GroupStyle -> Either String [(String, Double)])
-> [String]
selectBenchmarks SortColumn -> Maybe GroupStyle -> Either String [(String, Double)]
forall p. SortColumn -> p -> Either String [(String, Double)]
extractField
     in [String]
bmnames

    where

    -- columns are benchmark fields in this case
    extractField :: SortColumn -> p -> Either String [(String, Double)]
extractField (ColumnName (Left String
name)) p
_ = String -> Either String [(String, Double)]
extractColumnByFieldName String
name
    extractField (ColumnName (Right (String
name, Int
_))) p
_ =
        -- XXX runId does not make sense for fields
        String -> Either String [(String, Double)]
extractColumnByFieldName String
name
    extractField (ColumnIndex Int
n) p
_ = Int -> Either String [(String, Double)]
extractColumnByFieldIndex Int
n

    -- The benchmark field is constant.  Extract all benchmark values for the
    -- given field and for the given group.
    extractColumnByFieldName :: String -> Either String [(String, Double)]
extractColumnByFieldName String
name =
        let fields :: [String]
fields = BenchmarkMatrix -> [String]
colNames BenchmarkMatrix
groupMatrix
        in case String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem String
name [String]
fields of
            Bool
False -> String -> Either String [(String, Double)]
forall a b. a -> Either a b
Left (String -> Either String [(String, Double)])
-> String -> Either String [(String, Double)]
forall a b. (a -> b) -> a -> b
$ String
"Benchmark field name [" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name
                        String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"] not found in group ["
                        String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
groupName String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"]. Available fields are: "
                        String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
forall a. Show a => a -> String
show [String]
fields
            Bool
True -> [(String, Double)] -> Either String [(String, Double)]
forall a b. b -> Either a b
Right ([(String, Double)] -> Either String [(String, Double)])
-> [(String, Double)] -> Either String [(String, Double)]
forall a b. (a -> b) -> a -> b
$ String -> GroupMatrix -> Estimator -> [(String, Double)]
extractColumnValue String
name GroupMatrix
grp Estimator
estimator

    extractColumnByFieldIndex :: Int -> Either String [(String, Double)]
extractColumnByFieldIndex Int
idx =
        let fields :: [String]
fields = BenchmarkMatrix -> [String]
colNames BenchmarkMatrix
groupMatrix
            len :: Int
len = [String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
fields
        in if Int
idx Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
len
           then String -> Either String [(String, Double)]
forall a b. a -> Either a b
Left (String -> Either String [(String, Double)])
-> String -> Either String [(String, Double)]
forall a b. (a -> b) -> a -> b
$ String
"Column index must be in the range [0-"
                String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"]"
           else [(String, Double)] -> Either String [(String, Double)]
forall a b. b -> Either a b
Right ([(String, Double)] -> Either String [(String, Double)])
-> [(String, Double)] -> Either String [(String, Double)]
forall a b. (a -> b) -> a -> b
$ String -> GroupMatrix -> Estimator -> [(String, Double)]
extractColumnValue ([String]
fields [String] -> Int -> String
forall a. [a] -> Int -> a
!! Int
idx) GroupMatrix
grp Estimator
estimator

type NumberedLines = [(Int, [String])]

sanityCheckCSV :: CSV -> NumberedLines
sanityCheckCSV :: CSV -> NumberedLines
sanityCheckCSV CSV
csvlines | CSV -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null CSV
csvlines = String -> NumberedLines
forall a. HasCallStack => String -> a
error (String -> NumberedLines) -> String -> NumberedLines
forall a b. (a -> b) -> a -> b
$ String
"The input file is empty"
sanityCheckCSV CSV
csvlines =
    let headRow :: [String]
headRow = CSV -> [String]
forall a. [a] -> a
head CSV
csvlines
        rowLen :: Int
rowLen = [String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
headRow
    in  if Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ String
"name" String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ((Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower) [String]
headRow
        then String -> NumberedLines
forall a. HasCallStack => String -> a
error String
"No 'Name' column found in the CSV header line"
        else
          -- Add line numbers for error reporting
          [Int] -> CSV -> NumberedLines
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
1..] CSV
csvlines
          -- cleanup blank rows
        NumberedLines -> (NumberedLines -> NumberedLines) -> NumberedLines
forall a b. a -> (a -> b) -> b
& ((Int, [String]) -> Bool) -> NumberedLines -> NumberedLines
forall a. (a -> Bool) -> [a] -> [a]
filter (\(Int
_,[String]
xs) -> [String]
xs [String] -> [String] -> Bool
forall a. Eq a => a -> a -> Bool
/= [String
""])

          -- make sure all lines are of the same size, So that we can transpose
          -- back and forth without losing information.
        NumberedLines -> (NumberedLines -> NumberedLines) -> NumberedLines
forall a b. a -> (a -> b) -> b
& ((Int, [String]) -> (Int, [String]))
-> NumberedLines -> NumberedLines
forall a b. (a -> b) -> [a] -> [b]
map (\x :: (Int, [String])
x@(Int
i,[String]
xs) ->
               if [String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
xs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
rowLen
               then (Int, [String])
x
               else String -> (Int, [String])
forall a. HasCallStack => String -> a
error (String -> (Int, [String])) -> String -> (Int, [String])
forall a b. (a -> b) -> a -> b
$ String
"Line number " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i
                        String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" in the input file is not of the same length as\
                            \ the header line"
              )

-- An iteration field indicates that consecutive rows with the same benchmark
-- name have results from different iterations of the same benchmark and the
-- measurement fields have to be scaled per iteration based on the number of
-- iterations in the iteration count field.
--
-- Make sure that "iters" and "name" are the first and second columns
ensureIterField :: ([String], [NumberedLines])  -> ([String], [NumberedLines])
ensureIterField :: ([String], [NumberedLines]) -> ([String], [NumberedLines])
ensureIterField ([String]
header, [NumberedLines]
groups) =
    ( String
"iters" String -> [String] -> [String]
forall a. a -> [a] -> [a]
: String
"name" String -> [String] -> [String]
forall a. a -> [a] -> [a]
: (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter String -> Bool
isNotNameIter [String]
header
    , (NumberedLines -> NumberedLines)
-> [NumberedLines] -> [NumberedLines]
forall a b. (a -> b) -> [a] -> [b]
map NumberedLines -> NumberedLines
forall a. [(a, [String])] -> [(a, [String])]
reorderNameIter [NumberedLines]
groups
    )

    where

    isNotNameIter :: String -> Bool
isNotNameIter String
x =
           (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
x String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
"name"
        Bool -> Bool -> Bool
&& (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
x String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
"iters"

    notNameIters :: [String] -> Bool
notNameIters [] = Bool
True
    notNameIters (String
x:[String]
_) = String -> Bool
isNotNameIter String
x

    nameNotFound :: a
nameNotFound = String -> a
forall a. HasCallStack => String -> a
error String
"Name field is required in the csv file"

    reorderNameIter :: [(a, [String])] -> [(a, [String])]
reorderNameIter [(a, [String])]
csvlines =
          [(a, [String])] -> ([a], CSV)
forall a b. [(a, b)] -> ([a], [b])
unzip [(a, [String])]
csvlines
        ([a], CSV) -> (([a], CSV) -> ([a], CSV)) -> ([a], CSV)
forall a b. a -> (a -> b) -> b
& (CSV -> CSV) -> ([a], CSV) -> ([a], CSV)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second ([String]
header [String] -> CSV -> CSV
forall a. a -> [a] -> [a]
:)
        ([a], CSV) -> (([a], CSV) -> ([a], CSV)) -> ([a], CSV)
forall a b. a -> (a -> b) -> b
& (CSV -> CSV) -> ([a], CSV) -> ([a], CSV)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second CSV -> CSV
forall a. [[a]] -> [[a]]
transpose
        ([a], CSV) -> (([a], CSV) -> ([a], CSV)) -> ([a], CSV)
forall a b. a -> (a -> b) -> b
& (CSV -> CSV) -> ([a], CSV) -> ([a], CSV)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second CSV -> CSV
reorder
        ([a], CSV) -> (([a], CSV) -> ([a], CSV)) -> ([a], CSV)
forall a b. a -> (a -> b) -> b
& (CSV -> CSV) -> ([a], CSV) -> ([a], CSV)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second CSV -> CSV
forall a. [[a]] -> [[a]]
transpose
        ([a], CSV) -> (([a], CSV) -> [(a, [String])]) -> [(a, [String])]
forall a b. a -> (a -> b) -> b
& ([a] -> CSV -> [(a, [String])]) -> ([a], CSV) -> [(a, [String])]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry [a] -> CSV -> [(a, [String])]
forall a b. [a] -> [b] -> [(a, b)]
zip

        where

        reorder :: CSV -> CSV
reorder CSV
xs =
            let findField :: String -> t [String] -> Maybe [String]
findField String
x = ([String] -> Bool) -> t [String] -> Maybe [String]
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\(String
y:[String]
_) -> (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
y String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
x)
                iterCol :: [String]
iterCol = Int -> String -> [String]
forall a. Int -> a -> [a]
replicate ([String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (CSV -> [String]
forall a. [a] -> a
head CSV
xs) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) String
"1"
            in   [String] -> Maybe [String] -> [String]
forall a. a -> Maybe a -> a
fromMaybe [String]
iterCol (([String] -> [String]) -> Maybe [String] -> Maybe [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [String] -> [String]
forall a. [a] -> [a]
tail (Maybe [String] -> Maybe [String])
-> Maybe [String] -> Maybe [String]
forall a b. (a -> b) -> a -> b
$ String -> CSV -> Maybe [String]
forall (t :: * -> *).
Foldable t =>
String -> t [String] -> Maybe [String]
findField String
"iters" CSV
xs)
               [String] -> CSV -> CSV
forall a. a -> [a] -> [a]
: [String] -> Maybe [String] -> [String]
forall a. a -> Maybe a -> a
fromMaybe [String]
forall a. a
nameNotFound (([String] -> [String]) -> Maybe [String] -> Maybe [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [String] -> [String]
forall a. [a] -> [a]
tail (Maybe [String] -> Maybe [String])
-> Maybe [String] -> Maybe [String]
forall a b. (a -> b) -> a -> b
$ String -> CSV -> Maybe [String]
forall (t :: * -> *).
Foldable t =>
String -> t [String] -> Maybe [String]
findField String
"name" CSV
xs)
               [String] -> CSV -> CSV
forall a. a -> [a] -> [a]
: ([String] -> [String]) -> CSV -> CSV
forall a b. (a -> b) -> [a] -> [b]
map [String] -> [String]
forall a. [a] -> [a]
tail (([String] -> Bool) -> CSV -> CSV
forall a. (a -> Bool) -> [a] -> [a]
filter [String] -> Bool
notNameIters CSV
xs)

-- Only keep those fields that are passed to this function
-- Also, preserve any predictor fields for regression analysis
filterFields :: [String] -> BenchmarkIterMatrix -> BenchmarkIterMatrix
filterFields :: [String] -> BenchmarkIterMatrix -> BenchmarkIterMatrix
filterFields [String]
fieldNames BenchmarkIterMatrix{[String]
[(String, [([Double], [Double])])]
iterRowValues :: BenchmarkIterMatrix -> [(String, [([Double], [Double])])]
iterRespColNames :: BenchmarkIterMatrix -> [String]
iterPredColNames :: BenchmarkIterMatrix -> [String]
iterRowValues :: [(String, [([Double], [Double])])]
iterRespColNames :: [String]
iterPredColNames :: [String]
..} =
    BenchmarkIterMatrix :: [String]
-> [String]
-> [(String, [([Double], [Double])])]
-> BenchmarkIterMatrix
BenchmarkIterMatrix
        { iterPredColNames :: [String]
iterPredColNames = [String
"iters"] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter String -> Bool
isPredictorField [String]
iterRespColNames
        , iterRespColNames :: [String]
iterRespColNames = (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter String -> Bool
isRequestedField [String]
iterRespColNames
        , iterRowValues :: [(String, [([Double], [Double])])]
iterRowValues = [(String, [([Double], [Double])])]
-> [(String, [([Double], [Double])])]
transform [(String, [([Double], [Double])])]
iterRowValues
        }

    where

    transform :: [(String, [([Double], [Double])])] -> [(String, [([Double], [Double])])]
    transform :: [(String, [([Double], [Double])])]
-> [(String, [([Double], [Double])])]
transform = ((String, [([Double], [Double])])
 -> (String, [([Double], [Double])]))
-> [(String, [([Double], [Double])])]
-> [(String, [([Double], [Double])])]
forall a b. (a -> b) -> [a] -> [b]
map (\(String
name, [([Double], [Double])]
tuples) ->
        let ([[Double]]
ys, [[Double]]
zs) = [([Double], [Double])] -> ([[Double]], [[Double]])
forall a b. [(a, b)] -> ([a], [b])
unzip [([Double], [Double])]
tuples
            pcols :: [[Either String Double]]
pcols = [[Either String Double]] -> [[Either String Double]]
forall a. [[a]] -> [[a]]
transpose ((String -> Either String Double)
-> [String] -> [Either String Double]
forall a b. (a -> b) -> [a] -> [b]
map String -> Either String Double
forall a b. a -> Either a b
Left [String]
iterPredColNames [Either String Double]
-> [[Either String Double]] -> [[Either String Double]]
forall a. a -> [a] -> [a]
: ([Double] -> [Either String Double])
-> [[Double]] -> [[Either String Double]]
forall a b. (a -> b) -> [a] -> [b]
map ((Double -> Either String Double)
-> [Double] -> [Either String Double]
forall a b. (a -> b) -> [a] -> [b]
map Double -> Either String Double
forall a b. b -> Either a b
Right) [[Double]]
ys)
            rcols :: [[Either String Double]]
rcols = [[Either String Double]] -> [[Either String Double]]
forall a. [[a]] -> [[a]]
transpose ((String -> Either String Double)
-> [String] -> [Either String Double]
forall a b. (a -> b) -> [a] -> [b]
map String -> Either String Double
forall a b. a -> Either a b
Left [String]
iterRespColNames [Either String Double]
-> [[Either String Double]] -> [[Either String Double]]
forall a. a -> [a] -> [a]
: ([Double] -> [Either String Double])
-> [[Double]] -> [[Either String Double]]
forall a b. (a -> b) -> [a] -> [b]
map ((Double -> Either String Double)
-> [Double] -> [Either String Double]
forall a b. (a -> b) -> [a] -> [b]
map Double -> Either String Double
forall a b. b -> Either a b
Right) [[Double]]
zs)
            pcols' :: [[Either String Double]]
pcols' = [[Either String Double]]
pcols [[Either String Double]]
-> [[Either String Double]] -> [[Either String Double]]
forall a. [a] -> [a] -> [a]
++ ([Either String Double] -> Bool)
-> [[Either String Double]] -> [[Either String Double]]
forall a. (a -> Bool) -> [a] -> [a]
filter [Either String Double] -> Bool
forall b. [Either String b] -> Bool
isPredictor [[Either String Double]]
rcols
            rcols' :: [[Either String Double]]
rcols' = ([Either String Double] -> Bool)
-> [[Either String Double]] -> [[Either String Double]]
forall a. (a -> Bool) -> [a] -> [a]
filter [Either String Double] -> Bool
forall b. [Either String b] -> Bool
requested [[Either String Double]]
rcols
            pcols'' :: [[Double]]
pcols'' = ([Either String Double] -> [Double])
-> [[Either String Double]] -> [[Double]]
forall a b. (a -> b) -> [a] -> [b]
map ((Either String Double -> Double)
-> [Either String Double] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map Either String Double -> Double
forall a p. Either a p -> p
fromRt) ([[Either String Double]] -> [[Double]])
-> [[Either String Double]] -> [[Double]]
forall a b. (a -> b) -> a -> b
$ [[Either String Double]] -> [[Either String Double]]
forall a. [a] -> [a]
tail ([[Either String Double]] -> [[Either String Double]])
-> [[Either String Double]] -> [[Either String Double]]
forall a b. (a -> b) -> a -> b
$ [[Either String Double]] -> [[Either String Double]]
forall a. [[a]] -> [[a]]
transpose [[Either String Double]]
pcols'
            rcols'' :: [[Double]]
rcols'' = ([Either String Double] -> [Double])
-> [[Either String Double]] -> [[Double]]
forall a b. (a -> b) -> [a] -> [b]
map ((Either String Double -> Double)
-> [Either String Double] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map Either String Double -> Double
forall a p. Either a p -> p
fromRt) ([[Either String Double]] -> [[Double]])
-> [[Either String Double]] -> [[Double]]
forall a b. (a -> b) -> a -> b
$ [[Either String Double]] -> [[Either String Double]]
forall a. [a] -> [a]
tail ([[Either String Double]] -> [[Either String Double]])
-> [[Either String Double]] -> [[Either String Double]]
forall a b. (a -> b) -> a -> b
$ [[Either String Double]] -> [[Either String Double]]
forall a. [[a]] -> [[a]]
transpose [[Either String Double]]
rcols'
        in (String
name, [[Double]] -> [[Double]] -> [([Double], [Double])]
forall a b. [a] -> [b] -> [(a, b)]
zip [[Double]]
pcols'' [[Double]]
rcols''))

    fromRt :: Either a p -> p
fromRt (Right p
x) = p
x
    fromRt Either a p
_ = String -> p
forall a. HasCallStack => String -> a
error String
"bug"

    isRequestedField :: String -> Bool
isRequestedField = (String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
fieldNames)

    requested :: [Either String b] -> Bool
requested [] = Bool
True
    requested (Left String
x:[Either String b]
_) = String -> Bool
isRequestedField String
x
    requested [Either String b]
_ = String -> Bool
forall a. HasCallStack => String -> a
error String
"bug"

    isPredictor :: [Either String b] -> Bool
isPredictor [] = Bool
True
    isPredictor (Left String
x:[Either String b]
_) = String -> Bool
isPredictorField String
x
    isPredictor [Either String b]
_ = String -> Bool
forall a. HasCallStack => String -> a
error String
"bug"

-- Split the file into different runs
-- return the header fields and list of runs without the header
splitRuns :: NumberedLines -> ([String], [NumberedLines])
splitRuns :: NumberedLines -> ([String], [NumberedLines])
splitRuns NumberedLines
csvlines =
    let header :: [String]
header = (Int, [String]) -> [String]
forall a b. (a, b) -> b
snd ((Int, [String]) -> [String]) -> (Int, [String]) -> [String]
forall a b. (a -> b) -> a -> b
$ NumberedLines -> (Int, [String])
forall a. [a] -> a
head NumberedLines
csvlines
        ls :: [NumberedLines]
ls = ((Int, [String]) -> Bool) -> NumberedLines -> [NumberedLines]
forall a. (a -> Bool) -> [a] -> [[a]]
linesBy (\(Int, [String])
x -> (Int, [String]) -> [String]
forall a b. (a, b) -> b
snd (Int, [String])
x [String] -> [String] -> Bool
forall a. Eq a => a -> a -> Bool
== [String]
header) (NumberedLines -> NumberedLines
forall a. [a] -> [a]
tail NumberedLines
csvlines)
    in ([String]
header, [NumberedLines]
ls)

readWithError :: Read a => Int -> String -> (String, String) -> a
readWithError :: Int -> String -> (String, String) -> a
readWithError Int
lno String
typ (String
fname, String
fval) =
    case String -> Maybe a
forall a. Read a => String -> Maybe a
readMaybe String
fval of
        Maybe a
Nothing -> String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ String
"Cannot read " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
fname
            String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" field [" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
fval String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"] as "
            String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
typ String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" type at line number "
            String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
lno
        Just a
n -> a
n

-- An iteration field indicates that consecutive rows with the same benchmark
-- name have results from different iterations of the same benchmark and the
-- measurement fields have to be scaled per iteration based on the number of
-- iterations in the iteration count field.
--
-- If the first column is iteration then fold all iterations and remove the
-- iteration column.
readIterations :: [String] -> NumberedLines -> BenchmarkIterMatrix
readIterations :: [String] -> NumberedLines -> BenchmarkIterMatrix
readIterations [String]
header NumberedLines
csvlines =
    let tuples :: [(String, [([Double], [Double])])]
tuples =
            ((Int, [String]) -> (Int, String, [(String, Double)]))
-> NumberedLines -> [(Int, String, [(String, Double)])]
forall a b. (a -> b) -> [a] -> [b]
map ([String] -> (Int, [String]) -> (Int, String, [(String, Double)])
parseNumericFields [String]
header) NumberedLines
csvlines
            -- we now have a list of triples [(iter, name, (fieldName, [Double])]
          [(Int, String, [(String, Double)])]
-> ([(Int, String, [(String, Double)])]
    -> [[(Int, String, [(String, Double)])]])
-> [[(Int, String, [(String, Double)])]]
forall a b. a -> (a -> b) -> b
& ((Int, String, [(String, Double)])
 -> (Int, String, [(String, Double)]) -> Bool)
-> [(Int, String, [(String, Double)])]
-> [[(Int, String, [(String, Double)])]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy (Int, String, [(String, Double)])
-> (Int, String, [(String, Double)]) -> Bool
forall a a c c. (Ord a, Eq a) => (a, a, c) -> (a, a, c) -> Bool
successiveIters
          [[(Int, String, [(String, Double)])]]
-> ([[(Int, String, [(String, Double)])]]
    -> [(String, [([Double], [Double])])])
-> [(String, [([Double], [Double])])]
forall a b. a -> (a -> b) -> b
& ([(Int, String, [(String, Double)])]
 -> (String, [([Double], [Double])]))
-> [[(Int, String, [(String, Double)])]]
-> [(String, [([Double], [Double])])]
forall a b. (a -> b) -> [a] -> [b]
map (((String, [([Double], [Double])])
 -> (Int, String, [(String, Double)])
 -> (String, [([Double], [Double])]))
-> (String, [([Double], [Double])])
-> [(Int, String, [(String, Double)])]
-> (String, [([Double], [Double])])
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (String, [([Double], [Double])])
-> (Int, String, [(String, Double)])
-> (String, [([Double], [Double])])
forall a a a b a a.
(Integral a, Num a) =>
(a, [([a], [b])]) -> (a, a, [(a, b)]) -> (a, [([a], [b])])
addIters (String
"",[]))
    in BenchmarkIterMatrix :: [String]
-> [String]
-> [(String, [([Double], [Double])])]
-> BenchmarkIterMatrix
BenchmarkIterMatrix
        { iterPredColNames :: [String]
iterPredColNames = [String
"iters"]
        , iterRespColNames :: [String]
iterRespColNames = Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
drop Int
2 [String]
header
        , iterRowValues :: [(String, [([Double], [Double])])]
iterRowValues = [(String, [([Double], [Double])])]
tuples
        }

    where

    -- The first column is iters and the second is the name
    -- We zip the header for error reporting
    parseNumericFields :: [String] -> (Int, [String]) -> (Int, String, [(String, Double)])
parseNumericFields [String]
hdr (Int
lno, [String]
vals) = Int -> [(String, String)] -> (Int, String, [(String, Double)])
parseNumericTuples Int
lno ([(String, String)] -> (Int, String, [(String, Double)]))
-> [(String, String)] -> (Int, String, [(String, Double)])
forall a b. (a -> b) -> a -> b
$ [String] -> [String] -> [(String, String)]
forall a b. [a] -> [b] -> [(a, b)]
zip [String]
hdr [String]
vals

    parseNumericTuples :: Int -> [(String, String)] -> (Int, String, [(String, Double)])
parseNumericTuples Int
lno ((String, String)
iter:(String
_,String
name):[(String, String)]
xs) =
          (Int -> String -> (String, String) -> Int
forall a. Read a => Int -> String -> (String, String) -> a
readWithError Int
lno String
"Int" (String, String)
iter :: Int
          , String
name
          , ((String, String) -> (String, Double))
-> [(String, String)] -> [(String, Double)]
forall a b. (a -> b) -> [a] -> [b]
map (\x :: (String, String)
x@(String
n,String
_) -> (String
n, Int -> String -> (String, String) -> Double
forall a. Read a => Int -> String -> (String, String) -> a
readWithError Int
lno String
"Double" (String, String)
x)) [(String, String)]
xs
                :: [(String, Double)]
          )
    parseNumericTuples Int
_ [(String, String)]
_ = String -> (Int, String, [(String, Double)])
forall a. HasCallStack => String -> a
error String
"iters and name fields are needed"

    successiveIters :: (a, a, c) -> (a, a, c) -> Bool
successiveIters (a
i1,a
name1,c
_) (a
i2,a
name2,c
_) = a
name2 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
name1 Bool -> Bool -> Bool
&& a
i2 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
i1

    addIters :: (a, [([a], [b])]) -> (a, a, [(a, b)]) -> (a, [([a], [b])])
addIters (a
_,[([a], [b])]
siters) (a
iter,a
name,[(a, b)]
vals) =
        (a
name, ([a -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
iter], ((a, b) -> b) -> [(a, b)] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map (a, b) -> b
forall a b. (a, b) -> b
snd [(a, b)]
vals) ([a], [b]) -> [([a], [b])] -> [([a], [b])]
forall a. a -> [a] -> [a]
: [([a], [b])]
siters)

getFieldRange :: String -> Config -> Maybe (Double, Double)
getFieldRange :: String -> Config -> Maybe (Double, Double)
getFieldRange String
fieldName 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
..} =
    let res :: Maybe (String, Double, Double)
res = ((String, Double, Double) -> Bool)
-> [(String, Double, Double)] -> Maybe (String, Double, Double)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\(String
x, Double
_, Double
_) -> String
x String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
fieldName) [(String, Double, Double)]
fieldRanges
    in case Maybe (String, Double, Double)
res of
        Maybe (String, Double, Double)
Nothing -> Maybe (Double, Double)
forall a. Maybe a
Nothing
        Just (String
_, Double
x, Double
y) -> (Double, Double) -> Maybe (Double, Double)
forall a. a -> Maybe a
Just (Double
x, Double
y)

getFieldTick :: String -> Config -> Maybe FieldTick
getFieldTick :: String -> Config -> Maybe FieldTick
getFieldTick String
fieldName 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
..} =
    ((String, FieldTick) -> FieldTick)
-> Maybe (String, FieldTick) -> Maybe FieldTick
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String, FieldTick) -> FieldTick
forall a b. (a, b) -> b
snd (Maybe (String, FieldTick) -> Maybe FieldTick)
-> Maybe (String, FieldTick) -> Maybe FieldTick
forall a b. (a -> b) -> a -> b
$ ((String, FieldTick) -> Bool)
-> [(String, FieldTick)] -> Maybe (String, FieldTick)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\(String, FieldTick)
x -> (String, FieldTick) -> String
forall a b. (a, b) -> a
fst (String, FieldTick)
x String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
fieldName) [(String, FieldTick)]
fieldTicks

getReportExtension :: ReportType -> String
getReportExtension :: ReportType -> String
getReportExtension ReportType
rtype =
    case ReportType
rtype of
        ReportType
TextReport -> String
".txt"
        ReportType
GraphicalChart -> String
".svg"

prepareOutputFile :: FilePath -> ReportType -> FilePath -> Estimator -> String -> FilePath
prepareOutputFile :: String -> ReportType -> String -> Estimator -> String -> String
prepareOutputFile String
dir ReportType
rtype String
file Estimator
est String
field =
    let estStr :: String
estStr = case Estimator
est of
            Estimator
Mean -> String
"mean"
            Estimator
Median -> String
"median"
            Estimator
Regression -> String
"coeff"
        path :: String
path = String
dir String -> String -> String
</> (String
file String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"-" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
estStr String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"-" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
field
                             String -> String -> String
forall a. [a] -> [a] -> [a]
++ ReportType -> String
getReportExtension ReportType
rtype)
    in String
path

prepareToReport :: FilePath -> Config -> IO (CSV, [String])
prepareToReport :: String -> Config -> IO (CSV, [String])
prepareToReport String
inputFile 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
    case Maybe String
outputDir of
        Maybe String
Nothing -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Just String
dir -> Bool -> String -> IO ()
createDirectoryIfMissing Bool
True String
dir
    -- We assume the dataset is not big and therefore take liberties to process
    -- in a non-streaming fashion.
    Either ParseError CSV
csvData <- String -> IO (Either ParseError CSV)
parseCSVFromFile String
inputFile
    case Either ParseError CSV
csvData of
        Left ParseError
e -> String -> IO (CSV, [String])
forall a. HasCallStack => String -> a
error (String -> IO (CSV, [String])) -> String -> IO (CSV, [String])
forall a b. (a -> b) -> a -> b
$ ParseError -> String
forall a. Show a => a -> String
show ParseError
e
        Right CSV
csvlines -> do
            Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (CSV -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null CSV
csvlines) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
forall a. HasCallStack => String -> a
error (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"The input file ["
                String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
inputFile String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"] is empty"
            let allFields :: [String]
allFields = CSV -> [String]
forall a. [a] -> a
head CSV
csvlines
                fields :: [String]
fields = [String] -> [String]
selectFields [String]
allFields
            String -> [String] -> [String] -> IO ()
forall a. (Eq a, Show a) => String -> [a] -> [a] -> IO ()
filterSanity String
"selectFields" [String]
allFields [String]
fields
            let filt :: String -> Bool
filt String
x = String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
notElem ((Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
x) [String
"name", String
"iters"]
            (CSV, [String]) -> IO (CSV, [String])
forall (m :: * -> *) a. Monad m => a -> m a
return (CSV
csvlines, (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter String -> Bool
filt [String]
fields)

-- Keep only those benchmarks that belong to the group.
filterGroupBenchmarks :: [GroupMatrix] -> IO [GroupMatrix]
filterGroupBenchmarks :: [GroupMatrix] -> IO [GroupMatrix]
filterGroupBenchmarks [GroupMatrix]
matrices = [GroupMatrix] -> IO [GroupMatrix]
forall (m :: * -> *) a. Monad m => a -> m a
return ([GroupMatrix] -> IO [GroupMatrix])
-> [GroupMatrix] -> IO [GroupMatrix]
forall a b. (a -> b) -> a -> b
$ (GroupMatrix -> GroupMatrix) -> [GroupMatrix] -> [GroupMatrix]
forall a b. (a -> b) -> [a] -> [b]
map GroupMatrix -> GroupMatrix
filterMatrix [GroupMatrix]
matrices
    where
    filterMatrix :: GroupMatrix -> GroupMatrix
filterMatrix GroupMatrix
matrix =
        -- XXX make sure there are no duplicates
        let m :: BenchmarkMatrix
m = GroupMatrix -> BenchmarkMatrix
groupMatrix GroupMatrix
matrix
            vals :: [(String, [AnalyzedField])]
vals = ((String, String) -> (String, [AnalyzedField]))
-> [(String, String)] -> [(String, [AnalyzedField])]
forall a b. (a -> b) -> [a] -> [b]
map (\(String
new,String
old) ->
                (String
new, [AnalyzedField] -> Maybe [AnalyzedField] -> [AnalyzedField]
forall a. a -> Maybe a -> a
fromMaybe (String -> [AnalyzedField]
forall a. HasCallStack => String -> a
error String
"bug") (Maybe [AnalyzedField] -> [AnalyzedField])
-> Maybe [AnalyzedField] -> [AnalyzedField]
forall a b. (a -> b) -> a -> b
$ String -> [(String, [AnalyzedField])] -> Maybe [AnalyzedField]
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
old (BenchmarkMatrix -> [(String, [AnalyzedField])]
rowValues BenchmarkMatrix
m)))
                (GroupMatrix -> [(String, String)]
groupBenches GroupMatrix
matrix)
        in GroupMatrix
matrix {groupMatrix :: BenchmarkMatrix
groupMatrix = BenchmarkMatrix
m {rowValues :: [(String, [AnalyzedField])]
rowValues = [(String, [AnalyzedField])]
vals}}

_filterCommonSubsets :: [BenchmarkIterMatrix] -> [BenchmarkIterMatrix]
_filterCommonSubsets :: [BenchmarkIterMatrix] -> [BenchmarkIterMatrix]
_filterCommonSubsets [BenchmarkIterMatrix]
matrices =
    let commonPreds :: [(String, [[Double]])]
commonPreds =
            let initPreds :: [(String, [[Double]])]
initPreds = BenchmarkIterMatrix -> [(String, [[Double]])]
matrixPreds (BenchmarkIterMatrix -> [(String, [[Double]])])
-> BenchmarkIterMatrix -> [(String, [[Double]])]
forall a b. (a -> b) -> a -> b
$ [BenchmarkIterMatrix] -> BenchmarkIterMatrix
forall a. [a] -> a
head [BenchmarkIterMatrix]
matrices
            in ([(String, [[Double]])]
 -> BenchmarkIterMatrix -> [(String, [[Double]])])
-> [(String, [[Double]])]
-> [BenchmarkIterMatrix]
-> [(String, [[Double]])]
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' [(String, [[Double]])]
-> BenchmarkIterMatrix -> [(String, [[Double]])]
intersectPreds [(String, [[Double]])]
initPreds ([BenchmarkIterMatrix] -> [BenchmarkIterMatrix]
forall a. [a] -> [a]
tail [BenchmarkIterMatrix]
matrices)
    in (BenchmarkIterMatrix -> BenchmarkIterMatrix)
-> [BenchmarkIterMatrix] -> [BenchmarkIterMatrix]
forall a b. (a -> b) -> [a] -> [b]
map ([(String, [[Double]])]
-> BenchmarkIterMatrix -> BenchmarkIterMatrix
isectCommonPreds [(String, [[Double]])]
commonPreds) [BenchmarkIterMatrix]
matrices

    where

    pcols :: [String]
pcols = BenchmarkIterMatrix -> [String]
iterPredColNames (BenchmarkIterMatrix -> [String])
-> BenchmarkIterMatrix -> [String]
forall a b. (a -> b) -> a -> b
$ [BenchmarkIterMatrix] -> BenchmarkIterMatrix
forall a. [a] -> a
head [BenchmarkIterMatrix]
matrices

    cmpPred :: String -> a -> a -> Bool
cmpPred String
name a
v1 a
v2 =
            case (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
name of
                String
"iters" -> a
v1 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
v2
                String
"nivcsw" -> a
v1 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
v2
                String
_ -> a
v1 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
v2

    isectBench :: (a, [[a]]) -> (a, [[a]]) -> (a, [[a]])
isectBench (a
name1, [[a]]
preds1) (a
name2, [[a]]
preds2) =
        let isect :: [a] -> [a] -> Bool
isect [a]
row1 [a]
row2 = (Bool -> Bool) -> [Bool] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Bool -> Bool
forall a. a -> a
id ([Bool] -> Bool) -> [Bool] -> Bool
forall a b. (a -> b) -> a -> b
$ (String -> a -> a -> Bool) -> [String] -> [a] -> [a] -> [Bool]
forall a b c d. (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
zipWith3 String -> a -> a -> Bool
forall a. Eq a => String -> a -> a -> Bool
cmpPred [String]
pcols [a]
row1 [a]
row2
        in Bool -> (a, [[a]]) -> (a, [[a]])
forall a. HasCallStack => Bool -> a -> a
assert (a
name1 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
name2) ((a, [[a]]) -> (a, [[a]])) -> (a, [[a]]) -> (a, [[a]])
forall a b. (a -> b) -> a -> b
$ (a
name1, ([a] -> [a] -> Bool) -> [[a]] -> [[a]] -> [[a]]
forall a. (a -> a -> Bool) -> [a] -> [a] -> [a]
intersectBy [a] -> [a] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isect [[a]]
preds1 [[a]]
preds2)

    matrixPreds :: BenchmarkIterMatrix -> [(String, [[Double]])]
matrixPreds = ((String, [([Double], [Double])]) -> (String, [[Double]]))
-> [(String, [([Double], [Double])])] -> [(String, [[Double]])]
forall a b. (a -> b) -> [a] -> [b]
map (([([Double], [Double])] -> [[Double]])
-> (String, [([Double], [Double])]) -> (String, [[Double]])
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second ((([Double], [Double]) -> [Double])
-> [([Double], [Double])] -> [[Double]]
forall a b. (a -> b) -> [a] -> [b]
map ([Double], [Double]) -> [Double]
forall a b. (a, b) -> a
fst)) ([(String, [([Double], [Double])])] -> [(String, [[Double]])])
-> (BenchmarkIterMatrix -> [(String, [([Double], [Double])])])
-> BenchmarkIterMatrix
-> [(String, [[Double]])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BenchmarkIterMatrix -> [(String, [([Double], [Double])])]
iterRowValues

    intersectPreds :: [(String, [[Double]])]
-> BenchmarkIterMatrix -> [(String, [[Double]])]
intersectPreds [(String, [[Double]])]
preds BenchmarkIterMatrix
matrix = ((String, [[Double]])
 -> (String, [[Double]]) -> (String, [[Double]]))
-> [(String, [[Double]])]
-> [(String, [[Double]])]
-> [(String, [[Double]])]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (String, [[Double]])
-> (String, [[Double]]) -> (String, [[Double]])
forall a a. (Eq a, Eq a) => (a, [[a]]) -> (a, [[a]]) -> (a, [[a]])
isectBench [(String, [[Double]])]
preds (BenchmarkIterMatrix -> [(String, [[Double]])]
matrixPreds BenchmarkIterMatrix
matrix)

    isectRows :: (a, [[a]]) -> (a, t ([a], b)) -> (a, [([a], b)])
isectRows (a
name1, [[a]]
preds1) (a
name2, t ([a], b)
xs) =
        let isect :: [a] -> Maybe ([a], b)
isect [a]
row1 = (([a], b) -> Bool) -> t ([a], b) -> Maybe ([a], b)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\([a]
x,b
_) -> (Bool -> Bool) -> [Bool] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Bool -> Bool
forall a. a -> a
id
                                ([Bool] -> Bool) -> [Bool] -> Bool
forall a b. (a -> b) -> a -> b
$ (String -> a -> a -> Bool) -> [String] -> [a] -> [a] -> [Bool]
forall a b c d. (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
zipWith3 String -> a -> a -> Bool
forall a. Eq a => String -> a -> a -> Bool
cmpPred [String]
pcols [a]
row1 [a]
x) t ([a], b)
xs
        in Bool -> (a, [([a], b)]) -> (a, [([a], b)])
forall a. HasCallStack => Bool -> a -> a
assert (a
name1 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
name2) ((a, [([a], b)]) -> (a, [([a], b)]))
-> (a, [([a], b)]) -> (a, [([a], b)])
forall a b. (a -> b) -> a -> b
$ (a
name1, ([a] -> Maybe ([a], b)) -> [[a]] -> [([a], b)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe [a] -> Maybe ([a], b)
isect [[a]]
preds1)

    isectCommonPreds :: [(String, [[Double]])]
-> BenchmarkIterMatrix -> BenchmarkIterMatrix
isectCommonPreds [(String, [[Double]])]
preds matrix :: BenchmarkIterMatrix
matrix@BenchmarkIterMatrix{[String]
[(String, [([Double], [Double])])]
iterRowValues :: [(String, [([Double], [Double])])]
iterRespColNames :: [String]
iterPredColNames :: [String]
iterRowValues :: BenchmarkIterMatrix -> [(String, [([Double], [Double])])]
iterRespColNames :: BenchmarkIterMatrix -> [String]
iterPredColNames :: BenchmarkIterMatrix -> [String]
..} =
        BenchmarkIterMatrix
matrix
            { iterRowValues :: [(String, [([Double], [Double])])]
iterRowValues = ((String, [[Double]])
 -> (String, [([Double], [Double])])
 -> (String, [([Double], [Double])]))
-> [(String, [[Double]])]
-> [(String, [([Double], [Double])])]
-> [(String, [([Double], [Double])])]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (String, [[Double]])
-> (String, [([Double], [Double])])
-> (String, [([Double], [Double])])
forall a (t :: * -> *) a b.
(Eq a, Foldable t, Eq a) =>
(a, [[a]]) -> (a, t ([a], b)) -> (a, [([a], b)])
isectRows [(String, [[Double]])]
preds [(String, [([Double], [Double])])]
iterRowValues
            }

-- when comparing make sure all groups have same benchmarks and sort the other
-- ones based on the first column so that they are all in the same order.
selectCommon :: [GroupMatrix] -> IO [GroupMatrix]
selectCommon :: [GroupMatrix] -> IO [GroupMatrix]
selectCommon [GroupMatrix]
matrices =
    let commonBenches :: [String]
commonBenches =
            let initBenches :: [String]
initBenches = ((String, String) -> String) -> [(String, String)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, String) -> String
forall a b. (a, b) -> a
fst ([(String, String)] -> [String]) -> [(String, String)] -> [String]
forall a b. (a -> b) -> a -> b
$ GroupMatrix -> [(String, String)]
groupBenches (GroupMatrix -> [(String, String)])
-> GroupMatrix -> [(String, String)]
forall a b. (a -> b) -> a -> b
$ [GroupMatrix] -> GroupMatrix
forall a. [a] -> a
head [GroupMatrix]
matrices
            in ([String] -> GroupMatrix -> [String])
-> [String] -> [GroupMatrix] -> [String]
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' [String] -> GroupMatrix -> [String]
intersectBenches [String]
initBenches ([GroupMatrix] -> [GroupMatrix]
forall a. [a] -> [a]
tail [GroupMatrix]
matrices)
    in (GroupMatrix -> IO GroupMatrix)
-> [GroupMatrix] -> IO [GroupMatrix]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ([String] -> GroupMatrix -> IO GroupMatrix
isectCommonBenches [String]
commonBenches) [GroupMatrix]
matrices

    where

    intersectBenches :: [String] -> GroupMatrix -> [String]
intersectBenches [String]
benches GroupMatrix
matrix =
        [String] -> [String] -> [String]
forall a. Eq a => [a] -> [a] -> [a]
intersect [String]
benches (((String, String) -> String) -> [(String, String)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, String) -> String
forall a b. (a, b) -> a
fst ([(String, String)] -> [String]) -> [(String, String)] -> [String]
forall a b. (a -> b) -> a -> b
$ GroupMatrix -> [(String, String)]
groupBenches GroupMatrix
matrix)

    isectCommonBenches :: [String] -> GroupMatrix -> IO GroupMatrix
isectCommonBenches [String]
benches matrix :: GroupMatrix
matrix@GroupMatrix{Int
String
[(String, String)]
BenchmarkMatrix
groupMatrix :: BenchmarkMatrix
groupBenches :: [(String, String)]
groupName :: String
groupIndex :: Int
groupMatrix :: GroupMatrix -> BenchmarkMatrix
groupBenches :: GroupMatrix -> [(String, String)]
groupName :: GroupMatrix -> String
groupIndex :: GroupMatrix -> Int
..} = do
        let absent :: [String]
absent = ((String, String) -> String) -> [(String, String)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, String) -> String
forall a b. (a, b) -> a
fst [(String, String)]
groupBenches [String] -> [String] -> [String]
forall a. Eq a => [a] -> [a] -> [a]
\\ [String]
benches
            msg :: String
msg =
                String
"Removing benchmarks " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
forall a. Show a => a -> String
show [String]
absent
                String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" from column [" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
groupName
                String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"] run id [" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
groupIndex String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"]"
            lookupBench :: String -> Maybe String
lookupBench String
x = String -> [(String, String)] -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
x [(String, String)]
groupBenches
            findBench :: String -> (String, String)
findBench String
x = (String
x, String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
forall a. HasCallStack => a
undefined (String -> Maybe String
lookupBench String
x))
            newBenches :: [(String, String)]
newBenches = (String -> (String, String)) -> [String] -> [(String, String)]
forall a b. (a -> b) -> [a] -> [b]
map String -> (String, String)
findBench [String]
benches

        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
absent) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn String
msg
        GroupMatrix -> IO GroupMatrix
forall (m :: * -> *) a. Monad m => a -> m a
return GroupMatrix
matrix { groupBenches :: [(String, String)]
groupBenches = [(String, String)]
newBenches }

prepareGroupMatrices :: Config
                     -> FilePath
                     -> CSV
                     -> [String]
                     -> IO (Int, [GroupMatrix])
prepareGroupMatrices :: Config -> String -> CSV -> [String] -> IO (Int, [GroupMatrix])
prepareGroupMatrices 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
..} String
inputFile CSV
csvlines [String]
fields = do
    let res :: ([String], [NumberedLines])
res@([String]
_, [NumberedLines]
ls) =
              CSV -> NumberedLines
sanityCheckCSV CSV
csvlines
            NumberedLines
-> (NumberedLines -> ([String], [NumberedLines]))
-> ([String], [NumberedLines])
forall a b. a -> (a -> b) -> b
& NumberedLines -> ([String], [NumberedLines])
splitRuns

    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([NumberedLines] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [NumberedLines]
ls) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
        String -> IO ()
forall a. HasCallStack => String -> a
error (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"No benchmark results found in CSV file: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
inputFile

    let checkForData :: (a, t a) -> IO ()
checkForData (a
runId, t a
xs) =
            Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (t a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null t a
xs) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
                String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"No benchmark results found in the CSV file ["
                        String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
inputFile
                        String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"], for runId: "
                        String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
runId

    ((Int, NumberedLines) -> IO ()) -> [(Int, NumberedLines)] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Int, NumberedLines) -> IO ()
forall (t :: * -> *) a a. (Foldable t, Show a) => (a, t a) -> IO ()
checkForData ([Int] -> [NumberedLines] -> [(Int, NumberedLines)]
forall a b. [a] -> [b] -> [(a, b)]
zip [(Int
0 :: Int)..] [NumberedLines]
ls)

    let ([String]
hdr, [NumberedLines]
runs) = ([String], [NumberedLines]) -> ([String], [NumberedLines])
ensureIterField ([String], [NumberedLines])
res

    [BenchmarkMatrix]
xs <- [IO BenchmarkMatrix] -> IO [BenchmarkMatrix]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence ([IO BenchmarkMatrix] -> IO [BenchmarkMatrix])
-> [IO BenchmarkMatrix] -> IO [BenchmarkMatrix]
forall a b. (a -> b) -> a -> b
$ (NumberedLines -> BenchmarkIterMatrix)
-> [NumberedLines] -> [BenchmarkIterMatrix]
forall a b. (a -> b) -> [a] -> [b]
map ([String] -> NumberedLines -> BenchmarkIterMatrix
readIterations [String]
hdr) [NumberedLines]
runs
            [BenchmarkIterMatrix]
-> ([BenchmarkIterMatrix] -> [BenchmarkIterMatrix])
-> [BenchmarkIterMatrix]
forall a b. a -> (a -> b) -> b
& (BenchmarkIterMatrix -> BenchmarkIterMatrix)
-> [BenchmarkIterMatrix] -> [BenchmarkIterMatrix]
forall a b. (a -> b) -> [a] -> [b]
map ([String] -> BenchmarkIterMatrix -> BenchmarkIterMatrix
filterFields [String]
fields)
            -- & _filterCommonSubsets
            -- & map filterSamples
            [BenchmarkIterMatrix]
-> ([BenchmarkIterMatrix] -> [IO BenchmarkMatrix])
-> [IO BenchmarkMatrix]
forall a b. a -> (a -> b) -> b
& (BenchmarkIterMatrix -> IO BenchmarkMatrix)
-> [BenchmarkIterMatrix] -> [IO BenchmarkMatrix]
forall a b. (a -> b) -> [a] -> [b]
map BenchmarkIterMatrix -> IO BenchmarkMatrix
foldBenchmark

    [Int] -> [BenchmarkMatrix] -> [(Int, BenchmarkMatrix)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] [BenchmarkMatrix]
xs
        [(Int, BenchmarkMatrix)]
-> ([(Int, BenchmarkMatrix)] -> [[GroupMatrix]]) -> [[GroupMatrix]]
forall a b. a -> (a -> b) -> b
& ((Int, BenchmarkMatrix) -> [GroupMatrix])
-> [(Int, BenchmarkMatrix)] -> [[GroupMatrix]]
forall a b. (a -> b) -> [a] -> [b]
map ((String -> Maybe (String, String))
-> (Int, BenchmarkMatrix) -> [GroupMatrix]
splitGroup String -> Maybe (String, String)
classifyBenchmark)
        [[GroupMatrix]]
-> ([[GroupMatrix]] -> [GroupMatrix]) -> [GroupMatrix]
forall a b. a -> (a -> b) -> b
& [[GroupMatrix]] -> [GroupMatrix]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        [GroupMatrix]
-> ([GroupMatrix] -> IO [GroupMatrix]) -> IO [GroupMatrix]
forall a b. a -> (a -> b) -> b
& Config -> [GroupMatrix] -> IO [GroupMatrix]
sortGroups Config
cfg
        IO [GroupMatrix]
-> ([GroupMatrix] -> IO [GroupMatrix]) -> IO [GroupMatrix]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [GroupMatrix] -> IO [GroupMatrix]
selectCommon
        IO [GroupMatrix]
-> ([GroupMatrix] -> IO [GroupMatrix]) -> IO [GroupMatrix]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [GroupMatrix] -> IO [GroupMatrix]
filterGroupBenchmarks
        IO [GroupMatrix]
-> ([GroupMatrix] -> IO (Int, [GroupMatrix]))
-> IO (Int, [GroupMatrix])
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Int, [GroupMatrix]) -> IO (Int, [GroupMatrix])
forall (m :: * -> *) a. Monad m => a -> m a
return ((Int, [GroupMatrix]) -> IO (Int, [GroupMatrix]))
-> ([GroupMatrix] -> (Int, [GroupMatrix]))
-> [GroupMatrix]
-> IO (Int, [GroupMatrix])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([NumberedLines] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [NumberedLines]
runs,)

-- XXX display GHC version as well
-- XXX display the OS/arch
-- XXX display compiler/RTS options as well e.g. -threaded and -N
-- This data should be in the measurement data

data ReportColumn = ReportColumn
    { ReportColumn -> String
colName   :: String
    , ReportColumn -> RelativeUnit
colUnit   :: RelativeUnit
    , ReportColumn -> [Double]
colValues :: [Double]
    , ReportColumn -> [AnalyzedField]
colAnalyzed :: [AnalyzedField]
    } deriving Int -> ReportColumn -> String -> String
[ReportColumn] -> String -> String
ReportColumn -> String
(Int -> ReportColumn -> String -> String)
-> (ReportColumn -> String)
-> ([ReportColumn] -> String -> String)
-> Show ReportColumn
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [ReportColumn] -> String -> String
$cshowList :: [ReportColumn] -> String -> String
show :: ReportColumn -> String
$cshow :: ReportColumn -> String
showsPrec :: Int -> ReportColumn -> String -> String
$cshowsPrec :: Int -> ReportColumn -> String -> String
Show

data RawReport = RawReport
    { RawReport -> Maybe String
reportOutputFile :: Maybe FilePath
    , RawReport -> String
reportIdentifier :: String
    , RawReport -> [String]
reportRowIds     :: [String]
    , RawReport -> [ReportColumn]
reportColumns    :: [ReportColumn]
    , RawReport -> Maybe [[Estimator]]
reportEstimators :: Maybe [[Estimator]]
    } deriving Int -> RawReport -> String -> String
[RawReport] -> String -> String
RawReport -> String
(Int -> RawReport -> String -> String)
-> (RawReport -> String)
-> ([RawReport] -> String -> String)
-> Show RawReport
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [RawReport] -> String -> String
$cshowList :: [RawReport] -> String -> String
show :: RawReport -> String
$cshow :: RawReport -> String
showsPrec :: Int -> RawReport -> String -> String
$cshowsPrec :: Int -> RawReport -> String -> String
Show

getFieldMin :: Config -> Double -> String -> Double
getFieldMin :: Config -> Double -> String -> Double
getFieldMin Config
cfg Double
minval String
fieldName =
    case String -> Config -> Maybe (Double, Double)
getFieldRange String
fieldName Config
cfg of
        Maybe (Double, Double)
Nothing -> Double
minval
        Just (Double
minr, Double
_) -> Double
minr

scaleAnalyzedField :: RelativeUnit -> AnalyzedField -> AnalyzedField
scaleAnalyzedField :: RelativeUnit -> AnalyzedField -> AnalyzedField
scaleAnalyzedField (RelativeUnit String
_ Double
mult) AnalyzedField{Double
Maybe (Estimate ConfInt Double)
(Vector Double, Vector Double)
OutlierVariance
Outliers
analyzedRegRSq :: AnalyzedField -> Maybe (Estimate ConfInt Double)
analyzedRegCoeff :: AnalyzedField -> Maybe (Estimate ConfInt Double)
analyzedKDE :: AnalyzedField -> (Vector Double, Vector Double)
analyzedOutlierVar :: AnalyzedField -> OutlierVariance
analyzedOutliers :: AnalyzedField -> Outliers
analyzedMedian :: AnalyzedField -> Double
analyzedStdDev :: AnalyzedField -> Double
analyzedMean :: AnalyzedField -> Double
analyzedRegRSq :: Maybe (Estimate ConfInt Double)
analyzedRegCoeff :: Maybe (Estimate ConfInt Double)
analyzedKDE :: (Vector Double, Vector Double)
analyzedOutlierVar :: OutlierVariance
analyzedOutliers :: Outliers
analyzedMedian :: Double
analyzedStdDev :: Double
analyzedMean :: Double
..} =
    AnalyzedField :: Double
-> Double
-> Double
-> Outliers
-> OutlierVariance
-> (Vector Double, Vector Double)
-> Maybe (Estimate ConfInt Double)
-> Maybe (Estimate ConfInt Double)
-> AnalyzedField
AnalyzedField
    { analyzedMean :: Double
analyzedMean = Double
analyzedMean Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
mult
    , analyzedStdDev :: Double
analyzedStdDev = Double
analyzedStdDev Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
mult

    , analyzedMedian :: Double
analyzedMedian = Double
analyzedMedian Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
mult
    , analyzedOutliers :: Outliers
analyzedOutliers = Outliers
analyzedOutliers
    , analyzedOutlierVar :: OutlierVariance
analyzedOutlierVar = OutlierVariance
analyzedOutlierVar
    , analyzedKDE :: (Vector Double, Vector Double)
analyzedKDE = (Vector Double, Vector Double)
analyzedKDE
    , analyzedRegCoeff :: Maybe (Estimate ConfInt Double)
analyzedRegCoeff = case
        Maybe (Estimate ConfInt Double)
analyzedRegCoeff of
            Maybe (Estimate ConfInt Double)
Nothing -> Maybe (Estimate ConfInt Double)
forall a. Maybe a
Nothing
            Just Estimate{Double
ConfInt Double
estPoint :: forall (e :: * -> *) a. Estimate e a -> a
estError :: forall (e :: * -> *) a. Estimate e a -> e a
estError :: ConfInt Double
estPoint :: Double
..} ->
                let ConfInt{Double
CL Double
confIntLDX :: forall a. ConfInt a -> a
confIntUDX :: forall a. ConfInt a -> a
confIntCL :: forall a. ConfInt a -> CL Double
confIntCL :: CL Double
confIntUDX :: Double
confIntLDX :: Double
..} = ConfInt Double
estError
                in Estimate ConfInt Double -> Maybe (Estimate ConfInt Double)
forall a. a -> Maybe a
Just (Estimate ConfInt Double -> Maybe (Estimate ConfInt Double))
-> Estimate ConfInt Double -> Maybe (Estimate ConfInt Double)
forall a b. (a -> b) -> a -> b
$ Estimate :: forall (e :: * -> *) a. a -> e a -> Estimate e a
Estimate
                    { estPoint :: Double
estPoint = Double
estPoint Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
mult
                    , estError :: ConfInt Double
estError = ConfInt :: forall a. a -> a -> CL Double -> ConfInt a
ConfInt
                        { confIntLDX :: Double
confIntLDX = Double
confIntLDX Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
mult
                        , confIntUDX :: Double
confIntUDX = Double
confIntUDX Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
mult
                        , confIntCL :: CL Double
confIntCL = CL Double
confIntCL
                        }
                    }
    , analyzedRegRSq :: Maybe (Estimate ConfInt Double)
analyzedRegRSq = Maybe (Estimate ConfInt Double)
analyzedRegRSq
    }

prepareGroupsReport :: Config
                    -> GroupStyle
                    -> Maybe FilePath
                    -> ReportType
                    -> Int
                    -> String
                    -> [GroupMatrix]
                    -> Maybe RawReport
prepareGroupsReport :: Config
-> GroupStyle
-> Maybe String
-> ReportType
-> Int
-> String
-> [GroupMatrix]
-> Maybe RawReport
prepareGroupsReport 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
..} GroupStyle
style Maybe String
outfile ReportType
rtype Int
runs String
field [GroupMatrix]
matrices =
    -- XXX Determine the unit based the whole range of values across all columns
    let sortValues :: [String] -> [(String, a)] -> [a]
        sortValues :: [String] -> [(String, a)] -> [a]
sortValues [String]
bmarks [(String, a)]
vals =
            (String -> a) -> [String] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (\String
name -> a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe (String -> a
forall a. HasCallStack => String -> a
error String
"bug") (String -> [(String, a)] -> Maybe a
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
name [(String, a)]
vals)) [String]
bmarks

        unsortedCols :: [[(String, AnalyzedField)]]
unsortedCols = (GroupMatrix -> [(String, AnalyzedField)])
-> [GroupMatrix] -> [[(String, AnalyzedField)]]
forall a b. (a -> b) -> [a] -> [b]
map (String -> GroupMatrix -> [(String, AnalyzedField)]
extractColumn String
field) [GroupMatrix]
matrices

        (Maybe [[Estimator]]
estimators, [[(String, Double)]]
transformedCols) =
            ReportType
-> GroupStyle
-> Estimator
-> DiffStrategy
-> [[(String, AnalyzedField)]]
-> (Maybe [[Estimator]], [[(String, Double)]])
cmpTransformColumns ReportType
rtype GroupStyle
style Estimator
estimator DiffStrategy
diffStrategy [[(String, AnalyzedField)]]
unsortedCols
        transformedColsByStyle :: GroupStyle -> [[(String, Double)]]
transformedColsByStyle GroupStyle
s = (Maybe [[Estimator]], [[(String, Double)]]) -> [[(String, Double)]]
forall a b. (a, b) -> b
snd ((Maybe [[Estimator]], [[(String, Double)]])
 -> [[(String, Double)]])
-> (Maybe [[Estimator]], [[(String, Double)]])
-> [[(String, Double)]]
forall a b. (a -> b) -> a -> b
$
            ReportType
-> GroupStyle
-> Estimator
-> DiffStrategy
-> [[(String, AnalyzedField)]]
-> (Maybe [[Estimator]], [[(String, Double)]])
cmpTransformColumns ReportType
rtype GroupStyle
s Estimator
estimator DiffStrategy
diffStrategy [[(String, AnalyzedField)]]
unsortedCols

        benchmarks :: [String]
benchmarks = Config
-> [GroupMatrix]
-> [[(String, Double)]]
-> (GroupStyle -> [[(String, Double)]])
-> [String]
selectBenchmarksByField Config
cfg [GroupMatrix]
matrices
                            [[(String, Double)]]
transformedCols GroupStyle -> [[(String, Double)]]
transformedColsByStyle
        sortedCols :: [[Double]]
sortedCols = ([(String, Double)] -> [Double])
-> [[(String, Double)]] -> [[Double]]
forall a b. (a -> b) -> [a] -> [b]
map ([String] -> [(String, Double)] -> [Double]
forall a. [String] -> [(String, a)] -> [a]
sortValues [String]
benchmarks) [[(String, Double)]]
transformedCols
        origSortedCols :: [[AnalyzedField]]
origSortedCols = ([(String, AnalyzedField)] -> [AnalyzedField])
-> [[(String, AnalyzedField)]] -> [[AnalyzedField]]
forall a b. (a -> b) -> [a] -> [b]
map ([String] -> [(String, AnalyzedField)] -> [AnalyzedField]
forall a. [String] -> [(String, a)] -> [a]
sortValues [String]
benchmarks) [[(String, AnalyzedField)]]
unsortedCols

        mkColUnits :: [RelativeUnit]
        mkColUnits :: [RelativeUnit]
mkColUnits =
            let cols :: [[Double]]
cols =
                    if GroupStyle
style GroupStyle -> GroupStyle -> Bool
forall a. Eq a => a -> a -> Bool
/= GroupStyle
Absolute
                    -- if we consider diff values as well here then the
                    -- units will change to potentially very small.
                    then [[[Double]] -> [Double]
forall a. [a] -> a
head [[Double]]
sortedCols]
                    else [[Double]]
sortedCols
                minVal :: Double
minVal = Config -> Double -> String -> Double
getFieldMin Config
cfg ([Double] -> Double
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum ([Double] -> Double) -> [Double] -> Double
forall a b. (a -> b) -> a -> b
$ [[Double]] -> [Double]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Double]]
cols) String
field
                mkPercentColUnitText :: [RelativeUnit]
mkPercentColUnitText =
                    let unit :: RelativeUnit
unit = String -> Double -> GroupStyle -> RelativeUnit
fieldUnits String
field Double
minVal GroupStyle
Absolute
                        punit :: RelativeUnit
punit = String -> Double -> GroupStyle -> RelativeUnit
fieldUnits String
field Double
1 GroupStyle
style -- % unit
                    in RelativeUnit
unit RelativeUnit -> [RelativeUnit] -> [RelativeUnit]
forall a. a -> [a] -> [a]
: Int -> RelativeUnit -> [RelativeUnit]
forall a. Int -> a -> [a]
replicate ([GroupMatrix] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [GroupMatrix]
matrices Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) RelativeUnit
punit
                mkPercentColUnitGraph :: [RelativeUnit]
mkPercentColUnitGraph = [String -> Double -> GroupStyle -> RelativeUnit
fieldUnits String
field Double
minVal GroupStyle
Absolute]
                mkAbsoluteUnit :: [RelativeUnit]
mkAbsoluteUnit =
                     let unit :: RelativeUnit
unit = String -> Double -> GroupStyle -> RelativeUnit
fieldUnits String
field Double
minVal GroupStyle
style
                     in Int -> RelativeUnit -> [RelativeUnit]
forall a. Int -> a -> [a]
replicate ([GroupMatrix] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [GroupMatrix]
matrices) RelativeUnit
unit
            in case (ReportType
rtype, GroupStyle
style) of
                -- In case of percentDiff in TextReport we use absolute
                -- values in the baseline column, so the unit is different.
                (ReportType
_, GroupStyle
Absolute)   -> [RelativeUnit]
mkAbsoluteUnit
                (ReportType
_, GroupStyle
Diff)       -> [RelativeUnit]
mkAbsoluteUnit
                (ReportType
TextReport, GroupStyle
_) -> [RelativeUnit]
mkPercentColUnitText
                (ReportType
GraphicalChart, GroupStyle
_) | [GroupMatrix] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [GroupMatrix]
matrices Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 ->
                    [RelativeUnit]
mkPercentColUnitGraph
                (ReportType
GraphicalChart, GroupStyle
_) -> [RelativeUnit]
mkAbsoluteUnit

        mkColValues :: [[Double]]
        mkColValues :: [[Double]]
mkColValues =
            let applyUnit :: [Double] -> RelativeUnit -> [Double]
applyUnit [Double]
col (RelativeUnit String
_ Double
multiplier) =
                    (Double -> Double) -> [Double] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map (Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
multiplier) [Double]
col
            in ([Double] -> RelativeUnit -> [Double])
-> [[Double]] -> [RelativeUnit] -> [[Double]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith [Double] -> RelativeUnit -> [Double]
applyUnit [[Double]]
sortedCols [RelativeUnit]
mkColUnits

        mkColNames :: [String]
        mkColNames :: [String]
mkColNames =
                let withSuffix :: GroupMatrix -> String
withSuffix GroupMatrix
x =
                        GroupMatrix -> String
groupName GroupMatrix
x String -> String -> String
forall a. [a] -> [a] -> [a]
++
                            if Int
runs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1
                            then String
"(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (GroupMatrix -> Int
groupIndex GroupMatrix
x) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
                            else String
""
                in (GroupMatrix -> String) -> [GroupMatrix] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map GroupMatrix -> String
withSuffix [GroupMatrix]
matrices

        columns :: [ReportColumn]
columns =
            ZipList ReportColumn -> [ReportColumn]
forall a. ZipList a -> [a]
getZipList
                (ZipList ReportColumn -> [ReportColumn])
-> ZipList ReportColumn -> [ReportColumn]
forall a b. (a -> b) -> a -> b
$ (\String
n RelativeUnit
u [Double]
v [AnalyzedField]
a ->
                       String
-> RelativeUnit -> [Double] -> [AnalyzedField] -> ReportColumn
ReportColumn String
n RelativeUnit
u [Double]
v ((AnalyzedField -> AnalyzedField)
-> [AnalyzedField] -> [AnalyzedField]
forall a b. (a -> b) -> [a] -> [b]
map (RelativeUnit -> AnalyzedField -> AnalyzedField
scaleAnalyzedField RelativeUnit
u) [AnalyzedField]
a))
                    (String
 -> RelativeUnit -> [Double] -> [AnalyzedField] -> ReportColumn)
-> ZipList String
-> ZipList
     (RelativeUnit -> [Double] -> [AnalyzedField] -> ReportColumn)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String] -> ZipList String
forall a. [a] -> ZipList a
ZipList [String]
mkColNames
                    ZipList
  (RelativeUnit -> [Double] -> [AnalyzedField] -> ReportColumn)
-> ZipList RelativeUnit
-> ZipList ([Double] -> [AnalyzedField] -> ReportColumn)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [RelativeUnit] -> ZipList RelativeUnit
forall a. [a] -> ZipList a
ZipList [RelativeUnit]
mkColUnits
                    ZipList ([Double] -> [AnalyzedField] -> ReportColumn)
-> ZipList [Double] -> ZipList ([AnalyzedField] -> ReportColumn)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [[Double]] -> ZipList [Double]
forall a. [a] -> ZipList a
ZipList [[Double]]
mkColValues
                    ZipList ([AnalyzedField] -> ReportColumn)
-> ZipList [AnalyzedField] -> ZipList ReportColumn
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [[AnalyzedField]] -> ZipList [AnalyzedField]
forall a. [a] -> ZipList a
ZipList [[AnalyzedField]]
origSortedCols

        removeBaseline :: [a] -> [a]
removeBaseline [a]
xs =
            let rel :: Bool
rel = case GroupStyle
style of
                        GroupStyle
Absolute -> Bool
False
                        GroupStyle
Diff -> Bool
False
                        GroupStyle
PercentDiff -> Bool
True
                        GroupStyle
Multiples -> Bool
True
            in if Bool
omitBaseline Bool -> Bool -> Bool
&& Bool
rel Bool -> Bool -> Bool
&& [GroupMatrix] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [GroupMatrix]
matrices Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1
               then [a] -> [a]
forall a. [a] -> [a]
tail [a]
xs
               else [a]
xs

    in if [String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
benchmarks Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
       then RawReport -> Maybe RawReport
forall a. a -> Maybe a
Just (RawReport -> Maybe RawReport) -> RawReport -> Maybe RawReport
forall a b. (a -> b) -> a -> b
$ RawReport :: Maybe String
-> String
-> [String]
-> [ReportColumn]
-> Maybe [[Estimator]]
-> RawReport
RawReport
                { reportOutputFile :: Maybe String
reportOutputFile = Maybe String
outfile
                , reportIdentifier :: String
reportIdentifier = String
field
                , reportRowIds :: [String]
reportRowIds     = [String]
benchmarks
                , reportColumns :: [ReportColumn]
reportColumns    = [ReportColumn] -> [ReportColumn]
forall a. [a] -> [a]
removeBaseline
                    ([ReportColumn] -> [ReportColumn])
-> [ReportColumn] -> [ReportColumn]
forall a b. (a -> b) -> a -> b
$ [RelativeUnit] -> [ReportColumn] -> [ReportColumn]
columnNameByUnit [RelativeUnit]
mkColUnits
                    ([ReportColumn] -> [ReportColumn])
-> [ReportColumn] -> [ReportColumn]
forall a b. (a -> b) -> a -> b
$ GroupStyle -> [ReportColumn] -> [ReportColumn]
columnNameByStyle GroupStyle
style [ReportColumn]
columns
                , reportEstimators :: Maybe [[Estimator]]
reportEstimators = ([[Estimator]] -> [[Estimator]])
-> Maybe [[Estimator]] -> Maybe [[Estimator]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [[Estimator]] -> [[Estimator]]
forall a. [a] -> [a]
removeBaseline Maybe [[Estimator]]
estimators
                }
       else Maybe RawReport
forall a. Maybe a
Nothing

showStatusMessage :: Show a => Config -> String -> Maybe a -> IO ()
showStatusMessage :: Config -> String -> Maybe a -> IO ()
showStatusMessage Config
cfg String
field Maybe a
outfile =
    let atitle :: String
atitle = case Config -> Maybe (String -> String)
mkTitle Config
cfg of
                    Just String -> String
f -> String
" [" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
f String
field String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"]"
                    Maybe (String -> String)
Nothing ->
                        String
" [" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> Maybe String -> Config -> String
makeTitle String
field (Presentation -> DiffStrategy -> Maybe String
diffString (Config -> Presentation
presentation Config
cfg)
                                 (Config -> DiffStrategy
diffStrategy Config
cfg)) Config
cfg String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"]"
    in case Maybe a
outfile of
        Just a
path ->
            String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Creating chart"
                String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
atitle
                String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" at "
                String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
path
        Maybe a
Nothing -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

reportComparingGroups
    :: GroupStyle
    -> FilePath
    -> Maybe FilePath
    -> ReportType
    -> Int
    -> Config
    -> (RawReport -> Config -> IO ())
    -> [GroupMatrix]
    -> String
    -> IO ()
reportComparingGroups :: GroupStyle
-> String
-> Maybe String
-> ReportType
-> Int
-> Config
-> (RawReport -> Config -> IO ())
-> [GroupMatrix]
-> String
-> IO ()
reportComparingGroups GroupStyle
style String
dir Maybe String
outputFile ReportType
rtype Int
runs 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
..} RawReport -> Config -> IO ()
mkReport [GroupMatrix]
matrices String
field = do
    let outfile :: Maybe String
outfile = case Maybe String
outputFile of
            Just String
file -> String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ String -> ReportType -> String -> Estimator -> String -> String
prepareOutputFile String
dir ReportType
rtype String
file
                                            Estimator
estimator String
field
            Maybe String
Nothing -> Maybe String
forall a. Maybe a
Nothing
        mRawReport :: Maybe RawReport
mRawReport = Config
-> GroupStyle
-> Maybe String
-> ReportType
-> Int
-> String
-> [GroupMatrix]
-> Maybe RawReport
prepareGroupsReport Config
cfg GroupStyle
style Maybe String
outfile ReportType
rtype Int
runs String
field [GroupMatrix]
matrices
    -- Don't make report if it is empty
    case Maybe RawReport
mRawReport of
        Just RawReport
rawReport -> do
            Config -> String -> Maybe String -> IO ()
forall a. Show a => Config -> String -> Maybe a -> IO ()
showStatusMessage Config
cfg String
field Maybe String
outfile
            RawReport -> Config -> IO ()
mkReport RawReport
rawReport Config
cfg
        Maybe RawReport
Nothing -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- Prepare report for a given group, the report would consist of multiple
-- field columns.
prepareFieldsReport :: Config
                 -> Maybe FilePath
                 -> GroupMatrix
                 -> Maybe RawReport
prepareFieldsReport :: Config -> Maybe String -> GroupMatrix -> Maybe RawReport
prepareFieldsReport 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
..} Maybe String
outfile GroupMatrix
group =
    let mkColNames :: [String]
        mkColNames :: [String]
mkColNames = BenchmarkMatrix -> [String]
colNames (BenchmarkMatrix -> [String]) -> BenchmarkMatrix -> [String]
forall a b. (a -> b) -> a -> b
$ GroupMatrix -> BenchmarkMatrix
groupMatrix GroupMatrix
group

        benchmarks :: [String]
benchmarks = Config -> GroupMatrix -> [String]
selectBenchmarksByGroup Config
cfg GroupMatrix
group

        getBenchValues :: String -> [AnalyzedField]
getBenchValues String
name =
              [AnalyzedField] -> Maybe [AnalyzedField] -> [AnalyzedField]
forall a. a -> Maybe a -> a
fromMaybe (String -> [AnalyzedField]
forall a. HasCallStack => String -> a
error String
"bug") (Maybe [AnalyzedField] -> [AnalyzedField])
-> Maybe [AnalyzedField] -> [AnalyzedField]
forall a b. (a -> b) -> a -> b
$
                String -> [(String, [AnalyzedField])] -> Maybe [AnalyzedField]
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
name (BenchmarkMatrix -> [(String, [AnalyzedField])]
rowValues (BenchmarkMatrix -> [(String, [AnalyzedField])])
-> BenchmarkMatrix -> [(String, [AnalyzedField])]
forall a b. (a -> b) -> a -> b
$ GroupMatrix -> BenchmarkMatrix
groupMatrix GroupMatrix
group)

        sortedCols :: [[AnalyzedField]]
sortedCols = [[AnalyzedField]] -> [[AnalyzedField]]
forall a. [[a]] -> [[a]]
transpose ([[AnalyzedField]] -> [[AnalyzedField]])
-> [[AnalyzedField]] -> [[AnalyzedField]]
forall a b. (a -> b) -> a -> b
$ (String -> [AnalyzedField]) -> [String] -> [[AnalyzedField]]
forall a b. (a -> b) -> [a] -> [b]
map String -> [AnalyzedField]
getBenchValues [String]
benchmarks
        minColValues :: [Double]
minColValues = ([AnalyzedField] -> Double) -> [[AnalyzedField]] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map ([Double] -> Double
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum ([Double] -> Double)
-> ([AnalyzedField] -> [Double]) -> [AnalyzedField] -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AnalyzedField -> Double) -> [AnalyzedField] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map (Estimator -> AnalyzedField -> Double
getAnalyzedValue Estimator
estimator))
                           [[AnalyzedField]]
sortedCols

        mkColUnits :: [RelativeUnit]
        mkColUnits :: [RelativeUnit]
mkColUnits = ((String, Double) -> RelativeUnit)
-> [(String, Double)] -> [RelativeUnit]
forall a b. (a -> b) -> [a] -> [b]
map (\(String
x, Double
v) -> String -> Double -> RelativeUnit
getUnitByFieldName String
x (Config -> Double -> String -> Double
getFieldMin Config
cfg Double
v String
x))
                         ([String] -> [Double] -> [(String, Double)]
forall a b. [a] -> [b] -> [(a, b)]
zip [String]
mkColNames [Double]
minColValues)

        mkColValues :: [[Double]]
        mkColValues :: [[Double]]
mkColValues =
            let scaleCol :: RelativeUnit -> [Double] -> [Double]
scaleCol (RelativeUnit String
_ Double
multiplier) = (Double -> Double) -> [Double] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map (Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
multiplier)
            in  (RelativeUnit -> [Double] -> [Double])
-> [RelativeUnit] -> [[Double]] -> [[Double]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith RelativeUnit -> [Double] -> [Double]
scaleCol [RelativeUnit]
mkColUnits
                    (([AnalyzedField] -> [Double]) -> [[AnalyzedField]] -> [[Double]]
forall a b. (a -> b) -> [a] -> [b]
map ((AnalyzedField -> Double) -> [AnalyzedField] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map (Estimator -> AnalyzedField -> Double
getAnalyzedValue Estimator
estimator)) [[AnalyzedField]]
sortedCols)

        addUnitLabel :: String -> RelativeUnit -> String
addUnitLabel String
name (RelativeUnit String
label Double
_) =
            if String
label String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= []
            then String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
inParens String
label
            else String
name
        withUnits :: [String] -> [String]
withUnits [String]
xs = (String -> RelativeUnit -> String)
-> [String] -> [RelativeUnit] -> [String]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith String -> RelativeUnit -> String
addUnitLabel [String]
xs [RelativeUnit]
mkColUnits

        columns :: [ReportColumn]
columns = ZipList ReportColumn -> [ReportColumn]
forall a. ZipList a -> [a]
getZipList (ZipList ReportColumn -> [ReportColumn])
-> ZipList ReportColumn -> [ReportColumn]
forall a b. (a -> b) -> a -> b
$ String
-> RelativeUnit -> [Double] -> [AnalyzedField] -> ReportColumn
ReportColumn
                (String
 -> RelativeUnit -> [Double] -> [AnalyzedField] -> ReportColumn)
-> ZipList String
-> ZipList
     (RelativeUnit -> [Double] -> [AnalyzedField] -> ReportColumn)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String] -> ZipList String
forall a. [a] -> ZipList a
ZipList ([String] -> [String]
withUnits [String]
mkColNames)
                ZipList
  (RelativeUnit -> [Double] -> [AnalyzedField] -> ReportColumn)
-> ZipList RelativeUnit
-> ZipList ([Double] -> [AnalyzedField] -> ReportColumn)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [RelativeUnit] -> ZipList RelativeUnit
forall a. [a] -> ZipList a
ZipList [RelativeUnit]
mkColUnits
                ZipList ([Double] -> [AnalyzedField] -> ReportColumn)
-> ZipList [Double] -> ZipList ([AnalyzedField] -> ReportColumn)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [[Double]] -> ZipList [Double]
forall a. [a] -> ZipList a
ZipList [[Double]]
mkColValues
                ZipList ([AnalyzedField] -> ReportColumn)
-> ZipList [AnalyzedField] -> ZipList ReportColumn
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [[AnalyzedField]] -> ZipList [AnalyzedField]
forall a. [a] -> ZipList a
ZipList [[AnalyzedField]]
sortedCols

    in if [String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
benchmarks Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
       then RawReport -> Maybe RawReport
forall a. a -> Maybe a
Just (RawReport -> Maybe RawReport) -> RawReport -> Maybe RawReport
forall a b. (a -> b) -> a -> b
$ RawReport :: Maybe String
-> String
-> [String]
-> [ReportColumn]
-> Maybe [[Estimator]]
-> RawReport
RawReport
                { reportOutputFile :: Maybe String
reportOutputFile = Maybe String
outfile
                , reportIdentifier :: String
reportIdentifier = GroupMatrix -> String
groupName GroupMatrix
group
                , reportRowIds :: [String]
reportRowIds     = [String]
benchmarks
                , reportColumns :: [ReportColumn]
reportColumns    = [ReportColumn]
columns
                , reportEstimators :: Maybe [[Estimator]]
reportEstimators = Maybe [[Estimator]]
forall a. Maybe a
Nothing
                }
       else Maybe RawReport
forall a. Maybe a
Nothing

reportPerGroup
    :: FilePath
    -> Maybe FilePath
    -> ReportType
    -> Config
    -> (RawReport -> Config -> IO ())
    -> GroupMatrix
    -> IO ()
reportPerGroup :: String
-> Maybe String
-> ReportType
-> Config
-> (RawReport -> Config -> IO ())
-> GroupMatrix
-> IO ()
reportPerGroup String
dir Maybe String
outputFile ReportType
rtype 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
..} RawReport -> Config -> IO ()
mkReport GroupMatrix
group = do
    let outfile :: Maybe String
outfile = case Maybe String
outputFile of
            Just String
file -> String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ String -> ReportType -> String -> Estimator -> String -> String
prepareOutputFile String
dir ReportType
rtype String
file
                                            Estimator
estimator (GroupMatrix -> String
groupName GroupMatrix
group)
            Maybe String
Nothing -> Maybe String
forall a. Maybe a
Nothing
        mRawReport :: Maybe RawReport
mRawReport = Config -> Maybe String -> GroupMatrix -> Maybe RawReport
prepareFieldsReport Config
cfg Maybe String
outfile GroupMatrix
group
    -- Don't make report if it is empty
    case Maybe RawReport
mRawReport of
        Just RawReport
rawReport -> do
            Config -> String -> Maybe String -> IO ()
forall a. Show a => Config -> String -> Maybe a -> IO ()
showStatusMessage Config
cfg (GroupMatrix -> String
groupName GroupMatrix
group) Maybe String
outfile
            RawReport -> Config -> IO ()
mkReport RawReport
rawReport Config
cfg
        Maybe RawReport
Nothing -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-------------------------------------------------------------------------------
-- Utility functions
-------------------------------------------------------------------------------

showDiffStrategy :: DiffStrategy -> String
showDiffStrategy :: DiffStrategy -> String
showDiffStrategy DiffStrategy
s =
    case DiffStrategy
s of
        DiffStrategy
SingleEstimator -> String
""
        DiffStrategy
MinEstimator -> String
"using min estimator"

diffString :: Presentation -> DiffStrategy -> Maybe String
diffString :: Presentation -> DiffStrategy -> Maybe String
diffString Presentation
style DiffStrategy
s =
    case Presentation
style of
        Groups GroupStyle
Diff -> String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ String
"Diff from Baseline " String -> String -> String
forall a. [a] -> [a] -> [a]
++ DiffStrategy -> String
showDiffStrategy DiffStrategy
s
        Groups GroupStyle
PercentDiff -> String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ String
"Diff % of Lower " String -> String -> String
forall a. [a] -> [a] -> [a]
++ DiffStrategy -> String
showDiffStrategy DiffStrategy
s
        Groups GroupStyle
Multiples -> String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ String
"Multiples of Baseline " String -> String -> String
forall a. [a] -> [a] -> [a]
++ DiffStrategy -> String
showDiffStrategy DiffStrategy
s
        Groups GroupStyle
Absolute -> Maybe String
forall a. Maybe a
Nothing
        Presentation
Solo -> Maybe String
forall a. Maybe a
Nothing
        Presentation
Fields -> Maybe String
forall a. Maybe a
Nothing

inParens :: String -> String
inParens :: String -> String
inParens String
str = String
"(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
str String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"

showEstimator :: Estimator -> String
showEstimator :: Estimator -> String
showEstimator Estimator
est =
    case Estimator
est of
        Estimator
Mean       -> String
"Mean"
        Estimator
Median     -> String
"Median"
        Estimator
Regression -> String
"Regression Coeff."

addAnnotation :: String -> Maybe String -> Config -> TitleAnnotation -> String
addAnnotation :: String -> Maybe String -> Config -> TitleAnnotation -> String
addAnnotation String
field Maybe String
diff 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
..} TitleAnnotation
annot =
      String -> String
inParens
    (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ case TitleAnnotation
annot of
        TitleAnnotation
TitleField -> String
field
        TitleAnnotation
TitleEstimator -> Estimator -> String
showEstimator Estimator
estimator
        TitleAnnotation
TitleDiff -> String -> (String -> String) -> Maybe String -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" String -> String
inParens Maybe String
diff

makeTitle :: String -> Maybe String -> Config -> String
makeTitle :: String -> Maybe String -> Config -> String
makeTitle String
field Maybe String
diff 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
..} =
       String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"" Maybe String
title
       String -> String -> String
forall a. [a] -> [a] -> [a]
++ (TitleAnnotation -> String) -> [TitleAnnotation] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (String -> Maybe String -> Config -> TitleAnnotation -> String
addAnnotation String
field Maybe String
diff Config
cfg) [TitleAnnotation]
titleAnnotations