diff options
| author | John MacFarlane <jgm@berkeley.edu> | 2020-04-17 10:04:39 -0700 |
|---|---|---|
| committer | GitHub <noreply@github.com> | 2020-04-17 10:04:39 -0700 |
| commit | 906305de789c83f9fdcc2c7d30044acf97e89582 (patch) | |
| tree | f359e991e60e7324f11e73a40259ed9dc3e4b91b /src/Text/Pandoc | |
| parent | f0f3cc14beeea51f703f7cfc8b40ebf3de2d0a05 (diff) | |
| parent | d1521af8fb0d3e8ee4104224e4d5e0b6e6bfad8c (diff) | |
| download | pandoc-906305de789c83f9fdcc2c7d30044acf97e89582.tar.gz | |
Merge pull request #6224 from despresc/better-tables
Diffstat (limited to 'src/Text/Pandoc')
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 |