{-# 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.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 = forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> KVITable v
t forall s a. s -> Getting a s a -> a
^. forall v. Lens' (KVITable v) [(Text, [Text])]
keyVals
      (FmtLine
fmt, HtmlT Identity ()
hdr) = forall v.
Pretty v =>
RenderConfig
-> KVITable v -> [Text] -> (FmtLine, HtmlT Identity ())
renderHdrs RenderConfig
cfg KVITable v
t [Text]
kseq
      bdy :: HtmlT Identity ()
bdy = 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 forall a b. (a -> b) -> a -> b
$ forall a. Html a -> Text
renderText forall a b. (a -> b) -> a -> b
$
     forall arg result. Term arg result => arg -> result
table_ [ Text -> Attribute
class_ Text
"kvitable" ] forall a b. (a -> b) -> a -> b
$
     do forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty (forall arg result. Term arg result => arg -> result
caption_ forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
toHtml) forall a b. (a -> b) -> a -> b
$ RenderConfig -> Maybe Text
Data.KVITable.Render.caption RenderConfig
cfg
        forall arg result. Term arg result => arg -> result
thead_ [ Text -> Attribute
class_ Text
"kvitable_head" ] HtmlT Identity ()
hdr
        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 forall a b. (a -> b) -> a -> b
$ [Int]
c1 forall a. Semigroup a => a -> a -> a
<> [Int]
c2

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

fmtAddColLeft :: Int -> FmtLine -> FmtLine
fmtAddColLeft :: Int -> FmtLine -> FmtLine
fmtAddColLeft Int
lspan (FmtLine [Int]
col) = [Int] -> FmtLine
FmtLine forall a b. (a -> b) -> a -> b
$ Int
lspan 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
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FmtVal] -> ShowS
$cshowList :: [FmtVal] -> ShowS
show :: FmtVal -> String
$cshow :: FmtVal -> String
showsPrec :: Int -> FmtVal -> ShowS
$cshowsPrec :: Int -> 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
  forall arg result. Term arg result => arg -> result
tr_ [ Text -> Attribute
class_ Text
"kvitable_tr" ] forall a b. (a -> b) -> a -> b
$
    let excessColCnt :: Int
excessColCnt = forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
cols forall a. Num a => a -> a -> a
- 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 forall a. Eq a => a -> a -> LastInGroup
== Int
1 then []
                    else [ Text -> Attribute
rowspan_ forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Int
h ]
                  , if a
w forall a. Eq a => a -> a -> LastInGroup
== a
1 then []
                    else [ Text -> Attribute
colspan_ forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ 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 forall arg result. Term arg result => arg -> result
th_ (forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
reverse [[Attribute]]
a) (forall a (m :: * -> *). (ToHtml a, Monad m) => a -> 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 forall a. Eq a => a -> a -> LastInGroup
== Int
1 then []
                    else [ Text -> Attribute
rowspan_ forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Int
h ]
                  , if a
w forall a. Eq a => a -> a -> LastInGroup
== a
1 then []
                    else [ Text -> Attribute
colspan_ forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ 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 forall arg result. Term arg result => arg -> result
td_ (forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
reverse [[Attribute]]
a) (forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
toHtml Text
v)
        labelMark :: HtmlT Identity ()
labelMark = forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
toHtmlRaw (Text
"&nbsp;&larr;" :: Text)
        labelHtml :: Text -> HtmlT Identity ()
labelHtml = forall arg result. Term arg result => arg -> result
th_ [ Text -> Attribute
class_ Text
"rightlabel kvitable_th" ] forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                    (HtmlT Identity ()
labelMark forall a. Semigroup a => a -> a -> a
<>) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                    forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
toHtml
    in do forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ 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 forall a b. (a -> b) -> a -> b
$ forall a. (a -> LastInGroup) -> [a] -> [a]
L.filter ((forall a. Eq a => a -> a -> LastInGroup
/= Int
0) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) forall a b. (a -> b) -> a -> b
$
            forall a b. [a] -> [b] -> [(a, b)]
zip (forall a. Int -> [a] -> [a]
drop Int
excessColCnt [Int]
cols) [FmtVal]
vals
          forall b a. b -> (a -> b) -> Maybe a -> b
maybe 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 forall a. Semigroup a => a -> a -> a
<> FmtLine
fmt2) ([FmtVal]
hv1 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, forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ [ FmtLine -> [FmtVal] -> Maybe Text -> HtmlT Identity ()
fmtRender FmtLine
fmt [FmtVal]
hdrvals Maybe Text
trailer
                      | (HdrLine FmtLine
fmt [FmtVal]
hdrvals Maybe Text
trailer) <- [HeaderLine]
hrows
                      ])
  where
    ([HeaderLine]
hrows, FmtLine
rowfmt) = forall v.
Pretty v =>
RenderConfig -> KVITable v -> [Text] -> ([HeaderLine], FmtLine)
hdrstep RenderConfig
cfg KVITable v
t [Text]
keys

hdrstep :: PP.Pretty v
        => RenderConfig -> KVITable v -> [Key] -> ([HeaderLine], FmtLine)
hdrstep :: forall v.
Pretty v =>
RenderConfig -> KVITable v -> [Text] -> ([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 forall a b. (a -> b) -> a -> b
$ KVITable v
t forall s a. s -> Getting a s a -> a
^. forall v. Lens' (KVITable v) Text
valueColName] forall a. Maybe a
Nothing ]
  , [Int] -> FmtLine
FmtLine [Int
1]
  )
hdrstep RenderConfig
cfg KVITable v
t (Text
key:[Text]
keys) =
  if RenderConfig -> Maybe Text
colStackAt RenderConfig
cfg forall a. Eq a => a -> a -> LastInGroup
== forall a. a -> Maybe a
Just Text
key
  then forall v.
Pretty v =>
RenderConfig
-> KVITable v -> KeySpec -> [Text] -> ([HeaderLine], FmtLine)
hdrvalstep RenderConfig
cfg KVITable v
t [] (Text
keyforall a. a -> [a] -> [a]
:[Text]
keys) -- switch to column stacking mode
  else
    let ([HeaderLine]
nexthdrs, FmtLine
lowestfmt) = forall v.
Pretty v =>
RenderConfig -> KVITable v -> [Text] -> ([HeaderLine], FmtLine)
hdrstep RenderConfig
cfg KVITable v
t [Text]
keys
        (HdrLine FmtLine
fmt [FmtVal]
vals Maybe Text
tr) = forall a. [a] -> a
head [HeaderLine]
nexthdrs -- safe: there were keys
        fmt' :: FmtLine
fmt' = Int -> FmtLine -> FmtLine
fmtAddColLeft Int
1 FmtLine
fmt
        val :: FmtVal
val = Int -> LastInGroup -> Text -> FmtVal
Hdr (forall (t :: * -> *) a. Foldable t => t a -> Int
length [HeaderLine]
nexthdrs) LastInGroup
False Text
key
    in ( (FmtLine -> [FmtVal] -> Maybe Text -> HeaderLine
HdrLine FmtLine
fmt' (FmtVal
val forall a. a -> [a] -> [a]
: [FmtVal]
vals) Maybe Text
tr) forall a. a -> [a] -> [a]
: forall a. [a] -> [a]
tail [HeaderLine]
nexthdrs
       , Int -> FmtLine -> FmtLine
fmtAddColLeft Int
1 FmtLine
lowestfmt
       )

hdrvalstep :: PP.Pretty v
           => RenderConfig -> KVITable v -> KeySpec -> [Key]
           -> ([HeaderLine], FmtLine)
hdrvalstep :: forall v.
Pretty v =>
RenderConfig
-> KVITable v -> KeySpec -> [Text] -> ([HeaderLine], FmtLine)
hdrvalstep RenderConfig
_ KVITable v
_ KeySpec
_ [] = 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 forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a -> a
fromMaybe [] forall a b. (a -> b) -> a -> b
$ forall a b. Eq a => a -> [(a, b)] -> Maybe b
L.lookup Text
key forall a b. (a -> b) -> a -> b
$ KVITable v
t forall s a. s -> Getting a s a -> a
^. forall v. Lens' (KVITable v) [(Text, [Text])]
keyVals
      ordering :: [Text] -> [Text]
ordering = if RenderConfig -> LastInGroup
sortKeyVals RenderConfig
cfg then [Text] -> [Text]
sortWithNums else forall a. a -> a
id
      cvalWidths :: Text -> [Int]
cvalWidths Text
kv = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (t :: * -> *) a. Foldable t => t a -> Int
length forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a ann. Pretty a => a -> Doc ann
PP.pretty forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) forall a b. (a -> b) -> a -> b
$
                      forall a. (a -> LastInGroup) -> [a] -> [a]
L.filter ((forall a. Eq a => [a] -> [a] -> LastInGroup
L.isSuffixOf (KeySpec
steppath forall a. Semigroup a => a -> a -> a
<> [(Text
key, Text
kv)])) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) forall a b. (a -> b) -> a -> b
$
                      forall v. KVITable v -> [Item (KVITable v)]
toList KVITable v
t
      cwidth :: Text -> a
cwidth Text
c = if forall (t :: * -> *). Foldable t => t LastInGroup -> LastInGroup
and [ RenderConfig -> LastInGroup
hideBlankCols RenderConfig
cfg
                        , Int
0 forall a. Eq a => a -> a -> LastInGroup
== (forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum forall a b. (a -> b) -> a -> b
$ Text -> [Int]
cvalWidths Text
c) ]
                 then a
0
                 else a
1
      fmt :: FmtLine
fmt = [Int] -> FmtLine
FmtLine forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
titles) (forall a. a -> Maybe a
Just Text
key) ], FmtLine
fmt)
hdrvalstep RenderConfig
cfg KVITable v
t KeySpec
steppath (Text
key:[Text]
keys) =
  let titles :: [Text]
titles = [Text] -> [Text]
ordering forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a -> a
fromMaybe [] forall a b. (a -> b) -> a -> b
$ forall a b. Eq a => a -> [(a, b)] -> Maybe b
L.lookup Text
key forall a b. (a -> b) -> a -> b
$ KVITable v
t forall s a. s -> Getting a s a -> a
^. forall v. Lens' (KVITable v) [(Text, [Text])]
keyVals
      ordering :: [Text] -> [Text]
ordering = if RenderConfig -> LastInGroup
sortKeyVals RenderConfig
cfg then [Text] -> [Text]
sortWithNums else forall a. a -> a
id
      subhdrsV :: Text -> ([HeaderLine], FmtLine)
subhdrsV Text
v = forall v.
Pretty v =>
RenderConfig
-> KVITable v -> KeySpec -> [Text] -> ([HeaderLine], FmtLine)
hdrvalstep RenderConfig
cfg KVITable v
t (KeySpec
steppath forall a. Semigroup a => a -> a -> a
<> [(Text
key,Text
v)]) [Text]
keys
      subTtlHdrs :: [ ([HeaderLine], FmtLine) ]
      subTtlHdrs :: [([HeaderLine], FmtLine)]
subTtlHdrs = Text -> ([HeaderLine], FmtLine)
subhdrsV forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
titles
      subhdrs :: [([HeaderLine], FmtLine)]
subhdrs = if RenderConfig -> LastInGroup
hideBlankCols RenderConfig
cfg
                then [([HeaderLine], FmtLine)]
subTtlHdrs
                else forall a. Int -> a -> [a]
L.replicate (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
titles) forall a b. (a -> b) -> a -> b
$ forall a. [a] -> a
head [([HeaderLine], FmtLine)]
subTtlHdrs
      subhdr_rollup :: [HeaderLine]
subhdr_rollup = forall {a}. Semigroup a => [a] -> a
joinHdrs forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. [[a]] -> [[a]]
L.transpose (forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [([HeaderLine], FmtLine)]
subhdrs)
      joinHdrs :: [a] -> a
joinHdrs [a]
hl = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl forall a. Semigroup a => a -> a -> a
(<>) (forall a. [a] -> a
head [a]
hl) (forall a. [a] -> [a]
tail [a]
hl)
      superFmt :: ([HeaderLine], b) -> Int
superFmt ([HeaderLine], b)
sub = let FmtLine [Int]
subcols = HeaderLine -> FmtLine
hdrFmt forall a b. (a -> b) -> a -> b
$ forall a. [a] -> a
last forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> a
fst ([HeaderLine], b)
sub
                     in if forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Int]
subcols forall a. Eq a => a -> a -> LastInGroup
== Int
0
                        then Int
0
                        else forall (t :: * -> *) a. Foldable t => t a -> Int
length forall a b. (a -> b) -> a -> b
$ forall a. (a -> LastInGroup) -> [a] -> [a]
L.filter (forall a. Eq a => a -> a -> LastInGroup
/= Int
0) [Int]
subcols
      topfmt :: FmtLine
topfmt = [Int] -> FmtLine
FmtLine (forall {b}. ([HeaderLine], b) -> Int
superFmt forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [([HeaderLine], FmtLine)]
subhdrs)
      tophdr :: HeaderLine
tophdr = FmtLine -> [FmtVal] -> Maybe Text -> HeaderLine
HdrLine FmtLine
topfmt (Int -> LastInGroup -> Text -> FmtVal
Hdr Int
1 LastInGroup
False forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
titles) forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just Text
key
  in ( HeaderLine
tophdr forall a. a -> [a] -> [a]
: [HeaderLine]
subhdr_rollup, forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
F.fold (forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [([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 =
  forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (forall a b c. (a -> b -> c) -> b -> a -> c
flip (FmtLine -> [FmtVal] -> Maybe Text -> HtmlT Identity ()
fmtRender FmtLine
fmt) forall a. Maybe a
Nothing) 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = 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 = 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 forall a. Eq a => a -> a -> LastInGroup
== forall a. a -> Maybe a
Just Text
key =
          let filterOrDefaultBlankRows :: [[Maybe FmtVal]] -> [[FmtVal]]
filterOrDefaultBlankRows =
                forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Int -> LastInGroup -> Text -> FmtVal
Val Int
1 LastInGroup
False Text
"") forall a. a -> a
id)) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                if RenderConfig -> LastInGroup
hideBlankRows RenderConfig
cfg
                then forall a. (a -> LastInGroup) -> [a] -> [a]
L.filter (LastInGroup -> LastInGroup
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a.
Foldable t =>
(a -> LastInGroup) -> t a -> LastInGroup
all forall a. Maybe a -> LastInGroup
isNothing)
                else forall a. a -> a
id
          in [[Maybe FmtVal]] -> [[FmtVal]]
filterOrDefaultBlankRows forall a b. (a -> b) -> a -> b
$
             [ [Text] -> KeySpec -> [Maybe FmtVal]
multivalRows (Text
keyforall a. a -> [a] -> [a]
:[Text]
kseq) KeySpec
path ]
      | LastInGroup
otherwise =
          let keyvals :: [Text]
keyvals = [Text] -> [Text]
ordering forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a -> a
fromMaybe [] forall a b. (a -> b) -> a -> b
$ forall a b. Eq a => a -> [(a, b)] -> Maybe b
L.lookup Text
key forall a b. (a -> b) -> a -> b
$ KVITable v
t forall s a. s -> Getting a s a -> a
^. forall v. Lens' (KVITable v) [(Text, [Text])]
keyVals
              ordering :: [Text] -> [Text]
ordering = if RenderConfig -> LastInGroup
sortKeyVals RenderConfig
cfg then [Text] -> [Text]
sortWithNums else forall a. a -> a
id
              subrows :: Text -> [[FmtVal]]
subrows Text
keyval = [Text] -> KeySpec -> [[FmtVal]]
htmlRows [Text]
kseq forall a b. (a -> b) -> a -> b
$ KeySpec
path forall a. Semigroup a => a -> a -> a
<> [(Text
key,Text
keyval)]
              endOfGroup :: LastInGroup
endOfGroup = Text
key 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 forall a. Semigroup a => a -> a -> a
<> (forall a b. (a, b) -> a
fst forall a b. (a -> 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 (forall (t :: * -> *) a. Foldable t => t a -> Int
length [[FmtVal]]
sr)) ([],forall a. a -> Maybe a
Just Text
keyval) forall a b. (a -> b) -> a -> b
$
                           forall a. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip (LastInGroup
endOfGroupforall a. a -> [a] -> [a]
: forall a. a -> [a]
L.repeat LastInGroup
False) forall a b. (a -> b) -> a -> b
$ 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 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 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 forall a. a -> [a] -> [a]
: [FmtVal]
sr
                              ) ]
                   , if RenderConfig -> LastInGroup
rowRepeat RenderConfig
cfg then Maybe Text
mb'kv else forall a. Maybe a
Nothing)
          in 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
_ = 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 forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a -> a
fromMaybe [] forall a b. (a -> b) -> a -> b
$ forall a b. Eq a => a -> [(a, b)] -> Maybe b
L.lookup Text
key forall a b. (a -> b) -> a -> b
$ KVITable v
t forall s a. s -> Getting a s a -> a
^. forall v. Lens' (KVITable v) [(Text, [Text])]
keyVals
          ordering :: [Text] -> [Text]
ordering = if RenderConfig -> LastInGroup
sortKeyVals RenderConfig
cfg then [Text] -> [Text]
sortWithNums else forall a. a -> a
id
      in (\Text
v -> v -> FmtVal
mkVal forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall v. KeySpec -> KVITable v -> Maybe v
lookup (KeySpec
path forall a. Semigroup a => a -> a -> a
<> [(Text
key,Text
v)]) KVITable v
t) 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 forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a -> a
fromMaybe [] forall a b. (a -> b) -> a -> b
$ forall a b. Eq a => a -> [(a, b)] -> Maybe b
L.lookup Text
key forall a b. (a -> b) -> a -> b
$ KVITable v
t forall s a. s -> Getting a s a -> a
^. forall v. Lens' (KVITable v) [(Text, [Text])]
keyVals
          ordering :: [Text] -> [Text]
ordering = if RenderConfig -> LastInGroup
sortKeyVals RenderConfig
cfg then [Text] -> [Text]
sortWithNums else forall a. a -> a
id
      in forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\Text
v -> [Text] -> KeySpec -> [Maybe FmtVal]
multivalRows [Text]
kseq (KeySpec
path forall a. Semigroup a => a -> a -> a
<> [(Text
key,Text
v)])) [Text]
keyvals