diff options
Diffstat (limited to 'src/Text/Pandoc/Writers/HTML.hs')
-rw-r--r-- | src/Text/Pandoc/Writers/HTML.hs | 311 |
1 files changed, 176 insertions, 135 deletions
diff --git a/src/Text/Pandoc/Writers/HTML.hs b/src/Text/Pandoc/Writers/HTML.hs index 7ba506acb..1b5201191 100644 --- a/src/Text/Pandoc/Writers/HTML.hs +++ b/src/Text/Pandoc/Writers/HTML.hs @@ -1,4 +1,14 @@ --- | Converts Pandoc to HTML. +{- | + Module : Text.Pandoc.Writers.HTML + Copyright : Copyright (C) 2006 John MacFarlane + License : GNU GPL, version 2 or above + + Maintainer : John MacFarlane <jgm at berkeley dot edu> + Stability : unstable + Portability : portable + +Conversion of 'Pandoc' documents to HTML. +-} module Text.Pandoc.Writers.HTML ( writeHtml ) where @@ -13,94 +23,108 @@ import Data.List ( isPrefixOf, partition ) -- | 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 "<h1 class=\"title\">", Plain title, RawHtml "</h1>\n"] - else - [] - foot = if (writerStandalone options) then "</body>\n</html>\n" else "" - blocks' = replaceReferenceLinks (titleBlocks ++ blocks) - (noteBlocks, blocks'') = partition isNoteBlock blocks' - body = (writerIncludeBefore options) ++ - concatMap (blockToHtml options) blocks'' ++ - footnoteSection options noteBlocks ++ - (writerIncludeAfter options) in - head ++ body ++ foot + 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 "<h1 class=\"title\">", Plain title, + RawHtml "</h1>\n"] + else [] + foot = if (writerStandalone options) then "</body>\n</html>\n" else "" + blocks' = replaceReferenceLinks (titleBlocks ++ blocks) + (noteBlocks, blocks'') = partition isNoteBlock blocks' + body = (writerIncludeBefore options) ++ + concatMap (blockToHtml options) blocks'' ++ + footnoteSection options noteBlocks ++ + (writerIncludeAfter options) in + head ++ body ++ foot --- | Convert list of Note blocks to a footnote <div>. Assumes notes are sorted. +-- | Convert list of Note blocks to a footnote <div>. +-- Assumes notes are sorted. footnoteSection :: WriterOptions -> [Block] -> String footnoteSection options notes = - if null notes - then "" - else "<div class=\"footnotes\">\n<hr />\n<ol>\n" ++ - concatMap (blockToHtml options) notes ++ - "</ol>\n</div>\n" + if null notes + then "" + else "<div class=\"footnotes\">\n<hr />\n<ol>\n" ++ + concatMap (blockToHtml options) notes ++ + "</ol>\n</div>\n" -- | 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 + 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:([^@]*)@(.*)" ("<script type=\"text/javascript\">h='\\2';n='\\1';e=n+'@'+h;document.write('<a href=\"mailto:'+e+'\">'+" ++ linkText ++ "+'<\\/a>');</script><noscript>" ++ altText ++ "</noscript>") 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 ++ ";" +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 +stringToHtml str = escapePreservingRegex stringToHtmlString + (mkRegex "\"|(&[[:alnum:]]*;)") str -- | Escape string as in 'stringToHtml' but add smart typography 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 + 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) + '&' -> "&" ++ codeStringToHtml xs + '<' -> "<" ++ codeStringToHtml xs + _ -> x:(codeStringToHtml xs) -- | Escape string to HTML appropriate for attributes attributeStringToHtml :: String -> String @@ -109,17 +133,19 @@ attributeStringToHtml = gsub "\"" """ -- | Returns an HTML header with appropriate bibliographic information. htmlHeader :: WriterOptions -> Meta -> String htmlHeader options (Meta title authors date) = - let titletext = "<title>" ++ (inlineListToHtml options title) ++ "</title>\n" - authortext = if (null authors) then - "" - else - "<meta name=\"author\" content=\"" ++ - (joinWithSep ", " (map stringToHtml authors)) ++ "\" />\n" - datetext = if (date == "") then - "" - else - "<meta name=\"date\" content=\"" ++ (stringToHtml date) ++ "\" />\n" in - (writerHeader options) ++ authortext ++ datetext ++ titletext ++ "</head>\n<body>\n" + let titletext = "<title>" ++ (inlineListToHtml options title) ++ + "</title>\n" + authortext = if (null authors) + then "" + else "<meta name=\"author\" content=\"" ++ + (joinWithSep ", " (map stringToHtml authors)) ++ + "\" />\n" + datetext = if (date == "") + then "" + else "<meta name=\"date\" content=\"" ++ + (stringToHtml date) ++ "\" />\n" in + (writerHeader options) ++ authortext ++ datetext ++ titletext ++ + "</head>\n<body>\n" -- | Convert Pandoc block element to HTML. blockToHtml :: WriterOptions -> Block -> String @@ -128,85 +154,100 @@ blockToHtml options Null = "" blockToHtml options (Plain lst) = inlineListToHtml options lst blockToHtml options (Para lst) = "<p>" ++ (inlineListToHtml options lst) ++ "</p>\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 -> "<blockquote>\n" ++ (concatMap (blockToHtml options) blocks) ++ - "</blockquote>\n" - else - "<blockquote>\n" ++ (concatMap (blockToHtml options) blocks) ++ "</blockquote>\n" + 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 -> "<blockquote>\n" ++ + (concatMap (blockToHtml options) blocks) ++ + "</blockquote>\n" + else "<blockquote>\n" ++ (concatMap (blockToHtml options) blocks) ++ + "</blockquote>\n" blockToHtml options (Note ref lst) = - let contents = (concatMap (blockToHtml options) lst) in - "<li id=\"fn" ++ ref ++ "\">" ++ contents ++ " <a href=\"#fnref" ++ ref ++ - "\" class=\"footnoteBacklink\" title=\"Jump back to footnote " ++ ref ++ - "\">↩</a></li>\n" + let contents = (concatMap (blockToHtml options) lst) in + "<li id=\"fn" ++ ref ++ "\">" ++ contents ++ " <a href=\"#fnref" ++ ref ++ + "\" class=\"footnoteBacklink\" title=\"Jump back to footnote " ++ ref ++ + "\">↩</a></li>\n" blockToHtml options (Key _ _) = "" -blockToHtml options (CodeBlock str) = "<pre><code>" ++ (codeStringToHtml str) ++ - "\n</code></pre>\n" +blockToHtml options (CodeBlock str) = + "<pre><code>" ++ (codeStringToHtml str) ++ "\n</code></pre>\n" blockToHtml options (RawHtml str) = str blockToHtml options (BulletList lst) = - let attribs = if (writerIncremental options) then " class=\"incremental\"" else "" in - "<ul" ++ attribs ++ ">\n" ++ (concatMap (listItemToHtml options) lst) ++ "</ul>\n" + let attribs = if (writerIncremental options) + then " class=\"incremental\"" + else "" in + "<ul" ++ attribs ++ ">\n" ++ (concatMap (listItemToHtml options) lst) ++ + "</ul>\n" blockToHtml options (OrderedList lst) = - let attribs = if (writerIncremental options) then " class=\"incremental\"" else "" in - "<ol" ++ attribs ++ ">\n" ++ (concatMap (listItemToHtml options) lst) ++ "</ol>\n" + let attribs = if (writerIncremental options) + then " class=\"incremental\"" + else "" in + "<ol" ++ attribs ++ ">\n" ++ (concatMap (listItemToHtml options) lst) ++ + "</ol>\n" blockToHtml options HorizontalRule = "<hr />\n" blockToHtml options (Header level lst) = - let contents = inlineListToHtml options lst in - let simplify = gsub "<[^>]*>" "" . gsub " " "_" in - if ((level > 0) && (level <= 6)) - then "<a id=\"" ++ simplify contents ++ "\"></a>\n" ++ - "<h" ++ (show level) ++ ">" ++ contents ++ - "</h" ++ (show level) ++ ">\n" - else "<p>" ++ contents ++ "</p>\n" -listItemToHtml options list = "<li>" ++ (concatMap (blockToHtml options) list) ++ "</li>\n" + let contents = inlineListToHtml options lst in + let simplify = gsub "<[^>]*>" "" . gsub " " "_" in + if ((level > 0) && (level <= 6)) + then "<a id=\"" ++ simplify contents ++ "\"></a>\n" ++ + "<h" ++ (show level) ++ ">" ++ contents ++ + "</h" ++ (show level) ++ ">\n" + else "<p>" ++ contents ++ "</p>\n" +listItemToHtml options list = + "<li>" ++ (concatMap (blockToHtml options) list) ++ "</li>\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 - -- smart typography filtering - let lst' = consolidateList lst in - concatMap (inlineToHtml options) lst' + -- consolidate adjacent Str and Space elements for more intelligent + -- smart typography filtering + let lst' = consolidateList lst in + concatMap (inlineToHtml options) lst' -- | Convert Pandoc inline element to HTML. inlineToHtml :: WriterOptions -> Inline -> String -inlineToHtml options (Emph lst) = "<em>" ++ (inlineListToHtml options lst) ++ "</em>" -inlineToHtml options (Strong lst) = "<strong>" ++ (inlineListToHtml options lst) ++ "</strong>" -inlineToHtml options (Code str) = "<code>" ++ (codeStringToHtml str) ++ "</code>" -inlineToHtml options (Str str) = if (writerSmart options) then - stringToSmartHtml str - else - stringToHtml str +inlineToHtml options (Emph lst) = + "<em>" ++ (inlineListToHtml options lst) ++ "</em>" +inlineToHtml options (Strong lst) = + "<strong>" ++ (inlineListToHtml options lst) ++ "</strong>" +inlineToHtml options (Code str) = + "<code>" ++ (codeStringToHtml str) ++ "</code>" +inlineToHtml options (Str str) = + if (writerSmart options) then stringToSmartHtml str else stringToHtml str inlineToHtml options (TeX str) = (codeStringToHtml str) inlineToHtml options (HtmlInline str) = str inlineToHtml options (LineBreak) = "<br />\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 - "<a href=\"" ++ (codeStringToHtml src) ++ "\"" ++ - (if tit /= "" then " title=\"" ++ title ++ "\">" else ">") ++ - (inlineListToHtml options text) ++ "</a>" -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 + let title = attributeStringToHtml tit in + if (isPrefixOf "mailto:" src) + then obfuscateLink options text src + else "<a href=\"" ++ (codeStringToHtml src) ++ "\"" ++ + (if tit /= "" then " title=\"" ++ title ++ "\">" else ">") ++ + (inlineListToHtml options text) ++ "</a>" +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 - "<img src=\"" ++ source ++ "\"" ++ - (if tit /= "" then " title=\"" ++ title ++ "\"" else "") ++ - (if alternate /= "" then " alt=\"" ++ alternate ++ "\"" else "") ++ ">" + let title = attributeStringToHtml tit + alternate = inlineListToHtml options alt in + "<img src=\"" ++ source ++ "\"" ++ + (if tit /= "" then " title=\"" ++ title ++ "\"" else "") ++ + (if alternate /= "" then " alt=\"" ++ alternate ++ "\"" else "") ++ ">" inlineToHtml options (Image alternate (Ref [])) = - "![" ++ (inlineListToHtml options alternate) ++ "]" + "![" ++ (inlineListToHtml options alternate) ++ "]" inlineToHtml options (Image alternate (Ref ref)) = - "![" ++ (inlineListToHtml options alternate) ++ "][" ++ (inlineListToHtml options ref) ++ "]" + "![" ++ (inlineListToHtml options alternate) ++ "][" ++ + (inlineListToHtml options ref) ++ "]" inlineToHtml options (NoteRef ref) = - "<sup class=\"footnoteRef\" id=\"fnref" ++ ref ++ "\"><a href=\"#fn" ++ ref ++ - "\">" ++ ref ++ "</a></sup>" - + "<sup class=\"footnoteRef\" id=\"fnref" ++ ref ++ "\"><a href=\"#fn" ++ + ref ++ "\">" ++ ref ++ "</a></sup>" |