aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--src/Text/Pandoc/Readers/HTML.hs12
-rw-r--r--src/Text/Pandoc/Writers/HTML.hs21
-rw-r--r--test/Tests/Readers/HTML.hs6
-rw-r--r--test/Tests/Writers/HTML.hs22
4 files changed, 50 insertions, 11 deletions
diff --git a/src/Text/Pandoc/Readers/HTML.hs b/src/Text/Pandoc/Readers/HTML.hs
index 1ed61591b..c5abe0e15 100644
--- a/src/Text/Pandoc/Readers/HTML.hs
+++ b/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
diff --git a/src/Text/Pandoc/Writers/HTML.hs b/src/Text/Pandoc/Writers/HTML.hs
index 86dcb5a43..783aaa8fd 100644
--- a/src/Text/Pandoc/Writers/HTML.hs
+++ b/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 >>=
diff --git a/test/Tests/Readers/HTML.hs b/test/Tests/Readers/HTML.hs
index 17ca717ea..31299e40d 100644
--- a/test/Tests/Readers/HTML.hs
+++ b/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
diff --git a/test/Tests/Writers/HTML.hs b/test/Tests/Writers/HTML.hs
index 94549e0d8..f3c7b87fd 100644
--- a/test/Tests/Writers/HTML.hs
+++ b/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)