aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/Text/Pandoc/Writers/HTML.hs73
1 files changed, 50 insertions, 23 deletions
diff --git a/src/Text/Pandoc/Writers/HTML.hs b/src/Text/Pandoc/Writers/HTML.hs
index 4fd671da8..6bb708c37 100644
--- 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