{-# LANGUAGE OverloadedStrings #-}
module Perf.Report
( Name,
Header (..),
parseHeader,
CompareLevels (..),
defaultCompareLevels,
parseCompareLevels,
ReportOptions (..),
defaultReportOptions,
parseReportOptions,
infoReportOptions,
report,
reportMain,
reportMainWith,
writeResult,
readResult,
CompareResult (..),
compareNote,
reportOrg2D,
Golden (..),
defaultGolden,
parseGolden,
replaceDefaultFilePath,
)
where
import Control.Exception
import Control.Monad
import Data.Bool
import Data.Foldable
import Data.FormatN hiding (format)
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 Options.Applicative
import Perf.Measure
import Perf.Stats
import Perf.Types
import System.Exit
import Text.Printf hiding (parseFormat)
import Text.Read
type Name = String
data = | deriving (Header -> Header -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Header -> Header -> Bool
$c/= :: Header -> Header -> Bool
== :: Header -> Header -> Bool
$c== :: Header -> Header -> Bool
Eq, Int -> Header -> ShowS
[Header] -> ShowS
Header -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Header] -> ShowS
$cshowList :: [Header] -> ShowS
show :: Header -> FilePath
$cshow :: Header -> FilePath
showsPrec :: Int -> Header -> ShowS
$cshowsPrec :: Int -> Header -> ShowS
Show, 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
$cto :: forall x. Rep Header x -> Header
$cfrom :: forall x. Header -> Rep Header x
Generic)
parseHeader :: Parser Header
=
forall a. a -> Mod FlagFields a -> Parser a
flag' Header
Header (forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"header" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"include headers")
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a. a -> Mod FlagFields a -> Parser a
flag' Header
NoHeader (forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"noheader" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"dont include headers")
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Applicative f => a -> f a
pure Header
Header
data ReportOptions = ReportOptions
{
ReportOptions -> Int
reportN :: Int,
ReportOptions -> StatDType
reportStatDType :: StatDType,
ReportOptions -> MeasureType
reportMeasureType :: MeasureType,
ReportOptions -> Golden
reportGolden :: Golden,
:: Header,
ReportOptions -> CompareLevels
reportCompare :: CompareLevels
}
deriving (ReportOptions -> ReportOptions -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ReportOptions -> ReportOptions -> Bool
$c/= :: ReportOptions -> ReportOptions -> Bool
== :: ReportOptions -> ReportOptions -> Bool
$c== :: ReportOptions -> ReportOptions -> Bool
Eq, Int -> ReportOptions -> ShowS
[ReportOptions] -> ShowS
ReportOptions -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [ReportOptions] -> ShowS
$cshowList :: [ReportOptions] -> ShowS
show :: ReportOptions -> FilePath
$cshow :: ReportOptions -> FilePath
showsPrec :: Int -> ReportOptions -> ShowS
$cshowsPrec :: Int -> ReportOptions -> ShowS
Show, 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
$cto :: forall x. Rep ReportOptions x -> ReportOptions
$cfrom :: forall x. ReportOptions -> Rep ReportOptions x
Generic)
defaultReportOptions :: ReportOptions
defaultReportOptions :: ReportOptions
defaultReportOptions =
Int
-> StatDType
-> MeasureType
-> Golden
-> Header
-> CompareLevels
-> ReportOptions
ReportOptions
Int
1000
StatDType
StatAverage
MeasureType
MeasureTime
Golden
defaultGolden
Header
Header
CompareLevels
defaultCompareLevels
parseReportOptions :: Parser ReportOptions
parseReportOptions :: Parser ReportOptions
parseReportOptions =
Int
-> StatDType
-> MeasureType
-> Golden
-> Header
-> CompareLevels
-> ReportOptions
ReportOptions
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. ReadM a -> Mod OptionFields a -> Parser a
option forall a. Read a => ReadM a
auto (forall (f :: * -> *) a. HasValue f => a -> Mod f a
value Int
1000 forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"runs" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'n' forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"number of runs to perform")
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser StatDType
parseStatD
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser MeasureType
parseMeasure
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Golden
parseGolden
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Header
parseHeader
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> CompareLevels -> Parser CompareLevels
parseCompareLevels CompareLevels
defaultCompareLevels
infoReportOptions :: ParserInfo ReportOptions
infoReportOptions :: ParserInfo ReportOptions
infoReportOptions =
forall a. Parser a -> InfoMod a -> ParserInfo a
info
(Parser ReportOptions
parseReportOptions forall (f :: * -> *) a b. Applicative f => f a -> f (a -> b) -> f b
<**> forall a. Parser (a -> a)
helper)
(forall a. InfoMod a
fullDesc forall a. Semigroup a => a -> a -> a
<> forall a. FilePath -> InfoMod a
progDesc FilePath
"perf benchmarking" forall a. Semigroup a => a -> a -> a
<> forall a. FilePath -> InfoMod a
header FilePath
"reporting options")
reportMain :: Name -> PerfT IO [[Double]] a -> IO ()
reportMain :: forall a. FilePath -> PerfT IO [[Double]] a -> IO ()
reportMain FilePath
name PerfT IO [[Double]] a
t = do
ReportOptions
o <- forall a. ParserInfo a -> IO a
execParser ParserInfo ReportOptions
infoReportOptions
forall a.
ReportOptions -> FilePath -> PerfT IO [[Double]] a -> IO ()
reportMainWith ReportOptions
o FilePath
name PerfT IO [[Double]] a
t
reportMainWith :: ReportOptions -> Name -> PerfT IO [[Double]] a -> IO ()
reportMainWith :: forall a.
ReportOptions -> FilePath -> PerfT IO [[Double]] a -> IO ()
reportMainWith ReportOptions
o FilePath
name PerfT IO [[Double]] a
t = do
let !n :: Int
n = ReportOptions -> Int
reportN ReportOptions
o
let s :: StatDType
s = ReportOptions -> StatDType
reportStatDType ReportOptions
o
let mt :: MeasureType
mt = ReportOptions -> MeasureType
reportMeasureType ReportOptions
o
let o' :: ReportOptions
o' = FilePath -> ReportOptions -> ReportOptions
replaceDefaultFilePath (forall a. [a] -> [[a]] -> [a]
intercalate FilePath
"-" [FilePath
name, forall a. Show a => a -> FilePath
show Int
n, forall a. Show a => a -> FilePath
show MeasureType
mt, forall a. Show a => a -> FilePath
show StatDType
s]) ReportOptions
o
Map Text [[Double]]
m <- forall (m :: * -> *) t a.
Monad m =>
Measure m t -> PerfT m t a -> m (Map Text t)
execPerfT (MeasureType -> Int -> Measure IO [[Double]]
measureDs MeasureType
mt Int
n) PerfT IO [[Double]] a
t
ReportOptions -> Map [Text] [Double] -> IO ()
report ReportOptions
o' (forall a.
Ord a =>
StatDType -> Map a [[Double]] -> Map [a] [Double]
statify StatDType
s Map Text [[Double]]
m)
data CompareLevels = CompareLevels {CompareLevels -> Double
errorLevel :: Double, CompareLevels -> Double
warningLevel :: Double, CompareLevels -> Double
improvedLevel :: Double} deriving (CompareLevels -> CompareLevels -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CompareLevels -> CompareLevels -> Bool
$c/= :: CompareLevels -> CompareLevels -> Bool
== :: CompareLevels -> CompareLevels -> Bool
$c== :: CompareLevels -> CompareLevels -> Bool
Eq, Int -> CompareLevels -> ShowS
[CompareLevels] -> ShowS
CompareLevels -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [CompareLevels] -> ShowS
$cshowList :: [CompareLevels] -> ShowS
show :: CompareLevels -> FilePath
$cshow :: CompareLevels -> FilePath
showsPrec :: Int -> CompareLevels -> ShowS
$cshowsPrec :: Int -> CompareLevels -> ShowS
Show)
defaultCompareLevels :: CompareLevels
defaultCompareLevels :: CompareLevels
defaultCompareLevels = Double -> Double -> Double -> CompareLevels
CompareLevels Double
0.2 Double
0.05 Double
0.05
parseCompareLevels :: CompareLevels -> Parser CompareLevels
parseCompareLevels :: CompareLevels -> Parser CompareLevels
parseCompareLevels CompareLevels
c =
Double -> Double -> Double -> CompareLevels
CompareLevels
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. ReadM a -> Mod OptionFields a -> Parser a
option forall a. Read a => ReadM a
auto (forall (f :: * -> *) a. HasValue f => a -> Mod f a
value (CompareLevels -> Double
errorLevel CompareLevels
c) forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"error" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"error level")
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. ReadM a -> Mod OptionFields a -> Parser a
option forall a. Read a => ReadM a
auto (forall (f :: * -> *) a. HasValue f => a -> Mod f a
value (CompareLevels -> Double
warningLevel CompareLevels
c) forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"warning" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"warning level")
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. ReadM a -> Mod OptionFields a -> Parser a
option forall a. Read a => ReadM a
auto (forall (f :: * -> *) a. HasValue f => a -> Mod f a
value (CompareLevels -> Double
improvedLevel CompareLevels
c) forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"improved" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"improved level")
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 (forall a. Show a => a -> FilePath
show Map [Text] Double
m)
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 <- forall e a. Exception e => IO a -> IO (Either e a)
try (FilePath -> IO FilePath
readFile FilePath
f)
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> FilePath
show) forall a. Read a => FilePath -> Either FilePath a
readEither Either SomeException FilePath
a
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
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [CompareResult] -> ShowS
$cshowList :: [CompareResult] -> ShowS
show :: CompareResult -> FilePath
$cshow :: CompareResult -> FilePath
showsPrec :: Int -> CompareResult -> ShowS
$cshowsPrec :: Int -> CompareResult -> ShowS
Show, CompareResult -> CompareResult -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CompareResult -> CompareResult -> Bool
$c/= :: CompareResult -> CompareResult -> Bool
== :: CompareResult -> CompareResult -> Bool
$c== :: CompareResult -> CompareResult -> Bool
Eq)
hasDegraded :: Map.Map a CompareResult -> Bool
hasDegraded :: forall a. Map a CompareResult -> Bool
hasDegraded Map a CompareResult
m = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((forall a. Eq a => a -> a -> Bool
== Text
"degraded") forall b c a. (b -> c) -> (a -> b) -> a -> c
. CompareResult -> Text
noteResult) forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> b
snd (forall k a. Map k a -> [(k, a)]
Map.toList Map a CompareResult
m)
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 =
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
(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 forall a. Maybe a
Nothing (forall a. a -> Maybe a
Just Double
x') Text
"new result"))
(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 (forall a. a -> Maybe a
Just Double
x') forall a. Maybe a
Nothing Text
"old result not found"))
( 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 (forall a. a -> Maybe a
Just Double
x') (forall a. a -> Maybe a
Just Double
y') (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' forall a. Fractional a => a -> a -> a
/ Double
x' forall a. Ord a => a -> a -> Bool
> Double
1 forall a. Num a => a -> a -> a
+ CompareLevels -> Double
errorLevel CompareLevels
cfg = a
"degraded"
| Double
y' forall a. Fractional a => a -> a -> a
/ Double
x' forall a. Ord a => a -> a -> Bool
> Double
1 forall a. Num a => a -> a -> a
+ CompareLevels -> Double
warningLevel CompareLevels
cfg = a
"slightly-degraded"
| Double
y' forall a. Fractional a => a -> a -> a
/ Double
x' forall a. Ord a => a -> a -> Bool
< (Double
1 forall a. Num a => a -> a -> a
- CompareLevels -> Double
improvedLevel CompareLevels
cfg) = a
"improvement"
| Bool
otherwise = a
""
formatHeader :: Map.Map [Text] a -> [Text] -> [Text]
Map [Text] a
m [Text]
ts =
[forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ FilePath -> Text
Text.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r. PrintfType r => FilePath -> r
printf FilePath
"%-16s" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (((Text
"label" <>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
Text.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> FilePath
show forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Int
1 .. Int
labelCols]) forall a. Semigroup a => a -> a -> a
<> [Text]
ts), forall a. Monoid a => a
mempty]
where
labelCols :: Int
labelCols = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall k a. Map k a -> [k]
Map.keys Map [Text] a
m
formatCompare :: Header -> Map.Map [Text] CompareResult -> [Text]
formatCompare :: Header -> Map [Text] CompareResult -> [Text]
formatCompare Header
h Map [Text] CompareResult
m =
forall a. a -> a -> Bool -> a
bool [] (forall a. Map [Text] a -> [Text] -> [Text]
formatHeader Map [Text] CompareResult
m [Text
"old result", Text
"new result", Text
"change"]) (Header
h forall a. Eq a => a -> a -> Bool
== Header
Header)
forall a. Semigroup a => a -> a -> a
<> forall k a. Map k a -> [a]
Map.elems (forall k a b. (k -> a -> b) -> Map k a -> Map k b
Map.mapWithKey (\[Text]
k CompareResult
a -> FilePath -> Text
Text.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall r. PrintfType r => FilePath -> r
printf FilePath
"%-16s" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Text]
k 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) =
[ forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty (Maybe Int -> Double -> Text
expt (forall a. a -> Maybe a
Just Int
3)) Maybe Double
x,
forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty (Maybe Int -> Double -> Text
expt (forall a. a -> Maybe a
Just Int
3)) Maybe Double
y,
Text
n
]
formatText :: Header -> Map.Map [Text] Text -> [Text]
formatText :: Header -> Map [Text] Text -> [Text]
formatText Header
h Map [Text] Text
m =
forall a. a -> a -> Bool -> a
bool [] (forall a. Map [Text] a -> [Text] -> [Text]
formatHeader Map [Text] Text
m [Text
"results"]) (Header
h forall a. Eq a => a -> a -> Bool
== Header
Header)
forall a. Semigroup a => a -> a -> a
<> forall k a. Map k a -> [a]
Map.elems (forall k a b. (k -> a -> b) -> Map k a -> Map k b
Map.mapWithKey (\[Text]
k Text
a -> FilePath -> Text
Text.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall r. PrintfType r => FilePath -> r
printf FilePath
"%-16s" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Text]
k forall a. Semigroup a => a -> a -> a
<> [Text
a])) Map [Text] Text
m)
reportOrg2D :: Map.Map [Text] Text -> IO ()
reportOrg2D :: Map [Text] Text -> IO ()
reportOrg2D Map [Text] Text
m = do
let rs :: [Text]
rs = forall a. Eq a => [a] -> [a]
List.nub ((forall a. [a] -> Int -> a
List.!! Int
1) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall k a. Map k a -> [(k, a)]
Map.toList Map [Text] Text
m)
let cs :: [Text]
cs = forall a. Eq a => [a] -> [a]
List.nub ((forall a. [a] -> Int -> a
List.!! Int
0) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall k a. Map k a -> [(k, a)]
Map.toList Map [Text] Text
m)
Text -> IO ()
Text.putStrLn (Text
"||" forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
Text.intercalate Text
"|" [Text]
rs forall a. Semigroup a => a -> a -> a
<> Text
"|")
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_
( \Text
c ->
Text -> IO ()
Text.putStrLn
( Text
"|"
forall a. Semigroup a => a -> a -> a
<> Text
c
forall a. Semigroup a => a -> a -> a
<> Text
"|"
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
Text.intercalate Text
"|" ((\Text
r -> Map [Text] Text
m forall k a. Ord k => Map k a -> k -> a
Map.! [Text
c, Text
r]) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
rs)
forall a. Semigroup a => a -> a -> a
<> Text
"|"
)
)
[Text]
cs
reportToConsole :: [Text] -> IO ()
reportToConsole :: [Text] -> IO ()
reportToConsole [Text]
xs = forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ Text -> IO ()
Text.putStrLn [Text]
xs
data Golden = Golden {Golden -> FilePath
golden :: FilePath, Golden -> Bool
check :: Bool, Golden -> Bool
record :: Bool} deriving (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
$cto :: forall x. Rep Golden x -> Golden
$cfrom :: forall x. Golden -> Rep Golden x
Generic, Golden -> Golden -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Golden -> Golden -> Bool
$c/= :: Golden -> Golden -> Bool
== :: Golden -> Golden -> Bool
$c== :: Golden -> Golden -> Bool
Eq, Int -> Golden -> ShowS
[Golden] -> ShowS
Golden -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Golden] -> ShowS
$cshowList :: [Golden] -> ShowS
show :: Golden -> FilePath
$cshow :: Golden -> FilePath
showsPrec :: Int -> Golden -> ShowS
$cshowsPrec :: Int -> Golden -> ShowS
Show)
defaultGolden :: Golden
defaultGolden :: Golden
defaultGolden = FilePath -> Bool -> Bool -> Golden
Golden FilePath
"other/bench.perf" Bool
True Bool
False
replaceGoldenDefault :: FilePath -> Golden -> Golden
replaceGoldenDefault :: FilePath -> Golden -> Golden
replaceGoldenDefault FilePath
s Golden
g = forall a. a -> a -> Bool -> a
bool Golden
g Golden
g {golden :: FilePath
golden = FilePath
s} (Golden -> FilePath
golden Golden
g forall a. Eq a => a -> a -> Bool
== Golden -> FilePath
golden Golden
defaultGolden)
defaultGoldenPath :: FilePath -> FilePath
defaultGoldenPath :: ShowS
defaultGoldenPath FilePath
fp = FilePath
"other/" forall a. Semigroup a => a -> a -> a
<> FilePath
fp forall a. Semigroup a => a -> a -> a
<> FilePath
".perf"
replaceDefaultFilePath :: FilePath -> ReportOptions -> ReportOptions
replaceDefaultFilePath :: FilePath -> ReportOptions -> ReportOptions
replaceDefaultFilePath FilePath
fp ReportOptions
o =
ReportOptions
o {reportGolden :: Golden
reportGolden = FilePath -> Golden -> Golden
replaceGoldenDefault (ShowS
defaultGoldenPath FilePath
fp) (ReportOptions -> Golden
reportGolden ReportOptions
o)}
parseGolden :: Parser Golden
parseGolden :: Parser Golden
parseGolden =
FilePath -> Bool -> Bool -> Golden
Golden
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. ReadM a -> Mod OptionFields a -> Parser a
option forall s. IsString s => ReadM s
str (forall (f :: * -> *) a. HasValue f => a -> Mod f a
Options.Applicative.value (Golden -> FilePath
golden Golden
defaultGolden) forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"golden" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'g' forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"golden file name")
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. a -> a -> Mod FlagFields a -> Parser a
flag Bool
True Bool
False (forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"nocheck" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"do not check versus the golden file")
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mod FlagFields Bool -> Parser Bool
switch (forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"record" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'r' forall a. Semigroup a => a -> a -> a
<> 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 (forall a. a -> Maybe a
Just Int
3) 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 :: ReportOptions -> Map.Map [Text] [Double] -> IO ()
report :: ReportOptions -> Map [Text] [Double] -> IO ()
report ReportOptions
o Map [Text] [Double]
m = do
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when
(Golden -> Bool
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 -> Bool
check (ReportOptions -> Golden
reportGolden ReportOptions
o) of
Bool
False -> Header -> Map [Text] Double -> IO ()
reportConsoleNoCompare (ReportOptions -> Header
reportHeader ReportOptions
o) Map [Text] Double
m'
Bool
True -> 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'
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless
(Golden -> Bool
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 = 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
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall a. Map a CompareResult -> Bool
hasDegraded Map [Text] CompareResult
n) (forall a. ExitCode -> IO a
exitWith forall a b. (a -> b) -> a -> b
$ Int -> ExitCode
ExitFailure Int
1)
where
m' :: Map [Text] Double
m' = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ (\([Text]
ks, [Double]
xss) -> forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Double
x Text
l -> ([Text]
ks forall a. Semigroup a => a -> a -> a
<> [Text
l], Double
x)) [Double]
xss (MeasureType -> [Text]
measureLabels (ReportOptions -> MeasureType
reportMeasureType ReportOptions
o))) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall k a. Map k a -> [(k, a)]
Map.toList Map [Text] [Double]
m