Add `alerts` extension.

This enables GitHub style markdown alerts as a commonmark extension.

<https://docs.github.com/en/get-started/writing-on-github/getting-started-with-writing-and-formatting-on-github/basic-writing-and-formatting-syntax#alerts>

This extension is now default for `gfm`.
It can't be used with `markdown`, only with `commonmark` and variants.

3 files changed, 55 insertions, 33 deletions

diff --git a/src/Text/Pandoc/Extensions.hs b/src/Text/Pandoc/Extensions.hs
index 664f2f21c..adc8b4646 100644
--- a/src/Text/Pandoc/Extensions.hs
+++ b/src/Text/Pandoc/Extensions.hs
@@ -45,6 +45,7 @@ import qualified Data.Set as Set
 -- | Individually selectable syntax extensions.
 data Extension =
       Ext_abbreviations       -- ^ PHP markdown extra abbreviation definitions
+    | Ext_alerts              -- ^ Special block quotes become alerts
     | Ext_all_symbols_escapable  -- ^ Make all non-alphanumerics escapable
     | Ext_amuse -- ^ Enable Text::Amuse extensions to Emacs Muse markup
     | Ext_angle_brackets_escapable  -- ^ Make < and > escapable
@@ -308,6 +309,8 @@ githubMarkdownExtensions = extensionsFromList
   , Ext_emoji
   , Ext_fenced_code_blocks
   , Ext_backtick_code_blocks
+  , Ext_footnotes
+  , Ext_alerts
   ]
 
 -- | Extensions to be used with multimarkdown.
@@ -400,6 +403,7 @@ getDefaultExtensions "gfm"             = extensionsFromList
   , Ext_footnotes
   , Ext_tex_math_dollars
   , Ext_tex_math_gfm
+  , Ext_alerts
   ]
 getDefaultExtensions "commonmark"      = extensionsFromList
                                           [Ext_raw_html]
@@ -422,6 +426,7 @@ getDefaultExtensions "commonmark_x"    = extensionsFromList
   , Ext_raw_attribute
   , Ext_implicit_header_references
   , Ext_attributes
+  , Ext_alerts
   , Ext_yaml_metadata_block
   ]
 getDefaultExtensions "org"             = extensionsFromList
@@ -549,6 +554,7 @@ getAllExtensions f = universalExtensions <> getAll f
     , Ext_task_lists
     , Ext_emoji
     , Ext_raw_html
+    , Ext_alerts
     , Ext_implicit_figures
     , Ext_hard_line_breaks
     , Ext_smart
diff --git a/src/Text/Pandoc/Readers/CommonMark.hs b/src/Text/Pandoc/Readers/CommonMark.hs
index 08f37830e..8d90573de 100644
--- a/src/Text/Pandoc/Readers/CommonMark.hs
+++ b/src/Text/Pandoc/Readers/CommonMark.hs
@@ -169,6 +169,7 @@ specFor opts = foldr ($) defaultSyntaxSpec exts
          [ (bracketedSpanSpec <>) | isEnabled Ext_bracketed_spans opts ] ++
          [ (rawAttributeSpec <>) | isEnabled Ext_raw_attribute opts ] ++
          [ (attributesSpec <>) | isEnabled Ext_attributes opts ] ++
+         [ (alertSpec <>) | isEnabled Ext_alerts opts ] ++
          [ (<> pipeTableSpec) | isEnabled Ext_pipe_tables opts ] ++
             -- see #6739
          [ (autolinkSpec <>) | isEnabled Ext_autolink_bare_uris opts ] ++
diff --git a/src/Text/Pandoc/Writers/Markdown.hs b/src/Text/Pandoc/Writers/Markdown.hs
index 712adfae8..cf1b36807 100644
--- a/src/Text/Pandoc/Writers/Markdown.hs
+++ b/src/Text/Pandoc/Writers/Markdown.hs
@@ -368,39 +368,54 @@ blockToMarkdown' :: PandocMonad m
                  => WriterOptions -- ^ Options
                  -> Block         -- ^ Block element
                  -> MD m (Doc Text)
-blockToMarkdown' opts (Div attrs ils) = do
-  contents <- blockListToMarkdown opts ils
-  variant <- asks envVariant
-  return $
-     case () of
-         _ | variant == Markua ->
-                   case () of
-                        () | "blurb" `elem` classes' -> prefixed "B> " contents <> blankline
-                           | "aside" `elem` classes' -> prefixed "A> " contents <> blankline
-                           -- necessary to enable option to create a bibliography
-                           | (take 3 (T.unpack id')) == "ref" -> contents <> blankline
-                           | otherwise -> contents <> blankline
-           | isEnabled Ext_fenced_divs opts &&
-             attrs /= nullAttr ->
-                let attrsToMd = if variant == Commonmark
-                                then attrsToMarkdown opts
-                                else classOrAttrsToMarkdown opts
-                in nowrap (literal ":::" <+> attrsToMd attrs) $$
-                   chomp contents $$
-                   literal ":::" <> blankline
-           | isEnabled Ext_native_divs opts ||
-             (isEnabled Ext_raw_html opts &&
-              (variant == Commonmark ||
-               isEnabled Ext_markdown_in_html_blocks opts)) ->
-                tagWithAttrs "div" attrs <> blankline <>
-                contents <> blankline <> "</div>" <> blankline
-           | isEnabled Ext_raw_html opts &&
-             isEnabled Ext_markdown_attribute opts ->
-                tagWithAttrs "div" attrs' <> blankline <>
-                contents <> blankline <> "</div>" <> blankline
-           | otherwise -> contents <> blankline
-       where (id',classes',kvs') = attrs
-             attrs' = (id',classes',("markdown","1"):kvs')
+blockToMarkdown' opts (Div attrs@(_,classes,_) bs)
+  | isEnabled Ext_alerts opts
+  , "alert" `elem` classes
+  , (Div ("", ["alert-title"], []) _ : Para ils : bs') <- bs
+   = blockToMarkdown' opts $ BlockQuote $
+       (Para (RawInline (Format "markdown") (case () of
+         _ | "alert-note" `elem` classes -> "[!NOTE]\n"
+         _ | "alert-tip" `elem` classes -> "[!TIP]\n"
+         _ | "alert-warning" `elem` classes -> "[!WARNING]\n"
+         _ | "alert-caution" `elem` classes -> "[!CAUTION]\n"
+         _ | "alert-important" `elem` classes -> "[!IMPORTANT]\n"
+           | otherwise -> "[!NOTE]\n") : ils)) : bs'
+  | otherwise = do
+    contents <- blockListToMarkdown opts bs
+    variant <- asks envVariant
+    return $
+       case () of
+           _ | variant == Markua ->
+                 case () of
+                      () | "blurb" `elem` classes'
+                           -> prefixed "B> " contents <> blankline
+                         | "aside" `elem` classes'
+                           -> prefixed "A> " contents <> blankline
+                         -- necessary to enable option to create a bibliography
+                         | (take 3 (T.unpack id')) == "ref"
+                           -> contents <> blankline
+                         | otherwise -> contents <> blankline
+             | isEnabled Ext_fenced_divs opts &&
+               attrs /= nullAttr ->
+                  let attrsToMd = if variant == Commonmark
+                                  then attrsToMarkdown opts
+                                  else classOrAttrsToMarkdown opts
+                  in nowrap (literal ":::" <+> attrsToMd attrs) $$
+                     chomp contents $$
+                     literal ":::" <> blankline
+             | isEnabled Ext_native_divs opts ||
+               (isEnabled Ext_raw_html opts &&
+                (variant == Commonmark ||
+                 isEnabled Ext_markdown_in_html_blocks opts)) ->
+                  tagWithAttrs "div" attrs <> blankline <>
+                  contents <> blankline <> "</div>" <> blankline
+             | isEnabled Ext_raw_html opts &&
+               isEnabled Ext_markdown_attribute opts ->
+                  tagWithAttrs "div" attrs' <> blankline <>
+                  contents <> blankline <> "</div>" <> blankline
+             | otherwise -> contents <> blankline
+         where (id',classes',kvs') = attrs
+               attrs' = (id',classes',("markdown","1"):kvs')
 blockToMarkdown' opts (Plain inlines) = do
   -- escape if para starts with ordered list marker
   variant <- asks envVariant