aboutsummaryrefslogtreecommitdiff
path: root/src/Text
diff options
context:
space:
mode:
Diffstat (limited to 'src/Text')
-rw-r--r--src/Text/Pandoc/Lua/Marshaling/AST.hs105
-rw-r--r--src/Text/Pandoc/Lua/Walk.hs48
-rw-r--r--src/Text/Pandoc/Parsing.hs15
-rw-r--r--src/Text/Pandoc/Readers/CSV.hs18
-rw-r--r--src/Text/Pandoc/Readers/CommonMark.hs24
-rw-r--r--src/Text/Pandoc/Readers/DocBook.hs46
-rw-r--r--src/Text/Pandoc/Readers/Docx.hs35
-rw-r--r--src/Text/Pandoc/Readers/DokuWiki.hs10
-rw-r--r--src/Text/Pandoc/Readers/HTML.hs22
-rw-r--r--src/Text/Pandoc/Readers/Haddock.hs10
-rw-r--r--src/Text/Pandoc/Readers/Ipynb.hs2
-rw-r--r--src/Text/Pandoc/Readers/JATS.hs59
-rw-r--r--src/Text/Pandoc/Readers/Jira.hs2
-rw-r--r--src/Text/Pandoc/Readers/LaTeX.hs41
-rw-r--r--src/Text/Pandoc/Readers/Man.hs13
-rw-r--r--src/Text/Pandoc/Readers/Markdown.hs37
-rw-r--r--src/Text/Pandoc/Readers/MediaWiki.hs14
-rw-r--r--src/Text/Pandoc/Readers/Muse.hs19
-rw-r--r--src/Text/Pandoc/Readers/Odt/ContentReader.hs4
-rw-r--r--src/Text/Pandoc/Readers/Org/Blocks.hs24
-rw-r--r--src/Text/Pandoc/Readers/RST.hs67
-rw-r--r--src/Text/Pandoc/Readers/TWiki.hs18
-rw-r--r--src/Text/Pandoc/Readers/Textile.hs11
-rw-r--r--src/Text/Pandoc/Readers/Txt2Tags.hs10
-rw-r--r--src/Text/Pandoc/Shared.hs12
-rw-r--r--src/Text/Pandoc/Writers/AsciiDoc.hs3
-rw-r--r--src/Text/Pandoc/Writers/CommonMark.hs131
-rw-r--r--src/Text/Pandoc/Writers/ConTeXt.hs3
-rw-r--r--src/Text/Pandoc/Writers/Custom.hs5
-rw-r--r--src/Text/Pandoc/Writers/Docbook.hs5
-rw-r--r--src/Text/Pandoc/Writers/Docx.hs7
-rw-r--r--src/Text/Pandoc/Writers/DokuWiki.hs5
-rw-r--r--src/Text/Pandoc/Writers/FB2.hs13
-rw-r--r--src/Text/Pandoc/Writers/HTML.hs3
-rw-r--r--src/Text/Pandoc/Writers/Haddock.hs3
-rw-r--r--src/Text/Pandoc/Writers/ICML.hs5
-rw-r--r--src/Text/Pandoc/Writers/Ipynb.hs10
-rw-r--r--src/Text/Pandoc/Writers/JATS.hs34
-rw-r--r--src/Text/Pandoc/Writers/Jira.hs7
-rw-r--r--src/Text/Pandoc/Writers/LaTeX.hs3
-rw-r--r--src/Text/Pandoc/Writers/Man.hs5
-rw-r--r--src/Text/Pandoc/Writers/Markdown.hs5
-rw-r--r--src/Text/Pandoc/Writers/MediaWiki.hs3
-rw-r--r--src/Text/Pandoc/Writers/Ms.hs5
-rw-r--r--src/Text/Pandoc/Writers/Muse.hs9
-rw-r--r--src/Text/Pandoc/Writers/Native.hs42
-rw-r--r--src/Text/Pandoc/Writers/OpenDocument.hs4
-rw-r--r--src/Text/Pandoc/Writers/Org.hs3
-rw-r--r--src/Text/Pandoc/Writers/Powerpoint/Output.hs4
-rw-r--r--src/Text/Pandoc/Writers/Powerpoint/Presentation.hs18
-rw-r--r--src/Text/Pandoc/Writers/RST.hs3
-rw-r--r--src/Text/Pandoc/Writers/RTF.hs3
-rw-r--r--src/Text/Pandoc/Writers/Shared.hs67
-rw-r--r--src/Text/Pandoc/Writers/TEI.hs5
-rw-r--r--src/Text/Pandoc/Writers/Texinfo.hs3
-rw-r--r--src/Text/Pandoc/Writers/Textile.hs76
-rw-r--r--src/Text/Pandoc/Writers/XWiki.hs6
-rw-r--r--src/Text/Pandoc/Writers/ZimWiki.hs5
58 files changed, 789 insertions, 380 deletions
diff --git a/src/Text/Pandoc/Lua/Marshaling/AST.hs b/src/Text/Pandoc/Lua/Marshaling/AST.hs
index a4087ad87..81b206f67 100644
--- a/src/Text/Pandoc/Lua/Marshaling/AST.hs
+++ b/src/Text/Pandoc/Lua/Marshaling/AST.hs
@@ -150,7 +150,7 @@ peekMetaValue idx = defineHowTo "get MetaValue" $ do
<|> (MetaList <$> Lua.peek idx)
_ -> Lua.throwException "could not get meta value"
--- | Push an block element to the top of the lua stack.
+-- | Push a block element to the top of the Lua stack.
pushBlock :: Block -> Lua ()
pushBlock = \case
BlockQuote blcks -> pushViaConstructor "BlockQuote" blcks
@@ -167,8 +167,8 @@ pushBlock = \case
Para blcks -> pushViaConstructor "Para" blcks
Plain blcks -> pushViaConstructor "Plain" blcks
RawBlock f cs -> pushViaConstructor "RawBlock" f cs
- Table capt aligns widths headers rows ->
- pushViaConstructor "Table" capt aligns widths headers rows
+ Table attr blkCapt specs thead tbody tfoot ->
+ pushViaConstructor "Table" attr blkCapt specs thead tbody tfoot
-- | Return the value at the given index as block if possible.
peekBlock :: StackIndex -> Lua Block
@@ -191,8 +191,13 @@ peekBlock idx = defineHowTo "get Block value" $ do
"Para" -> Para <$> elementContent
"Plain" -> Plain <$> elementContent
"RawBlock" -> uncurry RawBlock <$> elementContent
- "Table" -> (\(capt, aligns, widths, headers, body) ->
- Table capt aligns widths headers body)
+ "Table" -> (\(attr, capt, colSpecs, thead, tbodies, tfoot) ->
+ Table (fromLuaAttr attr)
+ capt
+ colSpecs
+ thead
+ tbodies
+ tfoot)
<$> elementContent
_ -> Lua.throwException ("Unknown block type: " <> tag)
where
@@ -200,6 +205,96 @@ peekBlock idx = defineHowTo "get Block value" $ do
elementContent :: Peekable a => Lua a
elementContent = LuaUtil.rawField idx "c"
+instance Pushable Caption where
+ push = pushCaption
+
+instance Peekable Caption where
+ peek = peekCaption
+
+-- | Push Caption element
+pushCaption :: Caption -> Lua ()
+pushCaption (Caption shortCaption longCaption) = do
+ Lua.newtable
+ LuaUtil.addField "short" (Lua.Optional shortCaption)
+ LuaUtil.addField "long" longCaption
+
+-- | Peek Caption element
+peekCaption :: StackIndex -> Lua Caption
+peekCaption idx = do
+ short <- Lua.fromOptional <$> LuaUtil.rawField idx "short"
+ long <- LuaUtil.rawField idx "long"
+ return $ Caption short long
+
+instance Peekable ColWidth where
+ peek idx = do
+ width <- Lua.fromOptional <$> Lua.peek idx
+ return $ case width of
+ Nothing -> ColWidthDefault
+ Just w -> ColWidth w
+
+instance Pushable ColWidth where
+ push = \case
+ (ColWidth w) -> Lua.push w
+ ColWidthDefault -> Lua.pushnil
+
+instance Pushable Row where
+ push (Row attr cells) = Lua.push (attr, cells)
+
+instance Peekable Row where
+ peek = fmap (uncurry Row) . Lua.peek
+
+instance Pushable TableBody where
+ push (TableBody attr (RowHeadColumns rowHeadColumns) head' body) = do
+ Lua.newtable
+ LuaUtil.addField "attr" attr
+ LuaUtil.addField "row_head_columns" rowHeadColumns
+ LuaUtil.addField "head" head'
+ LuaUtil.addField "body" body
+
+instance Peekable TableBody where
+ peek idx = do
+ attr <- LuaUtil.rawField idx "attr"
+ rowHeadColumns <- LuaUtil.rawField idx "row_head_columns"
+ head' <- LuaUtil.rawField idx "head"
+ body <- LuaUtil.rawField idx "body"
+ return $ TableBody attr (RowHeadColumns rowHeadColumns) head' body
+
+instance Pushable TableHead where
+ push (TableHead attr cells) = Lua.push (attr, cells)
+
+instance Peekable TableHead where
+ peek = fmap (uncurry TableHead) . Lua.peek
+
+instance Pushable TableFoot where
+ push (TableFoot attr cells) = Lua.push (attr, cells)
+
+instance Peekable TableFoot where
+ peek = fmap (uncurry TableFoot) . Lua.peek
+
+instance Pushable Cell where
+ push = pushCell
+
+instance Peekable Cell where
+ peek = peekCell
+
+pushCell :: Cell -> Lua ()
+pushCell (Cell attr align (RowSpan rowSpan) (ColSpan colSpan) contents) = do
+ Lua.newtable
+ LuaUtil.addField "attr" attr
+ LuaUtil.addField "alignment" align
+ LuaUtil.addField "row_span" rowSpan
+ LuaUtil.addField "col_span" colSpan
+ LuaUtil.addField "contents" contents
+
+peekCell :: StackIndex -> Lua Cell
+peekCell idx = do
+ attr <- fromLuaAttr <$> LuaUtil.rawField idx "attr"
+ align <- LuaUtil.rawField idx "alignment"
+ rowSpan <- LuaUtil.rawField idx "row_span"
+ colSpan <- LuaUtil.rawField idx "col_span"
+ contents <- LuaUtil.rawField idx "contents"
+ return $ Cell attr align (RowSpan rowSpan) (ColSpan colSpan) contents
+
-- | Push an inline element to the top of the lua stack.
pushInline :: Inline -> Lua ()
pushInline = \case
diff --git a/src/Text/Pandoc/Lua/Walk.hs b/src/Text/Pandoc/Lua/Walk.hs
index 7043a383d..695c7b44e 100644
--- a/src/Text/Pandoc/Lua/Walk.hs
+++ b/src/Text/Pandoc/Lua/Walk.hs
@@ -55,6 +55,30 @@ instance Walkable (SingletonsList Inline) Block where
walkM = walkBlockM
query = queryBlock
+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
+
+instance Walkable (SingletonsList Inline) Cell where
+ walkM = walkCellM
+ query = queryCell
+
instance Walkable (SingletonsList Inline) MetaValue where
walkM = walkMetaValueM
query = queryMetaValue
@@ -86,6 +110,30 @@ instance Walkable (SingletonsList Block) Block where
walkM = walkBlockM
query = queryBlock
+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
+
+instance Walkable (SingletonsList Block) Cell where
+ walkM = walkCellM
+ query = queryCell
+
instance Walkable (SingletonsList Block) MetaValue where
walkM = walkMetaValueM
query = queryMetaValue
diff --git a/src/Text/Pandoc/Parsing.hs b/src/Text/Pandoc/Parsing.hs
index 9032fc7bd..f79d0fdfc 100644
--- a/src/Text/Pandoc/Parsing.hs
+++ b/src/Text/Pandoc/Parsing.hs
@@ -925,9 +925,16 @@ tableWith :: (Stream s m Char, HasReaderOptions st, Monad mf)
tableWith headerParser rowParser lineParser footerParser = try $ do
(aligns, widths, heads, rows) <- tableWith' headerParser rowParser
lineParser footerParser
- return $ B.table mempty (zip aligns widths) <$> heads <*> rows
+ let th = TableHead nullAttr <$> heads
+ tb = (:[]) . TableBody nullAttr 0 [] <$> rows
+ tf = pure $ TableFoot nullAttr []
+ return $ B.table B.emptyCaption (zip aligns (map fromWidth widths)) <$> th <*> tb <*> tf
+ where
+ fromWidth n
+ | n > 0 = ColWidth n
+ | otherwise = ColWidthDefault
-type TableComponents mf = ([Alignment], [Double], mf [Blocks], mf [[Blocks]])
+type TableComponents mf = ([Alignment], [Double], mf [Row], mf [Row])
tableWith' :: (Stream s m Char, HasReaderOptions st, Monad mf)
=> ParserT s st m (mf [Blocks], [Alignment], [Int])
@@ -943,7 +950,9 @@ tableWith' headerParser rowParser lineParser footerParser = try $ do
let widths = if null indices
then replicate (length aligns) 0.0
else widthsFromIndices numColumns indices
- return (aligns, widths, heads, lines')
+ let toRow = Row nullAttr . map B.simpleCell
+ toHeaderRow l = if null l then [] else [toRow l]
+ return (aligns, widths, toHeaderRow <$> heads, map toRow <$> lines')
-- Calculate relative widths of table columns, based on indices
widthsFromIndices :: Int -- Number of columns on terminal
diff --git a/src/Text/Pandoc/Readers/CSV.hs b/src/Text/Pandoc/Readers/CSV.hs
index fa358424f..384687a6a 100644
--- a/src/Text/Pandoc/Readers/CSV.hs
+++ b/src/Text/Pandoc/Readers/CSV.hs
@@ -30,13 +30,19 @@ readCSV :: PandocMonad m
-> m Pandoc
readCSV _opts s =
case parseCSV defaultCSVOptions (crFilter s) of
- Right (r:rs) -> return $ B.doc $ B.table capt (zip aligns widths) hdrs rows
- where capt = mempty
+ Right (r:rs) -> return $ B.doc $ B.table capt
+ (zip aligns widths)
+ (TableHead nullAttr hdrs)
+ [TableBody nullAttr 0 [] rows]
+ (TableFoot nullAttr [])
+ where capt = B.emptyCaption
numcols = length r
- toplain = B.plain . B.text . T.strip
- hdrs = map toplain r
- rows = map (map toplain) rs
+ toplain = B.simpleCell . B.plain . B.text . T.strip
+ toRow = Row nullAttr . map toplain
+ toHeaderRow l = if null l then [] else [toRow l]
+ hdrs = toHeaderRow r
+ rows = map toRow rs
aligns = replicate numcols AlignDefault
- widths = replicate numcols 0
+ 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 67853aef7..d1f732bf1 100644
--- a/src/Text/Pandoc/Readers/CommonMark.hs
+++ b/src/Text/Pandoc/Readers/CommonMark.hs
@@ -111,31 +111,39 @@ addBlock opts (Node _ (LIST listAttrs) nodes) =
PAREN_DELIM -> OneParen
exts = readerExtensions opts
addBlock opts (Node _ (TABLE alignments) nodes) =
- (Table [] aligns widths 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 0.0
+ widths = replicate numcols ColWidthDefault
numcols = if null rows'
then 0
- else maximum $ map length rows'
+ else maximum $ map rowLength rows'
rows' = map toRow $ filter isRow nodes
(headers, rows) = case rows' of
- (h:rs) -> (h, rs)
+ (h:rs) -> ([h], rs)
[] -> ([], [])
isRow (Node _ TABLE_ROW _) = True
isRow _ = False
isCell (Node _ TABLE_CELL _) = True
isCell _ = False
- toRow (Node _ TABLE_ROW ns) = map toCell $ filter isCell ns
+ toRow (Node _ TABLE_ROW ns) = Row nullAttr $ map toCell $ filter isCell ns
toRow (Node _ t _) = error $ "toRow encountered non-row " ++ show t
- toCell (Node _ TABLE_CELL []) = []
+ toCell (Node _ TABLE_CELL []) = fromSimpleCell []
toCell (Node _ TABLE_CELL (n:ns))
- | isBlockNode n = addBlocks opts (n:ns)
- | otherwise = [Plain (addInlines opts (n:ns))]
+ | 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 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
addBlock _ _ = id
diff --git a/src/Text/Pandoc/Readers/DocBook.hs b/src/Text/Pandoc/Readers/DocBook.hs
index 7f71cb3c1..9757b8914 100644
--- a/src/Text/Pandoc/Readers/DocBook.hs
+++ b/src/Text/Pandoc/Readers/DocBook.hs
@@ -676,10 +676,10 @@ getMediaobject e = do
Just z -> mconcat <$>
mapM parseInline (elContent z)
figTitle <- gets dbFigureTitle
- let (caption, title) = if isNull figTitle
- then (getCaption e, "")
- else (return figTitle, "fig:")
- fmap (imageWith attr imageUrl title) caption
+ let (capt, title) = if isNull figTitle
+ then (getCaption e, "")
+ else (return figTitle, "fig:")
+ fmap (imageWith attr imageUrl title) capt
getBlocks :: PandocMonad m => Element -> DB m Blocks
getBlocks e = mconcat <$>
@@ -844,9 +844,9 @@ parseBlock (Elem e) =
return (mconcat $ intersperse (str "; ") terms', items')
parseTable = do
let isCaption x = named "title" x || named "caption" x
- caption <- case filterChild isCaption e of
- Just t -> getInlines t
- Nothing -> return mempty
+ capt <- case filterChild isCaption e of
+ Just t -> getInlines t
+ Nothing -> return mempty
let e' = fromMaybe e $ filterChild (named "tgroup") e
let isColspec x = named "colspec" x || named "col" x
let colspecs = case filterChild (named "colgroup") e' of
@@ -868,12 +868,12 @@ parseBlock (Elem e) =
Just "right" -> AlignRight
Just "center" -> AlignCenter
_ -> AlignDefault
- let toWidth c = case findAttr (unqual "colwidth") c of
- Just w -> fromMaybe 0
- $ safeRead $ "0" <> T.filter (\x ->
+ let toWidth c = do
+ w <- findAttr (unqual "colwidth") c
+ n <- safeRead $ "0" <> T.filter (\x ->
(x >= '0' && x <= '9')
|| x == '.') (T.pack w)
- Nothing -> 0 :: Double
+ if n > 0 then Just n else Nothing
let numrows = case bodyrows of
[] -> 0
xs -> maximum $ map length xs
@@ -881,17 +881,19 @@ parseBlock (Elem e) =
[] -> replicate numrows AlignDefault
cs -> map toAlignment cs
let widths = case colspecs of
- [] -> replicate numrows 0
- cs -> let ws = map toWidth cs
- tot = sum ws
- in if all (> 0) ws
- then map (/ tot) ws
- else replicate numrows 0
- let headrows' = if null headrows
- then replicate numrows mempty
- else headrows
- return $ table caption (zip aligns widths)
- headrows' bodyrows
+ [] -> replicate numrows ColWidthDefault
+ cs -> let ws = map toWidth cs
+ in case sequence ws of
+ Just ws' -> let tot = sum ws'
+ in ColWidth . (/ tot) <$> ws'
+ Nothing -> replicate numrows ColWidthDefault
+ let toRow = Row nullAttr . map simpleCell
+ toHeaderRow l = if null l then [] else [toRow l]
+ return $ table (simpleCaption $ plain capt)
+ (zip aligns widths)
+ (TableHead nullAttr $ toHeaderRow headrows)
+ [TableBody nullAttr 0 [] $ map toRow bodyrows]
+ (TableFoot nullAttr [])
isEntry x = named "entry" x || named "td" x || named "th" x
parseRow = mapM (parseMixed plain . elContent) . filterChildren isEntry
sect n = do isbook <- gets dbBook
diff --git a/src/Text/Pandoc/Readers/Docx.hs b/src/Text/Pandoc/Readers/Docx.hs
index f616a5b7a..bb86c91b0 100644
--- a/src/Text/Pandoc/Readers/Docx.hs
+++ b/src/Text/Pandoc/Readers/Docx.hs
@@ -72,12 +72,12 @@ import Data.Maybe (isJust, fromMaybe)
import Data.Sequence (ViewL (..), viewl)
import qualified Data.Sequence as Seq
import qualified Data.Set as Set
-import Text.Pandoc.Builder
+import Text.Pandoc.Builder as Pandoc
import Text.Pandoc.MediaBag (MediaBag)
import Text.Pandoc.Options
import Text.Pandoc.Readers.Docx.Combine
import Text.Pandoc.Readers.Docx.Lists
-import Text.Pandoc.Readers.Docx.Parse
+import Text.Pandoc.Readers.Docx.Parse as Docx
import Text.Pandoc.Shared
import Text.Pandoc.Walk
import Text.TeXMath (writeTeX)
@@ -494,13 +494,13 @@ singleParaToPlain blks
singleton $ Plain ils
singleParaToPlain blks = blks
-cellToBlocks :: PandocMonad m => Cell -> DocxContext m Blocks
-cellToBlocks (Cell bps) = do
+cellToBlocks :: PandocMonad m => Docx.Cell -> DocxContext m Blocks
+cellToBlocks (Docx.Cell bps) = do
blks <- smushBlocks <$> mapM bodyPartToBlocks bps
return $ fromList $ blocksToDefinitions $ blocksToBullets $ toList blks
-rowToBlocksList :: PandocMonad m => Row -> DocxContext m [Blocks]
-rowToBlocksList (Row cells) = do
+rowToBlocksList :: PandocMonad m => Docx.Row -> DocxContext m [Blocks]
+rowToBlocksList (Docx.Row cells) = do
blksList <- mapM cellToBlocks cells
return $ map singleParaToPlain blksList
@@ -645,7 +645,7 @@ bodyPartToBlocks (ListItem pPr _ _ _ parparts) =
bodyPartToBlocks (Tbl _ _ _ []) =
return $ para mempty
bodyPartToBlocks (Tbl cap _ look parts@(r:rs)) = do
- let caption = text cap
+ let cap' = simpleCaption $ plain $ text cap
(hdr, rows) = case firstRowFormatting look of
True | null rs -> (Nothing, [r])
| otherwise -> (Just r, rs)
@@ -659,16 +659,19 @@ bodyPartToBlocks (Tbl cap _ look parts@(r:rs)) = do
-- https://github.com/jgm/pandoc/pull/4361#issuecomment-365416155
nonEmpty [] = Nothing
nonEmpty l = Just l
- rowLength :: Row -> Int
- rowLength (Row c) = length c
+ rowLength :: Docx.Row -> Int
+ rowLength (Docx.Row c) = length c
+
+ let toRow = Pandoc.Row nullAttr . map simpleCell
+ toHeaderRow l = if null l then [] else [toRow l]
-- pad cells. New Text.Pandoc.Builder will do that for us,
-- so this is for compatibility while we switch over.
- let cells' = map (\row -> take width (row ++ repeat mempty)) cells
+ let cells' = map (\row -> toRow $ take width (row ++ repeat mempty)) cells
hdrCells <- case hdr of
- Just r' -> rowToBlocksList r'
- Nothing -> return $ replicate width mempty
+ Just r' -> toHeaderRow <$> rowToBlocksList r'
+ Nothing -> return []
-- The two following variables (horizontal column alignment and
-- relative column widths) go to the default at the
@@ -676,9 +679,13 @@ 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 0 :: [Double]
+ widths = replicate width ColWidthDefault
- return $ table caption (zip alignments widths) hdrCells cells'
+ return $ table cap'
+ (zip alignments widths)
+ (TableHead nullAttr hdrCells)
+ [TableBody nullAttr 0 [] cells']
+ (TableFoot nullAttr [])
bodyPartToBlocks (OMathPara e) =
return $ para $ displayMath (writeTeX e)
diff --git a/src/Text/Pandoc/Readers/DokuWiki.hs b/src/Text/Pandoc/Readers/DokuWiki.hs
index 384deb694..8b48789b3 100644
--- a/src/Text/Pandoc/Readers/DokuWiki.hs
+++ b/src/Text/Pandoc/Readers/DokuWiki.hs
@@ -470,8 +470,14 @@ table = do
let (headerRow, body) = if firstSeparator == '^'
then (head rows, tail rows)
else ([], rows)
- let attrs = (AlignDefault, 0.0) <$ transpose rows
- pure $ B.table mempty attrs headerRow body
+ let attrs = (AlignDefault, ColWidthDefault) <$ transpose rows
+ let toRow = Row nullAttr . map B.simpleCell
+ toHeaderRow l = if null l then [] else [toRow l]
+ pure $ B.table B.emptyCaption
+ attrs
+ (TableHead nullAttr $ toHeaderRow headerRow)
+ [TableBody nullAttr 0 [] $ map toRow body]
+ (TableFoot nullAttr [])
tableRows :: PandocMonad m => DWParser m [[B.Blocks]]
tableRows = many1 tableRow
diff --git a/src/Text/Pandoc/Readers/HTML.hs b/src/Text/Pandoc/Readers/HTML.hs
index 798661fe3..a48836446 100644
--- a/src/Text/Pandoc/Readers/HTML.hs
+++ b/src/Text/Pandoc/Readers/HTML.hs
@@ -513,12 +513,18 @@ pTable = try $ do
_ -> replicate cols AlignDefault
let widths = if null widths'
then if isSimple
- then replicate cols 0
- else replicate cols (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 Double
+ let toRow = Row nullAttr . map B.simpleCell
+ toHeaderRow l = if null l then [] else [toRow l]
+ return $ B.table (B.simpleCaption $ B.plain caption)
+ (zip aligns widths)
+ (TableHead nullAttr $ toHeaderRow head')
+ [TableBody nullAttr 0 [] $ map toRow rows]
+ (TableFoot nullAttr [])
+
+pCol :: PandocMonad m => TagParser m ColWidth
pCol = try $ do
TagOpen _ attribs' <- pSatisfy (matchTagOpen "col" [])
let attribs = toStringAttr attribs'
@@ -535,10 +541,10 @@ pCol = try $ do
fromMaybe 0.0 $ safeRead xs
_ -> 0.0
if width > 0.0
- then return $ width / 100.0
- else return 0.0
+ then return $ ColWidth $ width / 100.0
+ else return ColWidthDefault
-pColgroup :: PandocMonad m => TagParser m [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 749a63114..8fe5e062c 100644
--- a/src/Text/Pandoc/Readers/Haddock.hs
+++ b/src/Text/Pandoc/Readers/Haddock.hs
@@ -85,14 +85,20 @@ docHToBlocks d' =
, tableBodyRows = bodyRows
}
-> let toCells = map (docHToBlocks . tableCellContents) . tableRowCells
+ toRow = Row nullAttr . map B.simpleCell
+ toHeaderRow l = if null l then [] else [toRow l]
(header, body) =
if null headerRows
then ([], map toCells bodyRows)
else (toCells (head headerRows),
map toCells (tail headerRows ++ bodyRows))
colspecs = replicate (maximum (map length body))
- (AlignDefault, 0.0)
- in B.table mempty colspecs header body
+ (AlignDefault, ColWidthDefault)
+ in B.table B.emptyCaption
+ colspecs
+ (TableHead nullAttr $ toHeaderRow header)
+ [TableBody nullAttr 0 [] $ map toRow body]
+ (TableFoot nullAttr [])
where inlineFallback = B.plain $ docHToInlines False d'
consolidatePlains = B.fromList . consolidatePlains' . B.toList
diff --git a/src/Text/Pandoc/Readers/Ipynb.hs b/src/Text/Pandoc/Readers/Ipynb.hs
index bfd9572ce..079eacf97 100644
--- a/src/Text/Pandoc/Readers/Ipynb.hs
+++ b/src/Text/Pandoc/Readers/Ipynb.hs
@@ -69,7 +69,7 @@ notebookToPandoc opts notebook = do
return $ Pandoc (Meta $ M.insert "jupyter" (MetaMap m) mempty) blocks
cellToBlocks :: PandocMonad m
- => ReaderOptions -> Text -> Cell a -> m B.Blocks
+ => ReaderOptions -> Text -> Ipynb.Cell a -> m B.Blocks
cellToBlocks opts lang c = do
let Source ts = cellSource c
let source = mconcat ts
diff --git a/src/Text/Pandoc/Readers/JATS.hs b/src/Text/Pandoc/Readers/JATS.hs
index 3672b05f6..f78630ec0 100644
--- a/src/Text/Pandoc/Readers/JATS.hs
+++ b/src/Text/Pandoc/Readers/JATS.hs
@@ -134,14 +134,14 @@ getGraphic :: PandocMonad m
=> Maybe (Inlines, Text) -> Element -> JATS m Inlines
getGraphic mbfigdata e = do
let atVal a = attrValue a e
- (ident, title, caption) =
+ (ident, title, capt) =
case mbfigdata of
- Just (capt, i) -> (i, "fig:" <> atVal "title", capt)
+ Just (capt', i) -> (i, "fig:" <> atVal "title", capt')
Nothing -> (atVal "id", atVal "title",
text (atVal "alt-text"))
attr = (ident, T.words $ atVal "role", [])
imageUrl = atVal "href"
- return $ imageWith attr imageUrl title caption
+ return $ imageWith attr imageUrl title capt
getBlocks :: PandocMonad m => Element -> JATS m Blocks
getBlocks e = mconcat <$>
@@ -230,20 +230,20 @@ parseBlock (Elem e) =
-- implicit figure. otherwise, we emit a div with the contents
case filterChildren (named "graphic") e of
[g] -> do
- caption <- case filterChild (named "caption") e of
- Just t -> mconcat .
- intersperse linebreak <$>
- mapM getInlines
- (filterChildren (const True) t)
- Nothing -> return mempty
- img <- getGraphic (Just (caption, attrValue "id" e)) g
+ capt <- case filterChild (named "caption") e of
+ Just t -> mconcat .
+ intersperse linebreak <$>
+ mapM getInlines
+ (filterChildren (const True) t)
+ Nothing -> return mempty
+ img <- getGraphic (Just (capt, attrValue "id" e)) g
return $ para img
_ -> divWith (attrValue "id" e, ["fig"], []) <$> getBlocks e
parseTable = do
let isCaption x = named "title" x || named "caption" x
- caption <- case filterChild isCaption e of
- Just t -> getInlines t
- Nothing -> return mempty
+ capt <- case filterChild isCaption e of
+ Just t -> getInlines t
+ Nothing -> return mempty
let e' = fromMaybe e $ filterChild (named "tgroup") e
let isColspec x = named "colspec" x || named "col" x
let colspecs = case filterChild (named "colgroup") e' of
@@ -265,27 +265,28 @@ parseBlock (Elem e) =
Just "right" -> AlignRight
Just "center" -> AlignCenter
_ -> AlignDefault
- let toWidth c = case findAttrText (unqual "colwidth") c of
- Just w -> fromMaybe 0
- $ safeRead $ "0" <> T.filter (\x ->
- isDigit x || x == '.') w
- Nothing -> 0 :: Double
+ let toWidth c = do
+ w <- findAttrText (unqual "colwidth") c
+ n <- safeRead $ "0" <> T.filter (\x -> isDigit x || x == '.') w
+ if n > 0 then Just n else Nothing
let numrows = foldl' max 0 $ map length bodyrows
let aligns = case colspecs of
[] -> replicate numrows AlignDefault
cs -> map toAlignment cs
let widths = case colspecs of
- [] -> replicate numrows 0
- cs -> let ws = map toWidth cs
- tot = sum ws
- in if all (> 0) ws
- then map (/ tot) ws
- else replicate numrows 0
- let headrows' = if null headrows
- then replicate numrows mempty
- else headrows
- return $ table caption (zip aligns widths)
- headrows' bodyrows
+ [] -> replicate numrows ColWidthDefault
+ cs -> let ws = map toWidth cs
+ in case sequence ws of
+ Just ws' -> let tot = sum ws'
+ in ColWidth . (/ tot) <$> ws'
+ Nothing -> replicate numrows ColWidthDefault
+ let toRow = Row nullAttr . map simpleCell
+ toHeaderRow l = if null l then [] else [toRow l]
+ return $ table (simpleCaption $ plain capt)
+ (zip aligns widths)
+ (TableHead nullAttr $ toHeaderRow headrows)
+ [TableBody nullAttr 0 [] $ map toRow bodyrows]
+ (TableFoot nullAttr [])
isEntry x = named "entry" x || named "td" x || named "th" x
parseRow = mapM (parseMixed plain . elContent) . filterChildren isEntry
sect n = do isbook <- gets jatsBook
diff --git a/src/Text/Pandoc/Readers/Jira.hs b/src/Text/Pandoc/Readers/Jira.hs
index d0900fd08..fd96cbc4d 100644
--- a/src/Text/Pandoc/Readers/Jira.hs
+++ b/src/Text/Pandoc/Readers/Jira.hs
@@ -16,7 +16,7 @@ import Data.Text (Text, append, pack, singleton, unpack)
import Text.HTML.TagSoup.Entity (lookupEntity)
import Text.Jira.Parser (parse)
import Text.Pandoc.Class.PandocMonad (PandocMonad (..))
-import Text.Pandoc.Builder
+import Text.Pandoc.Builder hiding (cell)
import Text.Pandoc.Error (PandocError (PandocParseError))
import Text.Pandoc.Options (ReaderOptions)
import Text.Pandoc.Shared (stringify)
diff --git a/src/Text/Pandoc/Readers/LaTeX.hs b/src/Text/Pandoc/Readers/LaTeX.hs
index 038430f99..cdd2c1362 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, Double, ([Tok], [Tok]))]
+parseAligns :: PandocMonad m => LP m [(Alignment, ColWidth, ([Tok], [Tok]))]
parseAligns = try $ do
let maybeBar = skipMany
(try $ sp *> (() <$ symbol '|' <|> () <$ (symbol '@' >> braced)))
@@ -2289,17 +2289,15 @@ parseAligns = try $ do
ds <- trim . untokenize <$> manyTill anyTok (controlSeq "linewidth")
spaces
symbol '}'
- case safeRead ds of
- Just w -> return w
- Nothing -> return 0.0
+ return $ safeRead ds
let alignSpec = do
pref <- option [] alignPrefix
spaces
al <- alignChar
- width <- colWidth <|> option 0.0 (do s <- untokenize <$> braced
- pos <- getPosition
- report $ SkippedContent s pos
- return 0.0)
+ width <- colWidth <|> option Nothing (do s <- untokenize <$> braced
+ pos <- getPosition
+ report $ SkippedContent s pos
+ return Nothing)
spaces
suff <- option [] alignSuffix
return (al, width, (pref, suff))
@@ -2321,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
@@ -2370,7 +2372,6 @@ simpTable envname hasWidthParameter = try $ do
skipopts
colspecs <- parseAligns
let (aligns, widths, prefsufs) = unzip3 colspecs
- let cols = length colspecs
optional $ controlSeq "caption" *> setCaption
spaces
optional label
@@ -2391,19 +2392,22 @@ simpTable envname hasWidthParameter = try $ do
spaces
optional lbreak
spaces
- let header'' = if null header'
- then replicate cols mempty
- else header'
lookAhead $ controlSeq "end" -- make sure we're at end
- return $ table mempty (zip aligns widths) header'' rows
+ let toRow = Row nullAttr . map simpleCell
+ toHeaderRow l = if null l then [] else [toRow l]
+ return $ table emptyCaption
+ (zip aligns widths)
+ (TableHead nullAttr $ toHeaderRow header')
+ [TableBody nullAttr 0 [] $ map toRow rows]
+ (TableFoot nullAttr [])
addTableCaption :: PandocMonad m => Blocks -> LP m Blocks
addTableCaption = walkM go
- where go (Table c als ws hs rs) = 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 $ toList ils
+ (Just ils, Nothing) -> return $ caption Nothing (plain ils)
(Just ils, Just lab) -> do
num <- getNextNumber sLastTableNum
setState
@@ -2411,13 +2415,12 @@ addTableCaption = walkM go
, sLabels = M.insert lab
[Str (renderDottedNum num)]
(sLabels st) }
- return $ toList ils -- add number??
+ return $ caption Nothing (plain ils) -- add number??
(Nothing, _) -> return c
return $ maybe id (\ident -> Div (ident, [], []) . (:[])) mblabel $
- Table capt als ws hs rs
+ Table attr capt spec th tb tf
go x = return x
-
block :: PandocMonad m => LP m Blocks
block = do
res <- (mempty <$ spaces1)
diff --git a/src/Text/Pandoc/Readers/Man.hs b/src/Text/Pandoc/Readers/Man.hs
index c14cbea52..12001b534 100644
--- a/src/Text/Pandoc/Readers/Man.hs
+++ b/src/Text/Pandoc/Readers/Man.hs
@@ -107,11 +107,12 @@ parseTable = do
bodyRows <- mapM (mapM parseTableCell . snd) bodyRows'
isPlainTable <- tableCellsPlain <$> getState
let widths = if isPlainTable
- then repeat 0.0
- else repeat ((1.0 / fromIntegral (length alignments))
- :: Double)
- return $ B.table mempty (zip alignments widths)
- headerRow bodyRows) <|> fallback pos
+ then repeat ColWidthDefault
+ else repeat $ ColWidth (1.0 / fromIntegral (length alignments))
+ return $ B.table B.emptyCaption (zip alignments widths)
+ (TableHead nullAttr $ toHeaderRow headerRow)
+ [TableBody nullAttr 0 [] $ map toRow bodyRows]
+ (TableFoot nullAttr [])) <|> fallback pos
[] -> fallback pos
where
@@ -160,6 +161,8 @@ parseTable = do
'r' -> Just AlignRight
_ -> Nothing
+ toRow = Row nullAttr . map simpleCell
+ toHeaderRow l = if null l then [] else [toRow l]
parseNewParagraph :: PandocMonad m => ManParser m Blocks
parseNewParagraph = do
diff --git a/src/Text/Pandoc/Readers/Markdown.hs b/src/Text/Pandoc/Readers/Markdown.hs
index 66f4df341..72a0975fd 100644
--- a/src/Text/Pandoc/Readers/Markdown.hs
+++ b/src/Text/Pandoc/Readers/Markdown.hs
@@ -28,11 +28,11 @@ import qualified Data.Text as T
import qualified Data.Text.Lazy as TL
import qualified Data.ByteString.Lazy as BL
import System.FilePath (addExtension, takeExtension)
-import Text.HTML.TagSoup
+import Text.HTML.TagSoup hiding (Row)
import Text.Pandoc.Builder (Blocks, Inlines)
import qualified Text.Pandoc.Builder as B
import Text.Pandoc.Class.PandocMonad (PandocMonad (..), report)
-import Text.Pandoc.Definition
+import Text.Pandoc.Definition as Pandoc
import Text.Pandoc.Emoji (emojiToInline)
import Text.Pandoc.Error
import Text.Pandoc.Logging
@@ -1163,7 +1163,7 @@ simpleTableHeader headless = try $ do
else return rawContent
let aligns = zipWith alignType (map (: []) rawHeads) lengths
let rawHeads' = if headless
- then replicate (length dashes) ""
+ then []
else rawHeads
heads <- fmap sequence
$
@@ -1235,7 +1235,7 @@ tableCaption = try $ do
-- Parse a simple table with '---' header and one line per row.
simpleTable :: PandocMonad m
=> Bool -- ^ Headerless table
- -> MarkdownParser m ([Alignment], [Double], F [Blocks], F [[Blocks]])
+ -> MarkdownParser m ([Alignment], [Double], F [Row], F [Row])
simpleTable headless = do
(aligns, _widths, heads', lines') <-
tableWith (simpleTableHeader headless) tableLine
@@ -1250,7 +1250,7 @@ simpleTable headless = do
-- ending with a footer (dashed line followed by blank line).
multilineTable :: PandocMonad m
=> Bool -- ^ Headerless table
- -> MarkdownParser m ([Alignment], [Double], F [Blocks], F [[Blocks]])
+ -> MarkdownParser m ([Alignment], [Double], F [Row], F [Row])
multilineTable headless =
tableWith (multilineTableHeader headless) multilineRow blanklines tableFooter
@@ -1281,7 +1281,7 @@ multilineTableHeader headless = try $ do
rawContent
let aligns = zipWith alignType rawHeadsList lengths
let rawHeads = if headless
- then replicate (length dashes) ""
+ then []
else map (T.unlines . map trim) rawHeadsList
heads <- fmap sequence $
mapM (parseFromString' (mconcat <$> many plain).trim) rawHeads
@@ -1292,7 +1292,7 @@ multilineTableHeader headless = try $ do
-- which may be grid, separated by blank lines, and
-- ending with a footer (dashed line followed by blank line).
gridTable :: PandocMonad m => Bool -- ^ Headerless table
- -> MarkdownParser m ([Alignment], [Double], F [Blocks], F [[Blocks]])
+ -> MarkdownParser m ([Alignment], [Double], F [Row], F [Row])
gridTable headless = gridTableWith' parseBlocks headless
pipeBreak :: PandocMonad m => MarkdownParser m ([Alignment], [Int])
@@ -1307,7 +1307,7 @@ pipeBreak = try $ do
blankline
return $ unzip (first:rest)
-pipeTable :: PandocMonad m => MarkdownParser m ([Alignment], [Double], F [Blocks], F [[Blocks]])
+pipeTable :: PandocMonad m => MarkdownParser m ([Alignment], [Double], F [Row], F [Row])
pipeTable = try $ do
nonindentSpaces
lookAhead nonspaceChar
@@ -1323,7 +1323,7 @@ pipeTable = try $ do
fromIntegral len / fromIntegral (sum seplengths))
seplengths
else replicate (length aligns) 0.0
- return (aligns, widths, heads', sequence lines'')
+ return (aligns, widths, toHeaderRow <$> heads', map toRow <$> sequence lines'')
sepPipe :: PandocMonad m => MarkdownParser m ()
sepPipe = try $ do
@@ -1384,7 +1384,7 @@ tableWith :: PandocMonad m
-> ([Int] -> MarkdownParser m (F [Blocks]))
-> MarkdownParser m sep
-> MarkdownParser m end
- -> MarkdownParser m ([Alignment], [Double], F [Blocks], F [[Blocks]])
+ -> MarkdownParser m ([Alignment], [Double], F [Row], F [Row])
tableWith headerParser rowParser lineParser footerParser = try $ do
(heads, aligns, indices) <- headerParser
lines' <- fmap sequence $ rowParser indices `sepEndBy1` lineParser
@@ -1393,7 +1393,7 @@ tableWith headerParser rowParser lineParser footerParser = try $ do
let widths = if null indices
then replicate (length aligns) 0.0
else widthsFromIndices numColumns indices
- return (aligns, widths, heads, lines')
+ return (aligns, widths, toHeaderRow <$> heads, map toRow <$> lines')
table :: PandocMonad m => MarkdownParser m (F Blocks)
table = try $ do
@@ -1417,11 +1417,18 @@ table = try $ do
let widths' = if totalWidth < 1
then widths
else map (/ totalWidth) widths
+ let strictPos w
+ | w > 0 = ColWidth w
+ | otherwise = ColWidthDefault
return $ do
caption' <- caption
heads' <- heads
lns' <- lns
- return $ B.table caption' (zip aligns widths') heads' lns'
+ return $ B.table (B.simpleCaption $ B.plain caption')
+ (zip aligns (strictPos <$> widths'))
+ (TableHead nullAttr heads')
+ [TableBody nullAttr 0 [] lns']
+ (TableFoot nullAttr [])
--
-- inline
@@ -2110,3 +2117,9 @@ doubleQuoted = try $ do
withQuoteContext InDoubleQuote $
fmap B.doubleQuoted . trimInlinesF . mconcat <$>
many1Till inline doubleQuoteEnd
+
+toRow :: [Blocks] -> Row
+toRow = Row nullAttr . map B.simpleCell
+
+toHeaderRow :: [Blocks] -> [Row]
+toHeaderRow l = if null l then [] else [toRow l]
diff --git a/src/Text/Pandoc/Readers/MediaWiki.hs b/src/Text/Pandoc/Readers/MediaWiki.hs
index a2ff51379..6bcc4735e 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 0.0
- else restwidth / fromIntegral zerocols
- let widths' = map (\w -> if w == 0 then defaultwidth else 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
@@ -232,7 +232,13 @@ table = do
let (headers,rows) = if hasheader
then (hdr, rows')
else (replicate cols mempty, hdr:rows')
- return $ B.table caption cellspecs headers rows
+ let toRow = Row nullAttr . map B.simpleCell
+ toHeaderRow l = if null l then [] else [toRow l]
+ return $ B.table (B.simpleCaption $ B.plain caption)
+ cellspecs
+ (TableHead nullAttr $ toHeaderRow headers)
+ [TableBody nullAttr 0 [] $ map toRow rows]
+ (TableFoot nullAttr [])
parseAttrs :: PandocMonad m => MWParser m [(Text,Text)]
parseAttrs = many1 parseAttr
diff --git a/src/Text/Pandoc/Readers/Muse.hs b/src/Text/Pandoc/Readers/Muse.hs
index a5def2479..987028910 100644
--- a/src/Text/Pandoc/Readers/Muse.hs
+++ b/src/Text/Pandoc/Readers/Muse.hs
@@ -645,9 +645,15 @@ data MuseTableElement = MuseHeaderRow [Blocks]
museToPandocTable :: MuseTable -> Blocks
museToPandocTable (MuseTable caption headers body footers) =
- B.table caption attrs headRow (rows ++ body ++ footers)
- where attrs = (AlignDefault, 0.0) <$ transpose (headers ++ body ++ footers)
+ B.table (B.simpleCaption $ B.plain caption)
+ attrs
+ (TableHead nullAttr $ toHeaderRow headRow)
+ [TableBody nullAttr 0 [] $ map toRow $ rows ++ body ++ footers]
+ (TableFoot nullAttr [])
+ where attrs = (AlignDefault, ColWidthDefault) <$ transpose (headers ++ body ++ footers)
(headRow, rows) = fromMaybe ([], []) $ uncons headers
+ toRow = Row nullAttr . map B.simpleCell
+ toHeaderRow l = if null l then [] else [toRow l]
museAppendElement :: MuseTableElement
-> MuseTable
@@ -693,8 +699,13 @@ museGridTable = try $ do
indent <- getIndent
indices <- museGridTableHeader
fmap rowsToTable . sequence <$> many1 (museGridTableRow indent indices)
- where rowsToTable rows = B.table mempty attrs [] rows
- where attrs = (AlignDefault, 0.0) <$ transpose rows
+ where rowsToTable rows = B.table B.emptyCaption
+ attrs
+ (TableHead nullAttr [])
+ [TableBody nullAttr 0 [] $ map toRow rows]
+ (TableFoot nullAttr [])
+ where attrs = (AlignDefault, ColWidthDefault) <$ transpose rows
+ toRow = Row nullAttr . map B.simpleCell
-- | 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 69c8e2924..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 _ a w h r : Div ("", ["caption"], _) [Para inlines] : xs) =
- Table inlines a w h r : 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 c80c179c6..b2cf3b3ec 100644
--- a/src/Text/Pandoc/Readers/Org/Blocks.hs
+++ b/src/Text/Pandoc/Readers/Org/Blocks.hs
@@ -627,16 +627,22 @@ orgToPandocTable (OrgTable colProps heads lns) caption =
let totalWidth = if any (isJust . columnRelWidth) colProps
then Just . sum $ map (fromMaybe 1 . columnRelWidth) colProps
else Nothing
- in B.table caption (map (convertColProp totalWidth) colProps) heads lns
+ in B.table (B.simpleCaption $ B.plain caption)
+ (map (convertColProp totalWidth) colProps)
+ (TableHead nullAttr $ toHeaderRow heads)
+ [TableBody nullAttr 0 [] $ map toRow lns]
+ (TableFoot nullAttr [])
where
- convertColProp :: Maybe Int -> ColumnProperty -> (Alignment, Double)
+ toRow = Row nullAttr . map B.simpleCell
+ toHeaderRow l = if null l then [] else [toRow l]
+ convertColProp :: Maybe Int -> ColumnProperty -> (Alignment, ColWidth)
convertColProp totalWidth colProp =
let
align' = fromMaybe AlignDefault $ columnAlignment colProp
- width' = fromMaybe 0 $ (\w t -> (fromIntegral w / fromIntegral t))
- <$> columnRelWidth colProp
- <*> totalWidth
- in (align', width')
+ width' = (\w t -> (fromIntegral w / fromIntegral t))
+ <$> columnRelWidth colProp
+ <*> totalWidth
+ in (align', maybe ColWidthDefault ColWidth width')
tableRows :: PandocMonad m => OrgParser m [OrgTableRow]
tableRows = try $ many (tableAlignRow <|> tableHline <|> tableContentRow)
@@ -658,16 +664,16 @@ tableAlignRow = try $ do
return $ OrgAlignRow colProps
columnPropertyCell :: Monad m => OrgParser m ColumnProperty
-columnPropertyCell = emptyCell <|> propCell <?> "alignment info"
+columnPropertyCell = emptyOrgCell <|> propCell <?> "alignment info"
where
- emptyCell = ColumnProperty Nothing Nothing <$ try (skipSpaces *> endOfCell)
+ emptyOrgCell = ColumnProperty Nothing Nothing <$ try (skipSpaces *> endOfCell)
propCell = try $ ColumnProperty
<$> (skipSpaces
*> char '<'
*> optionMaybe tableAlignFromChar)
<*> (optionMaybe (many1Char digit >>= safeRead)
<* char '>'
- <* emptyCell)
+ <* emptyOrgCell)
tableAlignFromChar :: Monad m => OrgParser m Alignment
tableAlignFromChar = try $
diff --git a/src/Text/Pandoc/Readers/RST.hs b/src/Text/Pandoc/Readers/RST.hs
index 430d24f4a..4acdc10c2 100644
--- a/src/Text/Pandoc/Readers/RST.hs
+++ b/src/Text/Pandoc/Readers/RST.hs
@@ -770,24 +770,34 @@ tableDirective :: PandocMonad m
tableDirective top fields body = do
bs <- parseFromString' parseBlocks body
case B.toList bs of
- [Table _ aligns' widths' header' rows'] -> 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 = length header'
+ let numOfCols = case thrs of
+ [] -> 0
+ (r:_) -> rowLength r
let normWidths ws =
- map (/ max 1.0 (fromIntegral (columns - numOfCols))) ws
+ strictPos . (/ max 1.0 (fromIntegral (columns - numOfCols))) <$> ws
let widths = case trim <$> lookup "widths" fields of
- Just "auto" -> replicate numOfCols 0.0
+ Just "auto" -> replicate numOfCols ColWidthDefault
Just "grid" -> widths'
Just specs -> normWidths
$ map (fromMaybe (0 :: Double) . safeRead)
$ splitTextBy (`elem` (" ," :: String)) specs
Nothing -> widths'
-- align is not applicable since we can't represent whole table align
- return $ B.singleton $ Table (B.toList title)
- aligns' widths header' rows'
+ let tspecs = zip aligns' widths
+ 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 _ _ _ (ColSpan w) _) = max 1 w
+ strictPos w
+ | w > 0 = ColWidth w
+ | otherwise = ColWidthDefault
-- TODO: :stub-columns:.
-- Only the first row becomes the header even if header-rows: > 1,
@@ -808,19 +818,25 @@ listTableDirective top fields body = do
else ([], rows, length x)
_ -> ([],[],0)
widths = case trim <$> lookup "widths" fields of
- Just "auto" -> replicate numOfCols 0
+ Just "auto" -> replicate numOfCols ColWidthDefault
Just specs -> normWidths $ map (fromMaybe (0 :: Double) . safeRead) $
splitTextBy (`elem` (" ," :: String)) specs
- _ -> replicate numOfCols 0
- return $ B.table title
+ _ -> replicate numOfCols ColWidthDefault
+ toRow = Row nullAttr . map B.simpleCell
+ toHeaderRow l = if null l then [] else [toRow l]
+ return $ B.table (B.simpleCaption $ B.plain title)
(zip (replicate numOfCols AlignDefault) widths)
- headerRow
- bodyRows
+ (TableHead nullAttr $ toHeaderRow headerRow)
+ [TableBody nullAttr 0 [] $ map toRow bodyRows]
+ (TableFoot nullAttr [])
where takeRows [BulletList rows] = map takeCells rows
takeRows _ = []
takeCells [BulletList cells] = map B.fromList cells
takeCells _ = []
- normWidths ws = map (/ max 1 (sum ws)) ws
+ normWidths ws = strictPos . (/ max 1 (sum ws)) <$> ws
+ strictPos w
+ | w > 0 = ColWidth w
+ | otherwise = ColWidthDefault
csvTableDirective :: PandocMonad m
=> Text -> [(Text, Text)] -> Text
@@ -873,18 +889,24 @@ csvTableDirective top fields rawcsv = do
else ([], rows, length x)
_ -> ([],[],0)
title <- parseFromString' (trimInlines . mconcat <$> many inline) top
- let normWidths ws = map (/ max 1 (sum ws)) ws
+ let strictPos w
+ | 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 0
+ Just "auto" -> replicate numOfCols ColWidthDefault
Just specs -> normWidths
$ map (fromMaybe (0 :: Double) . safeRead)
$ splitTextBy (`elem` (" ," :: String)) specs
- _ -> replicate numOfCols 0
- return $ B.table title
- (zip (replicate numOfCols AlignDefault) widths)
- headerRow
- bodyRows
+ _ -> replicate numOfCols ColWidthDefault
+ let toRow = Row nullAttr . map B.simpleCell
+ toHeaderRow l = if null l then [] else [toRow l]
+ return $ B.table (B.simpleCaption $ B.plain title)
+ (zip (replicate numOfCols AlignDefault) widths)
+ (TableHead nullAttr $ toHeaderRow headerRow)
+ [TableBody nullAttr 0 [] $ map toRow bodyRows]
+ (TableFoot nullAttr [])
-- TODO:
-- - Only supports :format: fields with a single format for :raw: roles,
@@ -1293,13 +1315,14 @@ simpleTable headless = do
sep simpleTableFooter
-- Simple tables get 0s for relative column widths (i.e., use default)
case B.toList tbl of
- [Table c a _w h l] -> return $ B.singleton $
- Table c a (replicate (length a) 0) h l
+ [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 ColWidthDefault
gridTable :: PandocMonad m
=> Bool -- ^ Headerless table
diff --git a/src/Text/Pandoc/Readers/TWiki.hs b/src/Text/Pandoc/Readers/TWiki.hs
index ee6a80ce3..4df1de045 100644
--- a/src/Text/Pandoc/Readers/TWiki.hs
+++ b/src/Text/Pandoc/Readers/TWiki.hs
@@ -228,12 +228,18 @@ table = try $ do
return $ buildTable mempty rows $ fromMaybe (align rows, columns rows) tableHead
where
buildTable caption rows (aligns, heads)
- = B.table caption aligns heads rows
- align rows = replicate (columCount rows) (AlignDefault, 0)
+ = B.table (B.simpleCaption $ B.plain caption)
+ aligns
+ (TableHead nullAttr $ toHeaderRow heads)
+ [TableBody nullAttr 0 [] $ map toRow rows]
+ (TableFoot nullAttr [])
+ align rows = replicate (columCount rows) (AlignDefault, ColWidthDefault)
columns rows = replicate (columCount rows) mempty
columCount rows = length $ head rows
+ toRow = Row nullAttr . map B.simpleCell
+ toHeaderRow l = if null l then [] else [toRow l]
-tableParseHeader :: PandocMonad m => TWParser m ((Alignment, Double), B.Blocks)
+tableParseHeader :: PandocMonad m => TWParser m ((Alignment, ColWidth), B.Blocks)
tableParseHeader = try $ do
char '|'
leftSpaces <- length <$> many spaceChar
@@ -245,9 +251,9 @@ tableParseHeader = try $ do
return (tableAlign leftSpaces rightSpaces, content)
where
tableAlign left right
- | left >= 2 && left == right = (AlignCenter, 0)
- | left > right = (AlignRight, 0)
- | otherwise = (AlignLeft, 0)
+ | 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 5aae11751..fef192fd3 100644
--- a/src/Text/Pandoc/Readers/Textile.hs
+++ b/src/Text/Pandoc/Readers/Textile.hs
@@ -377,10 +377,13 @@ table = try $ do
_ -> (mempty, rawrows)
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 0.0))
- (map snd headers)
- (map (map snd) rows)
+ let toRow = Row nullAttr . map B.simpleCell
+ toHeaderRow l = if null l then [] else [toRow l]
+ return $ B.table (B.simpleCaption $ B.plain caption)
+ (zip aligns (replicate nbOfCols ColWidthDefault))
+ (TableHead nullAttr $ toHeaderRow $ map snd headers)
+ [TableBody nullAttr 0 [] $ map (toRow . map snd) rows]
+ (TableFoot nullAttr [])
-- | Ignore markers for cols, thead, tfoot.
ignorableRow :: PandocMonad m => ParserT Text ParserState m ()
diff --git a/src/Text/Pandoc/Readers/Txt2Tags.hs b/src/Text/Pandoc/Readers/Txt2Tags.hs
index 68ba6dd7a..c5c87e471 100644
--- a/src/Text/Pandoc/Readers/Txt2Tags.hs
+++ b/src/Text/Pandoc/Readers/Txt2Tags.hs
@@ -267,9 +267,13 @@ table = try $ do
let size = maximum (map length rows')
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 0.0))
- headerPadded rowsPadded
+ let toRow = Row nullAttr . map B.simpleCell
+ toHeaderRow l = if null l then [] else [toRow l]
+ return $ B.table B.emptyCaption
+ (zip aligns (replicate ncolumns ColWidthDefault))
+ (TableHead nullAttr $ toHeaderRow headerPadded)
+ [TableBody nullAttr 0 [] $ map toRow rowsPadded]
+ (TableFoot nullAttr [])
pad :: (Monoid a) => Int -> [a] -> [a]
pad n xs = xs ++ replicate (n - length xs) mempty
diff --git a/src/Text/Pandoc/Shared.hs b/src/Text/Pandoc/Shared.hs
index 8bd10e564..1593106de 100644
--- a/src/Text/Pandoc/Shared.hs
+++ b/src/Text/Pandoc/Shared.hs
@@ -667,7 +667,7 @@ stripEmptyParagraphs = walk go
-- | Detect if table rows contain only cells consisting of a single
-- paragraph that has no @LineBreak@.
-onlySimpleTableCells :: [[TableCell]] -> Bool
+onlySimpleTableCells :: [[[Block]]] -> Bool
onlySimpleTableCells = all isSimpleCell . concat
where
isSimpleCell [Plain ils] = not (hasLineBreak ils)
@@ -992,9 +992,14 @@ blockToInlines (DefinitionList pairslst) =
mconcat (map blocksToInlines' blkslst)
blockToInlines (Header _ _ ils) = B.fromList ils
blockToInlines HorizontalRule = mempty
-blockToInlines (Table _ _ _ headers rows) =
+blockToInlines (Table _ _ _ (TableHead _ hbd) bodies (TableFoot _ fbd)) =
mconcat $ intersperse B.linebreak $
- map (mconcat . map blocksToInlines') (headers:rows)
+ 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
@@ -1016,7 +1021,6 @@ defaultBlocksSeparator =
-- there should be updated if this is changed.
B.space <> B.str "¶" <> B.space
-
--
-- Safe read
--
diff --git a/src/Text/Pandoc/Writers/AsciiDoc.hs b/src/Text/Pandoc/Writers/AsciiDoc.hs
index 08af578a7..e0ee830de 100644
--- a/src/Text/Pandoc/Writers/AsciiDoc.hs
+++ b/src/Text/Pandoc/Writers/AsciiDoc.hs
@@ -191,7 +191,8 @@ blockToAsciiDoc opts (BlockQuote blocks) = do
else contents
let bar = text "____"
return $ bar $$ chomp contents' $$ bar <> blankline
-blockToAsciiDoc opts (Table caption aligns widths headers rows) = 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
then empty
diff --git a/src/Text/Pandoc/Writers/CommonMark.hs b/src/Text/Pandoc/Writers/CommonMark.hs
index 48a6934eb..bab74c77c 100644
--- a/src/Text/Pandoc/Writers/CommonMark.hs
+++ b/src/Text/Pandoc/Writers/CommonMark.hs
@@ -154,71 +154,72 @@ blockToNodes opts (DefinitionList items) ns =
Plain (term ++ [LineBreak] ++ xs) : ys ++ concat zs
dlToBullet (term, xs) =
Para term : concat xs
-blockToNodes opts t@(Table capt aligns _widths headers rows) ns =
- if isEnabled Ext_pipe_tables opts && onlySimpleTableCells (headers:rows)
- then do
- -- We construct a table manually as a CUSTOM_BLOCK, for
- -- two reasons: (1) cmark-gfm currently doesn't support
- -- rendering TABLE nodes; (2) we can align the column sides;
- -- (3) we can render the caption as a regular paragraph.
- let capt' = node PARAGRAPH (inlinesToNodes opts capt)
- -- backslash | in code and raw:
- let fixPipe (Code attr xs) =
- Code attr (T.replace "|" "\\|" xs)
- fixPipe (RawInline format xs) =
- RawInline format (T.replace "|" "\\|" xs)
- fixPipe x = x
- let toCell [Plain ils] = T.strip
- $ nodeToCommonmark [] Nothing
- $ node (CUSTOM_INLINE mempty mempty)
- $ inlinesToNodes opts
- $ walk (fixPipe . softBreakToSpace) ils
- toCell [Para ils] = T.strip
- $ nodeToCommonmark [] Nothing
- $ node (CUSTOM_INLINE mempty mempty)
- $ inlinesToNodes opts
- $ walk (fixPipe . softBreakToSpace) ils
- toCell [] = ""
- toCell xs = error $ "toCell encountered " ++ show xs
- let separator = " | "
- let starter = "| "
- let ender = " |"
- let rawheaders = map toCell headers
- let rawrows = map (map toCell) rows
- let maximum' [] = 0
- maximum' xs = maximum xs
- let colwidths = map (maximum' . map T.length) $
- transpose (rawheaders:rawrows)
- let toHeaderLine len AlignDefault = T.replicate len "-"
- toHeaderLine len AlignLeft = ":" <>
- T.replicate (max (len - 1) 1) "-"
- toHeaderLine len AlignRight =
- T.replicate (max (len - 1) 1) "-" <> ":"
- toHeaderLine len AlignCenter = ":" <>
- T.replicate (max (len - 2) 1) (T.pack "-") <> ":"
- let rawheaderlines = zipWith toHeaderLine colwidths aligns
- let headerlines = starter <> T.intercalate separator rawheaderlines <>
- ender
- let padContent (align, w) t' =
- let padding = w - T.length t'
- halfpadding = padding `div` 2
- in case align of
- AlignRight -> T.replicate padding " " <> t'
- AlignCenter -> T.replicate halfpadding " " <> t' <>
- T.replicate (padding - halfpadding) " "
- _ -> t' <> T.replicate padding " "
- let toRow xs = starter <> T.intercalate separator
- (zipWith padContent (zip aligns colwidths) xs) <>
- ender
- let table' = toRow rawheaders <> "\n" <> headerlines <> "\n" <>
- T.intercalate "\n" (map toRow rawrows)
- return (node (CUSTOM_BLOCK table' mempty) [] :
- if null capt
- then ns
- else capt' : ns)
- else do -- fall back to raw HTML
- s <- writeHtml5String def $! Pandoc nullMeta [t]
- return (node (HTML_BLOCK s) [] : 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
+ -- We construct a table manually as a CUSTOM_BLOCK, for
+ -- two reasons: (1) cmark-gfm currently doesn't support
+ -- rendering TABLE nodes; (2) we can align the column sides;
+ -- (3) we can render the caption as a regular paragraph.
+ let capt' = node PARAGRAPH (inlinesToNodes opts capt)
+ -- backslash | in code and raw:
+ let fixPipe (Code attr xs) =
+ Code attr (T.replace "|" "\\|" xs)
+ fixPipe (RawInline format xs) =
+ RawInline format (T.replace "|" "\\|" xs)
+ fixPipe x = x
+ let toCell [Plain ils] = T.strip
+ $ nodeToCommonmark [] Nothing
+ $ node (CUSTOM_INLINE mempty mempty)
+ $ inlinesToNodes opts
+ $ walk (fixPipe . softBreakToSpace) ils
+ toCell [Para ils] = T.strip
+ $ nodeToCommonmark [] Nothing
+ $ node (CUSTOM_INLINE mempty mempty)
+ $ inlinesToNodes opts
+ $ walk (fixPipe . softBreakToSpace) ils
+ toCell [] = ""
+ toCell xs = error $ "toCell encountered " ++ show xs
+ let separator = " | "
+ let starter = "| "
+ let ender = " |"
+ let rawheaders = map toCell headers
+ let rawrows = map (map toCell) rows
+ let maximum' [] = 0
+ maximum' xs = maximum xs
+ let colwidths = map (maximum' . map T.length) $
+ transpose (rawheaders:rawrows)
+ let toHeaderLine len AlignDefault = T.replicate len "-"
+ toHeaderLine len AlignLeft = ":" <>
+ T.replicate (max (len - 1) 1) "-"
+ toHeaderLine len AlignRight =
+ T.replicate (max (len - 1) 1) "-" <> ":"
+ toHeaderLine len AlignCenter = ":" <>
+ T.replicate (max (len - 2) 1) (T.pack "-") <> ":"
+ let rawheaderlines = zipWith toHeaderLine colwidths aligns
+ let headerlines = starter <> T.intercalate separator rawheaderlines <>
+ ender
+ let padContent (align, w) t' =
+ let padding = w - T.length t'
+ halfpadding = padding `div` 2
+ in case align of
+ AlignRight -> T.replicate padding " " <> t'
+ AlignCenter -> T.replicate halfpadding " " <> t' <>
+ T.replicate (padding - halfpadding) " "
+ _ -> t' <> T.replicate padding " "
+ let toRow xs = starter <> T.intercalate separator
+ (zipWith padContent (zip aligns colwidths) xs) <>
+ ender
+ let table' = toRow rawheaders <> "\n" <> headerlines <> "\n" <>
+ T.intercalate "\n" (map toRow rawrows)
+ return (node (CUSTOM_BLOCK table' mempty) [] :
+ if null capt
+ then ns
+ else capt' : ns)
+ else do -- fall back to raw HTML
+ s <- writeHtml5String def $! Pandoc nullMeta [t]
+ return (node (HTML_BLOCK s) [] : ns)
blockToNodes _ Null ns = return ns
inlinesToNodes :: WriterOptions -> [Inline] -> [Node]
diff --git a/src/Text/Pandoc/Writers/ConTeXt.hs b/src/Text/Pandoc/Writers/ConTeXt.hs
index fb97e4fb4..6066f9bb2 100644
--- a/src/Text/Pandoc/Writers/ConTeXt.hs
+++ b/src/Text/Pandoc/Writers/ConTeXt.hs
@@ -255,7 +255,8 @@ 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 caption aligns widths heads rows) = 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
then Ntb
diff --git a/src/Text/Pandoc/Writers/Custom.hs b/src/Text/Pandoc/Writers/Custom.hs
index bc520d520..2be64d56f 100644
--- a/src/Text/Pandoc/Writers/Custom.hs
+++ b/src/Text/Pandoc/Writers/Custom.hs
@@ -149,8 +149,9 @@ blockToCustom (CodeBlock attr str) =
blockToCustom (BlockQuote blocks) =
Lua.callFunc "BlockQuote" (Stringify blocks)
-blockToCustom (Table capt aligns widths headers rows) =
- let aligns' = map show aligns
+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
headers' = map Stringify headers
rows' = map (map Stringify) rows
diff --git a/src/Text/Pandoc/Writers/Docbook.hs b/src/Text/Pandoc/Writers/Docbook.hs
index f05a29157..2f033b19e 100644
--- a/src/Text/Pandoc/Writers/Docbook.hs
+++ b/src/Text/Pandoc/Writers/Docbook.hs
@@ -263,7 +263,8 @@ blockToDocbook _ b@(RawBlock f str)
report $ BlockNotRendered b
return empty
blockToDocbook _ HorizontalRule = return empty -- not semantic
-blockToDocbook opts (Table caption aligns widths headers rows) = 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
else inTagsIndented "title" <$>
@@ -279,7 +280,7 @@ blockToDocbook opts (Table caption aligns widths headers rows) = do
body' <- (inTagsIndented "tbody" . vcat) <$>
mapM (tableRowToDocbook opts) rows
return $ inTagsIndented tableType $ captionDoc $$
- inTags True "tgroup" [("cols", tshow (length headers))] (
+ inTags True "tgroup" [("cols", tshow (length aligns))] (
coltags $$ head' $$ body')
hasLineBreaks :: [Inline] -> Bool
diff --git a/src/Text/Pandoc/Writers/Docx.hs b/src/Text/Pandoc/Writers/Docx.hs
index 2a2747826..2caba59cc 100644
--- a/src/Text/Pandoc/Writers/Docx.hs
+++ b/src/Text/Pandoc/Writers/Docx.hs
@@ -970,7 +970,8 @@ blockToOpenXML' _ HorizontalRule = do
$ mknode "v:rect" [("style","width:0;height:1.5pt"),
("o:hralign","center"),
("o:hrstd","t"),("o:hr","t")] () ]
-blockToOpenXML' opts (Table caption aligns widths headers rows) = 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 }
let captionStr = stringify caption
@@ -993,11 +994,11 @@ blockToOpenXML' opts (Table caption aligns widths headers rows) = do
$ mknode "w:bottom" [("w:val","single")] ()
, mknode "w:vAlign" [("w:val","bottom")] () ]
compactStyle <- pStyleM "Compact"
- let emptyCell = [mknode "w:p" [] [mknode "w:pPr" [] [compactStyle]]]
+ let emptyCell' = [mknode "w:p" [] [mknode "w:pPr" [] [compactStyle]]]
let mkcell border contents = mknode "w:tc" []
$ [ borderProps | border ] ++
if null contents
- then emptyCell
+ then emptyCell'
else contents
let mkrow border cells = mknode "w:tr" [] $
[mknode "w:trPr" [] [
diff --git a/src/Text/Pandoc/Writers/DokuWiki.hs b/src/Text/Pandoc/Writers/DokuWiki.hs
index 5cc5d19fe..b01d9a7bb 100644
--- a/src/Text/Pandoc/Writers/DokuWiki.hs
+++ b/src/Text/Pandoc/Writers/DokuWiki.hs
@@ -38,7 +38,7 @@ import Text.Pandoc.Shared (camelCaseToHyphenated, escapeURI, isURI, linesToPara,
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,8 @@ blockToDokuWiki opts (BlockQuote blocks) = do
then return $ T.unlines $ map ("> " <>) $ T.lines contents
else return $ "<HTML><blockquote>\n" <> contents <> "</blockquote></HTML>"
-blockToDokuWiki opts (Table capt aligns _ headers rows) = 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 ""
else do
diff --git a/src/Text/Pandoc/Writers/FB2.hs b/src/Text/Pandoc/Writers/FB2.hs
index b6f76235c..5e6f1861e 100644
--- a/src/Text/Pandoc/Writers/FB2.hs
+++ b/src/Text/Pandoc/Writers/FB2.hs
@@ -41,7 +41,7 @@ import Text.Pandoc.Logging
import Text.Pandoc.Options (HTMLMathMethod (..), WriterOptions (..), def)
import Text.Pandoc.Shared (capitalize, isURI, orderedListMarkers,
makeSections, tshow)
-import Text.Pandoc.Writers.Shared (lookupMetaString)
+import Text.Pandoc.Writers.Shared (lookupMetaString, toLegacyTable)
-- | Data to be written at the end of the document:
-- (foot)notes, URLs, references, images.
@@ -334,17 +334,18 @@ blockToXml h@Header{} = do
report $ BlockNotRendered h
return []
blockToXml HorizontalRule = return [ el "empty-line" () ]
-blockToXml (Table caption aligns _ headers rows) = do
- hd <- mkrow "th" headers aligns
+blockToXml (Table _ blkCapt specs thead tbody tfoot) = do
+ let (caption, aligns, _, headers, rows) = toLegacyTable blkCapt specs thead tbody tfoot
+ hd <- if null headers then pure [] else (:[]) <$> mkrow "th" headers aligns
bd <- mapM (\r -> mkrow "td" r aligns) rows
c <- el "emphasis" <$> cMapM toXml caption
- return [el "table" (hd : bd), el "p" c]
+ return [el "table" (hd <> bd), el "p" c]
where
- mkrow :: PandocMonad m => String -> [TableCell] -> [Alignment] -> FBM m Content
+ mkrow :: PandocMonad m => String -> [[Block]] -> [Alignment] -> FBM m Content
mkrow tag cells aligns' =
el "tr" <$> mapM (mkcell tag) (zip cells aligns')
--
- mkcell :: PandocMonad m => String -> (TableCell, Alignment) -> FBM m Content
+ mkcell :: PandocMonad m => String -> ([Block], Alignment) -> FBM m Content
mkcell tag (cell, align) = do
cblocks <- cMapM blockToXml cell
return $ el tag ([align_attr align], cblocks)
diff --git a/src/Text/Pandoc/Writers/HTML.hs b/src/Text/Pandoc/Writers/HTML.hs
index 7cee2868c..77585e920 100644
--- a/src/Text/Pandoc/Writers/HTML.hs
+++ b/src/Text/Pandoc/Writers/HTML.hs
@@ -885,7 +885,8 @@ blockToHtml opts (DefinitionList lst) = do
return $ mconcat $ nl opts : term' : nl opts :
intersperse (nl opts) defs') lst
defList opts contents
-blockToHtml opts (Table capt aligns widths headers rows') = 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
else do
diff --git a/src/Text/Pandoc/Writers/Haddock.hs b/src/Text/Pandoc/Writers/Haddock.hs
index 5a29f6246..925160602 100644
--- a/src/Text/Pandoc/Writers/Haddock.hs
+++ b/src/Text/Pandoc/Writers/Haddock.hs
@@ -115,7 +115,8 @@ blockToHaddock _ (CodeBlock (_,_,_) str) =
-- Nothing in haddock corresponds to block quotes:
blockToHaddock opts (BlockQuote blocks) =
blockListToHaddock opts blocks
-blockToHaddock opts (Table caption aligns widths headers rows) = 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
then empty
diff --git a/src/Text/Pandoc/Writers/ICML.hs b/src/Text/Pandoc/Writers/ICML.hs
index 997961f37..57066d303 100644
--- a/src/Text/Pandoc/Writers/ICML.hs
+++ b/src/Text/Pandoc/Writers/ICML.hs
@@ -321,8 +321,9 @@ 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 caption aligns widths headers rows) =
- let style' = tableName : style
+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
nrHeaders = if noHeader
then "0"
diff --git a/src/Text/Pandoc/Writers/Ipynb.hs b/src/Text/Pandoc/Writers/Ipynb.hs
index 9355cc22f..d01d5a7e5 100644
--- a/src/Text/Pandoc/Writers/Ipynb.hs
+++ b/src/Text/Pandoc/Writers/Ipynb.hs
@@ -97,7 +97,7 @@ addAttachment (Image attr lab (src,tit))
return $ Image attr lab ("attachment:" <> src, tit)
addAttachment x = return x
-extractCells :: PandocMonad m => WriterOptions -> [Block] -> m [Cell a]
+extractCells :: PandocMonad m => WriterOptions -> [Block] -> m [Ipynb.Cell a]
extractCells _ [] = return []
extractCells opts (Div (_id,classes,kvs) xs : bs)
| "cell" `elem` classes
@@ -106,7 +106,7 @@ extractCells opts (Div (_id,classes,kvs) xs : bs)
(newdoc, attachments) <-
runStateT (walkM addAttachment (Pandoc nullMeta xs)) mempty
source <- writeMarkdown opts{ writerTemplate = Nothing } newdoc
- (Cell{
+ (Ipynb.Cell{
cellType = Markdown
, cellSource = Source $ breakLines $ T.stripEnd source
, cellMetadata = meta
@@ -123,7 +123,7 @@ extractCells opts (Div (_id,classes,kvs) xs : bs)
let meta = pairsToJSONMeta kvs
outputs <- catMaybes <$> mapM blockToOutput rest
let exeCount = lookup "execution_count" kvs >>= safeRead
- (Cell{
+ (Ipynb.Cell{
cellType = Ipynb.Code {
codeExecutionCount = exeCount
, codeOutputs = outputs
@@ -143,7 +143,7 @@ extractCells opts (Div (_id,classes,kvs) xs : bs)
"markdown" -> "text/markdown"
"rst" -> "text/x-rst"
_ -> f
- (Cell{
+ (Ipynb.Cell{
cellType = Raw
, cellSource = Source $ breakLines raw
, cellMetadata = if format' == "ipynb" -- means no format given
@@ -156,7 +156,7 @@ extractCells opts (CodeBlock (_id,classes,kvs) raw : bs)
| "code" `elem` classes = do
let meta = pairsToJSONMeta kvs
let exeCount = lookup "execution_count" kvs >>= safeRead
- (Cell{
+ (Ipynb.Cell{
cellType = Ipynb.Code {
codeExecutionCount = exeCount
, codeOutputs = []
diff --git a/src/Text/Pandoc/Writers/JATS.hs b/src/Text/Pandoc/Writers/JATS.hs
index 4b731469e..47d8c00cf 100644
--- a/src/Text/Pandoc/Writers/JATS.hs
+++ b/src/Text/Pandoc/Writers/JATS.hs
@@ -356,21 +356,25 @@ blockToJATS _ b@(RawBlock f str)
report $ BlockNotRendered b
return empty
blockToJATS _ HorizontalRule = return empty -- not semantic
-blockToJATS opts (Table [] aligns widths headers rows) = do
- let percent w = tshow (truncate (100*w) :: Integer) <> "*"
- let coltags = vcat $ zipWith (\w al -> selfClosingTag "col"
- ([("width", percent w) | w > 0] ++
- [("align", alignmentToText al)])) widths aligns
- thead <- if all null headers
- then return empty
- else inTagsIndented "thead" <$> tableRowToJATS opts True headers
- tbody <- (inTagsIndented "tbody" . vcat) <$>
- mapM (tableRowToJATS opts False) rows
- return $ inTags True "table" [] $ coltags $$ thead $$ tbody
-blockToJATS opts (Table caption aligns widths headers rows) = do
- captionDoc <- inTagsIndented "caption" <$> blockToJATS opts (Para caption)
- tbl <- blockToJATS opts (Table [] aligns widths headers rows)
- return $ inTags True "table-wrap" [] $ captionDoc $$ tbl
+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
+ captionDoc <- inTagsIndented "caption" <$> blockToJATS opts (Para caption)
+ tbl <- captionlessTable aligns widths headers rows
+ return $ inTags True "table-wrap" [] $ captionDoc $$ tbl
+ where
+ captionlessTable aligns widths headers rows = do
+ let percent w = tshow (truncate (100*w) :: Integer) <> "*"
+ let coltags = vcat $ zipWith (\w al -> selfClosingTag "col"
+ ([("width", percent w) | w > 0] ++
+ [("align", alignmentToText al)])) widths aligns
+ thead <- if all null headers
+ then return empty
+ else inTagsIndented "thead" <$> tableRowToJATS opts True headers
+ tbody <- (inTagsIndented "tbody" . vcat) <$>
+ mapM (tableRowToJATS opts False) rows
+ return $ inTags True "table" [] $ coltags $$ thead $$ tbody
alignmentToText :: Alignment -> Text
alignmentToText alignment = case alignment of
diff --git a/src/Text/Pandoc/Writers/Jira.hs b/src/Text/Pandoc/Writers/Jira.hs
index 19db34137..1bf14c6a0 100644
--- a/src/Text/Pandoc/Writers/Jira.hs
+++ b/src/Text/Pandoc/Writers/Jira.hs
@@ -29,7 +29,7 @@ import Text.Pandoc.Options (WriterOptions (writerTemplate, writerWrapText),
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,8 @@ toJiraBlocks blocks = do
Plain xs -> singleton . Jira.Para <$> toJiraInlines xs
RawBlock fmt cs -> rawBlockToJira fmt cs
Null -> return mempty
- Table _ _ _ hd body -> 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
else Just <$> toRow Jira.HeaderCell hd
@@ -112,7 +113,7 @@ toJiraBlocks blocks = do
toRow :: PandocMonad m
=> ([Jira.Block] -> Jira.Cell)
- -> [TableCell]
+ -> [[Block]]
-> JiraConverter m Jira.Row
toRow mkCell cells = Jira.Row <$>
mapM (fmap mkCell . toJiraBlocks) cells
diff --git a/src/Text/Pandoc/Writers/LaTeX.hs b/src/Text/Pandoc/Writers/LaTeX.hs
index 1670f8380..c3a2762d2 100644
--- a/src/Text/Pandoc/Writers/LaTeX.hs
+++ b/src/Text/Pandoc/Writers/LaTeX.hs
@@ -759,7 +759,8 @@ blockToLaTeX (Header level (id',classes,_) lst) = do
hdr <- sectionHeader classes id' level lst
modify $ \s -> s{stInHeading = False}
return hdr
-blockToLaTeX (Table caption aligns widths heads rows) = 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
return ("\\toprule" $$ contents $$ "\\midrule")
diff --git a/src/Text/Pandoc/Writers/Man.hs b/src/Text/Pandoc/Writers/Man.hs
index 2f4175d19..105906138 100644
--- a/src/Text/Pandoc/Writers/Man.hs
+++ b/src/Text/Pandoc/Writers/Man.hs
@@ -139,8 +139,9 @@ blockToMan opts (CodeBlock _ str) = return $
blockToMan opts (BlockQuote blocks) = do
contents <- blockListToMan opts blocks
return $ literal ".RS" $$ contents $$ literal ".RE"
-blockToMan opts (Table caption alignments widths headers rows) =
- let aligncode AlignLeft = "l"
+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"
aligncode AlignCenter = "c"
aligncode AlignDefault = "l"
diff --git a/src/Text/Pandoc/Writers/Markdown.hs b/src/Text/Pandoc/Writers/Markdown.hs
index 58299f5ea..7a11e3c16 100644
--- a/src/Text/Pandoc/Writers/Markdown.hs
+++ b/src/Text/Pandoc/Writers/Markdown.hs
@@ -574,14 +574,15 @@ blockToMarkdown' opts (BlockQuote blocks) = do
else if plain then " " else "> "
contents <- blockListToMarkdown opts blocks
return $ (prefixed leader contents) <> blankline
-blockToMarkdown' opts t@(Table caption aligns widths headers rows) = 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))
caption' <- inlineListToMarkdown opts caption
let caption'' = if null caption || not (isEnabled Ext_table_captions opts)
then blankline
else blankline $$ (": " <> caption') $$ blankline
- let hasSimpleCells = onlySimpleTableCells $ headers:rows
+ let hasSimpleCells = onlySimpleTableCells $ headers : rows
let isSimple = hasSimpleCells && all (==0) widths
let isPlainBlock (Plain _) = True
isPlainBlock _ = False
diff --git a/src/Text/Pandoc/Writers/MediaWiki.hs b/src/Text/Pandoc/Writers/MediaWiki.hs
index 8b8eb7561..8d1745e8e 100644
--- a/src/Text/Pandoc/Writers/MediaWiki.hs
+++ b/src/Text/Pandoc/Writers/MediaWiki.hs
@@ -150,7 +150,8 @@ blockToMediaWiki (BlockQuote blocks) = do
contents <- blockListToMediaWiki blocks
return $ "<blockquote>" <> contents <> "</blockquote>"
-blockToMediaWiki (Table capt aligns widths headers rows') = 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 ""
else do
diff --git a/src/Text/Pandoc/Writers/Ms.hs b/src/Text/Pandoc/Writers/Ms.hs
index 78c70c561..6c9d8a783 100644
--- a/src/Text/Pandoc/Writers/Ms.hs
+++ b/src/Text/Pandoc/Writers/Ms.hs
@@ -215,8 +215,9 @@ blockToMs opts (BlockQuote blocks) = do
contents <- blockListToMs opts blocks
setFirstPara
return $ literal ".QS" $$ contents $$ literal ".QE"
-blockToMs opts (Table caption alignments widths headers rows) =
- let aligncode AlignLeft = "l"
+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"
aligncode AlignCenter = "c"
aligncode AlignDefault = "l"
diff --git a/src/Text/Pandoc/Writers/Muse.hs b/src/Text/Pandoc/Writers/Muse.hs
index 60d200007..88b4c2ef9 100644
--- a/src/Text/Pandoc/Writers/Muse.hs
+++ b/src/Text/Pandoc/Writers/Muse.hs
@@ -150,8 +150,8 @@ flatBlockListToMuse [] = return mempty
simpleTable :: PandocMonad m
=> [Inline]
- -> [TableCell]
- -> [[TableCell]]
+ -> [[Block]]
+ -> [[[Block]]]
-> Muse m (Doc Text)
simpleTable caption headers rows = do
topLevel <- asks envTopLevel
@@ -259,17 +259,18 @@ 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 caption aligns widths headers rows) =
+blockToMuse (Table _ blkCapt specs thead tbody tfoot) =
if isSimple && numcols > 1
then simpleTable caption headers rows
else do
opts <- asks envOptions
gridTable opts blocksToDoc True (map (const AlignDefault) aligns) widths headers rows
where
+ (caption, aligns, widths, headers, rows) = toLegacyTable blkCapt specs thead tbody tfoot
blocksToDoc opts blocks =
local (\env -> env { envOptions = opts }) $ blockListToMuse blocks
numcols = maximum (length aligns : length widths : map length (headers:rows))
- isSimple = onlySimpleTableCells (headers:rows) && all (== 0) widths
+ isSimple = onlySimpleTableCells (headers : rows) && all (== 0) widths
blockToMuse (Div _ bs) = flatBlockListToMuse bs
blockToMuse Null = return empty
diff --git a/src/Text/Pandoc/Writers/Native.hs b/src/Text/Pandoc/Writers/Native.hs
index 1c4719fe9..4d4dfca15 100644
--- a/src/Text/Pandoc/Writers/Native.hs
+++ b/src/Text/Pandoc/Writers/Native.hs
@@ -40,12 +40,42 @@ 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 caption aligns widths header rows) =
- "Table " <> text (show caption) <> " " <> text (show aligns) <> " " <>
- text (show widths) $$
- prettyRow header $$
- prettyList (map prettyRow rows)
- where prettyRow cols = prettyList (map (prettyList . map prettyBlock) cols)
+prettyBlock (Table attr blkCapt specs thead tbody tfoot) =
+ mconcat [ "Table "
+ , text (show attr)
+ , " "
+ , 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)
+ prettyCell (Cell a ma h w b) =
+ mconcat [ "Cell "
+ , text (show a)
+ , " "
+ , text (show ma)
+ , " ("
+ , text (show h)
+ , ") ("
+ , 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 b7243484b..9c802118a 100644
--- a/src/Text/Pandoc/Writers/OpenDocument.hs
+++ b/src/Text/Pandoc/Writers/OpenDocument.hs
@@ -359,7 +359,9 @@ 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 c a w h r <- bs = setFirstPara >> table c a w h r
+ | 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"
[ ("text:style-name", "Horizontal_20_Line") ])
| RawBlock f s <- bs = if f == Format "opendocument"
diff --git a/src/Text/Pandoc/Writers/Org.hs b/src/Text/Pandoc/Writers/Org.hs
index 632ad5d34..8e7f4dbf1 100644
--- a/src/Text/Pandoc/Writers/Org.hs
+++ b/src/Text/Pandoc/Writers/Org.hs
@@ -183,7 +183,8 @@ blockToOrg (BlockQuote blocks) = do
contents <- blockListToOrg blocks
return $ blankline $$ "#+BEGIN_QUOTE" $$
nest 2 contents $$ "#+END_QUOTE" $$ blankline
-blockToOrg (Table caption' _ _ headers rows) = 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'
then empty
diff --git a/src/Text/Pandoc/Writers/Powerpoint/Output.hs b/src/Text/Pandoc/Writers/Powerpoint/Output.hs
index b98eee1f5..12467048b 100644
--- a/src/Text/Pandoc/Writers/Powerpoint/Output.hs
+++ b/src/Text/Pandoc/Writers/Powerpoint/Output.hs
@@ -977,10 +977,10 @@ graphicToElement tableWidth (Tbl tblPr hdrCells rows) = do
headers' <- mapM cellToOpenXML hdrCells
rows' <- mapM (mapM cellToOpenXML) rows
let borderProps = mknode "a:tcPr" [] ()
- let emptyCell = [mknode "a:p" [] [mknode "a:pPr" [] ()]]
+ let emptyCell' = [mknode "a:p" [] [mknode "a:pPr" [] ()]]
let mkcell border contents = mknode "a:tc" []
$ (if null contents
- then emptyCell
+ then emptyCell'
else contents) <> [ borderProps | border ]
let mkrow border cells = mknode "a:tr" [("h", "0")] $ map (mkcell border) cells
diff --git a/src/Text/Pandoc/Writers/Powerpoint/Presentation.hs b/src/Text/Pandoc/Writers/Powerpoint/Presentation.hs
index 84e7423ac..68345bcd1 100644
--- a/src/Text/Pandoc/Writers/Powerpoint/Presentation.hs
+++ b/src/Text/Pandoc/Writers/Powerpoint/Presentation.hs
@@ -56,7 +56,8 @@ import Data.Time (UTCTime)
import qualified Text.Pandoc.Shared as Shared -- so we don't overlap "Element"
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)
@@ -201,13 +202,17 @@ data Shape = Pic PicProps FilePath [ParaElem]
| RawOOXMLShape T.Text
deriving (Show, Eq)
-type Cell = [Paragraph]
+type TableCell = [Paragraph]
+
+-- TODO: remove when better handling of new
+-- tables is implemented
+type SimpleCell = [Block]
data TableProps = TableProps { tblPrFirstRow :: Bool
, tblPrBandRow :: Bool
} deriving (Show, Eq)
-data Graphic = Tbl TableProps [Cell] [[Cell]]
+data Graphic = Tbl TableProps [TableCell] [[TableCell]]
deriving (Show, Eq)
@@ -503,7 +508,7 @@ multiParBullet (b:bs) = do
concatMapM blockToParagraphs bs
return $ p ++ ps
-cellToParagraphs :: Alignment -> TableCell -> Pres [Paragraph]
+cellToParagraphs :: Alignment -> SimpleCell -> Pres [Paragraph]
cellToParagraphs algn tblCell = do
paras <- mapM blockToParagraphs tblCell
let alignment = case algn of
@@ -514,7 +519,7 @@ cellToParagraphs algn tblCell = do
paras' = map (map (\p -> p{paraProps = (paraProps p){pPropAlign = alignment}})) paras
return $ concat paras'
-rowToParagraphs :: [Alignment] -> [TableCell] -> Pres [[Paragraph]]
+rowToParagraphs :: [Alignment] -> [SimpleCell] -> Pres [[Paragraph]]
rowToParagraphs algns tblCells = do
-- We have to make sure we have the right number of alignments
let pairs = zip (algns ++ repeat AlignDefault) tblCells
@@ -537,7 +542,8 @@ 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 caption algn _ hdrCells rows) = 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
rows' <- mapM (rowToParagraphs algn) rows
diff --git a/src/Text/Pandoc/Writers/RST.hs b/src/Text/Pandoc/Writers/RST.hs
index 9a6e41e3c..a390cc6cf 100644
--- a/src/Text/Pandoc/Writers/RST.hs
+++ b/src/Text/Pandoc/Writers/RST.hs
@@ -284,7 +284,8 @@ blockToRST (CodeBlock (_,classes,kvs) str) = do
blockToRST (BlockQuote blocks) = do
contents <- blockListToRST blocks
return $ nest 3 contents <> blankline
-blockToRST (Table caption aligns widths headers rows) = 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
oldOpts <- gets stOptions
diff --git a/src/Text/Pandoc/Writers/RTF.hs b/src/Text/Pandoc/Writers/RTF.hs
index 41cfc416b..da24e8b71 100644
--- a/src/Text/Pandoc/Writers/RTF.hs
+++ b/src/Text/Pandoc/Writers/RTF.hs
@@ -254,7 +254,8 @@ 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 caption aligns sizes headers rows) = 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
then return ""
diff --git a/src/Text/Pandoc/Writers/Shared.hs b/src/Text/Pandoc/Writers/Shared.hs
index 9ba6dcc8a..642b33933 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,67 @@ 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). Cells with a 'RowSpan' and 'ColSpan' of @(h, w)@
+-- will be cut up into @h * w@ cells of dimension @(1, 1)@, with the
+-- content placed in the upper-left corner.
+toLegacyTable :: Caption
+ -> [ColSpec]
+ -> TableHead
+ -> [TableBody]
+ -> TableFoot
+ -> ([Inline], [Alignment], [Double], [[Block]], [[[Block]]])
+toLegacyTable (Caption _ cbody) specs thead tbodies tfoot
+ = (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) = x
+ unBody (TableBody _ _ hd bd) = hd <> bd
+ unBodies = concatMap unBody
+
+ TableHead _ th = Builder.normalizeTableHead numcols thead
+ tb = map (Builder.normalizeTableBody numcols) tbodies
+ TableFoot _ tf = Builder.normalizeTableFoot numcols tfoot
+
+ cbody' = blocksToInlines cbody
+
+ (th', tb') = case th of
+ r:rs -> let (pendingPieces, r') = placeCutCells [] $ unRow r
+ rs' = cutRows pendingPieces $ rs <> unBodies tb <> tf
+ in (r', rs')
+ [] -> ([], cutRows [] $ unBodies tb <> tf)
+
+ -- Adapted from placeRowSection in Builders. There is probably a
+ -- more abstract foldRowSection that unifies them both.
+ placeCutCells pendingPieces cells
+ -- If there are any pending pieces for a column, add
+ -- them. Pending pieces have preference over cells due to grid
+ -- layout rules.
+ | (p:ps):pendingPieces' <- pendingPieces
+ = let (pendingPieces'', rowPieces) = placeCutCells pendingPieces' cells
+ in (ps : pendingPieces'', p : rowPieces)
+ -- Otherwise cut up a cell on the row and deal with its pieces.
+ | c:cells' <- cells
+ = let (h, w, cBody) = getComponents c
+ cRowPieces = cBody : replicate (w - 1) mempty
+ cPendingPieces = replicate w $ replicate (h - 1) mempty
+ pendingPieces' = dropWhile null pendingPieces
+ (pendingPieces'', rowPieces) = placeCutCells pendingPieces' cells'
+ in (cPendingPieces <> pendingPieces'', cRowPieces <> rowPieces)
+ | otherwise = ([], [])
+
+ cutRows pendingPieces (r:rs)
+ = let (pendingPieces', r') = placeCutCells pendingPieces $ unRow r
+ rs' = cutRows pendingPieces' rs
+ in r' : rs'
+ cutRows _ [] = []
+
+ getComponents (Cell _ _ (RowSpan h) (ColSpan w) body)
+ = (h, w, body)
diff --git a/src/Text/Pandoc/Writers/TEI.hs b/src/Text/Pandoc/Writers/TEI.hs
index d2689935e..9ccc137eb 100644
--- a/src/Text/Pandoc/Writers/TEI.hs
+++ b/src/Text/Pandoc/Writers/TEI.hs
@@ -194,8 +194,9 @@ 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 _ _ _ headers rows) = do
- headers' <- tableHeadersToTEI opts headers
+blockToTEI opts (Table _ blkCapt specs thead tbody tfoot) = do
+ let (_, _, _, headers, rows) = toLegacyTable blkCapt specs thead tbody tfoot
+ headers' <- if null headers then pure mempty else tableHeadersToTEI opts headers
rows' <- mapM (tableRowToTEI opts) rows
return $ inTags True "table" [] $ headers' $$ vcat rows'
diff --git a/src/Text/Pandoc/Writers/Texinfo.hs b/src/Text/Pandoc/Writers/Texinfo.hs
index de78b705e..ef1ee7d25 100644
--- a/src/Text/Pandoc/Writers/Texinfo.hs
+++ b/src/Text/Pandoc/Writers/Texinfo.hs
@@ -228,7 +228,8 @@ blockToTexinfo (Header level (ident,_,_) lst)
seccmd 4 = return "@subsubsection "
seccmd _ = throwError $ PandocSomeError "illegal seccmd level"
-blockToTexinfo (Table caption aligns widths heads rows) = 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
else tableHeadToTexinfo aligns heads
diff --git a/src/Text/Pandoc/Writers/Textile.hs b/src/Text/Pandoc/Writers/Textile.hs
index d2cb74c84..e68303cfe 100644
--- a/src/Text/Pandoc/Writers/Textile.hs
+++ b/src/Text/Pandoc/Writers/Textile.hs
@@ -168,44 +168,44 @@ blockToTextile opts (BlockQuote blocks) = do
contents <- blockListToTextile opts blocks
return $ "<blockquote>\n\n" <> contents <> "\n</blockquote>\n"
-blockToTextile opts (Table [] aligns widths headers rows') |
- all (==0) widths = do
- hs <- mapM (liftM (("_. " <>) . stripTrailingNewlines) . blockListToTextile opts) headers
- let cellsToRow cells = "|" <> T.intercalate "|" cells <> "|"
- let header = if all null headers then "" else cellsToRow hs <> "\n"
- let blocksToCell (align, bs) = do
- contents <- stripTrailingNewlines <$> blockListToTextile opts bs
- let alignMarker = case align of
- AlignLeft -> "<. "
- AlignRight -> ">. "
- AlignCenter -> "=. "
- AlignDefault -> ""
- return $ alignMarker <> contents
- let rowToCells = mapM blocksToCell . zip aligns
- bs <- mapM rowToCells rows'
- let body = T.unlines $ map cellsToRow bs
- return $ header <> body
-
-blockToTextile opts (Table capt aligns widths headers rows') = do
- let alignStrings = map alignmentToText aligns
- captionDoc <- if null capt
- then return ""
- else do
- c <- inlineListToTextile opts capt
- return $ "<caption>" <> c <> "</caption>\n"
- let percent w = tshow (truncate (100*w) :: Integer) <> "%"
- let coltags = if all (== 0.0) widths
- then ""
- else T.unlines $ map
- (\w -> "<col width=\"" <> percent w <> "\" />") widths
- head' <- if all null headers
- then return ""
- else do
- hs <- tableRowToTextile opts alignStrings 0 headers
- return $ "<thead>\n" <> hs <> "\n</thead>\n"
- body' <- zipWithM (tableRowToTextile opts alignStrings) [1..] rows'
- return $ "<table>\n" <> captionDoc <> coltags <> head' <>
- "<tbody>\n" <> T.unlines body' <> "</tbody>\n</table>\n"
+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
+ let cellsToRow cells = "|" <> T.intercalate "|" cells <> "|"
+ let header = if all null headers then "" else cellsToRow hs <> "\n"
+ let blocksToCell (align, bs) = do
+ contents <- stripTrailingNewlines <$> blockListToTextile opts bs
+ let alignMarker = case align of
+ AlignLeft -> "<. "
+ AlignRight -> ">. "
+ AlignCenter -> "=. "
+ AlignDefault -> ""
+ return $ alignMarker <> contents
+ let rowToCells = mapM blocksToCell . zip aligns
+ bs <- mapM rowToCells rows'
+ let body = T.unlines $ map cellsToRow bs
+ return $ header <> body
+ (capt, aligns, widths, headers, rows') -> do
+ let alignStrings = map alignmentToText aligns
+ captionDoc <- if null capt
+ then return ""
+ else do
+ c <- inlineListToTextile opts capt
+ return $ "<caption>" <> c <> "</caption>\n"
+ let percent w = tshow (truncate (100*w) :: Integer) <> "%"
+ let coltags = if all (== 0.0) widths
+ then ""
+ else T.unlines $ map
+ (\w -> "<col width=\"" <> percent w <> "\" />") widths
+ head' <- if all null headers
+ then return ""
+ else do
+ hs <- tableRowToTextile opts alignStrings 0 headers
+ return $ "<thead>\n" <> hs <> "\n</thead>\n"
+ body' <- zipWithM (tableRowToTextile opts alignStrings) [1..] rows'
+ return $ "<table>\n" <> captionDoc <> coltags <> head' <>
+ "<tbody>\n" <> T.unlines body' <> "</tbody>\n</table>\n"
blockToTextile opts x@(BulletList items) = do
oldUseTags <- gets stUseTags
diff --git a/src/Text/Pandoc/Writers/XWiki.hs b/src/Text/Pandoc/Writers/XWiki.hs
index 71bb8b2e4..486de943f 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,8 +123,9 @@ blockToXWiki (DefinitionList items) = do
return $ vcat contents <> if Text.null lev then "\n" else ""
-- TODO: support more features
-blockToXWiki (Table _ _ _ headers rows') = do
- headers' <- mapM (tableCellXWiki True) headers
+blockToXWiki (Table _ blkCapt specs thead tbody tfoot) = do
+ let (_, _, _, headers, rows') = toLegacyTable blkCapt specs thead tbody tfoot
+ headers' <- mapM (tableCellXWiki True) $ take (length specs) $ headers ++ repeat []
otherRows <- mapM formRow rows'
return $ Text.unlines (Text.unwords headers':otherRows)
diff --git a/src/Text/Pandoc/Writers/ZimWiki.hs b/src/Text/Pandoc/Writers/ZimWiki.hs
index 9644b9695..e311abe7b 100644
--- a/src/Text/Pandoc/Writers/ZimWiki.hs
+++ b/src/Text/Pandoc/Writers/ZimWiki.hs
@@ -34,7 +34,7 @@ import Text.Pandoc.Options (WrapOption (..),
writerWrapText))
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,8 @@ blockToZimWiki opts (BlockQuote blocks) = do
contents <- blockListToZimWiki opts blocks
return $ T.unlines $ map ("> " <>) $ T.lines contents
-blockToZimWiki opts (Table capt aligns _ headers rows) = 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 ""
else do