diff options
Diffstat (limited to 'src/Text/Pandoc/Writers')
| -rw-r--r-- | src/Text/Pandoc/Writers/HTML.hs | 311 | ||||
| -rw-r--r-- | src/Text/Pandoc/Writers/LaTeX.hs | 155 | ||||
| -rw-r--r-- | src/Text/Pandoc/Writers/Markdown.hs | 148 | ||||
| -rw-r--r-- | src/Text/Pandoc/Writers/RST.hs | 175 | ||||
| -rw-r--r-- | src/Text/Pandoc/Writers/RTF.hs | 155 |
5 files changed, 535 insertions, 409 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>" diff --git a/src/Text/Pandoc/Writers/LaTeX.hs b/src/Text/Pandoc/Writers/LaTeX.hs index 22a96a423..3a3d249e9 100644 --- a/src/Text/Pandoc/Writers/LaTeX.hs +++ b/src/Text/Pandoc/Writers/LaTeX.hs @@ -1,4 +1,14 @@ --- | Convert Pandoc to LaTeX. +{- | + Module : Text.Pandoc.Writers.LaTeX + 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' format into LaTeX. +-} module Text.Pandoc.Writers.LaTeX ( writeLaTeX ) where @@ -9,46 +19,40 @@ import List ( (\\) ) -- | Convert Pandoc to LaTeX. writeLaTeX :: WriterOptions -> Pandoc -> String writeLaTeX options (Pandoc meta blocks) = - let notes = filter isNoteBlock blocks in -- assumes all notes are at outer level - let body = (writerIncludeBefore options) ++ - (concatMap (blockToLaTeX notes) (replaceReferenceLinks blocks)) ++ - (writerIncludeAfter options) in - let head = if writerStandalone options then - latexHeader notes options meta - else - "" in - let foot = if writerStandalone options then "\n\\end{document}\n" else "" in - head ++ body ++ foot + let notes = filter isNoteBlock blocks in -- assumes all notes at outer level + let body = (writerIncludeBefore options) ++ + (concatMap (blockToLaTeX notes) + (replaceReferenceLinks blocks)) ++ + (writerIncludeAfter options) in + let head = if writerStandalone options + then latexHeader notes options meta + else "" in + let foot = if writerStandalone options then "\n\\end{document}\n" else "" in + head ++ body ++ foot -- | Insert bibliographic information into LaTeX header. -latexHeader :: [Block] -- ^ List of note blocks to use in resolving note refs - -> WriterOptions -- ^ Options, including LaTeX header - -> Meta -- ^ Meta with bibliographic information +latexHeader :: [Block] -- ^ List of note blocks to use in resolving note refs + -> WriterOptions -- ^ Options, including LaTeX header + -> Meta -- ^ Meta with bibliographic information -> String latexHeader notes options (Meta title authors date) = - let titletext = if null title then - "" - else - "\\title{" ++ inlineListToLaTeX notes title ++ "}\n" - authorstext = if null authors then - "" - else - "\\author{" ++ (joinWithSep "\\\\" (map stringToLaTeX authors)) ++ "}\n" - datetext = if date == "" then - "" - else - "\\date{" ++ stringToLaTeX date ++ "}\n" - maketitle = if null title then - "" - else - "\\maketitle\n" - secnumline = if (writerNumberSections options) then - "" - else - "\\setcounter{secnumdepth}{0}\n" - header = writerHeader options in - header ++ secnumline ++ titletext ++ authorstext ++ datetext ++ "\\begin{document}\n" ++ maketitle - + let titletext = if null title + then "" + else "\\title{" ++ inlineListToLaTeX notes title ++ "}\n" + authorstext = if null authors + then "" + else "\\author{" ++ (joinWithSep "\\\\" + (map stringToLaTeX authors)) ++ "}\n" + datetext = if date == "" + then "" + else "\\date{" ++ stringToLaTeX date ++ "}\n" + maketitle = if null title then "" else "\\maketitle\n" + secnumline = if (writerNumberSections options) + then "" + else "\\setcounter{secnumdepth}{0}\n" + header = writerHeader options in + header ++ secnumline ++ titletext ++ authorstext ++ datetext ++ + "\\begin{document}\n" ++ maketitle -- escape things as needed for LaTeX (also ldots, dashes, quotes, etc.) @@ -77,7 +81,8 @@ escapeSingleQuotes = gsub "([^[:punct:][:space:]])`(s|S)" "\\1'\\2" . -- catch possessives gsub "^'([^[:punct:][:space:]])" "`\\1" . -- 'word left gsub "([[:space:]])'" "\\1`" . -- never right quote after space - gsub "([[:space:]])'([^[:punct:][:space:]])" "\\1`\\2" -- 'word left (leave possessives) + gsub "([[:space:]])'([^[:punct:][:space:]])" "\\1`\\2" + -- 'word left (leave possessives) escapeEllipses = gsub "\\.\\.\\.|\\. \\. \\." "\\ldots{}" @@ -85,12 +90,14 @@ escapeDashes = gsub "([0-9])-([0-9])" "\\1--\\2" . gsub " *--- *" "---" . gsub "([^-])--([^-])" "\\1---\\2" -escapeSmart = escapeDashes . escapeSingleQuotes . escapeDoubleQuotes . escapeEllipses +escapeSmart = escapeDashes . escapeSingleQuotes . escapeDoubleQuotes . + escapeEllipses -- | Escape string for LaTeX (including smart quotes, dashes, ellipses) stringToLaTeX :: String -> String stringToLaTeX = escapeSmart . escapeGt . escapeLt . escapeBar . escapeHat . - escapeSpecial . fixBackslash . escapeBrackets . escapeBackslash + escapeSpecial . fixBackslash . escapeBrackets . + escapeBackslash -- | Remove all code elements from list of inline elements -- (because it's illegal to have a \\verb inside a command argument) @@ -107,43 +114,47 @@ blockToLaTeX notes Blank = "\n" blockToLaTeX notes Null = "" blockToLaTeX notes (Plain lst) = inlineListToLaTeX notes lst ++ "\n" blockToLaTeX notes (Para lst) = (inlineListToLaTeX notes lst) ++ "\n\n" -blockToLaTeX notes (BlockQuote lst) = - "\\begin{quote}\n" ++ (concatMap (blockToLaTeX notes) lst) ++ "\\end{quote}\n" +blockToLaTeX notes (BlockQuote lst) = "\\begin{quote}\n" ++ + (concatMap (blockToLaTeX notes) lst) ++ "\\end{quote}\n" blockToLaTeX notes (Note ref lst) = "" blockToLaTeX notes (Key _ _) = "" -blockToLaTeX notes (CodeBlock str) = "\\begin{verbatim}\n" ++ str ++ "\n\\end{verbatim}\n" +blockToLaTeX notes (CodeBlock str) = "\\begin{verbatim}\n" ++ str ++ + "\n\\end{verbatim}\n" blockToLaTeX notes (RawHtml str) = "" -blockToLaTeX notes (BulletList lst) = - "\\begin{itemize}\n" ++ (concatMap (listItemToLaTeX notes) lst) ++ "\\end{itemize}\n" -blockToLaTeX notes (OrderedList lst) = - "\\begin{enumerate}\n" ++ (concatMap (listItemToLaTeX notes) lst) ++ "\\end{enumerate}\n" -blockToLaTeX notes HorizontalRule = "\\begin{center}\\rule{3in}{0.4pt}\\end{center}\n\n" +blockToLaTeX notes (BulletList lst) = "\\begin{itemize}\n" ++ + (concatMap (listItemToLaTeX notes) lst) ++ "\\end{itemize}\n" +blockToLaTeX notes (OrderedList lst) = "\\begin{enumerate}\n" ++ + (concatMap (listItemToLaTeX notes) lst) ++ "\\end{enumerate}\n" +blockToLaTeX notes HorizontalRule = + "\\begin{center}\\rule{3in}{0.4pt}\\end{center}\n\n" blockToLaTeX notes (Header level lst) = - if (level > 0) && (level <= 3) then - "\\" ++ (concat (replicate (level - 1) "sub")) ++ "section{" ++ - (inlineListToLaTeX notes (deVerb lst)) ++ "}\n\n" - else - (inlineListToLaTeX notes lst) ++ "\n\n" -listItemToLaTeX notes list = "\\item " ++ (concatMap (blockToLaTeX notes) list) + if (level > 0) && (level <= 3) + then "\\" ++ (concat (replicate (level - 1) "sub")) ++ "section{" ++ + (inlineListToLaTeX notes (deVerb lst)) ++ "}\n\n" + else (inlineListToLaTeX notes lst) ++ "\n\n" +listItemToLaTeX notes list = "\\item " ++ + (concatMap (blockToLaTeX notes) list) -- | Convert list of inline elements to LaTeX. inlineListToLaTeX :: [Block] -- ^ List of note blocks to use in resolving note refs -> [Inline] -- ^ Inlines to convert -> String inlineListToLaTeX notes lst = - -- first, consolidate Str and Space for more effective smartquotes: - let lst' = consolidateList lst in - concatMap (inlineToLaTeX notes) lst' + -- first, consolidate Str and Space for more effective smartquotes: + let lst' = consolidateList lst in + concatMap (inlineToLaTeX notes) lst' -- | Convert inline element to LaTeX inlineToLaTeX :: [Block] -- ^ List of note blocks to use in resolving note refs -> Inline -- ^ Inline to convert -> String -inlineToLaTeX notes (Emph lst) = "\\emph{" ++ (inlineListToLaTeX notes (deVerb lst)) ++ "}" -inlineToLaTeX notes (Strong lst) = "\\textbf{" ++ (inlineListToLaTeX notes (deVerb lst)) ++ "}" +inlineToLaTeX notes (Emph lst) = "\\emph{" ++ + (inlineListToLaTeX notes (deVerb lst)) ++ "}" +inlineToLaTeX notes (Strong lst) = "\\textbf{" ++ + (inlineListToLaTeX notes (deVerb lst)) ++ "}" inlineToLaTeX notes (Code str) = "\\verb" ++ [chr] ++ stuffing ++ [chr] - where stuffing = str - chr = ((enumFromTo '!' '~') \\ stuffing) !! 0 + where stuffing = str + chr = ((enumFromTo '!' '~') \\ stuffing) !! 0 inlineToLaTeX notes (Str str) = stringToLaTeX str inlineToLaTeX notes (TeX str) = str inlineToLaTeX notes (HtmlInline str) = "" @@ -151,18 +162,22 @@ inlineToLaTeX notes (LineBreak) = "\\\\\n" inlineToLaTeX notes Space = " " inlineToLaTeX notes (Link text (Src src tit)) = "\\href{" ++ src ++ "}{" ++ (inlineListToLaTeX notes (deVerb text)) ++ "}" -inlineToLaTeX notes (Link text (Ref [])) = "[" ++ (inlineListToLaTeX notes text) ++ "]" -inlineToLaTeX notes (Link text (Ref ref)) = "[" ++ (inlineListToLaTeX notes text) ++ "][" ++ - (inlineListToLaTeX notes ref) ++ "]" -- this is what markdown does, for better or worse -inlineToLaTeX notes (Image alternate (Src source tit)) = "\\includegraphics{" ++ source ++ "}" +inlineToLaTeX notes (Link text (Ref [])) = "[" ++ + (inlineListToLaTeX notes text) ++ "]" +inlineToLaTeX notes (Link text (Ref ref)) = "[" ++ + (inlineListToLaTeX notes text) ++ "][" ++ (inlineListToLaTeX notes ref) ++ + "]" -- this is what markdown does, for better or worse +inlineToLaTeX notes (Image alternate (Src source tit)) = + "\\includegraphics{" ++ source ++ "}" inlineToLaTeX notes (Image alternate (Ref [])) = "![" ++ (inlineListToLaTeX notes alternate) ++ "]" inlineToLaTeX notes (Image alternate (Ref ref)) = - "![" ++ (inlineListToLaTeX notes alternate) ++ "][" ++ (inlineListToLaTeX notes ref) ++ "]" + "![" ++ (inlineListToLaTeX notes alternate) ++ "][" ++ + (inlineListToLaTeX notes ref) ++ "]" inlineToLaTeX [] (NoteRef ref) = "" inlineToLaTeX ((Note firstref firstblocks):rest) (NoteRef ref) = - if (firstref == ref) then - "\\footnote{" ++ (stripTrailingNewlines (concatMap (blockToLaTeX rest) firstblocks)) ++ "}" - else - inlineToLaTeX rest (NoteRef ref) + if (firstref == ref) + then "\\footnote{" ++ (stripTrailingNewlines + (concatMap (blockToLaTeX rest) firstblocks)) ++ "}" + else inlineToLaTeX rest (NoteRef ref) diff --git a/src/Text/Pandoc/Writers/Markdown.hs b/src/Text/Pandoc/Writers/Markdown.hs index 55d0eb2e1..eded63425 100644 --- a/src/Text/Pandoc/Writers/Markdown.hs +++ b/src/Text/Pandoc/Writers/Markdown.hs @@ -1,4 +1,16 @@ --- | Converts Pandoc to Markdown. +{- | + Module : Text.Pandoc.Writers.Markdown + 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 markdown-formatted plain text. + +Markdown: http://daringfireball.net/projects/markdown/ +-} module Text.Pandoc.Writers.Markdown ( writeMarkdown ) where @@ -11,11 +23,11 @@ import Text.PrettyPrint.HughesPJ hiding ( Str ) writeMarkdown :: WriterOptions -> Pandoc -> String writeMarkdown options (Pandoc meta blocks) = let body = text (writerIncludeBefore options) <> - vcat (map (blockToMarkdown (writerTabStop options)) (formatKeys blocks)) $$ text (writerIncludeAfter options) in - let head = if (writerStandalone options) then - ((metaToMarkdown meta) $$ text (writerHeader options)) - else - empty in + vcat (map (blockToMarkdown (writerTabStop options)) + (formatKeys blocks)) $$ text (writerIncludeAfter options) in + let head = if (writerStandalone options) + then ((metaToMarkdown meta) $$ text (writerHeader options)) + else empty in render $ head <> body -- | Escape special characters for Markdown. @@ -28,13 +40,15 @@ escapeLinkTitle = gsub "\"" "\\\\\"" -- | Take list of inline elements and return wrapped doc. wrappedMarkdown :: [Inline] -> Doc -wrappedMarkdown lst = fsep $ map (fcat . (map inlineToMarkdown)) (splitBySpace lst) +wrappedMarkdown lst = fsep $ + map (fcat . (map inlineToMarkdown)) (splitBySpace lst) -- | Insert Blank block between key and non-key formatKeys :: [Block] -> [Block] formatKeys [] = [] formatKeys [x] = [x] -formatKeys ((Key x1 y1):(Key x2 y2):rest) = (Key x1 y1):(formatKeys ((Key x2 y2):rest)) +formatKeys ((Key x1 y1):(Key x2 y2):rest) = + (Key x1 y1):(formatKeys ((Key x2 y2):rest)) formatKeys ((Key x1 y1):rest) = (Key x1 y1):Blank:(formatKeys rest) formatKeys (x:(Key x1 y1):rest) = x:Blank:(formatKeys ((Key x1 y1):rest)) formatKeys (x:rest) = x:(formatKeys rest) @@ -43,17 +57,18 @@ formatKeys (x:rest) = x:(formatKeys rest) metaToMarkdown :: Meta -> Doc metaToMarkdown (Meta [] [] "") = empty metaToMarkdown (Meta title [] "") = (titleToMarkdown title) <> (text "\n") -metaToMarkdown (Meta title authors "") = - (titleToMarkdown title) <> (text "\n") <> (authorsToMarkdown authors) <> (text "\n") -metaToMarkdown (Meta title authors date) = - (titleToMarkdown title) <> (text "\n") <> (authorsToMarkdown authors) <> - (text "\n") <> (dateToMarkdown date) <> (text "\n") +metaToMarkdown (Meta title authors "") = (titleToMarkdown title) <> + (text "\n") <> (authorsToMarkdown authors) <> (text "\n") +metaToMarkdown (Meta title authors date) = (titleToMarkdown title) <> + (text "\n") <> (authorsToMarkdown authors) <> (text "\n") <> + (dateToMarkdown date) <> (text "\n") titleToMarkdown :: [Inline] -> Doc titleToMarkdown lst = text "% " <> (inlineListToMarkdown lst) authorsToMarkdown :: [String] -> Doc -authorsToMarkdown lst = text "% " <> text (joinWithSep ", " (map escapeString lst)) +authorsToMarkdown lst = + text "% " <> text (joinWithSep ", " (map escapeString lst)) dateToMarkdown :: String -> Doc dateToMarkdown str = text "% " <> text (escapeString str) @@ -67,33 +82,34 @@ blockToMarkdown tabStop Null = empty blockToMarkdown tabStop (Plain lst) = wrappedMarkdown lst blockToMarkdown tabStop (Para lst) = (wrappedMarkdown lst) <> (text "\n") blockToMarkdown tabStop (BlockQuote lst) = - (vcat $ map (\line -> (text "> ") <> (text line)) $ lines $ render $ vcat $ - map (blockToMarkdown tabStop) lst) <> (text "\n") + (vcat $ map (\line -> (text "> ") <> (text line)) $ lines $ render $ vcat $ + map (blockToMarkdown tabStop) lst) <> (text "\n") blockToMarkdown tabStop (Note ref lst) = - let lns = lines $ render $ vcat $ map (blockToMarkdown tabStop) lst in - if null lns then - empty - else - let first = head lns - rest = tail lns in - text ("[^" ++ (escapeString ref) ++ "]: ") <> (text first) $$ (vcat $ - map (\line -> (text " ") <> (text line)) rest) <> text "\n" + let lns = lines $ render $ vcat $ map (blockToMarkdown tabStop) lst in + if null lns + then empty + else let first = head lns + rest = tail lns in + text ("[^" ++ (escapeString ref) ++ "]: ") <> (text first) $$ + (vcat $ map (\line -> (text " ") <> (text line)) rest) <> + text "\n" blockToMarkdown tabStop (Key txt (Src src tit)) = - text " " <> char '[' <> inlineListToMarkdown txt <> char ']' <> text ": " <> text src <> - (if tit /= "" then (text (" \"" ++ (escapeLinkTitle tit) ++ "\"")) else empty) -blockToMarkdown tabStop (CodeBlock str) = (nest tabStop $ vcat $ map text (lines str)) <> - text "\n" + text " " <> char '[' <> inlineListToMarkdown txt <> char ']' <> + text ": " <> text src <> + if tit /= "" then text (" \"" ++ (escapeLinkTitle tit) ++ "\"") else empty +blockToMarkdown tabStop (CodeBlock str) = + (nest tabStop $ vcat $ map text (lines str)) <> text "\n" blockToMarkdown tabStop (RawHtml str) = text str blockToMarkdown tabStop (BulletList lst) = - vcat (map (bulletListItemToMarkdown tabStop) lst) <> text "\n" + vcat (map (bulletListItemToMarkdown tabStop) lst) <> text "\n" blockToMarkdown tabStop (OrderedList lst) = - vcat (zipWith (orderedListItemToMarkdown tabStop) (enumFromTo 1 (length lst)) lst) <> - text "\n" + vcat (zipWith (orderedListItemToMarkdown tabStop) + (enumFromTo 1 (length lst)) lst) <> text "\n" blockToMarkdown tabStop HorizontalRule = text "\n* * * * *\n" -blockToMarkdown tabStop (Header level lst) = - text ((replicate level '#') ++ " ") <> (inlineListToMarkdown lst) <> (text "\n") +blockToMarkdown tabStop (Header level lst) = text ((replicate level '#') ++ + " ") <> (inlineListToMarkdown lst) <> (text "\n") bulletListItemToMarkdown tabStop list = - hang (text "- ") tabStop (vcat (map (blockToMarkdown tabStop) list)) + hang (text "- ") tabStop (vcat (map (blockToMarkdown tabStop) list)) -- | Convert ordered list item (a list of blocks) to markdown. orderedListItemToMarkdown :: Int -- ^ tab stop @@ -101,8 +117,9 @@ orderedListItemToMarkdown :: Int -- ^ tab stop -> [Block] -- ^ list item (list of blocks) -> Doc orderedListItemToMarkdown tabStop num list = - hang (text ((show num) ++ "." ++ spacer)) tabStop (vcat (map (blockToMarkdown tabStop) list)) - where spacer = if (num < 10) then " " else "" + hang (text ((show num) ++ "." ++ spacer)) tabStop + (vcat (map (blockToMarkdown tabStop) list)) + where spacer = if (num < 10) then " " else "" -- | Convert list of Pandoc inline elements to markdown. inlineListToMarkdown :: [Inline] -> Doc @@ -110,39 +127,46 @@ inlineListToMarkdown lst = hcat $ map inlineToMarkdown lst -- | Convert Pandoc inline element to markdown. inlineToMarkdown :: Inline -> Doc -inlineToMarkdown (Emph lst) = text "*" <> (inlineListToMarkdown lst) <> text "*" -inlineToMarkdown (Strong lst) = text "**" <> (inlineListToMarkdown lst) <> text "**" +inlineToMarkdown (Emph lst) = text "*" <> + (inlineListToMarkdown lst) <> text "*" +inlineToMarkdown (Strong lst) = text "**" <> + (inlineListToMarkdown lst) <> text "**" inlineToMarkdown (Code str) = - case (matchRegex (mkRegex "``") str) of - Just match -> text ("` " ++ str ++ " `") - Nothing -> case (matchRegex (mkRegex "`") str) of - Just match -> text ("`` " ++ str ++ " ``") - Nothing -> text ("`" ++ str ++ "`") + case (matchRegex (mkRegex "``") str) of + Just match -> text ("` " ++ str ++ " `") + Nothing -> case (matchRegex (mkRegex "`") str) of + Just match -> text ("`` " ++ str ++ " ``") + Nothing -> text ("`" ++ str ++ "`") inlineToMarkdown (Str str) = text $ escapeString str inlineToMarkdown (TeX str) = text str inlineToMarkdown (HtmlInline str) = text str inlineToMarkdown (LineBreak) = text " \n" inlineToMarkdown Space = char ' ' inlineToMarkdown (Link txt (Src src tit)) = - let linktext = if (null txt) || (txt == [Str ""]) then - text "link" - else - inlineListToMarkdown txt in - char '[' <> linktext <> char ']' <> char '(' <> text src <> - (if tit /= "" then (text (" \"" ++ (escapeLinkTitle tit) ++ "\"")) else empty) <> char ')' -inlineToMarkdown (Link txt (Ref [])) = char '[' <> inlineListToMarkdown txt <> text "][]" -inlineToMarkdown (Link txt (Ref ref)) = char '[' <> inlineListToMarkdown txt <> char ']' <> - char '[' <> inlineListToMarkdown ref <> char ']' + let linktext = if (null txt) || (txt == [Str ""]) + then text "link" + else inlineListToMarkdown txt in + char '[' <> linktext <> char ']' <> char '(' <> text src <> + (if tit /= "" + then text (" \"" ++ (escapeLinkTitle tit) ++ "\"") + else empty) <> char ')' +inlineToMarkdown (Link txt (Ref [])) = + char '[' <> inlineListToMarkdown txt <> text "][]" +inlineToMarkdown (Link txt (Ref ref)) = + char '[' <> inlineListToMarkdown txt <> char ']' <> char '[' <> + inlineListToMarkdown ref <> char ']' inlineToMarkdown (Image alternate (Src source tit)) = - let alt = if (null alternate) || (alternate == [Str ""]) then - text "image" - else - inlineListToMarkdown alternate in - char '!' <> char '[' <> alt <> char ']' <> char '(' <> text source <> - (if tit /= "" then (text (" \"" ++ (escapeLinkTitle tit) ++ "\"")) else empty) <> char ')' + let alt = if (null alternate) || (alternate == [Str ""]) + then text "image" + else inlineListToMarkdown alternate in + char '!' <> char '[' <> alt <> char ']' <> char '(' <> text source <> + (if tit /= "" + then text (" \"" ++ (escapeLinkTitle tit) ++ "\"") + else empty) <> char ')' inlineToMarkdown (Image alternate (Ref [])) = - char '!' <> char '[' <> inlineListToMarkdown alternate <> char ']' + char '!' <> char '[' <> inlineListToMarkdown alternate <> char ']' inlineToMarkdown (Image alternate (Ref ref)) = - char '!' <> char '[' <> inlineListToMarkdown alternate <> char ']' <> - char '[' <> inlineListToMarkdown ref <> char ']' -inlineToMarkdown (NoteRef ref) = text "[^" <> text (escapeString ref) <> char ']' + char '!' <> char '[' <> inlineListToMarkdown alternate <> char ']' <> + char '[' <> inlineListToMarkdown ref <> char ']' +inlineToMarkdown (NoteRef ref) = + text "[^" <> text (escapeString ref) <> char ']' diff --git a/src/Text/Pandoc/Writers/RST.hs b/src/Text/Pandoc/Writers/RST.hs index cc2bc6499..e42279ef4 100644 --- a/src/Text/Pandoc/Writers/RST.hs +++ b/src/Text/Pandoc/Writers/RST.hs @@ -1,4 +1,16 @@ --- | Converts Pandoc to reStructuredText. +{- | + Module : Text.Pandoc.Writers.RST + 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 reStructuredText. + +reStructuredText: http://docutils.sourceforge.net/rst.html +-} module Text.Pandoc.Writers.RST ( writeRST ) where @@ -10,40 +22,44 @@ import Text.PrettyPrint.HughesPJ hiding ( Str ) -- | Convert Pandoc to reStructuredText. writeRST :: WriterOptions -> Pandoc -> String writeRST options (Pandoc meta blocks) = - let (main, refs) = unzip $ map (blockToRST (writerTabStop options)) + let (main, refs) = unzip $ map (blockToRST (writerTabStop options)) (reformatBlocks $ replaceReferenceLinks blocks) - top = if (writerStandalone options) then - (metaToRST meta) $$ text (writerHeader options) - else - empty in - -- remove duplicate keys - let refs' = nubBy (\x y -> (render x) == (render y)) refs in - let body = text (writerIncludeBefore options) <> - vcat main $$ text (writerIncludeAfter options) in - render $ top <> body $$ vcat refs' $$ text "\n" + top = if (writerStandalone options) + then (metaToRST meta) $$ text (writerHeader options) + else empty in + -- remove duplicate keys + let refs' = nubBy (\x y -> (render x) == (render y)) refs in + let body = text (writerIncludeBefore options) <> + vcat main $$ text (writerIncludeAfter options) in + render $ top <> body $$ vcat refs' $$ text "\n" -- | Escape special RST characters. escapeString :: String -> String escapeString = backslashEscape "`\\|*_" --- | Convert list of inline elements into one 'Doc' of wrapped text and another --- containing references. +-- | Convert list of inline elements into one 'Doc' of wrapped text +-- and another containing references. wrappedRST :: [Inline] -> (Doc, Doc) wrappedRST lst = - let words = splitBySpace lst in - (fsep $ map (fcat . (map (fst . inlineToRST))) words, vcat (map (snd . inlineToRST) lst)) + let words = splitBySpace lst in + ( fsep $ map (fcat . (map (fst . inlineToRST))) words, + vcat (map (snd . inlineToRST) lst) ) -- | Remove reference keys, and make sure there are blanks before each list. reformatBlocks :: [Block] -> [Block] reformatBlocks [] = [] reformatBlocks ((Plain x):(OrderedList y):rest) = (Para x):(reformatBlocks ((OrderedList y):rest)) -reformatBlocks ((Plain x):(BulletList y):rest) = (Para x):(reformatBlocks ((BulletList y):rest)) +reformatBlocks ((Plain x):(BulletList y):rest) = + (Para x):(reformatBlocks ((BulletList y):rest)) reformatBlocks ((OrderedList x):rest) = (OrderedList (map reformatBlocks x)):(reformatBlocks rest) -reformatBlocks ((BulletList x):rest) = (BulletList (map reformatBlocks x)):(reformatBlocks rest) -reformatBlocks ((BlockQuote x):rest) = (BlockQuote (reformatBlocks x)):(reformatBlocks rest) -reformatBlocks ((Note ref x):rest) = (Note ref (reformatBlocks x)):(reformatBlocks rest) +reformatBlocks ((BulletList x):rest) = + (BulletList (map reformatBlocks x)):(reformatBlocks rest) +reformatBlocks ((BlockQuote x):rest) = + (BlockQuote (reformatBlocks x)):(reformatBlocks rest) +reformatBlocks ((Note ref x):rest) = + (Note ref (reformatBlocks x)):(reformatBlocks rest) reformatBlocks ((Key x1 y1):rest) = reformatBlocks rest reformatBlocks (x:rest) = x:(reformatBlocks rest) @@ -56,15 +72,16 @@ metaToRST (Meta title authors date) = titleToRST :: [Inline] -> Doc titleToRST [] = empty titleToRST lst = - let title = fst $ inlineListToRST lst in - let titleLength = length $ render title in - let border = text (replicate titleLength '=') in - border <> char '\n' <> title <> char '\n' <> border <> text "\n\n" + let title = fst $ inlineListToRST lst in + let titleLength = length $ render title in + let border = text (replicate titleLength '=') in + border <> char '\n' <> title <> char '\n' <> border <> text "\n\n" -- | Convert author list to 'Doc'. authorsToRST :: [String] -> Doc authorsToRST [] = empty -authorsToRST (first:rest) = text ":Author: " <> text first <> char '\n' <> (authorsToRST rest) +authorsToRST (first:rest) = text ":Author: " <> text first <> + char '\n' <> (authorsToRST rest) -- | Convert date to 'Doc'. dateToRST :: String -> Doc @@ -80,36 +97,38 @@ blockToRST tabStop Blank = (text "\n", empty) blockToRST tabStop Null = (empty, empty) blockToRST tabStop (Plain lst) = wrappedRST lst blockToRST tabStop (Para [TeX str]) = -- raw latex block - let str' = if (endsWith '\n' str) then (str ++ "\n") else (str ++ "\n\n") in - (hang (text "\n.. raw:: latex\n") 3 (vcat $ map text (lines str')), empty) -blockToRST tabStop (Para lst) = ((fst $ wrappedRST lst) <> (text "\n"), snd $ wrappedRST lst) + let str' = if (endsWith '\n' str) then (str ++ "\n") else (str ++ "\n\n") in + (hang (text "\n.. raw:: latex\n") 3 (vcat $ map text (lines str')), empty) +blockToRST tabStop (Para lst) = ( (fst $ wrappedRST lst) <> (text "\n"), + snd $ wrappedRST lst ) blockToRST tabStop (BlockQuote lst) = - let (main, refs) = unzip $ map (blockToRST tabStop) lst in - ((nest tabStop $ vcat $ main) <> text "\n", vcat refs) + let (main, refs) = unzip $ map (blockToRST tabStop) lst in + ((nest tabStop $ vcat $ main) <> text "\n", vcat refs) blockToRST tabStop (Note ref blocks) = - let (main, refs) = unzip $ map (blockToRST tabStop) blocks in - ((hang (text ".. [" <> text (escapeString ref) <> text "] ") 3 (vcat main)), vcat refs) + let (main, refs) = unzip $ map (blockToRST tabStop) blocks in + ((hang (text ".. [" <> text (escapeString ref) <> text "] ") 3 (vcat main)), + vcat refs) blockToRST tabStop (Key txt (Src src tit)) = - (text "ERROR - KEY FOUND", empty) -- shouldn't have a key here -blockToRST tabStop (CodeBlock str) = - (hang (text "::\n") tabStop (vcat $ map text (lines ('\n':(str ++ "\n\n")))), empty) + (text "ERROR - KEY FOUND", empty) -- shouldn't have a key here +blockToRST tabStop (CodeBlock str) = (hang (text "::\n") tabStop + (vcat $ map text (lines ('\n':(str ++ "\n\n")))), empty) blockToRST tabStop (RawHtml str) = - let str' = if (endsWith '\n' str) then (str ++ "\n") else (str ++ "\n\n") in - (hang (text "\n.. raw:: html\n") 3 (vcat $ map text (lines str')), empty) + let str' = if (endsWith '\n' str) then (str ++ "\n") else (str ++ "\n\n") in + (hang (text "\n.. raw:: html\n") 3 (vcat $ map text (lines str')), empty) blockToRST tabStop (BulletList lst) = - let (main, refs) = unzip $ map (bulletListItemToRST tabStop) lst in - (vcat main <> text "\n", vcat refs) + let (main, refs) = unzip $ map (bulletListItemToRST tabStop) lst in + (vcat main <> text "\n", vcat refs) blockToRST tabStop (OrderedList lst) = - let (main, refs) = - unzip $ zipWith (orderedListItemToRST tabStop) (enumFromTo 1 (length lst)) lst in - (vcat main <> text "\n", vcat refs) + let (main, refs) = unzip $ zipWith (orderedListItemToRST tabStop) + (enumFromTo 1 (length lst)) lst in + (vcat main <> text "\n", vcat refs) blockToRST tabStop HorizontalRule = (text "--------------\n", empty) blockToRST tabStop (Header level lst) = - let (headerText, refs) = inlineListToRST lst in - let headerLength = length $ render headerText in - let headerChar = if (level > 5) then ' ' else "=-~^'" !! (level - 1) in - let border = text $ replicate headerLength headerChar in - (headerText <> char '\n' <> border <> char '\n', refs) + let (headerText, refs) = inlineListToRST lst in + let headerLength = length $ render headerText in + let headerChar = if (level > 5) then ' ' else "=-~^'" !! (level - 1) in + let border = text $ replicate headerLength headerChar in + (headerText <> char '\n' <> border <> char '\n', refs) -- | Convert bullet list item (list of blocks) to reStructuredText. -- Returns a pair of 'Doc', the first the main text, the second references @@ -117,8 +136,8 @@ bulletListItemToRST :: Int -- ^ tab stop -> [Block] -- ^ list item (list of blocks) -> (Doc, Doc) bulletListItemToRST tabStop list = - let (main, refs) = unzip $ map (blockToRST tabStop) list in - (hang (text "- ") tabStop (vcat main), (vcat refs)) + let (main, refs) = unzip $ map (blockToRST tabStop) list in + (hang (text "- ") tabStop (vcat main), (vcat refs)) -- | Convert an ordered list item (list of blocks) to reStructuredText. -- Returns a pair of 'Doc', the first the main text, the second references @@ -127,9 +146,9 @@ orderedListItemToRST :: Int -- ^ tab stop -> [Block] -- ^ list item (list of blocks) -> (Doc, Doc) orderedListItemToRST tabStop num list = - let (main, refs) = unzip $ map (blockToRST tabStop) list - spacer = if (length (show num) < 2) then " " else "" in - (hang (text ((show num) ++ "." ++ spacer)) tabStop (vcat main), (vcat refs)) + let (main, refs) = unzip $ map (blockToRST tabStop) list + spacer = if (length (show num) < 2) then " " else "" in + (hang (text ((show num) ++ "." ++ spacer)) tabStop (vcat main), (vcat refs)) -- | Convert a list of inline elements to reStructuredText. -- Returns a pair of 'Doc', the first the main text, the second references. @@ -151,39 +170,41 @@ inlineToRST (HtmlInline str) = (empty, empty) inlineToRST (LineBreak) = inlineToRST Space -- RST doesn't have line breaks inlineToRST Space = (char ' ', empty) -- --- Note: can assume reference links have been replaced where possible with explicit links. +-- Note: can assume reference links have been replaced where possible +-- with explicit links. -- inlineToRST (Link txt (Src src tit)) = - let (linktext, ref') = if (null txt) || (txt == [Str ""]) then - (text "link", empty) - else - inlineListToRST $ normalizeSpaces txt in - let link = char '`' <> linktext <> text "`_" - linktext' = render linktext in - let linktext'' = if (':' `elem` linktext') then "`" ++ linktext' ++ "`" else linktext' in + let (linktext, ref') = if (null txt) || (txt == [Str ""]) + then (text "link", empty) + else inlineListToRST $ normalizeSpaces txt in + let link = char '`' <> linktext <> text "`_" + linktext' = render linktext in + let linktext'' = if (':' `elem` linktext') + then "`" ++ linktext' ++ "`" + else linktext' in let ref = text ".. _" <> text linktext'' <> text ": " <> text src in (link, ref' $$ ref) inlineToRST (Link txt (Ref [])) = - let (linktext, refs) = inlineListToRST txt in - (char '[' <> linktext <> char ']', refs) + let (linktext, refs) = inlineListToRST txt in + (char '[' <> linktext <> char ']', refs) inlineToRST (Link txt (Ref ref)) = - let (linktext, refs1) = inlineListToRST txt - (reftext, refs2) = inlineListToRST ref in - (char '[' <> linktext <> text "][" <> reftext <> char ']', refs1 $$ refs2) + let (linktext, refs1) = inlineListToRST txt + (reftext, refs2) = inlineListToRST ref in + (char '[' <> linktext <> text "][" <> reftext <> char ']', refs1 $$ refs2) inlineToRST (Image alternate (Src source tit)) = - let (alt, ref') = if (null alternate) || (alternate == [Str ""]) then - (text "image", empty) - else - inlineListToRST $ normalizeSpaces alternate in - let link = char '|' <> alt <> char '|' in - let ref = text ".. " <> link <> text " image:: " <> text source in - (link, ref' $$ ref) + let (alt, ref') = if (null alternate) || (alternate == [Str ""]) + then (text "image", empty) + else inlineListToRST $ normalizeSpaces alternate in + let link = char '|' <> alt <> char '|' in + let ref = text ".. " <> link <> text " image:: " <> text source in + (link, ref' $$ ref) inlineToRST (Image alternate (Ref [])) = - let (alttext, refs) = inlineListToRST alternate in - (char '|' <> alttext <> char '|', refs) + let (alttext, refs) = inlineListToRST alternate in + (char '|' <> alttext <> char '|', refs) -- The following case won't normally occur... inlineToRST (Image alternate (Ref ref)) = - let (alttext, refs1) = inlineListToRST alternate - (reftext, refs2) = inlineListToRST ref in - (char '|' <> alttext <> char '|', refs1 $$ refs2) -inlineToRST (NoteRef ref) = (text " [" <> text (escapeString ref) <> char ']' <> char '_', empty) + let (alttext, refs1) = inlineListToRST alternate + (reftext, refs2) = inlineListToRST ref in + (char '|' <> alttext <> char '|', refs1 $$ refs2) +inlineToRST (NoteRef ref) = + (text " [" <> text (escapeString ref) <> char ']' <> char '_', empty) diff --git a/src/Text/Pandoc/Writers/RTF.hs b/src/Text/Pandoc/Writers/RTF.hs index 386a5b51b..3dbda8518 100644 --- a/src/Text/Pandoc/Writers/RTF.hs +++ b/src/Text/Pandoc/Writers/RTF.hs @@ -1,4 +1,14 @@ --- | Convert Pandoc to rich text format. +{- | + Module : + 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 RTF (rich text format). +-} module Text.Pandoc.Writers.RTF ( writeRTF ) where @@ -10,24 +20,24 @@ import Char ( ord, chr ) -- | Convert Pandoc to a string in rich text format. writeRTF :: WriterOptions -> Pandoc -> String writeRTF options (Pandoc meta blocks) = - let notes = filter isNoteBlock blocks in -- assumes all notes are at outer level - let head = if writerStandalone options then - rtfHeader notes (writerHeader options) meta - else - "" - foot = if writerStandalone options then "\n}\n" else "" - body = (writerIncludeBefore options) ++ - (concatMap (blockToRTF notes 0) (replaceReferenceLinks blocks)) ++ - (writerIncludeAfter options) in - head ++ body ++ foot + -- assumes all notes are at outer level + let notes = filter isNoteBlock blocks in + let head = if writerStandalone options + then rtfHeader notes (writerHeader options) meta + else "" + foot = if writerStandalone options then "\n}\n" else "" + body = (writerIncludeBefore options) ++ (concatMap (blockToRTF notes 0) + (replaceReferenceLinks blocks)) ++ + (writerIncludeAfter options) in + head ++ body ++ foot -- | Convert unicode characters (> 127) into rich text format representation. handleUnicode :: String -> String handleUnicode [] = [] -handleUnicode (c:cs) = if (ord c) > 127 then - '\\':'u':(show (ord c)) ++ "?" ++ (handleUnicode cs) - else - c:(handleUnicode cs) +handleUnicode (c:cs) = if (ord c) > 127 + then '\\':'u':(show (ord c)) ++ "?" ++ + (handleUnicode cs) + else c:(handleUnicode cs) escapeSpecial = backslashEscape "{\\}" escapeTab = gsub "\\\\t" "\\\\tab " @@ -56,8 +66,8 @@ rtfParSpaced :: Int -- ^ space after (in twips) -> String -- ^ string with content -> String rtfParSpaced spaceAfter indent firstLineIndent content = - "{\\pard \\f0 \\sa" ++ (show spaceAfter) ++ " \\li" ++ (show indent) ++ - " \\fi" ++ (show firstLineIndent) ++ " " ++ content ++ "\\par}\n" + "{\\pard \\f0 \\sa" ++ (show spaceAfter) ++ " \\li" ++ (show indent) ++ + " \\fi" ++ (show firstLineIndent) ++ " " ++ content ++ "\\par}\n" -- | Default paragraph. rtfPar :: Int -- ^ block indent (in twips) @@ -85,9 +95,10 @@ bulletMarker indent = case (indent `mod` 720) of -- | Returns appropriate (list of) ordered list markers for indent level. orderedMarkers :: Int -> [String] -orderedMarkers indent = case (indent `mod` 720) of - 0 -> map (\x -> show x ++ ".") [1..] - otherwise -> map (\x -> show x ++ ".") $ cycle ['a'..'z'] +orderedMarkers indent = + case (indent `mod` 720) of + 0 -> map (\x -> show x ++ ".") [1..] + otherwise -> map (\x -> show x ++ ".") $ cycle ['a'..'z'] -- | Returns RTF header. rtfHeader :: [Block] -- ^ list of note blocks @@ -95,16 +106,20 @@ rtfHeader :: [Block] -- ^ list of note blocks -> Meta -- ^ bibliographic information -> String rtfHeader notes headerText (Meta title authors date) = - let titletext = if null title then - "" - else - rtfPar 0 0 ("\\qc \\b \\fs36 " ++ inlineListToRTF notes title) - authorstext = if null authors then - "" - else - rtfPar 0 0 ("\\qc " ++ (joinWithSep "\\" (map stringToRTF authors))) - datetext = if date == "" then "" else rtfPar 0 0 ("\\qc " ++ stringToRTF date) in - let spacer = if null (titletext ++ authorstext ++ datetext) then "" else rtfPar 0 0 "" in + let titletext = if null title + then "" + else rtfPar 0 0 ("\\qc \\b \\fs36 " ++ + inlineListToRTF notes title) + authorstext = if null authors + then "" + else rtfPar 0 0 ("\\qc " ++ (joinWithSep "\\" + (map stringToRTF authors))) + datetext = if date == "" + then "" + else rtfPar 0 0 ("\\qc " ++ stringToRTF date) in + let spacer = if null (titletext ++ authorstext ++ datetext) + then "" + else rtfPar 0 0 "" in headerText ++ titletext ++ authorstext ++ datetext ++ spacer -- | Convert Pandoc block element to RTF. @@ -114,32 +129,36 @@ blockToRTF :: [Block] -- ^ list of note blocks -> String blockToRTF notes indent Blank = rtfPar indent 0 "" blockToRTF notes indent Null = "" -blockToRTF notes indent (Plain lst) = rtfCompact indent 0 (inlineListToRTF notes lst) -blockToRTF notes indent (Para lst) = rtfPar indent 0 (inlineListToRTF notes lst) +blockToRTF notes indent (Plain lst) = + rtfCompact indent 0 (inlineListToRTF notes lst) +blockToRTF notes indent (Para lst) = + rtfPar indent 0 (inlineListToRTF notes lst) blockToRTF notes indent (BlockQuote lst) = - concatMap (blockToRTF notes (indent + indentIncrement)) lst -blockToRTF notes indent (Note ref lst) = "" -- there shouldn't be any after filtering + concatMap (blockToRTF notes (indent + indentIncrement)) lst +blockToRTF notes indent (Note ref lst) = "" -- shouldn't be any aftr filtering blockToRTF notes indent (Key _ _) = "" -blockToRTF notes indent (CodeBlock str) = rtfPar indent 0 ("\\f1 " ++ (codeStringToRTF str)) +blockToRTF notes indent (CodeBlock str) = + rtfPar indent 0 ("\\f1 " ++ (codeStringToRTF str)) blockToRTF notes indent (RawHtml str) = "" blockToRTF notes indent (BulletList lst) = - spaceAtEnd $ concatMap (listItemToRTF notes indent (bulletMarker indent)) lst + spaceAtEnd $ + concatMap (listItemToRTF notes indent (bulletMarker indent)) lst blockToRTF notes indent (OrderedList lst) = - spaceAtEnd $ concat $ zipWith (listItemToRTF notes indent) (orderedMarkers indent) lst + spaceAtEnd $ concat $ + zipWith (listItemToRTF notes indent) (orderedMarkers indent) lst blockToRTF notes indent HorizontalRule = - rtfPar indent 0 "\\qc \\emdash\\emdash\\emdash\\emdash\\emdash" + rtfPar indent 0 "\\qc \\emdash\\emdash\\emdash\\emdash\\emdash" blockToRTF notes indent (Header level lst) = - rtfPar indent 0 ("\\b \\fs" ++ (show (40 - (level * 4))) ++ " " ++ - (inlineListToRTF notes lst)) + rtfPar indent 0 ("\\b \\fs" ++ (show (40 - (level * 4))) ++ " " ++ + (inlineListToRTF notes lst)) -- | Ensure that there's the same amount of space after compact -- lists as after regular lists. spaceAtEnd :: String -> String spaceAtEnd str = - if isSuffixOf "\\par}\n" str then - (take ((length str) - 6) str) ++ "\\sa180\\par}\n" - else - str + if isSuffixOf "\\par}\n" str + then (take ((length str) - 6) str) ++ "\\sa180\\par}\n" + else str -- | Convert list item (list of blocks) to RTF. listItemToRTF :: [Block] -- ^ list of note blocks @@ -148,13 +167,14 @@ listItemToRTF :: [Block] -- ^ list of note blocks -> [Block] -- ^ list item (list of blocks) -> [Char] listItemToRTF notes indent marker [] = - rtfCompact (indent + listIncrement) (0 - listIncrement) - (marker ++ "\\tx" ++ (show listIncrement) ++ "\\tab ") + rtfCompact (indent + listIncrement) (0 - listIncrement) + (marker ++ "\\tx" ++ (show listIncrement) ++ "\\tab ") listItemToRTF notes indent marker list = - let (first:rest) = map (blockToRTF notes (indent + listIncrement)) list in - let modFirst = gsub "\\\\fi-?[0-9]+" ("\\\\fi" ++ (show (0 - listIncrement)) ++ - " " ++ marker ++ "\\\\tx" ++ (show listIncrement) ++ "\\\\tab") first in - modFirst ++ (concat rest) + let (first:rest) = map (blockToRTF notes (indent + listIncrement)) list in + let modFirst = gsub "\\\\fi-?[0-9]+" ("\\\\fi" ++ + (show (0 - listIncrement)) ++ " " ++ marker ++ + "\\\\tx" ++ (show listIncrement) ++ "\\\\tab") first in + modFirst ++ (concat rest) -- | Convert list of inline items to RTF. inlineListToRTF :: [Block] -- ^ list of note blocks @@ -167,7 +187,8 @@ inlineToRTF :: [Block] -- ^ list of note blocks -> Inline -- ^ inline to convert -> String inlineToRTF notes (Emph lst) = "{\\i " ++ (inlineListToRTF notes lst) ++ "} " -inlineToRTF notes (Strong lst) = "{\\b " ++ (inlineListToRTF notes lst) ++ "} " +inlineToRTF notes (Strong lst) = + "{\\b " ++ (inlineListToRTF notes lst) ++ "} " inlineToRTF notes (Code str) = "{\\f1 " ++ (codeStringToRTF str) ++ "} " inlineToRTF notes (Str str) = stringToRTF str inlineToRTF notes (TeX str) = latexToRTF str @@ -175,20 +196,24 @@ inlineToRTF notes (HtmlInline str) = "" inlineToRTF notes (LineBreak) = "\\line " inlineToRTF notes Space = " " inlineToRTF notes (Link text (Src src tit)) = - "{\\field{\\*\\fldinst{HYPERLINK \"" ++ (codeStringToRTF src) ++ "\"}}{\\fldrslt{\\ul\n" - ++ (inlineListToRTF notes text) ++ "\n}}}\n" -inlineToRTF notes (Link text (Ref [])) = "[" ++ (inlineListToRTF notes text) ++ "]" -inlineToRTF notes (Link text (Ref ref)) = "[" ++ (inlineListToRTF notes text) ++ "][" ++ - (inlineListToRTF notes ref) ++ "]" -- this is what markdown does, for better or worse -inlineToRTF notes (Image alternate (Src source tit)) = "{\\cf1 [image: " ++ source ++ "]\\cf0}" -inlineToRTF notes (Image alternate (Ref [])) = "![" ++ (inlineListToRTF notes alternate) ++ "]" -inlineToRTF notes (Image alternate (Ref ref)) = "![" ++ (inlineListToRTF notes alternate) ++ - "][" ++ (inlineListToRTF notes ref) ++ "]" + "{\\field{\\*\\fldinst{HYPERLINK \"" ++ (codeStringToRTF src) ++ + "\"}}{\\fldrslt{\\ul\n" ++ (inlineListToRTF notes text) ++ "\n}}}\n" +inlineToRTF notes (Link text (Ref [])) = + "[" ++ (inlineListToRTF notes text) ++ "]" +inlineToRTF notes (Link text (Ref ref)) = + "[" ++ (inlineListToRTF notes text) ++ "][" ++ + (inlineListToRTF notes ref) ++ "]" -- this is what markdown does +inlineToRTF notes (Image alternate (Src source tit)) = + "{\\cf1 [image: " ++ source ++ "]\\cf0}" +inlineToRTF notes (Image alternate (Ref [])) = + "![" ++ (inlineListToRTF notes alternate) ++ "]" +inlineToRTF notes (Image alternate (Ref ref)) = "![" ++ + (inlineListToRTF notes alternate) ++ "][" ++ + (inlineListToRTF notes ref) ++ "]" inlineToRTF [] (NoteRef ref) = "" inlineToRTF ((Note firstref firstblocks):rest) (NoteRef ref) = - if firstref == ref then - "{\\super\\chftn}{\\*\\footnote\\chftn\\~\\plain\\pard " ++ - (concatMap (blockToRTF rest 0) firstblocks) ++ "}" - else - inlineToRTF rest (NoteRef ref) + if firstref == ref + then "{\\super\\chftn}{\\*\\footnote\\chftn\\~\\plain\\pard " ++ + (concatMap (blockToRTF rest 0) firstblocks) ++ "}" + else inlineToRTF rest (NoteRef ref) |