{-# LANGUAGE CPP #-}
{-# 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.Time (defaultClock)
import Perf.Types
import System.Clock
import System.Exit
import Text.Printf hiding (parseFormat)
import Text.Read
type Name = String
data = | 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)
parseHeader :: Parser Header
=
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")
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")
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
data ReportOptions = ReportOptions
{
ReportOptions -> Int
reportN :: Int,
ReportOptions -> Clock
reportClock :: Clock,
ReportOptions -> StatDType
reportStatDType :: StatDType,
ReportOptions -> MeasureType
reportMeasureType :: MeasureType,
ReportOptions -> Golden
reportGolden :: Golden,
:: Header,
ReportOptions -> CompareLevels
reportCompare :: CompareLevels
}
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)
defaultReportOptions :: ReportOptions
defaultReportOptions :: ReportOptions
defaultReportOptions =
Int
-> Clock
-> StatDType
-> MeasureType
-> Golden
-> Header
-> CompareLevels
-> ReportOptions
ReportOptions
Int
1000
Clock
defaultClock
StatDType
StatAverage
MeasureType
MeasureTime
Golden
defaultGolden
Header
Header
CompareLevels
defaultCompareLevels
parseReportOptions :: Parser ReportOptions
parseReportOptions :: Parser ReportOptions
parseReportOptions =
Int
-> Clock
-> StatDType
-> MeasureType
-> Golden
-> Header
-> CompareLevels
-> ReportOptions
ReportOptions
(Int
-> Clock
-> StatDType
-> MeasureType
-> Golden
-> Header
-> CompareLevels
-> ReportOptions)
-> Parser Int
-> Parser
(Clock
-> StatDType
-> MeasureType
-> Golden
-> Header
-> CompareLevels
-> 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 Int
1000 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. FilePath -> Mod f a
help FilePath
"number of runs to perform")
Parser
(Clock
-> StatDType
-> MeasureType
-> Golden
-> Header
-> CompareLevels
-> ReportOptions)
-> Parser Clock
-> Parser
(StatDType
-> MeasureType
-> Golden
-> Header
-> CompareLevels
-> 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
-> ReportOptions)
-> Parser StatDType
-> Parser
(MeasureType -> Golden -> Header -> CompareLevels -> 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 -> ReportOptions)
-> Parser MeasureType
-> Parser (Golden -> Header -> CompareLevels -> 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 -> ReportOptions)
-> Parser Golden
-> Parser (Header -> CompareLevels -> 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 -> ReportOptions)
-> Parser Header -> Parser (CompareLevels -> 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 -> ReportOptions)
-> Parser CompareLevels -> 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
<*> CompareLevels -> Parser CompareLevels
parseCompareLevels CompareLevels
defaultCompareLevels
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")
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")
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")
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")
#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")
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
infoReportOptions :: ParserInfo ReportOptions
infoReportOptions :: ParserInfo ReportOptions
infoReportOptions =
Parser ReportOptions
-> InfoMod ReportOptions -> ParserInfo ReportOptions
forall a. Parser a -> InfoMod a -> ParserInfo a
info
(Parser ReportOptions
parseReportOptions Parser ReportOptions
-> Parser (ReportOptions -> ReportOptions) -> Parser ReportOptions
forall (f :: * -> *) a b. Applicative f => f a -> f (a -> b) -> f b
<**> Parser (ReportOptions -> ReportOptions)
forall a. Parser (a -> a)
helper)
(InfoMod ReportOptions
forall a. InfoMod a
fullDesc InfoMod ReportOptions
-> InfoMod ReportOptions -> InfoMod ReportOptions
forall a. Semigroup a => a -> a -> a
<> FilePath -> InfoMod ReportOptions
forall a. FilePath -> InfoMod a
progDesc FilePath
"perf benchmarking" InfoMod ReportOptions
-> InfoMod ReportOptions -> InfoMod ReportOptions
forall a. Semigroup a => a -> a -> a
<> FilePath -> InfoMod ReportOptions
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 <- ParserInfo ReportOptions -> IO ReportOptions
forall a. ParserInfo a -> IO a
execParser ParserInfo ReportOptions
infoReportOptions
ReportOptions -> FilePath -> PerfT IO [[Double]] a -> IO ()
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 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
Map Text [[Double]]
m <- 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 MeasureType
mt Clock
c Int
n) PerfT IO [[Double]] a
t
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)
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
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
(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
<> 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. FilePath -> Mod f a
help FilePath
"error level")
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
<> 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. FilePath -> Mod f a
help FilePath
"warning level")
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
<> 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. 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 (Map [Text] Double -> FilePath
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 <- 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
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)
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
""
formatHeader :: Map.Map [Text] a -> [Text] -> [Text]
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
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
]
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)
reportOrg2D :: Map.Map [Text] Text -> IO ()
reportOrg2D :: Map [Text] Text -> IO ()
reportOrg2D Map [Text] Text
m = do
let 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], Text) -> [Text]) -> ([Text], Text) -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Text], Text) -> [Text]
forall a b. (a, b) -> a
fst (([Text], Text) -> Text) -> [([Text], Text)] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map [Text] Text -> [([Text], Text)]
forall k a. Map k a -> [(k, a)]
Map.toList Map [Text] Text
m)
let 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], Text) -> [Text]) -> ([Text], Text) -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Text], Text) -> [Text]
forall a b. (a, b) -> a
fst (([Text], Text) -> Text) -> [([Text], Text)] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map [Text] Text -> [([Text], Text)]
forall k a. Map k a -> [(k, a)]
Map.toList Map [Text] Text
m)
Text -> IO ()
Text.putStrLn (Text
"||" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
Text.intercalate Text
"|" [Text]
rs Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"|")
(Text -> IO ()) -> [Text] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_
( \Text
c ->
Text -> IO ()
Text.putStrLn
( Text
"|"
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
c
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"|"
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
Text.intercalate Text
"|" ((\Text
r -> Map [Text] Text
m Map [Text] Text -> [Text] -> Text
forall k a. Ord k => Map k a -> k -> a
Map.! [Text
c, Text
r]) (Text -> Text) -> [Text] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
rs)
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"|"
)
)
[Text]
cs
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
data Golden = Golden {Golden -> FilePath
golden :: FilePath, Golden -> Bool
check :: Bool, Golden -> Bool
record :: Bool} 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)
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 = 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"
replaceDefaultFilePath :: FilePath -> ReportOptions -> ReportOptions
replaceDefaultFilePath :: FilePath -> ReportOptions -> ReportOptions
replaceDefaultFilePath FilePath
fp ReportOptions
o =
ReportOptions
o {reportGolden = replaceGoldenDefault (defaultGoldenPath fp) (reportGolden o)}
parseGolden :: Parser Golden
parseGolden :: Parser Golden
parseGolden =
FilePath -> Bool -> Bool -> Golden
Golden
(FilePath -> Bool -> Bool -> Golden)
-> Parser FilePath -> Parser (Bool -> Bool -> 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
Options.Applicative.value (Golden -> FilePath
golden Golden
defaultGolden) 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. FilePath -> Mod f a
help FilePath
"golden file name")
Parser (Bool -> Bool -> Golden)
-> Parser Bool -> Parser (Bool -> Golden)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => 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 (Bool -> Golden) -> Parser Bool -> 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
<*> 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 :: 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
(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'
Bool -> IO () -> IO ()
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 = 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