{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}

-- | This module provides the 'KVITable' 'render' function for
-- rendering the table in a plain ASCII format.

module Data.KVITable.Render.ASCII
  (
    render
    -- re-export Render definitions to save the caller an additional import
  , RenderConfig(..)
  , defaultRenderConfig
  )
where

import qualified Data.List as L
import           Data.Maybe ( isNothing )
import           Data.Name
import           Data.String ( fromString )
import           Data.Text ( Text )
import qualified Data.Text as T
import           Lens.Micro ( (^.) )
import           Numeric.Natural
import           Text.Sayable

import           Data.KVITable ( KVITable, KeySpec, keyVals )
import qualified Data.KVITable as KVIT
import           Data.KVITable.Internal.Helpers
import           Data.KVITable.Render
import           Data.KVITable.Render.Internal

import           Prelude hiding ( lookup )


-- | Renders the specified table in ASCII format, using the specified
-- 'RenderConfig' controls.

render :: Sayable "normal" v => RenderConfig -> KVITable v -> Text
render :: forall v. Sayable "normal" v => RenderConfig -> KVITable v -> Text
render RenderConfig
cfg KVITable v
t =
  let kmap :: (TblHdrs, TblHdrs)
kmap = RenderConfig -> KeyVals -> (TblHdrs, TblHdrs)
renderingKeyVals RenderConfig
cfg (KeyVals -> (TblHdrs, TblHdrs)) -> KeyVals -> (TblHdrs, TblHdrs)
forall a b. (a -> b) -> a -> b
$ KVITable v
t KVITable v -> Getting KeyVals (KVITable v) KeyVals -> KeyVals
forall s a. s -> Getting a s a -> a
^. Getting KeyVals (KVITable v) KeyVals
forall v (f :: * -> *).
Functor f =>
(KeyVals -> f KeyVals) -> KVITable v -> f (KVITable v)
keyVals
      (FmtLine
fmt, [Text]
hdr) = RenderConfig
-> KVITable v -> (TblHdrs, TblHdrs) -> (FmtLine, [Text])
forall v.
Sayable "normal" v =>
RenderConfig
-> KVITable v -> (TblHdrs, TblHdrs) -> (FmtLine, [Text])
renderHdrs RenderConfig
cfg KVITable v
t (TblHdrs, TblHdrs)
kmap
      bdy :: [Text]
bdy = RenderConfig
-> FmtLine -> (TblHdrs, TblHdrs) -> KVITable v -> [Text]
forall v.
Sayable "normal" v =>
RenderConfig
-> FmtLine -> (TblHdrs, TblHdrs) -> KVITable v -> [Text]
renderSeq RenderConfig
cfg FmtLine
fmt (TblHdrs, TblHdrs)
kmap KVITable v
t
  in [Text] -> Text
T.unlines ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ [Text]
hdr [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text]
bdy

----------------------------------------------------------------------

data FmtLine = FmtLine [Natural] Sigils Sigils  -- last is for sepline
data Sigils = Sigils { Sigils -> Text
sep :: Text, Sigils -> Text
pad :: Text, Sigils -> Text
cap :: Text }

fmtLine :: [Natural] -> FmtLine
fmtLine :: [Natural] -> FmtLine
fmtLine [Natural]
cols = [Natural] -> Sigils -> Sigils -> FmtLine
FmtLine [Natural]
cols
               Sigils { sep :: Text
sep = Text
"|", pad :: Text
pad = Text
" ", cap :: Text
cap = Text
"_" }
               Sigils { sep :: Text
sep = Text
"+", pad :: Text
pad = Text
"-", cap :: Text
cap = Text
"_" }

fmtColCnt :: FmtLine -> Natural
fmtColCnt :: FmtLine -> Natural
fmtColCnt (FmtLine [Natural]
cols Sigils
_ Sigils
_) = [Natural] -> Natural
forall (t :: * -> *) a. Foldable t => t a -> Natural
nLength [Natural]
cols

perColOvhd :: Natural
perColOvhd :: Natural
perColOvhd = Natural
2 -- pad chars on either side of each column's entry

-- | Formatted width of output, including pad on either side of each
-- column's value (but not the outer set), and a separator between columns.
--
-- Note that a column size of 0 indicates that hideBlankCols is active
-- and the column was found to be empty of values, so it should not be
-- counted.
fmtWidth :: FmtLine -> Natural
fmtWidth :: FmtLine -> Natural
fmtWidth (FmtLine [Natural]
cols Sigils
_ Sigils
_) =
  let cols' :: [Natural]
cols' = (Natural -> Bool) -> [Natural] -> [Natural]
forall a. (a -> Bool) -> [a] -> [a]
L.filter (Natural -> Natural -> Bool
forall a. Eq a => a -> a -> Bool
/= Natural
0) [Natural]
cols
  in [Natural] -> Natural
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Natural]
cols' Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
+ ((Natural
perColOvhd Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
+ Natural
1) Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
* ([Natural] -> Natural
forall (t :: * -> *) a. Foldable t => t a -> Natural
nLength [Natural]
cols' Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
- Natural
1))

fmtEmptyCols :: FmtLine -> Bool
fmtEmptyCols :: FmtLine -> Bool
fmtEmptyCols (FmtLine [Natural]
cols Sigils
_ Sigils
_) = [Natural] -> Natural
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Natural]
cols Natural -> Natural -> Bool
forall a. Eq a => a -> a -> Bool
== Natural
0

fmtAddColLeft :: Natural -> FmtLine -> FmtLine
fmtAddColLeft :: Natural -> FmtLine -> FmtLine
fmtAddColLeft Natural
leftCol (FmtLine [Natural]
cols Sigils
s Sigils
s') = [Natural] -> Sigils -> Sigils -> FmtLine
FmtLine (Natural
leftCol Natural -> [Natural] -> [Natural]
forall a. a -> [a] -> [a]
: [Natural]
cols) Sigils
s Sigils
s'

data FmtVal = Separator | TxtVal Text | CenterVal Text
            | Overage  -- cells for the overflow row/column

fmtRender :: FmtLine -> [FmtVal] -> Text
fmtRender :: FmtLine -> [FmtVal] -> Text
fmtRender (FmtLine [Natural]
_cols Sigils
_sigils Sigils
_sepsigils) [] = Text
""
fmtRender (FmtLine [Natural]
cols Sigils
sigils Sigils
sepsigils) vals :: [FmtVal]
vals@(FmtVal
val:[FmtVal]
_) =
  if [Natural] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Natural]
cols Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== [FmtVal] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [FmtVal]
vals
  then let sig :: (Sigils -> t) -> FmtVal -> t
sig Sigils -> t
f FmtVal
o = case FmtVal
o of
                       FmtVal
Separator   -> Sigils -> t
f Sigils
sepsigils
                       TxtVal Text
_    -> Sigils -> t
f Sigils
sigils
                       CenterVal Text
_ -> Sigils -> t
f Sigils
sigils
                       FmtVal
Overage     -> Sigils -> t
f Sigils
sigils
           l :: Text
l = (Sigils -> Text) -> FmtVal -> Text
forall {t}. (Sigils -> t) -> FmtVal -> t
sig Sigils -> Text
sep FmtVal
val
           charRepeat :: a -> Char -> Text
charRepeat a
n Char
c = [Char] -> Text
T.pack (Int -> Char -> [Char]
forall a. Int -> a -> [a]
replicate (a -> Int
forall a. Enum a => a -> Int
fromEnum a
n) Char
c)
           rightAlign :: a -> Text -> Text
rightAlign a
n Text
t = let tl :: a
tl = Int -> a
forall a. Enum a => Int -> a
toEnum (Int -> a) -> Int -> a
forall a b. (a -> b) -> a -> b
$ Text -> Int
T.length Text
t
                                rt :: Text
rt = a -> Char -> Text
forall {a}. Enum a => a -> Char -> Text
charRepeat (a
n a -> a -> a
forall a. Num a => a -> a -> a
- a
tl) Char
' ' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t
                            in if a
tl a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
n then Text
t else Text
rt
           centerIn :: a -> Text -> Text
centerIn a
n Text
t = let tl :: a
tl = Int -> a
forall a. Enum a => Int -> a
toEnum (Int -> a) -> Int -> a
forall a b. (a -> b) -> a -> b
$ Text -> Int
T.length Text
t
                              (a
w,a
e) = (a
n a -> a -> a
forall a. Num a => a -> a -> a
- a
tl a -> a -> a
forall a. Num a => a -> a -> a
- a
2) a -> a -> (a, a)
forall a. Integral a => a -> a -> (a, a)
`divMod` a
2
                              m :: Text
m = Sigils -> Text
cap Sigils
sigils
                              ls :: Text
ls = Int -> Text -> Text
T.replicate (a -> Int
forall a. Enum a => a -> Int
fromEnum (a -> Int) -> a -> Int
forall a b. (a -> b) -> a -> b
$ a
w a -> a -> a
forall a. Num a => a -> a -> a
+ a
0) Text
m
                              rs :: Text
rs = Int -> Text -> Text
T.replicate (a -> Int
forall a. Enum a => a -> Int
fromEnum (a -> Int) -> a -> Int
forall a b. (a -> b) -> a -> b
$ a
w a -> a -> a
forall a. Num a => a -> a -> a
+ a
e) Text
m
                          in if a
tl a -> a -> a
forall a. Num a => a -> a -> a
+ a
2 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
n
                             then a -> Text -> Text
forall {a}. (Ord a, Enum a, Num a) => a -> Text -> Text
rightAlign a
n Text
t
                             else Text
ls Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
rs
       in Text
l Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
          [Text] -> Text
T.concat
          [ (Sigils -> Text) -> FmtVal -> Text
forall {t}. (Sigils -> t) -> FmtVal -> t
sig Sigils -> Text
pad FmtVal
fld Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
            (case FmtVal
fld of
                FmtVal
Separator   -> Natural -> Char -> Text
forall {a}. Enum a => a -> Char -> Text
charRepeat Natural
sz Char
'-'
                TxtVal Text
v    -> Natural -> Text -> Text
forall {a}. (Ord a, Enum a, Num a) => a -> Text -> Text
rightAlign Natural
sz Text
v
                CenterVal Text
t -> Natural -> Text -> Text
forall {a}. Integral a => a -> Text -> Text
centerIn Natural
sz Text
t
                FmtVal
Overage     -> Natural -> Text -> Text
forall {a}. Integral a => a -> Text -> Text
centerIn Natural
sz Text
"+"
            ) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
            (Sigils -> Text) -> FmtVal -> Text
forall {t}. (Sigils -> t) -> FmtVal -> t
sig Sigils -> Text
pad FmtVal
fld Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
            (Sigils -> Text) -> FmtVal -> Text
forall {t}. (Sigils -> t) -> FmtVal -> t
sig Sigils -> Text
sep FmtVal
fld  -- KWQ or if next fld is Nothing
          | (Natural
sz,FmtVal
fld) <- [Natural] -> [FmtVal] -> [(Natural, FmtVal)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Natural]
cols [FmtVal]
vals, Natural
sz Natural -> Natural -> Bool
forall a. Eq a => a -> a -> Bool
/= Natural
0
          ]
  else [Char] -> Text
forall a. HasCallStack => [Char] -> a
error ([Char]
"Insufficient arguments (" [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<>
              Int -> [Char]
forall a. Show a => a -> [Char]
show ([FmtVal] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [FmtVal]
vals) [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
")" [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<>
              [Char]
" for FmtLine " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Int -> [Char]
forall a. Show a => a -> [Char]
show ([Natural] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Natural]
cols))

----------------------------------------------------------------------

data HeaderLine = HdrLine FmtLine HdrVals Trailer
type HdrVals = [FmtVal]
type Trailer = Name "column header"

hdrFmt :: HeaderLine -> FmtLine
hdrFmt :: HeaderLine -> FmtLine
hdrFmt (HdrLine FmtLine
fmt [FmtVal]
_ Name "column header"
_) = FmtLine
fmt

renderHdrs :: Sayable "normal" v
           => RenderConfig -> KVITable v -> (TblHdrs, TblHdrs)
           -> (FmtLine, [Text])
renderHdrs :: forall v.
Sayable "normal" v =>
RenderConfig
-> KVITable v -> (TblHdrs, TblHdrs) -> (FmtLine, [Text])
renderHdrs RenderConfig
cfg KVITable v
t (TblHdrs, TblHdrs)
kmap =
  ( FmtLine
lastFmt
  , [ FmtLine -> [FmtVal] -> Text
fmtRender FmtLine
fmt [FmtVal]
hdrvals
      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (if Name "column header" -> Bool
forall (style :: Symbol) (nm :: Symbol). Named style nm -> Bool
nullName Name "column header"
trailer then Text
"" else (Text
" <- " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Name "column header" -> Text
forall (nm :: Symbol). Named UTF8 nm -> Text
forall (style :: Symbol) (nm :: Symbol).
NameText style =>
Named style nm -> Text
nameText Name "column header"
trailer))
    | (HdrLine FmtLine
fmt [FmtVal]
hdrvals Name "column header"
trailer) <- [HeaderLine]
hrows
    ] [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<>
    (Text -> [Text]
forall e. e -> [e]
single (Text -> [Text]) -> Text -> [Text]
forall a b. (a -> b) -> a -> b
$ let sz :: Int
sz = Natural -> Int
forall a. Enum a => a -> Int
fromEnum (Natural -> Int) -> Natural -> Int
forall a b. (a -> b) -> a -> b
$ FmtLine -> Natural
fmtColCnt FmtLine
lastFmt
              in FmtLine -> [FmtVal] -> Text
fmtRender FmtLine
lastFmt (Int -> FmtVal -> [FmtVal]
forall a. Int -> a -> [a]
replicate Int
sz FmtVal
Separator)) )
  where
    hrows :: [HeaderLine]
hrows = RenderConfig -> KVITable v -> (TblHdrs, TblHdrs) -> [HeaderLine]
forall v.
Sayable "normal" v =>
RenderConfig -> KVITable v -> (TblHdrs, TblHdrs) -> [HeaderLine]
hdrstep RenderConfig
cfg KVITable v
t (TblHdrs, TblHdrs)
kmap
    lastFmt :: FmtLine
lastFmt = case [HeaderLine] -> [HeaderLine]
forall a. [a] -> [a]
reverse [HeaderLine]
hrows of
                [] -> [Natural] -> FmtLine
fmtLine [Natural]
forall a. Monoid a => a
mempty
                (HeaderLine
hrow:[HeaderLine]
_) -> HeaderLine -> FmtLine
hdrFmt HeaderLine
hrow

hdrstep :: Sayable "normal" v
        => RenderConfig
        -> KVITable v
        -> (TblHdrs, TblHdrs)
        -> [HeaderLine]
hdrstep :: forall v.
Sayable "normal" v =>
RenderConfig -> KVITable v -> (TblHdrs, TblHdrs) -> [HeaderLine]
hdrstep RenderConfig
_cfg KVITable v
t ([], []) =
  -- colStackAt wasn't recognized, so devolve into a non-colstack table
  let valcoltxt :: Named HTMLStyle "column header"
valcoltxt = KVITable v
t KVITable v
-> Getting
     (Named HTMLStyle "column header")
     (KVITable v)
     (Named HTMLStyle "column header")
-> Named HTMLStyle "column header"
forall s a. s -> Getting a s a -> a
^. Getting
  (Named HTMLStyle "column header")
  (KVITable v)
  (Named HTMLStyle "column header")
forall v (f :: * -> *).
Functor f =>
(Named HTMLStyle "column header"
 -> f (Named HTMLStyle "column header"))
-> KVITable v -> f (KVITable v)
KVIT.valueColName
      valcoltsz :: Natural
valcoltsz = Named HTMLStyle "column header" -> Natural
forall (style :: Symbol) (nm :: Symbol). Named style nm -> Natural
nameLength Named HTMLStyle "column header"
valcoltxt
      valsizes :: [Natural]
valsizes  = [Char] -> Natural
forall (t :: * -> *) a. Foldable t => t a -> Natural
nLength ([Char] -> Natural)
-> ((KeySpec, v) -> [Char]) -> (KeySpec, v) -> Natural
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (saytag :: Symbol) a. Sayable saytag a => a -> [Char]
sez @"normal" (v -> [Char]) -> ((KeySpec, v) -> v) -> (KeySpec, v) -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (KeySpec, v) -> v
forall a b. (a, b) -> b
snd ((KeySpec, v) -> Natural) -> [(KeySpec, v)] -> [Natural]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> KVITable v -> [Item (KVITable v)]
forall v. KVITable v -> [Item (KVITable v)]
KVIT.toList KVITable v
t
      valwidth :: Natural
valwidth  = Natural -> [Natural] -> Natural
forall (t :: * -> *) e. (Foldable t, Ord e) => e -> t e -> e
maxOf Natural
0 ([Natural] -> Natural) -> [Natural] -> Natural
forall a b. (a -> b) -> a -> b
$ Natural
valcoltsz Natural -> [Natural] -> [Natural]
forall a. a -> [a] -> [a]
: [Natural]
valsizes
      hdrVal :: FmtVal
hdrVal = Text -> FmtVal
TxtVal (Text -> FmtVal) -> Text -> FmtVal
forall a b. (a -> b) -> a -> b
$ Named HTMLStyle "column header" -> Text
forall (nm :: Symbol). Named HTMLStyle nm -> Text
forall (style :: Symbol) (nm :: Symbol).
NameText style =>
Named style nm -> Text
nameText Named HTMLStyle "column header"
valcoltxt
  in HeaderLine -> [HeaderLine]
forall e. e -> [e]
single (HeaderLine -> [HeaderLine]) -> HeaderLine -> [HeaderLine]
forall a b. (a -> b) -> a -> b
$ FmtLine -> [FmtVal] -> Name "column header" -> HeaderLine
HdrLine ([Natural] -> FmtLine
fmtLine ([Natural] -> FmtLine) -> [Natural] -> FmtLine
forall a b. (a -> b) -> a -> b
$ Natural -> [Natural]
forall e. e -> [e]
single Natural
valwidth) (FmtVal -> [FmtVal]
forall e. e -> [e]
single FmtVal
hdrVal) Name "column header"
""
hdrstep RenderConfig
cfg KVITable v
t ([], TblHdrs
colKeyMap) =
  RenderConfig -> KVITable v -> TblHdrs -> KeySpec -> [HeaderLine]
forall v.
Sayable "normal" v =>
RenderConfig -> KVITable v -> TblHdrs -> KeySpec -> [HeaderLine]
hdrvalstep RenderConfig
cfg KVITable v
t TblHdrs
colKeyMap KeySpec
forall a. Monoid a => a
mempty  -- switch to column-stacking mode
hdrstep RenderConfig
cfg KVITable v
t ((Named UTF8 "Key"
key,[TblHdr]
keyvals) : TblHdrs
keys, TblHdrs
colKeyMap) =
  let keyw :: Natural
keyw = Natural -> Natural -> Natural
forall a. Ord a => a -> a -> a
max (Named UTF8 "Key" -> Natural
forall (style :: Symbol) (nm :: Symbol). Named style nm -> Natural
nameLength Named UTF8 "Key"
key)
             (Natural -> Natural) -> Natural -> Natural
forall a b. (a -> b) -> a -> b
$ (Natural -> [Natural] -> Natural
forall (t :: * -> *) e. (Foldable t, Ord e) => e -> t e -> e
maxOf Natural
0 ([Natural] -> Natural)
-> ([TblHdr] -> [Natural]) -> [TblHdr] -> Natural
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TblHdr -> Natural) -> [TblHdr] -> [Natural]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Name "column header" -> Natural
forall (style :: Symbol) (nm :: Symbol). Named style nm -> Natural
nameLength (Name "column header" -> Natural)
-> (TblHdr -> Name "column header") -> TblHdr -> Natural
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TblHdr -> Name "column header"
toHdrText)) [TblHdr]
keyvals
      mkhdr :: ([HeaderLine], Named style nm) -> HeaderLine -> ([HeaderLine], b)
mkhdr ([HeaderLine]
hs, Named style nm
v) (HdrLine FmtLine
fmt [FmtVal]
hdrvals Name "column header"
trailer) =
        ( FmtLine -> [FmtVal] -> Name "column header" -> HeaderLine
HdrLine (Natural -> FmtLine -> FmtLine
fmtAddColLeft Natural
keyw FmtLine
fmt) (Text -> FmtVal
TxtVal (Named style nm -> Text
forall (nm :: Symbol). Named style nm -> Text
forall (style :: Symbol) (nm :: Symbol).
NameText style =>
Named style nm -> Text
nameText Named style nm
v) FmtVal -> [FmtVal] -> [FmtVal]
forall a. a -> [a] -> [a]
: [FmtVal]
hdrvals) Name "column header"
trailer HeaderLine -> [HeaderLine] -> [HeaderLine]
forall a. a -> [a] -> [a]
: [HeaderLine]
hs , b
"")
  in [HeaderLine] -> [HeaderLine]
forall a. [a] -> [a]
reverse ([HeaderLine] -> [HeaderLine]) -> [HeaderLine] -> [HeaderLine]
forall a b. (a -> b) -> a -> b
$ ([HeaderLine], Named UTF8 "Key") -> [HeaderLine]
forall a b. (a, b) -> a
fst (([HeaderLine], Named UTF8 "Key") -> [HeaderLine])
-> ([HeaderLine], Named UTF8 "Key") -> [HeaderLine]
forall a b. (a -> b) -> a -> b
$ (([HeaderLine], Named UTF8 "Key")
 -> HeaderLine -> ([HeaderLine], Named UTF8 "Key"))
-> ([HeaderLine], Named UTF8 "Key")
-> [HeaderLine]
-> ([HeaderLine], Named UTF8 "Key")
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl ([HeaderLine], Named UTF8 "Key")
-> HeaderLine -> ([HeaderLine], Named UTF8 "Key")
forall {style :: Symbol} {b} {nm :: Symbol}.
(NameText style, IsString b) =>
([HeaderLine], Named style nm) -> HeaderLine -> ([HeaderLine], b)
mkhdr ([HeaderLine]
forall a. Monoid a => a
mempty, Named UTF8 "Key"
key) ([HeaderLine] -> ([HeaderLine], Named UTF8 "Key"))
-> [HeaderLine] -> ([HeaderLine], Named UTF8 "Key")
forall a b. (a -> b) -> a -> b
$ RenderConfig -> KVITable v -> (TblHdrs, TblHdrs) -> [HeaderLine]
forall v.
Sayable "normal" v =>
RenderConfig -> KVITable v -> (TblHdrs, TblHdrs) -> [HeaderLine]
hdrstep RenderConfig
cfg KVITable v
t (TblHdrs
keys, TblHdrs
colKeyMap)
  -- first line shows hdrval for non-colstack'd columns, others are blank

hdrvalstep :: Sayable "normal" v
           => RenderConfig -> KVITable v -> TblHdrs -> KeySpec
           -> [HeaderLine]
hdrvalstep :: forall v.
Sayable "normal" v =>
RenderConfig -> KVITable v -> TblHdrs -> KeySpec -> [HeaderLine]
hdrvalstep RenderConfig
cfg KVITable v
t ((Named UTF8 "Key"
key,[TblHdr]
titles) : []) KeySpec
steppath =
  let cvalWidths :: TblHdr -> [Natural]
cvalWidths = \case
        V KeyVal
kv -> ((KeySpec, v) -> Natural) -> [(KeySpec, v)] -> [Natural]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Char] -> Natural
forall (t :: * -> *) a. Foldable t => t a -> Natural
nLength ([Char] -> Natural)
-> ((KeySpec, v) -> [Char]) -> (KeySpec, v) -> Natural
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (saytag :: Symbol) a. Sayable saytag a => a -> [Char]
sez @"normal" (v -> [Char]) -> ((KeySpec, v) -> v) -> (KeySpec, v) -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (KeySpec, v) -> v
forall a b. (a, b) -> b
snd)
                ([(KeySpec, v)] -> [Natural]) -> [(KeySpec, v)] -> [Natural]
forall a b. (a -> b) -> a -> b
$ ((KeySpec, v) -> Bool) -> [(KeySpec, v)] -> [(KeySpec, v)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((KeySpec -> KeySpec -> Bool
forall a. Eq a => [a] -> [a] -> Bool
L.isSuffixOf (KeySpec -> (Named UTF8 "Key", KeyVal) -> KeySpec
forall a. [a] -> a -> [a]
snoc KeySpec
steppath (Named UTF8 "Key"
key, KeyVal
kv))) (KeySpec -> Bool)
-> ((KeySpec, v) -> KeySpec) -> (KeySpec, v) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (KeySpec, v) -> KeySpec
forall a b. (a, b) -> a
fst)
                ([(KeySpec, v)] -> [(KeySpec, v)])
-> [(KeySpec, v)] -> [(KeySpec, v)]
forall a b. (a -> b) -> a -> b
$ KVITable v -> [Item (KVITable v)]
forall v. KVITable v -> [Item (KVITable v)]
KVIT.toList KVITable v
t
        AndMore Natural
_ -> [Natural
1] -- always show this column, although it has no contents
      colWidth :: TblHdr -> Natural
colWidth TblHdr
kv = let cvw :: [Natural]
cvw = TblHdr -> [Natural]
cvalWidths TblHdr
kv
                    in if RenderConfig -> Bool
hideBlankCols RenderConfig
cfg Bool -> Bool -> Bool
&& [Natural] -> Natural
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Natural]
cvw Natural -> Natural -> Bool
forall a. Eq a => a -> a -> Bool
== Natural
0
                       then Natural
0
                       else Natural -> [Natural] -> Natural
forall (t :: * -> *) e. (Foldable t, Ord e) => e -> t e -> e
maxOf (Name "column header" -> Natural
forall (style :: Symbol) (nm :: Symbol). Named style nm -> Natural
nameLength (Name "column header" -> Natural)
-> Name "column header" -> Natural
forall a b. (a -> b) -> a -> b
$ TblHdr -> Name "column header"
toHdrText TblHdr
kv) [Natural]
cvw
      cwidths :: [Natural]
cwidths = (TblHdr -> Natural) -> [TblHdr] -> [Natural]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TblHdr -> Natural
colWidth [TblHdr]
titles
      fmtcols :: [Natural]
fmtcols = if RenderConfig -> Bool
equisizedCols RenderConfig
cfg
                then (Int -> Natural -> [Natural]
forall a. Int -> a -> [a]
replicate ([Natural] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Natural]
cwidths) (Natural -> [Natural] -> Natural
forall (t :: * -> *) e. (Foldable t, Ord e) => e -> t e -> e
maxOf Natural
0 [Natural]
cwidths))
                else [Natural]
cwidths
      tr :: Name "column header"
tr = Named UTF8 "Key" -> Name "column header"
forall (style :: Symbol) (origTy :: Symbol) (newTy :: Symbol).
ConvertName style origTy newTy =>
Named style origTy -> Named style newTy
convertName Named UTF8 "Key"
key
      hdrTxt :: TblHdr -> Text
hdrTxt = Name "column header" -> Text
forall (nm :: Symbol). Named UTF8 nm -> Text
forall (style :: Symbol) (nm :: Symbol).
NameText style =>
Named style nm -> Text
nameText (Name "column header" -> Text)
-> (TblHdr -> Name "column header") -> TblHdr -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TblHdr -> Name "column header"
toHdrText
  in HeaderLine -> [HeaderLine]
forall e. e -> [e]
single (HeaderLine -> [HeaderLine]) -> HeaderLine -> [HeaderLine]
forall a b. (a -> b) -> a -> b
$ FmtLine -> [FmtVal] -> Name "column header" -> HeaderLine
HdrLine ([Natural] -> FmtLine
fmtLine ([Natural] -> FmtLine) -> [Natural] -> FmtLine
forall a b. (a -> b) -> a -> b
$ [Natural]
fmtcols) (Text -> FmtVal
TxtVal (Text -> FmtVal) -> (TblHdr -> Text) -> TblHdr -> FmtVal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TblHdr -> Text
hdrTxt (TblHdr -> FmtVal) -> [TblHdr] -> [FmtVal]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TblHdr]
titles) Name "column header"
tr
hdrvalstep RenderConfig
cfg KVITable v
t ((Named UTF8 "Key"
key,[TblHdr]
vals) : TblHdrs
keys) KeySpec
steppath =
  let subhdrsV :: TblHdr -> [HeaderLine]
subhdrsV = \case
        V KeyVal
v -> RenderConfig -> KVITable v -> TblHdrs -> KeySpec -> [HeaderLine]
forall v.
Sayable "normal" v =>
RenderConfig -> KVITable v -> TblHdrs -> KeySpec -> [HeaderLine]
hdrvalstep RenderConfig
cfg KVITable v
t TblHdrs
keys (KeySpec -> (Named UTF8 "Key", KeyVal) -> KeySpec
forall a. [a] -> a -> [a]
snoc KeySpec
steppath (Named UTF8 "Key"
key,KeyVal
v))
        TblHdr
_ -> [HeaderLine]
forall a. Monoid a => a
mempty
      subTtlHdrs :: [(Natural, [HeaderLine])]
subTtlHdrs = let subAtVal :: TblHdr -> (Natural, [HeaderLine])
subAtVal TblHdr
v = (Name "column header" -> Natural
forall (style :: Symbol) (nm :: Symbol). Named style nm -> Natural
nameLength (Name "column header" -> Natural)
-> Name "column header" -> Natural
forall a b. (a -> b) -> a -> b
$ TblHdr -> Name "column header"
toHdrText TblHdr
v, TblHdr -> [HeaderLine]
subhdrsV TblHdr
v)
                   in (TblHdr -> (Natural, [HeaderLine]))
-> [TblHdr] -> [(Natural, [HeaderLine])]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TblHdr -> (Natural, [HeaderLine])
subAtVal [TblHdr]
vals
      szexts :: [Natural]
szexts = let subW :: (a, [HeaderLine]) -> (a, Natural)
subW (a
hl,[HeaderLine]
sh) =
                     case [HeaderLine]
sh of
                       [] -> (a
0, Natural
0)  -- should never be the case
                       (HeaderLine
sh0:[HeaderLine]
_) ->
                         let sv :: Natural
sv = FmtLine -> Natural
fmtWidth (FmtLine -> Natural) -> FmtLine -> Natural
forall a b. (a -> b) -> a -> b
$ HeaderLine -> FmtLine
hdrFmt HeaderLine
sh0
                         in if RenderConfig -> Bool
hideBlankCols RenderConfig
cfg Bool -> Bool -> Bool
&& (FmtLine -> Bool
fmtEmptyCols (FmtLine -> Bool) -> FmtLine -> Bool
forall a b. (a -> b) -> a -> b
$ HeaderLine -> FmtLine
hdrFmt HeaderLine
sh0)
                            then (a
0, Natural
0)
                            else (a
hl, Natural
sv)
               in ((Natural, [HeaderLine]) -> Natural)
-> [(Natural, [HeaderLine])] -> [Natural]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Natural -> Natural -> Natural) -> (Natural, Natural) -> Natural
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Natural -> Natural -> Natural
forall a. Ord a => a -> a -> a
max ((Natural, Natural) -> Natural)
-> ((Natural, [HeaderLine]) -> (Natural, Natural))
-> (Natural, [HeaderLine])
-> Natural
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Natural, [HeaderLine]) -> (Natural, Natural)
forall {a}. Num a => (a, [HeaderLine]) -> (a, Natural)
subW) [(Natural, [HeaderLine])]
subTtlHdrs
      rsz_extsubhdrs :: [HeaderLine]
rsz_extsubhdrs = ([HeaderLine] -> HeaderLine) -> [[HeaderLine]] -> [HeaderLine]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [HeaderLine] -> HeaderLine
forall {t :: * -> *}. Foldable t => t HeaderLine -> HeaderLine
hdrJoin ([[HeaderLine]] -> [HeaderLine]) -> [[HeaderLine]] -> [HeaderLine]
forall a b. (a -> b) -> a -> b
$
                       [[HeaderLine]] -> [[HeaderLine]]
forall a. [[a]] -> [[a]]
L.transpose ([[HeaderLine]] -> [[HeaderLine]])
-> [[HeaderLine]] -> [[HeaderLine]]
forall a b. (a -> b) -> a -> b
$
                       ((Natural, [HeaderLine]) -> [HeaderLine])
-> [(Natural, [HeaderLine])] -> [[HeaderLine]]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Natural -> [HeaderLine] -> [HeaderLine])
-> (Natural, [HeaderLine]) -> [HeaderLine]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Natural -> [HeaderLine] -> [HeaderLine]
forall {f :: * -> *}.
Functor f =>
Natural -> f HeaderLine -> f HeaderLine
rsz_hdrstack) ([(Natural, [HeaderLine])] -> [[HeaderLine]])
-> [(Natural, [HeaderLine])] -> [[HeaderLine]]
forall a b. (a -> b) -> a -> b
$
                       [Natural] -> [[HeaderLine]] -> [(Natural, [HeaderLine])]
forall a b. [a] -> [b] -> [(a, b)]
zip [Natural]
szhdrs ([[HeaderLine]] -> [(Natural, [HeaderLine])])
-> [[HeaderLine]] -> [(Natural, [HeaderLine])]
forall a b. (a -> b) -> a -> b
$ ((Natural, [HeaderLine]) -> [HeaderLine])
-> [(Natural, [HeaderLine])] -> [[HeaderLine]]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Natural, [HeaderLine]) -> [HeaderLine]
forall a b. (a, b) -> b
snd [(Natural, [HeaderLine])]
subTtlHdrs
      largest :: Natural
largest = Natural -> [Natural] -> Natural
forall (t :: * -> *) e. (Foldable t, Ord e) => e -> t e -> e
maxOf Natural
0 [Natural]
szexts
      szhdrs :: [Natural]
szhdrs = if RenderConfig -> Bool
equisizedCols RenderConfig
cfg Bool -> Bool -> Bool
&& Bool -> Bool
not (RenderConfig -> Bool
hideBlankCols RenderConfig
cfg)
               then Int -> Natural -> [Natural]
forall a. Int -> a -> [a]
replicate ([TblHdr] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [TblHdr]
vals) Natural
largest
               else [Natural]
szexts
      rsz_hdrstack :: Natural -> f HeaderLine -> f HeaderLine
rsz_hdrstack Natural
s f HeaderLine
vhs = (HeaderLine -> HeaderLine) -> f HeaderLine -> f HeaderLine
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Natural -> HeaderLine -> HeaderLine
rsz_hdrs Natural
s) f HeaderLine
vhs
      rsz_hdrs :: Natural -> HeaderLine -> HeaderLine
rsz_hdrs Natural
hw (HdrLine (FmtLine [Natural]
c Sigils
s Sigils
j) [FmtVal]
v Name "column header"
r) =
        let nzCols :: [Natural]
nzCols = (Natural -> Bool) -> [Natural] -> [Natural]
forall a. (a -> Bool) -> [a] -> [a]
L.filter (Natural -> Natural -> Bool
forall a. Eq a => a -> a -> Bool
/= Natural
0) [Natural]
c
            numNZCols :: Natural
numNZCols = [Natural] -> Natural
forall (t :: * -> *) a. Foldable t => t a -> Natural
nLength [Natural]
nzCols
            pcw :: Natural
pcw = [Natural] -> Natural
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Natural]
nzCols Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
+ ((Natural
perColOvhd Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
+ Natural
1) Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
* (Natural
numNZCols Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
- Natural
1))
            (Natural
ew,Natural
w0) = let l :: Int
l = [Natural] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Natural]
nzCols
                      in if Int
l Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then (Natural
0,Natural
0)
                         else Natural -> Natural -> Natural
forall a. Ord a => a -> a -> a
max Natural
0 (Natural
hw Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
- Natural
pcw) Natural -> Natural -> (Natural, Natural)
forall a. Integral a => a -> a -> (a, a)
`divMod` Natural
numNZCols
            c' :: [Natural]
c' = ([Natural], Natural) -> [Natural]
forall a b. (a, b) -> a
fst (([Natural], Natural) -> [Natural])
-> ([Natural], Natural) -> [Natural]
forall a b. (a -> b) -> a -> b
$ (([Natural], Natural) -> Natural -> ([Natural], Natural))
-> ([Natural], Natural) -> [Natural] -> ([Natural], Natural)
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\([Natural]
c'',Natural
n) Natural
w -> ([Natural] -> Natural -> [Natural]
forall a. [a] -> a -> [a]
snoc [Natural]
c'' (Natural -> [Natural]) -> Natural -> [Natural]
forall a b. (a -> b) -> a -> b
$ Natural
nNatural -> Natural -> Natural
forall a. Num a => a -> a -> a
+Natural
w, Natural
ew)) ([Natural]
forall a. Monoid a => a
mempty,Natural
ewNatural -> Natural -> Natural
forall a. Num a => a -> a -> a
+Natural
w0) [Natural]
c
        in FmtLine -> [FmtVal] -> Name "column header" -> HeaderLine
HdrLine ([Natural] -> Sigils -> Sigils -> FmtLine
FmtLine [Natural]
c' Sigils
s Sigils
j) [FmtVal]
v Name "column header"
r
      hdrJoin :: t HeaderLine -> HeaderLine
hdrJoin t HeaderLine
hl = (HeaderLine -> HeaderLine -> HeaderLine)
-> HeaderLine -> t HeaderLine -> HeaderLine
forall b a. (b -> a -> b) -> b -> t a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl HeaderLine -> HeaderLine -> HeaderLine
hlJoin (FmtLine -> [FmtVal] -> Name "column header" -> HeaderLine
HdrLine ([Natural] -> FmtLine
fmtLine [Natural]
forall a. Monoid a => a
mempty) [FmtVal]
forall a. Monoid a => a
mempty Name "column header"
"") t HeaderLine
hl
      hlJoin :: HeaderLine -> HeaderLine -> HeaderLine
hlJoin (HdrLine (FmtLine [Natural]
c Sigils
s Sigils
j) [FmtVal]
v Name "column header"
_) (HdrLine (FmtLine [Natural]
c' Sigils
_ Sigils
_) [FmtVal]
v' Name "column header"
r) =
        FmtLine -> [FmtVal] -> Name "column header" -> HeaderLine
HdrLine ([Natural] -> Sigils -> Sigils -> FmtLine
FmtLine ([Natural]
c[Natural] -> [Natural] -> [Natural]
forall a. Semigroup a => a -> a -> a
<>[Natural]
c') Sigils
s Sigils
j) ([FmtVal]
v[FmtVal] -> [FmtVal] -> [FmtVal]
forall a. Semigroup a => a -> a -> a
<>[FmtVal]
v') Name "column header"
r
      tvals :: [FmtVal]
tvals = Text -> FmtVal
CenterVal (Text -> FmtVal) -> (TblHdr -> Text) -> TblHdr -> FmtVal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name "column header" -> Text
forall (nm :: Symbol). Named UTF8 nm -> Text
forall (style :: Symbol) (nm :: Symbol).
NameText style =>
Named style nm -> Text
nameText (Name "column header" -> Text)
-> (TblHdr -> Name "column header") -> TblHdr -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TblHdr -> Name "column header"
toHdrText (TblHdr -> FmtVal) -> [TblHdr] -> [FmtVal]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TblHdr]
vals
  in FmtLine -> [FmtVal] -> Name "column header" -> HeaderLine
HdrLine ([Natural] -> FmtLine
fmtLine [Natural]
szhdrs) [FmtVal]
tvals (Named UTF8 "Key" -> Name "column header"
forall (style :: Symbol) (origTy :: Symbol) (newTy :: Symbol).
ConvertName style origTy newTy =>
Named style origTy -> Named style newTy
convertName Named UTF8 "Key"
key) HeaderLine -> [HeaderLine] -> [HeaderLine]
forall a. a -> [a] -> [a]
: [HeaderLine]
rsz_extsubhdrs
hdrvalstep RenderConfig
_ KVITable v
_ [] KeySpec
_ = [Char] -> [HeaderLine]
forall a. HasCallStack => [Char] -> a
error [Char]
"ASCII hdrvalstep with empty keys after matching colStackAt -- impossible"

toHdrText :: TblHdr -> Name "column header"
toHdrText :: TblHdr -> Name "column header"
toHdrText = \case
  V KeyVal
kv -> KeyVal -> Name "column header"
forall (style :: Symbol) (origTy :: Symbol) (newTy :: Symbol).
ConvertName style origTy newTy =>
Named style origTy -> Named style newTy
convertName KeyVal
kv
  AndMore Natural
n -> [Char] -> Name "column header"
forall a. IsString a => [Char] -> a
fromString ([Char] -> Name "column header") -> [Char] -> Name "column header"
forall a b. (a -> b) -> a -> b
$ forall (saytag :: Symbol) a. Sayable saytag a => a -> [Char]
sez @"normal" (Saying "normal" -> [Char]) -> Saying "normal" -> [Char]
forall a b. (a -> b) -> a -> b
$ Text -> Text
t'Text
"{+" Text -> Natural -> Saying "normal"
forall (saytag :: Symbol) m n.
(Sayable saytag m, Sayable saytag n) =>
m -> n -> Saying saytag
&+ Natural
n Saying "normal" -> Char -> Saying "normal"
forall (saytag :: Symbol) m n.
(Sayable saytag m, Sayable saytag n) =>
m -> n -> Saying saytag
&+ Char
'}'

----------------------------------------------------------------------

renderSeq :: Sayable "normal" v
          => RenderConfig
          -> FmtLine
          -> (TblHdrs, TblHdrs)
          -> KVITable v
          -> [Text]
renderSeq :: forall v.
Sayable "normal" v =>
RenderConfig
-> FmtLine -> (TblHdrs, TblHdrs) -> KVITable v -> [Text]
renderSeq RenderConfig
cfg FmtLine
fmt (TblHdrs, TblHdrs)
kmap KVITable v
kvitbl = FmtLine -> [FmtVal] -> Text
fmtRender FmtLine
fmt ([FmtVal] -> Text)
-> ((Bool, [FmtVal]) -> [FmtVal]) -> (Bool, [FmtVal]) -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool, [FmtVal]) -> [FmtVal]
forall a b. (a, b) -> b
snd ((Bool, [FmtVal]) -> Text) -> [(Bool, [FmtVal])] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (TblHdrs, TblHdrs) -> KeySpec -> [(Bool, [FmtVal])]
asciiRows (TblHdrs, TblHdrs)
kmap KeySpec
forall a. Monoid a => a
mempty
  where
    filterBlank :: [(a, [Maybe a])] -> [(a, [Maybe a])]
filterBlank = if RenderConfig -> Bool
hideBlankRows RenderConfig
cfg
                  then ((a, [Maybe a]) -> Bool) -> [(a, [Maybe a])] -> [(a, [Maybe a])]
forall a. (a -> Bool) -> [a] -> [a]
L.filter (Bool -> Bool
not (Bool -> Bool)
-> ((a, [Maybe a]) -> Bool) -> (a, [Maybe a]) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe a -> Bool) -> [Maybe a] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Maybe a -> Bool
forall a. Maybe a -> Bool
isNothing ([Maybe a] -> Bool)
-> ((a, [Maybe a]) -> [Maybe a]) -> (a, [Maybe a]) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, [Maybe a]) -> [Maybe a]
forall a b. (a, b) -> b
snd)
                  else [(a, [Maybe a])] -> [(a, [Maybe a])]
forall a. a -> a
id
    asciiRows :: (TblHdrs, TblHdrs)
              -> KeySpec
              -> [ (Bool, [FmtVal]) ]
    asciiRows :: (TblHdrs, TblHdrs) -> KeySpec -> [(Bool, [FmtVal])]
asciiRows ([], []) KeySpec
path =
      let v :: Maybe v
v = KeySpec -> KVITable v -> Maybe v
forall v. KeySpec -> KVITable v -> Maybe v
KVIT.lookup' KeySpec
path KVITable v
kvitbl
          skip :: Bool
skip = case Maybe v
v of
                   Maybe v
Nothing -> RenderConfig -> Bool
hideBlankRows RenderConfig
cfg
                   Just v
_  -> Bool
False
      in if Bool
skip then [(Bool, [FmtVal])]
forall a. Monoid a => a
mempty
         else (Bool, [FmtVal]) -> [(Bool, [FmtVal])]
forall e. e -> [e]
single ((Bool, [FmtVal]) -> [(Bool, [FmtVal])])
-> (Bool, [FmtVal]) -> [(Bool, [FmtVal])]
forall a b. (a -> b) -> a -> b
$ (Bool
False, FmtVal -> [FmtVal]
forall e. e -> [e]
single (FmtVal -> [FmtVal]) -> FmtVal -> [FmtVal]
forall a b. (a -> b) -> a -> b
$ FmtVal -> (Text -> FmtVal) -> Maybe Text -> FmtVal
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Text -> FmtVal
TxtVal Text
"") Text -> FmtVal
TxtVal ([Char] -> Text
T.pack ([Char] -> Text) -> (v -> [Char]) -> v -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (saytag :: Symbol) a. Sayable saytag a => a -> [Char]
sez @"normal" (v -> Text) -> Maybe v -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe v
v) )
    asciiRows ([], TblHdrs
colKeyMap) KeySpec
path =
      let filterOrDefaultBlankRows :: [(a, [Maybe Text])] -> [(a, [FmtVal])]
filterOrDefaultBlankRows = ((a, [Maybe Text]) -> (a, [FmtVal]))
-> [(a, [Maybe Text])] -> [(a, [FmtVal])]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([Maybe Text] -> [FmtVal]) -> (a, [Maybe Text]) -> (a, [FmtVal])
forall a b. (a -> b) -> (a, a) -> (a, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Maybe Text] -> [FmtVal]
defaultBlanks) ([(a, [Maybe Text])] -> [(a, [FmtVal])])
-> ([(a, [Maybe Text])] -> [(a, [Maybe Text])])
-> [(a, [Maybe Text])]
-> [(a, [FmtVal])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(a, [Maybe Text])] -> [(a, [Maybe Text])]
forall {a} {a}. [(a, [Maybe a])] -> [(a, [Maybe a])]
filterBlank
          defaultBlanks :: [Maybe Text] -> [FmtVal]
defaultBlanks = (Maybe Text -> FmtVal) -> [Maybe Text] -> [FmtVal]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Maybe Text
v -> FmtVal -> (Text -> FmtVal) -> Maybe Text -> FmtVal
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Text -> FmtVal
TxtVal Text
"") Text -> FmtVal
TxtVal Maybe Text
v)
      in [(Bool, [Maybe Text])] -> [(Bool, [FmtVal])]
forall {a}. [(a, [Maybe Text])] -> [(a, [FmtVal])]
filterOrDefaultBlankRows ([(Bool, [Maybe Text])] -> [(Bool, [FmtVal])])
-> [(Bool, [Maybe Text])] -> [(Bool, [FmtVal])]
forall a b. (a -> b) -> a -> b
$ (Bool, [Maybe Text]) -> [(Bool, [Maybe Text])]
forall e. e -> [e]
single ((Bool, [Maybe Text]) -> [(Bool, [Maybe Text])])
-> (Bool, [Maybe Text]) -> [(Bool, [Maybe Text])]
forall a b. (a -> b) -> a -> b
$ (Bool
False, TblHdrs -> KeySpec -> [Maybe Text]
multivalRows TblHdrs
colKeyMap KeySpec
path)
    asciiRows ((Named UTF8 "Key"
key, [TblHdr]
keyvals) : TblHdrs
kseq, TblHdrs
colKeyMap) KeySpec
path =
      let subrows :: TblHdr -> [(Bool, [FmtVal])]
subrows = \case
            V KeyVal
keyval -> (TblHdrs, TblHdrs) -> KeySpec -> [(Bool, [FmtVal])]
asciiRows (TblHdrs
kseq, TblHdrs
colKeyMap) (KeySpec -> [(Bool, [FmtVal])]) -> KeySpec -> [(Bool, [FmtVal])]
forall a b. (a -> b) -> a -> b
$ KeySpec -> (Named UTF8 "Key", KeyVal) -> KeySpec
forall a. [a] -> a -> [a]
snoc KeySpec
path (Named UTF8 "Key"
key, KeyVal
keyval)
            TblHdr
_ ->
              let ttlcols :: Int
ttlcols = [Int] -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
product ( [TblHdr] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([TblHdr] -> Int)
-> ((Named UTF8 "Key", [TblHdr]) -> [TblHdr])
-> (Named UTF8 "Key", [TblHdr])
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Named UTF8 "Key", [TblHdr]) -> [TblHdr]
forall a b. (a, b) -> b
snd ((Named UTF8 "Key", [TblHdr]) -> Int) -> TblHdrs -> [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TblHdrs
colKeyMap)
              in [ (Bool
False , Int -> FmtVal -> [FmtVal]
forall a. Int -> a -> [a]
replicate (Int
ttlcols Int -> Int -> Int
forall a. Num a => a -> a -> a
+ TblHdrs -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length TblHdrs
kseq) (FmtVal -> [FmtVal]) -> FmtVal -> [FmtVal]
forall a b. (a -> b) -> a -> b
$ FmtVal
Overage) ]
          grprow :: [(Bool, [FmtVal])] -> [(Bool, [FmtVal])]
grprow = \case
            subs :: [(Bool, [FmtVal])]
subs@((Bool, [FmtVal])
sub0:[(Bool, [FmtVal])]
_) | Named UTF8 "Key"
key Named UTF8 "Key" -> [Named UTF8 "Key"] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` RenderConfig -> [Named UTF8 "Key"]
rowGroup RenderConfig
cfg ->
              let subl :: [(Bool, [FmtVal])]
subl = (Bool, [FmtVal]) -> [(Bool, [FmtVal])]
forall e. e -> [e]
single (Bool
True, Int -> FmtVal -> [FmtVal]
forall a. Int -> a -> [a]
replicate ([FmtVal] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([FmtVal] -> Int) -> [FmtVal] -> Int
forall a b. (a -> b) -> a -> b
$ (Bool, [FmtVal]) -> [FmtVal]
forall a b. (a, b) -> b
snd (Bool, [FmtVal])
sub0) FmtVal
Separator)
              in if (Bool, [FmtVal]) -> Bool
forall a b. (a, b) -> a
fst ([(Bool, [FmtVal])] -> (Bool, [FmtVal])
forall a. HasCallStack => [a] -> a
last [(Bool, [FmtVal])]
subs) then [(Bool, [FmtVal])] -> [(Bool, [FmtVal])]
forall a. HasCallStack => [a] -> [a]
init [(Bool, [FmtVal])]
subs [(Bool, [FmtVal])] -> [(Bool, [FmtVal])] -> [(Bool, [FmtVal])]
forall a. Semigroup a => a -> a -> a
<> [(Bool, [FmtVal])]
subl else [(Bool, [FmtVal])]
subs [(Bool, [FmtVal])] -> [(Bool, [FmtVal])] -> [(Bool, [FmtVal])]
forall a. Semigroup a => a -> a -> a
<> [(Bool, [FmtVal])]
subl
            [(Bool, [FmtVal])]
subs -> [(Bool, [FmtVal])]
subs
          genSubRow :: TblHdr -> [(Bool, [FmtVal])]
genSubRow TblHdr
keyval = [(Bool, [FmtVal])] -> [(Bool, [FmtVal])]
grprow ([(Bool, [FmtVal])] -> [(Bool, [FmtVal])])
-> [(Bool, [FmtVal])] -> [(Bool, [FmtVal])]
forall a b. (a -> b) -> a -> b
$ ([(Bool, [FmtVal])], Name "column header") -> [(Bool, [FmtVal])]
forall a b. (a, b) -> a
fst
                             (([(Bool, [FmtVal])], Name "column header") -> [(Bool, [FmtVal])])
-> ([(Bool, [FmtVal])], Name "column header") -> [(Bool, [FmtVal])]
forall a b. (a -> b) -> a -> b
$ (([(Bool, [FmtVal])], Name "column header")
 -> (Bool, [FmtVal]) -> ([(Bool, [FmtVal])], Name "column header"))
-> ([(Bool, [FmtVal])], Name "column header")
-> [(Bool, [FmtVal])]
-> ([(Bool, [FmtVal])], Name "column header")
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl ([(Bool, [FmtVal])], Name "column header")
-> (Bool, [FmtVal]) -> ([(Bool, [FmtVal])], Name "column header")
forall {style :: Symbol} {nm :: Symbol} {a}.
(NameText style, IsString (Named style nm)) =>
([(a, [FmtVal])], Named style nm)
-> (a, [FmtVal]) -> ([(a, [FmtVal])], Named style nm)
leftAdd ([(Bool, [FmtVal])]
forall a. Monoid a => a
mempty, TblHdr -> Name "column header"
toHdrText TblHdr
keyval) ([(Bool, [FmtVal])] -> ([(Bool, [FmtVal])], Name "column header"))
-> [(Bool, [FmtVal])] -> ([(Bool, [FmtVal])], Name "column header")
forall a b. (a -> b) -> a -> b
$ TblHdr -> [(Bool, [FmtVal])]
subrows TblHdr
keyval
          leftAdd :: ([(a, [FmtVal])], Named style nm)
-> (a, [FmtVal]) -> ([(a, [FmtVal])], Named style nm)
leftAdd ([(a, [FmtVal])]
acc,Named style nm
kv) (a
b,[FmtVal]
subrow) =
            ([(a, [FmtVal])] -> (a, [FmtVal]) -> [(a, [FmtVal])]
forall a. [a] -> a -> [a]
snoc [(a, [FmtVal])]
acc (a
b, Text -> FmtVal
TxtVal (Named style nm -> Text
forall (nm :: Symbol). Named style nm -> Text
forall (style :: Symbol) (nm :: Symbol).
NameText style =>
Named style nm -> Text
nameText Named style nm
kv) FmtVal -> [FmtVal] -> [FmtVal]
forall a. a -> [a] -> [a]
: [FmtVal]
subrow)
            , if RenderConfig -> Bool
rowRepeat RenderConfig
cfg then Named style nm
kv else Named style nm
""
            )
      in [[(Bool, [FmtVal])]] -> [(Bool, [FmtVal])]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (TblHdr -> [(Bool, [FmtVal])]
genSubRow (TblHdr -> [(Bool, [FmtVal])]) -> [TblHdr] -> [[(Bool, [FmtVal])]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TblHdr]
keyvals)

    multivalRows :: TblHdrs -> KeySpec -> [ Maybe Text ]
    multivalRows :: TblHdrs -> KeySpec -> [Maybe Text]
multivalRows ((Named UTF8 "Key"
key, [TblHdr]
keyvals) : []) KeySpec
path =
      let showEnt :: v -> Text
showEnt = [Char] -> Text
T.pack ([Char] -> Text) -> (v -> [Char]) -> v -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (saytag :: Symbol) a. Sayable saytag a => a -> [Char]
sez @"normal"
      in (\case
             V KeyVal
v -> (v -> Text
showEnt (v -> Text) -> Maybe v -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (KeySpec -> KVITable v -> Maybe v
forall v. KeySpec -> KVITable v -> Maybe v
KVIT.lookup' (KeySpec -> (Named UTF8 "Key", KeyVal) -> KeySpec
forall a. [a] -> a -> [a]
snoc KeySpec
path (Named UTF8 "Key"
key,KeyVal
v)) KVITable v
kvitbl))
             TblHdr
_ -> Maybe Text
forall a. Maybe a
Nothing
         ) (TblHdr -> Maybe Text) -> [TblHdr] -> [Maybe Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TblHdr]
keyvals
    multivalRows ((Named UTF8 "Key"
key, [TblHdr]
keyvals) : TblHdrs
kseq) KeySpec
path =
      (TblHdr -> [Maybe Text]) -> [TblHdr] -> [Maybe Text]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\case
                    V KeyVal
v -> TblHdrs -> KeySpec -> [Maybe Text]
multivalRows TblHdrs
kseq (KeySpec -> (Named UTF8 "Key", KeyVal) -> KeySpec
forall a. [a] -> a -> [a]
snoc KeySpec
path (Named UTF8 "Key"
key,KeyVal
v))
                    TblHdr
_ -> [Maybe Text]
forall a. Monoid a => a
mempty
                ) [TblHdr]
keyvals
    multivalRows [] KeySpec
_ = [Char] -> [Maybe Text]
forall a. HasCallStack => [Char] -> a
error [Char]
"multivalRows cannot be called with no keys!"