{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}

-- | This module provides the 'KVITable' 'render' function for
-- rendering the table in a HTML table format.  The various HTML table
-- entries have class designators that allow the user to provide CSS
-- to adjust the appearance of the table.

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

import qualified Data.Foldable as F
import qualified Data.List as L
import           Data.List.NonEmpty ( NonEmpty( (:|) ) )
import qualified Data.List.NonEmpty as NEL
import           Data.Maybe ( fromMaybe, isNothing )
import           Data.Text ( Text )
import qualified Data.Text as T
import qualified Data.Text.Lazy as TL
import           Lens.Micro ( (^.) )
import           Lucid
import qualified Prettyprinter as PP

import           Data.KVITable
import           Data.KVITable.Render

import           Prelude hiding ( lookup )


-- | Renders the specified table in HTML format, using the specified
-- 'RenderConfig' controls.  The output is only the @<table>@
-- definition; it is intended to be embedded in a larger HTML
-- document.

render :: PP.Pretty v => RenderConfig -> KVITable v -> Text
render :: forall v. Pretty v => RenderConfig -> KVITable v -> Text
render RenderConfig
cfg KVITable v
t =
  let kseq :: [Text]
kseq = (Text, [Text]) -> Text
forall a b. (a, b) -> a
fst ((Text, [Text]) -> Text) -> [(Text, [Text])] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> KVITable v
t KVITable v
-> Getting [(Text, [Text])] (KVITable v) [(Text, [Text])]
-> [(Text, [Text])]
forall s a. s -> Getting a s a -> a
^. Getting [(Text, [Text])] (KVITable v) [(Text, [Text])]
forall v (f :: * -> *).
Functor f =>
([(Text, [Text])] -> f [(Text, [Text])])
-> KVITable v -> f (KVITable v)
keyVals
      (FmtLine
fmt, HtmlT Identity ()
hdr) = RenderConfig
-> KVITable v -> [Text] -> (FmtLine, HtmlT Identity ())
forall v.
Pretty v =>
RenderConfig
-> KVITable v -> [Text] -> (FmtLine, HtmlT Identity ())
renderHdrs RenderConfig
cfg KVITable v
t [Text]
kseq
      bdy :: HtmlT Identity ()
bdy = RenderConfig
-> FmtLine -> [Text] -> KVITable v -> HtmlT Identity ()
forall v.
Pretty v =>
RenderConfig
-> FmtLine -> [Text] -> KVITable v -> HtmlT Identity ()
renderSeq RenderConfig
cfg FmtLine
fmt [Text]
kseq KVITable v
t
  in Text -> Text
TL.toStrict (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ HtmlT Identity () -> Text
forall a. Html a -> Text
renderText (HtmlT Identity () -> Text) -> HtmlT Identity () -> Text
forall a b. (a -> b) -> a -> b
$
     [Attribute] -> HtmlT Identity () -> HtmlT Identity ()
forall arg result. Term arg result => arg -> result
table_ [ Text -> Attribute
class_ Text
"kvitable" ] (HtmlT Identity () -> HtmlT Identity ())
-> HtmlT Identity () -> HtmlT Identity ()
forall a b. (a -> b) -> a -> b
$
     do HtmlT Identity ()
-> (Text -> HtmlT Identity ()) -> Maybe Text -> HtmlT Identity ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe HtmlT Identity ()
forall a. Monoid a => a
mempty (HtmlT Identity () -> HtmlT Identity ()
forall arg result. Term arg result => arg -> result
caption_ (HtmlT Identity () -> HtmlT Identity ())
-> (Text -> HtmlT Identity ()) -> Text -> HtmlT Identity ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> HtmlT Identity ()
forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
forall (m :: * -> *). Monad m => Text -> HtmlT m ()
toHtml) (Maybe Text -> HtmlT Identity ())
-> Maybe Text -> HtmlT Identity ()
forall a b. (a -> b) -> a -> b
$ RenderConfig -> Maybe Text
Data.KVITable.Render.caption RenderConfig
cfg
        [Attribute] -> HtmlT Identity () -> HtmlT Identity ()
forall arg result. Term arg result => arg -> result
thead_ [ Text -> Attribute
class_ Text
"kvitable_head" ] HtmlT Identity ()
hdr
        [Attribute] -> HtmlT Identity () -> HtmlT Identity ()
forall arg result. Term arg result => arg -> result
tbody_ [ Text -> Attribute
class_ Text
"kvitable_body" ] HtmlT Identity ()
bdy

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

data FmtLine = FmtLine [Int]  -- colspans, length is # columns

instance Semigroup FmtLine where
  (FmtLine [Int]
c1) <> :: FmtLine -> FmtLine -> FmtLine
<> (FmtLine [Int]
c2) = [Int] -> FmtLine
FmtLine ([Int] -> FmtLine) -> [Int] -> FmtLine
forall a b. (a -> b) -> a -> b
$ [Int]
c1 [Int] -> [Int] -> [Int]
forall a. Semigroup a => a -> a -> a
<> [Int]
c2

instance Monoid FmtLine where
  mempty :: FmtLine
mempty = [Int] -> FmtLine
FmtLine [Int]
forall a. Monoid a => a
mempty

fmtAddColLeft :: Int -> FmtLine -> FmtLine
fmtAddColLeft :: Int -> FmtLine -> FmtLine
fmtAddColLeft Int
lspan (FmtLine [Int]
col) = [Int] -> FmtLine
FmtLine ([Int] -> FmtLine) -> [Int] -> FmtLine
forall a b. (a -> b) -> a -> b
$ Int
lspan Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: [Int]
col

data FmtVal = Val Height LastInGroup Text
            | Hdr Height LastInGroup Text
            deriving Int -> FmtVal -> ShowS
[FmtVal] -> ShowS
FmtVal -> String
(Int -> FmtVal -> ShowS)
-> (FmtVal -> String) -> ([FmtVal] -> ShowS) -> Show FmtVal
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FmtVal -> ShowS
showsPrec :: Int -> FmtVal -> ShowS
$cshow :: FmtVal -> String
show :: FmtVal -> String
$cshowList :: [FmtVal] -> ShowS
showList :: [FmtVal] -> ShowS
Show
type Height = Int
type LastInGroup = Bool
type RightLabel = Text

fmtRender :: FmtLine -> [FmtVal] -> Maybe RightLabel -> Html ()
fmtRender :: FmtLine -> [FmtVal] -> Maybe Text -> HtmlT Identity ()
fmtRender (FmtLine [Int]
cols) [FmtVal]
vals Maybe Text
mbRLabel = do
  [Attribute] -> HtmlT Identity () -> HtmlT Identity ()
forall arg result. Term arg result => arg -> result
tr_ [ Text -> Attribute
class_ Text
"kvitable_tr" ] (HtmlT Identity () -> HtmlT Identity ())
-> HtmlT Identity () -> HtmlT Identity ()
forall a b. (a -> b) -> a -> b
$
    let excessColCnt :: Int
excessColCnt = [Int] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
cols Int -> Int -> Int
forall a. Num a => a -> a -> a
- [FmtVal] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [FmtVal]
vals
        cell :: (a, FmtVal) -> t
cell (a
w,Hdr Int
h LastInGroup
l Text
v) =
          let a :: [[Attribute]]
a = [ [ Text -> Attribute
class_ Text
"kvitable_th" ]
                  , if Int
h Int -> Int -> LastInGroup
forall a. Eq a => a -> a -> LastInGroup
== Int
1 then []
                    else [ Text -> Attribute
rowspan_ (Text -> Attribute) -> Text -> Attribute
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show Int
h ]
                  , if a
w a -> a -> LastInGroup
forall a. Eq a => a -> a -> LastInGroup
== a
1 then []
                    else [ Text -> Attribute
colspan_ (Text -> Attribute) -> Text -> Attribute
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ a -> String
forall a. Show a => a -> String
show a
w
                         , Text -> Attribute
class_ Text
" multicol" ]
                  , if LastInGroup
l then [ Text -> Attribute
class_ Text
" last_in_group" ] else []
                  ]
          in [Attribute] -> HtmlT m () -> t
forall arg result. Term arg result => arg -> result
th_ ([[Attribute]] -> [Attribute]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Attribute]] -> [Attribute]) -> [[Attribute]] -> [Attribute]
forall a b. (a -> b) -> a -> b
$ [[Attribute]] -> [[Attribute]]
forall a. [a] -> [a]
reverse [[Attribute]]
a) (Text -> HtmlT m ()
forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
forall (m :: * -> *). Monad m => Text -> HtmlT m ()
toHtml Text
v)
        cell (a
w,Val Int
h LastInGroup
l Text
v) =
          let a :: [[Attribute]]
a = [ [ Text -> Attribute
class_ Text
"kvitable_td" ]
                  , if Int
h Int -> Int -> LastInGroup
forall a. Eq a => a -> a -> LastInGroup
== Int
1 then []
                    else [ Text -> Attribute
rowspan_ (Text -> Attribute) -> Text -> Attribute
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show Int
h ]
                  , if a
w a -> a -> LastInGroup
forall a. Eq a => a -> a -> LastInGroup
== a
1 then []
                    else [ Text -> Attribute
colspan_ (Text -> Attribute) -> Text -> Attribute
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ a -> String
forall a. Show a => a -> String
show a
w
                         , Text -> Attribute
class_ Text
" multicol" ]
                  , if LastInGroup
l then [ Text -> Attribute
class_ Text
" last_in_group" ] else []
                  ]
          in [Attribute] -> HtmlT m () -> t
forall arg result. Term arg result => arg -> result
td_ ([[Attribute]] -> [Attribute]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Attribute]] -> [Attribute]) -> [[Attribute]] -> [Attribute]
forall a b. (a -> b) -> a -> b
$ [[Attribute]] -> [[Attribute]]
forall a. [a] -> [a]
reverse [[Attribute]]
a) (Text -> HtmlT m ()
forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
forall (m :: * -> *). Monad m => Text -> HtmlT m ()
toHtml Text
v)
        labelMark :: HtmlT Identity ()
labelMark = Text -> HtmlT Identity ()
forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
forall (m :: * -> *). Monad m => Text -> HtmlT m ()
toHtmlRaw (Text
"&nbsp;&larr;" :: Text)
        labelHtml :: Text -> HtmlT Identity ()
labelHtml = [Attribute] -> HtmlT Identity () -> HtmlT Identity ()
forall arg result. Term arg result => arg -> result
th_ [ Text -> Attribute
class_ Text
"rightlabel kvitable_th" ] (HtmlT Identity () -> HtmlT Identity ())
-> (Text -> HtmlT Identity ()) -> Text -> HtmlT Identity ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                    (HtmlT Identity ()
labelMark HtmlT Identity () -> HtmlT Identity () -> HtmlT Identity ()
forall a. Semigroup a => a -> a -> a
<>) (HtmlT Identity () -> HtmlT Identity ())
-> (Text -> HtmlT Identity ()) -> Text -> HtmlT Identity ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                    Text -> HtmlT Identity ()
forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
forall (m :: * -> *). Monad m => Text -> HtmlT m ()
toHtml
    in do ((Int, FmtVal) -> HtmlT Identity ())
-> [(Int, FmtVal)] -> HtmlT Identity ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Int, FmtVal) -> HtmlT Identity ()
forall {m :: * -> *} {t} {m :: * -> *} {a}.
(Term [Attribute] (HtmlT m () -> t),
 Term [Attribute] (HtmlT m () -> t), Monad m, Monad m, Eq a, Num a,
 Show a) =>
(a, FmtVal) -> t
cell ([(Int, FmtVal)] -> HtmlT Identity ())
-> [(Int, FmtVal)] -> HtmlT Identity ()
forall a b. (a -> b) -> a -> b
$ ((Int, FmtVal) -> LastInGroup)
-> [(Int, FmtVal)] -> [(Int, FmtVal)]
forall a. (a -> LastInGroup) -> [a] -> [a]
L.filter ((Int -> Int -> LastInGroup
forall a. Eq a => a -> a -> LastInGroup
/= Int
0) (Int -> LastInGroup)
-> ((Int, FmtVal) -> Int) -> (Int, FmtVal) -> LastInGroup
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, FmtVal) -> Int
forall a b. (a, b) -> a
fst) ([(Int, FmtVal)] -> [(Int, FmtVal)])
-> [(Int, FmtVal)] -> [(Int, FmtVal)]
forall a b. (a -> b) -> a -> b
$
            [Int] -> [FmtVal] -> [(Int, FmtVal)]
forall a b. [a] -> [b] -> [(a, b)]
zip (Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
drop Int
excessColCnt [Int]
cols) [FmtVal]
vals
          HtmlT Identity ()
-> (Text -> HtmlT Identity ()) -> Maybe Text -> HtmlT Identity ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe HtmlT Identity ()
forall a. Monoid a => a
mempty Text -> HtmlT Identity ()
labelHtml Maybe Text
mbRLabel


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

data HeaderLine = HdrLine FmtLine HdrVals Trailer
type HdrVals = [FmtVal]
type Trailer = Maybe Text

instance Semigroup HeaderLine where
  (HdrLine FmtLine
fmt1 [FmtVal]
hv1 Maybe Text
t1) <> :: HeaderLine -> HeaderLine -> HeaderLine
<> (HdrLine FmtLine
fmt2 [FmtVal]
hv2 Maybe Text
_) =
    FmtLine -> [FmtVal] -> Maybe Text -> HeaderLine
HdrLine (FmtLine
fmt1 FmtLine -> FmtLine -> FmtLine
forall a. Semigroup a => a -> a -> a
<> FmtLine
fmt2) ([FmtVal]
hv1 [FmtVal] -> [FmtVal] -> [FmtVal]
forall a. Semigroup a => a -> a -> a
<> [FmtVal]
hv2) Maybe Text
t1

hdrFmt :: HeaderLine -> FmtLine
hdrFmt :: HeaderLine -> FmtLine
hdrFmt (HdrLine FmtLine
fmt [FmtVal]
_ Maybe Text
_) = FmtLine
fmt

renderHdrs :: PP.Pretty v
           => RenderConfig -> KVITable v -> [Key]
           -> ( FmtLine, Html () )
renderHdrs :: forall v.
Pretty v =>
RenderConfig
-> KVITable v -> [Text] -> (FmtLine, HtmlT Identity ())
renderHdrs RenderConfig
cfg KVITable v
t [Text]
keys = ( FmtLine
rowfmt, NonEmpty (HtmlT Identity ()) -> HtmlT Identity ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ NonEmpty (HtmlT Identity ())
hdrs )
  where
    hdrs :: NonEmpty (HtmlT Identity ())
hdrs = (HeaderLine -> HtmlT Identity ())
-> NonEmpty HeaderLine -> NonEmpty (HtmlT Identity ())
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap HeaderLine -> HtmlT Identity ()
renderHdr NonEmpty HeaderLine
hrows
    (NonEmpty HeaderLine
hrows, FmtLine
rowfmt) = RenderConfig
-> KVITable v -> [Text] -> (NonEmpty HeaderLine, FmtLine)
forall v.
Pretty v =>
RenderConfig
-> KVITable v -> [Text] -> (NonEmpty HeaderLine, FmtLine)
hdrstep RenderConfig
cfg KVITable v
t [Text]
keys
    renderHdr :: HeaderLine -> HtmlT Identity ()
renderHdr (HdrLine FmtLine
fmt [FmtVal]
hdrvals Maybe Text
trailer) = FmtLine -> [FmtVal] -> Maybe Text -> HtmlT Identity ()
fmtRender FmtLine
fmt [FmtVal]
hdrvals Maybe Text
trailer

hdrstep :: PP.Pretty v
        => RenderConfig -> KVITable v -> [Key]
        -> (NEL.NonEmpty HeaderLine, FmtLine)
hdrstep :: forall v.
Pretty v =>
RenderConfig
-> KVITable v -> [Text] -> (NonEmpty HeaderLine, FmtLine)
hdrstep RenderConfig
_cfg KVITable v
t [] =
  ( FmtLine -> [FmtVal] -> Maybe Text -> HeaderLine
HdrLine ([Int] -> FmtLine
FmtLine [Int
1]) [Int -> LastInGroup -> Text -> FmtVal
Hdr Int
1 LastInGroup
False (Text -> FmtVal) -> Text -> FmtVal
forall a b. (a -> b) -> a -> b
$ KVITable v
t KVITable v -> Getting Text (KVITable v) Text -> Text
forall s a. s -> Getting a s a -> a
^. Getting Text (KVITable v) Text
forall v (f :: * -> *).
Functor f =>
(Text -> f Text) -> KVITable v -> f (KVITable v)
valueColName] Maybe Text
forall a. Maybe a
Nothing HeaderLine -> [HeaderLine] -> NonEmpty HeaderLine
forall a. a -> [a] -> NonEmpty a
:| []
  , [Int] -> FmtLine
FmtLine [Int
1]
  )
hdrstep RenderConfig
cfg KVITable v
t (Text
key:[Text]
keys) =
  if RenderConfig -> Maybe Text
colStackAt RenderConfig
cfg Maybe Text -> Maybe Text -> LastInGroup
forall a. Eq a => a -> a -> LastInGroup
== Text -> Maybe Text
forall a. a -> Maybe a
Just Text
key
  then RenderConfig
-> KVITable v
-> KeySpec
-> [Text]
-> (NonEmpty HeaderLine, FmtLine)
forall v.
Pretty v =>
RenderConfig
-> KVITable v
-> KeySpec
-> [Text]
-> (NonEmpty HeaderLine, FmtLine)
hdrvalstep RenderConfig
cfg KVITable v
t [] (Text
keyText -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:[Text]
keys) -- switch to column stacking mode
  else
    let (HeaderLine
nexthdr0 :| [HeaderLine]
nexthdrs, FmtLine
lowestfmt) = RenderConfig
-> KVITable v -> [Text] -> (NonEmpty HeaderLine, FmtLine)
forall v.
Pretty v =>
RenderConfig
-> KVITable v -> [Text] -> (NonEmpty HeaderLine, FmtLine)
hdrstep RenderConfig
cfg KVITable v
t [Text]
keys
        (HdrLine FmtLine
fmt [FmtVal]
vals Maybe Text
tr) = HeaderLine
nexthdr0
        fmt' :: FmtLine
fmt' = Int -> FmtLine -> FmtLine
fmtAddColLeft Int
1 FmtLine
fmt
        val :: FmtVal
val = Int -> LastInGroup -> Text -> FmtVal
Hdr ([HeaderLine] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [HeaderLine]
nexthdrs Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) LastInGroup
False Text
key
    in ( (FmtLine -> [FmtVal] -> Maybe Text -> HeaderLine
HdrLine FmtLine
fmt' (FmtVal
val FmtVal -> [FmtVal] -> [FmtVal]
forall a. a -> [a] -> [a]
: [FmtVal]
vals) Maybe Text
tr) HeaderLine -> [HeaderLine] -> NonEmpty HeaderLine
forall a. a -> [a] -> NonEmpty a
:| [HeaderLine]
nexthdrs
       , Int -> FmtLine -> FmtLine
fmtAddColLeft Int
1 FmtLine
lowestfmt
       )

hdrvalstep :: PP.Pretty v
           => RenderConfig -> KVITable v -> KeySpec -> [Key]
           -> (NEL.NonEmpty HeaderLine, FmtLine)
hdrvalstep :: forall v.
Pretty v =>
RenderConfig
-> KVITable v
-> KeySpec
-> [Text]
-> (NonEmpty HeaderLine, FmtLine)
hdrvalstep RenderConfig
_ KVITable v
_ KeySpec
_ [] = String -> (NonEmpty HeaderLine, FmtLine)
forall a. HasCallStack => String -> a
error String
"HTML hdrvalstep with empty keys after matching colStackAt -- impossible"
hdrvalstep RenderConfig
cfg KVITable v
t KeySpec
steppath (Text
key:[]) =
  let titles :: [Text]
titles = [Text] -> [Text]
ordering ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ [Text] -> Maybe [Text] -> [Text]
forall a. a -> Maybe a -> a
fromMaybe [] (Maybe [Text] -> [Text]) -> Maybe [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ Text -> [(Text, [Text])] -> Maybe [Text]
forall a b. Eq a => a -> [(a, b)] -> Maybe b
L.lookup Text
key ([(Text, [Text])] -> Maybe [Text])
-> [(Text, [Text])] -> Maybe [Text]
forall a b. (a -> b) -> a -> b
$ KVITable v
t KVITable v
-> Getting [(Text, [Text])] (KVITable v) [(Text, [Text])]
-> [(Text, [Text])]
forall s a. s -> Getting a s a -> a
^. Getting [(Text, [Text])] (KVITable v) [(Text, [Text])]
forall v (f :: * -> *).
Functor f =>
([(Text, [Text])] -> f [(Text, [Text])])
-> KVITable v -> f (KVITable v)
keyVals
      ordering :: [Text] -> [Text]
ordering = if RenderConfig -> LastInGroup
sortKeyVals RenderConfig
cfg then [Text] -> [Text]
sortWithNums else [Text] -> [Text]
forall a. a -> a
id
      cvalWidths :: Text -> [Int]
cvalWidths Text
kv = ((KeySpec, v) -> Int) -> [(KeySpec, v)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (String -> Int) -> ((KeySpec, v) -> String) -> (KeySpec, v) -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc Any -> String
forall a. Show a => a -> String
show (Doc Any -> String)
-> ((KeySpec, v) -> Doc Any) -> (KeySpec, v) -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> Doc Any
forall ann. v -> Doc ann
forall a ann. Pretty a => a -> Doc ann
PP.pretty (v -> Doc Any) -> ((KeySpec, v) -> v) -> (KeySpec, v) -> Doc Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (KeySpec, v) -> v
forall a b. (a, b) -> b
snd) ([(KeySpec, v)] -> [Int]) -> [(KeySpec, v)] -> [Int]
forall a b. (a -> b) -> a -> b
$
                      ((KeySpec, v) -> LastInGroup) -> [(KeySpec, v)] -> [(KeySpec, v)]
forall a. (a -> LastInGroup) -> [a] -> [a]
L.filter ((KeySpec -> KeySpec -> LastInGroup
forall a. Eq a => [a] -> [a] -> LastInGroup
L.isSuffixOf (KeySpec
steppath KeySpec -> KeySpec -> KeySpec
forall a. Semigroup a => a -> a -> a
<> [(Text
key, Text
kv)])) (KeySpec -> LastInGroup)
-> ((KeySpec, v) -> KeySpec) -> (KeySpec, v) -> LastInGroup
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)]
toList KVITable v
t
      cwidth :: Text -> a
cwidth Text
c = if [LastInGroup] -> LastInGroup
forall (t :: * -> *). Foldable t => t LastInGroup -> LastInGroup
and [ RenderConfig -> LastInGroup
hideBlankCols RenderConfig
cfg
                        , Int
0 Int -> Int -> LastInGroup
forall a. Eq a => a -> a -> LastInGroup
== ([Int] -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ Text -> [Int]
cvalWidths Text
c) ]
                 then a
0
                 else a
1
      fmt :: FmtLine
fmt = [Int] -> FmtLine
FmtLine ([Int] -> FmtLine) -> [Int] -> FmtLine
forall a b. (a -> b) -> a -> b
$ (Text -> Int) -> [Text] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Int
forall {a}. Num a => Text -> a
cwidth [Text]
titles
  in ( FmtLine -> [FmtVal] -> Maybe Text -> HeaderLine
HdrLine FmtLine
fmt (Int -> LastInGroup -> Text -> FmtVal
Hdr Int
1 LastInGroup
False (Text -> FmtVal) -> [Text] -> [FmtVal]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
titles) (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
key) HeaderLine -> [HeaderLine] -> NonEmpty HeaderLine
forall a. a -> [a] -> NonEmpty a
:| [], FmtLine
fmt)
hdrvalstep RenderConfig
cfg KVITable v
t KeySpec
steppath (Text
key:[Text]
keys) =
  let ordering :: [Text] -> [Text]
ordering = if RenderConfig -> LastInGroup
sortKeyVals RenderConfig
cfg then [Text] -> [Text]
sortWithNums else [Text] -> [Text]
forall a. a -> a
id
  in case [Text] -> [Text]
ordering ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ [Text] -> Maybe [Text] -> [Text]
forall a. a -> Maybe a -> a
fromMaybe [] (Maybe [Text] -> [Text]) -> Maybe [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ Text -> [(Text, [Text])] -> Maybe [Text]
forall a b. Eq a => a -> [(a, b)] -> Maybe b
L.lookup Text
key ([(Text, [Text])] -> Maybe [Text])
-> [(Text, [Text])] -> Maybe [Text]
forall a b. (a -> b) -> a -> b
$ KVITable v
t KVITable v
-> Getting [(Text, [Text])] (KVITable v) [(Text, [Text])]
-> [(Text, [Text])]
forall s a. s -> Getting a s a -> a
^. Getting [(Text, [Text])] (KVITable v) [(Text, [Text])]
forall v (f :: * -> *).
Functor f =>
([(Text, [Text])] -> f [(Text, [Text])])
-> KVITable v -> f (KVITable v)
keyVals of
       [] -> String -> (NonEmpty HeaderLine, FmtLine)
forall a. HasCallStack => String -> a
error String
"cannot happen"
       (Text
ttl:[Text]
ttls) ->
         let
           titles :: NonEmpty Text
titles = Text
ttl Text -> [Text] -> NonEmpty Text
forall a. a -> [a] -> NonEmpty a
:| [Text]
ttls
           subhdrsV :: Text -> (NonEmpty HeaderLine, FmtLine)
subhdrsV Text
v = RenderConfig
-> KVITable v
-> KeySpec
-> [Text]
-> (NonEmpty HeaderLine, FmtLine)
forall v.
Pretty v =>
RenderConfig
-> KVITable v
-> KeySpec
-> [Text]
-> (NonEmpty HeaderLine, FmtLine)
hdrvalstep RenderConfig
cfg KVITable v
t (KeySpec
steppath KeySpec -> KeySpec -> KeySpec
forall a. Semigroup a => a -> a -> a
<> [(Text
key,Text
v)]) [Text]
keys
           subTtlHdrs :: NEL.NonEmpty (NEL.NonEmpty HeaderLine, FmtLine)
           subTtlHdrs :: NonEmpty (NonEmpty HeaderLine, FmtLine)
subTtlHdrs = Text -> (NonEmpty HeaderLine, FmtLine)
subhdrsV (Text -> (NonEmpty HeaderLine, FmtLine))
-> NonEmpty Text -> NonEmpty (NonEmpty HeaderLine, FmtLine)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty Text
titles
           subhdrs :: NEL.NonEmpty (NEL.NonEmpty HeaderLine, FmtLine)
           subhdrs :: NonEmpty (NonEmpty HeaderLine, FmtLine)
subhdrs = if RenderConfig -> LastInGroup
hideBlankCols RenderConfig
cfg
                     then NonEmpty (NonEmpty HeaderLine, FmtLine)
subTtlHdrs
                     else
                       -- Want to repeat the first element of subTtlHdrs to get a
                       -- NonEmpty the same length as titles.  Both titles and
                       -- subTtlHdrs are NonEmpty, but NonEmpty has no replicate
                       -- function.
                       let n :: Int
n = NonEmpty Text -> Int
forall a. NonEmpty a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length NonEmpty Text
titles -- >= 1 because titles is NonEmpty
                           e :: (NonEmpty HeaderLine, FmtLine)
e = NonEmpty (NonEmpty HeaderLine, FmtLine)
-> (NonEmpty HeaderLine, FmtLine)
forall a. NonEmpty a -> a
NEL.head NonEmpty (NonEmpty HeaderLine, FmtLine)
subTtlHdrs
                           tail' :: [(NonEmpty HeaderLine, FmtLine)]
tail' = Int
-> NonEmpty (NonEmpty HeaderLine, FmtLine)
-> [(NonEmpty HeaderLine, FmtLine)]
forall a. Int -> NonEmpty a -> [a]
NEL.take (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) (NonEmpty (NonEmpty HeaderLine, FmtLine)
 -> [(NonEmpty HeaderLine, FmtLine)])
-> NonEmpty (NonEmpty HeaderLine, FmtLine)
-> [(NonEmpty HeaderLine, FmtLine)]
forall a b. (a -> b) -> a -> b
$ (NonEmpty HeaderLine, FmtLine)
-> NonEmpty (NonEmpty HeaderLine, FmtLine)
forall a. a -> NonEmpty a
NEL.repeat (NonEmpty HeaderLine, FmtLine)
e
                       in (NonEmpty HeaderLine, FmtLine)
e (NonEmpty HeaderLine, FmtLine)
-> [(NonEmpty HeaderLine, FmtLine)]
-> NonEmpty (NonEmpty HeaderLine, FmtLine)
forall a. a -> [a] -> NonEmpty a
:| [(NonEmpty HeaderLine, FmtLine)]
tail'
           subhdr_rollup :: NonEmpty HeaderLine
subhdr_rollup = NonEmpty HeaderLine -> HeaderLine
joinHdrs (NonEmpty HeaderLine -> HeaderLine)
-> NonEmpty (NonEmpty HeaderLine) -> NonEmpty HeaderLine
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty (NonEmpty HeaderLine) -> NonEmpty (NonEmpty HeaderLine)
forall a. NonEmpty (NonEmpty a) -> NonEmpty (NonEmpty a)
NEL.transpose ((NonEmpty HeaderLine, FmtLine) -> NonEmpty HeaderLine
forall a b. (a, b) -> a
fst ((NonEmpty HeaderLine, FmtLine) -> NonEmpty HeaderLine)
-> NonEmpty (NonEmpty HeaderLine, FmtLine)
-> NonEmpty (NonEmpty HeaderLine)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty (NonEmpty HeaderLine, FmtLine)
subhdrs)
           joinHdrs :: NEL.NonEmpty HeaderLine -> HeaderLine
           joinHdrs :: NonEmpty HeaderLine -> HeaderLine
joinHdrs (HeaderLine
hl0 :| [HeaderLine]
hls) = (HeaderLine -> HeaderLine -> HeaderLine)
-> HeaderLine -> [HeaderLine] -> HeaderLine
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl HeaderLine -> HeaderLine -> HeaderLine
forall a. Semigroup a => a -> a -> a
(<>) HeaderLine
hl0 [HeaderLine]
hls
           superFmt :: (NEL.NonEmpty HeaderLine, FmtLine) -> Int
           superFmt :: (NonEmpty HeaderLine, FmtLine) -> Int
superFmt (NonEmpty HeaderLine, FmtLine)
sub = let FmtLine [Int]
subcols = HeaderLine -> FmtLine
hdrFmt (HeaderLine -> FmtLine) -> HeaderLine -> FmtLine
forall a b. (a -> b) -> a -> b
$ NonEmpty HeaderLine -> HeaderLine
forall a. NonEmpty a -> a
NEL.last (NonEmpty HeaderLine -> HeaderLine)
-> NonEmpty HeaderLine -> HeaderLine
forall a b. (a -> b) -> a -> b
$ (NonEmpty HeaderLine, FmtLine) -> NonEmpty HeaderLine
forall a b. (a, b) -> a
fst (NonEmpty HeaderLine, FmtLine)
sub
                          in if [Int] -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Int]
subcols Int -> Int -> LastInGroup
forall a. Eq a => a -> a -> LastInGroup
== Int
0
                             then Int
0
                             else [Int] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ (Int -> LastInGroup) -> [Int] -> [Int]
forall a. (a -> LastInGroup) -> [a] -> [a]
L.filter (Int -> Int -> LastInGroup
forall a. Eq a => a -> a -> LastInGroup
/= Int
0) [Int]
subcols
           topfmt :: FmtLine
topfmt = [Int] -> FmtLine
FmtLine ([Int] -> FmtLine) -> [Int] -> FmtLine
forall a b. (a -> b) -> a -> b
$ NonEmpty Int -> [Int]
forall a. NonEmpty a -> [a]
NEL.toList ((NonEmpty HeaderLine, FmtLine) -> Int
superFmt ((NonEmpty HeaderLine, FmtLine) -> Int)
-> NonEmpty (NonEmpty HeaderLine, FmtLine) -> NonEmpty Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty (NonEmpty HeaderLine, FmtLine)
subhdrs)
           tophdr :: HeaderLine
tophdr = FmtLine -> [FmtVal] -> Maybe Text -> HeaderLine
HdrLine FmtLine
topfmt (NonEmpty FmtVal -> [FmtVal]
forall a. NonEmpty a -> [a]
NEL.toList (Int -> LastInGroup -> Text -> FmtVal
Hdr Int
1 LastInGroup
False (Text -> FmtVal) -> NonEmpty Text -> NonEmpty FmtVal
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty Text
titles)) (Maybe Text -> HeaderLine) -> Maybe Text -> HeaderLine
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text
forall a. a -> Maybe a
Just Text
key
         in ( HeaderLine -> NonEmpty HeaderLine -> NonEmpty HeaderLine
forall a. a -> NonEmpty a -> NonEmpty a
NEL.cons HeaderLine
tophdr NonEmpty HeaderLine
subhdr_rollup, NonEmpty FmtLine -> FmtLine
forall m. Monoid m => NonEmpty m -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
F.fold ((NonEmpty HeaderLine, FmtLine) -> FmtLine
forall a b. (a, b) -> b
snd ((NonEmpty HeaderLine, FmtLine) -> FmtLine)
-> NonEmpty (NonEmpty HeaderLine, FmtLine) -> NonEmpty FmtLine
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty (NonEmpty HeaderLine, FmtLine)
subTtlHdrs))

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

renderSeq :: PP.Pretty v
          => RenderConfig -> FmtLine -> [Key] -> KVITable v -> Html ()
renderSeq :: forall v.
Pretty v =>
RenderConfig
-> FmtLine -> [Text] -> KVITable v -> HtmlT Identity ()
renderSeq RenderConfig
cfg FmtLine
fmt [Text]
keys KVITable v
t =
  ([FmtVal] -> HtmlT Identity ()) -> [[FmtVal]] -> HtmlT Identity ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (([FmtVal] -> Maybe Text -> HtmlT Identity ())
-> Maybe Text -> [FmtVal] -> HtmlT Identity ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip (FmtLine -> [FmtVal] -> Maybe Text -> HtmlT Identity ()
fmtRender FmtLine
fmt) Maybe Text
forall a. Maybe a
Nothing) ([[FmtVal]] -> HtmlT Identity ())
-> [[FmtVal]] -> HtmlT Identity ()
forall a b. (a -> b) -> a -> b
$ [Text] -> KeySpec -> [[FmtVal]]
htmlRows [Text]
keys []
  where
    mkVal :: v -> FmtVal
mkVal = Int -> LastInGroup -> Text -> FmtVal
Val Int
1 LastInGroup
False (Text -> FmtVal) -> (v -> Text) -> v -> FmtVal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Text) -> (v -> String) -> v -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc Any -> String
forall a. Show a => a -> String
show (Doc Any -> String) -> (v -> Doc Any) -> v -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> Doc Any
forall ann. v -> Doc ann
forall a ann. Pretty a => a -> Doc ann
PP.pretty
    htmlRows :: [Key] -> KeySpec -> [ [FmtVal] ]
    htmlRows :: [Text] -> KeySpec -> [[FmtVal]]
htmlRows [] KeySpec
path =
      let v :: Maybe v
v = KeySpec -> KVITable v -> Maybe v
forall v. KeySpec -> KVITable v -> Maybe v
lookup KeySpec
path KVITable v
t
          skip :: LastInGroup
skip = case Maybe v
v of
            Maybe v
Nothing -> RenderConfig -> LastInGroup
hideBlankRows RenderConfig
cfg
            Just v
_ -> LastInGroup
False
          row :: FmtVal
row = FmtVal -> (v -> FmtVal) -> Maybe v -> FmtVal
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Int -> LastInGroup -> Text -> FmtVal
Val Int
1 LastInGroup
False Text
"") v -> FmtVal
mkVal Maybe v
v
      in if LastInGroup
skip then [] else [ [FmtVal
row] ]
    htmlRows (Text
key:[Text]
kseq) KeySpec
path
      | RenderConfig -> Maybe Text
colStackAt RenderConfig
cfg Maybe Text -> Maybe Text -> LastInGroup
forall a. Eq a => a -> a -> LastInGroup
== Text -> Maybe Text
forall a. a -> Maybe a
Just Text
key =
          let filterOrDefaultBlankRows :: [[Maybe FmtVal]] -> [[FmtVal]]
filterOrDefaultBlankRows =
                ([Maybe FmtVal] -> [FmtVal]) -> [[Maybe FmtVal]] -> [[FmtVal]]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Maybe FmtVal -> FmtVal) -> [Maybe FmtVal] -> [FmtVal]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (FmtVal -> (FmtVal -> FmtVal) -> Maybe FmtVal -> FmtVal
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Int -> LastInGroup -> Text -> FmtVal
Val Int
1 LastInGroup
False Text
"") FmtVal -> FmtVal
forall a. a -> a
id)) ([[Maybe FmtVal]] -> [[FmtVal]])
-> ([[Maybe FmtVal]] -> [[Maybe FmtVal]])
-> [[Maybe FmtVal]]
-> [[FmtVal]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                if RenderConfig -> LastInGroup
hideBlankRows RenderConfig
cfg
                then ([Maybe FmtVal] -> LastInGroup)
-> [[Maybe FmtVal]] -> [[Maybe FmtVal]]
forall a. (a -> LastInGroup) -> [a] -> [a]
L.filter (LastInGroup -> LastInGroup
not (LastInGroup -> LastInGroup)
-> ([Maybe FmtVal] -> LastInGroup) -> [Maybe FmtVal] -> LastInGroup
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe FmtVal -> LastInGroup) -> [Maybe FmtVal] -> LastInGroup
forall (t :: * -> *) a.
Foldable t =>
(a -> LastInGroup) -> t a -> LastInGroup
all Maybe FmtVal -> LastInGroup
forall a. Maybe a -> LastInGroup
isNothing)
                else [[Maybe FmtVal]] -> [[Maybe FmtVal]]
forall a. a -> a
id
          in [[Maybe FmtVal]] -> [[FmtVal]]
filterOrDefaultBlankRows ([[Maybe FmtVal]] -> [[FmtVal]]) -> [[Maybe FmtVal]] -> [[FmtVal]]
forall a b. (a -> b) -> a -> b
$
             [ [Text] -> KeySpec -> [Maybe FmtVal]
multivalRows (Text
keyText -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:[Text]
kseq) KeySpec
path ]
      | LastInGroup
otherwise =
          let keyvals :: [Text]
keyvals = [Text] -> [Text]
ordering ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ [Text] -> Maybe [Text] -> [Text]
forall a. a -> Maybe a -> a
fromMaybe [] (Maybe [Text] -> [Text]) -> Maybe [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ Text -> [(Text, [Text])] -> Maybe [Text]
forall a b. Eq a => a -> [(a, b)] -> Maybe b
L.lookup Text
key ([(Text, [Text])] -> Maybe [Text])
-> [(Text, [Text])] -> Maybe [Text]
forall a b. (a -> b) -> a -> b
$ KVITable v
t KVITable v
-> Getting [(Text, [Text])] (KVITable v) [(Text, [Text])]
-> [(Text, [Text])]
forall s a. s -> Getting a s a -> a
^. Getting [(Text, [Text])] (KVITable v) [(Text, [Text])]
forall v (f :: * -> *).
Functor f =>
([(Text, [Text])] -> f [(Text, [Text])])
-> KVITable v -> f (KVITable v)
keyVals
              ordering :: [Text] -> [Text]
ordering = if RenderConfig -> LastInGroup
sortKeyVals RenderConfig
cfg then [Text] -> [Text]
sortWithNums else [Text] -> [Text]
forall a. a -> a
id
              subrows :: Text -> [[FmtVal]]
subrows Text
keyval = [Text] -> KeySpec -> [[FmtVal]]
htmlRows [Text]
kseq (KeySpec -> [[FmtVal]]) -> KeySpec -> [[FmtVal]]
forall a b. (a -> b) -> a -> b
$ KeySpec
path KeySpec -> KeySpec -> KeySpec
forall a. Semigroup a => a -> a -> a
<> [(Text
key,Text
keyval)]
              endOfGroup :: LastInGroup
endOfGroup = Text
key Text -> [Text] -> LastInGroup
forall a. Eq a => a -> [a] -> LastInGroup
forall (t :: * -> *) a.
(Foldable t, Eq a) =>
a -> t a -> LastInGroup
`elem` RenderConfig -> [Text]
rowGroup RenderConfig
cfg
              addSubrows :: [[FmtVal]] -> Text -> [[FmtVal]]
addSubrows [[FmtVal]]
ret Text
keyval =
                let sr :: [[FmtVal]]
sr = Text -> [[FmtVal]]
subrows Text
keyval
                in [[FmtVal]]
ret [[FmtVal]] -> [[FmtVal]] -> [[FmtVal]]
forall a. Semigroup a => a -> a -> a
<> (([[FmtVal]], Maybe Text) -> [[FmtVal]]
forall a b. (a, b) -> a
fst (([[FmtVal]], Maybe Text) -> [[FmtVal]])
-> ([[FmtVal]], Maybe Text) -> [[FmtVal]]
forall a b. (a -> b) -> a -> b
$
                           (([[FmtVal]], Maybe Text)
 -> (LastInGroup, [FmtVal]) -> ([[FmtVal]], Maybe Text))
-> ([[FmtVal]], Maybe Text)
-> [(LastInGroup, [FmtVal])]
-> ([[FmtVal]], Maybe Text)
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (Int
-> ([[FmtVal]], Maybe Text)
-> (LastInGroup, [FmtVal])
-> ([[FmtVal]], Maybe Text)
leftAdd ([[FmtVal]] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[FmtVal]]
sr)) ([],Text -> Maybe Text
forall a. a -> Maybe a
Just Text
keyval) ([(LastInGroup, [FmtVal])] -> ([[FmtVal]], Maybe Text))
-> [(LastInGroup, [FmtVal])] -> ([[FmtVal]], Maybe Text)
forall a b. (a -> b) -> a -> b
$
                           [(LastInGroup, [FmtVal])] -> [(LastInGroup, [FmtVal])]
forall a. [a] -> [a]
reverse ([(LastInGroup, [FmtVal])] -> [(LastInGroup, [FmtVal])])
-> [(LastInGroup, [FmtVal])] -> [(LastInGroup, [FmtVal])]
forall a b. (a -> b) -> a -> b
$ [LastInGroup] -> [[FmtVal]] -> [(LastInGroup, [FmtVal])]
forall a b. [a] -> [b] -> [(a, b)]
zip (LastInGroup
endOfGroupLastInGroup -> [LastInGroup] -> [LastInGroup]
forall a. a -> [a] -> [a]
: LastInGroup -> [LastInGroup]
forall a. a -> [a]
L.repeat LastInGroup
False) ([[FmtVal]] -> [(LastInGroup, [FmtVal])])
-> [[FmtVal]] -> [(LastInGroup, [FmtVal])]
forall a b. (a -> b) -> a -> b
$ [[FmtVal]] -> [[FmtVal]]
forall a. [a] -> [a]
reverse [[FmtVal]]
sr)
              leftAdd :: Int
-> ([[FmtVal]], Maybe Text)
-> (LastInGroup, [FmtVal])
-> ([[FmtVal]], Maybe Text)
leftAdd Int
nrows ([[FmtVal]]
acc,Maybe Text
mb'kv) (LastInGroup
endGrp, [FmtVal]
subrow) =
                let sr :: [FmtVal]
sr = LastInGroup -> FmtVal -> FmtVal
setValGrouping LastInGroup
endGrp (FmtVal -> FmtVal) -> [FmtVal] -> [FmtVal]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [FmtVal]
subrow
                    setValGrouping :: LastInGroup -> FmtVal -> FmtVal
setValGrouping LastInGroup
g (Val Int
h LastInGroup
g' Text
v) = Int -> LastInGroup -> Text -> FmtVal
Val Int
h (LastInGroup
g LastInGroup -> LastInGroup -> LastInGroup
|| LastInGroup
g') Text
v
                    setValGrouping LastInGroup
g (Hdr Int
h LastInGroup
g' Text
v) = Int -> LastInGroup -> Text -> FmtVal
Hdr Int
h (LastInGroup
g LastInGroup -> LastInGroup -> LastInGroup
|| LastInGroup
g') Text
v
                in ( [[FmtVal]]
acc [[FmtVal]] -> [[FmtVal]] -> [[FmtVal]]
forall a. Semigroup a => a -> a -> a
<> [ (case Maybe Text
mb'kv of
                                    Maybe Text
Nothing -> [FmtVal]
sr
                                    Just Text
kv -> let w :: Int
w = if RenderConfig -> LastInGroup
rowRepeat RenderConfig
cfg
                                                       then Int
1
                                                       else Int
nrows
                                               in Int -> LastInGroup -> Text -> FmtVal
Hdr Int
w LastInGroup
endOfGroup Text
kv FmtVal -> [FmtVal] -> [FmtVal]
forall a. a -> [a] -> [a]
: [FmtVal]
sr
                              ) ]
                   , if RenderConfig -> LastInGroup
rowRepeat RenderConfig
cfg then Maybe Text
mb'kv else Maybe Text
forall a. Maybe a
Nothing)
          in ([[FmtVal]] -> Text -> [[FmtVal]])
-> [[FmtVal]] -> [Text] -> [[FmtVal]]
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl [[FmtVal]] -> Text -> [[FmtVal]]
addSubrows [] [Text]
keyvals


    multivalRows :: [Text] -> KeySpec -> [Maybe FmtVal]
multivalRows [] KeySpec
_ = String -> [Maybe FmtVal]
forall a. HasCallStack => String -> a
error String
"HTML multivalRows cannot be called with no keys!"
    multivalRows (Text
key:[]) KeySpec
path =
      let keyvals :: [Text]
keyvals = [Text] -> [Text]
ordering ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ [Text] -> Maybe [Text] -> [Text]
forall a. a -> Maybe a -> a
fromMaybe [] (Maybe [Text] -> [Text]) -> Maybe [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ Text -> [(Text, [Text])] -> Maybe [Text]
forall a b. Eq a => a -> [(a, b)] -> Maybe b
L.lookup Text
key ([(Text, [Text])] -> Maybe [Text])
-> [(Text, [Text])] -> Maybe [Text]
forall a b. (a -> b) -> a -> b
$ KVITable v
t KVITable v
-> Getting [(Text, [Text])] (KVITable v) [(Text, [Text])]
-> [(Text, [Text])]
forall s a. s -> Getting a s a -> a
^. Getting [(Text, [Text])] (KVITable v) [(Text, [Text])]
forall v (f :: * -> *).
Functor f =>
([(Text, [Text])] -> f [(Text, [Text])])
-> KVITable v -> f (KVITable v)
keyVals
          ordering :: [Text] -> [Text]
ordering = if RenderConfig -> LastInGroup
sortKeyVals RenderConfig
cfg then [Text] -> [Text]
sortWithNums else [Text] -> [Text]
forall a. a -> a
id
      in (\Text
v -> v -> FmtVal
mkVal (v -> FmtVal) -> Maybe v -> Maybe FmtVal
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> KeySpec -> KVITable v -> Maybe v
forall v. KeySpec -> KVITable v -> Maybe v
lookup (KeySpec
path KeySpec -> KeySpec -> KeySpec
forall a. Semigroup a => a -> a -> a
<> [(Text
key,Text
v)]) KVITable v
t) (Text -> Maybe FmtVal) -> [Text] -> [Maybe FmtVal]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
keyvals
    multivalRows (Text
key:[Text]
kseq) KeySpec
path =
      let keyvals :: [Text]
keyvals = [Text] -> [Text]
ordering ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ [Text] -> Maybe [Text] -> [Text]
forall a. a -> Maybe a -> a
fromMaybe [] (Maybe [Text] -> [Text]) -> Maybe [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ Text -> [(Text, [Text])] -> Maybe [Text]
forall a b. Eq a => a -> [(a, b)] -> Maybe b
L.lookup Text
key ([(Text, [Text])] -> Maybe [Text])
-> [(Text, [Text])] -> Maybe [Text]
forall a b. (a -> b) -> a -> b
$ KVITable v
t KVITable v
-> Getting [(Text, [Text])] (KVITable v) [(Text, [Text])]
-> [(Text, [Text])]
forall s a. s -> Getting a s a -> a
^. Getting [(Text, [Text])] (KVITable v) [(Text, [Text])]
forall v (f :: * -> *).
Functor f =>
([(Text, [Text])] -> f [(Text, [Text])])
-> KVITable v -> f (KVITable v)
keyVals
          ordering :: [Text] -> [Text]
ordering = if RenderConfig -> LastInGroup
sortKeyVals RenderConfig
cfg then [Text] -> [Text]
sortWithNums else [Text] -> [Text]
forall a. a -> a
id
      in (Text -> [Maybe FmtVal]) -> [Text] -> [Maybe FmtVal]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\Text
v -> [Text] -> KeySpec -> [Maybe FmtVal]
multivalRows [Text]
kseq (KeySpec
path KeySpec -> KeySpec -> KeySpec
forall a. Semigroup a => a -> a -> a
<> [(Text
key,Text
v)])) [Text]
keyvals