{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}

-- | Reporting on performance, potentially checking versus a canned results.
module Perf.Report
  ( Format (..),
    parseFormat,
    Header (..),
    parseHeader,
    CompareLevels (..),
    defaultCompareLevels,
    parseCompareLevels,
    ReportConfig (..),
    defaultReportConfig,
    parseReportConfig,
    writeResult,
    readResult,
    CompareResult (..),
    compareNote,
    outercalate,
    reportGolden,
    reportOrg2D,
    Golden (..),
    parseGolden,
    report,
  )
where

import Control.Monad
import Data.Bool
import Data.Foldable
import Data.FormatN hiding (format)
import qualified Data.List as List
import Data.Map.Merge.Strict
import qualified Data.Map.Strict as Map
import Data.Text (Text)
import qualified Data.Text as Text
import qualified Data.Text.IO as Text
import GHC.Generics
import Options.Applicative
import Text.Printf hiding (parseFormat)

-- | Type of format for report
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)

-- | Command-line parser for 'Format'
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

-- | Whether to include header information.
data Header = Header | NoHeader 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)

-- | Command-line parser for 'Header'
parseHeader :: Header -> Parser Header
parseHeader :: Header -> Parser Header
parseHeader 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

-- | Levels of geometric difference in compared performance that triggers reporting.
data CompareLevels = CompareLevels {CompareLevels -> Double
errorLevel :: Double, CompareLevels -> Double
warningLevel :: Double, CompareLevels -> Double
improvedLevel :: Double} deriving (CompareLevels -> CompareLevels -> Bool
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 {errorLevel = 0.2, warningLevel = 5.0e-2, improvedLevel = 5.0e-2}
defaultCompareLevels :: CompareLevels
defaultCompareLevels :: CompareLevels
defaultCompareLevels = Double -> Double -> Double -> CompareLevels
CompareLevels Double
0.2 Double
0.05 Double
0.05

-- | Command-line parser for 'CompareLevels'
parseCompareLevels :: CompareLevels -> Parser CompareLevels
parseCompareLevels :: CompareLevels -> Parser CompareLevels
parseCompareLevels CompareLevels
c =
  Double -> Double -> Double -> CompareLevels
CompareLevels
    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")

-- | Report configuration options
data ReportConfig = ReportConfig
  { ReportConfig -> Format
format :: Format,
    ReportConfig -> Header
includeHeader :: 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 {format = ConsoleMode, includeHeader = Header, levels = CompareLevels {errorLevel = 0.2, warningLevel = 5.0e-2, improvedLevel = 5.0e-2}}
defaultReportConfig :: ReportConfig
defaultReportConfig :: ReportConfig
defaultReportConfig = Format -> Header -> CompareLevels -> ReportConfig
ReportConfig Format
ConsoleMode Header
Header CompareLevels
defaultCompareLevels

-- | Parse 'ReportConfig' command line options.
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)

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

-- | Read results from file
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)

-- | Comparison data between two results.
data CompareResult = CompareResult {CompareResult -> Maybe Double
oldResult :: Maybe Double, CompareResult -> Maybe Double
newResult :: Maybe Double, CompareResult -> Text
noteResult :: Text} deriving (Int -> CompareResult -> ShowS
[CompareResult] -> ShowS
CompareResult -> FilePath
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)

-- | Compare two results and produce some notes given level triggers.
compareNote :: (Ord a) => CompareLevels -> Map.Map a Double -> Map.Map a Double -> Map.Map a CompareResult
compareNote :: forall a.
Ord a =>
CompareLevels
-> Map a Double -> Map a Double -> Map a CompareResult
compareNote CompareLevels
cfg Map a Double
x Map a Double
y =
  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
""

-- | Like intercalate, but on the outside as well.
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

-- | Report to a console, comparing the measurement versus a canned file.
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

-- | Org-mode style header.
formatOrgHeader :: Map.Map [Text] a -> [Text] -> [Text]
formatOrgHeader :: forall a. Map [Text] a -> [Text] -> [Text]
formatOrgHeader Map [Text] a
m [Text]
ts =
  [ Text -> [Text] -> Text
outercalate Text
"|" (((Text
"label" forall a. Semigroup a => a -> a -> a
<>) 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

-- | Console-style header information.
formatConsoleHeader :: Map.Map [Text] a -> [Text] -> [Text]
formatConsoleHeader :: forall a. Map [Text] a -> [Text] -> [Text]
formatConsoleHeader 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 a. Semigroup a => a -> a -> a
<>) 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

-- | Format a comparison.
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
      ]

-- | Format a result in org-mode style
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)

-- | Format a result in console-style
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)

-- | Format a result as a table.
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

-- | Golden file options.
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)

-- | Parse command-line golden file options.
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 results
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

-- | Format a result given 'Format' and 'Header' preferences.
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