HTML writer: render table footers if present

Part of: jgm#6314
tarleb · Sep 12, 2020 · 4fefd73 · 4fefd73
1 parent 22babd5
commit 4fefd73
Show file tree

Hide file tree

Showing 5 changed files with 221 additions and 29 deletions.
diff --git a/src/Text/Pandoc/Writers/HTML.hs b/src/Text/Pandoc/Writers/HTML.hs
@@ -910,7 +910,7 @@ tableToHtml :: PandocMonad m
             => WriterOptions
             -> Ann.Table
             -> StateT WriterState m Html
-tableToHtml opts (Ann.Table attr caption colspecs thead tbodies _tfoot) = do
+tableToHtml opts (Ann.Table attr caption colspecs thead tbodies tfoot) = do
   captionDoc <- case caption of
     Caption _ [] -> return mempty
     Caption _ longCapt -> do
@@ -921,11 +921,11 @@ tableToHtml opts (Ann.Table attr caption colspecs thead tbodies _tfoot) = do
   coltags <- colSpecListToHtml opts colspecs
   head' <- tableHeadToHtml opts thead
   body' <- mconcat <$> mapM (tableBodyToHtml opts) tbodies
+  foot' <- tableFootToHtml opts tfoot
   let (ident,classes,kvs) = attr
   -- When widths of columns are < 100%, we need to set width for the whole
   -- table, or some browsers give us skinny columns with lots of space
   -- between:
-  -- let totalWidth = sum widths
   let colWidth = \case
         ColWidth d -> d
         ColWidthDefault -> 0
@@ -936,8 +936,14 @@ tableToHtml opts (Ann.Table attr caption colspecs thead tbodies _tfoot) = do
                          T.pack (show (round (totalWidth * 100) :: Int))
                          <> "%;"):kvs)
                 _ -> attr
-  addAttrs opts attr' $ H.table $
-    nl opts *> captionDoc *> coltags *> head' *> body' *> nl opts
+  addAttrs opts attr' $ H.table $ do
+    nl opts
+    captionDoc
+    coltags
+    head'
+    body'
+    foot'
+    nl opts
 
 tableBodyToHtml :: PandocMonad m
                 => WriterOptions
@@ -951,36 +957,57 @@ tableHeadToHtml :: PandocMonad m
                 -> Ann.TableHead
                 -> StateT WriterState m Html
 tableHeadToHtml opts (Ann.TableHead attr rows) =
+  tablePartToHtml opts Thead attr rows
+
+tableFootToHtml :: PandocMonad m
+                => WriterOptions
+                -> Ann.TableFoot
+                -> StateT WriterState m Html
+tableFootToHtml opts (Ann.TableFoot attr rows) =
+  tablePartToHtml opts Tfoot attr rows
+
+tablePartToHtml :: PandocMonad m
+                => WriterOptions
+                -> TablePart
+                -> Attr
+                -> [Ann.HeaderRow]
+                -> StateT WriterState m Html
+tablePartToHtml opts tblpart attr rows =
   if null rows || all isEmptyRow rows
   then return mempty
   else do
-    contents <- headerRowsToHtml opts rows
-    headElement <- addAttrs opts attr $ H.thead contents
+    let tag' = case tblpart of
+                 Thead -> H.thead
+                 Tfoot -> H.tfoot
+                 Tbody -> H.tbody -- this would be unexpected
+    contents <- headerRowsToHtml opts tblpart rows
+    tablePartElement <- addAttrs opts attr $ tag' contents
     return $ do
-      headElement
+      tablePartElement
       nl opts
   where
     isEmptyRow (Ann.HeaderRow _attr _rownum cells) = all isEmptyCell cells
     isEmptyCell (Ann.Cell _colspecs _colnum cell) =
       cell == Cell nullAttr AlignDefault (RowSpan 1) (ColSpan 1) []
 
-
-data RowType = HeaderRow | FooterRow | BodyRow
+-- | The part of a table; header, footer, or body.
+data TablePart = Thead | Tfoot | Tbody
   deriving (Eq)
 
 data CellType = HeaderCell | BodyCell
 
-data TableRow = TableRow RowType Attr Ann.RowNumber Ann.RowHead Ann.RowBody
+data TableRow = TableRow TablePart Attr Ann.RowNumber Ann.RowHead Ann.RowBody
 
 headerRowsToHtml :: PandocMonad m
-              => WriterOptions
-              -> [Ann.HeaderRow]
-              -> StateT WriterState m Html
-headerRowsToHtml opts =
+                 => WriterOptions
+                 -> TablePart
+                 -> [Ann.HeaderRow]
+                 -> StateT WriterState m Html
+headerRowsToHtml opts tablepart =
   rowListToHtml opts . map toTableRow
   where
     toTableRow (Ann.HeaderRow attr rownum rowbody) =
-      TableRow HeaderRow attr rownum [] rowbody
+      TableRow tablepart attr rownum [] rowbody
 
 bodyRowsToHtml :: PandocMonad m
                => WriterOptions
@@ -990,7 +1017,7 @@ bodyRowsToHtml opts =
   rowListToHtml opts . zipWith toTableRow [1..]
   where
     toTableRow rownum (Ann.BodyRow attr _rownum rowhead rowbody) =
-      TableRow BodyRow attr rownum rowhead rowbody
+      TableRow Tbody attr rownum rowhead rowbody
 
 
 rowListToHtml :: PandocMonad m
@@ -1034,14 +1061,14 @@ tableRowToHtml :: PandocMonad m
                => WriterOptions
                -> TableRow
                -> StateT WriterState m Html
-tableRowToHtml opts (TableRow rowtype _attr rownum rowhead rowbody) = do
+tableRowToHtml opts (TableRow tblpart _attr rownum rowhead rowbody) = do
   let rowclass = A.class_ $ case rownum of
-        Ann.RowNumber x | x `rem` 2 == 1       -> "odd"
-        _               | rowtype /= HeaderRow -> "even"
-        _                                      -> "header"
-  let celltype = case rowtype of
-        HeaderRow -> HeaderCell
-        _         -> BodyCell
+        Ann.RowNumber x | x `rem` 2 == 1   -> "odd"
+        _               | tblpart /= Thead -> "even"
+        _                                  -> "header"
+  let celltype = case tblpart of
+                   Thead -> HeaderCell
+                   _     -> BodyCell
   head' <- mapM (cellToHtml opts HeaderCell) rowhead
   body <- mapM (cellToHtml opts celltype) rowbody
   return $ do

diff --git a/test/Tests/Old.hs b/test/Tests/Old.hs
@@ -267,12 +267,13 @@ writerTests pandocPath format
 extendedWriterTests :: FilePath -> String -> [TestTree]
 extendedWriterTests pandocPath format
   = writerTests pandocPath format ++
-    [ test pandocPath
-           "tables"
-           opts
-           ("tables" </> "planets.native")
-           ("tables" </> "planets" <.> format)
-    ]
+    let testForTable name =
+          test pandocPath
+               (name ++ " table")
+               opts
+               ("tables" </> name <.> "native")
+               ("tables" </> name <.> format)
+    in map testForTable ["planets", "nordics"]
   where
     opts = ["-r", "native", "-w", format, "--columns=78",
             "--variable", "pandoc-version="]

diff --git a/test/tables/nordics.html4 b/test/tables/nordics.html4
@@ -0,0 +1,59 @@
+<table>
+<caption><p>States belonging to the <em>Nordics.</em></p></caption>
+<colgroup>
+<col width="30%" />
+<col width="30%" />
+<col width="20%" />
+<col width="20%" />
+</colgroup>
+<thead>
+<tr class="header">
+<th align="center">Name</th>
+<th align="center">Capital</th>
+<th align="center">Population<br />
+(in 2018)</th>
+<th align="center">Area<br />
+(in km<sup>2</sup>)</th>
+</tr>
+</thead>
+<tbody>
+<tr class="odd">
+<th align="center">Denmark</th>
+<td align="left">Copenhagen</td>
+<td align="left">5,809,502</td>
+<td align="left">43,094</td>
+</tr>
+<tr class="even">
+<th align="center">Finland</th>
+<td align="left">Helsinki</td>
+<td align="left">5,537,364</td>
+<td align="left">338,145</td>
+</tr>
+<tr class="odd">
+<th align="center">Iceland</th>
+<td align="left">Reykjavik</td>
+<td align="left">343,518</td>
+<td align="left">103,000</td>
+</tr>
+<tr class="even">
+<th align="center">Norway</th>
+<td align="left">Oslo</td>
+<td align="left">5,372,191</td>
+<td align="left">323,802</td>
+</tr>
+<tr class="odd">
+<th align="center">Sweden</th>
+<td align="left">Stockholm</td>
+<td align="left">10,313,447</td>
+<td align="left">450,295</td>
+</tr>
+</tbody><tfoot>
+<tr class="even">
+<td align="center">Total</td>
+<td align="left"></td>
+<td align="left">27,376,022</td>
+<td align="left">1,258,336</td>
+</tr>
+</tfoot>
+
+</table>
diff --git a/test/tables/nordics.html5 b/test/tables/nordics.html5
@@ -0,0 +1,59 @@
+<table>
+<caption><p>States belonging to the <em>Nordics.</em></p></caption>
+<colgroup>
+<col style="width: 30%" />
+<col style="width: 30%" />
+<col style="width: 20%" />
+<col style="width: 20%" />
+</colgroup>
+<thead>
+<tr class="header">
+<th style="text-align: center;">Name</th>
+<th style="text-align: center;">Capital</th>
+<th style="text-align: center;">Population<br />
+(in 2018)</th>
+<th style="text-align: center;">Area<br />
+(in km<sup>2</sup>)</th>
+</tr>
+</thead>
+<tbody>
+<tr class="odd">
+<th style="text-align: center;">Denmark</th>
+<td style="text-align: left;">Copenhagen</td>
+<td style="text-align: left;">5,809,502</td>
+<td style="text-align: left;">43,094</td>
+</tr>
+<tr class="even">
+<th style="text-align: center;">Finland</th>
+<td style="text-align: left;">Helsinki</td>
+<td style="text-align: left;">5,537,364</td>
+<td style="text-align: left;">338,145</td>
+</tr>
+<tr class="odd">
+<th style="text-align: center;">Iceland</th>
+<td style="text-align: left;">Reykjavik</td>
+<td style="text-align: left;">343,518</td>
+<td style="text-align: left;">103,000</td>
+</tr>
+<tr class="even">
+<th style="text-align: center;">Norway</th>
+<td style="text-align: left;">Oslo</td>
+<td style="text-align: left;">5,372,191</td>
+<td style="text-align: left;">323,802</td>
+</tr>
+<tr class="odd">
+<th style="text-align: center;">Sweden</th>
+<td style="text-align: left;">Stockholm</td>
+<td style="text-align: left;">10,313,447</td>
+<td style="text-align: left;">450,295</td>
+</tr>
+</tbody><tfoot>
+<tr class="even">
+<td style="text-align: center;">Total</td>
+<td style="text-align: left;"></td>
+<td style="text-align: left;">27,376,022</td>
+<td style="text-align: left;">1,258,336</td>
+</tr>
+</tfoot>
+
+</table>
diff --git a/test/tables/nordics.native b/test/tables/nordics.native
@@ -0,0 +1,46 @@
+[Table ("",[],[]) (Caption (Just [Str "Nordic countries"])
+ [Para [Str "States", Space, Str "belonging", Space, Str "to", Space, Str "the", Space, Emph [Str "Nordics."]]])
+ [(AlignCenter,ColWidth 0.3)
+ ,(AlignLeft,ColWidth 0.3)
+ ,(AlignLeft,ColWidth 0.2)
+ ,(AlignLeft,ColWidth 0.2)]
+ (TableHead ("",[],[])
+  [Row ("",[],[])
+   [Cell ("",[],[]) AlignCenter (RowSpan 1) (ColSpan 1) [Plain [Str "Name"]]
+   ,Cell ("",[],[]) AlignCenter (RowSpan 1) (ColSpan 1) [Plain [Str "Capital"]]
+   ,Cell ("",[],[]) AlignCenter (RowSpan 1) (ColSpan 1) [Plain [Str "Population", LineBreak, Str "(in", Space, Str "2018)"]]
+   ,Cell ("",[],[]) AlignCenter (RowSpan 1) (ColSpan 1) [Plain [Str "Area", LineBreak, Str "(in", Space, Str "km", Superscript [Str "2"], Str ")"]]]])
+ [(TableBody ("",[],[]) (RowHeadColumns 1)
+  []
+  [Row ("",[],[])
+   [Cell ("",[],[]) AlignDefault (RowSpan 1) (ColSpan 1) [Plain [Str "Denmark"]]
+   ,Cell ("",[],[]) AlignDefault (RowSpan 1) (ColSpan 1) [Plain [Str "Copenhagen"]]
+   ,Cell ("",[],[]) AlignDefault (RowSpan 1) (ColSpan 1) [Plain [Str "5,809,502"]]
+   ,Cell ("",[],[]) AlignDefault (RowSpan 1) (ColSpan 1) [Plain [Str "43,094"]]]
+  ,Row ("",[],[])
+   [Cell ("",[],[]) AlignDefault (RowSpan 1) (ColSpan 1) [Plain [Str "Finland"]]
+   ,Cell ("",[],[]) AlignDefault (RowSpan 1) (ColSpan 1) [Plain [Str "Helsinki"]]
+   ,Cell ("",[],[]) AlignDefault (RowSpan 1) (ColSpan 1) [Plain [Str "5,537,364"]]
+   ,Cell ("",[],[]) AlignDefault (RowSpan 1) (ColSpan 1) [Plain [Str "338,145"]]]
+  ,Row ("",[],[])
+   [Cell ("",[],[]) AlignDefault (RowSpan 1) (ColSpan 1) [Plain [Str "Iceland"]]
+   ,Cell ("",[],[]) AlignDefault (RowSpan 1) (ColSpan 1) [Plain [Str "Reykjavik"]]
+   ,Cell ("",[],[]) AlignDefault (RowSpan 1) (ColSpan 1) [Plain [Str "343,518"]]
+   ,Cell ("",[],[]) AlignDefault (RowSpan 1) (ColSpan 1) [Plain [Str "103,000"]]]
+  ,Row ("",[],[])
+   [Cell ("",[],[]) AlignDefault (RowSpan 1) (ColSpan 1) [Plain [Str "Norway"]]
+   ,Cell ("",[],[]) AlignDefault (RowSpan 1) (ColSpan 1) [Plain [Str "Oslo"]]
+   ,Cell ("",[],[]) AlignDefault (RowSpan 1) (ColSpan 1) [Plain [Str "5,372,191"]]
+   ,Cell ("",[],[]) AlignDefault (RowSpan 1) (ColSpan 1) [Plain [Str "323,802"]]]
+  ,Row ("",[],[])
+   [Cell ("",[],[]) AlignDefault (RowSpan 1) (ColSpan 1) [Plain [Str "Sweden"]]
+   ,Cell ("",[],[]) AlignDefault (RowSpan 1) (ColSpan 1) [Plain [Str "Stockholm"]]
+   ,Cell ("",[],[]) AlignDefault (RowSpan 1) (ColSpan 1) [Plain [Str "10,313,447"]]
+   ,Cell ("",[],[]) AlignDefault (RowSpan 1) (ColSpan 1) [Plain [Str "450,295"]]]])]
+ (TableFoot ("",[],[])
+  [Row ("",[],[])
+   [Cell ("",[],[]) AlignDefault (RowSpan 1) (ColSpan 1) [Plain [Str "Total"]]
+   ,Cell ("",[],[]) AlignDefault (RowSpan 1) (ColSpan 1) []
+   ,Cell ("",[],[]) AlignDefault (RowSpan 1) (ColSpan 1) [Plain [Str "27,376,022"]]
+   ,Cell ("",[],[]) AlignDefault (RowSpan 1) (ColSpan 1) [Plain [Str "1,258,336"]]]])
+]