module ParkBench.Internal.Render
( estimatesToTable,
)
where
import qualified Data.Text as Text
import ParkBench.Internal.Array1 (Array1)
import ParkBench.Internal.Named (Named)
import qualified ParkBench.Internal.Named as Named
import ParkBench.Internal.Prelude
import ParkBench.Internal.Pretty
import ParkBench.Internal.RtsStats
import ParkBench.Internal.Statistics
estimatesToTable :: Array1 (Named (Estimate RtsStats)) -> Table
estimatesToTable :: Array1 (Named (Estimate RtsStats)) -> Table
estimatesToTable Array1 (Named (Estimate RtsStats))
estimates =
[Cell] -> [RowGroup] -> Table
Table (Array1 (Named (Estimate RtsStats)) -> [Cell]
estimatesToHeader Array1 (Named (Estimate RtsStats))
estimates) (Array1 (Estimate RtsStats) -> [RowGroup]
estimatesToRowGroups (forall a. Named a -> a
Named.thing forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Array1 (Named (Estimate RtsStats))
estimates))
estimatesToHeader :: Array1 (Named (Estimate RtsStats)) -> [Cell]
Array1 (Named (Estimate RtsStats))
estimates =
if forall (t :: * -> *) a. Foldable t => t a -> Int
length Array1 (Named (Estimate RtsStats))
estimates forall a. Ord a => a -> a -> Bool
> Int
2
then forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall a. Named a -> [Cell]
namedToHeader Array1 (Named (Estimate RtsStats))
estimates forall a. [a] -> [a] -> [a]
++ [Cell
"Total"]
else forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall a. Named a -> [Cell]
namedToHeader Array1 (Named (Estimate RtsStats))
estimates
where
namedToHeader :: Named a -> [Cell]
namedToHeader :: forall a. Named a -> [Cell]
namedToHeader Named a
x =
[Cell
EmptyCell, forall a. Named a -> Cell
namedToCell Named a
x]
namedToCell :: Named a -> Cell
namedToCell :: forall a. Named a -> Cell
namedToCell =
Color -> Text -> Cell
Cell Color
Blue forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char) -> Text -> Text
Text.map Char -> Char
spaceToDash forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Named a -> Text
Named.name
spaceToDash :: Char -> Char
spaceToDash :: Char -> Char
spaceToDash = \case
Char
' ' -> Char
'─'
Char
c -> Char
c
estimatesToRowGroups :: Array1 (Estimate RtsStats) -> [RowGroup]
estimatesToRowGroups :: Array1 (Estimate RtsStats) -> [RowGroup]
estimatesToRowGroups Array1 (Estimate RtsStats)
summaries =
[ Text -> [Row] -> RowGroup
RowGroup
Text
"Statistics"
[ forall a. Cellular a => R (Estimate RtsStats) a -> Row
render (forall a b. Cell -> (a -> Maybe b) -> R a b
R Cell
"Samples" (forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> IncomparableWord3Cell
IncomparableWord3Cell forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Estimate a -> Word64
samples)),
forall a. Cellular a => R (Estimate RtsStats) a -> Row
render (forall a b. Cell -> (a -> Maybe b) -> R a b
R Cell
"CV (σ/μ)" (forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> IncomparablePercentageCell
IncomparablePercentageCell forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Estimate a -> Double
goodness))
],
Text -> [Row] -> RowGroup
RowGroup
Text
"Elapsed time"
[ forall a. Cellular a => R (Estimate RtsStats) a -> Row
render (forall a b. Cell -> (a -> Maybe b) -> R a b
R Cell
"Total" (forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> NanosecondsCell
NanosecondsCell forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> Double
r2d forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Timed a -> Rational
nanoseconds forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Estimate a -> Timed a
mean)),
forall a. Cellular a => R (Estimate RtsStats) a -> Row
render (forall a b. Cell -> (a -> Maybe b) -> R a b
R Cell
"Mutator" (forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> NanosecondsCell
NanosecondsCell forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> Double
r2d forall b c a. (b -> c) -> (a -> b) -> a -> c
. RtsStats -> Rational
mutator_elapsed_ns forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Timed a -> a
value forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Estimate a -> Timed a
mean)),
forall a. Cellular a => R (Estimate RtsStats) a -> Row
render (forall a b. Cell -> (a -> Maybe b) -> R a b
R Cell
"Mutator %" (forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> PercentageCell'
PercentageCell' forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> Double
r2d forall b c a. (b -> c) -> (a -> b) -> a -> c
. RtsStats -> Rational
mut_wall_percent forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Timed a -> a
value forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Estimate a -> Timed a
mean)),
forall a. Cellular a => R (Estimate RtsStats) a -> Row
render (forall a b. Cell -> (a -> Maybe b) -> R a b
R Cell
"Garbage collector" (forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> NanosecondsCell
NanosecondsCell forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> Double
r2d forall b c a. (b -> c) -> (a -> b) -> a -> c
. RtsStats -> Rational
gc_elapsed_ns forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Timed a -> a
value forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Estimate a -> Timed a
mean)),
forall a. Cellular a => R (Estimate RtsStats) a -> Row
render (forall a b. Cell -> (a -> Maybe b) -> R a b
R Cell
"Garbage collector %" (forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> PercentageCell
PercentageCell forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> Double
r2d forall b c a. (b -> c) -> (a -> b) -> a -> c
. RtsStats -> Rational
gc_wall_percent forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Timed a -> a
value forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Estimate a -> Timed a
mean))
],
Text -> [Row] -> RowGroup
RowGroup
Text
"CPU time"
[ forall a. Cellular a => R (Estimate RtsStats) a -> Row
render (forall a b. Cell -> (a -> Maybe b) -> R a b
R Cell
"Total" (forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> NanosecondsCell
NanosecondsCell forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> Double
r2d forall b c a. (b -> c) -> (a -> b) -> a -> c
. RtsStats -> Rational
cpu_ns forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Timed a -> a
value forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Estimate a -> Timed a
mean)),
forall a. Cellular a => R (Estimate RtsStats) a -> Row
render (forall a b. Cell -> (a -> Maybe b) -> R a b
R Cell
"Mutator" (forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> NanosecondsCell
NanosecondsCell forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> Double
r2d forall b c a. (b -> c) -> (a -> b) -> a -> c
. RtsStats -> Rational
mutator_cpu_ns forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Timed a -> a
value forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Estimate a -> Timed a
mean)),
forall a. Cellular a => R (Estimate RtsStats) a -> Row
render (forall a b. Cell -> (a -> Maybe b) -> R a b
R Cell
"Mutator %" (forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> PercentageCell'
PercentageCell' forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> Double
r2d forall b c a. (b -> c) -> (a -> b) -> a -> c
. RtsStats -> Rational
mut_cpu_percent forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Timed a -> a
value forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Estimate a -> Timed a
mean)),
forall a. Cellular a => R (Estimate RtsStats) a -> Row
render (forall a b. Cell -> (a -> Maybe b) -> R a b
R Cell
"Garbage collector" (forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> NanosecondsCell
NanosecondsCell forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> Double
r2d forall b c a. (b -> c) -> (a -> b) -> a -> c
. RtsStats -> Rational
gc_cpu_ns forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Timed a -> a
value forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Estimate a -> Timed a
mean)),
forall a. Cellular a => R (Estimate RtsStats) a -> Row
render (forall a b. Cell -> (a -> Maybe b) -> R a b
R Cell
"Garbage collector %" (forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> PercentageCell
PercentageCell forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> Double
r2d forall b c a. (b -> c) -> (a -> b) -> a -> c
. RtsStats -> Rational
gc_cpu_percent forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Timed a -> a
value forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Estimate a -> Timed a
mean))
],
Text -> [Row] -> RowGroup
RowGroup
Text
"Memory usage"
[ forall a. Cellular a => R (Estimate RtsStats) a -> Row
render (forall a b. Cell -> (a -> Maybe b) -> R a b
R Cell
"Average" (forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> BytesCell
BytesCell forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> Double
r2d forall b c a. (b -> c) -> (a -> b) -> a -> c
. RtsStats -> Rational
average_live_data forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Timed a -> a
value forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Estimate a -> Timed a
mean)),
forall a. Cellular a => R (Estimate RtsStats) a -> Row
render (forall a b. Cell -> (a -> Maybe b) -> R a b
R Cell
"Maximum" (forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> BytesCell
BytesCell forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> Double
r2d forall b c a. (b -> c) -> (a -> b) -> a -> c
. RtsStats -> Rational
max_live_bytes forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Timed a -> a
value forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Estimate a -> Timed a
mean))
],
Text -> [Row] -> RowGroup
RowGroup
Text
"Memory pressure"
[ forall a. Cellular a => R (Estimate RtsStats) a -> Row
render (forall a b. Cell -> (a -> Maybe b) -> R a b
R Cell
"Allocated" (forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> BytesCell
BytesCell forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> Double
r2d forall b c a. (b -> c) -> (a -> b) -> a -> c
. RtsStats -> Rational
allocated_bytes forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Timed a -> a
value forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Estimate a -> Timed a
mean)),
forall a. Cellular a => R (Estimate RtsStats) a -> Row
render (forall a b. Cell -> (a -> Maybe b) -> R a b
R Cell
"Allocated/sec" (forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> BytesPerSecondCell
BytesPerSecondCell forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> Double
r2d forall b c a. (b -> c) -> (a -> b) -> a -> c
. RtsStats -> Rational
allocated_bytes_per_second forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Timed a -> a
value forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Estimate a -> Timed a
mean)),
forall a. Cellular a => R (Estimate RtsStats) a -> Row
render (forall a b. Cell -> (a -> Maybe b) -> R a b
R Cell
"Copied during GC" (forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> BytesCell
BytesCell forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> Double
r2d forall b c a. (b -> c) -> (a -> b) -> a -> c
. RtsStats -> Rational
copied_bytes forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Timed a -> a
value forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Estimate a -> Timed a
mean))
],
Text -> [Row] -> RowGroup
RowGroup
Text
"Garbage collection"
[ forall a. Cellular a => R (Estimate RtsStats) a -> Row
render (forall a b. Cell -> (a -> Maybe b) -> R a b
R Cell
"Total collections" (forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> NumberCell
NumberCell forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> Double
r2d forall b c a. (b -> c) -> (a -> b) -> a -> c
. RtsStats -> Rational
gcs forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Timed a -> a
value forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Estimate a -> Timed a
mean)),
forall a. Cellular a => R (Estimate RtsStats) a -> Row
render (forall a b. Cell -> (a -> Maybe b) -> R a b
R Cell
"Major collections" (forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> NumberCell
NumberCell forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> Double
r2d forall b c a. (b -> c) -> (a -> b) -> a -> c
. RtsStats -> Rational
major_gcs forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Timed a -> a
value forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Estimate a -> Timed a
mean)),
forall a. Cellular a => R (Estimate RtsStats) a -> Row
render (forall a b. Cell -> (a -> Maybe b) -> R a b
R Cell
"Average pause" (forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> NanosecondsCell
NanosecondsCell forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> Double
r2d forall b c a. (b -> c) -> (a -> b) -> a -> c
. RtsStats -> Rational
gc_average_ns forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Timed a -> a
value forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Estimate a -> Timed a
mean)),
forall a. Cellular a => R (Estimate RtsStats) a -> Row
render (forall a b. Cell -> (a -> Maybe b) -> R a b
R Cell
"Work balance" (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Double -> PercentageCell'
PercentageCell' forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> Double
r2d) forall b c a. (b -> c) -> (a -> b) -> a -> c
. RtsStats -> Maybe Rational
work_balance forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Timed a -> a
value forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Estimate a -> Timed a
mean))
]
]
where
render :: Cellular a => R (Estimate RtsStats) a -> Row
render :: forall a. Cellular a => R (Estimate RtsStats) a -> Row
render =
forall a. Array1 a -> forall b. Cellular b => R a b -> Row
rowMaker Array1 (Estimate RtsStats)
summaries