-- | Rendering code that takes lays out raw benchmarking results in a table.
module ParkBench.Render
  ( estimatesToTable,
  )
where

import Data.List.NonEmpty (NonEmpty (..))
import qualified Data.List.NonEmpty as NonEmpty
import qualified Data.Text as Text
import ParkBench.Named (Named)
import qualified ParkBench.Named as Named
import ParkBench.Prelude
import ParkBench.Pretty
import ParkBench.RtsStats
import ParkBench.Statistics

estimatesToTable :: NonEmpty (Named (Estimate RtsStats)) -> Table
estimatesToTable :: NonEmpty (Named (Estimate RtsStats)) -> Table
estimatesToTable NonEmpty (Named (Estimate RtsStats))
summaries =
  [Cell] -> [RowGroup] -> Table
Table (NonEmpty (Named (Estimate RtsStats)) -> [Cell]
estimatesToHeader NonEmpty (Named (Estimate RtsStats))
summaries) (NonEmpty (Estimate RtsStats) -> [RowGroup]
estimatesToRowGroups (Named (Estimate RtsStats) -> Estimate RtsStats
forall a. Named a -> a
Named.thing (Named (Estimate RtsStats) -> Estimate RtsStats)
-> NonEmpty (Named (Estimate RtsStats))
-> NonEmpty (Estimate RtsStats)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty (Named (Estimate RtsStats))
summaries))

estimatesToHeader :: NonEmpty (Named (Estimate RtsStats)) -> [Cell]
estimatesToHeader :: NonEmpty (Named (Estimate RtsStats)) -> [Cell]
estimatesToHeader (NonEmpty (Named (Estimate RtsStats)) -> [Named (Estimate RtsStats)]
forall a. NonEmpty a -> [a]
NonEmpty.toList -> [Named (Estimate RtsStats)]
names) =
  (if [Named (Estimate RtsStats)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Named (Estimate RtsStats)]
names Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
2 then ([Cell] -> [Cell] -> [Cell]
forall a. [a] -> [a] -> [a]
++ [Cell
"Total"]) else [Cell] -> [Cell]
forall a. a -> a
id) ([Named (Estimate RtsStats)] -> [Cell]
go [Named (Estimate RtsStats)]
names)
  where
    go :: [Named (Estimate RtsStats)] -> [Cell]
    go :: [Named (Estimate RtsStats)] -> [Cell]
go = \case
      [] -> []
      Named (Estimate RtsStats)
x : [Named (Estimate RtsStats)]
xs -> Cell
EmptyCell Cell -> [Cell] -> [Cell]
forall a. a -> [a] -> [a]
: Color -> Text -> Cell
Cell Color
Blue ((Char -> Char) -> Text -> Text
Text.map Char -> Char
dash (Named (Estimate RtsStats) -> Text
forall a. Named a -> Text
Named.name Named (Estimate RtsStats)
x)) Cell -> [Cell] -> [Cell]
forall a. a -> [a] -> [a]
: [Named (Estimate RtsStats)] -> [Cell]
go [Named (Estimate RtsStats)]
xs

    dash :: Char -> Char
    dash :: Char -> Char
dash = \case
      Char
' ' -> Char
'─'
      Char
c -> Char
c

estimatesToRowGroups :: NonEmpty (Estimate RtsStats) -> [RowGroup]
estimatesToRowGroups :: NonEmpty (Estimate RtsStats) -> [RowGroup]
estimatesToRowGroups (Estimate RtsStats
summary0 :| [Estimate RtsStats]
summaries0) =
  [ Text -> [Row] -> RowGroup
RowGroup
      Text
"Statistics"
      [ R (Estimate RtsStats) IncomparableWord3Cell -> Row
forall a. Cellular a => R (Estimate RtsStats) a -> Row
render (Cell
-> (Estimate RtsStats -> Maybe IncomparableWord3Cell)
-> R (Estimate RtsStats) IncomparableWord3Cell
forall a b. Cell -> (a -> Maybe b) -> R a b
R Cell
"Samples" (IncomparableWord3Cell -> Maybe IncomparableWord3Cell
forall a. a -> Maybe a
Just (IncomparableWord3Cell -> Maybe IncomparableWord3Cell)
-> (Estimate RtsStats -> IncomparableWord3Cell)
-> Estimate RtsStats
-> Maybe IncomparableWord3Cell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> IncomparableWord3Cell
IncomparableWord3Cell (Word64 -> IncomparableWord3Cell)
-> (Estimate RtsStats -> Word64)
-> Estimate RtsStats
-> IncomparableWord3Cell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Estimate RtsStats -> Word64
forall a. Estimate a -> Word64
samples)),
        R (Estimate RtsStats) IncomparablePercentageCell -> Row
forall a. Cellular a => R (Estimate RtsStats) a -> Row
render (Cell
-> (Estimate RtsStats -> Maybe IncomparablePercentageCell)
-> R (Estimate RtsStats) IncomparablePercentageCell
forall a b. Cell -> (a -> Maybe b) -> R a b
R Cell
"CV (σ/μ)" (IncomparablePercentageCell -> Maybe IncomparablePercentageCell
forall a. a -> Maybe a
Just (IncomparablePercentageCell -> Maybe IncomparablePercentageCell)
-> (Estimate RtsStats -> IncomparablePercentageCell)
-> Estimate RtsStats
-> Maybe IncomparablePercentageCell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> IncomparablePercentageCell
IncomparablePercentageCell (Double -> IncomparablePercentageCell)
-> (Estimate RtsStats -> Double)
-> Estimate RtsStats
-> IncomparablePercentageCell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Estimate RtsStats -> Double
forall a. Estimate a -> Double
goodness))
      ],
    Text -> [Row] -> RowGroup
RowGroup
      Text
"Elapsed time"
      [ R (Estimate RtsStats) NanosecondsCell -> Row
forall a. Cellular a => R (Estimate RtsStats) a -> Row
render (Cell
-> (Estimate RtsStats -> Maybe NanosecondsCell)
-> R (Estimate RtsStats) NanosecondsCell
forall a b. Cell -> (a -> Maybe b) -> R a b
R Cell
"Total" (NanosecondsCell -> Maybe NanosecondsCell
forall a. a -> Maybe a
Just (NanosecondsCell -> Maybe NanosecondsCell)
-> (Estimate RtsStats -> NanosecondsCell)
-> Estimate RtsStats
-> Maybe NanosecondsCell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> NanosecondsCell
NanosecondsCell (Double -> NanosecondsCell)
-> (Estimate RtsStats -> Double)
-> Estimate RtsStats
-> NanosecondsCell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> Double
r2d (Rational -> Double)
-> (Estimate RtsStats -> Rational) -> Estimate RtsStats -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Timed RtsStats -> Rational
forall a. Timed a -> Rational
nanoseconds (Timed RtsStats -> Rational)
-> (Estimate RtsStats -> Timed RtsStats)
-> Estimate RtsStats
-> Rational
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Estimate RtsStats -> Timed RtsStats
forall a. Estimate a -> Timed a
mean)),
        R (Estimate RtsStats) NanosecondsCell -> Row
forall a. Cellular a => R (Estimate RtsStats) a -> Row
render (Cell
-> (Estimate RtsStats -> Maybe NanosecondsCell)
-> R (Estimate RtsStats) NanosecondsCell
forall a b. Cell -> (a -> Maybe b) -> R a b
R Cell
"Mutator" (NanosecondsCell -> Maybe NanosecondsCell
forall a. a -> Maybe a
Just (NanosecondsCell -> Maybe NanosecondsCell)
-> (Estimate RtsStats -> NanosecondsCell)
-> Estimate RtsStats
-> Maybe NanosecondsCell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> NanosecondsCell
NanosecondsCell (Double -> NanosecondsCell)
-> (Estimate RtsStats -> Double)
-> Estimate RtsStats
-> NanosecondsCell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> Double
r2d (Rational -> Double)
-> (Estimate RtsStats -> Rational) -> Estimate RtsStats -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RtsStats -> Rational
mutator_elapsed_ns (RtsStats -> Rational)
-> (Estimate RtsStats -> RtsStats) -> Estimate RtsStats -> Rational
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Timed RtsStats -> RtsStats
forall a. Timed a -> a
value (Timed RtsStats -> RtsStats)
-> (Estimate RtsStats -> Timed RtsStats)
-> Estimate RtsStats
-> RtsStats
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Estimate RtsStats -> Timed RtsStats
forall a. Estimate a -> Timed a
mean)),
        R (Estimate RtsStats) PercentageCell' -> Row
forall a. Cellular a => R (Estimate RtsStats) a -> Row
render (Cell
-> (Estimate RtsStats -> Maybe PercentageCell')
-> R (Estimate RtsStats) PercentageCell'
forall a b. Cell -> (a -> Maybe b) -> R a b
R Cell
"Mutator %" (PercentageCell' -> Maybe PercentageCell'
forall a. a -> Maybe a
Just (PercentageCell' -> Maybe PercentageCell')
-> (Estimate RtsStats -> PercentageCell')
-> Estimate RtsStats
-> Maybe PercentageCell'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> PercentageCell'
PercentageCell' (Double -> PercentageCell')
-> (Estimate RtsStats -> Double)
-> Estimate RtsStats
-> PercentageCell'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> Double
r2d (Rational -> Double)
-> (Estimate RtsStats -> Rational) -> Estimate RtsStats -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RtsStats -> Rational
mut_wall_percent (RtsStats -> Rational)
-> (Estimate RtsStats -> RtsStats) -> Estimate RtsStats -> Rational
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Timed RtsStats -> RtsStats
forall a. Timed a -> a
value (Timed RtsStats -> RtsStats)
-> (Estimate RtsStats -> Timed RtsStats)
-> Estimate RtsStats
-> RtsStats
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Estimate RtsStats -> Timed RtsStats
forall a. Estimate a -> Timed a
mean)),
        R (Estimate RtsStats) NanosecondsCell -> Row
forall a. Cellular a => R (Estimate RtsStats) a -> Row
render (Cell
-> (Estimate RtsStats -> Maybe NanosecondsCell)
-> R (Estimate RtsStats) NanosecondsCell
forall a b. Cell -> (a -> Maybe b) -> R a b
R Cell
"Garbage collector" (NanosecondsCell -> Maybe NanosecondsCell
forall a. a -> Maybe a
Just (NanosecondsCell -> Maybe NanosecondsCell)
-> (Estimate RtsStats -> NanosecondsCell)
-> Estimate RtsStats
-> Maybe NanosecondsCell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> NanosecondsCell
NanosecondsCell (Double -> NanosecondsCell)
-> (Estimate RtsStats -> Double)
-> Estimate RtsStats
-> NanosecondsCell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> Double
r2d (Rational -> Double)
-> (Estimate RtsStats -> Rational) -> Estimate RtsStats -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RtsStats -> Rational
gc_elapsed_ns (RtsStats -> Rational)
-> (Estimate RtsStats -> RtsStats) -> Estimate RtsStats -> Rational
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Timed RtsStats -> RtsStats
forall a. Timed a -> a
value (Timed RtsStats -> RtsStats)
-> (Estimate RtsStats -> Timed RtsStats)
-> Estimate RtsStats
-> RtsStats
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Estimate RtsStats -> Timed RtsStats
forall a. Estimate a -> Timed a
mean)),
        R (Estimate RtsStats) PercentageCell -> Row
forall a. Cellular a => R (Estimate RtsStats) a -> Row
render (Cell
-> (Estimate RtsStats -> Maybe PercentageCell)
-> R (Estimate RtsStats) PercentageCell
forall a b. Cell -> (a -> Maybe b) -> R a b
R Cell
"Garbage collector %" (PercentageCell -> Maybe PercentageCell
forall a. a -> Maybe a
Just (PercentageCell -> Maybe PercentageCell)
-> (Estimate RtsStats -> PercentageCell)
-> Estimate RtsStats
-> Maybe PercentageCell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> PercentageCell
PercentageCell (Double -> PercentageCell)
-> (Estimate RtsStats -> Double)
-> Estimate RtsStats
-> PercentageCell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> Double
r2d (Rational -> Double)
-> (Estimate RtsStats -> Rational) -> Estimate RtsStats -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RtsStats -> Rational
gc_wall_percent (RtsStats -> Rational)
-> (Estimate RtsStats -> RtsStats) -> Estimate RtsStats -> Rational
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Timed RtsStats -> RtsStats
forall a. Timed a -> a
value (Timed RtsStats -> RtsStats)
-> (Estimate RtsStats -> Timed RtsStats)
-> Estimate RtsStats
-> RtsStats
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Estimate RtsStats -> Timed RtsStats
forall a. Estimate a -> Timed a
mean))
      ],
    Text -> [Row] -> RowGroup
RowGroup
      Text
"CPU time"
      [ R (Estimate RtsStats) NanosecondsCell -> Row
forall a. Cellular a => R (Estimate RtsStats) a -> Row
render (Cell
-> (Estimate RtsStats -> Maybe NanosecondsCell)
-> R (Estimate RtsStats) NanosecondsCell
forall a b. Cell -> (a -> Maybe b) -> R a b
R Cell
"Total" (NanosecondsCell -> Maybe NanosecondsCell
forall a. a -> Maybe a
Just (NanosecondsCell -> Maybe NanosecondsCell)
-> (Estimate RtsStats -> NanosecondsCell)
-> Estimate RtsStats
-> Maybe NanosecondsCell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> NanosecondsCell
NanosecondsCell (Double -> NanosecondsCell)
-> (Estimate RtsStats -> Double)
-> Estimate RtsStats
-> NanosecondsCell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> Double
r2d (Rational -> Double)
-> (Estimate RtsStats -> Rational) -> Estimate RtsStats -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RtsStats -> Rational
cpu_ns (RtsStats -> Rational)
-> (Estimate RtsStats -> RtsStats) -> Estimate RtsStats -> Rational
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Timed RtsStats -> RtsStats
forall a. Timed a -> a
value (Timed RtsStats -> RtsStats)
-> (Estimate RtsStats -> Timed RtsStats)
-> Estimate RtsStats
-> RtsStats
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Estimate RtsStats -> Timed RtsStats
forall a. Estimate a -> Timed a
mean)),
        R (Estimate RtsStats) NanosecondsCell -> Row
forall a. Cellular a => R (Estimate RtsStats) a -> Row
render (Cell
-> (Estimate RtsStats -> Maybe NanosecondsCell)
-> R (Estimate RtsStats) NanosecondsCell
forall a b. Cell -> (a -> Maybe b) -> R a b
R Cell
"Mutator" (NanosecondsCell -> Maybe NanosecondsCell
forall a. a -> Maybe a
Just (NanosecondsCell -> Maybe NanosecondsCell)
-> (Estimate RtsStats -> NanosecondsCell)
-> Estimate RtsStats
-> Maybe NanosecondsCell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> NanosecondsCell
NanosecondsCell (Double -> NanosecondsCell)
-> (Estimate RtsStats -> Double)
-> Estimate RtsStats
-> NanosecondsCell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> Double
r2d (Rational -> Double)
-> (Estimate RtsStats -> Rational) -> Estimate RtsStats -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RtsStats -> Rational
mutator_cpu_ns (RtsStats -> Rational)
-> (Estimate RtsStats -> RtsStats) -> Estimate RtsStats -> Rational
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Timed RtsStats -> RtsStats
forall a. Timed a -> a
value (Timed RtsStats -> RtsStats)
-> (Estimate RtsStats -> Timed RtsStats)
-> Estimate RtsStats
-> RtsStats
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Estimate RtsStats -> Timed RtsStats
forall a. Estimate a -> Timed a
mean)),
        R (Estimate RtsStats) PercentageCell' -> Row
forall a. Cellular a => R (Estimate RtsStats) a -> Row
render (Cell
-> (Estimate RtsStats -> Maybe PercentageCell')
-> R (Estimate RtsStats) PercentageCell'
forall a b. Cell -> (a -> Maybe b) -> R a b
R Cell
"Mutator %" (PercentageCell' -> Maybe PercentageCell'
forall a. a -> Maybe a
Just (PercentageCell' -> Maybe PercentageCell')
-> (Estimate RtsStats -> PercentageCell')
-> Estimate RtsStats
-> Maybe PercentageCell'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> PercentageCell'
PercentageCell' (Double -> PercentageCell')
-> (Estimate RtsStats -> Double)
-> Estimate RtsStats
-> PercentageCell'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> Double
r2d (Rational -> Double)
-> (Estimate RtsStats -> Rational) -> Estimate RtsStats -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RtsStats -> Rational
mut_cpu_percent (RtsStats -> Rational)
-> (Estimate RtsStats -> RtsStats) -> Estimate RtsStats -> Rational
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Timed RtsStats -> RtsStats
forall a. Timed a -> a
value (Timed RtsStats -> RtsStats)
-> (Estimate RtsStats -> Timed RtsStats)
-> Estimate RtsStats
-> RtsStats
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Estimate RtsStats -> Timed RtsStats
forall a. Estimate a -> Timed a
mean)),
        R (Estimate RtsStats) NanosecondsCell -> Row
forall a. Cellular a => R (Estimate RtsStats) a -> Row
render (Cell
-> (Estimate RtsStats -> Maybe NanosecondsCell)
-> R (Estimate RtsStats) NanosecondsCell
forall a b. Cell -> (a -> Maybe b) -> R a b
R Cell
"Garbage collector" (NanosecondsCell -> Maybe NanosecondsCell
forall a. a -> Maybe a
Just (NanosecondsCell -> Maybe NanosecondsCell)
-> (Estimate RtsStats -> NanosecondsCell)
-> Estimate RtsStats
-> Maybe NanosecondsCell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> NanosecondsCell
NanosecondsCell (Double -> NanosecondsCell)
-> (Estimate RtsStats -> Double)
-> Estimate RtsStats
-> NanosecondsCell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> Double
r2d (Rational -> Double)
-> (Estimate RtsStats -> Rational) -> Estimate RtsStats -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RtsStats -> Rational
gc_cpu_ns (RtsStats -> Rational)
-> (Estimate RtsStats -> RtsStats) -> Estimate RtsStats -> Rational
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Timed RtsStats -> RtsStats
forall a. Timed a -> a
value (Timed RtsStats -> RtsStats)
-> (Estimate RtsStats -> Timed RtsStats)
-> Estimate RtsStats
-> RtsStats
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Estimate RtsStats -> Timed RtsStats
forall a. Estimate a -> Timed a
mean)),
        R (Estimate RtsStats) PercentageCell -> Row
forall a. Cellular a => R (Estimate RtsStats) a -> Row
render (Cell
-> (Estimate RtsStats -> Maybe PercentageCell)
-> R (Estimate RtsStats) PercentageCell
forall a b. Cell -> (a -> Maybe b) -> R a b
R Cell
"Garbage collector %" (PercentageCell -> Maybe PercentageCell
forall a. a -> Maybe a
Just (PercentageCell -> Maybe PercentageCell)
-> (Estimate RtsStats -> PercentageCell)
-> Estimate RtsStats
-> Maybe PercentageCell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> PercentageCell
PercentageCell (Double -> PercentageCell)
-> (Estimate RtsStats -> Double)
-> Estimate RtsStats
-> PercentageCell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> Double
r2d (Rational -> Double)
-> (Estimate RtsStats -> Rational) -> Estimate RtsStats -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RtsStats -> Rational
gc_cpu_percent (RtsStats -> Rational)
-> (Estimate RtsStats -> RtsStats) -> Estimate RtsStats -> Rational
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Timed RtsStats -> RtsStats
forall a. Timed a -> a
value (Timed RtsStats -> RtsStats)
-> (Estimate RtsStats -> Timed RtsStats)
-> Estimate RtsStats
-> RtsStats
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Estimate RtsStats -> Timed RtsStats
forall a. Estimate a -> Timed a
mean))
      ],
    Text -> [Row] -> RowGroup
RowGroup
      Text
"Memory usage"
      [ R (Estimate RtsStats) BytesCell -> Row
forall a. Cellular a => R (Estimate RtsStats) a -> Row
render (Cell
-> (Estimate RtsStats -> Maybe BytesCell)
-> R (Estimate RtsStats) BytesCell
forall a b. Cell -> (a -> Maybe b) -> R a b
R Cell
"Average" (BytesCell -> Maybe BytesCell
forall a. a -> Maybe a
Just (BytesCell -> Maybe BytesCell)
-> (Estimate RtsStats -> BytesCell)
-> Estimate RtsStats
-> Maybe BytesCell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> BytesCell
BytesCell (Double -> BytesCell)
-> (Estimate RtsStats -> Double) -> Estimate RtsStats -> BytesCell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> Double
r2d (Rational -> Double)
-> (Estimate RtsStats -> Rational) -> Estimate RtsStats -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RtsStats -> Rational
average_live_data (RtsStats -> Rational)
-> (Estimate RtsStats -> RtsStats) -> Estimate RtsStats -> Rational
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Timed RtsStats -> RtsStats
forall a. Timed a -> a
value (Timed RtsStats -> RtsStats)
-> (Estimate RtsStats -> Timed RtsStats)
-> Estimate RtsStats
-> RtsStats
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Estimate RtsStats -> Timed RtsStats
forall a. Estimate a -> Timed a
mean)),
        R (Estimate RtsStats) BytesCell -> Row
forall a. Cellular a => R (Estimate RtsStats) a -> Row
render (Cell
-> (Estimate RtsStats -> Maybe BytesCell)
-> R (Estimate RtsStats) BytesCell
forall a b. Cell -> (a -> Maybe b) -> R a b
R Cell
"Maximum" (BytesCell -> Maybe BytesCell
forall a. a -> Maybe a
Just (BytesCell -> Maybe BytesCell)
-> (Estimate RtsStats -> BytesCell)
-> Estimate RtsStats
-> Maybe BytesCell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> BytesCell
BytesCell (Double -> BytesCell)
-> (Estimate RtsStats -> Double) -> Estimate RtsStats -> BytesCell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> Double
r2d (Rational -> Double)
-> (Estimate RtsStats -> Rational) -> Estimate RtsStats -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RtsStats -> Rational
max_live_bytes (RtsStats -> Rational)
-> (Estimate RtsStats -> RtsStats) -> Estimate RtsStats -> Rational
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Timed RtsStats -> RtsStats
forall a. Timed a -> a
value (Timed RtsStats -> RtsStats)
-> (Estimate RtsStats -> Timed RtsStats)
-> Estimate RtsStats
-> RtsStats
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Estimate RtsStats -> Timed RtsStats
forall a. Estimate a -> Timed a
mean))
      ],
    Text -> [Row] -> RowGroup
RowGroup
      Text
"Memory pressure"
      [ R (Estimate RtsStats) BytesCell -> Row
forall a. Cellular a => R (Estimate RtsStats) a -> Row
render (Cell
-> (Estimate RtsStats -> Maybe BytesCell)
-> R (Estimate RtsStats) BytesCell
forall a b. Cell -> (a -> Maybe b) -> R a b
R Cell
"Allocated" (BytesCell -> Maybe BytesCell
forall a. a -> Maybe a
Just (BytesCell -> Maybe BytesCell)
-> (Estimate RtsStats -> BytesCell)
-> Estimate RtsStats
-> Maybe BytesCell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> BytesCell
BytesCell (Double -> BytesCell)
-> (Estimate RtsStats -> Double) -> Estimate RtsStats -> BytesCell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> Double
r2d (Rational -> Double)
-> (Estimate RtsStats -> Rational) -> Estimate RtsStats -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RtsStats -> Rational
allocated_bytes (RtsStats -> Rational)
-> (Estimate RtsStats -> RtsStats) -> Estimate RtsStats -> Rational
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Timed RtsStats -> RtsStats
forall a. Timed a -> a
value (Timed RtsStats -> RtsStats)
-> (Estimate RtsStats -> Timed RtsStats)
-> Estimate RtsStats
-> RtsStats
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Estimate RtsStats -> Timed RtsStats
forall a. Estimate a -> Timed a
mean)),
        R (Estimate RtsStats) BytesPerSecondCell -> Row
forall a. Cellular a => R (Estimate RtsStats) a -> Row
render (Cell
-> (Estimate RtsStats -> Maybe BytesPerSecondCell)
-> R (Estimate RtsStats) BytesPerSecondCell
forall a b. Cell -> (a -> Maybe b) -> R a b
R Cell
"Allocated/sec" (BytesPerSecondCell -> Maybe BytesPerSecondCell
forall a. a -> Maybe a
Just (BytesPerSecondCell -> Maybe BytesPerSecondCell)
-> (Estimate RtsStats -> BytesPerSecondCell)
-> Estimate RtsStats
-> Maybe BytesPerSecondCell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> BytesPerSecondCell
BytesPerSecondCell (Double -> BytesPerSecondCell)
-> (Estimate RtsStats -> Double)
-> Estimate RtsStats
-> BytesPerSecondCell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> Double
r2d (Rational -> Double)
-> (Estimate RtsStats -> Rational) -> Estimate RtsStats -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RtsStats -> Rational
allocated_bytes_per_second (RtsStats -> Rational)
-> (Estimate RtsStats -> RtsStats) -> Estimate RtsStats -> Rational
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Timed RtsStats -> RtsStats
forall a. Timed a -> a
value (Timed RtsStats -> RtsStats)
-> (Estimate RtsStats -> Timed RtsStats)
-> Estimate RtsStats
-> RtsStats
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Estimate RtsStats -> Timed RtsStats
forall a. Estimate a -> Timed a
mean)),
        R (Estimate RtsStats) BytesCell -> Row
forall a. Cellular a => R (Estimate RtsStats) a -> Row
render (Cell
-> (Estimate RtsStats -> Maybe BytesCell)
-> R (Estimate RtsStats) BytesCell
forall a b. Cell -> (a -> Maybe b) -> R a b
R Cell
"Copied during GC" (BytesCell -> Maybe BytesCell
forall a. a -> Maybe a
Just (BytesCell -> Maybe BytesCell)
-> (Estimate RtsStats -> BytesCell)
-> Estimate RtsStats
-> Maybe BytesCell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> BytesCell
BytesCell (Double -> BytesCell)
-> (Estimate RtsStats -> Double) -> Estimate RtsStats -> BytesCell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> Double
r2d (Rational -> Double)
-> (Estimate RtsStats -> Rational) -> Estimate RtsStats -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RtsStats -> Rational
copied_bytes (RtsStats -> Rational)
-> (Estimate RtsStats -> RtsStats) -> Estimate RtsStats -> Rational
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Timed RtsStats -> RtsStats
forall a. Timed a -> a
value (Timed RtsStats -> RtsStats)
-> (Estimate RtsStats -> Timed RtsStats)
-> Estimate RtsStats
-> RtsStats
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Estimate RtsStats -> Timed RtsStats
forall a. Estimate a -> Timed a
mean))
      ],
    -- TODO nonmoving GC
    Text -> [Row] -> RowGroup
RowGroup
      Text
"Garbage collection"
      [ R (Estimate RtsStats) NumberCell -> Row
forall a. Cellular a => R (Estimate RtsStats) a -> Row
render (Cell
-> (Estimate RtsStats -> Maybe NumberCell)
-> R (Estimate RtsStats) NumberCell
forall a b. Cell -> (a -> Maybe b) -> R a b
R Cell
"Total collections" (NumberCell -> Maybe NumberCell
forall a. a -> Maybe a
Just (NumberCell -> Maybe NumberCell)
-> (Estimate RtsStats -> NumberCell)
-> Estimate RtsStats
-> Maybe NumberCell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> NumberCell
NumberCell (Double -> NumberCell)
-> (Estimate RtsStats -> Double) -> Estimate RtsStats -> NumberCell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> Double
r2d (Rational -> Double)
-> (Estimate RtsStats -> Rational) -> Estimate RtsStats -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RtsStats -> Rational
gcs (RtsStats -> Rational)
-> (Estimate RtsStats -> RtsStats) -> Estimate RtsStats -> Rational
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Timed RtsStats -> RtsStats
forall a. Timed a -> a
value (Timed RtsStats -> RtsStats)
-> (Estimate RtsStats -> Timed RtsStats)
-> Estimate RtsStats
-> RtsStats
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Estimate RtsStats -> Timed RtsStats
forall a. Estimate a -> Timed a
mean)),
        R (Estimate RtsStats) NumberCell -> Row
forall a. Cellular a => R (Estimate RtsStats) a -> Row
render (Cell
-> (Estimate RtsStats -> Maybe NumberCell)
-> R (Estimate RtsStats) NumberCell
forall a b. Cell -> (a -> Maybe b) -> R a b
R Cell
"Major collections" (NumberCell -> Maybe NumberCell
forall a. a -> Maybe a
Just (NumberCell -> Maybe NumberCell)
-> (Estimate RtsStats -> NumberCell)
-> Estimate RtsStats
-> Maybe NumberCell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> NumberCell
NumberCell (Double -> NumberCell)
-> (Estimate RtsStats -> Double) -> Estimate RtsStats -> NumberCell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> Double
r2d (Rational -> Double)
-> (Estimate RtsStats -> Rational) -> Estimate RtsStats -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RtsStats -> Rational
major_gcs (RtsStats -> Rational)
-> (Estimate RtsStats -> RtsStats) -> Estimate RtsStats -> Rational
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Timed RtsStats -> RtsStats
forall a. Timed a -> a
value (Timed RtsStats -> RtsStats)
-> (Estimate RtsStats -> Timed RtsStats)
-> Estimate RtsStats
-> RtsStats
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Estimate RtsStats -> Timed RtsStats
forall a. Estimate a -> Timed a
mean)),
        R (Estimate RtsStats) NanosecondsCell -> Row
forall a. Cellular a => R (Estimate RtsStats) a -> Row
render (Cell
-> (Estimate RtsStats -> Maybe NanosecondsCell)
-> R (Estimate RtsStats) NanosecondsCell
forall a b. Cell -> (a -> Maybe b) -> R a b
R Cell
"Average pause" (NanosecondsCell -> Maybe NanosecondsCell
forall a. a -> Maybe a
Just (NanosecondsCell -> Maybe NanosecondsCell)
-> (Estimate RtsStats -> NanosecondsCell)
-> Estimate RtsStats
-> Maybe NanosecondsCell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> NanosecondsCell
NanosecondsCell (Double -> NanosecondsCell)
-> (Estimate RtsStats -> Double)
-> Estimate RtsStats
-> NanosecondsCell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> Double
r2d (Rational -> Double)
-> (Estimate RtsStats -> Rational) -> Estimate RtsStats -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RtsStats -> Rational
gc_average_ns (RtsStats -> Rational)
-> (Estimate RtsStats -> RtsStats) -> Estimate RtsStats -> Rational
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Timed RtsStats -> RtsStats
forall a. Timed a -> a
value (Timed RtsStats -> RtsStats)
-> (Estimate RtsStats -> Timed RtsStats)
-> Estimate RtsStats
-> RtsStats
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Estimate RtsStats -> Timed RtsStats
forall a. Estimate a -> Timed a
mean)),
        R (Estimate RtsStats) PercentageCell' -> Row
forall a. Cellular a => R (Estimate RtsStats) a -> Row
render (Cell
-> (Estimate RtsStats -> Maybe PercentageCell')
-> R (Estimate RtsStats) PercentageCell'
forall a b. Cell -> (a -> Maybe b) -> R a b
R Cell
"Work balance" ((Rational -> PercentageCell')
-> Maybe Rational -> Maybe PercentageCell'
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Double -> PercentageCell'
PercentageCell' (Double -> PercentageCell')
-> (Rational -> Double) -> Rational -> PercentageCell'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> Double
r2d) (Maybe Rational -> Maybe PercentageCell')
-> (Estimate RtsStats -> Maybe Rational)
-> Estimate RtsStats
-> Maybe PercentageCell'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RtsStats -> Maybe Rational
work_balance (RtsStats -> Maybe Rational)
-> (Estimate RtsStats -> RtsStats)
-> Estimate RtsStats
-> Maybe Rational
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Timed RtsStats -> RtsStats
forall a. Timed a -> a
value (Timed RtsStats -> RtsStats)
-> (Estimate RtsStats -> Timed RtsStats)
-> Estimate RtsStats
-> RtsStats
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Estimate RtsStats -> Timed RtsStats
forall a. Estimate a -> Timed a
mean))
      ]
  ]
  where
    render :: forall a. Cellular a => R (Estimate RtsStats) a -> Row
    render :: R (Estimate RtsStats) a -> Row
render =
      NonEmpty (Estimate RtsStats)
-> forall a. Cellular a => R (Estimate RtsStats) a -> Row
forall a. NonEmpty a -> forall b. Cellular b => R a b -> Row
rowMaker (Estimate RtsStats
summary0 Estimate RtsStats
-> [Estimate RtsStats] -> NonEmpty (Estimate RtsStats)
forall a. a -> [a] -> NonEmpty a
:| [Estimate RtsStats]
summaries0)