-- | Generic-ish (not really) pretty-printing utilities and abstractions for rendering the table of cells.
module ParkBench.Internal.Pretty
  ( -- * High-level row/cell machinery
    R (..),
    Cellular (..),
    BytesCell (..),
    BytesPerSecondCell (..),
    IncomparablePercentageCell (..),
    IncomparableWord3Cell (..),
    NanosecondsCell (..),
    NumberCell (..),
    NumberCell' (..),
    PercentageCell (..),
    PercentageCell' (..),
    rowMaker,
    Table (..),
    renderTable,
    RowGroup (..),
    Row (..),
    Cell (..),
    isEmptyCell,
    Color (..),
  )
where

import qualified Data.Array as Array
import Data.Foldable (toList)
import Data.Maybe
import Data.Ord (Down (..))
import Data.String (IsString (..))
import qualified Data.Text as Text
import ParkBench.Internal.Array1 (Array1)
import qualified ParkBench.Internal.Array1 as Array1
import ParkBench.Internal.Builder (Builder)
import qualified ParkBench.Internal.Builder as Builder
import ParkBench.Internal.Prelude
import qualified ParkBench.Internal.Terminal as Terminal

------------------------------------------------------------------------------------------------------------------------
-- High-level row/cell machinery

data R a b
  = R Cell (a -> Maybe b)

class Ord a => Cellular a where
  cellDelta :: a -> a -> Double
  cellString :: a -> Builder

newtype BytesCell
  = BytesCell Double
  deriving (BytesCell -> BytesCell -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BytesCell -> BytesCell -> Bool
$c/= :: BytesCell -> BytesCell -> Bool
== :: BytesCell -> BytesCell -> Bool
$c== :: BytesCell -> BytesCell -> Bool
Eq) via Double
  deriving (Eq BytesCell
BytesCell -> BytesCell -> Bool
BytesCell -> BytesCell -> Ordering
BytesCell -> BytesCell -> BytesCell
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: BytesCell -> BytesCell -> BytesCell
$cmin :: BytesCell -> BytesCell -> BytesCell
max :: BytesCell -> BytesCell -> BytesCell
$cmax :: BytesCell -> BytesCell -> BytesCell
>= :: BytesCell -> BytesCell -> Bool
$c>= :: BytesCell -> BytesCell -> Bool
> :: BytesCell -> BytesCell -> Bool
$c> :: BytesCell -> BytesCell -> Bool
<= :: BytesCell -> BytesCell -> Bool
$c<= :: BytesCell -> BytesCell -> Bool
< :: BytesCell -> BytesCell -> Bool
$c< :: BytesCell -> BytesCell -> Bool
compare :: BytesCell -> BytesCell -> Ordering
$ccompare :: BytesCell -> BytesCell -> Ordering
Ord) via Down Double

instance Cellular BytesCell where
  cellDelta :: BytesCell -> BytesCell -> Double
cellDelta = coerce :: forall a b. Coercible a b => a -> b
coerce Double -> Double -> Double
doubleDelta
  cellString :: BytesCell -> Builder
cellString (BytesCell Double
r) = Double -> Builder
Builder.bytes4 Double
r

newtype BytesPerSecondCell
  = BytesPerSecondCell Double
  deriving (BytesPerSecondCell -> BytesPerSecondCell -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BytesPerSecondCell -> BytesPerSecondCell -> Bool
$c/= :: BytesPerSecondCell -> BytesPerSecondCell -> Bool
== :: BytesPerSecondCell -> BytesPerSecondCell -> Bool
$c== :: BytesPerSecondCell -> BytesPerSecondCell -> Bool
Eq) via Double
  deriving (Eq BytesPerSecondCell
BytesPerSecondCell -> BytesPerSecondCell -> Bool
BytesPerSecondCell -> BytesPerSecondCell -> Ordering
BytesPerSecondCell -> BytesPerSecondCell -> BytesPerSecondCell
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: BytesPerSecondCell -> BytesPerSecondCell -> BytesPerSecondCell
$cmin :: BytesPerSecondCell -> BytesPerSecondCell -> BytesPerSecondCell
max :: BytesPerSecondCell -> BytesPerSecondCell -> BytesPerSecondCell
$cmax :: BytesPerSecondCell -> BytesPerSecondCell -> BytesPerSecondCell
>= :: BytesPerSecondCell -> BytesPerSecondCell -> Bool
$c>= :: BytesPerSecondCell -> BytesPerSecondCell -> Bool
> :: BytesPerSecondCell -> BytesPerSecondCell -> Bool
$c> :: BytesPerSecondCell -> BytesPerSecondCell -> Bool
<= :: BytesPerSecondCell -> BytesPerSecondCell -> Bool
$c<= :: BytesPerSecondCell -> BytesPerSecondCell -> Bool
< :: BytesPerSecondCell -> BytesPerSecondCell -> Bool
$c< :: BytesPerSecondCell -> BytesPerSecondCell -> Bool
compare :: BytesPerSecondCell -> BytesPerSecondCell -> Ordering
$ccompare :: BytesPerSecondCell -> BytesPerSecondCell -> Ordering
Ord) via Down Double

instance Cellular BytesPerSecondCell where
  cellDelta :: BytesPerSecondCell -> BytesPerSecondCell -> Double
cellDelta = coerce :: forall a b. Coercible a b => a -> b
coerce Double -> Double -> Double
doubleDelta
  cellString :: BytesPerSecondCell -> Builder
cellString (BytesPerSecondCell Double
r) = Double -> Builder
prettyBytesPerSecond Double
r

prettyBytesPerSecond :: Double -> Builder
prettyBytesPerSecond :: Double -> Builder
prettyBytesPerSecond Double
r =
  if Builder -> Bool
Builder.null Builder
s
    then Builder
Builder.empty
    else Builder
s forall a. Semigroup a => a -> a -> a
<> Builder
"/s"
  where
    s :: Builder
s = Double -> Builder
Builder.bytes4 Double
r

newtype IncomparablePercentageCell
  = IncomparablePercentageCell Double
  deriving (IncomparablePercentageCell -> IncomparablePercentageCell -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IncomparablePercentageCell -> IncomparablePercentageCell -> Bool
$c/= :: IncomparablePercentageCell -> IncomparablePercentageCell -> Bool
== :: IncomparablePercentageCell -> IncomparablePercentageCell -> Bool
$c== :: IncomparablePercentageCell -> IncomparablePercentageCell -> Bool
Eq) via Double
  deriving (Eq IncomparablePercentageCell
IncomparablePercentageCell -> IncomparablePercentageCell -> Bool
IncomparablePercentageCell
-> IncomparablePercentageCell -> Ordering
IncomparablePercentageCell
-> IncomparablePercentageCell -> IncomparablePercentageCell
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: IncomparablePercentageCell
-> IncomparablePercentageCell -> IncomparablePercentageCell
$cmin :: IncomparablePercentageCell
-> IncomparablePercentageCell -> IncomparablePercentageCell
max :: IncomparablePercentageCell
-> IncomparablePercentageCell -> IncomparablePercentageCell
$cmax :: IncomparablePercentageCell
-> IncomparablePercentageCell -> IncomparablePercentageCell
>= :: IncomparablePercentageCell -> IncomparablePercentageCell -> Bool
$c>= :: IncomparablePercentageCell -> IncomparablePercentageCell -> Bool
> :: IncomparablePercentageCell -> IncomparablePercentageCell -> Bool
$c> :: IncomparablePercentageCell -> IncomparablePercentageCell -> Bool
<= :: IncomparablePercentageCell -> IncomparablePercentageCell -> Bool
$c<= :: IncomparablePercentageCell -> IncomparablePercentageCell -> Bool
< :: IncomparablePercentageCell -> IncomparablePercentageCell -> Bool
$c< :: IncomparablePercentageCell -> IncomparablePercentageCell -> Bool
compare :: IncomparablePercentageCell
-> IncomparablePercentageCell -> Ordering
$ccompare :: IncomparablePercentageCell
-> IncomparablePercentageCell -> Ordering
Ord) via Down Double

instance Cellular IncomparablePercentageCell where
  cellDelta :: IncomparablePercentageCell -> IncomparablePercentageCell -> Double
cellDelta IncomparablePercentageCell
_ IncomparablePercentageCell
_ = Double
0
  cellString :: IncomparablePercentageCell -> Builder
cellString (IncomparablePercentageCell Double
r) = Double -> Builder
Builder.percentage Double
r

newtype NumberCell
  = NumberCell Double
  deriving (NumberCell -> NumberCell -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NumberCell -> NumberCell -> Bool
$c/= :: NumberCell -> NumberCell -> Bool
== :: NumberCell -> NumberCell -> Bool
$c== :: NumberCell -> NumberCell -> Bool
Eq) via Double
  deriving (Eq NumberCell
NumberCell -> NumberCell -> Bool
NumberCell -> NumberCell -> Ordering
NumberCell -> NumberCell -> NumberCell
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: NumberCell -> NumberCell -> NumberCell
$cmin :: NumberCell -> NumberCell -> NumberCell
max :: NumberCell -> NumberCell -> NumberCell
$cmax :: NumberCell -> NumberCell -> NumberCell
>= :: NumberCell -> NumberCell -> Bool
$c>= :: NumberCell -> NumberCell -> Bool
> :: NumberCell -> NumberCell -> Bool
$c> :: NumberCell -> NumberCell -> Bool
<= :: NumberCell -> NumberCell -> Bool
$c<= :: NumberCell -> NumberCell -> Bool
< :: NumberCell -> NumberCell -> Bool
$c< :: NumberCell -> NumberCell -> Bool
compare :: NumberCell -> NumberCell -> Ordering
$ccompare :: NumberCell -> NumberCell -> Ordering
Ord) via Down Double

instance Cellular NumberCell where
  cellDelta :: NumberCell -> NumberCell -> Double
cellDelta = coerce :: forall a b. Coercible a b => a -> b
coerce Double -> Double -> Double
doubleDelta
  cellString :: NumberCell -> Builder
cellString (NumberCell Double
r) = Double -> Builder
Builder.double4 Double
r

newtype NumberCell'
  = NumberCell' Double
  deriving (NumberCell' -> NumberCell' -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NumberCell' -> NumberCell' -> Bool
$c/= :: NumberCell' -> NumberCell' -> Bool
== :: NumberCell' -> NumberCell' -> Bool
$c== :: NumberCell' -> NumberCell' -> Bool
Eq, Eq NumberCell'
NumberCell' -> NumberCell' -> Bool
NumberCell' -> NumberCell' -> Ordering
NumberCell' -> NumberCell' -> NumberCell'
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: NumberCell' -> NumberCell' -> NumberCell'
$cmin :: NumberCell' -> NumberCell' -> NumberCell'
max :: NumberCell' -> NumberCell' -> NumberCell'
$cmax :: NumberCell' -> NumberCell' -> NumberCell'
>= :: NumberCell' -> NumberCell' -> Bool
$c>= :: NumberCell' -> NumberCell' -> Bool
> :: NumberCell' -> NumberCell' -> Bool
$c> :: NumberCell' -> NumberCell' -> Bool
<= :: NumberCell' -> NumberCell' -> Bool
$c<= :: NumberCell' -> NumberCell' -> Bool
< :: NumberCell' -> NumberCell' -> Bool
$c< :: NumberCell' -> NumberCell' -> Bool
compare :: NumberCell' -> NumberCell' -> Ordering
$ccompare :: NumberCell' -> NumberCell' -> Ordering
Ord) via Double
  deriving (Ord NumberCell'
NumberCell' -> Builder
NumberCell' -> NumberCell' -> Double
forall a.
Ord a -> (a -> a -> Double) -> (a -> Builder) -> Cellular a
cellString :: NumberCell' -> Builder
$ccellString :: NumberCell' -> Builder
cellDelta :: NumberCell' -> NumberCell' -> Double
$ccellDelta :: NumberCell' -> NumberCell' -> Double
Cellular) via NumberCell

newtype NanosecondsCell
  = NanosecondsCell Double
  deriving (NanosecondsCell -> NanosecondsCell -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NanosecondsCell -> NanosecondsCell -> Bool
$c/= :: NanosecondsCell -> NanosecondsCell -> Bool
== :: NanosecondsCell -> NanosecondsCell -> Bool
$c== :: NanosecondsCell -> NanosecondsCell -> Bool
Eq) via Double
  deriving (Eq NanosecondsCell
NanosecondsCell -> NanosecondsCell -> Bool
NanosecondsCell -> NanosecondsCell -> Ordering
NanosecondsCell -> NanosecondsCell -> NanosecondsCell
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: NanosecondsCell -> NanosecondsCell -> NanosecondsCell
$cmin :: NanosecondsCell -> NanosecondsCell -> NanosecondsCell
max :: NanosecondsCell -> NanosecondsCell -> NanosecondsCell
$cmax :: NanosecondsCell -> NanosecondsCell -> NanosecondsCell
>= :: NanosecondsCell -> NanosecondsCell -> Bool
$c>= :: NanosecondsCell -> NanosecondsCell -> Bool
> :: NanosecondsCell -> NanosecondsCell -> Bool
$c> :: NanosecondsCell -> NanosecondsCell -> Bool
<= :: NanosecondsCell -> NanosecondsCell -> Bool
$c<= :: NanosecondsCell -> NanosecondsCell -> Bool
< :: NanosecondsCell -> NanosecondsCell -> Bool
$c< :: NanosecondsCell -> NanosecondsCell -> Bool
compare :: NanosecondsCell -> NanosecondsCell -> Ordering
$ccompare :: NanosecondsCell -> NanosecondsCell -> Ordering
Ord) via Down Double

instance Cellular NanosecondsCell where
  cellDelta :: NanosecondsCell -> NanosecondsCell -> Double
cellDelta = coerce :: forall a b. Coercible a b => a -> b
coerce Double -> Double -> Double
doubleDelta
  cellString :: NanosecondsCell -> Builder
cellString (NanosecondsCell Double
r) = Double -> Builder
Builder.nanos4 Double
r

newtype PercentageCell
  = PercentageCell Double
  deriving (PercentageCell -> PercentageCell -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PercentageCell -> PercentageCell -> Bool
$c/= :: PercentageCell -> PercentageCell -> Bool
== :: PercentageCell -> PercentageCell -> Bool
$c== :: PercentageCell -> PercentageCell -> Bool
Eq) via Double
  deriving (Eq PercentageCell
PercentageCell -> PercentageCell -> Bool
PercentageCell -> PercentageCell -> Ordering
PercentageCell -> PercentageCell -> PercentageCell
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: PercentageCell -> PercentageCell -> PercentageCell
$cmin :: PercentageCell -> PercentageCell -> PercentageCell
max :: PercentageCell -> PercentageCell -> PercentageCell
$cmax :: PercentageCell -> PercentageCell -> PercentageCell
>= :: PercentageCell -> PercentageCell -> Bool
$c>= :: PercentageCell -> PercentageCell -> Bool
> :: PercentageCell -> PercentageCell -> Bool
$c> :: PercentageCell -> PercentageCell -> Bool
<= :: PercentageCell -> PercentageCell -> Bool
$c<= :: PercentageCell -> PercentageCell -> Bool
< :: PercentageCell -> PercentageCell -> Bool
$c< :: PercentageCell -> PercentageCell -> Bool
compare :: PercentageCell -> PercentageCell -> Ordering
$ccompare :: PercentageCell -> PercentageCell -> Ordering
Ord) via Down Double

instance Cellular PercentageCell where
  cellDelta :: PercentageCell -> PercentageCell -> Double
cellDelta = coerce :: forall a b. Coercible a b => a -> b
coerce Double -> Double -> Double
doubleDelta
  cellString :: PercentageCell -> Builder
cellString (PercentageCell Double
r) = Double -> Builder
Builder.percentage Double
r

prettyDelta :: Double -> Builder
prettyDelta :: Double -> Builder
prettyDelta Double
n
  | Double
n forall a. Ord a => a -> a -> Bool
>= Double
1 = Double -> Builder
Builder.double4 (Double
n forall a. Num a => a -> a -> a
+ Double
1) forall a. Semigroup a => a -> a -> a
<> Builder
"x"
  | Double
n forall a. Ord a => a -> a -> Bool
<= -Double
0.5 = Double -> Builder
Builder.double4 (-Double
1 Double -> Double -> Double
`divideDouble` (Double
n forall a. Num a => a -> a -> a
+ Double
1)) forall a. Semigroup a => a -> a -> a
<> Builder
"x"
  | Bool
otherwise = Double -> Builder
Builder.percentage Double
n

newtype PercentageCell'
  = PercentageCell' Double
  deriving (PercentageCell' -> PercentageCell' -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PercentageCell' -> PercentageCell' -> Bool
$c/= :: PercentageCell' -> PercentageCell' -> Bool
== :: PercentageCell' -> PercentageCell' -> Bool
$c== :: PercentageCell' -> PercentageCell' -> Bool
Eq, Eq PercentageCell'
PercentageCell' -> PercentageCell' -> Bool
PercentageCell' -> PercentageCell' -> Ordering
PercentageCell' -> PercentageCell' -> PercentageCell'
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: PercentageCell' -> PercentageCell' -> PercentageCell'
$cmin :: PercentageCell' -> PercentageCell' -> PercentageCell'
max :: PercentageCell' -> PercentageCell' -> PercentageCell'
$cmax :: PercentageCell' -> PercentageCell' -> PercentageCell'
>= :: PercentageCell' -> PercentageCell' -> Bool
$c>= :: PercentageCell' -> PercentageCell' -> Bool
> :: PercentageCell' -> PercentageCell' -> Bool
$c> :: PercentageCell' -> PercentageCell' -> Bool
<= :: PercentageCell' -> PercentageCell' -> Bool
$c<= :: PercentageCell' -> PercentageCell' -> Bool
< :: PercentageCell' -> PercentageCell' -> Bool
$c< :: PercentageCell' -> PercentageCell' -> Bool
compare :: PercentageCell' -> PercentageCell' -> Ordering
$ccompare :: PercentageCell' -> PercentageCell' -> Ordering
Ord) via Double
  deriving (Ord PercentageCell'
PercentageCell' -> Builder
PercentageCell' -> PercentageCell' -> Double
forall a.
Ord a -> (a -> a -> Double) -> (a -> Builder) -> Cellular a
cellString :: PercentageCell' -> Builder
$ccellString :: PercentageCell' -> Builder
cellDelta :: PercentageCell' -> PercentageCell' -> Double
$ccellDelta :: PercentageCell' -> PercentageCell' -> Double
Cellular) via PercentageCell

newtype IncomparableWord3Cell
  = IncomparableWord3Cell Word64
  deriving (IncomparableWord3Cell -> IncomparableWord3Cell -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IncomparableWord3Cell -> IncomparableWord3Cell -> Bool
$c/= :: IncomparableWord3Cell -> IncomparableWord3Cell -> Bool
== :: IncomparableWord3Cell -> IncomparableWord3Cell -> Bool
$c== :: IncomparableWord3Cell -> IncomparableWord3Cell -> Bool
Eq) via Word64
  deriving (Eq IncomparableWord3Cell
IncomparableWord3Cell -> IncomparableWord3Cell -> Bool
IncomparableWord3Cell -> IncomparableWord3Cell -> Ordering
IncomparableWord3Cell
-> IncomparableWord3Cell -> IncomparableWord3Cell
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: IncomparableWord3Cell
-> IncomparableWord3Cell -> IncomparableWord3Cell
$cmin :: IncomparableWord3Cell
-> IncomparableWord3Cell -> IncomparableWord3Cell
max :: IncomparableWord3Cell
-> IncomparableWord3Cell -> IncomparableWord3Cell
$cmax :: IncomparableWord3Cell
-> IncomparableWord3Cell -> IncomparableWord3Cell
>= :: IncomparableWord3Cell -> IncomparableWord3Cell -> Bool
$c>= :: IncomparableWord3Cell -> IncomparableWord3Cell -> Bool
> :: IncomparableWord3Cell -> IncomparableWord3Cell -> Bool
$c> :: IncomparableWord3Cell -> IncomparableWord3Cell -> Bool
<= :: IncomparableWord3Cell -> IncomparableWord3Cell -> Bool
$c<= :: IncomparableWord3Cell -> IncomparableWord3Cell -> Bool
< :: IncomparableWord3Cell -> IncomparableWord3Cell -> Bool
$c< :: IncomparableWord3Cell -> IncomparableWord3Cell -> Bool
compare :: IncomparableWord3Cell -> IncomparableWord3Cell -> Ordering
$ccompare :: IncomparableWord3Cell -> IncomparableWord3Cell -> Ordering
Ord) via Down Word64

instance Cellular IncomparableWord3Cell where
  cellDelta :: IncomparableWord3Cell -> IncomparableWord3Cell -> Double
cellDelta IncomparableWord3Cell
_ IncomparableWord3Cell
_ = Double
0 -- incomparable
  cellString :: IncomparableWord3Cell -> Builder
cellString (IncomparableWord3Cell Word64
r) = Word64 -> Builder
Builder.word3 Word64
r

doubleDelta :: Double -> Double -> Double
doubleDelta :: Double -> Double -> Double
doubleDelta Double
v1 Double
v2 =
  (Double
v2 forall a. Num a => a -> a -> a
- Double
v1) Double -> Double -> Double
`divideDouble` Double
v1

rowMaker :: forall a. Array1 a -> (forall b. Cellular b => R a b -> Row)
rowMaker :: forall a. Array1 a -> forall b. Cellular b => R a b -> Row
rowMaker (forall a. Array1 a -> (a, Array Int a)
Array1.uncons -> (a
summary0, Array Int a
summaries0)) (R Cell
name (a -> Maybe b
f :: a -> Maybe b)) =
  let cols :: [Cell]
cols =
        forall b a. b -> (a -> b) -> Maybe a -> b
maybe
          Cell
EmptyCell
          (Color -> Text -> Cell
Cell Color
White forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
Builder.build forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Cellular a => a -> Builder
cellString)
          (a -> Maybe b
f a
summary0) forall a. a -> [a] -> [a]
:
        Maybe b -> [a] -> [Cell]
makeCols (a -> Maybe b
f a
summary0) (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Array Int a
summaries0)
   in if forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Cell -> Bool
isEmptyCell [Cell]
cols then Row
EmptyRow else [Cell] -> Row
Row (Cell
name forall a. a -> [a] -> [a]
: [Cell]
cols)
  where
    makeCols :: Maybe b -> [a] -> [Cell]
    makeCols :: Maybe b -> [a] -> [Cell]
makeCols Maybe b
s0 = \case
      [] -> [Cell]
totalDelta
      a
s1 : [a]
ss ->
        case (Maybe b
s0, a -> Maybe b
f a
s1) of
          (Maybe b
Nothing, Just b
v1) -> Cell
EmptyCell forall a. a -> [a] -> [a]
: Color -> Text -> Cell
Cell Color
White (Builder -> Text
Builder.build (forall a. Cellular a => a -> Builder
cellString b
v1)) forall a. a -> [a] -> [a]
: Maybe b -> [a] -> [Cell]
makeCols (forall a. a -> Maybe a
Just b
v1) [a]
ss
          (Just b
v0, Just b
v1) -> forall a. Cellular a => a -> a -> Cell
deltaCell b
v0 b
v1 forall a. a -> [a] -> [a]
: Color -> Text -> Cell
Cell Color
White (Builder -> Text
Builder.build (forall a. Cellular a => a -> Builder
cellString b
v1)) forall a. a -> [a] -> [a]
: Maybe b -> [a] -> [Cell]
makeCols (forall a. a -> Maybe a
Just b
v1) [a]
ss
          (Maybe b
_, Maybe b
Nothing) -> Cell
EmptyCell forall a. a -> [a] -> [a]
: Cell
EmptyCell forall a. a -> [a] -> [a]
: Maybe b -> [a] -> [Cell]
makeCols forall a. Maybe a
Nothing [a]
ss

    totalDelta :: [Cell]
    totalDelta :: [Cell]
totalDelta =
      if Int
n forall a. Ord a => a -> a -> Bool
< Int
2
        then []
        else case (a -> Maybe b
f a
summary0, a -> Maybe b
f (Array Int a
summaries0 forall i e. Ix i => Array i e -> i -> e
Array.! (Int
n forall a. Num a => a -> a -> a
- Int
1))) of
          (Just b
v0, Just b
v1) -> [forall a. Cellular a => a -> a -> Cell
deltaCell b
v0 b
v1]
          (Maybe b, Maybe b)
_ -> [Cell
EmptyCell]
      where
        n :: Int
n = forall (t :: * -> *) a. Foldable t => t a -> Int
length Array Int a
summaries0

deltaCell :: Cellular a => a -> a -> Cell
deltaCell :: forall a. Cellular a => a -> a -> Cell
deltaCell a
v1 a
v2 =
  if Builder -> Bool
Builder.null (forall a. Cellular a => a -> Builder
cellString a
v1) Bool -> Bool -> Bool
|| Builder -> Bool
Builder.null (forall a. Cellular a => a -> Builder
cellString a
v2)
    then Cell
EmptyCell
    else Color -> Text -> Cell
Cell Color
color (Builder -> Text
Builder.build (Double -> Builder
prettyDelta (forall a. Cellular a => a -> a -> Double
cellDelta a
v1 a
v2)))
  where
    color :: Color
    color :: Color
color =
      case forall a. Ord a => a -> a -> Ordering
compare a
v1 a
v2 of
        Ordering
LT -> Color
Green
        Ordering
EQ -> Color
White
        Ordering
GT -> Color
Red

data Table
  = Table ![Cell] ![RowGroup]
  deriving stock (Int -> Table -> ShowS
[Table] -> ShowS
Table -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Table] -> ShowS
$cshowList :: [Table] -> ShowS
show :: Table -> String
$cshow :: Table -> String
showsPrec :: Int -> Table -> ShowS
$cshowsPrec :: Int -> Table -> ShowS
Show)

data RowGroup
  = RowGroup {-# UNPACK #-} !Text ![Row]
  deriving stock (Int -> RowGroup -> ShowS
[RowGroup] -> ShowS
RowGroup -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RowGroup] -> ShowS
$cshowList :: [RowGroup] -> ShowS
show :: RowGroup -> String
$cshow :: RowGroup -> String
showsPrec :: Int -> RowGroup -> ShowS
$cshowsPrec :: Int -> RowGroup -> ShowS
Show)

data Row
  = -- | Invariant: 1+ cells; not all cells are empty
    Row ![Cell]
  | EmptyRow
  deriving stock (Int -> Row -> ShowS
[Row] -> ShowS
Row -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Row] -> ShowS
$cshowList :: [Row] -> ShowS
show :: Row -> String
$cshow :: Row -> String
showsPrec :: Int -> Row -> ShowS
$cshowsPrec :: Int -> Row -> ShowS
Show)

data Cell
  = EmptyCell
  | Cell !Color {-# UNPACK #-} !Text
  deriving stock (Int -> Cell -> ShowS
[Cell] -> ShowS
Cell -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Cell] -> ShowS
$cshowList :: [Cell] -> ShowS
show :: Cell -> String
$cshow :: Cell -> String
showsPrec :: Int -> Cell -> ShowS
$cshowsPrec :: Int -> Cell -> ShowS
Show)

cellBuilder :: Cell -> Builder
cellBuilder :: Cell -> Builder
cellBuilder = \case
  Cell
EmptyCell -> Builder
Builder.empty
  Cell Color
color (Text -> Builder
Builder.text -> Builder
s) ->
    case Color
color of
      Color
Blue -> Builder -> Builder
Terminal.blue Builder
s
      Color
Green -> Builder -> Builder
Terminal.green Builder
s
      Color
Red -> Builder -> Builder
Terminal.red Builder
s
      Color
White -> Builder
s

cellWidth :: Cell -> Int
cellWidth :: Cell -> Int
cellWidth = \case
  Cell Color
_ Text
s -> Text -> Int
Text.length Text
s
  Cell
EmptyCell -> Int
0

instance IsString Cell where
  fromString :: String -> Cell
fromString =
    Color -> Text -> Cell
Cell Color
White forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack

data Color
  = Blue
  | Green
  | Red
  | White
  deriving stock (Int -> Color -> ShowS
[Color] -> ShowS
Color -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Color] -> ShowS
$cshowList :: [Color] -> ShowS
show :: Color -> String
$cshow :: Color -> String
showsPrec :: Int -> Color -> ShowS
$cshowsPrec :: Int -> Color -> ShowS
Show)

isEmptyCell :: Cell -> Bool
isEmptyCell :: Cell -> Bool
isEmptyCell = \case
  -- don't yet have invariant that s is non-null
  Cell Color
_ Text
s -> Text -> Bool
Text.null Text
s
  Cell
EmptyCell -> Bool
True

data Align
  = AlignLeft
  | AlignRight

renderTable :: Table -> Builder
renderTable :: Table -> Builder
renderTable (Table [Cell]
labels [RowGroup]
rowGroups) =
  (Builder
header forall a. a -> [a] -> [a]
: forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe RowGroup -> Maybe Builder
renderRowGroup [RowGroup]
rowGroups forall a. [a] -> [a] -> [a]
++ [Builder
footer]) [Builder] -> Builder -> Builder
`Builder.sepBy` Char -> Builder
Builder.char Char
'\n'
  where
    header :: Builder
    header :: Builder
header =
      Char -> Builder
Builder.char Char
'┌'
        forall a. Semigroup a => a -> a -> a
<> ((forall a b. (a -> b) -> [a] -> [b]
map (Align -> Char -> (Int, Cell) -> Builder
renderCell Align
AlignLeft Char
'─') (forall a b. [a] -> [b] -> [(a, b)]
zip (forall a b. (a -> b) -> [a] -> [b]
map (forall a. Num a => a -> a -> a
+ Int
2) [Int]
widths) [Cell]
labels)) [Builder] -> Builder -> Builder
`Builder.sepBy` Char -> Builder
Builder.char Char
'┬')
        forall a. Semigroup a => a -> a -> a
<> Char -> Builder
Builder.char Char
'┐'

    footer :: Builder
    footer :: Builder
footer =
      Char -> Builder
Builder.char Char
'└'
        forall a. Semigroup a => a -> a -> a
<> ((forall a b. (a -> b) -> [a] -> [b]
map (\Int
n -> Int -> Char -> Builder
Builder.chars (Int
n forall a. Num a => a -> a -> a
+ Int
2) Char
'─') [Int]
widths) [Builder] -> Builder -> Builder
`Builder.sepBy` Char -> Builder
Builder.char Char
'┴')
        forall a. Semigroup a => a -> a -> a
<> Char -> Builder
Builder.char Char
'┘'

    renderRowGroup :: RowGroup -> Maybe Builder
    renderRowGroup :: RowGroup -> Maybe Builder
renderRowGroup (RowGroup Text
label [Row]
rows) =
      case forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Row -> Maybe Builder
renderRow [Row]
rows of
        [] -> forall a. Maybe a
Nothing
        [Builder]
s -> forall a. a -> Maybe a
Just ((Builder
line forall a. a -> [a] -> [a]
: [Builder]
s) [Builder] -> Builder -> Builder
`Builder.sepBy` Char -> Builder
Builder.char Char
'\n')
      where
        line :: Builder
line =
          case [Int]
widths of
            Int
w0 : [Int]
ws ->
              Char -> Builder
Builder.char Char
'├'
                forall a. Semigroup a => a -> a -> a
<> Builder
"\ESC[1m\ESC[97m"
                forall a. Semigroup a => a -> a -> a
<> Text -> Builder
Builder.text ((Char -> Char) -> Text -> Text
Text.map Char -> Char
dash Text
label)
                forall a. Semigroup a => a -> a -> a
<> Builder
"\ESC[39m\ESC[22m"
                forall a. Semigroup a => a -> a -> a
<> Int -> Char -> Builder
Builder.chars (Int
w0 forall a. Num a => a -> a -> a
+ Int
2 forall a. Num a => a -> a -> a
- Text -> Int
Text.length Text
label) Char
'─'
                forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\Int
n -> Char -> Builder
Builder.char Char
'┼' forall a. Semigroup a => a -> a -> a
<> Int -> Char -> Builder
Builder.chars (Int
n forall a. Num a => a -> a -> a
+ Int
2) Char
'─') [Int]
ws
                forall a. Semigroup a => a -> a -> a
<> Char -> Builder
Builder.char Char
'┤'
            [Int]
_ -> forall a. HasCallStack => a
undefined

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

    renderRow :: Row -> Maybe Builder
    renderRow :: Row -> Maybe Builder
renderRow = \case
      Row [Cell]
row -> forall a. a -> Maybe a
Just (Builder
"│ " forall a. Semigroup a => a -> a -> a
<> ((forall a b. (a -> b) -> [a] -> [b]
map (Align -> Char -> (Int, Cell) -> Builder
renderCell Align
AlignRight Char
' ') (forall a b. [a] -> [b] -> [(a, b)]
zip [Int]
widths [Cell]
row)) [Builder] -> Builder -> Builder
`Builder.sepBy` Builder
" │ ") forall a. Semigroup a => a -> a -> a
<> Builder
" │")
      Row
EmptyRow -> forall a. Maybe a
Nothing

    renderCell :: Align -> Char -> (Int, Cell) -> Builder
    renderCell :: Align -> Char -> (Int, Cell) -> Builder
renderCell Align
align Char
bg (Int
n, Cell
cell) =
      case Align
align of
        Align
AlignLeft -> Cell -> Builder
cellBuilder Cell
cell forall a. Semigroup a => a -> a -> a
<> Builder
padding
        Align
AlignRight -> Builder
padding forall a. Semigroup a => a -> a -> a
<> Cell -> Builder
cellBuilder Cell
cell
      where
        padding :: Builder
padding = Int -> Char -> Builder
Builder.chars (Int
n forall a. Num a => a -> a -> a
- Cell -> Int
cellWidth Cell
cell) Char
bg

    widths :: [Int]
    widths :: [Int]
widths =
      forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' [Int] -> RowGroup -> [Int]
step0 (forall a b. (a -> b) -> [a] -> [b]
map (forall a. Num a => a -> a -> a
subtract Int
1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Cell -> Int
cellWidth) [Cell]
labels) [RowGroup]
rowGroups
      where
        step0 :: [Int] -> RowGroup -> [Int]
        step0 :: [Int] -> RowGroup -> [Int]
step0 [Int]
acc (RowGroup Text
label [Row]
rows) =
          forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (Text -> [Int] -> Row -> [Int]
step1 Text
label) [Int]
acc [Row]
rows

        step1 :: Text -> [Int] -> Row -> [Int]
        step1 :: Text -> [Int] -> Row -> [Int]
step1 Text
label [Int]
acc = \case
          Row [] -> forall a. HasCallStack => String -> a
error String
"empty row"
          Row (Cell
col : [Cell]
cols) -> forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall a. Ord a => a -> a -> a
max (forall a. Ord a => a -> a -> a
max (Text -> Int
Text.length Text
label) (Cell -> Int
cellWidth Cell
col) forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map Cell -> Int
cellWidth [Cell]
cols) [Int]
acc
          Row
EmptyRow -> [Int]
acc