-- | Converts Pandoc to HTML. module Text.Pandoc.Writers.HTML ( writeHtml ) where import Text.Pandoc.Definition import Text.Pandoc.Shared import Text.Html ( stringToHtmlString ) import Text.Regex ( mkRegex ) import Numeric ( showHex ) import Char ( ord ) import List ( isPrefixOf ) -- | Convert Pandoc document to string in HTML format. writeHtml :: WriterOptions -> Pandoc -> String writeHtml options (Pandoc (Meta title authors date) blocks) = let titlePrefix = writerTitlePrefix options in let topTitle = if not (null titlePrefix) then [Str titlePrefix] ++ (if not (null title) then [Str " - "] ++ title else []) else title in let head = if (writerStandalone options) then htmlHeader options (Meta topTitle authors date) else "" titleBlocks = if (writerStandalone options) && (not (null title)) && (not (writerS5 options)) then [RawHtml "

", Plain title, RawHtml "

\n"] else [] foot = if (writerStandalone options) then "\n\n" else "" body = (writerIncludeBefore options) ++ concatMap (blockToHtml options) (replaceReferenceLinks (titleBlocks ++ blocks)) ++ (writerIncludeAfter options) in head ++ body ++ foot -- | Obfuscate a "mailto:" link using Javascript. obfuscateLink :: WriterOptions -> [Inline] -> String -> String obfuscateLink options text src = let text' = inlineListToHtml options text in let linkText = if src == ("mailto:" ++ text') then "e" else "'" ++ text' ++ "'" altText = if src == ("mailto:" ++ text') then "\\1 [at] \\2" else text' ++ " (\\1 [at] \\2)" in gsub "mailto:([^@]*)@(.*)" ("") src -- | 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 ++ ";" -- | Escape string, preserving character entities and quote. stringToHtml :: String -> String stringToHtml str = escapePreservingRegex stringToHtmlString (mkRegex "\"|(&[[:alnum:]]*;)") str -- | Escape string as in 'stringToHtml' but add smartypants filter. stringToSmartHtml :: String -> String stringToSmartHtml = let escapeDoubleQuotes = gsub "(\"|")" "”" . -- rest are right quotes gsub "(\"|")(&r[sd]quo;)" "”\\2" . -- never left quo before right quo gsub "(&l[sd]quo;)(\"|")" "\\2“" . -- never right quo after left quo gsub "([ \t])(\"|")" "\\1“" . -- never right quo after space gsub "(\"|")([^,.;:!?^) \t-])" "“\\2" . -- "word left gsub "(\"|")('|`|‘)" "”’" . -- right if it got through last filter gsub "(\"|")('|`|‘)([^,.;:!?^) \t-])" "“‘\\3" . -- "'word left gsub "``" "“" . gsub "''" "”" escapeSingleQuotes = gsub "'" "’" . -- otherwise right gsub "'(&r[sd]quo;)" "’\\1" . -- never left quo before right quo gsub "(&l[sd]quo;)'" "\\1‘" . -- never right quo after left quo gsub "([ \t])'" "\\1‘" . -- never right quo after space gsub "`" "‘" . -- ` is left gsub "([^,.;:!?^) \t-])'" "\\1’" . -- word' right gsub "^('|`)([^,.;:!?^) \t-])" "‘\\2" . -- 'word left gsub "('|`)(\"|"|“|``)" "‘“" . -- '"word left gsub "([^,.;:!?^) \t-])'(s|S)" "\\1’\\2" . -- possessive gsub "([[:space:]])'([^,.;:!?^) \t-])" "\\1‘\\2" . -- 'word left gsub "'([0-9][0-9](s|S))" "’\\1" -- '80s - decade abbrevs. escapeDashes = gsub " ?-- ?" "—" . gsub " ?--- ?" "—" . gsub "([0-9])--?([0-9])" "\\1–\\2" escapeEllipses = gsub "\\.\\.\\.|\\. \\. \\." "…" in escapeSingleQuotes . escapeDoubleQuotes . escapeDashes . escapeEllipses . stringToHtml -- | Escape code string as needed for HTML. codeStringToHtml :: String -> String codeStringToHtml [] = [] codeStringToHtml (x:xs) = case x of '&' -> "&" ++ codeStringToHtml xs '<' -> "<" ++ codeStringToHtml xs _ -> x:(codeStringToHtml xs) -- | Escape string to HTML appropriate for attributes attributeStringToHtml :: String -> String attributeStringToHtml = gsub "\"" """ -- | Returns an HTML header with appropriate bibliographic information. htmlHeader :: WriterOptions -> Meta -> String htmlHeader options (Meta title authors date) = let titletext = "" ++ (inlineListToHtml options title) ++ "\n" authortext = if (null authors) then "" else "\n" datetext = if (date == "") then "" else "\n" in (writerHeader options) ++ authortext ++ datetext ++ titletext ++ "\n\n" -- | Convert Pandoc block element to HTML. blockToHtml :: WriterOptions -> Block -> String blockToHtml options Blank = "\n" blockToHtml options Null = "" blockToHtml options (Plain lst) = inlineListToHtml options lst blockToHtml options (Para lst) = "

" ++ (inlineListToHtml options lst) ++ "

\n" blockToHtml options (BlockQuote blocks) = if (writerS5 options) then -- in S5, treat list in blockquote specially -- if default is incremental, make it nonincremental; otherwise incremental let inc = not (writerIncremental options) in case blocks of [BulletList lst] -> blockToHtml (options {writerIncremental = inc}) (BulletList lst) [OrderedList lst] -> blockToHtml (options {writerIncremental = inc}) (OrderedList lst) otherwise -> "
\n" ++ (concatMap (blockToHtml options) blocks) ++ "
\n" else "
\n" ++ (concatMap (blockToHtml options) blocks) ++ "
\n" blockToHtml options (Note ref lst) = let marker = "(" ++ ref ++ ") " in let contents = (concatMap (blockToHtml options) lst) in let contents' = case contents of ('<':'p':'>':rest) -> "

" ++ marker ++ rest ++ "\n" otherwise -> marker ++ contents ++ "\n" in "

\n" ++ contents' ++ "
\n" blockToHtml options (Key _ _) = "" blockToHtml options (CodeBlock str) = "
" ++ (codeStringToHtml str) ++ 
                                      "\n
\n" blockToHtml options (RawHtml str) = str blockToHtml options (BulletList lst) = let attribs = if (writerIncremental options) then " class=\"incremental\"" else "" in "\n" ++ (concatMap (listItemToHtml options) lst) ++ "\n" blockToHtml options (OrderedList lst) = let attribs = if (writerIncremental options) then " class=\"incremental\"" else "" in "\n" ++ (concatMap (listItemToHtml options) lst) ++ "\n" blockToHtml options HorizontalRule = "
\n" blockToHtml options (Header level lst) = if ((level > 0) && (level <= 6)) then "" ++ (inlineListToHtml options lst) ++ "\n" else "

" ++ (inlineListToHtml options lst) ++ "

\n" listItemToHtml options list = "
  • " ++ (concatMap (blockToHtml options) list) ++ "
  • \n" -- | Convert list of Pandoc inline elements to HTML. inlineListToHtml :: WriterOptions -> [Inline] -> String inlineListToHtml options lst = -- consolidate adjacent Str and Space elements for more intelligent -- smartypants filtering let lst' = consolidateList lst in concatMap (inlineToHtml options) lst' -- | Convert Pandoc inline element to HTML. inlineToHtml :: WriterOptions -> Inline -> String inlineToHtml options (Emph lst) = "" ++ (inlineListToHtml options lst) ++ "" inlineToHtml options (Strong lst) = "" ++ (inlineListToHtml options lst) ++ "" inlineToHtml options (Code str) = "" ++ (codeStringToHtml str) ++ "" inlineToHtml options (Str str) = if (writerSmartypants options) then stringToSmartHtml str else stringToHtml str inlineToHtml options (TeX str) = (codeStringToHtml str) inlineToHtml options (HtmlInline str) = str inlineToHtml options (LineBreak) = "
    \n" inlineToHtml options Space = " " inlineToHtml options (Link text (Src src tit)) = let title = attributeStringToHtml tit in if (isPrefixOf "mailto:" src) then obfuscateLink options text src else "" else ">") ++ (inlineListToHtml options text) ++ "" inlineToHtml options (Link text (Ref [])) = "[" ++ (inlineListToHtml options text) ++ "]" inlineToHtml options (Link text (Ref ref)) = "[" ++ (inlineListToHtml options text) ++ "][" ++ (inlineListToHtml options ref) ++ "]" -- this is what markdown does, for better or worse inlineToHtml options (Image alt (Src source tit)) = let title = attributeStringToHtml tit alternate = inlineListToHtml options alt in "\""" inlineToHtml options (Image alternate (Ref [])) = "![" ++ (inlineListToHtml options alternate) ++ "]" inlineToHtml options (Image alternate (Ref ref)) = "![" ++ (inlineListToHtml options alternate) ++ "][" ++ (inlineListToHtml options ref) ++ "]" inlineToHtml options (NoteRef ref) = "(" ++ ref ++ ")"