{-# LANGUAGE OverloadedStrings #-}
module Perf.Report
( Format (..),
parseFormat,
Header (..),
parseHeader,
CompareLevels (..),
defaultCompareLevels,
parseCompareLevels,
ReportConfig (..),
defaultReportConfig,
parseReportConfig,
writeResult,
readResult,
CompareResult (..),
compareNote,
outercalate,
reportGolden,
reportOrg2D,
Golden (..),
defaultGolden,
goldenFromOptions,
parseGolden,
report,
)
where
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 Text.Printf hiding (parseFormat)
data Format = OrgMode | ConsoleMode deriving (Format -> Format -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Format -> Format -> Bool
$c/= :: Format -> Format -> Bool
== :: Format -> Format -> Bool
$c== :: Format -> Format -> Bool
Eq, Int -> Format -> ShowS
[Format] -> ShowS
Format -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Format] -> ShowS
$cshowList :: [Format] -> ShowS
show :: Format -> FilePath
$cshow :: Format -> FilePath
showsPrec :: Int -> Format -> ShowS
$cshowsPrec :: Int -> Format -> ShowS
Show, forall x. Rep Format x -> Format
forall x. Format -> Rep Format x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Format x -> Format
$cfrom :: forall x. Format -> Rep Format x
Generic)
parseFormat :: Format -> Parser Format
parseFormat :: Format -> Parser Format
parseFormat Format
f =
forall a. a -> Mod FlagFields a -> Parser a
flag' Format
OrgMode (forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"orgmode" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"report using orgmode table format")
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a. a -> Mod FlagFields a -> Parser a
flag' Format
ConsoleMode (forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"console" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"report using plain table format")
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Applicative f => a -> f a
pure Format
f
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 :: Header -> Parser Header
Header
h =
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
h
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")
data ReportConfig = ReportConfig
{ ReportConfig -> Format
format :: Format,
:: Header,
ReportConfig -> CompareLevels
levels :: CompareLevels
}
deriving (ReportConfig -> ReportConfig -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ReportConfig -> ReportConfig -> Bool
$c/= :: ReportConfig -> ReportConfig -> Bool
== :: ReportConfig -> ReportConfig -> Bool
$c== :: ReportConfig -> ReportConfig -> Bool
Eq, Int -> ReportConfig -> ShowS
[ReportConfig] -> ShowS
ReportConfig -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [ReportConfig] -> ShowS
$cshowList :: [ReportConfig] -> ShowS
show :: ReportConfig -> FilePath
$cshow :: ReportConfig -> FilePath
showsPrec :: Int -> ReportConfig -> ShowS
$cshowsPrec :: Int -> ReportConfig -> ShowS
Show, forall x. Rep ReportConfig x -> ReportConfig
forall x. ReportConfig -> Rep ReportConfig x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ReportConfig x -> ReportConfig
$cfrom :: forall x. ReportConfig -> Rep ReportConfig x
Generic)
defaultReportConfig :: ReportConfig
defaultReportConfig :: ReportConfig
defaultReportConfig = Format -> Header -> CompareLevels -> ReportConfig
ReportConfig Format
ConsoleMode Header
Header CompareLevels
defaultCompareLevels
parseReportConfig :: ReportConfig -> Parser ReportConfig
parseReportConfig :: ReportConfig -> Parser ReportConfig
parseReportConfig ReportConfig
c =
Format -> Header -> CompareLevels -> ReportConfig
ReportConfig
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Format -> Parser Format
parseFormat (ReportConfig -> Format
format ReportConfig
c)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Header -> Parser Header
parseHeader (ReportConfig -> Header
includeHeader ReportConfig
c)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> CompareLevels -> Parser CompareLevels
parseCompareLevels (ReportConfig -> CompareLevels
levels ReportConfig
c)
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 (Map.Map [Text] Double)
readResult :: FilePath -> IO (Map [Text] Double)
readResult FilePath
f = do
FilePath
a <- FilePath -> IO FilePath
readFile FilePath
f
forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. Read a => FilePath -> a
read 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)
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
""
outercalate :: Text -> [Text] -> Text
outercalate :: Text -> [Text] -> Text
outercalate Text
c [Text]
ts = Text
c forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
Text.intercalate Text
c [Text]
ts forall a. Semigroup a => a -> a -> a
<> Text
c
reportGolden :: ReportConfig -> FilePath -> Map.Map [Text] Double -> IO ()
reportGolden :: ReportConfig -> FilePath -> Map [Text] Double -> IO ()
reportGolden ReportConfig
cfg FilePath
f Map [Text] Double
m = do
Map [Text] Double
mOrig <- FilePath -> IO (Map [Text] Double)
readResult FilePath
f
let n :: Map [Text] CompareResult
n = forall a.
Ord a =>
CompareLevels
-> Map a Double -> Map a Double -> Map a CompareResult
compareNote (ReportConfig -> CompareLevels
levels ReportConfig
cfg) Map [Text] Double
mOrig Map [Text] Double
m
[Text] -> IO ()
reportToConsole forall a b. (a -> b) -> a -> b
$ Format -> Header -> Map [Text] CompareResult -> [Text]
formatCompare (ReportConfig -> Format
format ReportConfig
cfg) (ReportConfig -> Header
includeHeader ReportConfig
cfg) Map [Text] CompareResult
n
formatOrgHeader :: Map.Map [Text] a -> [Text] -> [Text]
Map [Text] a
m [Text]
ts =
[ Text -> [Text] -> Text
outercalate Text
"|" (((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),
Text -> [Text] -> Text
outercalate Text
"|" (forall a. Int -> a -> [a]
replicate (Int
labelCols forall a. Num a => a -> a -> a
+ Int
1) Text
"---")
]
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
formatConsoleHeader :: 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
"%-20s" 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 :: Format -> Header -> Map.Map [Text] CompareResult -> [Text]
formatCompare :: Format -> Header -> Map [Text] CompareResult -> [Text]
formatCompare Format
f Header
h Map [Text] CompareResult
m =
case Format
f of
Format
OrgMode ->
forall a. a -> a -> Bool -> a
bool [] (forall a. Map [Text] a -> [Text] -> [Text]
formatOrgHeader Map [Text] CompareResult
m [Text
"old_result", Text
"new_result", Text
"status"]) (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 -> Text -> [Text] -> Text
outercalate Text
"|" ([Text]
k forall a. Semigroup a => a -> a -> a
<> CompareResult -> [Text]
compareReport CompareResult
a)) Map [Text] CompareResult
m)
Format
ConsoleMode ->
forall a. a -> a -> Bool -> a
bool [] (forall a. Map [Text] a -> [Text] -> [Text]
formatConsoleHeader Map [Text] CompareResult
m [Text
"old_result", Text
"new_result", Text
"status"]) (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
"%-20s" 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
]
formatOrg :: Header -> Map.Map [Text] Text -> [Text]
formatOrg :: Header -> Map [Text] Text -> [Text]
formatOrg Header
h Map [Text] Text
m =
forall a. a -> a -> Bool -> a
bool [] (forall a. Map [Text] a -> [Text] -> [Text]
formatOrgHeader 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 -> Text -> [Text] -> Text
outercalate Text
"|" ([Text]
k forall a. Semigroup a => a -> a -> a
<> [Text
a])) Map [Text] Text
m)
formatConsole :: Header -> Map.Map [Text] Text -> [Text]
formatConsole :: Header -> Map [Text] Text -> [Text]
formatConsole Header
h Map [Text] Text
m =
forall a. a -> a -> Bool -> a
bool [] (forall a. Map [Text] a -> [Text] -> [Text]
formatConsoleHeader 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
"%-20s" 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/golden.perf" Bool
False Bool
False
goldenFromOptions :: [String] -> Golden -> Golden
goldenFromOptions :: [FilePath] -> Golden -> Golden
goldenFromOptions [FilePath]
xs Golden
g = forall a. a -> a -> Bool -> a
bool Golden
g Golden
g {golden :: FilePath
golden = FilePath
fp} (Golden -> FilePath
golden Golden
g forall a. Eq a => a -> a -> Bool
== Golden -> FilePath
golden Golden
defaultGolden)
where
fp :: FilePath
fp = FilePath
"other/" forall a. Semigroup a => a -> a -> a
<> forall a. [a] -> [[a]] -> [a]
intercalate FilePath
"-" [FilePath]
xs forall a. Semigroup a => a -> a -> a
<> FilePath
".perf"
parseGolden :: String -> Parser Golden
parseGolden :: FilePath -> Parser Golden
parseGolden FilePath
def =
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 (FilePath
"other/" forall a. Semigroup a => a -> a -> a
<> FilePath
def forall a. Semigroup a => a -> a -> a
<> FilePath
".perf") 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
<*> Mod FlagFields Bool -> Parser Bool
switch (forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"check" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'c' forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"check versus a 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 a golden file")
report :: ReportConfig -> Golden -> [Text] -> Map.Map [Text] [Double] -> IO ()
report :: ReportConfig -> Golden -> [Text] -> Map [Text] [Double] -> IO ()
report ReportConfig
cfg Golden
g [Text]
labels Map [Text] [Double]
m = do
forall a. a -> a -> Bool -> a
bool
([Text] -> IO ()
reportToConsole (Format -> Header -> Map [Text] Text -> [Text]
formatIn (ReportConfig -> Format
format ReportConfig
cfg) (ReportConfig -> Header
includeHeader ReportConfig
cfg) (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')))
(ReportConfig -> FilePath -> Map [Text] Double -> IO ()
reportGolden ReportConfig
cfg (Golden -> FilePath
golden Golden
g) Map [Text] Double
m')
(Golden -> Bool
check Golden
g)
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when
(Golden -> Bool
record Golden
g)
(FilePath -> Map [Text] Double -> IO ()
writeResult (Golden -> FilePath
golden Golden
g) Map [Text] Double
m')
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 [Text]
labels) 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
formatIn :: Format -> Header -> Map.Map [Text] Text -> [Text]
formatIn :: Format -> Header -> Map [Text] Text -> [Text]
formatIn Format
f Header
h = case Format
f of
Format
OrgMode -> Header -> Map [Text] Text -> [Text]
formatOrg Header
h
Format
ConsoleMode -> Header -> Map [Text] Text -> [Text]
formatConsole Header
h