From 4e34d366df31937cdc69b6b366355f10a84c16b2 Mon Sep 17 00:00:00 2001
From: despresc <christian.j.j.despres@gmail.com>
Date: Sat, 4 Apr 2020 16:35:42 -0400
Subject: Adapt to the newest Table type, fix some previous adaptation issues
- Writers.Native is now adapted to the new Table type.
- Inline captions should now be conditionally wrapped in a Plain, not
a Para block.
- The toLegacyTable function now lives in Writers.Shared.
---
src/Text/Pandoc/Lua/Marshaling/AST.hs | 21 ++++++-----
src/Text/Pandoc/Lua/Walk.hs | 24 +++++++++++++
src/Text/Pandoc/Parsing.hs | 4 +--
src/Text/Pandoc/Readers/CSV.hs | 2 +-
src/Text/Pandoc/Readers/CommonMark.hs | 12 +++++--
src/Text/Pandoc/Readers/DocBook.hs | 6 ++--
src/Text/Pandoc/Readers/Docx.hs | 2 +-
src/Text/Pandoc/Readers/DokuWiki.hs | 2 +-
src/Text/Pandoc/Readers/HTML.hs | 12 +++----
src/Text/Pandoc/Readers/Haddock.hs | 2 +-
src/Text/Pandoc/Readers/JATS.hs | 6 ++--
src/Text/Pandoc/Readers/LaTeX.hs | 20 +++++------
src/Text/Pandoc/Readers/Man.hs | 5 ++-
src/Text/Pandoc/Readers/Markdown.hs | 4 +--
src/Text/Pandoc/Readers/MediaWiki.hs | 6 ++--
src/Text/Pandoc/Readers/Muse.hs | 4 +--
src/Text/Pandoc/Readers/Odt/ContentReader.hs | 4 +--
src/Text/Pandoc/Readers/Org/Blocks.hs | 4 +--
src/Text/Pandoc/Readers/RST.hs | 41 ++++++++++------------
src/Text/Pandoc/Readers/TWiki.hs | 10 +++---
src/Text/Pandoc/Readers/Textile.hs | 2 +-
src/Text/Pandoc/Readers/Txt2Tags.hs | 2 +-
src/Text/Pandoc/Shared.hs | 31 +++-------------
src/Text/Pandoc/Writers/AsciiDoc.hs | 2 +-
src/Text/Pandoc/Writers/CommonMark.hs | 4 +--
src/Text/Pandoc/Writers/ConTeXt.hs | 2 +-
src/Text/Pandoc/Writers/Custom.hs | 3 +-
src/Text/Pandoc/Writers/Docbook.hs | 2 +-
src/Text/Pandoc/Writers/Docx.hs | 2 +-
src/Text/Pandoc/Writers/DokuWiki.hs | 6 ++--
src/Text/Pandoc/Writers/FB2.hs | 6 ++--
src/Text/Pandoc/Writers/HTML.hs | 2 +-
src/Text/Pandoc/Writers/Haddock.hs | 2 +-
src/Text/Pandoc/Writers/ICML.hs | 2 +-
src/Text/Pandoc/Writers/JATS.hs | 2 +-
src/Text/Pandoc/Writers/Jira.hs | 6 ++--
src/Text/Pandoc/Writers/LaTeX.hs | 2 +-
src/Text/Pandoc/Writers/Man.hs | 2 +-
src/Text/Pandoc/Writers/Markdown.hs | 2 +-
src/Text/Pandoc/Writers/MediaWiki.hs | 2 +-
src/Text/Pandoc/Writers/Ms.hs | 2 +-
src/Text/Pandoc/Writers/Muse.hs | 2 +-
src/Text/Pandoc/Writers/Native.hs | 35 +++++++++++-------
src/Text/Pandoc/Writers/OpenDocument.hs | 4 +--
src/Text/Pandoc/Writers/Org.hs | 2 +-
src/Text/Pandoc/Writers/Powerpoint/Presentation.hs | 7 ++--
src/Text/Pandoc/Writers/RST.hs | 2 +-
src/Text/Pandoc/Writers/RTF.hs | 2 +-
src/Text/Pandoc/Writers/Shared.hs | 32 ++++++++++++++++-
src/Text/Pandoc/Writers/TEI.hs | 2 +-
src/Text/Pandoc/Writers/Texinfo.hs | 2 +-
src/Text/Pandoc/Writers/Textile.hs | 2 +-
src/Text/Pandoc/Writers/XWiki.hs | 3 +-
src/Text/Pandoc/Writers/ZimWiki.hs | 6 ++--
54 files changed, 210 insertions(+), 168 deletions(-)
(limited to 'src')
diff --git a/src/Text/Pandoc/Lua/Marshaling/AST.hs b/src/Text/Pandoc/Lua/Marshaling/AST.hs
index db9f097ef..f314649f0 100644
--- a/src/Text/Pandoc/Lua/Marshaling/AST.hs
+++ b/src/Text/Pandoc/Lua/Marshaling/AST.hs
@@ -21,7 +21,7 @@ import Foreign.Lua (Lua, Peekable, Pushable, StackIndex)
import Text.Pandoc.Definition
import Text.Pandoc.Lua.Util (defineHowTo, pushViaConstructor)
import Text.Pandoc.Lua.Marshaling.CommonState ()
-import Text.Pandoc.Shared (toLegacyTable)
+import Text.Pandoc.Writers.Shared (toLegacyTable)
import qualified Foreign.Lua as Lua
import qualified Text.Pandoc.Lua.Util as LuaUtil
@@ -168,7 +168,7 @@ pushBlock = \case
Para blcks -> pushViaConstructor "Para" blcks
Plain blcks -> pushViaConstructor "Plain" blcks
RawBlock f cs -> pushViaConstructor "RawBlock" f cs
- Table _ blkCapt specs _ thead tbody tfoot ->
+ Table _ blkCapt specs thead tbody tfoot ->
let (capt, aligns, widths, headers, rows) = toLegacyTable blkCapt specs thead tbody tfoot
in pushViaConstructor "Table" capt aligns widths headers rows
@@ -195,12 +195,11 @@ peekBlock idx = defineHowTo "get Block value" $ do
"RawBlock" -> uncurry RawBlock <$> elementContent
"Table" -> (\(capt, aligns, widths, headers, body) ->
Table nullAttr
- (Caption Nothing $ maybePara capt)
+ (Caption Nothing $ maybePlain capt)
(zip aligns (map strictPos widths))
- 0
- [toRow headers]
- (map toRow body)
- [])
+ (TableHead nullAttr [toRow headers])
+ [TableBody nullAttr 0 [] (map toRow body)]
+ (TableFoot nullAttr []))
<$> elementContent
_ -> Lua.throwException ("Unknown block type: " <> tag)
where
@@ -208,10 +207,10 @@ peekBlock idx = defineHowTo "get Block value" $ do
elementContent :: Peekable a => Lua a
elementContent = LuaUtil.rawField idx "c"
- strictPos w = if w > 0 then Just w else Nothing
- maybePara [] = []
- maybePara x = [Para x]
- toRow = Row nullAttr . map (\blk -> Cell nullAttr Nothing 1 1 blk)
+ strictPos w = if w > 0 then ColWidth w else ColWidthDefault
+ maybePlain [] = []
+ maybePlain x = [Plain x]
+ toRow = Row nullAttr . map (\blk -> Cell nullAttr AlignDefault 1 1 blk)
-- | Push an inline element to the top of the lua stack.
pushInline :: Inline -> Lua ()
diff --git a/src/Text/Pandoc/Lua/Walk.hs b/src/Text/Pandoc/Lua/Walk.hs
index 5b62001de..695c7b44e 100644
--- a/src/Text/Pandoc/Lua/Walk.hs
+++ b/src/Text/Pandoc/Lua/Walk.hs
@@ -59,6 +59,18 @@ instance Walkable (SingletonsList Inline) Row where
walkM = walkRowM
query = queryRow
+instance Walkable (SingletonsList Inline) TableHead where
+ walkM = walkTableHeadM
+ query = queryTableHead
+
+instance Walkable (SingletonsList Inline) TableBody where
+ walkM = walkTableBodyM
+ query = queryTableBody
+
+instance Walkable (SingletonsList Inline) TableFoot where
+ walkM = walkTableFootM
+ query = queryTableFoot
+
instance Walkable (SingletonsList Inline) Caption where
walkM = walkCaptionM
query = queryCaption
@@ -102,6 +114,18 @@ instance Walkable (SingletonsList Block) Row where
walkM = walkRowM
query = queryRow
+instance Walkable (SingletonsList Block) TableHead where
+ walkM = walkTableHeadM
+ query = queryTableHead
+
+instance Walkable (SingletonsList Block) TableBody where
+ walkM = walkTableBodyM
+ query = queryTableBody
+
+instance Walkable (SingletonsList Block) TableFoot where
+ walkM = walkTableFootM
+ query = queryTableFoot
+
instance Walkable (SingletonsList Block) Caption where
walkM = walkCaptionM
query = queryCaption
diff --git a/src/Text/Pandoc/Parsing.hs b/src/Text/Pandoc/Parsing.hs
index aa961e814..f17a9af1d 100644
--- a/src/Text/Pandoc/Parsing.hs
+++ b/src/Text/Pandoc/Parsing.hs
@@ -928,8 +928,8 @@ tableWith headerParser rowParser lineParser footerParser = try $ do
return $ B.table mempty (zip aligns (map fromWidth widths)) <$> heads <*> rows
where
fromWidth n
- | n > 0 = Just n
- | otherwise = Nothing
+ | n > 0 = ColWidth n
+ | otherwise = ColWidthDefault
type TableComponents mf = ([Alignment], [Double], mf [Blocks], mf [[Blocks]])
diff --git a/src/Text/Pandoc/Readers/CSV.hs b/src/Text/Pandoc/Readers/CSV.hs
index 8608a1a2c..a1272d47f 100644
--- a/src/Text/Pandoc/Readers/CSV.hs
+++ b/src/Text/Pandoc/Readers/CSV.hs
@@ -37,6 +37,6 @@ readCSV _opts s =
hdrs = map toplain r
rows = map (map toplain) rs
aligns = replicate numcols AlignDefault
- widths = replicate numcols Nothing
+ widths = replicate numcols ColWidthDefault
Right [] -> return $ B.doc mempty
Left e -> throwError $ PandocParsecError s e
diff --git a/src/Text/Pandoc/Readers/CommonMark.hs b/src/Text/Pandoc/Readers/CommonMark.hs
index 33afbe59f..d1f732bf1 100644
--- a/src/Text/Pandoc/Readers/CommonMark.hs
+++ b/src/Text/Pandoc/Readers/CommonMark.hs
@@ -111,13 +111,19 @@ addBlock opts (Node _ (LIST listAttrs) nodes) =
PAREN_DELIM -> OneParen
exts = readerExtensions opts
addBlock opts (Node _ (TABLE alignments) nodes) =
- (Table nullAttr (Caption Nothing []) (zip aligns widths) 0 headers rows [] :)
+ (Table
+ nullAttr
+ (Caption Nothing [])
+ (zip aligns widths)
+ (TableHead nullAttr headers)
+ [TableBody nullAttr 0 [] rows]
+ (TableFoot nullAttr []) :)
where aligns = map fromTableCellAlignment alignments
fromTableCellAlignment NoAlignment = AlignDefault
fromTableCellAlignment LeftAligned = AlignLeft
fromTableCellAlignment RightAligned = AlignRight
fromTableCellAlignment CenterAligned = AlignCenter
- widths = replicate numcols Nothing
+ widths = replicate numcols ColWidthDefault
numcols = if null rows'
then 0
else maximum $ map rowLength rows'
@@ -136,7 +142,7 @@ addBlock opts (Node _ (TABLE alignments) nodes) =
| isBlockNode n = fromSimpleCell $ addBlocks opts (n:ns)
| otherwise = fromSimpleCell [Plain (addInlines opts (n:ns))]
toCell (Node _ t _) = error $ "toCell encountered non-cell " ++ show t
- fromSimpleCell = Cell nullAttr Nothing 1 1
+ fromSimpleCell = Cell nullAttr AlignDefault 1 1
rowLength (Row _ body) = length body -- all cells are 1×1
addBlock _ (Node _ TABLE_ROW _) = id -- handled in TABLE
addBlock _ (Node _ TABLE_CELL _) = id -- handled in TABLE
diff --git a/src/Text/Pandoc/Readers/DocBook.hs b/src/Text/Pandoc/Readers/DocBook.hs
index 6c56c1bd7..4001d647e 100644
--- a/src/Text/Pandoc/Readers/DocBook.hs
+++ b/src/Text/Pandoc/Readers/DocBook.hs
@@ -881,12 +881,12 @@ parseBlock (Elem e) =
[] -> replicate numrows AlignDefault
cs -> map toAlignment cs
let widths = case colspecs of
- [] -> replicate numrows Nothing
+ [] -> replicate numrows ColWidthDefault
cs -> let ws = map toWidth cs
in case sequence ws of
Just ws' -> let tot = sum ws'
- in Just . (/ tot) <$> ws'
- Nothing -> replicate numrows Nothing
+ in ColWidth . (/ tot) <$> ws'
+ Nothing -> replicate numrows ColWidthDefault
let headrows' = if null headrows
then replicate numrows mempty
else headrows
diff --git a/src/Text/Pandoc/Readers/Docx.hs b/src/Text/Pandoc/Readers/Docx.hs
index a5e8cb463..69aa18f73 100644
--- a/src/Text/Pandoc/Readers/Docx.hs
+++ b/src/Text/Pandoc/Readers/Docx.hs
@@ -676,7 +676,7 @@ bodyPartToBlocks (Tbl cap _ look parts@(r:rs)) = do
-- so should be possible. Alignment might be more difficult,
-- since there doesn't seem to be a column entity in docx.
let alignments = replicate width AlignDefault
- widths = replicate width Nothing
+ widths = replicate width ColWidthDefault
return $ table cap' (zip alignments widths) hdrCells cells'
bodyPartToBlocks (OMathPara e) =
diff --git a/src/Text/Pandoc/Readers/DokuWiki.hs b/src/Text/Pandoc/Readers/DokuWiki.hs
index 296c751a2..ee26eed84 100644
--- a/src/Text/Pandoc/Readers/DokuWiki.hs
+++ b/src/Text/Pandoc/Readers/DokuWiki.hs
@@ -470,7 +470,7 @@ table = do
let (headerRow, body) = if firstSeparator == '^'
then (head rows, tail rows)
else ([], rows)
- let attrs = (AlignDefault, Nothing) <$ transpose rows
+ let attrs = (AlignDefault, ColWidthDefault) <$ transpose rows
pure $ B.table mempty attrs headerRow body
tableRows :: PandocMonad m => DWParser m [[B.Blocks]]
diff --git a/src/Text/Pandoc/Readers/HTML.hs b/src/Text/Pandoc/Readers/HTML.hs
index 8de9ebc19..30b812913 100644
--- a/src/Text/Pandoc/Readers/HTML.hs
+++ b/src/Text/Pandoc/Readers/HTML.hs
@@ -513,12 +513,12 @@ pTable = try $ do
_ -> replicate cols AlignDefault
let widths = if null widths'
then if isSimple
- then replicate cols Nothing
- else replicate cols (Just (1.0 / fromIntegral cols))
+ then replicate cols ColWidthDefault
+ else replicate cols (ColWidth (1.0 / fromIntegral cols))
else widths'
return $ B.table caption (zip aligns widths) head' rows
-pCol :: PandocMonad m => TagParser m (Maybe Double)
+pCol :: PandocMonad m => TagParser m ColWidth
pCol = try $ do
TagOpen _ attribs' <- pSatisfy (matchTagOpen "col" [])
let attribs = toStringAttr attribs'
@@ -535,10 +535,10 @@ pCol = try $ do
fromMaybe 0.0 $ safeRead xs
_ -> 0.0
if width > 0.0
- then return $ Just $ width / 100.0
- else return Nothing
+ then return $ ColWidth $ width / 100.0
+ else return ColWidthDefault
-pColgroup :: PandocMonad m => TagParser m [Maybe Double]
+pColgroup :: PandocMonad m => TagParser m [ColWidth]
pColgroup = try $ do
pSatisfy (matchTagOpen "colgroup" [])
skipMany pBlank
diff --git a/src/Text/Pandoc/Readers/Haddock.hs b/src/Text/Pandoc/Readers/Haddock.hs
index 7303f9c32..5bef6f9fd 100644
--- a/src/Text/Pandoc/Readers/Haddock.hs
+++ b/src/Text/Pandoc/Readers/Haddock.hs
@@ -91,7 +91,7 @@ docHToBlocks d' =
else (toCells (head headerRows),
map toCells (tail headerRows ++ bodyRows))
colspecs = replicate (maximum (map length body))
- (AlignDefault, Nothing)
+ (AlignDefault, ColWidthDefault)
in B.table mempty colspecs header body
where inlineFallback = B.plain $ docHToInlines False d'
diff --git a/src/Text/Pandoc/Readers/JATS.hs b/src/Text/Pandoc/Readers/JATS.hs
index 3dfe9161b..24d2ef4a1 100644
--- a/src/Text/Pandoc/Readers/JATS.hs
+++ b/src/Text/Pandoc/Readers/JATS.hs
@@ -274,12 +274,12 @@ parseBlock (Elem e) =
[] -> replicate numrows AlignDefault
cs -> map toAlignment cs
let widths = case colspecs of
- [] -> replicate numrows Nothing
+ [] -> replicate numrows ColWidthDefault
cs -> let ws = map toWidth cs
in case sequence ws of
Just ws' -> let tot = sum ws'
- in Just . (/ tot) <$> ws'
- Nothing -> replicate numrows Nothing
+ in ColWidth . (/ tot) <$> ws'
+ Nothing -> replicate numrows ColWidthDefault
let headrows' = if null headrows
then replicate numrows mempty
else headrows
diff --git a/src/Text/Pandoc/Readers/LaTeX.hs b/src/Text/Pandoc/Readers/LaTeX.hs
index 4b09f1402..ea5549543 100644
--- a/src/Text/Pandoc/Readers/LaTeX.hs
+++ b/src/Text/Pandoc/Readers/LaTeX.hs
@@ -2268,7 +2268,7 @@ splitWordTok = do
setInput $ map (Tok spos Symbol . T.singleton) (T.unpack t) <> rest
_ -> return ()
-parseAligns :: PandocMonad m => LP m [(Alignment, Maybe Double, ([Tok], [Tok]))]
+parseAligns :: PandocMonad m => LP m [(Alignment, ColWidth, ([Tok], [Tok]))]
parseAligns = try $ do
let maybeBar = skipMany
(try $ sp *> (() <$ symbol '|' <|> () <$ (symbol '@' >> braced)))
@@ -2319,7 +2319,11 @@ parseAligns = try $ do
spaces
egroup
spaces
- return aligns'
+ return $ map toSpec aligns'
+ where
+ toColWidth (Just w) | w > 0 = ColWidth w
+ toColWidth _ = ColWidthDefault
+ toSpec (x, y, z) = (x, toColWidth y, z)
parseTableRow :: PandocMonad m
=> Text -- ^ table environment name
@@ -2397,11 +2401,11 @@ simpTable envname hasWidthParameter = try $ do
addTableCaption :: PandocMonad m => Blocks -> LP m Blocks
addTableCaption = walkM go
- where go (Table attr c spec rhs th tb tf) = do
+ where go (Table attr c spec th tb tf) = do
st <- getState
let mblabel = sLastLabel st
capt <- case (sCaption st, mblabel) of
- (Just ils, Nothing) -> return $ Caption Nothing (mcap ils)
+ (Just ils, Nothing) -> return $ caption Nothing (plain ils)
(Just ils, Just lab) -> do
num <- getNextNumber sLastTableNum
setState
@@ -2409,15 +2413,11 @@ addTableCaption = walkM go
, sLabels = M.insert lab
[Str (renderDottedNum num)]
(sLabels st) }
- return $ Caption Nothing (mcap ils) -- add number??
+ return $ caption Nothing (plain ils) -- add number??
(Nothing, _) -> return c
return $ maybe id (\ident -> Div (ident, [], []) . (:[])) mblabel $
- Table attr capt spec rhs th tb tf
+ Table attr capt spec th tb tf
go x = return x
- mcap ils
- | isNull ils = []
- | otherwise = [Para $ toList ils]
-
block :: PandocMonad m => LP m Blocks
block = do
diff --git a/src/Text/Pandoc/Readers/Man.hs b/src/Text/Pandoc/Readers/Man.hs
index 50dbb5992..e175135da 100644
--- a/src/Text/Pandoc/Readers/Man.hs
+++ b/src/Text/Pandoc/Readers/Man.hs
@@ -107,9 +107,8 @@ parseTable = do
bodyRows <- mapM (mapM parseTableCell . snd) bodyRows'
isPlainTable <- tableCellsPlain <$> getState
let widths = if isPlainTable
- then repeat Nothing
- else repeat (Just (1.0 / fromIntegral (length alignments))
- :: Maybe Double)
+ then repeat ColWidthDefault
+ else repeat $ ColWidth (1.0 / fromIntegral (length alignments))
return $ B.table mempty (zip alignments widths)
headerRow bodyRows) <|> fallback pos
[] -> fallback pos
diff --git a/src/Text/Pandoc/Readers/Markdown.hs b/src/Text/Pandoc/Readers/Markdown.hs
index 54d2752c7..222c227e2 100644
--- a/src/Text/Pandoc/Readers/Markdown.hs
+++ b/src/Text/Pandoc/Readers/Markdown.hs
@@ -1418,8 +1418,8 @@ table = try $ do
then widths
else map (/ totalWidth) widths
let strictPos w
- | w > 0 = Just w
- | otherwise = Nothing
+ | w > 0 = ColWidth w
+ | otherwise = ColWidthDefault
return $ do
caption' <- caption
heads' <- heads
diff --git a/src/Text/Pandoc/Readers/MediaWiki.hs b/src/Text/Pandoc/Readers/MediaWiki.hs
index 5e9aecc49..0396c95de 100644
--- a/src/Text/Pandoc/Readers/MediaWiki.hs
+++ b/src/Text/Pandoc/Readers/MediaWiki.hs
@@ -221,9 +221,9 @@ table = do
let restwidth = tableWidth - sum widths
let zerocols = length $ filter (==0.0) widths
let defaultwidth = if zerocols == 0 || zerocols == length widths
- then Nothing
- else Just $ restwidth / fromIntegral zerocols
- let widths' = map (\w -> if w == 0 then defaultwidth else Just w) widths
+ then ColWidthDefault
+ else ColWidth $ restwidth / fromIntegral zerocols
+ let widths' = map (\w -> if w > 0 then ColWidth w else defaultwidth) widths
let cellspecs = zip (map fst cellspecs') widths'
rows' <- many $ try $ rowsep *> (map snd <$> tableRow)
optional blanklines
diff --git a/src/Text/Pandoc/Readers/Muse.hs b/src/Text/Pandoc/Readers/Muse.hs
index 1cabfa112..34a9a7367 100644
--- a/src/Text/Pandoc/Readers/Muse.hs
+++ b/src/Text/Pandoc/Readers/Muse.hs
@@ -646,7 +646,7 @@ data MuseTableElement = MuseHeaderRow [Blocks]
museToPandocTable :: MuseTable -> Blocks
museToPandocTable (MuseTable caption headers body footers) =
B.table caption attrs headRow (rows ++ body ++ footers)
- where attrs = (AlignDefault, Nothing) <$ transpose (headers ++ body ++ footers)
+ where attrs = (AlignDefault, ColWidthDefault) <$ transpose (headers ++ body ++ footers)
(headRow, rows) = fromMaybe ([], []) $ uncons headers
museAppendElement :: MuseTableElement
@@ -694,7 +694,7 @@ museGridTable = try $ do
indices <- museGridTableHeader
fmap rowsToTable . sequence <$> many1 (museGridTableRow indent indices)
where rowsToTable rows = B.table mempty attrs [] rows
- where attrs = (AlignDefault, Nothing) <$ transpose rows
+ where attrs = (AlignDefault, ColWidthDefault) <$ transpose rows
-- | Parse a table.
table :: PandocMonad m => MuseParser m (F Blocks)
diff --git a/src/Text/Pandoc/Readers/Odt/ContentReader.hs b/src/Text/Pandoc/Readers/Odt/ContentReader.hs
index 2afd8a66d..cbf7236d0 100644
--- a/src/Text/Pandoc/Readers/Odt/ContentReader.hs
+++ b/src/Text/Pandoc/Readers/Odt/ContentReader.hs
@@ -921,8 +921,8 @@ post_process (Pandoc m blocks) =
Pandoc m (post_process' blocks)
post_process' :: [Block] -> [Block]
-post_process' (Table attr _ specs rhs th tb tf : Div ("", ["caption"], _) blks : xs)
- = Table attr (Caption Nothing blks) specs rhs th tb tf : post_process' xs
+post_process' (Table attr _ specs th tb tf : Div ("", ["caption"], _) blks : xs)
+ = Table attr (Caption Nothing blks) specs th tb tf : post_process' xs
post_process' bs = bs
read_body :: OdtReader _x (Pandoc, MediaBag)
diff --git a/src/Text/Pandoc/Readers/Org/Blocks.hs b/src/Text/Pandoc/Readers/Org/Blocks.hs
index aef6ae210..5dbaa2a17 100644
--- a/src/Text/Pandoc/Readers/Org/Blocks.hs
+++ b/src/Text/Pandoc/Readers/Org/Blocks.hs
@@ -629,14 +629,14 @@ orgToPandocTable (OrgTable colProps heads lns) caption =
else Nothing
in B.table caption (map (convertColProp totalWidth) colProps) heads lns
where
- convertColProp :: Maybe Int -> ColumnProperty -> (Alignment, Maybe Double)
+ convertColProp :: Maybe Int -> ColumnProperty -> (Alignment, ColWidth)
convertColProp totalWidth colProp =
let
align' = fromMaybe AlignDefault $ columnAlignment colProp
width' = (\w t -> (fromIntegral w / fromIntegral t))
<$> columnRelWidth colProp
<*> totalWidth
- in (align', width')
+ in (align', maybe ColWidthDefault ColWidth width')
tableRows :: PandocMonad m => OrgParser m [OrgTableRow]
tableRows = try $ many (tableAlignRow <|> tableHline <|> tableContentRow)
diff --git a/src/Text/Pandoc/Readers/RST.hs b/src/Text/Pandoc/Readers/RST.hs
index 5db303d4d..0dadd5120 100644
--- a/src/Text/Pandoc/Readers/RST.hs
+++ b/src/Text/Pandoc/Readers/RST.hs
@@ -770,17 +770,17 @@ tableDirective :: PandocMonad m
tableDirective top fields body = do
bs <- parseFromString' parseBlocks body
case B.toList bs of
- [Table attr _ tspecs' rhs thead tbody tfoot] -> do
+ [Table attr _ tspecs' thead@(TableHead _ thrs) tbody tfoot] -> do
let (aligns', widths') = unzip tspecs'
title <- parseFromString' (trimInlines . mconcat <$> many inline) top
columns <- getOption readerColumns
- let numOfCols = case thead of
+ let numOfCols = case thrs of
[] -> 0
(r:_) -> rowLength r
let normWidths ws =
strictPos . (/ max 1.0 (fromIntegral (columns - numOfCols))) <$> ws
let widths = case trim <$> lookup "widths" fields of
- Just "auto" -> replicate numOfCols Nothing
+ Just "auto" -> replicate numOfCols ColWidthDefault
Just "grid" -> widths'
Just specs -> normWidths
$ map (fromMaybe (0 :: Double) . safeRead)
@@ -788,19 +788,16 @@ tableDirective top fields body = do
Nothing -> widths'
-- align is not applicable since we can't represent whole table align
let tspecs = zip aligns' widths
- return $ B.singleton $ Table attr (Caption Nothing (mpara title))
- tspecs rhs thead tbody tfoot
+ return $ B.singleton $ Table attr (B.caption Nothing (B.plain title))
+ tspecs thead tbody tfoot
_ -> return mempty
where
-- only valid on the very first row of a table section
rowLength (Row _ rb) = sum $ cellLength <$> rb
- cellLength (Cell _ _ _ w _) = if w < 0 then 0 else w
+ cellLength (Cell _ _ _ w _) = max 1 (getColSpan w)
strictPos w
- | w > 0 = Just w
- | otherwise = Nothing
- mpara t
- | B.isNull t = []
- | otherwise = [Para $ B.toList t]
+ | w > 0 = ColWidth w
+ | otherwise = ColWidthDefault
-- TODO: :stub-columns:.
-- Only the first row becomes the header even if header-rows: > 1,
@@ -821,10 +818,10 @@ listTableDirective top fields body = do
else ([], rows, length x)
_ -> ([],[],0)
widths = case trim <$> lookup "widths" fields of
- Just "auto" -> replicate numOfCols Nothing
+ Just "auto" -> replicate numOfCols ColWidthDefault
Just specs -> normWidths $ map (fromMaybe (0 :: Double) . safeRead) $
splitTextBy (`elem` (" ," :: String)) specs
- _ -> replicate numOfCols Nothing
+ _ -> replicate numOfCols ColWidthDefault
return $ B.table title
(zip (replicate numOfCols AlignDefault) widths)
headerRow
@@ -835,8 +832,8 @@ listTableDirective top fields body = do
takeCells _ = []
normWidths ws = strictPos . (/ max 1 (sum ws)) <$> ws
strictPos w
- | w > 0 = Just w
- | otherwise = Nothing
+ | w > 0 = ColWidth w
+ | otherwise = ColWidthDefault
csvTableDirective :: PandocMonad m
=> Text -> [(Text, Text)] -> Text
@@ -890,16 +887,16 @@ csvTableDirective top fields rawcsv = do
_ -> ([],[],0)
title <- parseFromString' (trimInlines . mconcat <$> many inline) top
let strictPos w
- | w > 0 = Just w
- | otherwise = Nothing
+ | w > 0 = ColWidth w
+ | otherwise = ColWidthDefault
let normWidths ws = strictPos . (/ max 1 (sum ws)) <$> ws
let widths =
case trim <$> lookup "widths" fields of
- Just "auto" -> replicate numOfCols Nothing
+ Just "auto" -> replicate numOfCols ColWidthDefault
Just specs -> normWidths
$ map (fromMaybe (0 :: Double) . safeRead)
$ splitTextBy (`elem` (" ," :: String)) specs
- _ -> replicate numOfCols Nothing
+ _ -> replicate numOfCols ColWidthDefault
return $ B.table title
(zip (replicate numOfCols AlignDefault) widths)
headerRow
@@ -1312,14 +1309,14 @@ simpleTable headless = do
sep simpleTableFooter
-- Simple tables get 0s for relative column widths (i.e., use default)
case B.toList tbl of
- [Table attr cap spec rhs th tb tf] -> return $ B.singleton $
- Table attr cap (rewidth spec) rhs th tb tf
+ [Table attr cap spec th tb tf] -> return $ B.singleton $
+ Table attr cap (rewidth spec) th tb tf
_ ->
throwError $ PandocShouldNeverHappenError
"tableWith returned something unexpected"
where
sep = return () -- optional (simpleTableSep '-')
- rewidth = fmap $ fmap $ const Nothing
+ rewidth = fmap $ fmap $ const ColWidthDefault
gridTable :: PandocMonad m
=> Bool -- ^ Headerless table
diff --git a/src/Text/Pandoc/Readers/TWiki.hs b/src/Text/Pandoc/Readers/TWiki.hs
index f14e3f710..b39e3303e 100644
--- a/src/Text/Pandoc/Readers/TWiki.hs
+++ b/src/Text/Pandoc/Readers/TWiki.hs
@@ -229,11 +229,11 @@ table = try $ do
where
buildTable caption rows (aligns, heads)
= B.table caption aligns heads rows
- align rows = replicate (columCount rows) (AlignDefault, Nothing)
+ align rows = replicate (columCount rows) (AlignDefault, ColWidthDefault)
columns rows = replicate (columCount rows) mempty
columCount rows = length $ head rows
-tableParseHeader :: PandocMonad m => TWParser m ((Alignment, Maybe Double), B.Blocks)
+tableParseHeader :: PandocMonad m => TWParser m ((Alignment, ColWidth), B.Blocks)
tableParseHeader = try $ do
char '|'
leftSpaces <- length <$> many spaceChar
@@ -245,9 +245,9 @@ tableParseHeader = try $ do
return (tableAlign leftSpaces rightSpaces, content)
where
tableAlign left right
- | left >= 2 && left == right = (AlignCenter, Nothing)
- | left > right = (AlignRight, Nothing)
- | otherwise = (AlignLeft, Nothing)
+ | left >= 2 && left == right = (AlignCenter, ColWidthDefault)
+ | left > right = (AlignRight, ColWidthDefault)
+ | otherwise = (AlignLeft, ColWidthDefault)
tableParseRow :: PandocMonad m => TWParser m [B.Blocks]
tableParseRow = many1Till tableParseColumn newline
diff --git a/src/Text/Pandoc/Readers/Textile.hs b/src/Text/Pandoc/Readers/Textile.hs
index 3d2a962e9..a0680ac81 100644
--- a/src/Text/Pandoc/Readers/Textile.hs
+++ b/src/Text/Pandoc/Readers/Textile.hs
@@ -378,7 +378,7 @@ table = try $ do
let nbOfCols = maximum $ map length (headers:rows)
let aligns = map minimum $ transpose $ map (map (snd . fst)) (headers:rows)
return $ B.table caption
- (zip aligns (replicate nbOfCols Nothing))
+ (zip aligns (replicate nbOfCols ColWidthDefault))
(map snd headers)
(map (map snd) rows)
diff --git a/src/Text/Pandoc/Readers/Txt2Tags.hs b/src/Text/Pandoc/Readers/Txt2Tags.hs
index 5d2f11864..fc1c8c5cf 100644
--- a/src/Text/Pandoc/Readers/Txt2Tags.hs
+++ b/src/Text/Pandoc/Readers/Txt2Tags.hs
@@ -268,7 +268,7 @@ table = try $ do
let rowsPadded = map (pad size) rows'
let headerPadded = if null tableHeader then mempty else pad size tableHeader
return $ B.table mempty
- (zip aligns (replicate ncolumns Nothing))
+ (zip aligns (replicate ncolumns ColWidthDefault))
headerPadded rowsPadded
pad :: (Monoid a) => Int -> [a] -> [a]
diff --git a/src/Text/Pandoc/Shared.hs b/src/Text/Pandoc/Shared.hs
index 0418aa6e2..4a60866af 100644
--- a/src/Text/Pandoc/Shared.hs
+++ b/src/Text/Pandoc/Shared.hs
@@ -77,7 +77,6 @@ module Text.Pandoc.Shared (
htmlSpanLikeElements,
splitSentences,
filterIpynbOutput,
- toLegacyTable,
-- * TagSoup HTML handling
renderTags',
-- * File handling
@@ -993,12 +992,14 @@ blockToInlines (DefinitionList pairslst) =
mconcat (map blocksToInlines' blkslst)
blockToInlines (Header _ _ ils) = B.fromList ils
blockToInlines HorizontalRule = mempty
-blockToInlines (Table _ _ _ _ headers rows feet) =
+blockToInlines (Table _ _ _ (TableHead _ hbd) bodies (TableFoot _ fbd)) =
mconcat $ intersperse B.linebreak $
- map (mconcat . map blocksToInlines') (plainRowBody <$> headers <> rows <> feet)
+ map (mconcat . map blocksToInlines') (plainRowBody <$> hbd <> unTableBodies bodies <> fbd)
where
plainRowBody (Row _ body) = cellBody <$> body
cellBody (Cell _ _ _ _ body) = body
+ unTableBody (TableBody _ _ hd bd) = hd <> bd
+ unTableBodies = concatMap unTableBody
blockToInlines (Div _ blks) = blocksToInlines' blks
blockToInlines Null = mempty
@@ -1012,30 +1013,6 @@ blocksToInlines' = blocksToInlinesWithSep defaultBlocksSeparator
blocksToInlines :: [Block] -> [Inline]
blocksToInlines = B.toList . blocksToInlines'
--- | Convert the relevant components of a new-style table (with block
--- caption, row headers, row and column spans, and so on) to those of
--- an old-style table (inline caption, table head with one row, no
--- foot, and so on).
-toLegacyTable :: Caption
- -> [ColSpec]
- -> TableHead
- -> TableBody
- -> TableFoot
- -> ([Inline], [Alignment], [Double], [[Block]], [[[Block]]])
-toLegacyTable (Caption _ cbody) specs th tb tf = (cbody', aligns, widths, th', tb')
- where
- numcols = length specs
- (aligns, mwidths) = unzip specs
- widths = map (fromMaybe 0) mwidths
- unRow (Row _ x) = map unCell x
- unCell (Cell _ _ _ _ x) = x
- cbody' = blocksToInlines cbody
- sanitise = pad mempty numcols . unRow
- pad element upTo list = take upTo (list ++ repeat element)
- (th', tb') = case th of
- (r:rs) -> (sanitise r, map sanitise $ rs <> tb <> tf)
- [] -> ([], map sanitise $ tb <> tf)
-
-- | Inline elements used to separate blocks when squashing blocks into
-- inlines.
defaultBlocksSeparator :: Inlines
diff --git a/src/Text/Pandoc/Writers/AsciiDoc.hs b/src/Text/Pandoc/Writers/AsciiDoc.hs
index b9d93188a..e0ee830de 100644
--- a/src/Text/Pandoc/Writers/AsciiDoc.hs
+++ b/src/Text/Pandoc/Writers/AsciiDoc.hs
@@ -191,7 +191,7 @@ blockToAsciiDoc opts (BlockQuote blocks) = do
else contents
let bar = text "____"
return $ bar $$ chomp contents' $$ bar <> blankline
-blockToAsciiDoc opts (Table _ blkCapt specs _ thead tbody tfoot) = do
+blockToAsciiDoc opts (Table _ blkCapt specs thead tbody tfoot) = do
let (caption, aligns, widths, headers, rows) = toLegacyTable blkCapt specs thead tbody tfoot
caption' <- inlineListToAsciiDoc opts caption
let caption'' = if null caption
diff --git a/src/Text/Pandoc/Writers/CommonMark.hs b/src/Text/Pandoc/Writers/CommonMark.hs
index bd798ee73..bab74c77c 100644
--- a/src/Text/Pandoc/Writers/CommonMark.hs
+++ b/src/Text/Pandoc/Writers/CommonMark.hs
@@ -27,7 +27,7 @@ import Text.Pandoc.Class.PandocMonad (PandocMonad)
import Text.Pandoc.Definition
import Text.Pandoc.Options
import Text.Pandoc.Shared (capitalize, isTightList,
- linesToPara, onlySimpleTableCells, taskListItemToAscii, tshow, toLegacyTable)
+ linesToPara, onlySimpleTableCells, taskListItemToAscii, tshow)
import Text.Pandoc.Templates (renderTemplate)
import Text.Pandoc.Walk (walk, walkM)
import Text.Pandoc.Writers.HTML (writeHtml5String, tagWithAttributes)
@@ -154,7 +154,7 @@ blockToNodes opts (DefinitionList items) ns =
Plain (term ++ [LineBreak] ++ xs) : ys ++ concat zs
dlToBullet (term, xs) =
Para term : concat xs
-blockToNodes opts t@(Table _ blkCapt specs _ thead tbody tfoot) ns =
+blockToNodes opts t@(Table _ blkCapt specs thead tbody tfoot) ns =
let (capt, aligns, _widths, headers, rows) = toLegacyTable blkCapt specs thead tbody tfoot
in if isEnabled Ext_pipe_tables opts && onlySimpleTableCells (headers : rows)
then do
diff --git a/src/Text/Pandoc/Writers/ConTeXt.hs b/src/Text/Pandoc/Writers/ConTeXt.hs
index f3d7219d1..6066f9bb2 100644
--- a/src/Text/Pandoc/Writers/ConTeXt.hs
+++ b/src/Text/Pandoc/Writers/ConTeXt.hs
@@ -255,7 +255,7 @@ blockToConTeXt (DefinitionList lst) =
blockToConTeXt HorizontalRule = return $ "\\thinrule" <> blankline
-- If this is ever executed, provide a default for the reference identifier.
blockToConTeXt (Header level attr lst) = sectionHeader attr level lst
-blockToConTeXt (Table _ blkCapt specs _ thead tbody tfoot) = do
+blockToConTeXt (Table _ blkCapt specs thead tbody tfoot) = do
let (caption, aligns, widths, heads, rows) = toLegacyTable blkCapt specs thead tbody tfoot
opts <- gets stOptions
let tabl = if isEnabled Ext_ntb opts
diff --git a/src/Text/Pandoc/Writers/Custom.hs b/src/Text/Pandoc/Writers/Custom.hs
index beb2301c9..2be64d56f 100644
--- a/src/Text/Pandoc/Writers/Custom.hs
+++ b/src/Text/Pandoc/Writers/Custom.hs
@@ -29,7 +29,6 @@ import Text.Pandoc.Lua (Global (..), LuaException (LuaException),
runLua, setGlobals)
import Text.Pandoc.Lua.Util (addField, dofileWithTraceback)
import Text.Pandoc.Options
-import Text.Pandoc.Shared (toLegacyTable)
import Text.Pandoc.Templates (renderTemplate)
import qualified Text.Pandoc.UTF8 as UTF8
import Text.Pandoc.Writers.Shared
@@ -150,7 +149,7 @@ blockToCustom (CodeBlock attr str) =
blockToCustom (BlockQuote blocks) =
Lua.callFunc "BlockQuote" (Stringify blocks)
-blockToCustom (Table _ blkCapt specs _ thead tbody tfoot) =
+blockToCustom (Table _ blkCapt specs thead tbody tfoot) =
let (capt, aligns, widths, headers, rows) = toLegacyTable blkCapt specs thead tbody tfoot
aligns' = map show aligns
capt' = Stringify capt
diff --git a/src/Text/Pandoc/Writers/Docbook.hs b/src/Text/Pandoc/Writers/Docbook.hs
index 7af357fb0..ba468cf4f 100644
--- a/src/Text/Pandoc/Writers/Docbook.hs
+++ b/src/Text/Pandoc/Writers/Docbook.hs
@@ -263,7 +263,7 @@ blockToDocbook _ b@(RawBlock f str)
report $ BlockNotRendered b
return empty
blockToDocbook _ HorizontalRule = return empty -- not semantic
-blockToDocbook opts (Table _ blkCapt specs _ thead tbody tfoot) = do
+blockToDocbook opts (Table _ blkCapt specs thead tbody tfoot) = do
let (caption, aligns, widths, headers, rows) = toLegacyTable blkCapt specs thead tbody tfoot
captionDoc <- if null caption
then return empty
diff --git a/src/Text/Pandoc/Writers/Docx.hs b/src/Text/Pandoc/Writers/Docx.hs
index f9e173bb2..2caba59cc 100644
--- a/src/Text/Pandoc/Writers/Docx.hs
+++ b/src/Text/Pandoc/Writers/Docx.hs
@@ -970,7 +970,7 @@ blockToOpenXML' _ HorizontalRule = do
$ mknode "v:rect" [("style","width:0;height:1.5pt"),
("o:hralign","center"),
("o:hrstd","t"),("o:hr","t")] () ]
-blockToOpenXML' opts (Table _ blkCapt specs _ thead tbody tfoot) = do
+blockToOpenXML' opts (Table _ blkCapt specs thead tbody tfoot) = do
let (caption, aligns, widths, headers, rows) = toLegacyTable blkCapt specs thead tbody tfoot
setFirstPara
modify $ \s -> s { stInTable = True }
diff --git a/src/Text/Pandoc/Writers/DokuWiki.hs b/src/Text/Pandoc/Writers/DokuWiki.hs
index ce99aaa9d..b01d9a7bb 100644
--- a/src/Text/Pandoc/Writers/DokuWiki.hs
+++ b/src/Text/Pandoc/Writers/DokuWiki.hs
@@ -35,10 +35,10 @@ import Text.Pandoc.ImageSize
import Text.Pandoc.Logging
import Text.Pandoc.Options (WrapOption (..), WriterOptions (writerTableOfContents, writerTemplate, writerWrapText))
import Text.Pandoc.Shared (camelCaseToHyphenated, escapeURI, isURI, linesToPara,
- removeFormatting, trimr, tshow, toLegacyTable)
+ removeFormatting, trimr, tshow)
import Text.Pandoc.Templates (renderTemplate)
import Text.DocLayout (render, literal)
-import Text.Pandoc.Writers.Shared (defField, metaToContext)
+import Text.Pandoc.Writers.Shared (defField, metaToContext, toLegacyTable)
data WriterState = WriterState {
}
@@ -166,7 +166,7 @@ blockToDokuWiki opts (BlockQuote blocks) = do
then return $ T.unlines $ map ("> " <>) $ T.lines contents
else return $ "<HTML><blockquote>\n" <> contents <> "</blockquote></HTML>"
-blockToDokuWiki opts (Table _ blkCapt specs _ thead tbody tfoot) = do
+blockToDokuWiki opts (Table _ blkCapt specs thead tbody tfoot) = do
let (capt, aligns, _, headers, rows) = toLegacyTable blkCapt specs thead tbody tfoot
captionDoc <- if null capt
then return ""
diff --git a/src/Text/Pandoc/Writers/FB2.hs b/src/Text/Pandoc/Writers/FB2.hs
index 5b62119a3..83bcf2038 100644
--- a/src/Text/Pandoc/Writers/FB2.hs
+++ b/src/Text/Pandoc/Writers/FB2.hs
@@ -40,8 +40,8 @@ import Text.Pandoc.Definition
import Text.Pandoc.Logging
import Text.Pandoc.Options (HTMLMathMethod (..), WriterOptions (..), def)
import Text.Pandoc.Shared (capitalize, isURI, orderedListMarkers,
- makeSections, tshow, toLegacyTable)
-import Text.Pandoc.Writers.Shared (lookupMetaString)
+ makeSections, tshow)
+import Text.Pandoc.Writers.Shared (lookupMetaString, toLegacyTable)
-- | Data to be written at the end of the document:
-- (foot)notes, URLs, references, images.
@@ -334,7 +334,7 @@ blockToXml h@Header{} = do
report $ BlockNotRendered h
return []
blockToXml HorizontalRule = return [ el "empty-line" () ]
-blockToXml (Table _ blkCapt specs _ thead tbody tfoot) = do
+blockToXml (Table _ blkCapt specs thead tbody tfoot) = do
let (caption, aligns, _, headers, rows) = toLegacyTable blkCapt specs thead tbody tfoot
hd <- mkrow "th" headers aligns
bd <- mapM (\r -> mkrow "td" r aligns) rows
diff --git a/src/Text/Pandoc/Writers/HTML.hs b/src/Text/Pandoc/Writers/HTML.hs
index 070631f0d..77585e920 100644
--- a/src/Text/Pandoc/Writers/HTML.hs
+++ b/src/Text/Pandoc/Writers/HTML.hs
@@ -885,7 +885,7 @@ blockToHtml opts (DefinitionList lst) = do
return $ mconcat $ nl opts : term' : nl opts :
intersperse (nl opts) defs') lst
defList opts contents
-blockToHtml opts (Table _ blkCapt specs _ thead tbody tfoot) = do
+blockToHtml opts (Table _ blkCapt specs thead tbody tfoot) = do
let (capt, aligns, widths, headers, rows') = toLegacyTable blkCapt specs thead tbody tfoot
captionDoc <- if null capt
then return mempty
diff --git a/src/Text/Pandoc/Writers/Haddock.hs b/src/Text/Pandoc/Writers/Haddock.hs
index 57e2f0ea7..925160602 100644
--- a/src/Text/Pandoc/Writers/Haddock.hs
+++ b/src/Text/Pandoc/Writers/Haddock.hs
@@ -115,7 +115,7 @@ blockToHaddock _ (CodeBlock (_,_,_) str) =
-- Nothing in haddock corresponds to block quotes:
blockToHaddock opts (BlockQuote blocks) =
blockListToHaddock opts blocks
-blockToHaddock opts (Table _ blkCapt specs _ thead tbody tfoot) = do
+blockToHaddock opts (Table _ blkCapt specs thead tbody tfoot) = do
let (caption, aligns, widths, headers, rows) = toLegacyTable blkCapt specs thead tbody tfoot
caption' <- inlineListToHaddock opts caption
let caption'' = if null caption
diff --git a/src/Text/Pandoc/Writers/ICML.hs b/src/Text/Pandoc/Writers/ICML.hs
index 5575ab2bb..57066d303 100644
--- a/src/Text/Pandoc/Writers/ICML.hs
+++ b/src/Text/Pandoc/Writers/ICML.hs
@@ -321,7 +321,7 @@ blockToICML opts style (Header lvl (_, cls, _) lst) =
else ""
in parStyle opts stl lst
blockToICML _ _ HorizontalRule = return empty -- we could insert a page break instead
-blockToICML opts style (Table _ blkCapt specs _ thead tbody tfoot) =
+blockToICML opts style (Table _ blkCapt specs thead tbody tfoot) =
let (caption, aligns, widths, headers, rows) = toLegacyTable blkCapt specs thead tbody tfoot
style' = tableName : style
noHeader = all null headers
diff --git a/src/Text/Pandoc/Writers/JATS.hs b/src/Text/Pandoc/Writers/JATS.hs
index f739613b6..47d8c00cf 100644
--- a/src/Text/Pandoc/Writers/JATS.hs
+++ b/src/Text/Pandoc/Writers/JATS.hs
@@ -356,7 +356,7 @@ blockToJATS _ b@(RawBlock f str)
report $ BlockNotRendered b
return empty
blockToJATS _ HorizontalRule = return empty -- not semantic
-blockToJATS opts (Table _ blkCapt specs _ th tb tf) =
+blockToJATS opts (Table _ blkCapt specs th tb tf) =
case toLegacyTable blkCapt specs th tb tf of
([], aligns, widths, headers, rows) -> captionlessTable aligns widths headers rows
(caption, aligns, widths, headers, rows) -> do
diff --git a/src/Text/Pandoc/Writers/Jira.hs b/src/Text/Pandoc/Writers/Jira.hs
index bd22c161f..1bf14c6a0 100644
--- a/src/Text/Pandoc/Writers/Jira.hs
+++ b/src/Text/Pandoc/Writers/Jira.hs
@@ -26,10 +26,10 @@ import Text.Pandoc.Class.PandocMonad (PandocMonad)
import Text.Pandoc.Definition
import Text.Pandoc.Options (WriterOptions (writerTemplate, writerWrapText),
WrapOption (..))
-import Text.Pandoc.Shared (linesToPara, stringify, toLegacyTable)
+import Text.Pandoc.Shared (linesToPara, stringify)
import Text.Pandoc.Templates (renderTemplate)
import Text.Pandoc.Writers.Math (texMathToInlines)
-import Text.Pandoc.Writers.Shared (defField, metaToContext)
+import Text.Pandoc.Writers.Shared (defField, metaToContext, toLegacyTable)
import Text.DocLayout (literal, render)
import qualified Data.Text as T
import qualified Text.Jira.Markup as Jira
@@ -98,7 +98,7 @@ toJiraBlocks blocks = do
Plain xs -> singleton . Jira.Para <$> toJiraInlines xs
RawBlock fmt cs -> rawBlockToJira fmt cs
Null -> return mempty
- Table _ blkCapt specs _ thead tbody tfoot -> singleton <$> do
+ Table _ blkCapt specs thead tbody tfoot -> singleton <$> do
let (_, _, _, hd, body) = toLegacyTable blkCapt specs thead tbody tfoot
headerRow <- if all null hd
then pure Nothing
diff --git a/src/Text/Pandoc/Writers/LaTeX.hs b/src/Text/Pandoc/Writers/LaTeX.hs
index 274f5108a..c3a2762d2 100644
--- a/src/Text/Pandoc/Writers/LaTeX.hs
+++ b/src/Text/Pandoc/Writers/LaTeX.hs
@@ -759,7 +759,7 @@ blockToLaTeX (Header level (id',classes,_) lst) = do
hdr <- sectionHeader classes id' level lst
modify $ \s -> s{stInHeading = False}
return hdr
-blockToLaTeX (Table _ blkCapt specs _ thead tbody tfoot) = do
+blockToLaTeX (Table _ blkCapt specs thead tbody tfoot) = do
let (caption, aligns, widths, heads, rows) = toLegacyTable blkCapt specs thead tbody tfoot
(captionText, captForLof, captNotes) <- getCaption False caption
let toHeaders hs = do contents <- tableRowToLaTeX True aligns widths hs
diff --git a/src/Text/Pandoc/Writers/Man.hs b/src/Text/Pandoc/Writers/Man.hs
index dda1e1cf1..105906138 100644
--- a/src/Text/Pandoc/Writers/Man.hs
+++ b/src/Text/Pandoc/Writers/Man.hs
@@ -139,7 +139,7 @@ blockToMan opts (CodeBlock _ str) = return $
blockToMan opts (BlockQuote blocks) = do
contents <- blockListToMan opts blocks
return $ literal ".RS" $$ contents $$ literal ".RE"
-blockToMan opts (Table _ blkCapt specs _ thead tbody tfoot) =
+blockToMan opts (Table _ blkCapt specs thead tbody tfoot) =
let (caption, alignments, widths, headers, rows) = toLegacyTable blkCapt specs thead tbody tfoot
aligncode AlignLeft = "l"
aligncode AlignRight = "r"
diff --git a/src/Text/Pandoc/Writers/Markdown.hs b/src/Text/Pandoc/Writers/Markdown.hs
index 4d4d02028..7a11e3c16 100644
--- a/src/Text/Pandoc/Writers/Markdown.hs
+++ b/src/Text/Pandoc/Writers/Markdown.hs
@@ -574,7 +574,7 @@ blockToMarkdown' opts (BlockQuote blocks) = do
else if plain then " " else "> "
contents <- blockListToMarkdown opts blocks
return $ (prefixed leader contents) <> blankline
-blockToMarkdown' opts t@(Table _ blkCapt specs _ thead tbody tfoot) = do
+blockToMarkdown' opts t@(Table _ blkCapt specs thead tbody tfoot) = do
let (caption, aligns, widths, headers, rows) = toLegacyTable blkCapt specs thead tbody tfoot
let numcols = maximum (length aligns : length widths :
map length (headers:rows))
diff --git a/src/Text/Pandoc/Writers/MediaWiki.hs b/src/Text/Pandoc/Writers/MediaWiki.hs
index fbfb7acb4..8d1745e8e 100644
--- a/src/Text/Pandoc/Writers/MediaWiki.hs
+++ b/src/Text/Pandoc/Writers/MediaWiki.hs
@@ -150,7 +150,7 @@ blockToMediaWiki (BlockQuote blocks) = do
contents <- blockListToMediaWiki blocks
return $ "<blockquote>" <> contents <> "</blockquote>"
-blockToMediaWiki (Table _ blkCapt specs _ thead tbody tfoot) = do
+blockToMediaWiki (Table _ blkCapt specs thead tbody tfoot) = do
let (capt, aligns, widths, headers, rows') = toLegacyTable blkCapt specs thead tbody tfoot
caption <- if null capt
then return ""
diff --git a/src/Text/Pandoc/Writers/Ms.hs b/src/Text/Pandoc/Writers/Ms.hs
index ad2a7a3fd..6c9d8a783 100644
--- a/src/Text/Pandoc/Writers/Ms.hs
+++ b/src/Text/Pandoc/Writers/Ms.hs
@@ -215,7 +215,7 @@ blockToMs opts (BlockQuote blocks) = do
contents <- blockListToMs opts blocks
setFirstPara
return $ literal ".QS" $$ contents $$ literal ".QE"
-blockToMs opts (Table _ blkCapt specs _ thead tbody tfoot) =
+blockToMs opts (Table _ blkCapt specs thead tbody tfoot) =
let (caption, alignments, widths, headers, rows) = toLegacyTable blkCapt specs thead tbody tfoot
aligncode AlignLeft = "l"
aligncode AlignRight = "r"
diff --git a/src/Text/Pandoc/Writers/Muse.hs b/src/Text/Pandoc/Writers/Muse.hs
index f2bc91290..88b4c2ef9 100644
--- a/src/Text/Pandoc/Writers/Muse.hs
+++ b/src/Text/Pandoc/Writers/Muse.hs
@@ -259,7 +259,7 @@ blockToMuse (Header level (ident,_,_) inlines) = do
return $ blankline <> attr' $$ nowrap (header' <> contents) <> blankline
-- https://www.gnu.org/software/emacs-muse/manual/muse.html#Horizontal-Rules-and-Anchors
blockToMuse HorizontalRule = return $ blankline $$ "----" $$ blankline
-blockToMuse (Table _ blkCapt specs _ thead tbody tfoot) =
+blockToMuse (Table _ blkCapt specs thead tbody tfoot) =
if isSimple && numcols > 1
then simpleTable caption headers rows
else do
diff --git a/src/Text/Pandoc/Writers/Native.hs b/src/Text/Pandoc/Writers/Native.hs
index a533496c1..4d4dfca15 100644
--- a/src/Text/Pandoc/Writers/Native.hs
+++ b/src/Text/Pandoc/Writers/Native.hs
@@ -40,18 +40,15 @@ prettyBlock (DefinitionList items) = "DefinitionList" $$
prettyList (map deflistitem items)
where deflistitem (term, defs) = "(" <> text (show term) <> "," <> cr <>
nest 1 (prettyList $ map (prettyList . map prettyBlock) defs) <> ")"
-prettyBlock (Table attr blkCapt specs rhs thead tbody tfoot) =
+prettyBlock (Table attr blkCapt specs thead tbody tfoot) =
mconcat [ "Table "
, text (show attr)
, " "
- , prettyCaption blkCapt
- , " "
- , text (show specs)
- , " "
- , text (show rhs) ] $$
- prettyRows thead $$
- prettyRows tbody $$
- prettyRows tfoot
+ , prettyCaption blkCapt ] $$
+ prettyList (map (text . show) specs) $$
+ prettyHead thead $$
+ prettyBodies tbody $$
+ prettyFoot tfoot
where prettyRows = prettyList . map prettyRow
prettyRow (Row a body) =
text ("Row " <> show a) $$ prettyList (map prettyCell body)
@@ -59,14 +56,26 @@ prettyBlock (Table attr blkCapt specs rhs thead tbody tfoot) =
mconcat [ "Cell "
, text (show a)
, " "
- , text (showsPrec 11 ma "")
- , " "
+ , text (show ma)
+ , " ("
, text (show h)
- , " "
- , text (show w) ] $$
+ , ") ("
+ , text (show w)
+ , ")" ] $$
prettyList (map prettyBlock b)
prettyCaption (Caption mshort body) =
"(Caption " <> text (showsPrec 11 mshort "") $$ prettyList (map prettyBlock body) <> ")"
+ prettyHead (TableHead thattr body)
+ = "(TableHead " <> text (show thattr) $$ prettyRows body <> ")"
+ prettyBody (TableBody tbattr rhc hd bd)
+ = mconcat [ "(TableBody "
+ , text (show tbattr)
+ , " ("
+ , text (show rhc)
+ , ")" ] $$ prettyRows hd $$ prettyRows bd <> ")"
+ prettyBodies = prettyList . map prettyBody
+ prettyFoot (TableFoot tfattr body)
+ = "(TableFoot " <> text (show tfattr) $$ prettyRows body <> ")"
prettyBlock (Div attr blocks) =
text ("Div " <> show attr) $$ prettyList (map prettyBlock blocks)
prettyBlock block = text $ show block
diff --git a/src/Text/Pandoc/Writers/OpenDocument.hs b/src/Text/Pandoc/Writers/OpenDocument.hs
index 12599772f..9c802118a 100644
--- a/src/Text/Pandoc/Writers/OpenDocument.hs
+++ b/src/Text/Pandoc/Writers/OpenDocument.hs
@@ -31,7 +31,7 @@ import Text.Pandoc.Definition
import Text.Pandoc.Logging
import Text.Pandoc.Options
import Text.DocLayout
-import Text.Pandoc.Shared (linesToPara, tshow, toLegacyTable)
+import Text.Pandoc.Shared (linesToPara, tshow)
import Text.Pandoc.Templates (renderTemplate)
import qualified Text.Pandoc.Translations as Term (Term(Figure, Table))
import Text.Pandoc.Writers.Math
@@ -359,7 +359,7 @@ blockToOpenDocument o bs
| BulletList b <- bs = setFirstPara >> bulletListToOpenDocument o b
| OrderedList a b <- bs = setFirstPara >> orderedList a b
| CodeBlock _ s <- bs = setFirstPara >> preformatted s
- | Table _ bc s _ th tb tf
+ | Table _ bc s th tb tf
<- bs = let (c, a, w, h, r) = toLegacyTable bc s th tb tf
in setFirstPara >> table c a w h r
| HorizontalRule <- bs = setFirstPara >> return (selfClosingTag "text:p"
diff --git a/src/Text/Pandoc/Writers/Org.hs b/src/Text/Pandoc/Writers/Org.hs
index d8d89d2eb..8e7f4dbf1 100644
--- a/src/Text/Pandoc/Writers/Org.hs
+++ b/src/Text/Pandoc/Writers/Org.hs
@@ -183,7 +183,7 @@ blockToOrg (BlockQuote blocks) = do
contents <- blockListToOrg blocks
return $ blankline $$ "#+BEGIN_QUOTE" $$
nest 2 contents $$ "#+END_QUOTE" $$ blankline
-blockToOrg (Table _ blkCapt specs _ thead tbody tfoot) = do
+blockToOrg (Table _ blkCapt specs thead tbody tfoot) = do
let (caption', _, _, headers, rows) = toLegacyTable blkCapt specs thead tbody tfoot
caption'' <- inlineListToOrg caption'
let caption = if null caption'
diff --git a/src/Text/Pandoc/Writers/Powerpoint/Presentation.hs b/src/Text/Pandoc/Writers/Powerpoint/Presentation.hs
index dbacbb3cf..68345bcd1 100644
--- a/src/Text/Pandoc/Writers/Powerpoint/Presentation.hs
+++ b/src/Text/Pandoc/Writers/Powerpoint/Presentation.hs
@@ -54,9 +54,10 @@ import Text.Pandoc.Logging
import Text.Pandoc.Walk
import Data.Time (UTCTime)
import qualified Text.Pandoc.Shared as Shared -- so we don't overlap "Element"
-import Text.Pandoc.Shared (tshow, toLegacyTable)
+import Text.Pandoc.Shared (tshow)
import Text.Pandoc.Writers.Shared (lookupMetaInlines, lookupMetaBlocks
- , lookupMetaString, toTableOfContents)
+ , lookupMetaString, toTableOfContents
+ , toLegacyTable)
import qualified Data.Map as M
import qualified Data.Set as S
import Data.Maybe (maybeToList, fromMaybe)
@@ -541,7 +542,7 @@ blockToShape (Para (il:_)) | Link _ (il':_) target <- il
, Image attr ils (url, _) <- il' =
(withAttr attr . Pic def{picPropLink = Just $ ExternalTarget target} (T.unpack url))
<$> inlinesToParElems ils
-blockToShape (Table _ blkCapt specs _ thead tbody tfoot) = do
+blockToShape (Table _ blkCapt specs thead tbody tfoot) = do
let (caption, algn, _, hdrCells, rows) = toLegacyTable blkCapt specs thead tbody tfoot
caption' <- inlinesToParElems caption
hdrCells' <- rowToParagraphs algn hdrCells
diff --git a/src/Text/Pandoc/Writers/RST.hs b/src/Text/Pandoc/Writers/RST.hs
index 85354d93f..a390cc6cf 100644
--- a/src/Text/Pandoc/Writers/RST.hs
+++ b/src/Text/Pandoc/Writers/RST.hs
@@ -284,7 +284,7 @@ blockToRST (CodeBlock (_,classes,kvs) str) = do
blockToRST (BlockQuote blocks) = do
contents <- blockListToRST blocks
return $ nest 3 contents <> blankline
-blockToRST (Table _ blkCapt specs _ thead tbody tfoot) = do
+blockToRST (Table _ blkCapt specs thead tbody tfoot) = do
let (caption, aligns, widths, headers, rows) = toLegacyTable blkCapt specs thead tbody tfoot
caption' <- inlineListToRST caption
let blocksToDoc opts bs = do
diff --git a/src/Text/Pandoc/Writers/RTF.hs b/src/Text/Pandoc/Writers/RTF.hs
index e45a73f79..da24e8b71 100644
--- a/src/Text/Pandoc/Writers/RTF.hs
+++ b/src/Text/Pandoc/Writers/RTF.hs
@@ -254,7 +254,7 @@ blockToRTF indent alignment (Header level _ lst) = do
contents <- inlinesToRTF lst
return $ rtfPar indent 0 alignment $
"\\b \\fs" <> tshow (40 - (level * 4)) <> " " <> contents
-blockToRTF indent alignment (Table _ blkCapt specs _ thead tbody tfoot) = do
+blockToRTF indent alignment (Table _ blkCapt specs thead tbody tfoot) = do
let (caption, aligns, sizes, headers, rows) = toLegacyTable blkCapt specs thead tbody tfoot
caption' <- inlinesToRTF caption
header' <- if all null headers
diff --git a/src/Text/Pandoc/Writers/Shared.hs b/src/Text/Pandoc/Writers/Shared.hs
index 9ba6dcc8a..fb4e8eca6 100644
--- a/src/Text/Pandoc/Writers/Shared.hs
+++ b/src/Text/Pandoc/Writers/Shared.hs
@@ -34,6 +34,7 @@ module Text.Pandoc.Writers.Shared (
, toSuperscript
, toTableOfContents
, endsWithPlain
+ , toLegacyTable
)
where
import Safe (lastMay)
@@ -50,7 +51,7 @@ import qualified Text.Pandoc.Builder as Builder
import Text.Pandoc.Definition
import Text.Pandoc.Options
import Text.DocLayout
-import Text.Pandoc.Shared (stringify, makeSections, deNote, deLink)
+import Text.Pandoc.Shared (stringify, makeSections, deNote, deLink, blocksToInlines)
import Text.Pandoc.Walk (walk)
import qualified Text.Pandoc.UTF8 as UTF8
import Text.Pandoc.XML (escapeStringForXML)
@@ -426,3 +427,32 @@ endsWithPlain xs =
case lastMay xs of
Just Plain{} -> True
_ -> False
+
+-- | Convert the relevant components of a new-style table (with block
+-- caption, row headers, row and column spans, and so on) to those of
+-- an old-style table (inline caption, table head with one row, no
+-- foot, and so on).
+toLegacyTable :: Caption
+ -> [ColSpec]
+ -> TableHead
+ -> [TableBody]
+ -> TableFoot
+ -> ([Inline], [Alignment], [Double], [[Block]], [[[Block]]])
+toLegacyTable (Caption _ cbody) specs (TableHead _ th) tb (TableFoot _ tf)
+ = (cbody', aligns, widths, th', tb')
+ where
+ numcols = length specs
+ (aligns, mwidths) = unzip specs
+ fromWidth (ColWidth w) | w > 0 = w
+ fromWidth _ = 0
+ widths = map fromWidth mwidths
+ unRow (Row _ x) = map unCell x
+ unCell (Cell _ _ _ _ x) = x
+ unBody (TableBody _ _ hd bd) = hd <> bd
+ unBodies = concatMap unBody
+ cbody' = blocksToInlines cbody
+ sanitise = pad mempty numcols . unRow
+ pad element upTo list = take upTo (list ++ repeat element)
+ (th', tb') = case th of
+ (r:rs) -> (sanitise r, map sanitise $ rs <> unBodies tb <> tf)
+ [] -> ([], map sanitise $ unBodies tb <> tf)
diff --git a/src/Text/Pandoc/Writers/TEI.hs b/src/Text/Pandoc/Writers/TEI.hs
index d1bc514c1..f7fa19b1b 100644
--- a/src/Text/Pandoc/Writers/TEI.hs
+++ b/src/Text/Pandoc/Writers/TEI.hs
@@ -194,7 +194,7 @@ blockToTEI _ HorizontalRule = return $
-- | TEI Tables
-- TEI Simple's tables are composed of cells and rows; other
-- table info in the AST is here lossily discard.
-blockToTEI opts (Table _ blkCapt specs _ thead tbody tfoot) = do
+blockToTEI opts (Table _ blkCapt specs thead tbody tfoot) = do
let (_, _, _, headers, rows) = toLegacyTable blkCapt specs thead tbody tfoot
headers' <- tableHeadersToTEI opts headers
rows' <- mapM (tableRowToTEI opts) rows
diff --git a/src/Text/Pandoc/Writers/Texinfo.hs b/src/Text/Pandoc/Writers/Texinfo.hs
index a4b1d3a57..ef1ee7d25 100644
--- a/src/Text/Pandoc/Writers/Texinfo.hs
+++ b/src/Text/Pandoc/Writers/Texinfo.hs
@@ -228,7 +228,7 @@ blockToTexinfo (Header level (ident,_,_) lst)
seccmd 4 = return "@subsubsection "
seccmd _ = throwError $ PandocSomeError "illegal seccmd level"
-blockToTexinfo (Table _ blkCapt specs _ thead tbody tfoot) = do
+blockToTexinfo (Table _ blkCapt specs thead tbody tfoot) = do
let (caption, aligns, widths, heads, rows) = toLegacyTable blkCapt specs thead tbody tfoot
headers <- if all null heads
then return empty
diff --git a/src/Text/Pandoc/Writers/Textile.hs b/src/Text/Pandoc/Writers/Textile.hs
index 2e02448e3..e68303cfe 100644
--- a/src/Text/Pandoc/Writers/Textile.hs
+++ b/src/Text/Pandoc/Writers/Textile.hs
@@ -168,7 +168,7 @@ blockToTextile opts (BlockQuote blocks) = do
contents <- blockListToTextile opts blocks
return $ "<blockquote>\n\n" <> contents <> "\n</blockquote>\n"
-blockToTextile opts (Table _ blkCapt specs _ thead tbody tfoot)
+blockToTextile opts (Table _ blkCapt specs thead tbody tfoot)
= case toLegacyTable blkCapt specs thead tbody tfoot of
([], aligns, widths, headers, rows') | all (==0) widths -> do
hs <- mapM (liftM (("_. " <>) . stripTrailingNewlines) . blockListToTextile opts) headers
diff --git a/src/Text/Pandoc/Writers/XWiki.hs b/src/Text/Pandoc/Writers/XWiki.hs
index 43729d0b0..bfc61c3b5 100644
--- a/src/Text/Pandoc/Writers/XWiki.hs
+++ b/src/Text/Pandoc/Writers/XWiki.hs
@@ -43,6 +43,7 @@ import Text.Pandoc.Logging
import Text.Pandoc.Options
import Text.Pandoc.Shared
import Text.Pandoc.Writers.MediaWiki (highlightingLangs)
+import Text.Pandoc.Writers.Shared (toLegacyTable)
data WriterState = WriterState {
listLevel :: Text -- String at the beginning of items
@@ -122,7 +123,7 @@ blockToXWiki (DefinitionList items) = do
return $ vcat contents <> if Text.null lev then "\n" else ""
-- TODO: support more features
-blockToXWiki (Table _ blkCapt specs _ thead tbody tfoot) = do
+blockToXWiki (Table _ blkCapt specs thead tbody tfoot) = do
let (_, _, _, headers, rows') = toLegacyTable blkCapt specs thead tbody tfoot
headers' <- mapM (tableCellXWiki True) headers
otherRows <- mapM formRow rows'
diff --git a/src/Text/Pandoc/Writers/ZimWiki.hs b/src/Text/Pandoc/Writers/ZimWiki.hs
index 0709744d5..e311abe7b 100644
--- a/src/Text/Pandoc/Writers/ZimWiki.hs
+++ b/src/Text/Pandoc/Writers/ZimWiki.hs
@@ -32,9 +32,9 @@ import Text.Pandoc.Logging
import Text.Pandoc.Options (WrapOption (..),
WriterOptions (writerTableOfContents, writerTemplate,
writerWrapText))
-import Text.Pandoc.Shared (escapeURI, isURI, linesToPara, removeFormatting, trimr, toLegacyTable)
+import Text.Pandoc.Shared (escapeURI, isURI, linesToPara, removeFormatting, trimr)
import Text.Pandoc.Templates (renderTemplate)
-import Text.Pandoc.Writers.Shared (defField, metaToContext)
+import Text.Pandoc.Writers.Shared (defField, metaToContext, toLegacyTable)
data WriterState = WriterState {
stIndent :: Text, -- Indent after the marker at the beginning of list items
@@ -132,7 +132,7 @@ blockToZimWiki opts (BlockQuote blocks) = do
contents <- blockListToZimWiki opts blocks
return $ T.unlines $ map ("> " <>) $ T.lines contents
-blockToZimWiki opts (Table _ blkCapt specs _ thead tbody tfoot) = do
+blockToZimWiki opts (Table _ blkCapt specs thead tbody tfoot) = do
let (capt, aligns, _, headers, rows) = toLegacyTable blkCapt specs thead tbody tfoot
captionDoc <- if null capt
then return ""
--
cgit v1.2.3