. -- Assumes notes are sorted. footnoteSection :: WriterOptions -> [Block] -> Doc footnoteSection opts notes = if null notes then empty else inTags True "div" [("class","footnotes")] $ selfClosingTag "hr" [] $$ (inTagsIndented "ol" (vcat $ map (blockToHtml opts) notes)) -- | Obfuscate a "mailto:" link using Javascript. obfuscateLink :: WriterOptions -> [Inline] -> String -> Doc obfuscateLink opts txt src = let emailRegex = mkRegex "mailto:*([^@]*)@(.*)" text' = render $ inlineListToHtml opts txt src' = map toLower src in case (matchRegex emailRegex src') of (Just [name, domain]) -> let domain' = substitute "." " dot " domain at' = obfuscateChar '@' in let linkText = if src' == ("mailto:" ++ text') then "e" else "'" ++ text' ++ "'" altText = if src' == ("mailto:" ++ text') then name ++ " at " ++ domain' else text' ++ " (" ++ name ++ " at " ++ domain' ++ ")" in if writerStrictMarkdown opts then inTags False "a" [("href", obfuscateString src')] $ text $ obfuscateString text' else inTags False "script" [("type", "text/javascript")] (text ("\n\n")) <> inTagsSimple "noscript" (text (obfuscateString altText)) _ -> inTags False "a" [("href", src)] (text text') -- malformed email -- | Obfuscate character as entity. obfuscateChar :: Char -> String obfuscateChar char = let num = ord char in let numstr = if even num then (show num) else ("x" ++ (showHex num "")) in "&#" ++ numstr ++ ";" -- | Obfuscate string using entities. obfuscateString :: String -> String obfuscateString = concatMap obfuscateChar -- | Return an HTML header with appropriate bibliographic information. htmlHeader :: WriterOptions -> Meta -> Doc htmlHeader opts (Meta title authors date) = let titletext = inTagsSimple "title" (wrap opts title) authortext = if (null authors) then empty else selfClosingTag "meta" [("name", "author"), ("content", joinWithSep ", " (map stringToSGML authors))] datetext = if (date == "") then empty else selfClosingTag "meta" [("name", "date"), ("content", stringToSGML date)] in text (writerHeader opts) $$ authortext $$ datetext $$ titletext $$ text "\n" -- | Take list of inline elements and return wrapped doc. wrap :: WriterOptions -> [Inline] -> Doc wrap opts lst = fsep $ map (inlineListToHtml opts) (splitBy Space lst) -- | Convert Pandoc block element to HTML. blockToHtml :: WriterOptions -> Block -> Doc blockToHtml opts Blank = text "" blockToHtml opts Null = empty blockToHtml opts (Plain lst) = wrap opts lst blockToHtml opts (Para lst) = inTagsIndented "p" $ wrap opts lst blockToHtml opts (BlockQuote blocks) = if (writerS5 opts) then -- in S5, treat list in blockquote specially -- if default is incremental, make it nonincremental; -- otherwise incremental let inc = not (writerIncremental opts) in case blocks of [BulletList lst] -> blockToHtml (opts {writerIncremental = inc}) (BulletList lst) [OrderedList lst] -> blockToHtml (opts {writerIncremental = inc}) (OrderedList lst) otherwise -> inTagsIndented "blockquote" $ vcat $ map (blockToHtml opts) blocks else inTagsIndented "blockquote" $ vcat $ map (blockToHtml opts) blocks blockToHtml opts (Note ref lst) = let contents = (vcat $ map (blockToHtml opts) lst) in inTags True "li" [("id", "fn" ++ ref)] $ contents <> inTags False "a" [("href", "#fnref" ++ ref), ("class", "footnoteBacklink"), ("title", "Jump back to footnote " ++ ref)] (text "↩") blockToHtml opts (Key _ _) = empty blockToHtml opts (CodeBlock str) = text "

" <> text (escapeSGML str) <> text "\n

" blockToHtml opts (RawHtml str) = text str blockToHtml opts (BulletList lst) = let attribs = if (writerIncremental opts) then [("class","incremental")] else [] in inTags True "ul" attribs $ vcat $ map (listItemToHtml opts) lst blockToHtml opts (OrderedList lst) = let attribs = if (writerIncremental opts) then [("class","incremental")] else [] in inTags True "ol" attribs $ vcat $ map (listItemToHtml opts) lst blockToHtml opts HorizontalRule = selfClosingTag "hr" [] blockToHtml opts (Header level lst) = let contents = wrap opts lst in if ((level > 0) && (level <= 6)) then inTagsSimple ("h" ++ show level) contents else inTagsSimple "p" contents blockToHtml opts (Table caption aligns widths headers rows) = let alignStrings = map alignmentToString aligns captionDoc = if null caption then empty else inTagsSimple "caption" (inlineListToHtml opts caption) in inTagsIndented "table" $ captionDoc $$ (colHeadsToHtml opts alignStrings widths headers) $$ (vcat $ map (tableRowToHtml opts alignStrings) rows) colHeadsToHtml opts alignStrings widths headers = let heads = zipWith3 (\align width item -> tableItemToHtml opts "th" align width item) alignStrings widths headers in inTagsIndented "tr" $ vcat heads alignmentToString alignment = case alignment of AlignLeft -> "left" AlignRight -> "right" AlignCenter -> "center" AlignDefault -> "left" tableRowToHtml opts aligns cols = inTagsIndented "tr" $ vcat $ zipWith3 (tableItemToHtml opts "td") aligns (repeat 0) cols tableItemToHtml opts tag align width item = let attrib = [("align", align)] ++ if (width /= 0) then [("style", "{width: " ++ show (truncate (100*width)) ++ "%;}")] else [] in inTags False tag attrib $ vcat $ map (blockToHtml opts) item listItemToHtml :: WriterOptions -> [Block] -> Doc listItemToHtml opts list = inTagsSimple "li" $ vcat $ map (blockToHtml opts) list -- | Convert list of Pandoc inline elements to HTML. inlineListToHtml :: WriterOptions -> [Inline] -> Doc inlineListToHtml opts lst = hcat (map (inlineToHtml opts) lst) -- | Convert Pandoc inline element to HTML. inlineToHtml :: WriterOptions -> Inline -> Doc inlineToHtml opts (Emph lst) = inTagsSimple "em" (inlineListToHtml opts lst) inlineToHtml opts (Strong lst) = inTagsSimple "strong" (inlineListToHtml opts lst) inlineToHtml opts (Code str) = inTagsSimple "code" $ text (escapeSGML str) inlineToHtml opts (Quoted SingleQuote lst) = text "‘" <> (inlineListToHtml opts lst) <> text "’" inlineToHtml opts (Quoted DoubleQuote lst) = text "“" <> (inlineListToHtml opts lst) <> text "”" inlineToHtml opts EmDash = text "—" inlineToHtml opts EnDash = text "–" inlineToHtml opts Ellipses = text "…" inlineToHtml opts Apostrophe = text "’" inlineToHtml opts (Str str) = text $ stringToSGML str inlineToHtml opts (TeX str) = text $ escapeSGML str inlineToHtml opts (HtmlInline str) = text str inlineToHtml opts (LineBreak) = selfClosingTag "br" [] inlineToHtml opts Space = space inlineToHtml opts (Link txt (Src src tit)) = let title = stringToSGML tit in if (isPrefixOf "mailto:" src) then obfuscateLink opts txt src else inTags False "a" ([("href", escapeSGML src)] ++ if null tit then [] else [("title", title)]) (inlineListToHtml opts txt) inlineToHtml opts (Link txt (Ref ref)) = char '[' <> (inlineListToHtml opts txt) <> text "][" <> (inlineListToHtml opts ref) <> char ']' -- this is what markdown does, for better or worse inlineToHtml opts (Image alt (Src source tit)) = let title = stringToSGML tit alternate = render $ inlineListToHtml opts alt in selfClosingTag "img" $ [("src", source)] ++ (if null alternate then [] else [("alt", alternate)]) ++ [("title", title)] -- note: null title is included, as in Markdown.pl inlineToHtml opts (Image alternate (Ref ref)) = text "![" <> (inlineListToHtml opts alternate) <> text "][" <> (inlineListToHtml opts ref) <> char ']' inlineToHtml opts (NoteRef ref) = inTags False "sup" [("class", "footnoteRef"), ("id", "fnref" ++ ref)] (inTags False "a" [("href", "#fn" ++ ref)] $ text ref)

", Plain title, RawHtml "