Tissevert/pandoc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions 1

HTML writer: hlint improvements.

Browse source
This commit is contained in:
John MacFarlane 2019-11-27 09:52:11 -08:00
parent 3accc2a5cd
commit 982d2f6cd3
1 changed files with 22 additions and 25 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

47
src/Text/Pandoc/Writers/HTML.hs
View file

@ -41,9 +41,8 @@ import Numeric (showHex)
import Text.DocLayout (render, literal) import Text.DocLayout (render, literal)
import Prelude import Prelude
import Text.Blaze.Internal (MarkupM (Empty), customLeaf, customParent) import Text.Blaze.Internal (MarkupM (Empty), customLeaf, customParent)
import Text.DocTemplates (FromContext (lookupContext)) import Text.DocTemplates (FromContext (lookupContext), Context (..))
import Text.Blaze.Html hiding (contents) import Text.Blaze.Html hiding (contents)
import Text.DocTemplates (Context (..))
import Text.Pandoc.Definition import Text.Pandoc.Definition
import Text.Pandoc.Highlighting (formatHtmlBlock, formatHtmlInline, highlight, import Text.Pandoc.Highlighting (formatHtmlBlock, formatHtmlInline, highlight,
styleToCss) styleToCss)
@ -941,15 +940,14 @@ toListItem opts item = nl opts >> H.li item
blockListToHtml :: PandocMonad m blockListToHtml :: PandocMonad m
=> WriterOptions -> [Block] -> StateT WriterState m Html => WriterOptions -> [Block] -> StateT WriterState m Html
blockListToHtml opts lst = blockListToHtml opts lst =
(mconcat . intersperse (nl opts) . filter nonempty) mconcat . intersperse (nl opts) . filter nonempty
<$> mapM (blockToHtml opts) lst <$> mapM (blockToHtml opts) lst
where nonempty (Empty _) = False where nonempty (Empty _) = False
nonempty _ = True nonempty _ = True
-- | Convert list of Pandoc inline elements to HTML. -- | Convert list of Pandoc inline elements to HTML.
inlineListToHtml :: PandocMonad m => WriterOptions -> [Inline] -> StateT WriterState m Html inlineListToHtml :: PandocMonad m => WriterOptions -> [Inline] -> StateT WriterState m Html
inlineListToHtml opts lst = inlineListToHtml opts lst = mconcat <$> mapM (inlineToHtml opts) lst
mapM (inlineToHtml opts) lst >>= return . mconcat
-- | Annotates a MathML expression with the tex source -- | Annotates a MathML expression with the tex source
annotateMML :: XML.Element -> Text -> XML.Element annotateMML :: XML.Element -> Text -> XML.Element
@ -1011,37 +1009,36 @@ inlineToHtml opts inline = do
] ]
] ]
(Emph lst) -> inlineListToHtml opts lst >>= return . H.em (Emph lst) -> H.em <$> inlineListToHtml opts lst
(Strong lst) -> inlineListToHtml opts lst >>= return . H.strong (Strong lst) -> H.strong <$> inlineListToHtml opts lst
(Code attr@(ids,cs,kvs) str) (Code attr@(ids,cs,kvs) str)
-> case hlCode of -> case hlCode of
Left msg -> do Left msg -> do
unless (T.null msg) $ unless (T.null msg) $
report $ CouldNotHighlight msg report $ CouldNotHighlight msg
addAttrs opts (ids,cs',kvs) $ addAttrs opts (ids,cs',kvs) $
maybe H.code id sampOrVar $ fromMaybe H.code sampOrVar $
strToHtml str strToHtml str
Right h -> do Right h -> do
modify $ \st -> st{ stHighlighting = True } modify $ \st -> st{ stHighlighting = True }
addAttrs opts (ids,[],kvs) $ addAttrs opts (ids,[],kvs) $
maybe id id sampOrVar $ h fromMaybe id sampOrVar h
where hlCode = if isJust (writerHighlightStyle opts) where hlCode = if isJust (writerHighlightStyle opts)
then highlight then highlight
(writerSyntaxMap opts) (writerSyntaxMap opts)
formatHtmlInline attr str formatHtmlInline attr str
else Left "" else Left ""
(sampOrVar,cs') = (sampOrVar,cs')
if "sample" `elem` cs | "sample" `elem` cs =
then (Just H.samp,"sample" `delete` cs) (Just H.samp,"sample" `delete` cs)
else if "variable" `elem` cs | "variable" `elem` cs =
then (Just H.var,"variable" `delete` cs) (Just H.var,"variable" `delete` cs)
else (Nothing,cs) | otherwise = (Nothing,cs)
(Strikeout lst) -> inlineListToHtml opts lst >>= (Strikeout lst) -> H.del <$> inlineListToHtml opts lst
return . H.del (SmallCaps lst) -> (H.span ! A.class_ "smallcaps") <$>
(SmallCaps lst) -> inlineListToHtml opts lst >>= inlineListToHtml opts lst
return . (H.span ! A.class_ "smallcaps") (Superscript lst) -> H.sup <$> inlineListToHtml opts lst
(Superscript lst) -> inlineListToHtml opts lst >>= return . H.sup (Subscript lst) -> H.sub <$> inlineListToHtml opts lst
(Subscript lst) -> inlineListToHtml opts lst >>= return . H.sub
(Quoted quoteType lst) -> (Quoted quoteType lst) ->
let (leftQuote, rightQuote) = case quoteType of let (leftQuote, rightQuote) = case quoteType of
SingleQuote -> (strToHtml "‘", SingleQuote -> (strToHtml "‘",
@ -1210,7 +1207,7 @@ blockListToNote opts ref blocks = do
html5 <- gets stHtml5 html5 <- gets stHtml5
-- If last block is Para or Plain, include the backlink at the end of -- If last block is Para or Plain, include the backlink at the end of
-- that block. Otherwise, insert a new Plain block with the backlink. -- that block. Otherwise, insert a new Plain block with the backlink.
let kvs = if html5 then [("role","doc-backlink")] else [] let kvs = [("role","doc-backlink") | html5]
let backlink = [Link ("",["footnote-back"],kvs) let backlink = [Link ("",["footnote-back"],kvs)
[Str "↩"] ("#" <> "fnref" <> ref,"")] [Str "↩"] ("#" <> "fnref" <> ref,"")]
let blocks' = if null blocks let blocks' = if null blocks