diff options
Diffstat (limited to 'src/Text/Pandoc/Writers')
31 files changed, 96 insertions, 56 deletions
diff --git a/src/Text/Pandoc/Writers/AsciiDoc.hs b/src/Text/Pandoc/Writers/AsciiDoc.hs index b9d93188a..e0ee830de 100644 --- a/src/Text/Pandoc/Writers/AsciiDoc.hs +++ b/src/Text/Pandoc/Writers/AsciiDoc.hs @@ -191,7 +191,7 @@ blockToAsciiDoc opts (BlockQuote blocks) = do else contents let bar = text "____" return $ bar $$ chomp contents' $$ bar <> blankline -blockToAsciiDoc opts (Table _ blkCapt specs _ thead tbody tfoot) = do +blockToAsciiDoc opts (Table _ blkCapt specs thead tbody tfoot) = do let (caption, aligns, widths, headers, rows) = toLegacyTable blkCapt specs thead tbody tfoot caption' <- inlineListToAsciiDoc opts caption let caption'' = if null caption diff --git a/src/Text/Pandoc/Writers/CommonMark.hs b/src/Text/Pandoc/Writers/CommonMark.hs index bd798ee73..bab74c77c 100644 --- a/src/Text/Pandoc/Writers/CommonMark.hs +++ b/src/Text/Pandoc/Writers/CommonMark.hs @@ -27,7 +27,7 @@ import Text.Pandoc.Class.PandocMonad (PandocMonad) import Text.Pandoc.Definition import Text.Pandoc.Options import Text.Pandoc.Shared (capitalize, isTightList, - linesToPara, onlySimpleTableCells, taskListItemToAscii, tshow, toLegacyTable) + linesToPara, onlySimpleTableCells, taskListItemToAscii, tshow) import Text.Pandoc.Templates (renderTemplate) import Text.Pandoc.Walk (walk, walkM) import Text.Pandoc.Writers.HTML (writeHtml5String, tagWithAttributes) @@ -154,7 +154,7 @@ blockToNodes opts (DefinitionList items) ns = Plain (term ++ [LineBreak] ++ xs) : ys ++ concat zs dlToBullet (term, xs) = Para term : concat xs -blockToNodes opts t@(Table _ blkCapt specs _ thead tbody tfoot) ns = +blockToNodes opts t@(Table _ blkCapt specs thead tbody tfoot) ns = let (capt, aligns, _widths, headers, rows) = toLegacyTable blkCapt specs thead tbody tfoot in if isEnabled Ext_pipe_tables opts && onlySimpleTableCells (headers : rows) then do diff --git a/src/Text/Pandoc/Writers/ConTeXt.hs b/src/Text/Pandoc/Writers/ConTeXt.hs index f3d7219d1..6066f9bb2 100644 --- a/src/Text/Pandoc/Writers/ConTeXt.hs +++ b/src/Text/Pandoc/Writers/ConTeXt.hs @@ -255,7 +255,7 @@ blockToConTeXt (DefinitionList lst) = blockToConTeXt HorizontalRule = return $ "\\thinrule" <> blankline -- If this is ever executed, provide a default for the reference identifier. blockToConTeXt (Header level attr lst) = sectionHeader attr level lst -blockToConTeXt (Table _ blkCapt specs _ thead tbody tfoot) = do +blockToConTeXt (Table _ blkCapt specs thead tbody tfoot) = do let (caption, aligns, widths, heads, rows) = toLegacyTable blkCapt specs thead tbody tfoot opts <- gets stOptions let tabl = if isEnabled Ext_ntb opts diff --git a/src/Text/Pandoc/Writers/Custom.hs b/src/Text/Pandoc/Writers/Custom.hs index beb2301c9..2be64d56f 100644 --- a/src/Text/Pandoc/Writers/Custom.hs +++ b/src/Text/Pandoc/Writers/Custom.hs @@ -29,7 +29,6 @@ import Text.Pandoc.Lua (Global (..), LuaException (LuaException), runLua, setGlobals) import Text.Pandoc.Lua.Util (addField, dofileWithTraceback) import Text.Pandoc.Options -import Text.Pandoc.Shared (toLegacyTable) import Text.Pandoc.Templates (renderTemplate) import qualified Text.Pandoc.UTF8 as UTF8 import Text.Pandoc.Writers.Shared @@ -150,7 +149,7 @@ blockToCustom (CodeBlock attr str) = blockToCustom (BlockQuote blocks) = Lua.callFunc "BlockQuote" (Stringify blocks) -blockToCustom (Table _ blkCapt specs _ thead tbody tfoot) = +blockToCustom (Table _ blkCapt specs thead tbody tfoot) = let (capt, aligns, widths, headers, rows) = toLegacyTable blkCapt specs thead tbody tfoot aligns' = map show aligns capt' = Stringify capt diff --git a/src/Text/Pandoc/Writers/Docbook.hs b/src/Text/Pandoc/Writers/Docbook.hs index 7af357fb0..ba468cf4f 100644 --- a/src/Text/Pandoc/Writers/Docbook.hs +++ b/src/Text/Pandoc/Writers/Docbook.hs @@ -263,7 +263,7 @@ blockToDocbook _ b@(RawBlock f str) report $ BlockNotRendered b return empty blockToDocbook _ HorizontalRule = return empty -- not semantic -blockToDocbook opts (Table _ blkCapt specs _ thead tbody tfoot) = do +blockToDocbook opts (Table _ blkCapt specs thead tbody tfoot) = do let (caption, aligns, widths, headers, rows) = toLegacyTable blkCapt specs thead tbody tfoot captionDoc <- if null caption then return empty diff --git a/src/Text/Pandoc/Writers/Docx.hs b/src/Text/Pandoc/Writers/Docx.hs index f9e173bb2..2caba59cc 100644 --- a/src/Text/Pandoc/Writers/Docx.hs +++ b/src/Text/Pandoc/Writers/Docx.hs @@ -970,7 +970,7 @@ blockToOpenXML' _ HorizontalRule = do $ mknode "v:rect" [("style","width:0;height:1.5pt"), ("o:hralign","center"), ("o:hrstd","t"),("o:hr","t")] () ] -blockToOpenXML' opts (Table _ blkCapt specs _ thead tbody tfoot) = do +blockToOpenXML' opts (Table _ blkCapt specs thead tbody tfoot) = do let (caption, aligns, widths, headers, rows) = toLegacyTable blkCapt specs thead tbody tfoot setFirstPara modify $ \s -> s { stInTable = True } diff --git a/src/Text/Pandoc/Writers/DokuWiki.hs b/src/Text/Pandoc/Writers/DokuWiki.hs index ce99aaa9d..b01d9a7bb 100644 --- a/src/Text/Pandoc/Writers/DokuWiki.hs +++ b/src/Text/Pandoc/Writers/DokuWiki.hs @@ -35,10 +35,10 @@ import Text.Pandoc.ImageSize import Text.Pandoc.Logging import Text.Pandoc.Options (WrapOption (..), WriterOptions (writerTableOfContents, writerTemplate, writerWrapText)) import Text.Pandoc.Shared (camelCaseToHyphenated, escapeURI, isURI, linesToPara, - removeFormatting, trimr, tshow, toLegacyTable) + removeFormatting, trimr, tshow) import Text.Pandoc.Templates (renderTemplate) import Text.DocLayout (render, literal) -import Text.Pandoc.Writers.Shared (defField, metaToContext) +import Text.Pandoc.Writers.Shared (defField, metaToContext, toLegacyTable) data WriterState = WriterState { } @@ -166,7 +166,7 @@ blockToDokuWiki opts (BlockQuote blocks) = do then return $ T.unlines $ map ("> " <>) $ T.lines contents else return $ "<HTML><blockquote>\n" <> contents <> "</blockquote></HTML>" -blockToDokuWiki opts (Table _ blkCapt specs _ thead tbody tfoot) = do +blockToDokuWiki opts (Table _ blkCapt specs thead tbody tfoot) = do let (capt, aligns, _, headers, rows) = toLegacyTable blkCapt specs thead tbody tfoot captionDoc <- if null capt then return "" diff --git a/src/Text/Pandoc/Writers/FB2.hs b/src/Text/Pandoc/Writers/FB2.hs index 5b62119a3..83bcf2038 100644 --- a/src/Text/Pandoc/Writers/FB2.hs +++ b/src/Text/Pandoc/Writers/FB2.hs @@ -40,8 +40,8 @@ import Text.Pandoc.Definition import Text.Pandoc.Logging import Text.Pandoc.Options (HTMLMathMethod (..), WriterOptions (..), def) import Text.Pandoc.Shared (capitalize, isURI, orderedListMarkers, - makeSections, tshow, toLegacyTable) -import Text.Pandoc.Writers.Shared (lookupMetaString) + makeSections, tshow) +import Text.Pandoc.Writers.Shared (lookupMetaString, toLegacyTable) -- | Data to be written at the end of the document: -- (foot)notes, URLs, references, images. @@ -334,7 +334,7 @@ blockToXml h@Header{} = do report $ BlockNotRendered h return [] blockToXml HorizontalRule = return [ el "empty-line" () ] -blockToXml (Table _ blkCapt specs _ thead tbody tfoot) = do +blockToXml (Table _ blkCapt specs thead tbody tfoot) = do let (caption, aligns, _, headers, rows) = toLegacyTable blkCapt specs thead tbody tfoot hd <- mkrow "th" headers aligns bd <- mapM (\r -> mkrow "td" r aligns) rows diff --git a/src/Text/Pandoc/Writers/HTML.hs b/src/Text/Pandoc/Writers/HTML.hs index 070631f0d..77585e920 100644 --- a/src/Text/Pandoc/Writers/HTML.hs +++ b/src/Text/Pandoc/Writers/HTML.hs @@ -885,7 +885,7 @@ blockToHtml opts (DefinitionList lst) = do return $ mconcat $ nl opts : term' : nl opts : intersperse (nl opts) defs') lst defList opts contents -blockToHtml opts (Table _ blkCapt specs _ thead tbody tfoot) = do +blockToHtml opts (Table _ blkCapt specs thead tbody tfoot) = do let (capt, aligns, widths, headers, rows') = toLegacyTable blkCapt specs thead tbody tfoot captionDoc <- if null capt then return mempty diff --git a/src/Text/Pandoc/Writers/Haddock.hs b/src/Text/Pandoc/Writers/Haddock.hs index 57e2f0ea7..925160602 100644 --- a/src/Text/Pandoc/Writers/Haddock.hs +++ b/src/Text/Pandoc/Writers/Haddock.hs @@ -115,7 +115,7 @@ blockToHaddock _ (CodeBlock (_,_,_) str) = -- Nothing in haddock corresponds to block quotes: blockToHaddock opts (BlockQuote blocks) = blockListToHaddock opts blocks -blockToHaddock opts (Table _ blkCapt specs _ thead tbody tfoot) = do +blockToHaddock opts (Table _ blkCapt specs thead tbody tfoot) = do let (caption, aligns, widths, headers, rows) = toLegacyTable blkCapt specs thead tbody tfoot caption' <- inlineListToHaddock opts caption let caption'' = if null caption diff --git a/src/Text/Pandoc/Writers/ICML.hs b/src/Text/Pandoc/Writers/ICML.hs index 5575ab2bb..57066d303 100644 --- a/src/Text/Pandoc/Writers/ICML.hs +++ b/src/Text/Pandoc/Writers/ICML.hs @@ -321,7 +321,7 @@ blockToICML opts style (Header lvl (_, cls, _) lst) = else "" in parStyle opts stl lst blockToICML _ _ HorizontalRule = return empty -- we could insert a page break instead -blockToICML opts style (Table _ blkCapt specs _ thead tbody tfoot) = +blockToICML opts style (Table _ blkCapt specs thead tbody tfoot) = let (caption, aligns, widths, headers, rows) = toLegacyTable blkCapt specs thead tbody tfoot style' = tableName : style noHeader = all null headers diff --git a/src/Text/Pandoc/Writers/JATS.hs b/src/Text/Pandoc/Writers/JATS.hs index f739613b6..47d8c00cf 100644 --- a/src/Text/Pandoc/Writers/JATS.hs +++ b/src/Text/Pandoc/Writers/JATS.hs @@ -356,7 +356,7 @@ blockToJATS _ b@(RawBlock f str) report $ BlockNotRendered b return empty blockToJATS _ HorizontalRule = return empty -- not semantic -blockToJATS opts (Table _ blkCapt specs _ th tb tf) = +blockToJATS opts (Table _ blkCapt specs th tb tf) = case toLegacyTable blkCapt specs th tb tf of ([], aligns, widths, headers, rows) -> captionlessTable aligns widths headers rows (caption, aligns, widths, headers, rows) -> do diff --git a/src/Text/Pandoc/Writers/Jira.hs b/src/Text/Pandoc/Writers/Jira.hs index bd22c161f..1bf14c6a0 100644 --- a/src/Text/Pandoc/Writers/Jira.hs +++ b/src/Text/Pandoc/Writers/Jira.hs @@ -26,10 +26,10 @@ import Text.Pandoc.Class.PandocMonad (PandocMonad) import Text.Pandoc.Definition import Text.Pandoc.Options (WriterOptions (writerTemplate, writerWrapText), WrapOption (..)) -import Text.Pandoc.Shared (linesToPara, stringify, toLegacyTable) +import Text.Pandoc.Shared (linesToPara, stringify) import Text.Pandoc.Templates (renderTemplate) import Text.Pandoc.Writers.Math (texMathToInlines) -import Text.Pandoc.Writers.Shared (defField, metaToContext) +import Text.Pandoc.Writers.Shared (defField, metaToContext, toLegacyTable) import Text.DocLayout (literal, render) import qualified Data.Text as T import qualified Text.Jira.Markup as Jira @@ -98,7 +98,7 @@ toJiraBlocks blocks = do Plain xs -> singleton . Jira.Para <$> toJiraInlines xs RawBlock fmt cs -> rawBlockToJira fmt cs Null -> return mempty - Table _ blkCapt specs _ thead tbody tfoot -> singleton <$> do + Table _ blkCapt specs thead tbody tfoot -> singleton <$> do let (_, _, _, hd, body) = toLegacyTable blkCapt specs thead tbody tfoot headerRow <- if all null hd then pure Nothing diff --git a/src/Text/Pandoc/Writers/LaTeX.hs b/src/Text/Pandoc/Writers/LaTeX.hs index 274f5108a..c3a2762d2 100644 --- a/src/Text/Pandoc/Writers/LaTeX.hs +++ b/src/Text/Pandoc/Writers/LaTeX.hs @@ -759,7 +759,7 @@ blockToLaTeX (Header level (id',classes,_) lst) = do hdr <- sectionHeader classes id' level lst modify $ \s -> s{stInHeading = False} return hdr -blockToLaTeX (Table _ blkCapt specs _ thead tbody tfoot) = do +blockToLaTeX (Table _ blkCapt specs thead tbody tfoot) = do let (caption, aligns, widths, heads, rows) = toLegacyTable blkCapt specs thead tbody tfoot (captionText, captForLof, captNotes) <- getCaption False caption let toHeaders hs = do contents <- tableRowToLaTeX True aligns widths hs diff --git a/src/Text/Pandoc/Writers/Man.hs b/src/Text/Pandoc/Writers/Man.hs index dda1e1cf1..105906138 100644 --- a/src/Text/Pandoc/Writers/Man.hs +++ b/src/Text/Pandoc/Writers/Man.hs @@ -139,7 +139,7 @@ blockToMan opts (CodeBlock _ str) = return $ blockToMan opts (BlockQuote blocks) = do contents <- blockListToMan opts blocks return $ literal ".RS" $$ contents $$ literal ".RE" -blockToMan opts (Table _ blkCapt specs _ thead tbody tfoot) = +blockToMan opts (Table _ blkCapt specs thead tbody tfoot) = let (caption, alignments, widths, headers, rows) = toLegacyTable blkCapt specs thead tbody tfoot aligncode AlignLeft = "l" aligncode AlignRight = "r" diff --git a/src/Text/Pandoc/Writers/Markdown.hs b/src/Text/Pandoc/Writers/Markdown.hs index 4d4d02028..7a11e3c16 100644 --- a/src/Text/Pandoc/Writers/Markdown.hs +++ b/src/Text/Pandoc/Writers/Markdown.hs @@ -574,7 +574,7 @@ blockToMarkdown' opts (BlockQuote blocks) = do else if plain then " " else "> " contents <- blockListToMarkdown opts blocks return $ (prefixed leader contents) <> blankline -blockToMarkdown' opts t@(Table _ blkCapt specs _ thead tbody tfoot) = do +blockToMarkdown' opts t@(Table _ blkCapt specs thead tbody tfoot) = do let (caption, aligns, widths, headers, rows) = toLegacyTable blkCapt specs thead tbody tfoot let numcols = maximum (length aligns : length widths : map length (headers:rows)) diff --git a/src/Text/Pandoc/Writers/MediaWiki.hs b/src/Text/Pandoc/Writers/MediaWiki.hs index fbfb7acb4..8d1745e8e 100644 --- a/src/Text/Pandoc/Writers/MediaWiki.hs +++ b/src/Text/Pandoc/Writers/MediaWiki.hs @@ -150,7 +150,7 @@ blockToMediaWiki (BlockQuote blocks) = do contents <- blockListToMediaWiki blocks return $ "<blockquote>" <> contents <> "</blockquote>" -blockToMediaWiki (Table _ blkCapt specs _ thead tbody tfoot) = do +blockToMediaWiki (Table _ blkCapt specs thead tbody tfoot) = do let (capt, aligns, widths, headers, rows') = toLegacyTable blkCapt specs thead tbody tfoot caption <- if null capt then return "" diff --git a/src/Text/Pandoc/Writers/Ms.hs b/src/Text/Pandoc/Writers/Ms.hs index ad2a7a3fd..6c9d8a783 100644 --- a/src/Text/Pandoc/Writers/Ms.hs +++ b/src/Text/Pandoc/Writers/Ms.hs @@ -215,7 +215,7 @@ blockToMs opts (BlockQuote blocks) = do contents <- blockListToMs opts blocks setFirstPara return $ literal ".QS" $$ contents $$ literal ".QE" -blockToMs opts (Table _ blkCapt specs _ thead tbody tfoot) = +blockToMs opts (Table _ blkCapt specs thead tbody tfoot) = let (caption, alignments, widths, headers, rows) = toLegacyTable blkCapt specs thead tbody tfoot aligncode AlignLeft = "l" aligncode AlignRight = "r" diff --git a/src/Text/Pandoc/Writers/Muse.hs b/src/Text/Pandoc/Writers/Muse.hs index f2bc91290..88b4c2ef9 100644 --- a/src/Text/Pandoc/Writers/Muse.hs +++ b/src/Text/Pandoc/Writers/Muse.hs @@ -259,7 +259,7 @@ blockToMuse (Header level (ident,_,_) inlines) = do return $ blankline <> attr' $$ nowrap (header' <> contents) <> blankline -- https://www.gnu.org/software/emacs-muse/manual/muse.html#Horizontal-Rules-and-Anchors blockToMuse HorizontalRule = return $ blankline $$ "----" $$ blankline -blockToMuse (Table _ blkCapt specs _ thead tbody tfoot) = +blockToMuse (Table _ blkCapt specs thead tbody tfoot) = if isSimple && numcols > 1 then simpleTable caption headers rows else do diff --git a/src/Text/Pandoc/Writers/Native.hs b/src/Text/Pandoc/Writers/Native.hs index a533496c1..4d4dfca15 100644 --- a/src/Text/Pandoc/Writers/Native.hs +++ b/src/Text/Pandoc/Writers/Native.hs @@ -40,18 +40,15 @@ prettyBlock (DefinitionList items) = "DefinitionList" $$ prettyList (map deflistitem items) where deflistitem (term, defs) = "(" <> text (show term) <> "," <> cr <> nest 1 (prettyList $ map (prettyList . map prettyBlock) defs) <> ")" -prettyBlock (Table attr blkCapt specs rhs thead tbody tfoot) = +prettyBlock (Table attr blkCapt specs thead tbody tfoot) = mconcat [ "Table " , text (show attr) , " " - , prettyCaption blkCapt - , " " - , text (show specs) - , " " - , text (show rhs) ] $$ - prettyRows thead $$ - prettyRows tbody $$ - prettyRows tfoot + , prettyCaption blkCapt ] $$ + prettyList (map (text . show) specs) $$ + prettyHead thead $$ + prettyBodies tbody $$ + prettyFoot tfoot where prettyRows = prettyList . map prettyRow prettyRow (Row a body) = text ("Row " <> show a) $$ prettyList (map prettyCell body) @@ -59,14 +56,26 @@ prettyBlock (Table attr blkCapt specs rhs thead tbody tfoot) = mconcat [ "Cell " , text (show a) , " " - , text (showsPrec 11 ma "") - , " " + , text (show ma) + , " (" , text (show h) - , " " - , text (show w) ] $$ + , ") (" + , text (show w) + , ")" ] $$ prettyList (map prettyBlock b) prettyCaption (Caption mshort body) = "(Caption " <> text (showsPrec 11 mshort "") $$ prettyList (map prettyBlock body) <> ")" + prettyHead (TableHead thattr body) + = "(TableHead " <> text (show thattr) $$ prettyRows body <> ")" + prettyBody (TableBody tbattr rhc hd bd) + = mconcat [ "(TableBody " + , text (show tbattr) + , " (" + , text (show rhc) + , ")" ] $$ prettyRows hd $$ prettyRows bd <> ")" + prettyBodies = prettyList . map prettyBody + prettyFoot (TableFoot tfattr body) + = "(TableFoot " <> text (show tfattr) $$ prettyRows body <> ")" prettyBlock (Div attr blocks) = text ("Div " <> show attr) $$ prettyList (map prettyBlock blocks) prettyBlock block = text $ show block diff --git a/src/Text/Pandoc/Writers/OpenDocument.hs b/src/Text/Pandoc/Writers/OpenDocument.hs index 12599772f..9c802118a 100644 --- a/src/Text/Pandoc/Writers/OpenDocument.hs +++ b/src/Text/Pandoc/Writers/OpenDocument.hs @@ -31,7 +31,7 @@ import Text.Pandoc.Definition import Text.Pandoc.Logging import Text.Pandoc.Options import Text.DocLayout -import Text.Pandoc.Shared (linesToPara, tshow, toLegacyTable) +import Text.Pandoc.Shared (linesToPara, tshow) import Text.Pandoc.Templates (renderTemplate) import qualified Text.Pandoc.Translations as Term (Term(Figure, Table)) import Text.Pandoc.Writers.Math @@ -359,7 +359,7 @@ blockToOpenDocument o bs | BulletList b <- bs = setFirstPara >> bulletListToOpenDocument o b | OrderedList a b <- bs = setFirstPara >> orderedList a b | CodeBlock _ s <- bs = setFirstPara >> preformatted s - | Table _ bc s _ th tb tf + | Table _ bc s th tb tf <- bs = let (c, a, w, h, r) = toLegacyTable bc s th tb tf in setFirstPara >> table c a w h r | HorizontalRule <- bs = setFirstPara >> return (selfClosingTag "text:p" diff --git a/src/Text/Pandoc/Writers/Org.hs b/src/Text/Pandoc/Writers/Org.hs index d8d89d2eb..8e7f4dbf1 100644 --- a/src/Text/Pandoc/Writers/Org.hs +++ b/src/Text/Pandoc/Writers/Org.hs @@ -183,7 +183,7 @@ blockToOrg (BlockQuote blocks) = do contents <- blockListToOrg blocks return $ blankline $$ "#+BEGIN_QUOTE" $$ nest 2 contents $$ "#+END_QUOTE" $$ blankline -blockToOrg (Table _ blkCapt specs _ thead tbody tfoot) = do +blockToOrg (Table _ blkCapt specs thead tbody tfoot) = do let (caption', _, _, headers, rows) = toLegacyTable blkCapt specs thead tbody tfoot caption'' <- inlineListToOrg caption' let caption = if null caption' diff --git a/src/Text/Pandoc/Writers/Powerpoint/Presentation.hs b/src/Text/Pandoc/Writers/Powerpoint/Presentation.hs index dbacbb3cf..68345bcd1 100644 --- a/src/Text/Pandoc/Writers/Powerpoint/Presentation.hs +++ b/src/Text/Pandoc/Writers/Powerpoint/Presentation.hs @@ -54,9 +54,10 @@ import Text.Pandoc.Logging import Text.Pandoc.Walk import Data.Time (UTCTime) import qualified Text.Pandoc.Shared as Shared -- so we don't overlap "Element" -import Text.Pandoc.Shared (tshow, toLegacyTable) +import Text.Pandoc.Shared (tshow) import Text.Pandoc.Writers.Shared (lookupMetaInlines, lookupMetaBlocks - , lookupMetaString, toTableOfContents) + , lookupMetaString, toTableOfContents + , toLegacyTable) import qualified Data.Map as M import qualified Data.Set as S import Data.Maybe (maybeToList, fromMaybe) @@ -541,7 +542,7 @@ blockToShape (Para (il:_)) | Link _ (il':_) target <- il , Image attr ils (url, _) <- il' = (withAttr attr . Pic def{picPropLink = Just $ ExternalTarget target} (T.unpack url)) <$> inlinesToParElems ils -blockToShape (Table _ blkCapt specs _ thead tbody tfoot) = do +blockToShape (Table _ blkCapt specs thead tbody tfoot) = do let (caption, algn, _, hdrCells, rows) = toLegacyTable blkCapt specs thead tbody tfoot caption' <- inlinesToParElems caption hdrCells' <- rowToParagraphs algn hdrCells diff --git a/src/Text/Pandoc/Writers/RST.hs b/src/Text/Pandoc/Writers/RST.hs index 85354d93f..a390cc6cf 100644 --- a/src/Text/Pandoc/Writers/RST.hs +++ b/src/Text/Pandoc/Writers/RST.hs @@ -284,7 +284,7 @@ blockToRST (CodeBlock (_,classes,kvs) str) = do blockToRST (BlockQuote blocks) = do contents <- blockListToRST blocks return $ nest 3 contents <> blankline -blockToRST (Table _ blkCapt specs _ thead tbody tfoot) = do +blockToRST (Table _ blkCapt specs thead tbody tfoot) = do let (caption, aligns, widths, headers, rows) = toLegacyTable blkCapt specs thead tbody tfoot caption' <- inlineListToRST caption let blocksToDoc opts bs = do diff --git a/src/Text/Pandoc/Writers/RTF.hs b/src/Text/Pandoc/Writers/RTF.hs index e45a73f79..da24e8b71 100644 --- a/src/Text/Pandoc/Writers/RTF.hs +++ b/src/Text/Pandoc/Writers/RTF.hs @@ -254,7 +254,7 @@ blockToRTF indent alignment (Header level _ lst) = do contents <- inlinesToRTF lst return $ rtfPar indent 0 alignment $ "\\b \\fs" <> tshow (40 - (level * 4)) <> " " <> contents -blockToRTF indent alignment (Table _ blkCapt specs _ thead tbody tfoot) = do +blockToRTF indent alignment (Table _ blkCapt specs thead tbody tfoot) = do let (caption, aligns, sizes, headers, rows) = toLegacyTable blkCapt specs thead tbody tfoot caption' <- inlinesToRTF caption header' <- if all null headers diff --git a/src/Text/Pandoc/Writers/Shared.hs b/src/Text/Pandoc/Writers/Shared.hs index 9ba6dcc8a..fb4e8eca6 100644 --- a/src/Text/Pandoc/Writers/Shared.hs +++ b/src/Text/Pandoc/Writers/Shared.hs @@ -34,6 +34,7 @@ module Text.Pandoc.Writers.Shared ( , toSuperscript , toTableOfContents , endsWithPlain + , toLegacyTable ) where import Safe (lastMay) @@ -50,7 +51,7 @@ import qualified Text.Pandoc.Builder as Builder import Text.Pandoc.Definition import Text.Pandoc.Options import Text.DocLayout -import Text.Pandoc.Shared (stringify, makeSections, deNote, deLink) +import Text.Pandoc.Shared (stringify, makeSections, deNote, deLink, blocksToInlines) import Text.Pandoc.Walk (walk) import qualified Text.Pandoc.UTF8 as UTF8 import Text.Pandoc.XML (escapeStringForXML) @@ -426,3 +427,32 @@ endsWithPlain xs = case lastMay xs of Just Plain{} -> True _ -> False + +-- | Convert the relevant components of a new-style table (with block +-- caption, row headers, row and column spans, and so on) to those of +-- an old-style table (inline caption, table head with one row, no +-- foot, and so on). +toLegacyTable :: Caption + -> [ColSpec] + -> TableHead + -> [TableBody] + -> TableFoot + -> ([Inline], [Alignment], [Double], [[Block]], [[[Block]]]) +toLegacyTable (Caption _ cbody) specs (TableHead _ th) tb (TableFoot _ tf) + = (cbody', aligns, widths, th', tb') + where + numcols = length specs + (aligns, mwidths) = unzip specs + fromWidth (ColWidth w) | w > 0 = w + fromWidth _ = 0 + widths = map fromWidth mwidths + unRow (Row _ x) = map unCell x + unCell (Cell _ _ _ _ x) = x + unBody (TableBody _ _ hd bd) = hd <> bd + unBodies = concatMap unBody + cbody' = blocksToInlines cbody + sanitise = pad mempty numcols . unRow + pad element upTo list = take upTo (list ++ repeat element) + (th', tb') = case th of + (r:rs) -> (sanitise r, map sanitise $ rs <> unBodies tb <> tf) + [] -> ([], map sanitise $ unBodies tb <> tf) diff --git a/src/Text/Pandoc/Writers/TEI.hs b/src/Text/Pandoc/Writers/TEI.hs index d1bc514c1..f7fa19b1b 100644 --- a/src/Text/Pandoc/Writers/TEI.hs +++ b/src/Text/Pandoc/Writers/TEI.hs @@ -194,7 +194,7 @@ blockToTEI _ HorizontalRule = return $ -- | TEI Tables -- TEI Simple's tables are composed of cells and rows; other -- table info in the AST is here lossily discard. -blockToTEI opts (Table _ blkCapt specs _ thead tbody tfoot) = do +blockToTEI opts (Table _ blkCapt specs thead tbody tfoot) = do let (_, _, _, headers, rows) = toLegacyTable blkCapt specs thead tbody tfoot headers' <- tableHeadersToTEI opts headers rows' <- mapM (tableRowToTEI opts) rows diff --git a/src/Text/Pandoc/Writers/Texinfo.hs b/src/Text/Pandoc/Writers/Texinfo.hs index a4b1d3a57..ef1ee7d25 100644 --- a/src/Text/Pandoc/Writers/Texinfo.hs +++ b/src/Text/Pandoc/Writers/Texinfo.hs @@ -228,7 +228,7 @@ blockToTexinfo (Header level (ident,_,_) lst) seccmd 4 = return "@subsubsection " seccmd _ = throwError $ PandocSomeError "illegal seccmd level" -blockToTexinfo (Table _ blkCapt specs _ thead tbody tfoot) = do +blockToTexinfo (Table _ blkCapt specs thead tbody tfoot) = do let (caption, aligns, widths, heads, rows) = toLegacyTable blkCapt specs thead tbody tfoot headers <- if all null heads then return empty diff --git a/src/Text/Pandoc/Writers/Textile.hs b/src/Text/Pandoc/Writers/Textile.hs index 2e02448e3..e68303cfe 100644 --- a/src/Text/Pandoc/Writers/Textile.hs +++ b/src/Text/Pandoc/Writers/Textile.hs @@ -168,7 +168,7 @@ blockToTextile opts (BlockQuote blocks) = do contents <- blockListToTextile opts blocks return $ "<blockquote>\n\n" <> contents <> "\n</blockquote>\n" -blockToTextile opts (Table _ blkCapt specs _ thead tbody tfoot) +blockToTextile opts (Table _ blkCapt specs thead tbody tfoot) = case toLegacyTable blkCapt specs thead tbody tfoot of ([], aligns, widths, headers, rows') | all (==0) widths -> do hs <- mapM (liftM (("_. " <>) . stripTrailingNewlines) . blockListToTextile opts) headers diff --git a/src/Text/Pandoc/Writers/XWiki.hs b/src/Text/Pandoc/Writers/XWiki.hs index 43729d0b0..bfc61c3b5 100644 --- a/src/Text/Pandoc/Writers/XWiki.hs +++ b/src/Text/Pandoc/Writers/XWiki.hs @@ -43,6 +43,7 @@ import Text.Pandoc.Logging import Text.Pandoc.Options import Text.Pandoc.Shared import Text.Pandoc.Writers.MediaWiki (highlightingLangs) +import Text.Pandoc.Writers.Shared (toLegacyTable) data WriterState = WriterState { listLevel :: Text -- String at the beginning of items @@ -122,7 +123,7 @@ blockToXWiki (DefinitionList items) = do return $ vcat contents <> if Text.null lev then "\n" else "" -- TODO: support more features -blockToXWiki (Table _ blkCapt specs _ thead tbody tfoot) = do +blockToXWiki (Table _ blkCapt specs thead tbody tfoot) = do let (_, _, _, headers, rows') = toLegacyTable blkCapt specs thead tbody tfoot headers' <- mapM (tableCellXWiki True) headers otherRows <- mapM formRow rows' diff --git a/src/Text/Pandoc/Writers/ZimWiki.hs b/src/Text/Pandoc/Writers/ZimWiki.hs index 0709744d5..e311abe7b 100644 --- a/src/Text/Pandoc/Writers/ZimWiki.hs +++ b/src/Text/Pandoc/Writers/ZimWiki.hs @@ -32,9 +32,9 @@ import Text.Pandoc.Logging import Text.Pandoc.Options (WrapOption (..), WriterOptions (writerTableOfContents, writerTemplate, writerWrapText)) -import Text.Pandoc.Shared (escapeURI, isURI, linesToPara, removeFormatting, trimr, toLegacyTable) +import Text.Pandoc.Shared (escapeURI, isURI, linesToPara, removeFormatting, trimr) import Text.Pandoc.Templates (renderTemplate) -import Text.Pandoc.Writers.Shared (defField, metaToContext) +import Text.Pandoc.Writers.Shared (defField, metaToContext, toLegacyTable) data WriterState = WriterState { stIndent :: Text, -- Indent after the marker at the beginning of list items @@ -132,7 +132,7 @@ blockToZimWiki opts (BlockQuote blocks) = do contents <- blockListToZimWiki opts blocks return $ T.unlines $ map ("> " <>) $ T.lines contents -blockToZimWiki opts (Table _ blkCapt specs _ thead tbody tfoot) = do +blockToZimWiki opts (Table _ blkCapt specs thead tbody tfoot) = do let (capt, aligns, _, headers, rows) = toLegacyTable blkCapt specs thead tbody tfoot captionDoc <- if null capt then return "" |