Markdown tables: implement `table_attributes` extension.

When `table_attributes` is enabled (as it is by default for
pandoc's Markdown), attributes can be attached to a table by
including them at the end of the caption. Previously the writer
would emit an identifier in this position, but the reader didn't
handle it. Now arbitrary attributes are allowed, and they work in
both the reader and writer.

Closes #10884.

[API change]: Text.Pandoc.Extensions: Add `Ext_table_attributes`
constructor for `Extension`.

3 files changed, 22 insertions, 12 deletions

diff --git a/src/Text/Pandoc/Extensions.hs b/src/Text/Pandoc/Extensions.hs
index 6f173da0e..6a9377942 100644
--- a/src/Text/Pandoc/Extensions.hs
+++ b/src/Text/Pandoc/Extensions.hs
@@ -84,6 +84,7 @@ data Extension =
     | Ext_gutenberg           -- ^ Use Project Gutenberg conventions for plain
     | Ext_hard_line_breaks    -- ^ All newlines become hard line breaks
     | Ext_header_attributes   -- ^ Explicit header attributes {#id .class k=v}
+    | Ext_table_attributes    -- ^ Explicit table attributes after caption
     | Ext_ignore_line_breaks  -- ^ Newlines in paragraphs are ignored
     | Ext_implicit_figures    -- ^ A paragraph with just an image is a figure
     | Ext_implicit_header_references -- ^ Implicit reference links for headers
@@ -253,6 +254,7 @@ pandocExtensions = extensionsFromList
   , Ext_task_lists
   , Ext_auto_identifiers
   , Ext_header_attributes
+  , Ext_table_attributes
   , Ext_link_attributes
   , Ext_implicit_header_references
   , Ext_line_blocks
diff --git a/src/Text/Pandoc/Readers/Markdown.hs b/src/Text/Pandoc/Readers/Markdown.hs
index 0a17b9a1a..3fee1c57a 100644
--- a/src/Text/Pandoc/Readers/Markdown.hs
+++ b/src/Text/Pandoc/Readers/Markdown.hs
@@ -22,7 +22,7 @@ module Text.Pandoc.Readers.Markdown (
 
 import Control.Monad
 import Control.Monad.Except (throwError)
-import Data.Bifunctor (second)
+import qualified Data.Bifunctor as Bifunctor
 import Data.Char (isAlphaNum, isPunctuation, isSpace)
 import Data.List (transpose, elemIndex, sortOn, foldl')
 import qualified Data.Map as M
@@ -1305,14 +1305,19 @@ multilineRow indices = do
 
 -- Parses a table caption:  inlines beginning with 'Table:'
 -- and followed by blank lines.
-tableCaption :: PandocMonad m => MarkdownParser m (F Inlines)
+tableCaption :: PandocMonad m => MarkdownParser m (F Inlines, Attr)
 tableCaption = do
   guardEnabled Ext_table_captions
   try $ do
     skipNonindentSpaces
     (string ":" <* notFollowedBy (satisfy isPunctuation)) <|>
       (oneOf ['T','t'] >> string "able:")
-    trimInlinesF <$> inlines1 <* blanklines
+    let attributes' = guardEnabled Ext_table_attributes *> attributes
+    ils <- trimInlinesF . mconcat <$>
+               many (notFollowedBy (attributes' *> blanklines) *> inline)
+    attr <- option nullAttr attributes'
+    blanklines
+    pure (ils, attr)
 
 -- Parse a simple table with '---' header and one line per row.
 simpleTable :: PandocMonad m
@@ -1326,7 +1331,8 @@ simpleTable headless = do
               (if headless then tableFooter else tableFooter <|> blanklines')
   -- All columns in simple tables have default widths.
   let useDefaultColumnWidths tc =
-        let cs' = map (second (const ColWidthDefault)) $ tableColSpecs tc
+        let cs' = map (Bifunctor.second (const ColWidthDefault)) $
+                   tableColSpecs tc
         in tc {tableColSpecs = cs'}
   return $ useDefaultColumnWidths <$> tableComponents
 
@@ -1476,7 +1482,8 @@ scanForPipe = do
 
 table :: PandocMonad m => MarkdownParser m (F Blocks)
 table = try $ do
-  frontCaption <- option Nothing (Just <$> tableCaption)
+  (frontCaption, frontAttr) <- option (Nothing, nullAttr)
+                               (Bifunctor.first Just <$> tableCaption)
   tableComponents <-
          (guardEnabled Ext_pipe_tables >> try (scanForPipe >> pipeTable)) <|>
          (guardEnabled Ext_multiline_tables >> try (multilineTable False)) <|>
@@ -1487,13 +1494,14 @@ table = try $ do
          (guardEnabled Ext_grid_tables >>
                 try gridTable) <?> "table"
   optional blanklines
-  caption <- case frontCaption of
-                  Nothing -> option (return mempty) tableCaption
-                  Just c  -> return c
+  (caption, attr) <- case frontCaption of
+                        Nothing -> option (return mempty, nullAttr) tableCaption
+                        Just c  -> return (c, frontAttr)
   return $ do
     caption' <- caption
     (TableComponents _attr _capt colspecs th tb tf) <- tableComponents
-    return $ B.table (B.simpleCaption $ B.plain caption') colspecs th tb tf
+    return $ B.tableWith attr
+                (B.simpleCaption $ B.plain caption') colspecs th tb tf
 
 --
 -- inline
diff --git a/src/Text/Pandoc/Writers/Markdown.hs b/src/Text/Pandoc/Writers/Markdown.hs
index 9ff0e1d5b..1750db3bd 100644
--- a/src/Text/Pandoc/Writers/Markdown.hs
+++ b/src/Text/Pandoc/Writers/Markdown.hs
@@ -607,7 +607,7 @@ blockToMarkdown' opts (BlockQuote blocks) = do
         | otherwise            = "> "
   contents <- blockListToMarkdown opts blocks
   return $ text leader <> prefixed leader contents <> blankline
-blockToMarkdown' opts t@(Table (ident,_,_) blkCapt specs thead tbody tfoot) = do
+blockToMarkdown' opts t@(Table attr blkCapt specs thead tbody tfoot) = do
   let (caption, aligns, widths, headers, rows) = toLegacyTable blkCapt specs thead tbody tfoot
   let isColRowSpans (Cell _ _ rs cs _) = rs > 1 || cs > 1
   let rowHasColRowSpans (Row _ cs) = any isColRowSpans cs
@@ -621,9 +621,9 @@ blockToMarkdown' opts t@(Table (ident,_,_) blkCapt specs thead tbody tfoot) = do
   let numcols = maximum (length aligns :| length widths :
                            map length (headers:rows))
   caption' <- inlineListToMarkdown opts caption
-  let caption'' = if T.null ident
+  let caption'' = if attr == nullAttr
                      then caption'
-                     else caption' <+> attrsToMarkdown opts (ident,[],[])
+                     else caption' <+> attrsToMarkdown opts attr
   let caption'''
         | null caption = blankline
         | isEnabled Ext_table_captions opts