HTML writer: keep attributes from code nested below pre tag.

If a code block is defined with `<pre><code
class="language-x">…</code></pre>`, where the `<pre>` element has no
attributes, then the attributes from the `<code>` element are used
instead. Any leading `language-` prefix is dropped in the code's *class*
attribute are dropped to improve syntax highlighting.

Closes: #7221

2 files changed, 23 insertions, 1 deletions

diff --git a/src/Text/Pandoc/Readers/HTML.hs b/src/Text/Pandoc/Readers/HTML.hs
index 0a9e4addf..fc4575f2d 100644
--- a/src/Text/Pandoc/Readers/HTML.hs
+++ b/src/Text/Pandoc/Readers/HTML.hs
@@ -557,7 +557,18 @@ pFigure = try $ do
 pCodeBlock :: PandocMonad m => TagParser m Blocks
 pCodeBlock = try $ do
   TagOpen _ attr' <- pSatisfy (matchTagOpen "pre" [])
-  let attr = toAttr attr'
+  -- if the `pre` has no attributes, try if it is followed by a `code`
+  -- element and use those attributes if possible.
+  attr <- case attr' of
+    _:_ -> pure (toAttr attr')
+    []  -> option nullAttr $ do
+      TagOpen _ codeAttr <- pSatisfy (matchTagOpen "code" [])
+      pure $ toAttr
+        [ (k, v') | (k, v) <- codeAttr
+                    -- strip language from class
+                  , let v' = if k == "class"
+                             then fromMaybe v (T.stripPrefix "language-" v)
+                             else v ]
   contents <- manyTill pAny (pCloses "pre" <|> eof)
   let rawText = T.concat $ map tagToText contents
   -- drop leading newline if any
diff --git a/test/Tests/Readers/HTML.hs b/test/Tests/Readers/HTML.hs
index 7f5849991..9bf567194 100644
--- a/test/Tests/Readers/HTML.hs
+++ b/test/Tests/Readers/HTML.hs
@@ -108,6 +108,17 @@ tests = [ testGroup "base tag"
             "<header id=\"title\">Title</header>" =?>
             divWith ("title", mempty, mempty) (plain "Title")
           ]
+        , testGroup "code block"
+          [ test html "attributes in pre > code element" $
+            "<pre><code id=\"a\" class=\"python\">\nprint('hi')\n</code></pre>"
+            =?>
+            codeBlockWith ("a", ["python"], []) "print('hi')"
+
+          , test html "attributes in pre take precendence" $
+            "<pre id=\"c\"><code id=\"d\">\nprint('hi mom!')\n</code></pre>"
+            =?>
+            codeBlockWith ("c", [], []) "print('hi mom!')"
+          ]
         , askOption $ \(QuickCheckTests numtests) ->
             testProperty "Round trip" $
               withMaxSuccess (if QuickCheckTests numtests == defaultValue