{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE OverloadedStrings #-}

-- | Reporting on performance, potentially checking versus a canned results.
module Perf.Report
  ( Name,
    Header (..),
    parseHeader,
    CompareLevels (..),
    defaultCompareLevels,
    parseCompareLevels,
    ReportOptions (..),
    defaultReportOptions,
    parseReportOptions,
    PerfDumpOptions (..),
    defaultPerfDumpOptions,
    parsePerfDumpOptions,
    fromDump,
    report,
    reportMain,
    writeResult,
    readResult,
    CompareResult (..),
    compareNote,
    report2D,
    Golden (..),
    defaultGolden,
    parseGolden,
    replaceDefaultFilePath,
    parseClock,
    reportToConsole,
  )
where

import Chart
import Control.Exception
import Control.Monad
import Data.Bool
import Data.Foldable
import Data.List (intercalate)
import Data.List qualified as List
import Data.Map.Merge.Strict
import Data.Map.Strict qualified as Map
import Data.Text (Text)
import Data.Text qualified as Text
import Data.Text.IO qualified as Text
import GHC.Generics
import Optics.Core
import Options.Applicative as OA
import Options.Applicative.Help.Pretty
import Perf.Algos
import Perf.BigO
import Perf.Chart
import Perf.Measure
import Perf.Stats
import Perf.Time (defaultClock)
import Perf.Types
import Prettyprinter.Render.Text qualified as PP
import System.Clock
import System.Exit
import System.Mem
import Test.Tasty
import Test.Tasty.Bench
import Text.PrettyPrint.Boxes qualified as B
import Text.Printf hiding (parseFormat)
import Text.Read

-- | Benchmark name
type Name = String

-- | Whether to include header information.
data Header = Header | NoHeader deriving (Header -> Header -> Bool
(Header -> Header -> Bool)
-> (Header -> Header -> Bool) -> Eq Header
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Header -> Header -> Bool
== :: Header -> Header -> Bool
$c/= :: Header -> Header -> Bool
/= :: Header -> Header -> Bool
Eq, Int -> Header -> ShowS
[Header] -> ShowS
Header -> FilePath
(Int -> Header -> ShowS)
-> (Header -> FilePath) -> ([Header] -> ShowS) -> Show Header
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Header -> ShowS
showsPrec :: Int -> Header -> ShowS
$cshow :: Header -> FilePath
show :: Header -> FilePath
$cshowList :: [Header] -> ShowS
showList :: [Header] -> ShowS
Show, (forall x. Header -> Rep Header x)
-> (forall x. Rep Header x -> Header) -> Generic Header
forall x. Rep Header x -> Header
forall x. Header -> Rep Header x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Header -> Rep Header x
from :: forall x. Header -> Rep Header x
$cto :: forall x. Rep Header x -> Header
to :: forall x. Rep Header x -> Header
Generic)

-- | Command-line parser for 'Header'
parseHeader :: Parser Header
parseHeader :: Parser Header
parseHeader =
  Header -> Mod FlagFields Header -> Parser Header
forall a. a -> Mod FlagFields a -> Parser a
flag' Header
Header (FilePath -> Mod FlagFields Header
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"header" Mod FlagFields Header
-> Mod FlagFields Header -> Mod FlagFields Header
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod FlagFields Header
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"include headers in reporting")
    Parser Header -> Parser Header -> Parser Header
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Header -> Mod FlagFields Header -> Parser Header
forall a. a -> Mod FlagFields a -> Parser a
flag' Header
NoHeader (FilePath -> Mod FlagFields Header
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"noheader" Mod FlagFields Header
-> Mod FlagFields Header -> Mod FlagFields Header
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod FlagFields Header
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"dont include headers in reporting")
    Parser Header -> Parser Header -> Parser Header
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Header -> Parser Header
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Header
Header

-- | Options for production of a performance report.
data ReportOptions = ReportOptions
  { -- | Number of times to run a benchmark.
    ReportOptions -> Int
reportN :: Int,
    ReportOptions -> Int
reportLength :: Int,
    ReportOptions -> Clock
reportClock :: Clock,
    ReportOptions -> StatDType
reportStatDType :: StatDType,
    ReportOptions -> MeasureType
reportMeasureType :: MeasureType,
    ReportOptions -> Golden
reportGolden :: Golden,
    ReportOptions -> Header
reportHeader :: Header,
    ReportOptions -> CompareLevels
reportCompare :: CompareLevels,
    ReportOptions -> PerfChartOptions
reportChart :: PerfChartOptions,
    ReportOptions -> PerfDumpOptions
reportDump :: PerfDumpOptions,
    ReportOptions -> Bool
reportGC :: Bool,
    ReportOptions -> OrderOptions
reportOrder :: OrderOptions,
    ReportOptions -> Bool
reportTasty :: Bool
  }
  deriving (ReportOptions -> ReportOptions -> Bool
(ReportOptions -> ReportOptions -> Bool)
-> (ReportOptions -> ReportOptions -> Bool) -> Eq ReportOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ReportOptions -> ReportOptions -> Bool
== :: ReportOptions -> ReportOptions -> Bool
$c/= :: ReportOptions -> ReportOptions -> Bool
/= :: ReportOptions -> ReportOptions -> Bool
Eq, Int -> ReportOptions -> ShowS
[ReportOptions] -> ShowS
ReportOptions -> FilePath
(Int -> ReportOptions -> ShowS)
-> (ReportOptions -> FilePath)
-> ([ReportOptions] -> ShowS)
-> Show ReportOptions
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ReportOptions -> ShowS
showsPrec :: Int -> ReportOptions -> ShowS
$cshow :: ReportOptions -> FilePath
show :: ReportOptions -> FilePath
$cshowList :: [ReportOptions] -> ShowS
showList :: [ReportOptions] -> ShowS
Show, (forall x. ReportOptions -> Rep ReportOptions x)
-> (forall x. Rep ReportOptions x -> ReportOptions)
-> Generic ReportOptions
forall x. Rep ReportOptions x -> ReportOptions
forall x. ReportOptions -> Rep ReportOptions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ReportOptions -> Rep ReportOptions x
from :: forall x. ReportOptions -> Rep ReportOptions x
$cto :: forall x. Rep ReportOptions x -> ReportOptions
to :: forall x. Rep ReportOptions x -> ReportOptions
Generic)

-- | Default reporting options
defaultReportOptions :: ReportOptions
defaultReportOptions :: ReportOptions
defaultReportOptions =
  Int
-> Int
-> Clock
-> StatDType
-> MeasureType
-> Golden
-> Header
-> CompareLevels
-> PerfChartOptions
-> PerfDumpOptions
-> Bool
-> OrderOptions
-> Bool
-> ReportOptions
ReportOptions
    Int
1000
    Int
1000
    Clock
defaultClock
    StatDType
StatAverage
    MeasureType
MeasureTime
    Golden
defaultGolden
    Header
Header
    CompareLevels
defaultCompareLevels
    PerfChartOptions
defaultPerfChartOptions
    PerfDumpOptions
defaultPerfDumpOptions
    Bool
False
    OrderOptions
defaultOrderOptions
    Bool
False

-- | Command-line parser for 'ReportOptions'
parseReportOptions :: ReportOptions -> Parser ReportOptions
parseReportOptions :: ReportOptions -> Parser ReportOptions
parseReportOptions ReportOptions
def =
  Int
-> Int
-> Clock
-> StatDType
-> MeasureType
-> Golden
-> Header
-> CompareLevels
-> PerfChartOptions
-> PerfDumpOptions
-> Bool
-> OrderOptions
-> Bool
-> ReportOptions
ReportOptions
    (Int
 -> Int
 -> Clock
 -> StatDType
 -> MeasureType
 -> Golden
 -> Header
 -> CompareLevels
 -> PerfChartOptions
 -> PerfDumpOptions
 -> Bool
 -> OrderOptions
 -> Bool
 -> ReportOptions)
-> Parser Int
-> Parser
     (Int
      -> Clock
      -> StatDType
      -> MeasureType
      -> Golden
      -> Header
      -> CompareLevels
      -> PerfChartOptions
      -> PerfDumpOptions
      -> Bool
      -> OrderOptions
      -> Bool
      -> ReportOptions)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadM Int -> Mod OptionFields Int -> Parser Int
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM Int
forall a. Read a => ReadM a
auto (Int -> Mod OptionFields Int
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value (Optic' A_Lens NoIx ReportOptions Int -> ReportOptions -> Int
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx ReportOptions Int
#reportN ReportOptions
def) Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<> (Int -> FilePath) -> Mod OptionFields Int
forall a (f :: * -> *). (a -> FilePath) -> Mod f a
showDefaultWith Int -> FilePath
forall a. Show a => a -> FilePath
show Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields Int
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"runs" Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields Int
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'n' Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields Int
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"INT" Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields Int
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"number of runs to perform")
    Parser
  (Int
   -> Clock
   -> StatDType
   -> MeasureType
   -> Golden
   -> Header
   -> CompareLevels
   -> PerfChartOptions
   -> PerfDumpOptions
   -> Bool
   -> OrderOptions
   -> Bool
   -> ReportOptions)
-> Parser Int
-> Parser
     (Clock
      -> StatDType
      -> MeasureType
      -> Golden
      -> Header
      -> CompareLevels
      -> PerfChartOptions
      -> PerfDumpOptions
      -> Bool
      -> OrderOptions
      -> Bool
      -> ReportOptions)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ReadM Int -> Mod OptionFields Int -> Parser Int
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM Int
forall a. Read a => ReadM a
auto (Int -> Mod OptionFields Int
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value (Optic' A_Lens NoIx ReportOptions Int -> ReportOptions -> Int
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx ReportOptions Int
#reportLength ReportOptions
def) Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields Int
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"length" Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<> (Int -> FilePath) -> Mod OptionFields Int
forall a (f :: * -> *). (a -> FilePath) -> Mod f a
showDefaultWith Int -> FilePath
forall a. Show a => a -> FilePath
show Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields Int
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'l' Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields Int
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"INT" Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields Int
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"length-like variable eg, used to alter list length and compute order")
    Parser
  (Clock
   -> StatDType
   -> MeasureType
   -> Golden
   -> Header
   -> CompareLevels
   -> PerfChartOptions
   -> PerfDumpOptions
   -> Bool
   -> OrderOptions
   -> Bool
   -> ReportOptions)
-> Parser Clock
-> Parser
     (StatDType
      -> MeasureType
      -> Golden
      -> Header
      -> CompareLevels
      -> PerfChartOptions
      -> PerfDumpOptions
      -> Bool
      -> OrderOptions
      -> Bool
      -> ReportOptions)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Clock
parseClock
    Parser
  (StatDType
   -> MeasureType
   -> Golden
   -> Header
   -> CompareLevels
   -> PerfChartOptions
   -> PerfDumpOptions
   -> Bool
   -> OrderOptions
   -> Bool
   -> ReportOptions)
-> Parser StatDType
-> Parser
     (MeasureType
      -> Golden
      -> Header
      -> CompareLevels
      -> PerfChartOptions
      -> PerfDumpOptions
      -> Bool
      -> OrderOptions
      -> Bool
      -> ReportOptions)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser StatDType
parseStatD
    Parser
  (MeasureType
   -> Golden
   -> Header
   -> CompareLevels
   -> PerfChartOptions
   -> PerfDumpOptions
   -> Bool
   -> OrderOptions
   -> Bool
   -> ReportOptions)
-> Parser MeasureType
-> Parser
     (Golden
      -> Header
      -> CompareLevels
      -> PerfChartOptions
      -> PerfDumpOptions
      -> Bool
      -> OrderOptions
      -> Bool
      -> ReportOptions)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser MeasureType
parseMeasure
    Parser
  (Golden
   -> Header
   -> CompareLevels
   -> PerfChartOptions
   -> PerfDumpOptions
   -> Bool
   -> OrderOptions
   -> Bool
   -> ReportOptions)
-> Parser Golden
-> Parser
     (Header
      -> CompareLevels
      -> PerfChartOptions
      -> PerfDumpOptions
      -> Bool
      -> OrderOptions
      -> Bool
      -> ReportOptions)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Golden
parseGolden
    Parser
  (Header
   -> CompareLevels
   -> PerfChartOptions
   -> PerfDumpOptions
   -> Bool
   -> OrderOptions
   -> Bool
   -> ReportOptions)
-> Parser Header
-> Parser
     (CompareLevels
      -> PerfChartOptions
      -> PerfDumpOptions
      -> Bool
      -> OrderOptions
      -> Bool
      -> ReportOptions)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Header
parseHeader
    Parser
  (CompareLevels
   -> PerfChartOptions
   -> PerfDumpOptions
   -> Bool
   -> OrderOptions
   -> Bool
   -> ReportOptions)
-> Parser CompareLevels
-> Parser
     (PerfChartOptions
      -> PerfDumpOptions
      -> Bool
      -> OrderOptions
      -> Bool
      -> ReportOptions)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> CompareLevels -> Parser CompareLevels
parseCompareLevels CompareLevels
defaultCompareLevels
    Parser
  (PerfChartOptions
   -> PerfDumpOptions
   -> Bool
   -> OrderOptions
   -> Bool
   -> ReportOptions)
-> Parser PerfChartOptions
-> Parser
     (PerfDumpOptions -> Bool -> OrderOptions -> Bool -> ReportOptions)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> PerfChartOptions -> Parser PerfChartOptions
parsePerfChartOptions PerfChartOptions
defaultPerfChartOptions
    Parser
  (PerfDumpOptions -> Bool -> OrderOptions -> Bool -> ReportOptions)
-> Parser PerfDumpOptions
-> Parser (Bool -> OrderOptions -> Bool -> ReportOptions)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> PerfDumpOptions -> Parser PerfDumpOptions
parsePerfDumpOptions PerfDumpOptions
defaultPerfDumpOptions
    Parser (Bool -> OrderOptions -> Bool -> ReportOptions)
-> Parser Bool -> Parser (OrderOptions -> Bool -> ReportOptions)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mod FlagFields Bool -> Parser Bool
switch (FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"gc" Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"run the GC prior to measurement")
    Parser (OrderOptions -> Bool -> ReportOptions)
-> Parser OrderOptions -> Parser (Bool -> ReportOptions)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> OrderOptions -> Parser OrderOptions
parseOrderOptions OrderOptions
defaultOrderOptions
    Parser (Bool -> ReportOptions)
-> Parser Bool -> Parser ReportOptions
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mod FlagFields Bool -> Parser Bool
switch (FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"tasty" Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"run tasty-bench")

-- | Parse command-line 'Clock' options.
parseClock :: Parser Clock
parseClock :: Parser Clock
parseClock =
  Clock -> Mod FlagFields Clock -> Parser Clock
forall a. a -> Mod FlagFields a -> Parser a
flag' Clock
Monotonic (FilePath -> Mod FlagFields Clock
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"Monotonic" Mod FlagFields Clock
-> Mod FlagFields Clock -> Mod FlagFields Clock
forall a. Semigroup a => a -> a -> a
<> (Doc -> Doc) -> Mod FlagFields Clock
forall (f :: * -> *) a. (Doc -> Doc) -> Mod f a
OA.style (AnsiStyle -> Doc -> Doc
forall ann. ann -> Doc ann -> Doc ann
annotate AnsiStyle
bold) Mod FlagFields Clock
-> Mod FlagFields Clock -> Mod FlagFields Clock
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod FlagFields Clock
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"use Monotonic clock")
    Parser Clock -> Parser Clock -> Parser Clock
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Clock -> Mod FlagFields Clock -> Parser Clock
forall a. a -> Mod FlagFields a -> Parser a
flag' Clock
Realtime (FilePath -> Mod FlagFields Clock
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"Realtime" Mod FlagFields Clock
-> Mod FlagFields Clock -> Mod FlagFields Clock
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod FlagFields Clock
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"use Realtime clock")
    Parser Clock -> Parser Clock -> Parser Clock
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Clock -> Mod FlagFields Clock -> Parser Clock
forall a. a -> Mod FlagFields a -> Parser a
flag' Clock
ProcessCPUTime (FilePath -> Mod FlagFields Clock
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"ProcessCPUTime" Mod FlagFields Clock
-> Mod FlagFields Clock -> Mod FlagFields Clock
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod FlagFields Clock
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"use ProcessCPUTime clock")
    Parser Clock -> Parser Clock -> Parser Clock
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Clock -> Mod FlagFields Clock -> Parser Clock
forall a. a -> Mod FlagFields a -> Parser a
flag' Clock
ThreadCPUTime (FilePath -> Mod FlagFields Clock
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"ThreadCPUTime" Mod FlagFields Clock
-> Mod FlagFields Clock -> Mod FlagFields Clock
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod FlagFields Clock
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"use ThreadCPUTime clock")
#ifdef mingw32_HOST_OS
    <|> pure ThreadCPUTime
#else
    Parser Clock -> Parser Clock -> Parser Clock
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Clock -> Mod FlagFields Clock -> Parser Clock
forall a. a -> Mod FlagFields a -> Parser a
flag' Clock
MonotonicRaw (FilePath -> Mod FlagFields Clock
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"MonotonicRaw" Mod FlagFields Clock
-> Mod FlagFields Clock -> Mod FlagFields Clock
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod FlagFields Clock
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"use MonotonicRaw clock")
    Parser Clock -> Parser Clock -> Parser Clock
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Clock -> Parser Clock
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Clock
MonotonicRaw
#endif

data PerfDumpOptions = PerfDumpOptions {PerfDumpOptions -> FilePath
dumpFilepath :: FilePath, PerfDumpOptions -> Bool
doDump :: Bool} deriving (PerfDumpOptions -> PerfDumpOptions -> Bool
(PerfDumpOptions -> PerfDumpOptions -> Bool)
-> (PerfDumpOptions -> PerfDumpOptions -> Bool)
-> Eq PerfDumpOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PerfDumpOptions -> PerfDumpOptions -> Bool
== :: PerfDumpOptions -> PerfDumpOptions -> Bool
$c/= :: PerfDumpOptions -> PerfDumpOptions -> Bool
/= :: PerfDumpOptions -> PerfDumpOptions -> Bool
Eq, Int -> PerfDumpOptions -> ShowS
[PerfDumpOptions] -> ShowS
PerfDumpOptions -> FilePath
(Int -> PerfDumpOptions -> ShowS)
-> (PerfDumpOptions -> FilePath)
-> ([PerfDumpOptions] -> ShowS)
-> Show PerfDumpOptions
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PerfDumpOptions -> ShowS
showsPrec :: Int -> PerfDumpOptions -> ShowS
$cshow :: PerfDumpOptions -> FilePath
show :: PerfDumpOptions -> FilePath
$cshowList :: [PerfDumpOptions] -> ShowS
showList :: [PerfDumpOptions] -> ShowS
Show, (forall x. PerfDumpOptions -> Rep PerfDumpOptions x)
-> (forall x. Rep PerfDumpOptions x -> PerfDumpOptions)
-> Generic PerfDumpOptions
forall x. Rep PerfDumpOptions x -> PerfDumpOptions
forall x. PerfDumpOptions -> Rep PerfDumpOptions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. PerfDumpOptions -> Rep PerfDumpOptions x
from :: forall x. PerfDumpOptions -> Rep PerfDumpOptions x
$cto :: forall x. Rep PerfDumpOptions x -> PerfDumpOptions
to :: forall x. Rep PerfDumpOptions x -> PerfDumpOptions
Generic)

defaultPerfDumpOptions :: PerfDumpOptions
defaultPerfDumpOptions :: PerfDumpOptions
defaultPerfDumpOptions = FilePath -> Bool -> PerfDumpOptions
PerfDumpOptions FilePath
"other/perf.map" Bool
False

-- | Parse charting options.
parsePerfDumpOptions :: PerfDumpOptions -> Parser PerfDumpOptions
parsePerfDumpOptions :: PerfDumpOptions -> Parser PerfDumpOptions
parsePerfDumpOptions PerfDumpOptions
def =
  FilePath -> Bool -> PerfDumpOptions
PerfDumpOptions
    (FilePath -> Bool -> PerfDumpOptions)
-> Parser FilePath -> Parser (Bool -> PerfDumpOptions)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadM FilePath -> Mod OptionFields FilePath -> Parser FilePath
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM FilePath
forall s. IsString s => ReadM s
str (FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value (Optic' A_Lens NoIx PerfDumpOptions FilePath
-> PerfDumpOptions -> FilePath
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx PerfDumpOptions FilePath
#dumpFilepath PerfDumpOptions
def) Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> ShowS -> Mod OptionFields FilePath
forall a (f :: * -> *). (a -> FilePath) -> Mod f a
showDefaultWith ShowS
forall a. Show a => a -> FilePath
show Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"dumppath" Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"FILE" Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"dump file name")
    Parser (Bool -> PerfDumpOptions)
-> Parser Bool -> Parser PerfDumpOptions
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mod FlagFields Bool -> Parser Bool
switch (FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"dump" Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"dump raw performance data as a Map Text [[Double]]")

fromDump :: PerfDumpOptions -> IO (Map.Map Text [[Double]])
fromDump :: PerfDumpOptions -> IO (Map Text [[Double]])
fromDump PerfDumpOptions
cfg = FilePath -> Map Text [[Double]]
forall a. Read a => FilePath -> a
read (FilePath -> Map Text [[Double]])
-> IO FilePath -> IO (Map Text [[Double]])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO FilePath
readFile (Optic' A_Lens NoIx PerfDumpOptions FilePath
-> PerfDumpOptions -> FilePath
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx PerfDumpOptions FilePath
#dumpFilepath PerfDumpOptions
cfg)

-- | Run and report a benchmark with the specified reporting options.
reportMain :: Example -> ReportOptions -> Name -> (Int -> PerfT IO [[Double]] a) -> IO a
reportMain :: forall a.
Example
-> ReportOptions
-> FilePath
-> (Int -> PerfT IO [[Double]] a)
-> IO a
reportMain Example
ex ReportOptions
o FilePath
name Int -> PerfT IO [[Double]] a
t = do
  let !n :: Int
n = ReportOptions -> Int
reportN ReportOptions
o
  let l :: Int
l = ReportOptions -> Int
reportLength ReportOptions
o
  let s :: StatDType
s = ReportOptions -> StatDType
reportStatDType ReportOptions
o
  let c :: Clock
c = ReportOptions -> Clock
reportClock ReportOptions
o
  let mt :: MeasureType
mt = ReportOptions -> MeasureType
reportMeasureType ReportOptions
o
  let o' :: ReportOptions
o' = FilePath -> ReportOptions -> ReportOptions
replaceDefaultFilePath (FilePath -> [FilePath] -> FilePath
forall a. [a] -> [[a]] -> [a]
intercalate FilePath
"-" [FilePath
name, Int -> FilePath
forall a. Show a => a -> FilePath
show Int
n, MeasureType -> FilePath
forall a. Show a => a -> FilePath
show MeasureType
mt, StatDType -> FilePath
forall a. Show a => a -> FilePath
show StatDType
s]) ReportOptions
o
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ReportOptions -> Bool
reportGC ReportOptions
o) IO ()
performGC
  (a
a, Map Text [[Double]]
m) <- Measure IO [[Double]]
-> PerfT IO [[Double]] a -> IO (a, Map Text [[Double]])
forall (m :: * -> *) t a.
Functor m =>
Measure m t -> PerfT m t a -> m (a, Map Text t)
runPerfT (MeasureType -> Clock -> Int -> Measure IO [[Double]]
measureDs MeasureType
mt Clock
c Int
n) (Int -> PerfT IO [[Double]] a
t Int
l)
  ReportOptions -> Map [Text] [Double] -> IO ()
report ReportOptions
o' (StatDType -> Map Text [[Double]] -> Map [Text] [Double]
forall a.
Ord a =>
StatDType -> Map a [[Double]] -> Map [a] [Double]
statify StatDType
s Map Text [[Double]]
m)
  (\PerfChartOptions
cfg -> Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Optic' A_Lens NoIx PerfChartOptions Bool
-> PerfChartOptions -> Bool
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx PerfChartOptions Bool
#doChart PerfChartOptions
cfg) (FilePath -> ChartOptions -> IO ()
writeChartOptions (Optic' A_Lens NoIx PerfChartOptions FilePath
-> PerfChartOptions -> FilePath
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx PerfChartOptions FilePath
#chartFilepath PerfChartOptions
cfg) (PerfChartOptions
-> Maybe [Text] -> Map Text [[Double]] -> ChartOptions
perfCharts PerfChartOptions
cfg ([Text] -> Maybe [Text]
forall a. a -> Maybe a
Just (MeasureType -> [Text]
measureLabels MeasureType
mt)) Map Text [[Double]]
m))) (ReportOptions -> PerfChartOptions
reportChart ReportOptions
o)
  (\PerfDumpOptions
cfg -> Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Optic' A_Lens NoIx PerfDumpOptions Bool -> PerfDumpOptions -> Bool
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx PerfDumpOptions Bool
#doDump PerfDumpOptions
cfg) (FilePath -> FilePath -> IO ()
writeFile (Optic' A_Lens NoIx PerfDumpOptions FilePath
-> PerfDumpOptions -> FilePath
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx PerfDumpOptions FilePath
#dumpFilepath PerfDumpOptions
cfg) (Map Text [[Double]] -> FilePath
forall a. Show a => a -> FilePath
show Map Text [[Double]]
m))) (ReportOptions -> PerfDumpOptions
reportDump ReportOptions
o)
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Optic' A_Lens NoIx ReportOptions Bool -> ReportOptions -> Bool
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view (Optic
  A_Lens NoIx ReportOptions ReportOptions OrderOptions OrderOptions
#reportOrder Optic
  A_Lens NoIx ReportOptions ReportOptions OrderOptions OrderOptions
-> Optic A_Lens NoIx OrderOptions OrderOptions Bool Bool
-> Optic' A_Lens NoIx ReportOptions Bool
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx OrderOptions OrderOptions Bool Bool
#doOrder) ReportOptions
o) (ReportOptions -> (Int -> PerfT IO [[Double]] a) -> IO ()
forall a. ReportOptions -> (Int -> PerfT IO [[Double]] a) -> IO ()
reportBigO ReportOptions
o Int -> PerfT IO [[Double]] a
t)
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Optic' A_Lens NoIx ReportOptions Bool -> ReportOptions -> Bool
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx ReportOptions Bool
#reportTasty ReportOptions
o) (Example -> ReportOptions -> IO ()
reportTasty' Example
ex ReportOptions
o)
  a -> IO a
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a

-- | Levels of geometric difference in compared performance that triggers reporting.
data CompareLevels = CompareLevels {CompareLevels -> Double
errorLevel :: Double, CompareLevels -> Double
warningLevel :: Double, CompareLevels -> Double
improvedLevel :: Double} deriving (CompareLevels -> CompareLevels -> Bool
(CompareLevels -> CompareLevels -> Bool)
-> (CompareLevels -> CompareLevels -> Bool) -> Eq CompareLevels
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CompareLevels -> CompareLevels -> Bool
== :: CompareLevels -> CompareLevels -> Bool
$c/= :: CompareLevels -> CompareLevels -> Bool
/= :: CompareLevels -> CompareLevels -> Bool
Eq, Int -> CompareLevels -> ShowS
[CompareLevels] -> ShowS
CompareLevels -> FilePath
(Int -> CompareLevels -> ShowS)
-> (CompareLevels -> FilePath)
-> ([CompareLevels] -> ShowS)
-> Show CompareLevels
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CompareLevels -> ShowS
showsPrec :: Int -> CompareLevels -> ShowS
$cshow :: CompareLevels -> FilePath
show :: CompareLevels -> FilePath
$cshowList :: [CompareLevels] -> ShowS
showList :: [CompareLevels] -> ShowS
Show)

-- |
-- >>> defaultCompareLevels
-- CompareLevels {errorLevel = 0.2, warningLevel = 5.0e-2, improvedLevel = 5.0e-2}
defaultCompareLevels :: CompareLevels
defaultCompareLevels :: CompareLevels
defaultCompareLevels = Double -> Double -> Double -> CompareLevels
CompareLevels Double
0.2 Double
0.05 Double
0.05

-- | Command-line parser for 'CompareLevels'
parseCompareLevels :: CompareLevels -> Parser CompareLevels
parseCompareLevels :: CompareLevels -> Parser CompareLevels
parseCompareLevels CompareLevels
c =
  Double -> Double -> Double -> CompareLevels
CompareLevels
    (Double -> Double -> Double -> CompareLevels)
-> Parser Double -> Parser (Double -> Double -> CompareLevels)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadM Double -> Mod OptionFields Double -> Parser Double
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM Double
forall a. Read a => ReadM a
auto (Double -> Mod OptionFields Double
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value (CompareLevels -> Double
errorLevel CompareLevels
c) Mod OptionFields Double
-> Mod OptionFields Double -> Mod OptionFields Double
forall a. Semigroup a => a -> a -> a
<> (Double -> FilePath) -> Mod OptionFields Double
forall a (f :: * -> *). (a -> FilePath) -> Mod f a
showDefaultWith Double -> FilePath
forall a. Show a => a -> FilePath
show Mod OptionFields Double
-> Mod OptionFields Double -> Mod OptionFields Double
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields Double
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"error" Mod OptionFields Double
-> Mod OptionFields Double -> Mod OptionFields Double
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields Double
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"DOUBLE" Mod OptionFields Double
-> Mod OptionFields Double -> Mod OptionFields Double
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields Double
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"report an error if performance degrades by more than this")
    Parser (Double -> Double -> CompareLevels)
-> Parser Double -> Parser (Double -> CompareLevels)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ReadM Double -> Mod OptionFields Double -> Parser Double
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM Double
forall a. Read a => ReadM a
auto (Double -> Mod OptionFields Double
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value (CompareLevels -> Double
warningLevel CompareLevels
c) Mod OptionFields Double
-> Mod OptionFields Double -> Mod OptionFields Double
forall a. Semigroup a => a -> a -> a
<> (Double -> FilePath) -> Mod OptionFields Double
forall a (f :: * -> *). (a -> FilePath) -> Mod f a
showDefaultWith Double -> FilePath
forall a. Show a => a -> FilePath
show Mod OptionFields Double
-> Mod OptionFields Double -> Mod OptionFields Double
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields Double
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"warning" Mod OptionFields Double
-> Mod OptionFields Double -> Mod OptionFields Double
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields Double
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"DOUBLE" Mod OptionFields Double
-> Mod OptionFields Double -> Mod OptionFields Double
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields Double
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"report a warning if performance degrades by more than this")
    Parser (Double -> CompareLevels)
-> Parser Double -> Parser CompareLevels
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ReadM Double -> Mod OptionFields Double -> Parser Double
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM Double
forall a. Read a => ReadM a
auto (Double -> Mod OptionFields Double
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value (CompareLevels -> Double
improvedLevel CompareLevels
c) Mod OptionFields Double
-> Mod OptionFields Double -> Mod OptionFields Double
forall a. Semigroup a => a -> a -> a
<> (Double -> FilePath) -> Mod OptionFields Double
forall a (f :: * -> *). (a -> FilePath) -> Mod f a
showDefaultWith Double -> FilePath
forall a. Show a => a -> FilePath
show Mod OptionFields Double
-> Mod OptionFields Double -> Mod OptionFields Double
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields Double
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"improved" Mod OptionFields Double
-> Mod OptionFields Double -> Mod OptionFields Double
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields Double
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"DOUBLE" Mod OptionFields Double
-> Mod OptionFields Double -> Mod OptionFields Double
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields Double
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"report if performance improves by more than this")

-- | Write results to file
writeResult :: FilePath -> Map.Map [Text] Double -> IO ()
writeResult :: FilePath -> Map [Text] Double -> IO ()
writeResult FilePath
f Map [Text] Double
m = FilePath -> FilePath -> IO ()
writeFile FilePath
f (Map [Text] Double -> FilePath
forall a. Show a => a -> FilePath
show Map [Text] Double
m)

-- | Read results from a file.
readResult :: FilePath -> IO (Either String (Map.Map [Text] Double))
readResult :: FilePath -> IO (Either FilePath (Map [Text] Double))
readResult FilePath
f = do
  Either SomeException FilePath
a :: Either SomeException String <- IO FilePath -> IO (Either SomeException FilePath)
forall e a. Exception e => IO a -> IO (Either e a)
try (FilePath -> IO FilePath
readFile FilePath
f)
  Either FilePath (Map [Text] Double)
-> IO (Either FilePath (Map [Text] Double))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either FilePath (Map [Text] Double)
 -> IO (Either FilePath (Map [Text] Double)))
-> Either FilePath (Map [Text] Double)
-> IO (Either FilePath (Map [Text] Double))
forall a b. (a -> b) -> a -> b
$ (SomeException -> Either FilePath (Map [Text] Double))
-> (FilePath -> Either FilePath (Map [Text] Double))
-> Either SomeException FilePath
-> Either FilePath (Map [Text] Double)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (FilePath -> Either FilePath (Map [Text] Double)
forall a b. a -> Either a b
Left (FilePath -> Either FilePath (Map [Text] Double))
-> (SomeException -> FilePath)
-> SomeException
-> Either FilePath (Map [Text] Double)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SomeException -> FilePath
forall a. Show a => a -> FilePath
show) FilePath -> Either FilePath (Map [Text] Double)
forall a. Read a => FilePath -> Either FilePath a
readEither Either SomeException FilePath
a

-- | Comparison data between two results.
data CompareResult = CompareResult {CompareResult -> Maybe Double
oldResult :: Maybe Double, CompareResult -> Maybe Double
newResult :: Maybe Double, CompareResult -> Text
noteResult :: Text} deriving (Int -> CompareResult -> ShowS
[CompareResult] -> ShowS
CompareResult -> FilePath
(Int -> CompareResult -> ShowS)
-> (CompareResult -> FilePath)
-> ([CompareResult] -> ShowS)
-> Show CompareResult
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CompareResult -> ShowS
showsPrec :: Int -> CompareResult -> ShowS
$cshow :: CompareResult -> FilePath
show :: CompareResult -> FilePath
$cshowList :: [CompareResult] -> ShowS
showList :: [CompareResult] -> ShowS
Show, CompareResult -> CompareResult -> Bool
(CompareResult -> CompareResult -> Bool)
-> (CompareResult -> CompareResult -> Bool) -> Eq CompareResult
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CompareResult -> CompareResult -> Bool
== :: CompareResult -> CompareResult -> Bool
$c/= :: CompareResult -> CompareResult -> Bool
/= :: CompareResult -> CompareResult -> Bool
Eq)

hasDegraded :: Map.Map a CompareResult -> Bool
hasDegraded :: forall a. Map a CompareResult -> Bool
hasDegraded Map a CompareResult
m = ((a, CompareResult) -> Bool) -> [(a, CompareResult)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (((Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"degraded") (Text -> Bool) -> (CompareResult -> Text) -> CompareResult -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CompareResult -> Text
noteResult) (CompareResult -> Bool)
-> ((a, CompareResult) -> CompareResult)
-> (a, CompareResult)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, CompareResult) -> CompareResult
forall a b. (a, b) -> b
snd) (Map a CompareResult -> [(a, CompareResult)]
forall k a. Map k a -> [(k, a)]
Map.toList Map a CompareResult
m)

-- | Compare two results and produce some notes given level triggers.
compareNote :: (Ord a) => CompareLevels -> Map.Map a Double -> Map.Map a Double -> Map.Map a CompareResult
compareNote :: forall a.
Ord a =>
CompareLevels
-> Map a Double -> Map a Double -> Map a CompareResult
compareNote CompareLevels
cfg Map a Double
x Map a Double
y =
  SimpleWhenMissing a Double CompareResult
-> SimpleWhenMissing a Double CompareResult
-> SimpleWhenMatched a Double Double CompareResult
-> Map a Double
-> Map a Double
-> Map a CompareResult
forall k a c b.
Ord k =>
SimpleWhenMissing k a c
-> SimpleWhenMissing k b c
-> SimpleWhenMatched k a b c
-> Map k a
-> Map k b
-> Map k c
merge
    ((a -> Double -> CompareResult)
-> SimpleWhenMissing a Double CompareResult
forall (f :: * -> *) k x y.
Applicative f =>
(k -> x -> y) -> WhenMissing f k x y
mapMissing (\a
_ Double
x' -> Maybe Double -> Maybe Double -> Text -> CompareResult
CompareResult Maybe Double
forall a. Maybe a
Nothing (Double -> Maybe Double
forall a. a -> Maybe a
Just Double
x') Text
"new result"))
    ((a -> Double -> CompareResult)
-> SimpleWhenMissing a Double CompareResult
forall (f :: * -> *) k x y.
Applicative f =>
(k -> x -> y) -> WhenMissing f k x y
mapMissing (\a
_ Double
x' -> Maybe Double -> Maybe Double -> Text -> CompareResult
CompareResult (Double -> Maybe Double
forall a. a -> Maybe a
Just Double
x') Maybe Double
forall a. Maybe a
Nothing Text
"old result not found"))
    ( (a -> Double -> Double -> CompareResult)
-> SimpleWhenMatched a Double Double CompareResult
forall (f :: * -> *) k x y z.
Applicative f =>
(k -> x -> y -> z) -> WhenMatched f k x y z
zipWithMatched
        ( \a
_ Double
x' Double
y' ->
            Maybe Double -> Maybe Double -> Text -> CompareResult
CompareResult (Double -> Maybe Double
forall a. a -> Maybe a
Just Double
x') (Double -> Maybe Double
forall a. a -> Maybe a
Just Double
y') (Double -> Double -> Text
forall {a}. IsString a => Double -> Double -> a
note' Double
x' Double
y')
        )
    )
    Map a Double
x
    Map a Double
y
  where
    note' :: Double -> Double -> a
note' Double
x' Double
y'
      | Double
y' Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
x' Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
1 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ CompareLevels -> Double
errorLevel CompareLevels
cfg = a
"degraded"
      | Double
y' Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
x' Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
1 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ CompareLevels -> Double
warningLevel CompareLevels
cfg = a
"slightly-degraded"
      | Double
y' Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
x' Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< (Double
1 Double -> Double -> Double
forall a. Num a => a -> a -> a
- CompareLevels -> Double
improvedLevel CompareLevels
cfg) = a
"improvement"
      | Bool
otherwise = a
""

-- | Console-style header information.
formatHeader :: Map.Map [Text] a -> [Text] -> [Text]
formatHeader :: forall a. Map [Text] a -> [Text] -> [Text]
formatHeader Map [Text] a
m [Text]
ts =
  [[Text] -> Text
forall a. Monoid a => [a] -> a
mconcat ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ FilePath -> Text
Text.pack (FilePath -> Text) -> (Text -> FilePath) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text -> FilePath
forall r. PrintfType r => FilePath -> r
printf FilePath
"%-16s" (Text -> Text) -> [Text] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (((Text
"label" <>) (Text -> Text) -> (Int -> Text) -> Int -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
Text.pack (FilePath -> Text) -> (Int -> FilePath) -> Int -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> FilePath
forall a. Show a => a -> FilePath
show (Int -> Text) -> [Int] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Int
1 .. Int
labelCols]) [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text]
ts), Text
forall a. Monoid a => a
mempty]
  where
    labelCols :: Int
labelCols = [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ [Text] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Text] -> Int) -> [[Text]] -> [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map [Text] a -> [[Text]]
forall k a. Map k a -> [k]
Map.keys Map [Text] a
m

-- | Format a comparison.
formatCompare :: Header -> Map.Map [Text] CompareResult -> [Text]
formatCompare :: Header -> Map [Text] CompareResult -> [Text]
formatCompare Header
h Map [Text] CompareResult
m =
  [Text] -> [Text] -> Bool -> [Text]
forall a. a -> a -> Bool -> a
bool [] (Map [Text] CompareResult -> [Text] -> [Text]
forall a. Map [Text] a -> [Text] -> [Text]
formatHeader Map [Text] CompareResult
m [Text
"old result", Text
"new result", Text
"change"]) (Header
h Header -> Header -> Bool
forall a. Eq a => a -> a -> Bool
== Header
Header)
    [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> Map [Text] Text -> [Text]
forall k a. Map k a -> [a]
Map.elems (([Text] -> CompareResult -> Text)
-> Map [Text] CompareResult -> Map [Text] Text
forall k a b. (k -> a -> b) -> Map k a -> Map k b
Map.mapWithKey (\[Text]
k CompareResult
a -> FilePath -> Text
Text.pack (FilePath -> Text)
-> ([FilePath] -> FilePath) -> [FilePath] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FilePath] -> FilePath
forall a. Monoid a => [a] -> a
mconcat ([FilePath] -> Text) -> [FilePath] -> Text
forall a b. (a -> b) -> a -> b
$ FilePath -> Text -> FilePath
forall r. PrintfType r => FilePath -> r
printf FilePath
"%-16s" (Text -> FilePath) -> [Text] -> [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Text]
k [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> CompareResult -> [Text]
compareReport CompareResult
a)) Map [Text] CompareResult
m)
  where
    compareReport :: CompareResult -> [Text]
compareReport (CompareResult Maybe Double
x Maybe Double
y Text
n) =
      [ Text -> (Double -> Text) -> Maybe Double -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
forall a. Monoid a => a
mempty (Maybe Int -> Double -> Text
expt (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
3)) Maybe Double
x,
        Text -> (Double -> Text) -> Maybe Double -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
forall a. Monoid a => a
mempty (Maybe Int -> Double -> Text
expt (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
3)) Maybe Double
y,
        Text
n
      ]

-- | Format a result as lines of text.
formatText :: Header -> Map.Map [Text] Text -> [Text]
formatText :: Header -> Map [Text] Text -> [Text]
formatText Header
h Map [Text] Text
m =
  [Text] -> [Text] -> Bool -> [Text]
forall a. a -> a -> Bool -> a
bool [] (Map [Text] Text -> [Text] -> [Text]
forall a. Map [Text] a -> [Text] -> [Text]
formatHeader Map [Text] Text
m [Text
"results"]) (Header
h Header -> Header -> Bool
forall a. Eq a => a -> a -> Bool
== Header
Header)
    [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> Map [Text] Text -> [Text]
forall k a. Map k a -> [a]
Map.elems (([Text] -> Text -> Text) -> Map [Text] Text -> Map [Text] Text
forall k a b. (k -> a -> b) -> Map k a -> Map k b
Map.mapWithKey (\[Text]
k Text
a -> FilePath -> Text
Text.pack (FilePath -> Text)
-> ([FilePath] -> FilePath) -> [FilePath] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FilePath] -> FilePath
forall a. Monoid a => [a] -> a
mconcat ([FilePath] -> Text) -> [FilePath] -> Text
forall a b. (a -> b) -> a -> b
$ FilePath -> Text -> FilePath
forall r. PrintfType r => FilePath -> r
printf FilePath
"%-16s" (Text -> FilePath) -> [Text] -> [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Text]
k [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text
a])) Map [Text] Text
m)

-- | Format a result as a table.
report2D :: Map.Map [Text] Double -> IO ()
report2D :: Map [Text] Double -> IO ()
report2D Map [Text] Double
m = FilePath -> IO ()
putStrLn (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ Box -> FilePath
B.render (Box -> FilePath) -> Box -> FilePath
forall a b. (a -> b) -> a -> b
$ Int -> Alignment -> [Box] -> Box
forall (f :: * -> *).
Foldable f =>
Int -> Alignment -> f Box -> Box
B.hsep Int
1 Alignment
B.left ([Box] -> Box) -> [Box] -> Box
forall a b. (a -> b) -> a -> b
$ Box
cs' Box -> [Box] -> [Box]
forall a. a -> [a] -> [a]
: [Box]
rs'
  where
    rs :: [Text]
rs = [Text] -> [Text]
forall a. Eq a => [a] -> [a]
List.nub (([Text] -> Int -> Text
forall a. HasCallStack => [a] -> Int -> a
List.!! Int
1) ([Text] -> Text)
-> (([Text], Double) -> [Text]) -> ([Text], Double) -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Text], Double) -> [Text]
forall a b. (a, b) -> a
fst (([Text], Double) -> Text) -> [([Text], Double)] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map [Text] Double -> [([Text], Double)]
forall k a. Map k a -> [(k, a)]
Map.toList Map [Text] Double
m)
    cs :: [Text]
cs = [Text] -> [Text]
forall a. Eq a => [a] -> [a]
List.nub (([Text] -> Int -> Text
forall a. HasCallStack => [a] -> Int -> a
List.!! Int
0) ([Text] -> Text)
-> (([Text], Double) -> [Text]) -> ([Text], Double) -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Text], Double) -> [Text]
forall a b. (a, b) -> a
fst (([Text], Double) -> Text) -> [([Text], Double)] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map [Text] Double -> [([Text], Double)]
forall k a. Map k a -> [(k, a)]
Map.toList Map [Text] Double
m)
    bx :: Text -> Box
bx = FilePath -> Box
B.text (FilePath -> Box) -> (Text -> FilePath) -> Text -> Box
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FilePath
Text.unpack
    xs :: [[Double]]
xs = (\Text
c -> (\Text
r -> Map [Text] Double
m Map [Text] Double -> [Text] -> Double
forall k a. Ord k => Map k a -> k -> a
Map.! [Text
c, Text
r]) (Text -> Double) -> [Text] -> [Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
rs) (Text -> [Double]) -> [Text] -> [[Double]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
cs
    xs' :: [[Box]]
xs' = ([Double] -> [Box]) -> [[Double]] -> [[Box]]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Double -> Box) -> [Double] -> [Box]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> Box
bx (Text -> Box) -> (Double -> Text) -> Double -> Box
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Int -> Double -> Text
expt (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
3))) [[Double]]
xs
    cs' :: Box
cs' = Alignment -> [Box] -> Box
forall (f :: * -> *). Foldable f => Alignment -> f Box -> Box
B.vcat Alignment
B.left (Text -> Box
bx (Text -> Box) -> [Text] -> [Box]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text
"algo" Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
cs))
    rs' :: [Box]
rs' = Alignment -> [Box] -> Box
forall (f :: * -> *). Foldable f => Alignment -> f Box -> Box
B.vcat Alignment
B.right ([Box] -> Box) -> [[Box]] -> [Box]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Box -> [Box] -> [Box]) -> [Box] -> [[Box]] -> [[Box]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (:) (Text -> Box
bx (Text -> Box) -> [Text] -> [Box]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
rs) ([[Box]] -> [[Box]]
forall a. [[a]] -> [[a]]
List.transpose [[Box]]
xs')

reportToConsole :: [Text] -> IO ()
reportToConsole :: [Text] -> IO ()
reportToConsole [Text]
xs = (Text -> IO ()) -> [Text] -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ Text -> IO ()
Text.putStrLn [Text]
xs

-- | Golden file options.
data Golden = Golden {Golden -> FilePath
golden :: FilePath, Golden -> CheckGolden
check :: CheckGolden, Golden -> RecordGolden
record :: RecordGolden} deriving ((forall x. Golden -> Rep Golden x)
-> (forall x. Rep Golden x -> Golden) -> Generic Golden
forall x. Rep Golden x -> Golden
forall x. Golden -> Rep Golden x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Golden -> Rep Golden x
from :: forall x. Golden -> Rep Golden x
$cto :: forall x. Rep Golden x -> Golden
to :: forall x. Rep Golden x -> Golden
Generic, Golden -> Golden -> Bool
(Golden -> Golden -> Bool)
-> (Golden -> Golden -> Bool) -> Eq Golden
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Golden -> Golden -> Bool
== :: Golden -> Golden -> Bool
$c/= :: Golden -> Golden -> Bool
/= :: Golden -> Golden -> Bool
Eq, Int -> Golden -> ShowS
[Golden] -> ShowS
Golden -> FilePath
(Int -> Golden -> ShowS)
-> (Golden -> FilePath) -> ([Golden] -> ShowS) -> Show Golden
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Golden -> ShowS
showsPrec :: Int -> Golden -> ShowS
$cshow :: Golden -> FilePath
show :: Golden -> FilePath
$cshowList :: [Golden] -> ShowS
showList :: [Golden] -> ShowS
Show)

-- | Whether to check against a golden file
data CheckGolden = CheckGolden | NoCheckGolden deriving (CheckGolden -> CheckGolden -> Bool
(CheckGolden -> CheckGolden -> Bool)
-> (CheckGolden -> CheckGolden -> Bool) -> Eq CheckGolden
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CheckGolden -> CheckGolden -> Bool
== :: CheckGolden -> CheckGolden -> Bool
$c/= :: CheckGolden -> CheckGolden -> Bool
/= :: CheckGolden -> CheckGolden -> Bool
Eq, Int -> CheckGolden -> ShowS
[CheckGolden] -> ShowS
CheckGolden -> FilePath
(Int -> CheckGolden -> ShowS)
-> (CheckGolden -> FilePath)
-> ([CheckGolden] -> ShowS)
-> Show CheckGolden
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CheckGolden -> ShowS
showsPrec :: Int -> CheckGolden -> ShowS
$cshow :: CheckGolden -> FilePath
show :: CheckGolden -> FilePath
$cshowList :: [CheckGolden] -> ShowS
showList :: [CheckGolden] -> ShowS
Show, (forall x. CheckGolden -> Rep CheckGolden x)
-> (forall x. Rep CheckGolden x -> CheckGolden)
-> Generic CheckGolden
forall x. Rep CheckGolden x -> CheckGolden
forall x. CheckGolden -> Rep CheckGolden x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CheckGolden -> Rep CheckGolden x
from :: forall x. CheckGolden -> Rep CheckGolden x
$cto :: forall x. Rep CheckGolden x -> CheckGolden
to :: forall x. Rep CheckGolden x -> CheckGolden
Generic)

-- | Whether to overwrite a golden file
data RecordGolden = RecordGolden | NoRecordGolden deriving (RecordGolden -> RecordGolden -> Bool
(RecordGolden -> RecordGolden -> Bool)
-> (RecordGolden -> RecordGolden -> Bool) -> Eq RecordGolden
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RecordGolden -> RecordGolden -> Bool
== :: RecordGolden -> RecordGolden -> Bool
$c/= :: RecordGolden -> RecordGolden -> Bool
/= :: RecordGolden -> RecordGolden -> Bool
Eq, Int -> RecordGolden -> ShowS
[RecordGolden] -> ShowS
RecordGolden -> FilePath
(Int -> RecordGolden -> ShowS)
-> (RecordGolden -> FilePath)
-> ([RecordGolden] -> ShowS)
-> Show RecordGolden
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RecordGolden -> ShowS
showsPrec :: Int -> RecordGolden -> ShowS
$cshow :: RecordGolden -> FilePath
show :: RecordGolden -> FilePath
$cshowList :: [RecordGolden] -> ShowS
showList :: [RecordGolden] -> ShowS
Show, (forall x. RecordGolden -> Rep RecordGolden x)
-> (forall x. Rep RecordGolden x -> RecordGolden)
-> Generic RecordGolden
forall x. Rep RecordGolden x -> RecordGolden
forall x. RecordGolden -> Rep RecordGolden x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. RecordGolden -> Rep RecordGolden x
from :: forall x. RecordGolden -> Rep RecordGolden x
$cto :: forall x. Rep RecordGolden x -> RecordGolden
to :: forall x. Rep RecordGolden x -> RecordGolden
Generic)

-- | Default is Golden "other/bench.perf" CheckGolden NoRecordGolden
defaultGolden :: Golden
defaultGolden :: Golden
defaultGolden = FilePath -> CheckGolden -> RecordGolden -> Golden
Golden FilePath
"other/bench.perf" CheckGolden
CheckGolden RecordGolden
NoRecordGolden

-- | Replace the golden file name stem if it's the default.
replaceGoldenDefault :: FilePath -> Golden -> Golden
replaceGoldenDefault :: FilePath -> Golden -> Golden
replaceGoldenDefault FilePath
s Golden
g = Golden -> Golden -> Bool -> Golden
forall a. a -> a -> Bool -> a
bool Golden
g Golden
g {golden = s} (Golden -> FilePath
golden Golden
g FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== Golden -> FilePath
golden Golden
defaultGolden)

defaultGoldenPath :: FilePath -> FilePath
defaultGoldenPath :: ShowS
defaultGoldenPath FilePath
fp = FilePath
"other/" FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
fp FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
".perf"

-- | Replace the Golden file path with the suggested stem, but only if the user did not specify a specific file path at the command line.
replaceDefaultFilePath :: FilePath -> ReportOptions -> ReportOptions
replaceDefaultFilePath :: FilePath -> ReportOptions -> ReportOptions
replaceDefaultFilePath FilePath
fp ReportOptions
o =
  ReportOptions
o {reportGolden = replaceGoldenDefault (defaultGoldenPath fp) (reportGolden o)}

-- | Parse command-line golden file options.
parseGolden :: Parser Golden
parseGolden :: Parser Golden
parseGolden =
  FilePath -> CheckGolden -> RecordGolden -> Golden
Golden
    (FilePath -> CheckGolden -> RecordGolden -> Golden)
-> Parser FilePath
-> Parser (CheckGolden -> RecordGolden -> Golden)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadM FilePath -> Mod OptionFields FilePath -> Parser FilePath
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM FilePath
forall s. IsString s => ReadM s
str (FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value (Golden -> FilePath
golden Golden
defaultGolden) Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> ShowS -> Mod OptionFields FilePath
forall a (f :: * -> *). (a -> FilePath) -> Mod f a
showDefaultWith ShowS
forall a. Show a => a -> FilePath
show Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"golden" Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'g' Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"FILE" Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"golden file name")
    -- True is the default for 'check'.
    Parser (CheckGolden -> RecordGolden -> Golden)
-> Parser CheckGolden -> Parser (RecordGolden -> Golden)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (CheckGolden -> CheckGolden -> Bool -> CheckGolden
forall a. a -> a -> Bool -> a
bool CheckGolden
NoCheckGolden CheckGolden
CheckGolden (Bool -> CheckGolden) -> Parser Bool -> Parser CheckGolden
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> Bool -> Mod FlagFields Bool -> Parser Bool
forall a. a -> a -> Mod FlagFields a -> Parser a
flag Bool
True Bool
False (FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"nocheck" Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"do not check versus the golden file"))
    Parser (RecordGolden -> Golden)
-> Parser RecordGolden -> Parser Golden
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (RecordGolden -> RecordGolden -> Bool -> RecordGolden
forall a. a -> a -> Bool -> a
bool RecordGolden
NoRecordGolden RecordGolden
RecordGolden (Bool -> RecordGolden) -> Parser Bool -> Parser RecordGolden
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mod FlagFields Bool -> Parser Bool
switch (FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"record" Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> Char -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'r' Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"record the result to the golden file"))

reportConsoleNoCompare :: Header -> Map.Map [Text] Double -> IO ()
reportConsoleNoCompare :: Header -> Map [Text] Double -> IO ()
reportConsoleNoCompare Header
h Map [Text] Double
m =
  [Text] -> IO ()
reportToConsole (Header -> Map [Text] Text -> [Text]
formatText Header
h (Maybe Int -> Double -> Text
expt (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
3) (Double -> Text) -> Map [Text] Double -> Map [Text] Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map [Text] Double
m))

reportConsoleCompare :: Header -> Map.Map [Text] CompareResult -> IO ()
reportConsoleCompare :: Header -> Map [Text] CompareResult -> IO ()
reportConsoleCompare Header
h Map [Text] CompareResult
m =
  [Text] -> IO ()
reportToConsole (Header -> Map [Text] CompareResult -> [Text]
formatCompare Header
h Map [Text] CompareResult
m)

-- | Report results
--
-- If a goldenFile is checked, and performance has degraded, the function will exit with 'ExitFailure' so that 'cabal bench' and other types of processes can signal performance issues.
report :: ReportOptions -> Map.Map [Text] [Double] -> IO ()
report :: ReportOptions -> Map [Text] [Double] -> IO ()
report ReportOptions
o Map [Text] [Double]
m = do
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when
    ((RecordGolden -> RecordGolden -> Bool
forall a. Eq a => a -> a -> Bool
== RecordGolden
RecordGolden) (RecordGolden -> Bool) -> RecordGolden -> Bool
forall a b. (a -> b) -> a -> b
$ Golden -> RecordGolden
record (ReportOptions -> Golden
reportGolden ReportOptions
o))
    (FilePath -> Map [Text] Double -> IO ()
writeResult (Golden -> FilePath
golden (ReportOptions -> Golden
reportGolden ReportOptions
o)) Map [Text] Double
m')
  case Golden -> CheckGolden
check (ReportOptions -> Golden
reportGolden ReportOptions
o) of
    CheckGolden
NoCheckGolden -> Header -> Map [Text] Double -> IO ()
reportConsoleNoCompare (ReportOptions -> Header
reportHeader ReportOptions
o) Map [Text] Double
m'
    CheckGolden
CheckGolden -> do
      Either FilePath (Map [Text] Double)
mOrig <- FilePath -> IO (Either FilePath (Map [Text] Double))
readResult (Golden -> FilePath
golden (ReportOptions -> Golden
reportGolden ReportOptions
o))
      case Either FilePath (Map [Text] Double)
mOrig of
        Left FilePath
_ -> do
          Header -> Map [Text] Double -> IO ()
reportConsoleNoCompare (ReportOptions -> Header
reportHeader ReportOptions
o) Map [Text] Double
m'
          Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless
            ((RecordGolden
RecordGolden ==) (RecordGolden -> Bool) -> RecordGolden -> Bool
forall a b. (a -> b) -> a -> b
$ Golden -> RecordGolden
record (ReportOptions -> Golden
reportGolden ReportOptions
o))
            (FilePath -> IO ()
putStrLn FilePath
"No golden file found. To create one, run with '-r'")
        Right Map [Text] Double
orig -> do
          let n :: Map [Text] CompareResult
n = CompareLevels
-> Map [Text] Double
-> Map [Text] Double
-> Map [Text] CompareResult
forall a.
Ord a =>
CompareLevels
-> Map a Double -> Map a Double -> Map a CompareResult
compareNote (ReportOptions -> CompareLevels
reportCompare ReportOptions
o) Map [Text] Double
orig Map [Text] Double
m'
          ()
_ <- Header -> Map [Text] CompareResult -> IO ()
reportConsoleCompare (ReportOptions -> Header
reportHeader ReportOptions
o) Map [Text] CompareResult
n
          Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Map [Text] CompareResult -> Bool
forall a. Map a CompareResult -> Bool
hasDegraded Map [Text] CompareResult
n) (ExitCode -> IO ()
forall a. ExitCode -> IO a
exitWith (ExitCode -> IO ()) -> ExitCode -> IO ()
forall a b. (a -> b) -> a -> b
$ Int -> ExitCode
ExitFailure Int
1)
  where
    m' :: Map [Text] Double
m' = [([Text], Double)] -> Map [Text] Double
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([([Text], Double)] -> Map [Text] Double)
-> [([Text], Double)] -> Map [Text] Double
forall a b. (a -> b) -> a -> b
$ [[([Text], Double)]] -> [([Text], Double)]
forall a. Monoid a => [a] -> a
mconcat ([[([Text], Double)]] -> [([Text], Double)])
-> [[([Text], Double)]] -> [([Text], Double)]
forall a b. (a -> b) -> a -> b
$ (\([Text]
ks, [Double]
xss) -> (Double -> Text -> ([Text], Double))
-> [Double] -> [Text] -> [([Text], Double)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Double
x Text
l -> ([Text]
ks [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text
l], Double
x)) [Double]
xss (MeasureType -> [Text]
measureLabels (ReportOptions -> MeasureType
reportMeasureType ReportOptions
o))) (([Text], [Double]) -> [([Text], Double)])
-> [([Text], [Double])] -> [[([Text], Double)]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map [Text] [Double] -> [([Text], [Double])]
forall k a. Map k a -> [(k, a)]
Map.toList Map [Text] [Double]
m

reportBigO :: ReportOptions -> (Int -> PerfT IO [[Double]] a) -> IO ()
reportBigO :: forall a. ReportOptions -> (Int -> PerfT IO [[Double]] a) -> IO ()
reportBigO ReportOptions
o Int -> PerfT IO [[Double]] a
p = do
  [Map Text [[Double]]]
m <- (Int -> IO (Map Text [[Double]]))
-> [Int] -> IO [Map Text [[Double]]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (Measure IO [[Double]]
-> PerfT IO [[Double]] a -> IO (Map Text [[Double]])
forall (m :: * -> *) t a.
Monad m =>
Measure m t -> PerfT m t a -> m (Map Text t)
execPerfT (MeasureType -> Clock -> Int -> Measure IO [[Double]]
measureDs (Optic' A_Lens NoIx ReportOptions MeasureType
-> ReportOptions -> MeasureType
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx ReportOptions MeasureType
#reportMeasureType ReportOptions
o) (Optic' A_Lens NoIx ReportOptions Clock -> ReportOptions -> Clock
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx ReportOptions Clock
#reportClock ReportOptions
o) (Optic' A_Lens NoIx ReportOptions Int -> ReportOptions -> Int
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx ReportOptions Int
#reportN ReportOptions
o)) (PerfT IO [[Double]] a -> IO (Map Text [[Double]]))
-> (Int -> PerfT IO [[Double]] a)
-> Int
-> IO (Map Text [[Double]])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> PerfT IO [[Double]] a
p) [Int]
ns
  FilePath -> IO ()
putStrLn FilePath
forall a. Monoid a => a
mempty
  [Text] -> IO ()
reportToConsole ([Text] -> IO ()) -> [Text] -> IO ()
forall a b. (a -> b) -> a -> b
$ SimpleDocStream Any -> Text
forall ann. SimpleDocStream ann -> Text
PP.renderStrict (SimpleDocStream Any -> Text)
-> (Doc Any -> SimpleDocStream Any) -> Doc Any -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LayoutOptions -> Doc Any -> SimpleDocStream Any
forall ann. LayoutOptions -> Doc ann -> SimpleDocStream ann
layoutPretty LayoutOptions
defaultLayoutOptions (Doc Any -> Text) -> [Doc Any] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Map Text [[Double]]] -> [Doc Any]
forall {f :: * -> *} {ann}.
(Foldable f, Functor f) =>
f (Map Text [[Double]]) -> [Doc ann]
os'' [Map Text [[Double]]]
m
  () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  where
    l :: Int
l = Optic' A_Lens NoIx ReportOptions Int -> ReportOptions -> Int
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx ReportOptions Int
#reportLength ReportOptions
o
    ns :: [Int]
ns = Int -> Double -> Int -> [Int]
makeNs Int
l (Optic' A_Lens NoIx ReportOptions Double -> ReportOptions -> Double
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view (Optic
  A_Lens NoIx ReportOptions ReportOptions OrderOptions OrderOptions
#reportOrder Optic
  A_Lens NoIx ReportOptions ReportOptions OrderOptions OrderOptions
-> Optic A_Lens NoIx OrderOptions OrderOptions Double Double
-> Optic' A_Lens NoIx ReportOptions Double
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx OrderOptions OrderOptions Double Double
#orderDivisor) ReportOptions
o) (Optic' A_Lens NoIx ReportOptions Int -> ReportOptions -> Int
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view (Optic
  A_Lens NoIx ReportOptions ReportOptions OrderOptions OrderOptions
#reportOrder Optic
  A_Lens NoIx ReportOptions ReportOptions OrderOptions OrderOptions
-> Optic A_Lens NoIx OrderOptions OrderOptions Int Int
-> Optic' A_Lens NoIx ReportOptions Int
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx OrderOptions OrderOptions Int Int
#orderLow) ReportOptions
o)
    ms :: f (f [[Double]]) -> f (f [Double])
ms f (f [[Double]])
m' = ([[Double]] -> [Double]) -> f [[Double]] -> f [Double]
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([Double] -> Double) -> [[Double]] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (StatDType -> [Double] -> Double
statD (Optic' A_Lens NoIx ReportOptions StatDType
-> ReportOptions -> StatDType
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx ReportOptions StatDType
#reportStatDType ReportOptions
o)) ([[Double]] -> [Double])
-> ([[Double]] -> [[Double]]) -> [[Double]] -> [Double]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Double]] -> [[Double]]
forall a. [[a]] -> [[a]]
List.transpose) (f [[Double]] -> f [Double]) -> f (f [[Double]]) -> f (f [Double])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (f [[Double]])
m'
    os :: f (Map k [[Double]]) -> Map k [Doc ann]
os f (Map k [[Double]])
m' = ([[Double]] -> [Doc ann]) -> Map k [[Double]] -> Map k [Doc ann]
forall a b. (a -> b) -> Map k a -> Map k b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([Double] -> Doc ann) -> [[Double]] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (BigOrder Double -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. BigOrder Double -> Doc ann
pretty (BigOrder Double -> Doc ann)
-> ([Double] -> BigOrder Double) -> [Double] -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Order Double -> BigOrder Double
fromOrder (Order Double -> BigOrder Double)
-> ([Double] -> Order Double) -> [Double] -> BigOrder Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Order Double, [Double]) -> Order Double
forall a b. (a, b) -> a
fst ((Order Double, [Double]) -> Order Double)
-> ([Double] -> (Order Double, [Double]))
-> [Double]
-> Order Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Double] -> [Double] -> (Order Double, [Double])
estO (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Double) -> [Int] -> [Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Int]
ns)) ([[Double]] -> [Doc ann])
-> ([[Double]] -> [[Double]]) -> [[Double]] -> [Doc ann]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Double]] -> [[Double]]
forall a. [[a]] -> [[a]]
List.transpose) (([[Double]] -> [[Double]] -> [[Double]])
-> f (Map k [[Double]]) -> Map k [[Double]]
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
(a -> a -> a) -> f (Map k a) -> Map k a
Map.unionsWith [[Double]] -> [[Double]] -> [[Double]]
forall a. Semigroup a => a -> a -> a
(<>) ((Map k [Double] -> Map k [[Double]])
-> f (Map k [Double]) -> f (Map k [[Double]])
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([Double] -> [[Double]]) -> Map k [Double] -> Map k [[Double]]
forall a b. (a -> b) -> Map k a -> Map k b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Double] -> [[Double]] -> [[Double]]
forall a. a -> [a] -> [a]
: [])) (f (Map k [[Double]]) -> f (Map k [Double])
forall {f :: * -> *} {f :: * -> *}.
(Functor f, Functor f) =>
f (f [[Double]]) -> f (f [Double])
ms f (Map k [[Double]])
m')))
    os' :: f (Map Text [[Double]]) -> [([Text], Doc ann)]
os' f (Map Text [[Double]])
m' = [[([Text], Doc ann)]] -> [([Text], Doc ann)]
forall a. Monoid a => [a] -> a
mconcat ([[([Text], Doc ann)]] -> [([Text], Doc ann)])
-> [[([Text], Doc ann)]] -> [([Text], Doc ann)]
forall a b. (a -> b) -> a -> b
$ (\(Text
ks, [Doc ann]
xss) -> (Doc ann -> Text -> ([Text], Doc ann))
-> [Doc ann] -> [Text] -> [([Text], Doc ann)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Doc ann
x Text
l' -> ([Text
ks] [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text
l'], Doc ann
x)) [Doc ann]
xss (MeasureType -> [Text]
measureLabels (ReportOptions -> MeasureType
reportMeasureType ReportOptions
o))) ((Text, [Doc ann]) -> [([Text], Doc ann)])
-> [(Text, [Doc ann])] -> [[([Text], Doc ann)]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Text [Doc ann] -> [(Text, [Doc ann])]
forall k a. Map k a -> [(k, a)]
Map.toList (f (Map Text [[Double]]) -> Map Text [Doc ann]
forall {f :: * -> *} {k} {ann}.
(Foldable f, Ord k, Functor f) =>
f (Map k [[Double]]) -> Map k [Doc ann]
os f (Map Text [[Double]])
m')
    os'' :: f (Map Text [[Double]]) -> [Doc ann]
os'' f (Map Text [[Double]])
m' = (\([Text]
k, Doc ann
v) -> (Text -> Doc ann
forall ann. Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Text -> Doc ann) -> ([Text] -> Text) -> [Text] -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> Text
Text.intercalate Text
":") [Text]
k Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
" " Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
v) (([Text], Doc ann) -> Doc ann) -> [([Text], Doc ann)] -> [Doc ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (Map Text [[Double]]) -> [([Text], Doc ann)]
forall {f :: * -> *} {ann}.
(Foldable f, Functor f) =>
f (Map Text [[Double]]) -> [([Text], Doc ann)]
os' f (Map Text [[Double]])
m'

reportTasty' :: Example -> ReportOptions -> IO ()
reportTasty' :: Example -> ReportOptions -> IO ()
reportTasty' Example
ex ReportOptions
o = do
  Double
t <- Timeout -> RelStDev -> Benchmarkable -> IO Double
measureCpuTime (Integer -> Timeout
mkTimeout Integer
1000000) (Double -> RelStDev
RelStDev Double
0.05) (ExamplePattern Int -> Benchmarkable
tastyExample (Example -> Int -> ExamplePattern Int
examplePattern Example
ex (Optic' A_Lens NoIx ReportOptions Int -> ReportOptions -> Int
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx ReportOptions Int
#reportLength ReportOptions
o)))
  Text -> IO ()
Text.putStrLn (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
"tasty:time: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Maybe Int -> Double -> Text
decimal (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
3) (Double
t Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
1e9)