HTML Reader/Writer - Add support for <var> and <samp> (#5861)

Closes #5799

src/Text/Pandoc/Readers/HTML.hs

@@ -652,7 +652,7 @@ inline = choice
            , pLink
            , pImage
            , pCode
-           , pSamp
+           , pCodeWithClass [(T.pack "samp","sample"),(T.pack "var","variable")]
            , pSpan
            , pMath False
            , pScriptMath
@@ -782,12 +782,14 @@ pImage = do
   let kvs = concatMap getAtt ["width", "height", "sizes", "srcset"]
   return $ B.imageWith (uid, cls, kvs) (escapeURI url) title (B.text alt)
 
-pSamp :: PandocMonad m => TagParser m Inlines 
-pSamp = try $ do 
-  TagOpen open attr' <- pSatisfy $ tagOpen (=="samp") (const True)
+pCodeWithClass :: PandocMonad m => [(T.Text,String)] -> TagParser m Inlines 
+pCodeWithClass elemToClass = try $ do 
+  let tagTest = flip elem . fmap fst $ elemToClass
+  TagOpen open attr' <- pSatisfy $ tagOpen tagTest (const True)
   result <- manyTill pAny (pCloses open)
   let (ids,cs,kvs) = mkAttr . toStringAttr $ attr'
-  return . B.codeWith (ids,"sample":cs,kvs) .
+      cs'          = maybe cs (:cs) . lookup open $ elemToClass
+  return . B.codeWith (ids,cs',kvs) .
     unwords . lines . T.unpack . innerText $ result
 
 pCode :: PandocMonad m => TagParser m Inlines

src/Text/Pandoc/Writers/HTML.hs

@@ -31,7 +31,7 @@ module Text.Pandoc.Writers.HTML (
   ) where
 import Control.Monad.State.Strict
 import Data.Char (ord, toLower)
-import Data.List (intercalate, intersperse, isPrefixOf, partition)
+import Data.List (intercalate, intersperse, isPrefixOf, partition, delete)
 import Data.List.Split (splitWhen)
 import Data.Maybe (fromMaybe, isJust, isNothing, mapMaybe)
 import qualified Data.Set as Set
@@ -1023,20 +1023,29 @@ inlineToHtml opts inline = do
 
     (Emph lst)       -> inlineListToHtml opts lst >>= return . H.em
     (Strong lst)     -> inlineListToHtml opts lst >>= return . H.strong
-    (Code attr str)  -> case hlCode of
+    (Code attr@(ids,cs,kvs) str)  
+                     -> case hlCode of
                              Left msg -> do
                                unless (null msg) $
                                  report $ CouldNotHighlight msg
-                               addAttrs opts attr $ H.code $ strToHtml str
+                               addAttrs opts (ids,cs',kvs) $ 
+                                 maybe H.code id sampOrVar $ 
+                                 strToHtml str
                              Right h -> do
                                modify $ \st -> st{ stHighlighting = True }
-                               addAttrs opts (id',[],keyvals) h
-                        where (id',_,keyvals) = attr
-                              hlCode = if isJust (writerHighlightStyle opts)
+                               addAttrs opts (ids,[],kvs) $ 
+                                 maybe id id sampOrVar $ h
+                        where hlCode = if isJust (writerHighlightStyle opts)
                                           then highlight
                                                  (writerSyntaxMap opts)
                                                  formatHtmlInline attr str
                                           else Left ""
+                              (sampOrVar,cs') = 
+                                  if "sample" `elem` cs
+                                      then (Just H.samp,"sample" `delete` cs)
+                                  else if "variable" `elem` cs
+                                      then (Just H.var,"variable" `delete` cs)
+                                      else (Nothing,cs)
     (Strikeout lst)  -> inlineListToHtml opts lst >>=
                         return . H.del
     (SmallCaps lst)   -> inlineListToHtml opts lst >>=

test/Tests/Readers/HTML.hs

@@ -95,6 +95,12 @@ tests = [ testGroup "base tag"
             "<samp>Answer is 42</samp>" =?> 
             plain (codeWith ("",["sample"],[]) "Answer is 42")
           ]
+        , testGroup "var"
+        [
+          test html "inline var block" $ 
+          "<var>result</var>" =?> 
+          plain (codeWith ("",["variable"],[]) "result")
+        ]
         , askOption $ \(QuickCheckTests numtests) ->
             testProperty "Round trip" $
               withMaxSuccess (if QuickCheckTests numtests == defaultValue

test/Tests/Writers/HTML.hs

@@ -61,6 +61,28 @@ tests = [ testGroup "inline code"
             doubleQuoted (spanWith ("", [], [("cite", "http://example.org")]) (str "examples"))
             =?> "<q cite=\"http://example.org\">examples</q>"
           ]
+        , testGroup "sample"
+          [ "sample should be rendered correctly" =:
+            plain (codeWith ("",["sample"],[]) "Answer is 42") =?>
+            "<samp>Answer is 42</samp>"
+          ]
+        , testGroup "variable"
+          [ "variable should be rendered correctly" =:
+            plain (codeWith ("",["variable"],[]) "result") =?>
+            "<var>result</var>"
+          ]
+        , testGroup "sample with style"
+          [ "samp should wrap highlighted code" =:
+            codeWith ("",["sample","haskell"],[]) ">>="
+            =?> ("<samp><code class=\"sourceCode haskell\">" ++ 
+                "<span class=\"op\">&gt;&gt;=</span></code></samp>")
+          ]
+        , testGroup "variable with style"
+          [ "var should wrap highlighted code" =:
+            codeWith ("",["haskell","variable"],[]) ">>="
+            =?> ("<var><code class=\"sourceCode haskell\">" ++ 
+                "<span class=\"op\">&gt;&gt;=</span></code></var>")
+          ]
         ]
         where
           tQ :: (ToString a, ToPandoc a)