Markdown writer: better handling of pandoc-generated code blocks.

Omit the wrapper sourceCode divs added by pandoc around code blocks.

More intelligently identify which class to use for the one class
allowed in GFM code blocks.  If there is a class of form `language-X`,
use `X`; otherwise use the first class other than `sourceCode`.

Closes #10926.

src/Text/Pandoc/Writers/Markdown.hs

@@ -25,7 +25,7 @@ import Control.Monad (foldM, zipWithM, MonadPlus(..), when, liftM)
 import Control.Monad.Reader ( asks, MonadReader(local) )
 import Control.Monad.State.Strict ( gets, modify )
 import Data.Default
-import Data.List (intersperse, sortOn, union)
+import Data.List (intersperse, sortOn, union, find)
 import Data.List.NonEmpty (nonEmpty, NonEmpty(..))
 import qualified Data.Map as M
 import Data.Maybe (fromMaybe, mapMaybe, isNothing)
@@ -369,6 +369,10 @@ blockToMarkdown' :: PandocMonad m
                  -> Block         -- ^ Block element
                  -> MD m (Doc Text)
 blockToMarkdown' opts (Div attrs@(_,classes,_) bs)
+  | ("sourceCode":_) <- classes
+  , [CodeBlock (_,"sourceCode":_,_) _] <- bs
+     -- skip pandoc-generated Div wrappers around code blocks
+   = blockListToMarkdown opts bs
   | isEnabled Ext_alerts opts
   , (cls:_) <- classes
   , cls `elem` ["note", "tip", "warning", "caution", "important"]
@@ -589,9 +593,11 @@ blockToMarkdown' opts (CodeBlock attribs str) = do
      attrs  = if isEnabled Ext_fenced_code_attributes opts ||
                  isEnabled Ext_attributes opts
                  then nowrap $ " " <> classOrAttrsToMarkdown opts attribs
-                 else case attribs of
-                            (_,cls:_,_) -> " " <> literal cls
-                            _             -> empty
+                 else
+                   let (_,cls,_) = attribs
+                    in case getLangFromClasses cls of
+                              Just l -> " " <> literal l
+                              Nothing -> empty
 blockToMarkdown' opts (BlockQuote blocks) = do
   variant <- asks envVariant
   -- if we're writing literate haskell, put a space before the bird tracks
@@ -942,3 +948,14 @@ computeDivNestingLevel = foldr go 0
  where
    go (Div _ bls') n = max (n + 1) (foldr go (n + 1) bls')
    go _ n = n
+
+-- Identify the class in a list of classes that corresponds to
+-- the language syntax.  language-X turns to X.
+getLangFromClasses :: [Text] -> Maybe Text
+getLangFromClasses cs =
+  case find ("language-" `T.isPrefixOf`) cs of
+    Just x -> Just (T.drop 9 x)
+    Nothing ->
+      case filter (/= "sourceCode") cs of
+        (x:_) -> Just x
+        [] -> Nothing

test/command/10926.md

@@ -0,0 +1,19 @@
+````
+% pandoc -f html -t gfm
+<div class="sourceCode" id="cb1"><pre
+class="sourceCode ruby"><code class="sourceCode ruby"><span id="cb1-1"><a href="#cb1-1" aria-hidden="true" tabindex="-1"></a><span class="fu">test</span></span></code></pre></div>
+^D
+``` ruby
+test
+```
+````
+
+````
+% pandoc -f html -t gfm
+<pre
+class="border language-ruby"><code class="sourceCode ruby"><span id="cb1-1"><a href="#cb1-1" aria-hidden="true" tabindex="-1"></a><span class="fu">test</span></span></code></pre>
+^D
+``` ruby
+test
+```
+````