git.iko.soy/typeable/pandoc
on master help sign in
HTML Reader/Writer - Add support for <var> and <samp> (#5861)

Closes #5799

commitbd2bd9b19d949f59a64358f756bf8b398a13db0f authorAmogh Rathore <amoghdroid09@gmail.com> dateTue 5 Nov 2019, 01:42 (7 years ago) parentfdc0f47
4 files changed+50−11
src/Text/Pandoc/Readers/HTML.hs+7−5 src/Text/Pandoc/Writers/HTML.hs+15−6 test/Tests/Readers/HTML.hs+6 test/Tests/Writers/HTML.hs+22
src/Text/Pandoc/Readers/HTML.hs+7−5
@@ -652,7 +652,7 @@ inline = choice
652652 , pLink
653653 , pImage
654654 , pCode
655− , pSamp
655+ , pCodeWithClass [(T.pack "samp","sample"),(T.pack "var","variable")]
656656 , pSpan
657657 , pMath False
658658 , pScriptMath
@@ -782,12 +782,14 @@ pImage = do
782782 let kvs = concatMap getAtt ["width", "height", "sizes", "srcset"]
783783 return $ B.imageWith (uid, cls, kvs) (escapeURI url) title (B.text alt)
784784
785−pSamp :: PandocMonad m => TagParser m Inlines
786−pSamp = try $ do
787− TagOpen open attr' <- pSatisfy $ tagOpen (=="samp") (const True)
785+pCodeWithClass :: PandocMonad m => [(T.Text,String)] -> TagParser m Inlines
786+pCodeWithClass elemToClass = try $ do
787+ let tagTest = flip elem . fmap fst $ elemToClass
788+ TagOpen open attr' <- pSatisfy $ tagOpen tagTest (const True)
788789 result <- manyTill pAny (pCloses open)
789790 let (ids,cs,kvs) = mkAttr . toStringAttr $ attr'
790− return . B.codeWith (ids,"sample":cs,kvs) .
791+ cs' = maybe cs (:cs) . lookup open $ elemToClass
792+ return . B.codeWith (ids,cs',kvs) .
791793 unwords . lines . T.unpack . innerText $ result
792794
793795pCode :: PandocMonad m => TagParser m Inlines
src/Text/Pandoc/Writers/HTML.hs+15−6
@@ -31,7 +31,7 @@ module Text.Pandoc.Writers.HTML (
3131 ) where
3232import Control.Monad.State.Strict
3333import Data.Char (ord, toLower)
34−import Data.List (intercalate, intersperse, isPrefixOf, partition)
34+import Data.List (intercalate, intersperse, isPrefixOf, partition, delete)
3535import Data.List.Split (splitWhen)
3636import Data.Maybe (fromMaybe, isJust, isNothing, mapMaybe)
3737import qualified Data.Set as Set
@@ -1023,20 +1023,29 @@ inlineToHtml opts inline = do
10231023
10241024 (Emph lst) -> inlineListToHtml opts lst >>= return . H.em
10251025 (Strong lst) -> inlineListToHtml opts lst >>= return . H.strong
1026− (Code attr str) -> case hlCode of
1026+ (Code attr@(ids,cs,kvs) str)
1027+ -> case hlCode of
10271028 Left msg -> do
10281029 unless (null msg) $
10291030 report $ CouldNotHighlight msg
1030− addAttrs opts attr $ H.code $ strToHtml str
1031+ addAttrs opts (ids,cs',kvs) $
1032+ maybe H.code id sampOrVar $
1033+ strToHtml str
10311034 Right h -> do
10321035 modify $ \st -> st{ stHighlighting = True }
1033− addAttrs opts (id',[],keyvals) h
1034− where (id',_,keyvals) = attr
1035− hlCode = if isJust (writerHighlightStyle opts)
1036+ addAttrs opts (ids,[],kvs) $
1037+ maybe id id sampOrVar $ h
1038+ where hlCode = if isJust (writerHighlightStyle opts)
10361039 then highlight
10371040 (writerSyntaxMap opts)
10381041 formatHtmlInline attr str
10391042 else Left ""
1043+ (sampOrVar,cs') =
1044+ if "sample" `elem` cs
1045+ then (Just H.samp,"sample" `delete` cs)
1046+ else if "variable" `elem` cs
1047+ then (Just H.var,"variable" `delete` cs)
1048+ else (Nothing,cs)
10401049 (Strikeout lst) -> inlineListToHtml opts lst >>=
10411050 return . H.del
10421051 (SmallCaps lst) -> inlineListToHtml opts lst >>=
test/Tests/Readers/HTML.hs+6
@@ -95,6 +95,12 @@ tests = [ testGroup "base tag"
9595 "<samp>Answer is 42</samp>" =?>
9696 plain (codeWith ("",["sample"],[]) "Answer is 42")
9797 ]
98+ , testGroup "var"
99+ [
100+ test html "inline var block" $
101+ "<var>result</var>" =?>
102+ plain (codeWith ("",["variable"],[]) "result")
103+ ]
98104 , askOption $ \(QuickCheckTests numtests) ->
99105 testProperty "Round trip" $
100106 withMaxSuccess (if QuickCheckTests numtests == defaultValue
test/Tests/Writers/HTML.hs+22
@@ -61,6 +61,28 @@ tests = [ testGroup "inline code"
6161 doubleQuoted (spanWith ("", [], [("cite", "http://example.org")]) (str "examples"))
6262 =?> "<q cite=\"http://example.org\">examples</q>"
6363 ]
64+ , testGroup "sample"
65+ [ "sample should be rendered correctly" =:
66+ plain (codeWith ("",["sample"],[]) "Answer is 42") =?>
67+ "<samp>Answer is 42</samp>"
68+ ]
69+ , testGroup "variable"
70+ [ "variable should be rendered correctly" =:
71+ plain (codeWith ("",["variable"],[]) "result") =?>
72+ "<var>result</var>"
73+ ]
74+ , testGroup "sample with style"
75+ [ "samp should wrap highlighted code" =:
76+ codeWith ("",["sample","haskell"],[]) ">>="
77+ =?> ("<samp><code class=\"sourceCode haskell\">" ++
78+ "<span class=\"op\">&gt;&gt;=</span></code></samp>")
79+ ]
80+ , testGroup "variable with style"
81+ [ "var should wrap highlighted code" =:
82+ codeWith ("",["haskell","variable"],[]) ">>="
83+ =?> ("<var><code class=\"sourceCode haskell\">" ++
84+ "<span class=\"op\">&gt;&gt;=</span></code></var>")
85+ ]
6486 ]
6587 where
6688 tQ :: (ToString a, ToPandoc a)