git.iko.soy/typeable/pandoc
on master help sign in
+ Added module data for haddock.

+ Reformatted code consistently. git-svn-id: https://pandoc.googlecode.com/svn/trunk@252 788f1e2b-df1e-0410-8736-df70ead52e1b

commitdc9c6450f3b16592d0ee865feafc17b670e4ad14 authorfiddlosopher <fiddlosopher@788f1e2b-df1e-0410-8736-df70ead52e1b> dateWed 20 Dec 2006, 06:50 (20 years ago) parent42d2983
15 files changed+1571−1266
compare with master
unifiedsplit
src/Main.hs+59−40 src/Text/Pandoc/Definition.hs+24−10 src/Text/Pandoc/HtmlEntities.hs+21−10 src/Text/Pandoc/Readers/HTML.hs+47−38 src/Text/Pandoc/Readers/LaTeX.hs+66−52 src/Text/Pandoc/Readers/Markdown.hs+312−289 src/Text/Pandoc/Readers/RST.hs+325−306 src/Text/Pandoc/Shared.hs+163−104 src/Text/Pandoc/UTF8.hs+2−1 src/Text/Pandoc/Writers/HTML.hs+176−135 src/Text/Pandoc/Writers/LaTeX.hs+85−70 src/Text/Pandoc/Writers/Markdown.hs+86−62 src/Text/Pandoc/Writers/RST.hs+98−77 src/Text/Pandoc/Writers/RTF.hs+90−65 src/Text/ParserCombinators/Pandoc.hs+17−7
src/Main.hs+59−40
@@ -1,5 +1,15 @@
1−-- | Main Pandoc program. Parses command-line options and calls the
2−-- appropriate readers and writers.
1+{- |
2+ Module : Main
3+ Copyright : Copyright (C) 2006 John MacFarlane
4+ License : GNU GPL, version 2 or above
5+
6+ Maintainer : John MacFarlane <jgm at berkeley dot edu>
7+ Stability : unstable
8+ Portability : portable
9+
10+Parses command-line options and calls the appropriate readers and
11+writers.
12+-}
313module Main where
414import Text.Pandoc.UTF8 ( decodeUTF8, encodeUTF8 )
515import Text.Pandoc.Readers.Markdown ( readMarkdown )
@@ -13,7 +23,8 @@ import Text.Pandoc.Writers.LaTeX ( writeLaTeX )
1323import Text.Pandoc.Readers.LaTeX ( readLaTeX )
1424import Text.Pandoc.Writers.RTF ( writeRTF )
1525import Text.Pandoc.Writers.Markdown ( writeMarkdown )
16−import Text.Pandoc.Writers.DefaultHeaders ( defaultHtmlHeader, defaultRTFHeader, defaultS5Header, defaultLaTeXHeader )
26+import Text.Pandoc.Writers.DefaultHeaders ( defaultHtmlHeader,
27+ defaultRTFHeader, defaultS5Header, defaultLaTeXHeader )
1728import Text.Pandoc.Definition
1829import Text.Pandoc.Shared
1930import System ( exitWith, getArgs, getProgName )
@@ -58,23 +69,24 @@ writeDoc options = prettyPandoc
5869
5970-- | Data structure for command line options.
6071data Opt = Opt
61− { optPreserveTabs :: Bool -- ^ If @False@, convert tabs to spaces
62− , optTabStop :: Int -- ^ Number of spaces per tab
63− , optStandalone :: Bool -- ^ If @True@, include header and footer
64− , optReader :: ParserState -> String -> Pandoc -- ^ Reader to use
65− , optWriter :: WriterOptions -> Pandoc -> String -- ^ Writer to use
66− , optParseRaw :: Bool -- ^ If @True@, parse unconvertable HTML and TeX
67− , optCSS :: String -- ^ CSS file to link to
68− , optIncludeInHeader :: String -- ^ File to include in header
69− , optIncludeBeforeBody :: String -- ^ File to include at beginning of body
70− , optIncludeAfterBody :: String -- ^ File to include at end of body
71− , optCustomHeader :: String -- ^ Custom header to use, or "DEFAULT"
72− , optDefaultHeader :: String -- ^ Default header
73− , optTitlePrefix :: String -- ^ Optional prefix for HTML title
74− , optNumberSections :: Bool -- ^ If @True@, number sections in LaTeX
75− , optIncremental :: Bool -- ^ If @True@, show lists incrementally in S5
76− , optSmart :: Bool -- ^ If @True@, use smart quotes, dashes, ...
77− , optASCIIMathML :: Bool -- ^ If @True@, use ASCIIMathML in HTML or S5
72+ { optPreserveTabs :: Bool -- ^ If @False@, convert tabs to spaces
73+ , optTabStop :: Int -- ^ Number of spaces per tab
74+ , optStandalone :: Bool -- ^ If @True@, include header, footer
75+ , optReader :: ParserState -> String -> Pandoc -- ^ Read format
76+ , optWriter :: WriterOptions -> Pandoc -> String -- ^ Write fmt
77+ , optParseRaw :: Bool -- ^ If @True@, parse unconvertable
78+ -- HTML and TeX
79+ , optCSS :: String -- ^ CSS file to link to
80+ , optIncludeInHeader :: String -- ^ File to include in header
81+ , optIncludeBeforeBody :: String -- ^ File to include at top of body
82+ , optIncludeAfterBody :: String -- ^ File to include at end of body
83+ , optCustomHeader :: String -- ^ Custom header to use, or "DEFAULT"
84+ , optDefaultHeader :: String -- ^ Default header
85+ , optTitlePrefix :: String -- ^ Optional prefix for HTML title
86+ , optNumberSections :: Bool -- ^ If @True@, number sections in LaTeX
87+ , optIncremental :: Bool -- ^ If @True@, incremental lists in S5
88+ , optSmart :: Bool -- ^ If @True@, use smart typography
89+ , optASCIIMathML :: Bool -- ^ If @True@, use ASCIIMathML in HTML
7890 }
7991
8092-- | Defaults for command-line options.
@@ -121,18 +133,19 @@ options =
121133 , Option "fr" ["from","read"]
122134 (ReqArg
123135 (\arg opt -> case (lookup (map toLower arg) readers) of
124− Just reader -> return opt { optReader = reader }
125− Nothing -> error ("Unknown reader: " ++ arg) )
136+ Just reader -> return opt { optReader = reader }
137+ Nothing -> error ("Unknown reader: " ++ arg) )
126138 "FORMAT")
127− ("Source format (" ++ (concatMap (\(name, fn) -> " " ++ name) readers) ++ " )")
139+ ("Source format (" ++
140+ (concatMap (\(name, fn) -> " " ++ name) readers) ++ " )")
128141
129142 , Option "tw" ["to","write"]
130143 (ReqArg
131144 (\arg opt -> case (lookup (map toLower arg) writers) of
132− Just (writer, defaultHeader) ->
133− return opt { optWriter = writer,
134− optDefaultHeader = defaultHeader }
135− Nothing -> error ("Unknown writer: " ++ arg) )
145+ Just (writer, defaultHeader) ->
146+ return opt { optWriter = writer,
147+ optDefaultHeader = defaultHeader }
148+ Nothing -> error ("Unknown writer: " ++ arg) )
136149 "FORMAT")
137150 ("Output format (" ++ (concatMap (\(name, fn) -> " " ++ name) writers) ++ " )")
138151
@@ -164,7 +177,8 @@ options =
164177
165178 , Option "m" ["asciimathml"]
166179 (NoArg
167− (\opt -> return opt { optASCIIMathML = True, optStandalone = True }))
180+ (\opt -> return opt { optASCIIMathML = True,
181+ optStandalone = True }))
168182 "Use ASCIIMathML script in html output"
169183
170184 , Option "i" ["incremental"]
@@ -179,7 +193,8 @@ options =
179193
180194 , Option "c" ["css"]
181195 (ReqArg
182− (\arg opt -> return opt { optCSS = arg, optStandalone = True })
196+ (\arg opt -> return opt { optCSS = arg,
197+ optStandalone = True })
183198 "CSS")
184199 "Link to CSS style sheet"
185200
@@ -187,7 +202,8 @@ options =
187202 (ReqArg
188203 (\arg opt -> do
189204 text <- readFile arg
190− return opt { optIncludeInHeader = text, optStandalone = True })
205+ return opt { optIncludeInHeader = text,
206+ optStandalone = True })
191207 "FILENAME")
192208 "File to include at end of header (implies -s)"
193209
@@ -211,13 +227,15 @@ options =
211227 (ReqArg
212228 (\arg opt -> do
213229 text <- readFile arg
214− return opt { optCustomHeader = text, optStandalone = True })
230+ return opt { optCustomHeader = text,
231+ optStandalone = True })
215232 "FILENAME")
216233 "File to use for custom header (implies -s)"
217234
218235 , Option "T" ["title-prefix"]
219236 (ReqArg
220− (\arg opt -> return opt { optTitlePrefix = arg, optStandalone = True })
237+ (\arg opt -> return opt { optTitlePrefix = arg,
238+ optStandalone = True })
221239 "STRING")
222240 "String to prefix to HTML window title"
223241
@@ -225,8 +243,8 @@ options =
225243 (ReqArg
226244 (\arg opt -> do
227245 let header = case (lookup arg writers) of
228− Just (writer, head) -> head
229− Nothing -> error ("Unknown reader: " ++ arg)
246+ Just (writer, head) -> head
247+ Nothing -> error ("Unknown reader: " ++ arg)
230248 hPutStrLn stdout header
231249 exitWith ExitSuccess)
232250 "FORMAT")
@@ -267,13 +285,14 @@ main = do
267285 let startParserState = defaultParserState { stateParseRaw = parseRaw,
268286 stateTabStop = tabStop,
269287 stateStandalone = standalone }
270− let csslink = if (css == "") then
271− ""
272− else
273− "<link rel=\"stylesheet\" href=\"" ++ css ++
274− "\" type=\"text/css\" media=\"all\" />\n"
288+ let csslink = if (css == "")
289+ then ""
290+ else "<link rel=\"stylesheet\" href=\"" ++ css ++
291+ "\" type=\"text/css\" media=\"all\" />\n"
275292 let asciiMathMLLink = if asciiMathML then asciiMathMLScript else ""
276− let header = (if (customHeader == "DEFAULT") then defaultHeader else customHeader) ++
293+ let header = (if (customHeader == "DEFAULT")
294+ then defaultHeader
295+ else customHeader) ++
277296 csslink ++ asciiMathMLLink ++ includeHeader
278297 let writerOptions = WriterOptions { writerStandalone = standalone,
279298 writerHeader = header,
src/Text/Pandoc/Definition.hs+24−10
@@ -1,5 +1,15 @@
1−-- | Definition of 'Pandoc' data structure for format-neutral representation
2−-- of documents.
1+{- |
2+ Module : Text.Pandoc.Definition
3+ Copyright : Copyright (C) 2006 John MacFarlane
4+ License : GNU GPL, version 2 or above
5+
6+ Maintainer : John MacFarlane <jgm at berkeley dot edu>
7+ Stability : unstable
8+ Portability : portable
9+
10+Definition of 'Pandoc' data structure for format-neutral representation
11+of documents.
12+-}
313module Text.Pandoc.Definition where
414
515data Pandoc = Pandoc Meta [Block] deriving (Eq, Read, Show)
@@ -17,21 +27,24 @@ data Block
1727 | Blank -- ^ A blank line
1828 | Null -- ^ Nothing
1929 | Para [Inline] -- ^ Paragraph
20− | Key [Inline] Target -- ^ Reference key: name (list of inlines) and 'Target'
30+ | Key [Inline] Target -- ^ Reference key: name (inlines) and 'Target'
2131 | CodeBlock String -- ^ Code block (literal)
2232 | RawHtml String -- ^ Raw HTML block (literal)
2333 | BlockQuote [Block] -- ^ Block quote (list of blocks)
24− | OrderedList [[Block]] -- ^ Ordered list (list of items, each a list of blocks)
25− | BulletList [[Block]] -- ^ Bullet list (list of items, each a list of blocks)
26− | Header Int [Inline] -- ^ Header - level (integer) and text (list of inlines)
34+ | OrderedList [[Block]] -- ^ Ordered list (list of items, each
35+ -- a list of blocks)
36+ | BulletList [[Block]] -- ^ Bullet list (list of items, each
37+ -- a list of blocks)
38+ | Header Int [Inline] -- ^ Header - level (integer) and text (inlines)
2739 | HorizontalRule -- ^ Horizontal rule
28− | Note String [Block] -- ^ Footnote or endnote - reference (string), text (list of blocks)
40+ | Note String [Block] -- ^ Footnote or endnote - reference (string),
41+ -- text (list of blocks)
2942 deriving (Eq, Read, Show)
3043
3144-- | Target for a link: either a URL or an indirect (labeled) reference.
3245data Target
3346 = Src String String -- ^ First string is URL, second is title
34− | Ref [Inline] -- ^ Label (list of inlines) for an indirect reference
47+ | Ref [Inline] -- ^ Label (list of inlines) for an indirect ref
3548 deriving (Show, Eq, Read)
3649
3750-- | Inline elements.
@@ -42,9 +55,10 @@ data Inline
4255 | Code String -- ^ Inline code (literal)
4356 | Space -- ^ Inter-word space
4457 | LineBreak -- ^ Hard line break
45− | TeX String -- ^ LaTeX code (literal)
58+ | TeX String -- ^ LaTeX code (literal)
4659 | HtmlInline String -- ^ HTML code (literal)
4760 | Link [Inline] Target -- ^ Hyperlink: text (list of inlines) and target
48− | Image [Inline] Target -- ^ Image: alternative text (list of inlines) and target
61+ | Image [Inline] Target -- ^ Image: alternative text (list of inlines)
62+ -- and target
4963 | NoteRef String -- ^ Footnote or endnote reference
5064 deriving (Show, Eq, Read)
src/Text/Pandoc/HtmlEntities.hs+21−10
@@ -1,12 +1,22 @@
1−-- | Functions for encoding unicode characters as HTML entity
2−-- references, and vice versa.
1+{- |
2+ Module : Text.Pandoc.HtmlEntities
3+ Copyright : Copyright (C) 2006 John MacFarlane
4+ License : GNU GPL, version 2 or above
5+
6+ Maintainer : John MacFarlane <jgm at berkeley dot edu>
7+ Stability : unstable
8+ Portability : portable
9+
10+Functions for encoding unicode characters as HTML entity references,
11+and vice versa.
12+-}
313module Text.Pandoc.HtmlEntities (
414 htmlEntityToChar,
515 charToHtmlEntity,
616 decodeEntities,
717 encodeEntities
818 ) where
9−import Char ( chr, ord )
19+import Data.Char ( chr, ord )
1020import Text.Regex ( mkRegex, matchRegexAll )
1121import Maybe ( fromMaybe )
1222
@@ -19,13 +29,15 @@ characterEntity = mkRegex "&#[0-9]+;|&[A-Za-z0-9]+;"
1929decodeEntities :: String -> String
2030decodeEntities str =
2131 case (matchRegexAll characterEntity str) of
22− Nothing -> str
23− Just (before, match, rest, _) -> before ++ replacement ++ (decodeEntities rest)
32+ Nothing -> str
33+ Just (before, match, rest, _) -> before ++ replacement ++
34+ (decodeEntities rest)
2435 where replacement = case (htmlEntityToChar match) of
2536 Just ch -> [ch]
2637 Nothing -> match
2738
28−-- | Returns a string with characters replaced with entity references where possible.
39+-- | Returns a string with characters replaced with entity references where
40+-- possible.
2941encodeEntities :: String -> String
3042encodeEntities = concatMap (\c -> fromMaybe [c] (charToHtmlEntity c))
3143
@@ -44,10 +56,9 @@ htmlEntityToChar entity =
4456charToHtmlEntity :: Char -> Maybe String
4557charToHtmlEntity char =
4658 let matches = filter (\(entity, character) -> (character == char)) htmlEntityTable in
47− if (length matches) == 0 then
48− Nothing
49− else
50− Just (fst (head matches))
59+ if (length matches) == 0
60+ then Nothing
61+ else Just (fst (head matches))
5162
5263htmlEntityTable :: [(String, Char)]
5364htmlEntityTable = [
src/Text/Pandoc/Readers/HTML.hs+47−38
@@ -1,4 +1,14 @@
1−-- | Converts HTML to 'Pandoc' document.
1+{- |
2+ Module : Text.Pandoc.Readers.HTML
3+ Copyright : Copyright (C) 2006 John MacFarlane
4+ License : GNU GPL, version 2 or above
5+
6+ Maintainer : John MacFarlane <jgm at berkeley dot edu>
7+ Stability : unstable
8+ Portability : portable
9+
10+Conversion of HTML to 'Pandoc' document.
11+-}
212module Text.Pandoc.Readers.HTML (
313 readHtml,
414 rawHtmlInline,
@@ -30,10 +40,11 @@ testString = testStringWith parseHtml
3040-- Constants
3141--
3242
33−inlineHtmlTags = ["a", "abbr", "acronym", "b", "basefont", "bdo", "big", "br", "cite",
34− "code", "dfn", "em", "font", "i", "img", "input", "kbd", "label", "q",
35− "s", "samp", "select", "small", "span", "strike", "strong", "sub",
36− "sup", "textarea", "tt", "u", "var"]
43+inlineHtmlTags = ["a", "abbr", "acronym", "b", "basefont", "bdo", "big",
44+ "br", "cite", "code", "dfn", "em", "font", "i", "img",
45+ "input", "kbd", "label", "q", "s", "samp", "select",
46+ "small", "span", "strike", "strong", "sub", "sup",
47+ "textarea", "tt", "u", "var"]
3748
3849--
3950-- HTML utility functions
@@ -50,9 +61,10 @@ inlinesTilEnd tag = try (do
5061 return inlines)
5162
5263-- extract type from a tag: e.g. br from <br>, < br >, </br>, etc.
53−extractTagType tag = case (matchRegex (mkRegex "<[[:space:]]*/?([A-Za-z0-9]+)") tag) of
54− Just [match] -> (map toLower match)
55− Nothing -> ""
64+extractTagType tag =
65+ case (matchRegex (mkRegex "<[[:space:]]*/?([A-Za-z0-9]+)") tag) of
66+ Just [match] -> (map toLower match)
67+ Nothing -> ""
5668
5769anyHtmlTag = try (do
5870 char '<'
@@ -90,7 +102,8 @@ htmlTag tag = try (do
90102
91103-- parses a quoted html attribute value
92104quoted quoteChar = do
93− result <- between (char quoteChar) (char quoteChar) (many (noneOf [quoteChar]))
105+ result <- between (char quoteChar) (char quoteChar)
106+ (many (noneOf [quoteChar]))
94107 return (result, [quoteChar])
95108
96109htmlAttributes = do
@@ -116,9 +129,11 @@ htmlRegularAttribute = try (do
116129 spaces
117130 (content, quoteStr) <- choice [ (quoted '\''),
118131 (quoted '"'),
119− (do{ a <- (many (alphaNum <|> (oneOf "-._:")));
120− return (a,"")} ) ]
121− return (name, content, (" " ++ name ++ "=" ++ quoteStr ++ content ++ quoteStr)))
132+ (do
133+ a <- many (alphaNum <|> (oneOf "-._:"))
134+ return (a,"")) ]
135+ return (name, content,
136+ (" " ++ name ++ "=" ++ quoteStr ++ content ++ quoteStr)))
122137
123138htmlEndTag tag = try (do
124139 char '<'
@@ -135,17 +150,11 @@ isInline tag = (extractTagType tag) `elem` inlineHtmlTags
135150
136151anyHtmlBlockTag = try (do
137152 tag <- choice [anyHtmlTag, anyHtmlEndTag]
138− if isInline tag then
139− fail "inline tag"
140− else
141− return tag)
153+ if isInline tag then fail "inline tag" else return tag)
142154
143155anyHtmlInlineTag = try (do
144156 tag <- choice [ anyHtmlTag, anyHtmlEndTag ]
145− if isInline tag then
146− return tag
147− else
148− fail "not an inline tag")
157+ if isInline tag then return tag else fail "not an inline tag")
149158
150159-- scripts must be treated differently, because they can contain <> etc.
151160htmlScript = try (do
@@ -155,13 +164,11 @@ htmlScript = try (do
155164
156165rawHtmlBlock = try (do
157166 notFollowedBy' (choice [htmlTag "/body", htmlTag "/html"])
158− body <- choice [htmlScript, anyHtmlBlockTag, htmlComment, xmlDec, definition]
167+ body <- choice [htmlScript, anyHtmlBlockTag, htmlComment, xmlDec,
168+ definition]
159169 sp <- (many space)
160170 state <- getState
161− if stateParseRaw state then
162− return (RawHtml (body ++ sp))
163− else
164− return Null)
171+ if stateParseRaw state then return (RawHtml (body ++ sp)) else return Null)
165172
166173htmlComment = try (do
167174 string "<!--"
@@ -266,10 +273,10 @@ headerLevel n = try (do
266273hrule = try (do
267274 (tag, attribs) <- htmlTag "hr"
268275 state <- getState
269− if (not (null attribs)) && (stateParseRaw state) then
270− unexpected "attributes in hr" -- in this case we want to parse it as raw html
271− else
272− return HorizontalRule)
276+ if (not (null attribs)) && (stateParseRaw state)
277+ then -- in this case we want to parse it as raw html
278+ unexpected "attributes in hr"
279+ else return HorizontalRule)
273280
274281--
275282-- code blocks
@@ -352,29 +359,31 @@ inline = choice [ text, special ] <?> "inline"
352359
353360text = choice [ entity, strong, emph, code, str, linebreak, whitespace ] <?> "text"
354361
355−special = choice [ link, image, rawHtmlInline ] <?> "link, inline html, or image"
362+special = choice [ link, image, rawHtmlInline ] <?>
363+ "link, inline html, or image"
356364
357365entity = try (do
358366 char '&'
359− body <- choice [(many1 letter),
360− (try (do{ char '#'; num <- many1 digit; return ("#" ++ num)}))]
367+ body <- choice [(many1 letter), (try (do
368+ char '#'
369+ num <- many1 digit
370+ return ("#" ++ num)))]
361371 char ';'
362372 return (Str [fromMaybe '?' (htmlEntityToChar ("&" ++ body ++ ";"))]))
363373
364374code = try (do
365375 htmlTag "code"
366376 result <- manyTill anyChar (htmlEndTag "code")
367− -- remove internal line breaks, leading and trailing space, and decode entities
368− let result' = decodeEntities $ removeLeadingTrailingSpace $ joinWithSep " " $ lines result
377+ -- remove internal line breaks, leading and trailing space,
378+ -- and decode entities
379+ let result' = decodeEntities $ removeLeadingTrailingSpace $
380+ joinWithSep " " $ lines result
369381 return (Code result'))
370382
371383rawHtmlInline = do
372384 result <- choice [htmlScript, anyHtmlInlineTag]
373385 state <- getState
374− if stateParseRaw state then
375− return (HtmlInline result)
376− else
377− return (Str "")
386+ if stateParseRaw state then return (HtmlInline result) else return (Str "")
378387
379388betweenTags tag = try (do
380389 htmlTag tag
src/Text/Pandoc/Readers/LaTeX.hs+66−52
@@ -1,4 +1,14 @@
1−-- | Converts LaTeX to 'Pandoc' document.
1+{- |
2+ Module : Text.Pandoc.Readers.LaTeX
3+ Copyright : Copyright (C) 2006 John MacFarlane
4+ License : GNU GPL, version 2 or above
5+
6+ Maintainer : John MacFarlane <jgm at berkeley dot edu>
7+ Stability : unstable
8+ Portability : portable
9+
10+Conversion of LaTeX to 'Pandoc' document.
11+-}
212module Text.Pandoc.Readers.LaTeX (
313 readLaTeX,
414 rawLaTeXInline,
@@ -81,7 +91,8 @@ end name = try (do
8191 spaces
8292 return name)
8393
84−-- | Returns a list of block elements containing the contents of an environment.
94+-- | Returns a list of block elements containing the contents of an
95+-- environment.
8596environment name = try (do
8697 begin name
8798 spaces
@@ -104,15 +115,16 @@ anyEnvironment = try (do
104115
105116-- | Process LaTeX preamble, extracting metadata.
106117processLaTeXPreamble = do
107− manyTill (choice [bibliographic, comment, unknownCommand, nullBlock]) (try (string "\\begin{document}"))
118+ manyTill (choice [bibliographic, comment, unknownCommand, nullBlock])
119+ (try (string "\\begin{document}"))
108120 spaces
109121
110122-- | Parse LaTeX and return 'Pandoc'.
111123parseLaTeX = do
112− option () processLaTeXPreamble -- preamble might not be present, if a fragment
124+ option () processLaTeXPreamble -- preamble might not be present (fragment)
113125 blocks <- parseBlocks
114126 spaces
115− option "" (string "\\end{document}") -- if parsing a fragment, this might not be present
127+ option "" (string "\\end{document}") -- might not be present (in fragment)
116128 spaces
117129 eof
118130 state <- getState
@@ -122,7 +134,8 @@ parseLaTeX = do
122134 let title' = stateTitle state
123135 let authors' = stateAuthors state
124136 let date' = stateDate state
125− return (Pandoc (Meta title' authors' date') (blocks' ++ (reverse noteBlocks) ++ (reverse keyBlocks)))
137+ return (Pandoc (Meta title' authors' date')
138+ (blocks' ++ (reverse noteBlocks) ++ (reverse keyBlocks)))
126139
127140--
128141-- parsing blocks
@@ -133,9 +146,10 @@ parseBlocks = do
133146 result <- many block
134147 return result
135148
136−block = choice [ hrule, codeBlock, header, list, blockQuote, mathBlock, comment,
137− bibliographic, para, specialEnvironment, itemBlock, unknownEnvironment,
138− unknownCommand ] <?> "block"
149+block = choice [ hrule, codeBlock, header, list, blockQuote, mathBlock,
150+ comment, bibliographic, para, specialEnvironment,
151+ itemBlock, unknownEnvironment, unknownCommand ] <?>
152+ "block"
139153
140154--
141155-- header blocks
@@ -157,7 +171,8 @@ headerLevel n = try (do
157171--
158172
159173hrule = try (do
160− oneOfStrings [ "\\begin{center}\\rule{3in}{0.4pt}\\end{center}\n\n", "\\newpage" ]
174+ oneOfStrings [ "\\begin{center}\\rule{3in}{0.4pt}\\end{center}\n\n",
175+ "\\newpage" ]
161176 spaces
162177 return HorizontalRule)
163178
@@ -166,8 +181,10 @@ hrule = try (do
166181--
167182
168183codeBlock = try (do
169− string "\\begin{verbatim}" -- don't use begin function because it gobbles whitespace
170− option "" blanklines -- we want to gobble blank lines, but not leading space
184+ string "\\begin{verbatim}" -- don't use begin function because it
185+ -- gobbles whitespace
186+ option "" blanklines -- we want to gobble blank lines, but not
187+ -- leading space
171188 contents <- manyTill anyChar (try (string "\\end{verbatim}"))
172189 spaces
173190 return (CodeBlock (stripTrailingNewlines contents)))
@@ -266,7 +283,8 @@ authors = try (do
266283 string "\\author{"
267284 authors <- manyTill anyChar (char '}')
268285 spaces
269− let authors' = map removeLeadingTrailingSpace $ lines $ gsub "\\\\\\\\" "\n" authors
286+ let authors' = map removeLeadingTrailingSpace $ lines $
287+ gsub "\\\\\\\\" "\n" authors
270288 updateState (\state -> state { stateAuthors = authors' })
271289 return Null)
272290
@@ -286,21 +304,19 @@ date = try (do
286304itemBlock = try (do
287305 ("item", _, args) <- command
288306 state <- getState
289− if (stateParserContext state == ListItemState) then
290− fail "item should be handled by list block"
291− else
292− if null args then
293− return Null
294− else
295− return (Plain [Str (stripFirstAndLast (head args))]))
307+ if (stateParserContext state == ListItemState)
308+ then fail "item should be handled by list block"
309+ else if null args
310+ then return Null
311+ else return (Plain [Str (stripFirstAndLast (head args))]))
296312
297313--
298314-- raw LaTeX
299315--
300316
301317specialEnvironment = do -- these are always parsed as raw
302− followedBy' (choice (map (\name -> begin name) ["tabular", "figure", "tabbing", "eqnarry",
303− "picture", "table", "verse", "theorem"]))
318+ followedBy' (choice (map (\name -> begin name) ["tabular", "figure",
319+ "tabbing", "eqnarry", "picture", "table", "verse", "theorem"]))
304320 rawLaTeXEnvironment
305321
306322-- | Parse any LaTeX environment and return a Para block containing
@@ -316,18 +332,20 @@ rawLaTeXEnvironment = try (do
316332 args <- option [] commandArgs
317333 let argStr = concat args
318334 contents <- manyTill (choice [(many1 (noneOf "\\")),
319− (do{ (Para [TeX str]) <- rawLaTeXEnvironment; return str }),
320− string "\\"]) (end name')
335+ (do
336+ (Para [TeX str]) <- rawLaTeXEnvironment
337+ return str),
338+ string "\\" ])
339+ (end name')
321340 spaces
322341 return (Para [TeX ("\\begin{" ++ name' ++ "}" ++ argStr ++
323− (concat contents) ++ "\\end{" ++ name' ++ "}")]))
342+ (concat contents) ++ "\\end{" ++ name' ++ "}")]))
324343
325344unknownEnvironment = try (do
326345 state <- getState
327− result <- if stateParseRaw state then -- check to see whether we should include raw TeX
328− rawLaTeXEnvironment -- if so, get the whole raw environment
329− else
330− anyEnvironment -- otherwise just the contents
346+ result <- if stateParseRaw state -- check whether we should include raw TeX
347+ then rawLaTeXEnvironment -- if so, get whole raw environment
348+ else anyEnvironment -- otherwise just the contents
331349 return result)
332350
333351unknownCommand = try (do
@@ -338,14 +356,12 @@ unknownCommand = try (do
338356 spaces
339357 let argStr = concat args
340358 state <- getState
341− if (name == "item") && ((stateParserContext state) == ListItemState) then
342− fail "should not be parsed as raw"
343− else
344− string ""
345− if stateParseRaw state then
346− return (Plain [TeX ("\\" ++ name ++ star ++ argStr)])
347− else
348− return (Plain [Str (joinWithSep " " args)]))
359+ if (name == "item") && ((stateParserContext state) == ListItemState)
360+ then fail "should not be parsed as raw"
361+ else string ""
362+ if stateParseRaw state
363+ then return (Plain [TeX ("\\" ++ name ++ star ++ argStr)])
364+ else return (Plain [Str (joinWithSep " " args)]))
349365
350366-- latex comment
351367comment = try (do
@@ -358,9 +374,9 @@ comment = try (do
358374-- inline
359375--
360376
361−inline = choice [ strong, emph, ref, lab, code, linebreak, math, ldots, accentedChar,
362− specialChar, specialInline, escapedChar, unescapedChar, str,
363− endline, whitespace ] <?> "inline"
377+inline = choice [ strong, emph, ref, lab, code, linebreak, math, ldots,
378+ accentedChar, specialChar, specialInline, escapedChar,
379+ unescapedChar, str, endline, whitespace ] <?> "inline"
364380
365381specialInline = choice [ link, image, footnote, rawLaTeXInline ] <?>
366382 "link, raw TeX, note, or image"
@@ -397,8 +413,8 @@ accentTable =
397413 ('o', [('`', 242), ('\'', 243), ('^', 244), ('~', 245), ('"', 246)]),
398414 ('u', [('`', 249), ('\'', 250), ('^', 251), ('"', 252)]) ]
399415
400−specialAccentedChar = choice [ ccedil, aring, iuml, szlig, aelig, oslash, pound,
401− euro, copyright, sect ]
416+specialAccentedChar = choice [ ccedil, aring, iuml, szlig, aelig,
417+ oslash, pound, euro, copyright, sect ]
402418
403419ccedil = try (do
404420 char '\\'
@@ -563,15 +579,14 @@ image = try (do
563579
564580footnote = try (do
565581 (name, _, (contents:[])) <- command
566− if ((name == "footnote") || (name == "thanks")) then
567− string ""
568− else
569− fail "not a footnote or thanks command"
582+ if ((name == "footnote") || (name == "thanks"))
583+ then string ""
584+ else fail "not a footnote or thanks command"
570585 let contents' = stripFirstAndLast contents
571586 state <- getState
572587 let blocks = case runParser parseBlocks state "footnote" contents of
573− Left err -> error $ "Input:\n" ++ show contents' ++
574− "\nError:\n" ++ show err
588+ Left err -> error $ "Input:\n" ++ show contents' ++
589+ "\nError:\n" ++ show err
575590 Right result -> result
576591 let notes = stateNoteBlocks state
577592 let nextRef = case notes of
@@ -586,8 +601,7 @@ rawLaTeXInline = try (do
586601 (name, star, args) <- command
587602 let argStr = concat args
588603 state <- getState
589− if ((name == "begin") || (name == "end") || (name == "item")) then
590− fail "not an inline command"
591− else
592− string ""
604+ if ((name == "begin") || (name == "end") || (name == "item"))
605+ then fail "not an inline command"
606+ else string ""
593607 return (TeX ("\\" ++ name ++ star ++ argStr)))
src/Text/Pandoc/Readers/Markdown.hs+312−289
@@ -1,4 +1,14 @@
1−-- | Convert markdown to Pandoc document.
1+{- |
2+ Module : Text.Pandoc.Readers.Markdown
3+ Copyright : Copyright (C) 2006 John MacFarlane
4+ License : GNU GPL, version 2 or above
5+
6+ Maintainer : John MacFarlane <jgm at berkeley dot edu>
7+ Stability : unstable
8+ Portability : portable
9+
10+Conversion of markdown-formatted plain text to 'Pandoc' document.
11+-}
212module Text.Pandoc.Readers.Markdown (
313 readMarkdown
414 ) where
@@ -8,8 +18,8 @@ import Text.ParserCombinators.Pandoc
818import Text.Pandoc.Definition
919import Text.Pandoc.Readers.LaTeX ( rawLaTeXInline, rawLaTeXEnvironment )
1020import Text.Pandoc.Shared
11−import Text.Pandoc.Readers.HTML ( rawHtmlInline, rawHtmlBlock, anyHtmlBlockTag,
12− anyHtmlInlineTag )
21+import Text.Pandoc.Readers.HTML ( rawHtmlInline, rawHtmlBlock,
22+ anyHtmlBlockTag, anyHtmlInlineTag )
1323import Text.Pandoc.HtmlEntities ( decodeEntities )
1424import Text.Regex ( matchRegex, mkRegex )
1525import Text.ParserCombinators.Parsec
@@ -57,9 +67,10 @@ blockQuoteChar = '>'
5767hyphenChar = '-'
5868
5969-- treat these as potentially non-text when parsing inline:
60−specialChars = [escapeChar, labelStart, labelEnd, emphStart, emphEnd, emphStartAlt,
61− emphEndAlt, codeStart, codeEnd, autoLinkEnd, autoLinkStart, mathStart,
62− mathEnd, imageStart, noteStart, hyphenChar]
70+specialChars = [escapeChar, labelStart, labelEnd, emphStart, emphEnd,
71+ emphStartAlt, emphEndAlt, codeStart, codeEnd, autoLinkEnd,
72+ autoLinkStart, mathStart, mathEnd, imageStart, noteStart,
73+ hyphenChar]
6374
6475--
6576-- auxiliary functions
@@ -115,14 +126,16 @@ numberOfNote (Note ref _) = (read ref)
115126numberOfNote _ = 0
116127
117128parseMarkdown = do
118− updateState (\state -> state { stateParseRaw = True }) -- need to parse raw HTML
129+ updateState (\state -> state { stateParseRaw = True })
130+ -- need to parse raw HTML, since markdown allows it
119131 (title, author, date) <- option ([],[],"") titleBlock
120132 blocks <- parseBlocks
121133 let blocks' = filter (/= Null) blocks
122134 state <- getState
123135 let keys = reverse $ stateKeyBlocks state
124136 let notes = reverse $ stateNoteBlocks state
125− let sortedNotes = sortBy (\x y -> compare (numberOfNote x) (numberOfNote y)) notes
137+ let sortedNotes = sortBy (\x y -> compare (numberOfNote x)
138+ (numberOfNote y)) notes
126139 return (Pandoc (Meta title author date) (blocks' ++ sortedNotes ++ keys))
127140
128141--
@@ -133,8 +146,9 @@ parseBlocks = do
133146 result <- manyTill block eof
134147 return result
135148
136−block = choice [ codeBlock, note, referenceKey, header, hrule, list, blockQuote, rawHtmlBlocks,
137− rawLaTeXEnvironment, para, plain, blankBlock, nullBlock ] <?> "block"
149+block = choice [ codeBlock, note, referenceKey, header, hrule, list,
150+ blockQuote, rawHtmlBlocks, rawLaTeXEnvironment, para,
151+ plain, blankBlock, nullBlock ] <?> "block"
138152
139153--
140154-- header blocks
@@ -154,33 +168,33 @@ atxClosing = try (do
154168 newline
155169 option "" blanklines)
156170
157−setextHeader = choice (map (\x -> setextH x) (enumFromTo 1 (length setextHChars)))
171+setextHeader = choice $
172+ map (\x -> setextH x) (enumFromTo 1 (length setextHChars))
158173
159174setextH n = try (do
160− txt <- many1 (do {notFollowedBy newline; inline})
161− endline
162− many1 (char (setextHChars !! (n-1)))
163− skipSpaces
164− newline
165− option "" blanklines
166− return (Header n (normalizeSpaces txt)))
175+ txt <- many1 (do {notFollowedBy newline; inline})
176+ endline
177+ many1 (char (setextHChars !! (n-1)))
178+ skipSpaces
179+ newline
180+ option "" blanklines
181+ return (Header n (normalizeSpaces txt)))
167182
168183--
169184-- hrule block
170185--
171186
172−hruleWith chr =
173− try (do
174− skipSpaces
175− char chr
176− skipSpaces
177− char chr
178− skipSpaces
179− char chr
180− skipMany (oneOf (chr:spaceChars))
181− newline
182− option "" blanklines
183− return HorizontalRule)
187+hruleWith chr = try (do
188+ skipSpaces
189+ char chr
190+ skipSpaces
191+ char chr
192+ skipSpaces
193+ char chr
194+ skipMany (oneOf (chr:spaceChars))
195+ newline
196+ option "" blanklines
197+ return HorizontalRule)
184198
185199hrule = choice (map hruleWith hruleChars) <?> "hrule"
186200
@@ -189,9 +203,9 @@ hrule = choice (map hruleWith hruleChars) <?> "hrule"
189203--
190204
191205indentedLine = try (do
192− indentSpaces
193− result <- manyTill anyChar newline
194− return (result ++ "\n"))
206+ indentSpaces
207+ result <- manyTill anyChar newline
208+ return (result ++ "\n"))
195209
196210-- two or more indented lines, possibly separated by blank lines
197211indentedBlock = try (do
@@ -201,62 +215,66 @@ indentedBlock = try (do
201215 return (res1 ++ blanks ++ res2))
202216
203217codeBlock = do
204− result <- choice [indentedBlock, indentedLine]
205− option "" blanklines
206− return (CodeBlock (stripTrailingNewlines result))
218+ result <- choice [indentedBlock, indentedLine]
219+ option "" blanklines
220+ return (CodeBlock (stripTrailingNewlines result))
207221
208222--
209223-- note block
210224--
211225
212226rawLine = try (do
213− notFollowedBy' blankline
214− notFollowedBy' noteMarker
215− contents <- many1 nonEndline
216− end <- option "" (do
217− newline
218− option "" indentSpaces
219− return "\n")
220− return (contents ++ end))
227+ notFollowedBy' blankline
228+ notFollowedBy' noteMarker
229+ contents <- many1 nonEndline
230+ end <- option "" (do
231+ newline
232+ option "" indentSpaces
233+ return "\n")
234+ return (contents ++ end))
221235
222236rawLines = do
223237 lines <- many1 rawLine
224238 return (concat lines)
225239
226240note = try (do
227− ref <- noteMarker
228− char ':'
229− skipSpaces
230− skipEndline
231− raw <- sepBy rawLines (try (do {blankline; indentSpaces}))
232− option "" blanklines
233− -- parse the extracted text, which may contain various block elements:
234− state <- getState
235− let parsed = case runParser parseBlocks (state {stateParserContext = BlockQuoteState}) "block" ((joinWithSep "\n" raw) ++ "\n\n") of
236− Left err -> error $ "Raw block:\n" ++ show raw ++ "\nError:\n" ++ show err
237− Right result -> result
238− let identifiers = stateNoteIdentifiers state
239− case (findIndex (== ref) identifiers) of
240− Just n -> updateState (\s -> s {stateNoteBlocks =
241− (Note (show (n+1)) parsed):(stateNoteBlocks s)})
242− Nothing -> updateState id
243− return Null)
241+ ref <- noteMarker
242+ char ':'
243+ skipSpaces
244+ skipEndline
245+ raw <- sepBy rawLines (try (do {blankline; indentSpaces}))
246+ option "" blanklines
247+ -- parse the extracted text, which may contain various block elements:
248+ state <- getState
249+ let parsed = case runParser parseBlocks
250+ (state {stateParserContext = BlockQuoteState}) "block"
251+ ((joinWithSep "\n" raw) ++ "\n\n") of
252+ Left err -> error $ "Raw block:\n" ++ show raw ++
253+ "\nError:\n" ++ show err
254+ Right result -> result
255+ let identifiers = stateNoteIdentifiers state
256+ case (findIndex (== ref) identifiers) of
257+ Just n -> updateState (\s -> s {stateNoteBlocks =
258+ (Note (show (n+1)) parsed):(stateNoteBlocks s)})
259+ Nothing -> updateState id
260+ return Null)
244261
245262--
246263-- block quotes
247264--
248265
249266emacsBoxQuote = try (do
250− string ",----"
251− manyTill anyChar newline
252− raw <- manyTill (try (do{ char '|';
253− option ' ' (char ' ');
254− result <- manyTill anyChar newline;
255− return result}))
256− (string "`----")
257− manyTill anyChar newline
258− option "" blanklines
259− return raw)
267+ string ",----"
268+ manyTill anyChar newline
269+ raw <- manyTill (try (do
270+ char '|'
271+ option ' ' (char ' ')
272+ result <- manyTill anyChar newline
273+ return result))
274+ (string "`----")
275+ manyTill anyChar newline
276+ option "" blanklines
277+ return raw)
260278
261279emailBlockQuoteStart = try (do
262280 skipNonindentSpaces
@@ -265,24 +283,28 @@ emailBlockQuoteStart = try (do
265283 return "> ")
266284
267285emailBlockQuote = try (do
268− emailBlockQuoteStart
269− raw <- sepBy (many (choice [nonEndline,
270− (try (do{ endline;
271− notFollowedBy' emailBlockQuoteStart;
272− return '\n'}))]))
273− (try (do {newline; emailBlockQuoteStart}))
274− newline <|> (do{ eof; return '\n'})
275− option "" blanklines
276− return raw)
286+ emailBlockQuoteStart
287+ raw <- sepBy (many (choice [nonEndline,
288+ (try (do
289+ endline
290+ notFollowedBy' emailBlockQuoteStart
291+ return '\n'))]))
292+ (try (do {newline; emailBlockQuoteStart}))
293+ newline <|> (do{ eof; return '\n' })
294+ option "" blanklines
295+ return raw)
277296
278297blockQuote = do
279− raw <- choice [ emailBlockQuote, emacsBoxQuote ]
280− -- parse the extracted block, which may contain various block elements:
281− state <- getState
282− let parsed = case runParser parseBlocks (state {stateParserContext = BlockQuoteState}) "block" ((joinWithSep "\n" raw) ++ "\n\n") of
283− Left err -> error $ "Raw block:\n" ++ show raw ++ "\nError:\n" ++ show err
284− Right result -> result
285− return (BlockQuote parsed)
298+ raw <- choice [ emailBlockQuote, emacsBoxQuote ]
299+ -- parse the extracted block, which may contain various block elements:
300+ state <- getState
301+ let parsed = case runParser parseBlocks
302+ (state {stateParserContext = BlockQuoteState}) "block"
303+ ((joinWithSep "\n" raw) ++ "\n\n") of
304+ Left err -> error $ "Raw block:\n" ++ show raw ++
305+ "\nError:\n" ++ show err
306+ Right result -> result
307+ return (BlockQuote parsed)
286308
287309--
288310-- list blocks
@@ -290,85 +312,81 @@ blockQuote = do
290312
291313list = choice [ bulletList, orderedList ] <?> "list"
292314
293−bulletListStart =
294− try (do
295− option ' ' newline -- if preceded by a Plain block in a list context
296− skipNonindentSpaces
297− notFollowedBy' hrule -- because hrules start out just like lists
298− oneOf bulletListMarkers
299− spaceChar
300− skipSpaces)
301−
302−orderedListStart =
303− try (do
304− option ' ' newline -- if preceded by a Plain block in a list context
305− skipNonindentSpaces
306− many1 digit <|> count 1 letter
307− oneOf orderedListDelimiters
308− oneOf spaceChars
309− skipSpaces)
315+bulletListStart = try (do
316+ option ' ' newline -- if preceded by a Plain block in a list context
317+ skipNonindentSpaces
318+ notFollowedBy' hrule -- because hrules start out just like lists
319+ oneOf bulletListMarkers
320+ spaceChar
321+ skipSpaces)
322+
323+orderedListStart = try (do
324+ option ' ' newline -- if preceded by a Plain block in a list context
325+ skipNonindentSpaces
326+ many1 digit <|> count 1 letter
327+ oneOf orderedListDelimiters
328+ oneOf spaceChars
329+ skipSpaces)
310330
311331-- parse a line of a list item (start = parser for beginning of list item)
312332listLine start = try (do
313333 notFollowedBy' start
314334 notFollowedBy blankline
315− notFollowedBy' (do{ indentSpaces;
316− many (spaceChar);
317− choice [bulletListStart, orderedListStart]})
335+ notFollowedBy' (do
336+ indentSpaces
337+ many (spaceChar)
338+ choice [bulletListStart, orderedListStart])
318339 line <- manyTill anyChar newline
319340 return (line ++ "\n"))
320341
321342-- parse raw text for one list item, excluding start marker and continuations
322−rawListItem start =
323− try (do
324− start
325− result <- many1 (listLine start)
326− blanks <- many blankline
327− return ((concat result) ++ blanks))
343+rawListItem start = try (do
344+ start
345+ result <- many1 (listLine start)
346+ blanks <- many blankline
347+ return ((concat result) ++ blanks))
328348
329349-- continuation of a list item - indented and separated by blankline
330350-- or (in compact lists) endline.
331351-- note: nested lists are parsed as continuations
332−listContinuation start =
333− try (do
334− followedBy' indentSpaces
335− result <- many1 (listContinuationLine start)
336− blanks <- many blankline
337− return ((concat result) ++ blanks))
352+listContinuation start = try (do
353+ followedBy' indentSpaces
354+ result <- many1 (listContinuationLine start)
355+ blanks <- many blankline
356+ return ((concat result) ++ blanks))
338357
339358listContinuationLine start = try (do
340− notFollowedBy' blankline
341− notFollowedBy' start
342− option "" indentSpaces
343− result <- manyTill anyChar newline
344− return (result ++ "\n"))
345−
346−listItem start =
347− try (do
348− first <- rawListItem start
349− rest <- many (listContinuation start)
350− -- parsing with ListItemState forces markers at beginning of lines to
351− -- count as list item markers, even if not separated by blank space.
352− -- see definition of "endline"
353− state <- getState
354− let parsed = case runParser parseBlocks (state {stateParserContext = ListItemState})
355− "block" raw of
356− Left err -> error $ "Raw block:\n" ++ raw ++ "\nError:\n" ++ show err
357− Right result -> result
358− where raw = concat (first:rest)
359− return parsed)
360−
361−orderedList =
362− try (do
363− items <- many1 (listItem orderedListStart)
364− let items' = compactify items
365− return (OrderedList items'))
366−
367−bulletList =
368− try (do
369− items <- many1 (listItem bulletListStart)
370− let items' = compactify items
371− return (BulletList items'))
359+ notFollowedBy' blankline
360+ notFollowedBy' start
361+ option "" indentSpaces
362+ result <- manyTill anyChar newline
363+ return (result ++ "\n"))
364+
365+listItem start = try (do
366+ first <- rawListItem start
367+ rest <- many (listContinuation start)
368+ -- parsing with ListItemState forces markers at beginning of lines to
369+ -- count as list item markers, even if not separated by blank space.
370+ -- see definition of "endline"
371+ state <- getState
372+ let parsed = case runParser parseBlocks
373+ (state {stateParserContext = ListItemState})
374+ "block" raw of
375+ Left err -> error $ "Raw block:\n" ++ raw ++
376+ "\nError:\n" ++ show err
377+ Right result -> result
378+ where raw = concat (first:rest)
379+ return parsed)
380+
381+orderedList = try (do
382+ items <- many1 (listItem orderedListStart)
383+ let items' = compactify items
384+ return (OrderedList items'))
385+
386+bulletList = try (do
387+ items <- many1 (listItem bulletListStart)
388+ let items' = compactify items
389+ return (BulletList items'))
372390
373391--
374392-- paragraph block
@@ -377,7 +395,10 @@ bulletList =
377395para = try (do
378396 result <- many1 inline
379397 newline
380− choice [ (do{ followedBy' (oneOfStrings [">", ",----"]); return "" }), blanklines ]
398+ choice [ (do
399+ followedBy' (oneOfStrings [">", ",----"])
400+ return "" ),
401+ blanklines ]
381402 let result' = normalizeSpaces result
382403 return (Para result'))
383404
@@ -391,30 +412,28 @@ plain = do
391412--
392413
393414rawHtmlBlocks = try (do
394− htmlBlocks <- many1 rawHtmlBlock
395− let combined = concatMap (\(RawHtml str) -> str) htmlBlocks
396− let combined' = if (last combined == '\n') then
397− init combined -- strip extra newline
398− else
399− combined
400− return (RawHtml combined'))
415+ htmlBlocks <- many1 rawHtmlBlock
416+ let combined = concatMap (\(RawHtml str) -> str) htmlBlocks
417+ let combined' = if (last combined == '\n')
418+ then init combined -- strip extra newline
419+ else combined
420+ return (RawHtml combined'))
401421
402422--
403423-- reference key
404424--
405425
406−referenceKey =
407− try (do
408− skipSpaces
409− label <- reference
410− char labelSep
411− skipSpaces
412− option ' ' (char autoLinkStart)
413− src <- many (noneOf (titleOpeners ++ [autoLinkEnd] ++ endLineChars))
414− option ' ' (char autoLinkEnd)
415− tit <- option "" title
416− blanklines
417− return (Key label (Src (removeTrailingSpace src) tit)))
426+referenceKey = try (do
427+ skipSpaces
428+ label <- reference
429+ char labelSep
430+ skipSpaces
431+ option ' ' (char autoLinkStart)
432+ src <- many (noneOf (titleOpeners ++ [autoLinkEnd] ++ endLineChars))
433+ option ' ' (char autoLinkEnd)
434+ tit <- option "" title
435+ blanklines
436+ return (Key label (Src (removeTrailingSpace src) tit)))
418437
419438--
420439-- inline
@@ -423,10 +442,11 @@ referenceKey =
423442text = choice [ math, strong, emph, code2, code1, str, linebreak, tabchar,
424443 whitespace, endline ] <?> "text"
425444
426−inline = choice [ rawLaTeXInline, escapedChar, special, hyphens, text, ltSign, symbol ] <?> "inline"
445+inline = choice [ rawLaTeXInline, escapedChar, special, hyphens, text,
446+ ltSign, symbol ] <?> "inline"
427447
428−special = choice [ noteRef, inlineNote, link, referenceLink, rawHtmlInline, autoLink,
429− image ] <?> "link, inline html, note, or image"
448+special = choice [ noteRef, inlineNote, link, referenceLink, rawHtmlInline,
449+ autoLink, image ] <?> "link, inline html, note, or image"
430450
431451escapedChar = escaped anyChar
432452
@@ -443,30 +463,33 @@ symbol = do
443463
444464hyphens = try (do
445465 result <- many1 (char '-')
446− if (length result) == 1 then
447− skipEndline -- don't want to treat endline after hyphen as a space
448− else
449− do{ string ""; return Space }
466+ if (length result) == 1
467+ then skipEndline -- don't want to treat endline after hyphen as a space
468+ else do{ string ""; return Space }
450469 return (Str result))
451470
452471-- parses inline code, between codeStart and codeEnd
453−code1 =
454− try (do
455− char codeStart
456− result <- many (noneOf [codeEnd])
457− char codeEnd
458− let result' = removeLeadingTrailingSpace $ joinWithSep " " $ lines result -- get rid of any internal newlines
459− return (Code result'))
472+code1 = try (do
473+ char codeStart
474+ result <- many (noneOf [codeEnd])
475+ char codeEnd
476+ -- get rid of any internal newlines
477+ let result' = removeLeadingTrailingSpace $ joinWithSep " " $ lines result
478+ return (Code result'))
460479
461480-- parses inline code, between 2 codeStarts and 2 codeEnds
462−code2 =
463− try (do
464− string [codeStart, codeStart]
465− result <- manyTill anyChar (try (string [codeEnd, codeEnd]))
466− let result' = removeLeadingTrailingSpace $ joinWithSep " " $ lines result -- get rid of any internal newlines
467− return (Code result'))
468−
469−mathWord = many1 (choice [(noneOf (" \t\n\\" ++ [mathEnd])), (try (do {c <- char '\\'; notFollowedBy (char mathEnd); return c}))])
481+code2 = try (do
482+ string [codeStart, codeStart]
483+ result <- manyTill anyChar (try (string [codeEnd, codeEnd]))
484+ let result' = removeLeadingTrailingSpace $ joinWithSep " " $ lines result
485+ -- get rid of any internal newlines
486+ return (Code result'))
487+
488+mathWord = many1 (choice [ (noneOf (" \t\n\\" ++ [mathEnd])),
489+ (try (do
490+ c <- char '\\'
491+ notFollowedBy (char mathEnd)
492+ return c))])
470493
471494math = try (do
472495 char mathStart
@@ -477,12 +500,14 @@ math = try (do
477500
478501emph = do
479502 result <- choice [ (enclosed (char emphStart) (char emphEnd) inline),
480− (enclosed (char emphStartAlt) (char emphEndAlt) inline) ]
503+ (enclosed (char emphStartAlt) (char emphEndAlt) inline) ]
481504 return (Emph (normalizeSpaces result))
482505
483506strong = do
484− result <- choice [ (enclosed (count 2 (char emphStart)) (count 2 (char emphEnd)) inline),
485− (enclosed (count 2 (char emphStartAlt)) (count 2 (char emphEndAlt)) inline)]
507+ result <- choice [ (enclosed (count 2 (char emphStart))
508+ (count 2 (char emphEnd)) inline),
509+ (enclosed (count 2 (char emphStartAlt))
510+ (count 2 (char emphEndAlt)) inline) ]
486511 return (Strong (normalizeSpaces result))
487512
488513whitespace = do
@@ -507,23 +532,21 @@ str = do
507532 return (Str (decodeEntities result))
508533
509534-- an endline character that can be treated as a space, not a structural break
510−endline =
511− try (do
512− newline
513− -- next line would allow block quotes without preceding blank line
514− -- Markdown.pl does allow this, but there's a chance of a wrapped
515− -- greater-than sign triggering a block quote by accident...
516−-- notFollowedBy' (choice [emailBlockQuoteStart, string ",----"])
517− notFollowedBy blankline
518− -- parse potential list starts at beginning of line differently if in a list:
519− st <- getState
520− if (stateParserContext st) == ListItemState then
521− do
522− notFollowedBy' orderedListStart
523− notFollowedBy' bulletListStart
524− else
525− option () pzero
526− return Space)
535+endline = try (do
536+ newline
537+ -- next line would allow block quotes without preceding blank line
538+ -- Markdown.pl does allow this, but there's a chance of a wrapped
539+ -- greater-than sign triggering a block quote by accident...
540+ -- notFollowedBy' (choice [emailBlockQuoteStart, string ",----"])
541+ notFollowedBy blankline
542+ -- parse potential list-starts differently if in a list:
543+ st <- getState
544+ if (stateParserContext st) == ListItemState
545+ then do
546+ notFollowedBy' orderedListStart
547+ notFollowedBy' bulletListStart
548+ else option () pzero
549+ return Space)
527550
528551--
529552-- links
@@ -537,92 +560,92 @@ reference = do
537560 return (normalizeSpaces label)
538561
539562-- source for a link, with optional title
540−source =
541− try (do
542− char srcStart
543− option ' ' (char autoLinkStart)
544− src <- many (noneOf ([srcEnd, autoLinkEnd] ++ titleOpeners))
545− option ' ' (char autoLinkEnd)
546− tit <- option "" title
547− skipSpaces
548− char srcEnd
549− return (Src (removeTrailingSpace src) tit))
550−
551−titleWith startChar endChar =
552− try (do
553− skipSpaces
554− skipEndline -- a title can be on the next line from the source
555− skipSpaces
556− char startChar
557− tit <- manyTill (choice [ try (do {char '\\'; char endChar}),
558− (noneOf (endChar:endLineChars)) ]) (char endChar)
559− let tit' = gsub "\"" "&quot;" tit
560− return tit')
561−
562−title = choice [titleWith '(' ')', titleWith '"' '"', titleWith '\'' '\''] <?> "title"
563+source = try (do
564+ char srcStart
565+ option ' ' (char autoLinkStart)
566+ src <- many (noneOf ([srcEnd, autoLinkEnd] ++ titleOpeners))
567+ option ' ' (char autoLinkEnd)
568+ tit <- option "" title
569+ skipSpaces
570+ char srcEnd
571+ return (Src (removeTrailingSpace src) tit))
572+
573+titleWith startChar endChar = try (do
574+ skipSpaces
575+ skipEndline -- a title can be on the next line from the source
576+ skipSpaces
577+ char startChar
578+ tit <- manyTill (choice [ try (do {char '\\'; char endChar}),
579+ (noneOf (endChar:endLineChars)) ]) (char endChar)
580+ let tit' = gsub "\"" "&quot;" tit
581+ return tit')
582+
583+title = choice [ titleWith '(' ')',
584+ titleWith '"' '"',
585+ titleWith '\'' '\''] <?> "title"
563586
564587link = choice [explicitLink, referenceLink] <?> "link"
565588
566−explicitLink =
567− try (do
568− label <- reference
569− src <- source
570− return (Link label src))
589+explicitLink = try (do
590+ label <- reference
591+ src <- source
592+ return (Link label src))
571593
572594referenceLink = choice [referenceLinkDouble, referenceLinkSingle]
573595
574−referenceLinkDouble = -- a link like [this][/url/]
575− try (do
576− label <- reference
577− skipSpaces
578− skipEndline
579− skipSpaces
580− ref <- reference
581− return (Link label (Ref ref)))
582−
583−referenceLinkSingle = -- a link like [this]
584− try (do
585− label <- reference
586− return (Link label (Ref [])))
587−
588−autoLink = -- a link <like.this.com>
589− try (do
590− notFollowedBy' anyHtmlBlockTag
591− src <- between (char autoLinkStart) (char autoLinkEnd)
592− (many (noneOf (spaceChars ++ endLineChars ++ [autoLinkEnd])))
593− case (matchRegex emailAddress src) of
594− Just _ -> return (Link [Str src] (Src ("mailto:" ++ src) ""))
595− Nothing -> return (Link [Str src] (Src src "")))
596−
597−emailAddress = mkRegex "([^@:/]+)@(([^.]+[.]?)*([^.]+))" -- presupposes no whitespace
598−
599−image =
600− try (do
601− char imageStart
602− (Link label src) <- link
603− return (Image label src))
596+-- a link like [this][/url/]
597+referenceLinkDouble = try (do
598+ label <- reference
599+ skipSpaces
600+ skipEndline
601+ skipSpaces
602+ ref <- reference
603+ return (Link label (Ref ref)))
604+
605+-- a link like [this]
606+referenceLinkSingle = try (do
607+ label <- reference
608+ return (Link label (Ref [])))
609+
610+-- a link <like.this.com>
611+autoLink = try (do
612+ notFollowedBy' anyHtmlBlockTag
613+ src <- between (char autoLinkStart) (char autoLinkEnd)
614+ (many (noneOf (spaceChars ++ endLineChars ++ [autoLinkEnd])))
615+ case (matchRegex emailAddress src) of
616+ Just _ -> return (Link [Str src] (Src ("mailto:" ++ src) ""))
617+ Nothing -> return (Link [Str src] (Src src "")))
618+
619+emailAddress =
620+ mkRegex "([^@:/]+)@(([^.]+[.]?)*([^.]+))" -- presupposes no whitespace
621+
622+image = try (do
623+ char imageStart
624+ (Link label src) <- link
625+ return (Image label src))
604626
605627noteMarker = try (do
606− char labelStart
607− char noteStart
608− manyTill (noneOf " \t\n") (char labelEnd))
628+ char labelStart
629+ char noteStart
630+ manyTill (noneOf " \t\n") (char labelEnd))
609631
610632noteRef = try (do
611− ref <- noteMarker
612− state <- getState
613− let identifiers = (stateNoteIdentifiers state) ++ [ref]
614− updateState (\st -> st {stateNoteIdentifiers = identifiers})
615− return (NoteRef (show (length identifiers))))
633+ ref <- noteMarker
634+ state <- getState
635+ let identifiers = (stateNoteIdentifiers state) ++ [ref]
636+ updateState (\st -> st {stateNoteIdentifiers = identifiers})
637+ return (NoteRef (show (length identifiers))))
616638
617639inlineNote = try (do
618− char noteStart
619− char labelStart
620− contents <- manyTill inline (char labelEnd)
621− state <- getState
622− let identifiers = stateNoteIdentifiers state
623− let ref = show $ (length identifiers) + 1
624− let noteBlocks = stateNoteBlocks state
625− updateState (\st -> st {stateNoteIdentifiers = (identifiers ++ [ref]),
626− stateNoteBlocks = (Note ref [Para contents]):noteBlocks})
627− return (NoteRef ref))
640+ char noteStart
641+ char labelStart
642+ contents <- manyTill inline (char labelEnd)
643+ state <- getState
644+ let identifiers = stateNoteIdentifiers state
645+ let ref = show $ (length identifiers) + 1
646+ let noteBlocks = stateNoteBlocks state
647+ updateState (\st -> st {stateNoteIdentifiers = (identifiers ++ [ref]),
648+ stateNoteBlocks =
649+ (Note ref [Para contents]):noteBlocks})
650+ return (NoteRef ref))
628651
src/Text/Pandoc/Readers/RST.hs+325−306
@@ -1,4 +1,14 @@
1−-- | Parse reStructuredText and return Pandoc document.
1+{- |
2+ Module : Text.Pandoc.Readers.RST
3+ Copyright : Copyright (C) 2006 John MacFarlane
4+ License : GNU GPL, version 2 or above
5+
6+ Maintainer : John MacFarlane <jgm at berkeley dot edu>
7+ Stability : unstable
8+ Portability : portable
9+
10+Conversion from reStructuredText to 'Pandoc' document.
11+-}
212module Text.Pandoc.Readers.RST (
313 readRST
414 ) where
@@ -61,16 +71,14 @@ promoteHeaders num [] = []
6171-- promote all the other headers.
6272titleTransform :: [Block] -- ^ list of blocks
6373 -> ([Block], [Inline]) -- ^ modified list of blocks, title
64−titleTransform ((Header 1 head1):(Header 2 head2):rest) = -- title and subtitle
65− if (any isHeader1 rest) || (any isHeader2 rest) then
66− ((Header 1 head1):(Header 2 head2):rest, [])
67− else
68− ((promoteHeaders 2 rest), head1 ++ [Str ":", Space] ++ head2)
74+titleTransform ((Header 1 head1):(Header 2 head2):rest) = -- title subtitle
75+ if (any isHeader1 rest) || (any isHeader2 rest)
76+ then ((Header 1 head1):(Header 2 head2):rest, [])
77+ else ((promoteHeaders 2 rest), head1 ++ [Str ":", Space] ++ head2)
6978titleTransform ((Header 1 head1):rest) = -- title, no subtitle
70− if (any isHeader1 rest) then
71− ((Header 1 head1):rest, [])
72− else
73− ((promoteHeaders 1 rest), head1)
79+ if (any isHeader1 rest)
80+ then ((Header 1 head1):rest, [])
81+ else ((promoteHeaders 1 rest), head1)
7482titleTransform blocks = (blocks, [])
7583
7684parseRST = do
@@ -78,17 +86,18 @@ parseRST = do
7886 input <- getInput
7987 blocks <- parseBlocks -- first pass
8088 let anonymousKeys = filter isAnonKeyBlock blocks
81− let blocks' = if (null anonymousKeys) then
82− blocks
83− else -- run parser again to fill in anonymous links...
84− case runParser parseBlocks (state { stateKeyBlocks = anonymousKeys })
89+ let blocks' = if (null anonymousKeys)
90+ then blocks
91+ else -- run parser again to fill in anonymous links...
92+ case runParser parseBlocks
93+ (state { stateKeyBlocks = anonymousKeys })
8594 "RST source, second pass" input of
86− Left err -> error $ "\nError:\n" ++ show err
87− Right result -> (filter isNotAnonKeyBlock result)
88− let (blocks'', title) = if stateStandalone state then
89− titleTransform blocks'
90− else
91− (blocks', [])
95+ Left err -> error $ "\nError:\n" ++ show err
96+ Right result ->
97+ (filter isNotAnonKeyBlock result)
98+ let (blocks'', title) = if stateStandalone state
99+ then titleTransform blocks'
100+ else (blocks', [])
92101 state <- getState
93102 let authors = stateAuthors state
94103 let date = stateDate state
@@ -103,9 +112,10 @@ parseBlocks = do
103112 result <- manyTill block eof
104113 return result
105114
106−block = choice [ codeBlock, rawHtmlBlock, rawLaTeXBlock, blockQuote, referenceKey,
107− imageBlock, unknownDirective, header, hrule, list, fieldList, lineBlock,
108− para, plain, blankBlock, nullBlock ] <?> "block"
115+block = choice [ codeBlock, rawHtmlBlock, rawLaTeXBlock, blockQuote,
116+ referenceKey, imageBlock, unknownDirective, header,
117+ hrule, list, fieldList, lineBlock, para, plain,
118+ blankBlock, nullBlock ] <?> "block"
109119
110120--
111121-- field list
@@ -117,28 +127,32 @@ fieldListItem = try (do
117127 string ": "
118128 skipSpaces
119129 first <- manyTill anyChar newline
120− rest <- many (do{ notFollowedBy (char ':');
121− notFollowedBy blankline;
122− skipSpaces;
123− manyTill anyChar newline })
130+ rest <- many (do
131+ notFollowedBy (char ':')
132+ notFollowedBy blankline
133+ skipSpaces
134+ manyTill anyChar newline )
124135 return (name, (joinWithSep " " (first:rest))))
125136
126137fieldList = try (do
127138 items <- many1 fieldListItem
128139 blanklines
129140 let authors = case (lookup "Authors" items) of
130− Just auth -> [auth]
131− Nothing -> map snd (filter (\(x,y) -> x == "Author") items)
141+ Just auth -> [auth]
142+ Nothing -> map snd (filter (\(x,y) -> x == "Author") items)
132143 let date = case (lookup "Date" items) of
133− Just dat -> dat
134− Nothing -> ""
144+ Just dat -> dat
145+ Nothing -> ""
135146 let title = case (lookup "Title" items) of
136− Just tit -> [Str tit]
137− Nothing -> []
138− let remaining = filter (\(x,y) -> (x /= "Authors") && (x /= "Author") && (x /= "Date") &&
139− (x /= "Title")) items
140− let result = map (\(x,y) -> Para [Strong [Str x], Str ":", Space, Str y]) remaining
141− updateState (\st -> st { stateAuthors = authors, stateDate = date, stateTitle = title })
147+ Just tit -> [Str tit]
148+ Nothing -> []
149+ let remaining = filter (\(x,y) -> (x /= "Authors") && (x /= "Author") &&
150+ (x /= "Date") && (x /= "Title")) items
151+ let result = map (\(x,y) ->
152+ Para [Strong [Str x], Str ":", Space, Str y]) remaining
153+ updateState (\st -> st { stateAuthors = authors,
154+ stateDate = date,
155+ stateTitle = title })
142156 return (BlockQuote result))
143157
144158--
@@ -164,18 +178,17 @@ lineBlock = try (do
164178para = choice [ paraBeforeCodeBlock, paraNormal ] <?> "paragraph"
165179
166180codeBlockStart = try (do
167− string "::"
168− blankline
169− blankline)
181+ string "::"
182+ blankline
183+ blankline)
170184
171185-- paragraph that ends in a :: starting a code block
172186paraBeforeCodeBlock = try (do
173187 result <- many1 (do {notFollowedBy' codeBlockStart; inline})
174188 followedBy' (string "::")
175− return (Para (if (last result == Space) then
176− normalizeSpaces result
177− else
178− (normalizeSpaces result) ++ [Str ":"])))
189+ return (Para (if (last result == Space)
190+ then normalizeSpaces result
191+ else (normalizeSpaces result) ++ [Str ":"])))
179192
180193-- regular paragraph
181194paraNormal = try (do
@@ -195,9 +208,9 @@ plain = do
195208--
196209
197210imageBlock = try (do
198− string ".. image:: "
199− src <- manyTill anyChar newline
200− return (Plain [Image [Str "image"] (Src src "")]))
211+ string ".. image:: "
212+ src <- manyTill anyChar newline
213+ return (Plain [Image [Str "image"] (Src src "")]))
201214
202215--
203216-- header blocks
@@ -207,59 +220,58 @@ header = choice [ doubleHeader, singleHeader ] <?> "header"
207220
208221-- a header with lines on top and bottom
209222doubleHeader = try (do
210− c <- oneOf underlineChars
211− rest <- many (char c) -- the top line
212− let lenTop = length (c:rest)
213− skipSpaces
214− newline
215− txt <- many1 (do {notFollowedBy blankline; inline})
216− pos <- getPosition
217− let len = (sourceColumn pos) - 1
218− if (len > lenTop) then fail "title longer than border" else (do {return ()})
219− blankline -- spaces and newline
220− count lenTop (char c) -- the bottom line
221− blanklines
222− -- check to see if we've had this kind of header before.
223− -- if so, get appropriate level. if not, add to list.
224− state <- getState
225− let headerTable = stateHeaderTable state
226− let (headerTable', level) = case findIndex (== DoubleHeader c) headerTable of
227− Just ind -> (headerTable, ind + 1)
228− Nothing -> (headerTable ++ [DoubleHeader c], (length headerTable) + 1)
229− setState (state { stateHeaderTable = headerTable' })
230− return (Header level (normalizeSpaces txt)))
223+ c <- oneOf underlineChars
224+ rest <- many (char c) -- the top line
225+ let lenTop = length (c:rest)
226+ skipSpaces
227+ newline
228+ txt <- many1 (do {notFollowedBy blankline; inline})
229+ pos <- getPosition
230+ let len = (sourceColumn pos) - 1
231+ if (len > lenTop) then fail "title longer than border" else (do {return ()})
232+ blankline -- spaces and newline
233+ count lenTop (char c) -- the bottom line
234+ blanklines
235+ -- check to see if we've had this kind of header before.
236+ -- if so, get appropriate level. if not, add to list.
237+ state <- getState
238+ let headerTable = stateHeaderTable state
239+ let (headerTable',level) = case findIndex (== DoubleHeader c) headerTable of
240+ Just ind -> (headerTable, ind + 1)
241+ Nothing -> (headerTable ++ [DoubleHeader c], (length headerTable) + 1)
242+ setState (state { stateHeaderTable = headerTable' })
243+ return (Header level (normalizeSpaces txt)))
231244
232245-- a header with line on the bottom only
233246singleHeader = try (do
234− notFollowedBy' whitespace
235− txt <- many1 (do {notFollowedBy blankline; inline})
236− pos <- getPosition
237− let len = (sourceColumn pos) - 1
238− blankline
239− c <- oneOf underlineChars
240− rest <- count (len - 1) (char c)
241− many (char c)
242− blanklines
243− state <- getState
244− let headerTable = stateHeaderTable state
245− let (headerTable', level) = case findIndex (== SingleHeader c) headerTable of
246− Just ind -> (headerTable, ind + 1)
247− Nothing -> (headerTable ++ [SingleHeader c], (length headerTable) + 1)
248− setState (state { stateHeaderTable = headerTable' })
249− return (Header level (normalizeSpaces txt)))
247+ notFollowedBy' whitespace
248+ txt <- many1 (do {notFollowedBy blankline; inline})
249+ pos <- getPosition
250+ let len = (sourceColumn pos) - 1
251+ blankline
252+ c <- oneOf underlineChars
253+ rest <- count (len - 1) (char c)
254+ many (char c)
255+ blanklines
256+ state <- getState
257+ let headerTable = stateHeaderTable state
258+ let (headerTable',level) = case findIndex (== SingleHeader c) headerTable of
259+ Just ind -> (headerTable, ind + 1)
260+ Nothing -> (headerTable ++ [SingleHeader c], (length headerTable) + 1)
261+ setState (state { stateHeaderTable = headerTable' })
262+ return (Header level (normalizeSpaces txt)))
250263
251264--
252265-- hrule block
253266--
254267
255−hruleWith chr =
256− try (do
257− count 4 (char chr)
258− skipMany (char chr)
259− skipSpaces
260− newline
261− blanklines
262− return HorizontalRule)
268+hruleWith chr = try (do
269+ count 4 (char chr)
270+ skipMany (char chr)
271+ skipSpaces
272+ newline
273+ blanklines
274+ return HorizontalRule)
263275
264276hrule = choice (map hruleWith underlineChars) <?> "hrule"
265277
@@ -269,9 +281,9 @@ hrule = choice (map hruleWith underlineChars) <?> "hrule"
269281
270282-- read a line indented by a given string
271283indentedLine indents = try (do
272− string indents
273− result <- manyTill anyChar newline
274− return (result ++ "\n"))
284+ string indents
285+ result <- manyTill anyChar newline
286+ return (result ++ "\n"))
275287
276288-- two or more indented lines, possibly separated by blank lines
277289-- if variable = True, then any indent will work, but it must be consistent through the block
@@ -279,54 +291,59 @@ indentedLine indents = try (do
279291indentedBlock variable = try (do
280292 state <- getState
281293 let tabStop = stateTabStop state
282− indents <- if variable then
283− many1 (oneOf " \t")
284− else
285− oneOfStrings ["\t", (replicate tabStop ' ')]
294+ indents <- if variable
295+ then many1 (oneOf " \t")
296+ else oneOfStrings ["\t", (replicate tabStop ' ')]
286297 firstline <- manyTill anyChar newline
287298 rest <- many (choice [ indentedLine indents,
288− try (do {b <- blanklines; l <- indentedLine indents; return (b ++ l)})])
299+ try (do
300+ b <- blanklines
301+ l <- indentedLine indents
302+ return (b ++ l))])
289303 option "" blanklines
290304 return (firstline ++ "\n" ++ (concat rest)))
291305
292306codeBlock = try (do
293− codeBlockStart
294− result <- indentedBlock False -- the False means we want one tab stop indent on each line
295− return (CodeBlock (stripTrailingNewlines result)))
307+ codeBlockStart
308+ result <- indentedBlock False
309+ -- the False means we want one tab stop indent on each line
310+ return (CodeBlock (stripTrailingNewlines result)))
296311
297312--
298313-- raw html
299314--
300315
301316rawHtmlBlock = try (do
302− string ".. raw:: html"
303− blanklines
304− result <- indentedBlock True
305− return (RawHtml result))
317+ string ".. raw:: html"
318+ blanklines
319+ result <- indentedBlock True
320+ return (RawHtml result))
306321
307322--
308323-- raw latex
309324--
310325
311326rawLaTeXBlock = try (do
312− string ".. raw:: latex"
313− blanklines
314− result <- indentedBlock True
315− return (Para [(TeX result)]))
327+ string ".. raw:: latex"
328+ blanklines
329+ result <- indentedBlock True
330+ return (Para [(TeX result)]))
316331
317332--
318333-- block quotes
319334--
320335
321336blockQuote = try (do
322− block <- indentedBlock True
323− -- parse the extracted block, which may contain various block elements:
324− state <- getState
325− let parsed = case runParser parseBlocks (state {stateParserContext = BlockQuoteState})
326− "block" (block ++ "\n\n") of
327− Left err -> error $ "Raw block:\n" ++ show block ++ "\nError:\n" ++ show err
328− Right result -> result
329− return (BlockQuote parsed))
337+ block <- indentedBlock True
338+ -- parse the extracted block, which may contain various block elements:
339+ state <- getState
340+ let parsed = case runParser parseBlocks
341+ (state {stateParserContext = BlockQuoteState})
342+ "block" (block ++ "\n\n") of
343+ Left err -> error $ "Raw block:\n" ++ show block ++
344+ "\nError:\n" ++ show err
345+ Right result -> result
346+ return (BlockQuote parsed))
330347
331348--
332349-- list blocks
@@ -335,34 +352,36 @@ blockQuote = try (do
335352list = choice [ bulletList, orderedList ] <?> "list"
336353
337354-- parses bullet list start and returns its length (inc. following whitespace)
338−bulletListStart =
339− try (do
340− notFollowedBy' hrule -- because hrules start out just like lists
341− marker <- oneOf bulletListMarkers
342− white <- many1 spaceChar
343− let len = length (marker:white)
344− return len)
355+bulletListStart = try (do
356+ notFollowedBy' hrule -- because hrules start out just like lists
357+ marker <- oneOf bulletListMarkers
358+ white <- many1 spaceChar
359+ let len = length (marker:white)
360+ return len)
345361
346362withPeriodSuffix parser = try (do
347− a <- parser
348− b <- char '.'
349− return (a ++ [b]))
363+ a <- parser
364+ b <- char '.'
365+ return (a ++ [b]))
350366
351367withParentheses parser = try (do
352− a <- char '('
353− b <- parser
354− c <- char ')'
355− return ([a] ++ b ++ [c]))
368+ a <- char '('
369+ b <- parser
370+ c <- char ')'
371+ return ([a] ++ b ++ [c]))
356372
357373withRightParen parser = try (do
358− a <- parser
359− b <- char ')'
360− return (a ++ [b]))
374+ a <- parser
375+ b <- char ')'
376+ return (a ++ [b]))
361377
362378upcaseWord = map toUpper
363379
364380romanNumeral = do
365− let lowerNumerals = ["i", "ii", "iii", "iiii", "iv", "v", "vi", "vii", "viii", "ix", "x", "xi", "xii", "xiii", "xiv", "xv", "xvi", "xvii", "xviii", "xix", "xx", "xxi", "xxii", "xxiii", "xxiv" ]
381+ let lowerNumerals = ["i", "ii", "iii", "iiii", "iv", "v", "vi",
382+ "vii", "viii", "ix", "x", "xi", "xii", "xiii",
383+ "xiv", "xv", "xvi", "xvii", "xviii", "xix", "xx",
384+ "xxi", "xxii", "xxiii", "xxiv" ]
366385 let upperNumerals = map upcaseWord lowerNumerals
367386 result <- choice $ map string (lowerNumerals ++ upperNumerals)
368387 return result
@@ -372,15 +391,14 @@ orderedListEnumerator = choice [ many1 digit,
372391 count 1 letter,
373392 romanNumeral ]
374393
375−-- parses ordered list start and returns its length (inc. following whitespace)
376−orderedListStart =
377− try (do
378− marker <- choice [ withPeriodSuffix orderedListEnumerator,
379− withParentheses orderedListEnumerator,
380− withRightParen orderedListEnumerator ]
381− white <- many1 spaceChar
382− let len = length (marker ++ white)
383− return len)
394+-- parses ordered list start and returns its length (inc following whitespace)
395+orderedListStart = try (do
396+ marker <- choice [ withPeriodSuffix orderedListEnumerator,
397+ withParentheses orderedListEnumerator,
398+ withRightParen orderedListEnumerator ]
399+ white <- many1 spaceChar
400+ let len = length (marker ++ white)
401+ return len)
384402
385403-- parse a line of a list item
386404listLine markerLength = try (do
@@ -393,72 +411,73 @@ listLine markerLength = try (do
393411indentWith num = do
394412 state <- getState
395413 let tabStop = stateTabStop state
396− if (num < tabStop) then
397− count num (char ' ')
398− else
399− choice [ try (count num (char ' ')),
400− (try (do {char '\t'; count (num - tabStop) (char ' ')})) ]
414+ if (num < tabStop)
415+ then count num (char ' ')
416+ else choice [ try (count num (char ' ')),
417+ (try (do {char '\t'; count (num - tabStop) (char ' ')})) ]
401418
402419-- parse raw text for one list item, excluding start marker and continuations
403−rawListItem start =
404− try (do
405− markerLength <- start
406− firstLine <- manyTill anyChar newline
407− restLines <- many (listLine markerLength)
408− return (markerLength, (firstLine ++ "\n" ++ (concat restLines))))
409−
410−-- continuation of a list item - indented and separated by blankline or (in compact lists)
411−-- endline. Note: nested lists are parsed as continuations.
412−listContinuation markerLength =
413− try (do
414− blanks <- many1 blankline
415− result <- many1 (listLine markerLength)
416− return (blanks ++ (concat result)))
417−
418−listItem start =
419− try (do
420− (markerLength, first) <- rawListItem start
421− rest <- many (listContinuation markerLength)
422− blanks <- choice [ try (do {b <- many blankline; followedBy' start; return b}),
423− many1 blankline ] -- whole list must end with blank
424− -- parsing with ListItemState forces markers at beginning of lines to
425− -- count as list item markers, even if not separated by blank space.
426− -- see definition of "endline"
427− state <- getState
428− let parsed = case runParser parseBlocks (state {stateParserContext = ListItemState})
429− "list item" raw of
430− Left err -> error $ "Raw:\n" ++ raw ++ "\nError:\n" ++ show err
431− Right result -> result
432− where raw = concat (first:rest) ++ blanks
433− return parsed)
434−
435−orderedList =
436− try (do
437− items <- many1 (listItem orderedListStart)
438− let items' = compactify items
439− return (OrderedList items'))
440−
441−bulletList =
442− try (do
443− items <- many1 (listItem bulletListStart)
444− let items' = compactify items
445− return (BulletList items'))
420+rawListItem start = try (do
421+ markerLength <- start
422+ firstLine <- manyTill anyChar newline
423+ restLines <- many (listLine markerLength)
424+ return (markerLength, (firstLine ++ "\n" ++ (concat restLines))))
425+
426+-- continuation of a list item - indented and separated by blankline or
427+-- (in compact lists) endline.
428+-- Note: nested lists are parsed as continuations.
429+listContinuation markerLength = try (do
430+ blanks <- many1 blankline
431+ result <- many1 (listLine markerLength)
432+ return (blanks ++ (concat result)))
433+
434+listItem start = try (do
435+ (markerLength, first) <- rawListItem start
436+ rest <- many (listContinuation markerLength)
437+ blanks <- choice [ try (do
438+ b <- many blankline
439+ followedBy' start
440+ return b),
441+ many1 blankline ] -- whole list must end with blank
442+ -- parsing with ListItemState forces markers at beginning of lines to
443+ -- count as list item markers, even if not separated by blank space.
444+ -- see definition of "endline"
445+ state <- getState
446+ let parsed = case runParser parseBlocks
447+ (state {stateParserContext = ListItemState}) "list item"
448+ raw of
449+ Left err -> error $ "Raw:\n" ++ raw ++
450+ "\nError:\n" ++ show err
451+ Right result -> result
452+ where raw = concat (first:rest) ++ blanks
453+ return parsed)
454+
455+orderedList = try (do
456+ items <- many1 (listItem orderedListStart)
457+ let items' = compactify items
458+ return (OrderedList items'))
459+
460+bulletList = try (do
461+ items <- many1 (listItem bulletListStart)
462+ let items' = compactify items
463+ return (BulletList items'))
446464
447465--
448466-- unknown directive (e.g. comment)
449467--
450468
451469unknownDirective = try (do
452− string ".. "
453− manyTill anyChar newline
454− many (do {string " ";
455− char ':';
456− many1 (noneOf "\n:");
457− char ':';
458− many1 (noneOf "\n");
459− newline})
460− option "" blanklines
461− return Null)
470+ string ".. "
471+ manyTill anyChar newline
472+ many (do
473+ string " "
474+ char ':'
475+ many1 (noneOf "\n:")
476+ char ':'
477+ many1 (noneOf "\n")
478+ newline)
479+ option "" blanklines
480+ return Null)
462481
463482--
464483-- reference key
@@ -467,39 +486,43 @@ unknownDirective = try (do
467486referenceKey = choice [imageKey, anonymousKey, regularKeyQuoted, regularKey]
468487
469488imageKey = try (do
470− string ".. |"
471− ref <- manyTill inline (char '|')
472− skipSpaces
473− string "image::"
474− src <- manyTill anyChar newline
475− return (Key (normalizeSpaces ref) (Src (removeLeadingTrailingSpace src) "")))
489+ string ".. |"
490+ ref <- manyTill inline (char '|')
491+ skipSpaces
492+ string "image::"
493+ src <- manyTill anyChar newline
494+ return (Key (normalizeSpaces ref)
495+ (Src (removeLeadingTrailingSpace src) "")))
476496
477497anonymousKey = try (do
478− choice [string ".. __:", string "__"]
479− skipSpaces
480− src <- manyTill anyChar newline
481− state <- getState
482− return (Key [Str "_"] (Src (removeLeadingTrailingSpace src) "")))
498+ choice [string ".. __:", string "__"]
499+ skipSpaces
500+ src <- manyTill anyChar newline
501+ state <- getState
502+ return (Key [Str "_"] (Src (removeLeadingTrailingSpace src) "")))
483503
484504regularKeyQuoted = try (do
485− string ".. _`"
486− ref <- manyTill inline (string "`:")
487− skipSpaces
488− src <- manyTill anyChar newline
489− return (Key (normalizeSpaces ref) (Src (removeLeadingTrailingSpace src) "")))
505+ string ".. _`"
506+ ref <- manyTill inline (string "`:")
507+ skipSpaces
508+ src <- manyTill anyChar newline
509+ return (Key (normalizeSpaces ref)
510+ (Src (removeLeadingTrailingSpace src) "")))
490511
491512regularKey = try (do
492− string ".. _"
493− ref <- manyTill inline (char ':')
494− skipSpaces
495− src <- manyTill anyChar newline
496− return (Key (normalizeSpaces ref) (Src (removeLeadingTrailingSpace src) "")))
513+ string ".. _"
514+ ref <- manyTill inline (char ':')
515+ skipSpaces
516+ src <- manyTill anyChar newline
517+ return (Key (normalizeSpaces ref)
518+ (Src (removeLeadingTrailingSpace src) "")))
497519
498520 --
499521 -- inline
500522 --
501523
502−text = choice [ strong, emph, code, str, tabchar, whitespace, endline ] <?> "text"
524+text = choice [ strong, emph, code, str, tabchar, whitespace,
525+ endline ] <?> "text"
503526
504527inline = choice [ escapedChar, special, hyphens, text, symbol ] <?> "inline"
505528
@@ -507,7 +530,8 @@ special = choice [ link, image ] <?> "link, inline html, or image"
507530
508531hyphens = try (do
509532 result <- many1 (char '-')
510− option Space endline -- don't want to treat endline after hyphen or dash as a space
533+ option Space endline
534+ -- don't want to treat endline after hyphen or dash as a space
511535 return (Str result))
512536
513537escapedChar = escaped anyChar
@@ -517,12 +541,11 @@ symbol = do
517541 return (Str [result])
518542
519543-- parses inline code, between codeStart and codeEnd
520−code =
521− try (do
522− string "``"
523− result <- manyTill anyChar (string "``")
524− let result' = removeLeadingTrailingSpace $ joinWithSep " " $ lines result
525− return (Code result'))
544+code = try (do
545+ string "``"
546+ result <- manyTill anyChar (string "``")
547+ let result' = removeLeadingTrailingSpace $ joinWithSep " " $ lines result
548+ return (Code result'))
526549
527550emph = do
528551 result <- enclosed (char '*') (char '*') inline
@@ -546,99 +569,95 @@ str = do
546569 return (Str result)
547570
548571-- an endline character that can be treated as a space, not a structural break
549−endline =
550− try (do
551− newline
552− notFollowedBy blankline
553− -- parse potential list starts at beginning of line differently if in a list:
554− st <- getState
555− if ((stateParserContext st) == ListItemState) then
556− notFollowedBy' (choice [orderedListStart, bulletListStart])
557− else
558− option () pzero
559− return Space)
572+endline = try (do
573+ newline
574+ notFollowedBy blankline
575+ -- parse potential list-starts at beginning of line differently in a list:
576+ st <- getState
577+ if ((stateParserContext st) == ListItemState)
578+ then notFollowedBy' (choice [orderedListStart, bulletListStart])
579+ else option () pzero
580+ return Space)
560581
561582--
562583-- links
563584--
564585
565−link = choice [explicitLink, referenceLink, autoLink, oneWordReferenceLink] <?> "link"
566−
567−explicitLink =
568− try (do
569− char '`'
570− label <- manyTill inline (try (do {spaces; char '<'}))
571− src <- manyTill (noneOf ">\n ") (char '>')
572− skipSpaces
573− string "`_"
574− return (Link (normalizeSpaces label) (Src (removeLeadingTrailingSpace src) "")))
575−
576−anonymousLinkEnding =
577− try (do
578− char '_'
579− state <- getState
580− let anonKeys = stateKeyBlocks state
581− -- if there's a list of anon key refs (from previous pass), pop one off.
582− -- otherwise return an anon key ref for the next pass to take care of...
583− case anonKeys of
584− (Key [Str "_"] src):rest ->
585− do{ setState (state { stateKeyBlocks = rest });
586− return src }
587− otherwise -> return (Ref [Str "_"]))
588−
589−referenceLink =
590− try (do
591− char '`'
592− label <- manyTill inline (string "`_")
593− src <- option (Ref []) anonymousLinkEnding
594− return (Link (normalizeSpaces label) src))
595−
596−oneWordReferenceLink =
597− try (do
598− label <- many1 alphaNum
599− char '_'
600− src <- option (Ref []) anonymousLinkEnding
601− notFollowedBy alphaNum -- because this_is_not a link
602− return (Link [Str label] src))
603−
604−uriScheme = oneOfStrings [ "http://", "https://", "ftp://", "file://", "mailto:",
605− "news:", "telnet:" ]
586+link = choice [explicitLink, referenceLink, autoLink,
587+ oneWordReferenceLink] <?> "link"
588+
589+explicitLink = try (do
590+ char '`'
591+ label <- manyTill inline (try (do {spaces; char '<'}))
592+ src <- manyTill (noneOf ">\n ") (char '>')
593+ skipSpaces
594+ string "`_"
595+ return (Link (normalizeSpaces label)
596+ (Src (removeLeadingTrailingSpace src) "")))
597+
598+anonymousLinkEnding = try (do
599+ char '_'
600+ state <- getState
601+ let anonKeys = stateKeyBlocks state
602+ -- if there's a list of anon key refs (from previous pass), pop one off.
603+ -- otherwise return an anon key ref for the next pass to take care of...
604+ case anonKeys of
605+ (Key [Str "_"] src):rest ->
606+ do
607+ setState (state { stateKeyBlocks = rest })
608+ return src
609+ otherwise -> return (Ref [Str "_"]))
610+
611+referenceLink = try (do
612+ char '`'
613+ label <- manyTill inline (string "`_")
614+ src <- option (Ref []) anonymousLinkEnding
615+ return (Link (normalizeSpaces label) src))
616+
617+oneWordReferenceLink = try (do
618+ label <- many1 alphaNum
619+ char '_'
620+ src <- option (Ref []) anonymousLinkEnding
621+ notFollowedBy alphaNum -- because this_is_not a link
622+ return (Link [Str label] src))
623+
624+uriScheme = oneOfStrings [ "http://", "https://", "ftp://", "file://",
625+ "mailto:", "news:", "telnet:" ]
606626
607627uri = try (do
608− scheme <- uriScheme
609− identifier <- many1 (noneOf " \t\n")
610− return (scheme ++ identifier))
628+ scheme <- uriScheme
629+ identifier <- many1 (noneOf " \t\n")
630+ return (scheme ++ identifier))
611631
612632autoURI = try (do
613− src <- uri
614− return (Link [Str src] (Src src "")))
633+ src <- uri
634+ return (Link [Str src] (Src src "")))
615635
616636emailChar = alphaNum <|> oneOf "-+_."
617637
618638emailAddress = try (do
619− firstLetter <- alphaNum
620− restAddr <- many emailChar
621− let addr = firstLetter:restAddr
622− char '@'
623− dom <- domain
624− return (addr ++ '@':dom))
639+ firstLetter <- alphaNum
640+ restAddr <- many emailChar
641+ let addr = firstLetter:restAddr
642+ char '@'
643+ dom <- domain
644+ return (addr ++ '@':dom))
625645
626646domainChar = alphaNum <|> char '-'
627647
628648domain = try (do
629− first <- many1 domainChar
630− dom <- many1 (try (do{ char '.'; many1 domainChar }))
631− return (joinWithSep "." (first:dom)))
649+ first <- many1 domainChar
650+ dom <- many1 (try (do{ char '.'; many1 domainChar }))
651+ return (joinWithSep "." (first:dom)))
632652
633653autoEmail = try (do
634− src <- emailAddress
635− return (Link [Str src] (Src ("mailto:" ++ src) "")))
654+ src <- emailAddress
655+ return (Link [Str src] (Src ("mailto:" ++ src) "")))
636656
637657autoLink = autoURI <|> autoEmail
638658
639659-- For now, we assume that all substitution references are for images.
640−image =
641− try (do
642− char '|'
643− ref <- manyTill inline (char '|')
644− return (Image (normalizeSpaces ref) (Ref ref)))
660+image = try (do
661+ char '|'
662+ ref <- manyTill inline (char '|')
663+ return (Image (normalizeSpaces ref) (Ref ref)))
src/Text/Pandoc/Shared.hs+163−104
@@ -1,4 +1,14 @@
1−-- | Utility functions and definitions used by the various Pandoc modules.
1+{- |
2+ Module : Text.Pandoc.Shared
3+ Copyright : Copyright (C) 2006 John MacFarlane
4+ License : GNU GPL, version 2 or above
5+
6+ Maintainer : John MacFarlane <jgm at berkeley dot edu>
7+ Stability : unstable
8+ Portability : portable
9+
10+Utility functions and definitions used by the various Pandoc modules.
11+-}
212module Text.Pandoc.Shared (
313 -- * Text processing
414 gsub,
@@ -50,17 +60,16 @@ readWith :: GenParser Char ParserState a -- ^ parser
5060 -> a
5161readWith parser state input =
5262 case runParser parser state "source" input of
53− Left err -> error $ "\nError:\n" ++ show err
63+ Left err -> error $ "\nError:\n" ++ show err
5464 Right result -> result
5565
5666-- | Parse a string with @parser@ (for testing).
5767testStringWith :: (Show a) =>
5868 GenParser Char ParserState a
59− -> String
60− -> IO ()
61−testStringWith parser str = putStrLn $ show $ readWith parser defaultParserState str
62−
63−-- | Parser state
69+ -> String
70+ -> IO ()
71+testStringWith parser str = putStrLn $ show $
72+ readWith parser defaultParserState str
6473
6574data HeaderType
6675 = SingleHeader Char -- ^ Single line of characters underneath
@@ -68,24 +77,28 @@ data HeaderType
6877 deriving (Eq, Show)
6978
7079data ParserContext
71− = BlockQuoteState -- ^ Used when running parser on contents of blockquote
72− | ListItemState -- ^ Used when running parser on list item contents
73− | NullState -- ^ Default state
80+ = BlockQuoteState -- ^ Used when running parser on contents of blockquote
81+ | ListItemState -- ^ Used when running parser on list item contents
82+ | NullState -- ^ Default state
7483 deriving (Eq, Show)
7584
7685data ParserState = ParserState
77− { stateParseRaw :: Bool, -- ^ Parse untranslatable HTML and LaTeX?
78− stateParserContext :: ParserContext, -- ^ What are we parsing?
79− stateKeyBlocks :: [Block], -- ^ List of reference key blocks
80− stateKeysUsed :: [[Inline]], -- ^ List of references used so far
81− stateNoteBlocks :: [Block], -- ^ List of note blocks
82− stateNoteIdentifiers :: [String], -- ^ List of footnote identifiers, in order encountered
83− stateTabStop :: Int, -- ^ Tab stop
84− stateStandalone :: Bool, -- ^ If @True@, parse bibliographic info
85− stateTitle :: [Inline], -- ^ Title of document
86− stateAuthors :: [String], -- ^ Authors of document
87− stateDate :: String, -- ^ Date of document
88− stateHeaderTable :: [HeaderType] -- ^ List of header types used, in what order (for reStructuredText only)
86+ { stateParseRaw :: Bool, -- ^ Parse untranslatable HTML
87+ -- and LaTeX?
88+ stateParserContext :: ParserContext, -- ^ What are we parsing?
89+ stateKeyBlocks :: [Block], -- ^ List of reference key blocks
90+ stateKeysUsed :: [[Inline]], -- ^ List of references used
91+ stateNoteBlocks :: [Block], -- ^ List of note blocks
92+ stateNoteIdentifiers :: [String], -- ^ List of footnote identifiers
93+ -- in the order encountered
94+ stateTabStop :: Int, -- ^ Tab stop
95+ stateStandalone :: Bool, -- ^ If @True@, parse
96+ -- bibliographic info
97+ stateTitle :: [Inline], -- ^ Title of document
98+ stateAuthors :: [String], -- ^ Authors of document
99+ stateDate :: String, -- ^ Date of document
100+ stateHeaderTable :: [HeaderType] -- ^ List of header types used,
101+ -- in what order (rst only)
89102 }
90103 deriving Show
91104
@@ -115,9 +128,9 @@ consolidateList (inline:rest) = inline:(consolidateList rest)
115128consolidateList [] = []
116129
117130-- | Indent string as a block.
118−indentBy :: Int -- ^ Number of spaces to indent the block
119− -> Int -- ^ Number of spaces to indent first line, relative to block
120− -> String -- ^ Contents of block to indent
131+indentBy :: Int -- ^ Number of spaces to indent the block
132+ -> Int -- ^ Number of spaces (rel to block) to indent first line
133+ -> String -- ^ Contents of block to indent
121134 -> String
122135indentBy num first [] = ""
123136indentBy num first str =
@@ -130,19 +143,27 @@ prettyBlockList :: Int -- ^ Number of spaces to indent list of blocks
130143 -> [Block] -- ^ List of blocks
131144 -> String
132145prettyBlockList indent [] = indentBy indent 0 "[]"
133−prettyBlockList indent blocks = indentBy indent (-2) $ "[ " ++ (joinWithSep "\n, " (map prettyBlock blocks)) ++ " ]"
146+prettyBlockList indent blocks = indentBy indent (-2) $ "[ " ++
147+ (joinWithSep "\n, " (map prettyBlock blocks)) ++ " ]"
134148
135149-- | Prettyprint Pandoc block element.
136150prettyBlock :: Block -> String
137−prettyBlock (BlockQuote blocks) = "BlockQuote\n " ++ (prettyBlockList 2 blocks)
138−prettyBlock (Note ref blocks) = "Note " ++ (show ref) ++ "\n " ++ (prettyBlockList 2 blocks)
139−prettyBlock (OrderedList blockLists) = "OrderedList\n" ++ indentBy 2 0 ("[ " ++ (joinWithSep ", " (map (\blocks -> prettyBlockList 2 blocks) blockLists))) ++ " ]"
140−prettyBlock (BulletList blockLists) = "BulletList\n" ++ indentBy 2 0 ("[ " ++ (joinWithSep ", " (map (\blocks -> prettyBlockList 2 blocks) blockLists))) ++ " ]"
151+prettyBlock (BlockQuote blocks) = "BlockQuote\n " ++
152+ (prettyBlockList 2 blocks)
153+prettyBlock (Note ref blocks) = "Note " ++ (show ref) ++ "\n " ++
154+ (prettyBlockList 2 blocks)
155+prettyBlock (OrderedList blockLists) =
156+ "OrderedList\n" ++ indentBy 2 0 ("[ " ++ (joinWithSep ", "
157+ (map (\blocks -> prettyBlockList 2 blocks) blockLists))) ++ " ]"
158+prettyBlock (BulletList blockLists) = "BulletList\n" ++
159+ indentBy 2 0 ("[ " ++ (joinWithSep ", "
160+ (map (\blocks -> prettyBlockList 2 blocks) blockLists))) ++ " ]"
141161prettyBlock block = show block
142162
143163-- | Prettyprint Pandoc document.
144164prettyPandoc :: Pandoc -> String
145−prettyPandoc (Pandoc meta blocks) = "Pandoc " ++ "(" ++ (show meta) ++ ")\n" ++ (prettyBlockList 0 blocks) ++ "\n"
165+prettyPandoc (Pandoc meta blocks) = "Pandoc " ++ "(" ++ (show meta) ++
166+ ")\n" ++ (prettyBlockList 0 blocks) ++ "\n"
146167
147168-- | Convert tabs to spaces (with adjustable tab stop).
148169tabsToSpaces :: Int -- ^ Tabstop
@@ -160,7 +181,9 @@ tabsInLine num tabstop "" = ""
160181tabsInLine num tabstop (c:cs) =
161182 let replacement = (if (c == '\t') then (replicate num ' ') else [c]) in
162183 let nextnumraw = (num - (length replacement)) in
163− let nextnum = if (nextnumraw < 1) then (nextnumraw + tabstop) else nextnumraw in
184+ let nextnum = if (nextnumraw < 1)
185+ then (nextnumraw + tabstop)
186+ else nextnumraw in
164187 replacement ++ (tabsInLine nextnum tabstop cs)
165188
166189-- | Substitute string for every occurrence of regular expression.
@@ -175,10 +198,9 @@ backslashEscape :: [Char] -- ^ list of special characters to escape
175198 -> String -- ^ string input
176199 -> String
177200backslashEscape special [] = []
178−backslashEscape special (x:xs) = if x `elem` special then
179− '\\':x:(backslashEscape special xs)
180− else
181− x:(backslashEscape special xs)
201+backslashEscape special (x:xs) = if x `elem` special
202+ then '\\':x:(backslashEscape special xs)
203+ else x:(backslashEscape special xs)
182204
183205-- | Escape string by applying a function, but don't touch anything that matches regex.
184206escapePreservingRegex :: (String -> String) -- ^ Escaping function
@@ -187,10 +209,9 @@ escapePreservingRegex :: (String -> String) -- ^ Escaping function
187209 -> String
188210escapePreservingRegex escapeFunction regex str =
189211 case (matchRegexAll regex str) of
190− Nothing -> escapeFunction str
191− Just (before, matched, after, _) ->
192− (escapeFunction before) ++ matched ++
193− (escapePreservingRegex escapeFunction regex after)
212+ Nothing -> escapeFunction str
213+ Just (before, matched, after, _) -> (escapeFunction before) ++
214+ matched ++ (escapePreservingRegex escapeFunction regex after)
194215
195216-- | Returns @True@ if string ends with given character.
196217endsWith :: Char -> [Char] -> Bool
@@ -213,10 +234,9 @@ joinWithSep sep lst = foldr1 (\a b -> a ++ sep ++ b) lst
213234stripTrailingNewlines :: String -> String
214235stripTrailingNewlines "" = ""
215236stripTrailingNewlines str =
216− if (last str) == '\n' then
217− stripTrailingNewlines (init str)
218− else
219− str
237+ if (last str) == '\n'
238+ then stripTrailingNewlines (init str)
239+ else str
220240
221241-- | Remove leading and trailing space (including newlines) from string.
222242removeLeadingTrailingSpace :: String -> String
@@ -224,7 +244,8 @@ removeLeadingTrailingSpace = removeLeadingSpace . removeTrailingSpace
224244
225245-- | Remove leading space (including newlines) from string.
226246removeLeadingSpace :: String -> String
227−removeLeadingSpace = dropWhile (\x -> (x == ' ') || (x == '\n') || (x == '\t'))
247+removeLeadingSpace = dropWhile (\x -> (x == ' ') || (x == '\n') ||
248+ (x == '\t'))
228249
229250-- | Remove trailing space (including newlines) from string.
230251removeTrailingSpace :: String -> String
@@ -248,12 +269,17 @@ normalizeSpaces list =
248269 removeDoubles (Space:Space:rest) = removeDoubles (Space:rest)
249270 removeDoubles (x:rest) = x:(removeDoubles rest) in
250271 let removeLeading [] = []
251− removeLeading lst = if ((head lst) == Space) then tail lst else lst in
272+ removeLeading lst = if ((head lst) == Space)
273+ then tail lst
274+ else lst in
252275 let removeTrailing [] = []
253− removeTrailing lst = if ((last lst) == Space) then init lst else lst in
276+ removeTrailing lst = if ((last lst) == Space)
277+ then init lst
278+ else lst in
254279 removeLeading $ removeTrailing $ removeDoubles list
255280
256−-- | Change final list item from @Para@ to @Plain@ if the list should be compact.
281+-- | Change final list item from @Para@ to @Plain@ if the list should
282+-- be compact.
257283compactify :: [[Block]] -- ^ List of list items (each a list of blocks)
258284 -> [[Block]]
259285compactify [] = []
@@ -261,30 +287,34 @@ compactify items =
261287 let final = last items
262288 others = init items in
263289 case final of
264− [Para a] -> if any containsPara others then items else others ++ [[Plain a]]
290+ [Para a] -> if any containsPara others
291+ then items
292+ else others ++ [[Plain a]]
265293 otherwise -> items
266294
267295containsPara :: [Block] -> Bool
268296containsPara [] = False
269297containsPara ((Para a):rest) = True
270−containsPara ((BulletList items):rest) = (any containsPara items) || (containsPara rest)
271−containsPara ((OrderedList items):rest) = (any containsPara items) || (containsPara rest)
298+containsPara ((BulletList items):rest) = (any containsPara items) ||
299+ (containsPara rest)
300+containsPara ((OrderedList items):rest) = (any containsPara items) ||
301+ (containsPara rest)
272302containsPara (x:rest) = containsPara rest
273303
274304-- | Options for writers
275305data WriterOptions = WriterOptions
276− { writerStandalone :: Bool -- ^ If @True@, writer header and footer
277− , writerTitlePrefix :: String -- ^ Prefix for HTML titles
278− , writerHeader :: String -- ^ Header for the document
279− , writerIncludeBefore :: String -- ^ String to include before the document body
280− , writerIncludeAfter :: String -- ^ String to include after the document body
281− , writerSmart :: Bool -- ^ If @True@, use smart quotes, dashes, and ellipses
282− , writerS5 :: Bool -- ^ @True@ if we're writing S5 instead of normal HTML
283− , writerIncremental :: Bool -- ^ If @True@, display S5 lists incrementally
284− , writerNumberSections :: Bool -- ^ If @True@, number sections in LaTeX
285− , writerTabStop :: Int -- ^ Tabstop for conversion between spaces and tabs
286− }
287− deriving Show
306+ { writerStandalone :: Bool -- ^ If @True@, writer header and footer
307+ , writerTitlePrefix :: String -- ^ Prefix for HTML titles
308+ , writerHeader :: String -- ^ Header for the document
309+ , writerIncludeBefore :: String -- ^ String to include before the body
310+ , writerIncludeAfter :: String -- ^ String to include after the body
311+ , writerSmart :: Bool -- ^ If @True@, use smart typography
312+ , writerS5 :: Bool -- ^ @True@ if we're writing S5
313+ , writerIncremental :: Bool -- ^ If @True@, inceremental S5 lists
314+ , writerNumberSections :: Bool -- ^ If @True@, number sections in LaTeX
315+ , writerTabStop :: Int -- ^ Tabstop for conversion between
316+ -- spaces and tabs
317+ } deriving Show
288318
289319--
290320-- Functions for constructing lists of reference keys
@@ -296,10 +326,9 @@ keyFoundIn :: [Block] -- ^ List of key blocks to search
296326 -> Target -- ^ Target to search for
297327 -> Maybe String
298328keyFoundIn [] src = Nothing
299−keyFoundIn ((Key [Str num] src1):rest) src = if (src1 == src) then
300− Just num
301− else
302− keyFoundIn rest src
329+keyFoundIn ((Key [Str num] src1):rest) src = if (src1 == src)
330+ then Just num
331+ else keyFoundIn rest src
303332keyFoundIn (_:rest) src = keyFoundIn rest src
304333
305334-- | Return next unique numerical key, given keyList
@@ -308,7 +337,7 @@ nextUniqueKey keys =
308337 let nums = [1..10000]
309338 notAKey n = not (any (== [Str (show n)]) keys) in
310339 case (find notAKey nums) of
311− Just x -> show x
340+ Just x -> show x
312341 Nothing -> error "Could not find unique key for reference link"
313342
314343-- | Generate a reference for a URL (either an existing reference, if
@@ -325,8 +354,10 @@ generateReference url title = do
325354 Just num -> return (Ref [Str num])
326355 Nothing -> do
327356 let nextNum = nextUniqueKey keysUsed
328− updateState (\st -> st {stateKeyBlocks = (Key [Str nextNum] src):keyBlocks,
329− stateKeysUsed = [Str nextNum]:keysUsed})
357+ updateState (\st -> st { stateKeyBlocks =
358+ (Key [Str nextNum] src):keyBlocks,
359+ stateKeysUsed =
360+ [Str nextNum]:keysUsed })
330361 return (Ref [Str nextNum])
331362
332363--
@@ -348,21 +379,25 @@ keyTable ((Key ref target):lst) = (((ref, target):table), rest)
348379 where (table, rest) = keyTable lst
349380keyTable (Null:lst) = keyTable lst -- get rid of Nulls
350381keyTable (Blank:lst) = keyTable lst -- get rid of Blanks
351−keyTable ((BlockQuote blocks):lst) = ((table1 ++ table2), ((BlockQuote rest1):rest2))
382+keyTable ((BlockQuote blocks):lst) = ((table1 ++ table2),
383+ ((BlockQuote rest1):rest2))
352384 where (table1, rest1) = keyTable blocks
353385 (table2, rest2) = keyTable lst
354−keyTable ((Note ref blocks):lst) = ((table1 ++ table2), ((Note ref rest1):rest2))
386+keyTable ((Note ref blocks):lst) = ((table1 ++ table2),
387+ ((Note ref rest1):rest2))
355388 where (table1, rest1) = keyTable blocks
356389 (table2, rest2) = keyTable lst
357−keyTable ((OrderedList blockLists):lst) = ((table1 ++ table2), ((OrderedList rest1):rest2))
358− where results = map keyTable blockLists
359− rest1 = map snd results
360− table1 = concatMap fst results
390+keyTable ((OrderedList blockLists):lst) = ((table1 ++ table2),
391+ ((OrderedList rest1):rest2))
392+ where results = map keyTable blockLists
393+ rest1 = map snd results
394+ table1 = concatMap fst results
361395 (table2, rest2) = keyTable lst
362−keyTable ((BulletList blockLists):lst) = ((table1 ++ table2), ((BulletList rest1):rest2))
363− where results = map keyTable blockLists
364− rest1 = map snd results
365− table1 = concatMap fst results
396+keyTable ((BulletList blockLists):lst) = ((table1 ++ table2),
397+ ((BulletList rest1):rest2))
398+ where results = map keyTable blockLists
399+ rest1 = map snd results
400+ table1 = concatMap fst results
366401 (table2, rest2) = keyTable lst
367402keyTable (other:lst) = (table, (other:rest))
368403 where (table, rest) = keyTable lst
@@ -372,55 +407,79 @@ lookupKeySrc :: KeyTable -- ^ Key table
372407 -> [Inline] -- ^ Key
373408 -> Maybe Target
374409lookupKeySrc table key = case table of
375− [] -> Nothing
376− (k, src):rest -> if (refsMatch k key) then Just src else lookupKeySrc rest key
410+ [] -> Nothing
411+ (k, src):rest -> if (refsMatch k key)
412+ then Just src
413+ else lookupKeySrc rest key
377414
378415-- | Returns @True@ if keys match (case insensitive).
379416refsMatch :: [Inline] -> [Inline] -> Bool
380−refsMatch ((Str x):restx) ((Str y):resty) = ((map toLower x) == (map toLower y)) && refsMatch restx resty
381−refsMatch ((Code x):restx) ((Code y):resty) = ((map toLower x) == (map toLower y)) && refsMatch restx resty
382−refsMatch ((TeX x):restx) ((TeX y):resty) = ((map toLower x) == (map toLower y)) && refsMatch restx resty
383−refsMatch ((HtmlInline x):restx) ((HtmlInline y):resty) = ((map toLower x) == (map toLower y)) && refsMatch restx resty
384−refsMatch ((NoteRef x):restx) ((NoteRef y):resty) = ((map toLower x) == (map toLower y)) && refsMatch restx resty
385−refsMatch ((Emph x):restx) ((Emph y):resty) = refsMatch x y && refsMatch restx resty
386−refsMatch ((Strong x):restx) ((Strong y):resty) = refsMatch x y && refsMatch restx resty
417+refsMatch ((Str x):restx) ((Str y):resty) =
418+ ((map toLower x) == (map toLower y)) && refsMatch restx resty
419+refsMatch ((Code x):restx) ((Code y):resty) =
420+ ((map toLower x) == (map toLower y)) && refsMatch restx resty
421+refsMatch ((TeX x):restx) ((TeX y):resty) =
422+ ((map toLower x) == (map toLower y)) && refsMatch restx resty
423+refsMatch ((HtmlInline x):restx) ((HtmlInline y):resty) =
424+ ((map toLower x) == (map toLower y)) && refsMatch restx resty
425+refsMatch ((NoteRef x):restx) ((NoteRef y):resty) =
426+ ((map toLower x) == (map toLower y)) && refsMatch restx resty
427+refsMatch ((Emph x):restx) ((Emph y):resty) =
428+ refsMatch x y && refsMatch restx resty
429+refsMatch ((Strong x):restx) ((Strong y):resty) =
430+ refsMatch x y && refsMatch restx resty
387431refsMatch (x:restx) (y:resty) = (x == y) && refsMatch restx resty
388432refsMatch [] x = null x
389433refsMatch x [] = null x
390434
391−-- | Replace reference links with explicit links in list of blocks, removing key blocks.
435+-- | Replace reference links with explicit links in list of blocks,
436+-- removing key blocks.
392437replaceReferenceLinks :: [Block] -> [Block]
393438replaceReferenceLinks blocks =
394439 let (keytable, purged) = keyTable blocks in
395440 replaceRefLinksBlockList keytable purged
396441
397−-- | Use key table to replace reference links with explicit links in a list of blocks
442+-- | Use key table to replace reference links with explicit links in a list
443+-- of blocks
398444replaceRefLinksBlockList :: KeyTable -> [Block] -> [Block]
399−replaceRefLinksBlockList keytable lst = map (replaceRefLinksBlock keytable) lst
445+replaceRefLinksBlockList keytable lst =
446+ map (replaceRefLinksBlock keytable) lst
400447
401448-- | Use key table to replace reference links with explicit links in a block
402449replaceRefLinksBlock :: KeyTable -> Block -> Block
403−replaceRefLinksBlock keytable (Plain lst) = Plain (map (replaceRefLinksInline keytable) lst)
404−replaceRefLinksBlock keytable (Para lst) = Para (map (replaceRefLinksInline keytable) lst)
405−replaceRefLinksBlock keytable (Header lvl lst) = Header lvl (map (replaceRefLinksInline keytable) lst)
406−replaceRefLinksBlock keytable (BlockQuote lst) = BlockQuote (map (replaceRefLinksBlock keytable) lst)
407−replaceRefLinksBlock keytable (Note ref lst) = Note ref (map (replaceRefLinksBlock keytable) lst)
408−replaceRefLinksBlock keytable (OrderedList lst) = OrderedList (map (replaceRefLinksBlockList keytable) lst)
409−replaceRefLinksBlock keytable (BulletList lst) = BulletList (map (replaceRefLinksBlockList keytable) lst)
450+replaceRefLinksBlock keytable (Plain lst) =
451+ Plain (map (replaceRefLinksInline keytable) lst)
452+replaceRefLinksBlock keytable (Para lst) =
453+ Para (map (replaceRefLinksInline keytable) lst)
454+replaceRefLinksBlock keytable (Header lvl lst) =
455+ Header lvl (map (replaceRefLinksInline keytable) lst)
456+replaceRefLinksBlock keytable (BlockQuote lst) =
457+ BlockQuote (map (replaceRefLinksBlock keytable) lst)
458+replaceRefLinksBlock keytable (Note ref lst) =
459+ Note ref (map (replaceRefLinksBlock keytable) lst)
460+replaceRefLinksBlock keytable (OrderedList lst) =
461+ OrderedList (map (replaceRefLinksBlockList keytable) lst)
462+replaceRefLinksBlock keytable (BulletList lst) =
463+ BulletList (map (replaceRefLinksBlockList keytable) lst)
410464replaceRefLinksBlock keytable other = other
411465
412−-- | Use key table to replace reference links with explicit links in an inline element.
466+-- | Use key table to replace reference links with explicit links in an
467+-- inline element.
413468replaceRefLinksInline :: KeyTable -> Inline -> Inline
414469replaceRefLinksInline keytable (Link text (Ref ref)) = (Link newText newRef)
415− where newRef = case lookupKeySrc keytable (if (null ref) then text else ref) of
470+ where newRef = case lookupKeySrc keytable
471+ (if (null ref) then text else ref) of
416472 Nothing -> (Ref ref)
417473 Just src -> src
418474 newText = map (replaceRefLinksInline keytable) text
419475replaceRefLinksInline keytable (Image text (Ref ref)) = (Image newText newRef)
420− where newRef = case lookupKeySrc keytable (if (null ref) then text else ref) of
476+ where newRef = case lookupKeySrc keytable
477+ (if (null ref) then text else ref) of
421478 Nothing -> (Ref ref)
422479 Just src -> src
423480 newText = map (replaceRefLinksInline keytable) text
424−replaceRefLinksInline keytable (Emph lst) = Emph (map (replaceRefLinksInline keytable) lst)
425−replaceRefLinksInline keytable (Strong lst) = Strong (map (replaceRefLinksInline keytable) lst)
481+replaceRefLinksInline keytable (Emph lst) =
482+ Emph (map (replaceRefLinksInline keytable) lst)
483+replaceRefLinksInline keytable (Strong lst) =
484+ Strong (map (replaceRefLinksInline keytable) lst)
426485replaceRefLinksInline keytable other = other
src/Text/Pandoc/UTF8.hs+2−1
@@ -4,7 +4,8 @@
44-- (c) 2003, OGI School of Science & Engineering, Oregon Health and
55-- Science University.
66--
7−-- Modified by Martin Norbaeck to pass illegal UTF-8 sequences through unchanged.
7+-- Modified by Martin Norbaeck
8+-- to pass illegal UTF-8 sequences through unchanged.
89module Text.Pandoc.UTF8 (
910 decodeUTF8,
1011 encodeUTF8
src/Text/Pandoc/Writers/HTML.hs+176−135
@@ -1,4 +1,14 @@
1−-- | Converts Pandoc to HTML.
1+{- |
2+ Module : Text.Pandoc.Writers.HTML
3+ Copyright : Copyright (C) 2006 John MacFarlane
4+ License : GNU GPL, version 2 or above
5+
6+ Maintainer : John MacFarlane <jgm at berkeley dot edu>
7+ Stability : unstable
8+ Portability : portable
9+
10+Conversion of 'Pandoc' documents to HTML.
11+-}
212module Text.Pandoc.Writers.HTML (
313 writeHtml
414 ) where
@@ -13,94 +23,108 @@ import Data.List ( isPrefixOf, partition )
1323-- | Convert Pandoc document to string in HTML format.
1424writeHtml :: WriterOptions -> Pandoc -> String
1525writeHtml options (Pandoc (Meta title authors date) blocks) =
16− let titlePrefix = writerTitlePrefix options in
17− let topTitle = if not (null titlePrefix) then
18− [Str titlePrefix] ++ (if not (null title) then [Str " - "] ++ title else [])
19− else
20− title in
21− let head = if (writerStandalone options) then
22− htmlHeader options (Meta topTitle authors date)
23− else
24− ""
25− titleBlocks = if (writerStandalone options) && (not (null title)) &&
26− (not (writerS5 options)) then
27− [RawHtml "<h1 class=\"title\">", Plain title, RawHtml "</h1>\n"]
28− else
29− []
30− foot = if (writerStandalone options) then "</body>\n</html>\n" else ""
31− blocks' = replaceReferenceLinks (titleBlocks ++ blocks)
32− (noteBlocks, blocks'') = partition isNoteBlock blocks'
33− body = (writerIncludeBefore options) ++
34− concatMap (blockToHtml options) blocks'' ++
35− footnoteSection options noteBlocks ++
36− (writerIncludeAfter options) in
37− head ++ body ++ foot
26+ let titlePrefix = writerTitlePrefix options in
27+ let topTitle = if not (null titlePrefix)
28+ then [Str titlePrefix] ++ (if not (null title)
29+ then [Str " - "] ++ title
30+ else [])
31+ else title in
32+ let head = if (writerStandalone options)
33+ then htmlHeader options (Meta topTitle authors date)
34+ else ""
35+ titleBlocks = if (writerStandalone options) && (not (null title)) &&
36+ (not (writerS5 options))
37+ then [RawHtml "<h1 class=\"title\">", Plain title,
38+ RawHtml "</h1>\n"]
39+ else []
40+ foot = if (writerStandalone options) then "</body>\n</html>\n" else ""
41+ blocks' = replaceReferenceLinks (titleBlocks ++ blocks)
42+ (noteBlocks, blocks'') = partition isNoteBlock blocks'
43+ body = (writerIncludeBefore options) ++
44+ concatMap (blockToHtml options) blocks'' ++
45+ footnoteSection options noteBlocks ++
46+ (writerIncludeAfter options) in
47+ head ++ body ++ foot
3848
39−-- | Convert list of Note blocks to a footnote <div>. Assumes notes are sorted.
49+-- | Convert list of Note blocks to a footnote <div>.
50+-- Assumes notes are sorted.
4051footnoteSection :: WriterOptions -> [Block] -> String
4152footnoteSection options notes =
42− if null notes
43− then ""
44− else "<div class=\"footnotes\">\n<hr />\n<ol>\n" ++
45− concatMap (blockToHtml options) notes ++
46− "</ol>\n</div>\n"
53+ if null notes
54+ then ""
55+ else "<div class=\"footnotes\">\n<hr />\n<ol>\n" ++
56+ concatMap (blockToHtml options) notes ++
57+ "</ol>\n</div>\n"
4758
4859-- | Obfuscate a "mailto:" link using Javascript.
4960obfuscateLink :: WriterOptions -> [Inline] -> String -> String
5061obfuscateLink options text src =
5162 let text' = inlineListToHtml options text in
52− let linkText = if src == ("mailto:" ++ text') then "e" else "'" ++ text' ++ "'"
53− altText = if src == ("mailto:" ++ text') then "\\1 [at] \\2" else text' ++ " (\\1 [at] \\2)" in
63+ let linkText = if src == ("mailto:" ++ text')
64+ then "e"
65+ else "'" ++ text' ++ "'"
66+ altText = if src == ("mailto:" ++ text')
67+ then "\\1 [at] \\2"
68+ else text' ++ " (\\1 [at] \\2)" in
5469 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
5570
5671-- | Obfuscate character as entity.
5772obfuscateChar :: Char -> String
58−obfuscateChar char = let num = ord char in
59− let numstr = if even num then (show num) else ("x" ++ (showHex num "")) in
60− "&#" ++ numstr ++ ";"
73+obfuscateChar char =
74+ let num = ord char in
75+ let numstr = if even num then (show num) else ("x" ++ (showHex num "")) in
76+ "&#" ++ numstr ++ ";"
6177
6278-- | Escape string, preserving character entities and quote.
6379stringToHtml :: String -> String
64−stringToHtml str = escapePreservingRegex stringToHtmlString (mkRegex "\"|(&[[:alnum:]]*;)") str
80+stringToHtml str = escapePreservingRegex stringToHtmlString
81+ (mkRegex "\"|(&[[:alnum:]]*;)") str
6582
6683-- | Escape string as in 'stringToHtml' but add smart typography filter.
6784stringToSmartHtml :: String -> String
6885stringToSmartHtml =
69− let escapeDoubleQuotes =
70− gsub "(\"|&quot;)" "&rdquo;" . -- rest are right quotes
71− gsub "(\"|&quot;)(&r[sd]quo;)" "&rdquo;\\2" . -- never left quo before right quo
72− gsub "(&l[sd]quo;)(\"|&quot;)" "\\2&ldquo;" . -- never right quo after left quo
73− gsub "([ \t])(\"|&quot;)" "\\1&ldquo;" . -- never right quo after space
74− gsub "(\"|&quot;)([^,.;:!?^) \t-])" "&ldquo;\\2" . -- "word left
75− gsub "(\"|&quot;)('|`|&lsquo;)" "&rdquo;&rsquo;" . -- right if it got through last filter
76− gsub "(\"|&quot;)('|`|&lsquo;)([^,.;:!?^) \t-])" "&ldquo;&lsquo;\\3" . -- "'word left
77− gsub "``" "&ldquo;" .
78− gsub "''" "&rdquo;"
79− escapeSingleQuotes =
80− gsub "'" "&rsquo;" . -- otherwise right
81− gsub "'(&r[sd]quo;)" "&rsquo;\\1" . -- never left quo before right quo
82− gsub "(&l[sd]quo;)'" "\\1&lsquo;" . -- never right quo after left quo
83− gsub "([ \t])'" "\\1&lsquo;" . -- never right quo after space
84− gsub "`" "&lsquo;" . -- ` is left
85− gsub "([^,.;:!?^) \t-])'" "\\1&rsquo;" . -- word' right
86− gsub "^('|`)([^,.;:!?^) \t-])" "&lsquo;\\2" . -- 'word left
87− gsub "('|`)(\"|&quot;|&ldquo;|``)" "&lsquo;&ldquo;" . -- '"word left
88− gsub "([^,.;:!?^) \t-])'(s|S)" "\\1&rsquo;\\2" . -- possessive
89− gsub "([[:space:]])'([^,.;:!?^) \t-])" "\\1&lsquo;\\2" . -- 'word left
90− gsub "'([0-9][0-9](s|S))" "&rsquo;\\1" -- '80s - decade abbrevs.
91− escapeDashes = gsub " ?-- ?" "&mdash;" .
92− gsub " ?--- ?" "&mdash;" .
93− gsub "([0-9])--?([0-9])" "\\1&ndash;\\2"
94− escapeEllipses = gsub "\\.\\.\\.|\\. \\. \\." "&hellip;" in
95− escapeSingleQuotes . escapeDoubleQuotes . escapeDashes . escapeEllipses . stringToHtml
86+ let escapeDoubleQuotes =
87+ gsub "(\"|&quot;)" "&rdquo;" . -- rest are right quotes
88+ gsub "(\"|&quot;)(&r[sd]quo;)" "&rdquo;\\2" .
89+ -- never left quo before right quo
90+ gsub "(&l[sd]quo;)(\"|&quot;)" "\\2&ldquo;" .
91+ -- never right quo after left quo
92+ gsub "([ \t])(\"|&quot;)" "\\1&ldquo;" .
93+ -- never right quo after space
94+ gsub "(\"|&quot;)([^,.;:!?^) \t-])" "&ldquo;\\2" . -- "word left
95+ gsub "(\"|&quot;)('|`|&lsquo;)" "&rdquo;&rsquo;" .
96+ -- right if it got through last filter
97+ gsub "(\"|&quot;)('|`|&lsquo;)([^,.;:!?^) \t-])" "&ldquo;&lsquo;\\3" .
98+ -- "'word left
99+ gsub "``" "&ldquo;" .
100+ gsub "''" "&rdquo;"
101+ escapeSingleQuotes =
102+ gsub "'" "&rsquo;" . -- otherwise right
103+ gsub "'(&r[sd]quo;)" "&rsquo;\\1" . -- never left quo before right quo
104+ gsub "(&l[sd]quo;)'" "\\1&lsquo;" . -- never right quo after left quo
105+ gsub "([ \t])'" "\\1&lsquo;" . -- never right quo after space
106+ gsub "`" "&lsquo;" . -- ` is left
107+ gsub "([^,.;:!?^) \t-])'" "\\1&rsquo;" . -- word' right
108+ gsub "^('|`)([^,.;:!?^) \t-])" "&lsquo;\\2" . -- 'word left
109+ gsub "('|`)(\"|&quot;|&ldquo;|``)" "&lsquo;&ldquo;" . -- '"word left
110+ gsub "([^,.;:!?^) \t-])'(s|S)" "\\1&rsquo;\\2" . -- possessive
111+ gsub "([[:space:]])'([^,.;:!?^) \t-])" "\\1&lsquo;\\2" . -- 'word left
112+ gsub "'([0-9][0-9](s|S))" "&rsquo;\\1" -- '80s - decade abbrevs.
113+ escapeDashes =
114+ gsub " ?-- ?" "&mdash;" .
115+ gsub " ?--- ?" "&mdash;" .
116+ gsub "([0-9])--?([0-9])" "\\1&ndash;\\2"
117+ escapeEllipses = gsub "\\.\\.\\.|\\. \\. \\." "&hellip;" in
118+ escapeSingleQuotes . escapeDoubleQuotes . escapeDashes .
119+ escapeEllipses . stringToHtml
96120
97121-- | Escape code string as needed for HTML.
98122codeStringToHtml :: String -> String
99123codeStringToHtml [] = []
100124codeStringToHtml (x:xs) = case x of
101− '&' -> "&amp;" ++ codeStringToHtml xs
102− '<' -> "&lt;" ++ codeStringToHtml xs
103− _ -> x:(codeStringToHtml xs)
125+ '&' -> "&amp;" ++ codeStringToHtml xs
126+ '<' -> "&lt;" ++ codeStringToHtml xs
127+ _ -> x:(codeStringToHtml xs)
104128
105129-- | Escape string to HTML appropriate for attributes
106130attributeStringToHtml :: String -> String
@@ -109,17 +133,19 @@ attributeStringToHtml = gsub "\"" "&quot;"
109133-- | Returns an HTML header with appropriate bibliographic information.
110134htmlHeader :: WriterOptions -> Meta -> String
111135htmlHeader options (Meta title authors date) =
112− let titletext = "<title>" ++ (inlineListToHtml options title) ++ "</title>\n"
113− authortext = if (null authors) then
114− ""
115− else
116− "<meta name=\"author\" content=\"" ++
117− (joinWithSep ", " (map stringToHtml authors)) ++ "\" />\n"
118− datetext = if (date == "") then
119− ""
120− else
121− "<meta name=\"date\" content=\"" ++ (stringToHtml date) ++ "\" />\n" in
122− (writerHeader options) ++ authortext ++ datetext ++ titletext ++ "</head>\n<body>\n"
136+ let titletext = "<title>" ++ (inlineListToHtml options title) ++
137+ "</title>\n"
138+ authortext = if (null authors)
139+ then ""
140+ else "<meta name=\"author\" content=\"" ++
141+ (joinWithSep ", " (map stringToHtml authors)) ++
142+ "\" />\n"
143+ datetext = if (date == "")
144+ then ""
145+ else "<meta name=\"date\" content=\"" ++
146+ (stringToHtml date) ++ "\" />\n" in
147+ (writerHeader options) ++ authortext ++ datetext ++ titletext ++
148+ "</head>\n<body>\n"
123149
124150-- | Convert Pandoc block element to HTML.
125151blockToHtml :: WriterOptions -> Block -> String
@@ -128,85 +154,100 @@ blockToHtml options Null = ""
128154blockToHtml options (Plain lst) = inlineListToHtml options lst
129155blockToHtml options (Para lst) = "<p>" ++ (inlineListToHtml options lst) ++ "</p>\n"
130156blockToHtml options (BlockQuote blocks) =
131− if (writerS5 options) then -- in S5, treat list in blockquote specially
132− -- if default is incremental, make it nonincremental; otherwise incremental
133− let inc = not (writerIncremental options) in
134− case blocks of
135− [BulletList lst] -> blockToHtml (options {writerIncremental = inc}) (BulletList lst)
136− [OrderedList lst] -> blockToHtml (options {writerIncremental = inc}) (OrderedList lst)
137− otherwise -> "<blockquote>\n" ++ (concatMap (blockToHtml options) blocks) ++
138− "</blockquote>\n"
139− else
140− "<blockquote>\n" ++ (concatMap (blockToHtml options) blocks) ++ "</blockquote>\n"
157+ if (writerS5 options)
158+ then -- in S5, treat list in blockquote specially
159+ -- if default is incremental, make it nonincremental;
160+ -- otherwise incremental
161+ let inc = not (writerIncremental options) in
162+ case blocks of
163+ [BulletList lst] -> blockToHtml (options {writerIncremental =
164+ inc}) (BulletList lst)
165+ [OrderedList lst] -> blockToHtml (options {writerIncremental =
166+ inc}) (OrderedList lst)
167+ otherwise -> "<blockquote>\n" ++
168+ (concatMap (blockToHtml options) blocks) ++
169+ "</blockquote>\n"
170+ else "<blockquote>\n" ++ (concatMap (blockToHtml options) blocks) ++
171+ "</blockquote>\n"
141172blockToHtml options (Note ref lst) =
142− let contents = (concatMap (blockToHtml options) lst) in
143− "<li id=\"fn" ++ ref ++ "\">" ++ contents ++ " <a href=\"#fnref" ++ ref ++
144− "\" class=\"footnoteBacklink\" title=\"Jump back to footnote " ++ ref ++
145− "\">&#8617;</a></li>\n"
173+ let contents = (concatMap (blockToHtml options) lst) in
174+ "<li id=\"fn" ++ ref ++ "\">" ++ contents ++ " <a href=\"#fnref" ++ ref ++
175+ "\" class=\"footnoteBacklink\" title=\"Jump back to footnote " ++ ref ++
176+ "\">&#8617;</a></li>\n"
146177blockToHtml options (Key _ _) = ""
147−blockToHtml options (CodeBlock str) = "<pre><code>" ++ (codeStringToHtml str) ++
148− "\n</code></pre>\n"
178+blockToHtml options (CodeBlock str) =
179+ "<pre><code>" ++ (codeStringToHtml str) ++ "\n</code></pre>\n"
149180blockToHtml options (RawHtml str) = str
150181blockToHtml options (BulletList lst) =
151− let attribs = if (writerIncremental options) then " class=\"incremental\"" else "" in
152− "<ul" ++ attribs ++ ">\n" ++ (concatMap (listItemToHtml options) lst) ++ "</ul>\n"
182+ let attribs = if (writerIncremental options)
183+ then " class=\"incremental\""
184+ else "" in
185+ "<ul" ++ attribs ++ ">\n" ++ (concatMap (listItemToHtml options) lst) ++
186+ "</ul>\n"
153187blockToHtml options (OrderedList lst) =
154− let attribs = if (writerIncremental options) then " class=\"incremental\"" else "" in
155− "<ol" ++ attribs ++ ">\n" ++ (concatMap (listItemToHtml options) lst) ++ "</ol>\n"
188+ let attribs = if (writerIncremental options)
189+ then " class=\"incremental\""
190+ else "" in
191+ "<ol" ++ attribs ++ ">\n" ++ (concatMap (listItemToHtml options) lst) ++
192+ "</ol>\n"
156193blockToHtml options HorizontalRule = "<hr />\n"
157194blockToHtml options (Header level lst) =
158− let contents = inlineListToHtml options lst in
159− let simplify = gsub "<[^>]*>" "" . gsub " " "_" in
160− if ((level > 0) && (level <= 6))
161− then "<a id=\"" ++ simplify contents ++ "\"></a>\n" ++
162− "<h" ++ (show level) ++ ">" ++ contents ++
163− "</h" ++ (show level) ++ ">\n"
164− else "<p>" ++ contents ++ "</p>\n"
165−listItemToHtml options list = "<li>" ++ (concatMap (blockToHtml options) list) ++ "</li>\n"
195+ let contents = inlineListToHtml options lst in
196+ let simplify = gsub "<[^>]*>" "" . gsub " " "_" in
197+ if ((level > 0) && (level <= 6))
198+ then "<a id=\"" ++ simplify contents ++ "\"></a>\n" ++
199+ "<h" ++ (show level) ++ ">" ++ contents ++
200+ "</h" ++ (show level) ++ ">\n"
201+ else "<p>" ++ contents ++ "</p>\n"
202+listItemToHtml options list =
203+ "<li>" ++ (concatMap (blockToHtml options) list) ++ "</li>\n"
166204
167205-- | Convert list of Pandoc inline elements to HTML.
168206inlineListToHtml :: WriterOptions -> [Inline] -> String
169207inlineListToHtml options lst =
170− -- consolidate adjacent Str and Space elements for more intelligent
171− -- smart typography filtering
172− let lst' = consolidateList lst in
173− concatMap (inlineToHtml options) lst'
208+ -- consolidate adjacent Str and Space elements for more intelligent
209+ -- smart typography filtering
210+ let lst' = consolidateList lst in
211+ concatMap (inlineToHtml options) lst'
174212
175213-- | Convert Pandoc inline element to HTML.
176214inlineToHtml :: WriterOptions -> Inline -> String
177−inlineToHtml options (Emph lst) = "<em>" ++ (inlineListToHtml options lst) ++ "</em>"
178−inlineToHtml options (Strong lst) = "<strong>" ++ (inlineListToHtml options lst) ++ "</strong>"
179−inlineToHtml options (Code str) = "<code>" ++ (codeStringToHtml str) ++ "</code>"
180−inlineToHtml options (Str str) = if (writerSmart options) then
181− stringToSmartHtml str
182− else
183− stringToHtml str
215+inlineToHtml options (Emph lst) =
216+ "<em>" ++ (inlineListToHtml options lst) ++ "</em>"
217+inlineToHtml options (Strong lst) =
218+ "<strong>" ++ (inlineListToHtml options lst) ++ "</strong>"
219+inlineToHtml options (Code str) =
220+ "<code>" ++ (codeStringToHtml str) ++ "</code>"
221+inlineToHtml options (Str str) =
222+ if (writerSmart options) then stringToSmartHtml str else stringToHtml str
184223inlineToHtml options (TeX str) = (codeStringToHtml str)
185224inlineToHtml options (HtmlInline str) = str
186225inlineToHtml options (LineBreak) = "<br />\n"
187226inlineToHtml options Space = " "
188227inlineToHtml options (Link text (Src src tit)) =
189− let title = attributeStringToHtml tit in
190− if (isPrefixOf "mailto:" src) then
191− obfuscateLink options text src
192− else
193− "<a href=\"" ++ (codeStringToHtml src) ++ "\"" ++
194− (if tit /= "" then " title=\"" ++ title ++ "\">" else ">") ++
195− (inlineListToHtml options text) ++ "</a>"
196−inlineToHtml options (Link text (Ref [])) = "[" ++ (inlineListToHtml options text) ++ "]"
197−inlineToHtml options (Link text (Ref ref)) = "[" ++ (inlineListToHtml options text) ++ "][" ++
198− (inlineListToHtml options ref) ++ "]" -- this is what markdown does, for better or worse
228+ let title = attributeStringToHtml tit in
229+ if (isPrefixOf "mailto:" src)
230+ then obfuscateLink options text src
231+ else "<a href=\"" ++ (codeStringToHtml src) ++ "\"" ++
232+ (if tit /= "" then " title=\"" ++ title ++ "\">" else ">") ++
233+ (inlineListToHtml options text) ++ "</a>"
234+inlineToHtml options (Link text (Ref [])) =
235+ "[" ++ (inlineListToHtml options text) ++ "]"
236+inlineToHtml options (Link text (Ref ref)) =
237+ "[" ++ (inlineListToHtml options text) ++ "][" ++
238+ (inlineListToHtml options ref) ++ "]"
239+ -- this is what markdown does, for better or worse
199240inlineToHtml options (Image alt (Src source tit)) =
200− let title = attributeStringToHtml tit
201− alternate = inlineListToHtml options alt in
202− "<img src=\"" ++ source ++ "\"" ++
203− (if tit /= "" then " title=\"" ++ title ++ "\"" else "") ++
204− (if alternate /= "" then " alt=\"" ++ alternate ++ "\"" else "") ++ ">"
241+ let title = attributeStringToHtml tit
242+ alternate = inlineListToHtml options alt in
243+ "<img src=\"" ++ source ++ "\"" ++
244+ (if tit /= "" then " title=\"" ++ title ++ "\"" else "") ++
245+ (if alternate /= "" then " alt=\"" ++ alternate ++ "\"" else "") ++ ">"
205246inlineToHtml options (Image alternate (Ref [])) =
206− "![" ++ (inlineListToHtml options alternate) ++ "]"
247+ "![" ++ (inlineListToHtml options alternate) ++ "]"
207248inlineToHtml options (Image alternate (Ref ref)) =
208− "![" ++ (inlineListToHtml options alternate) ++ "][" ++ (inlineListToHtml options ref) ++ "]"
249+ "![" ++ (inlineListToHtml options alternate) ++ "][" ++
250+ (inlineListToHtml options ref) ++ "]"
209251inlineToHtml options (NoteRef ref) =
210− "<sup class=\"footnoteRef\" id=\"fnref" ++ ref ++ "\"><a href=\"#fn" ++ ref ++
211− "\">" ++ ref ++ "</a></sup>"
212−
252+ "<sup class=\"footnoteRef\" id=\"fnref" ++ ref ++ "\"><a href=\"#fn" ++
253+ ref ++ "\">" ++ ref ++ "</a></sup>"
src/Text/Pandoc/Writers/LaTeX.hs+85−70
@@ -1,4 +1,14 @@
1−-- | Convert Pandoc to LaTeX.
1+{- |
2+ Module : Text.Pandoc.Writers.LaTeX
3+ Copyright : Copyright (C) 2006 John MacFarlane
4+ License : GNU GPL, version 2 or above
5+
6+ Maintainer : John MacFarlane <jgm at berkeley dot edu>
7+ Stability : unstable
8+ Portability : portable
9+
10+Conversion of 'Pandoc' format into LaTeX.
11+-}
212module Text.Pandoc.Writers.LaTeX (
313 writeLaTeX
414 ) where
@@ -9,46 +19,40 @@ import List ( (\\) )
919-- | Convert Pandoc to LaTeX.
1020writeLaTeX :: WriterOptions -> Pandoc -> String
1121writeLaTeX options (Pandoc meta blocks) =
12− let notes = filter isNoteBlock blocks in -- assumes all notes are at outer level
13− let body = (writerIncludeBefore options) ++
14− (concatMap (blockToLaTeX notes) (replaceReferenceLinks blocks)) ++
15− (writerIncludeAfter options) in
16− let head = if writerStandalone options then
17− latexHeader notes options meta
18− else
19− "" in
20− let foot = if writerStandalone options then "\n\\end{document}\n" else "" in
21− head ++ body ++ foot
22+ let notes = filter isNoteBlock blocks in -- assumes all notes at outer level
23+ let body = (writerIncludeBefore options) ++
24+ (concatMap (blockToLaTeX notes)
25+ (replaceReferenceLinks blocks)) ++
26+ (writerIncludeAfter options) in
27+ let head = if writerStandalone options
28+ then latexHeader notes options meta
29+ else "" in
30+ let foot = if writerStandalone options then "\n\\end{document}\n" else "" in
31+ head ++ body ++ foot
2232
2333-- | Insert bibliographic information into LaTeX header.
24−latexHeader :: [Block] -- ^ List of note blocks to use in resolving note refs
25− -> WriterOptions -- ^ Options, including LaTeX header
26− -> Meta -- ^ Meta with bibliographic information
34+latexHeader :: [Block] -- ^ List of note blocks to use in resolving note refs
35+ -> WriterOptions -- ^ Options, including LaTeX header
36+ -> Meta -- ^ Meta with bibliographic information
2737 -> String
2838latexHeader notes options (Meta title authors date) =
29− let titletext = if null title then
30− ""
31− else
32− "\\title{" ++ inlineListToLaTeX notes title ++ "}\n"
33− authorstext = if null authors then
34− ""
35− else
36− "\\author{" ++ (joinWithSep "\\\\" (map stringToLaTeX authors)) ++ "}\n"
37− datetext = if date == "" then
38− ""
39− else
40− "\\date{" ++ stringToLaTeX date ++ "}\n"
41− maketitle = if null title then
42− ""
43− else
44− "\\maketitle\n"
45− secnumline = if (writerNumberSections options) then
46− ""
47− else
48− "\\setcounter{secnumdepth}{0}\n"
49− header = writerHeader options in
50− header ++ secnumline ++ titletext ++ authorstext ++ datetext ++ "\\begin{document}\n" ++ maketitle
51−
39+ let titletext = if null title
40+ then ""
41+ else "\\title{" ++ inlineListToLaTeX notes title ++ "}\n"
42+ authorstext = if null authors
43+ then ""
44+ else "\\author{" ++ (joinWithSep "\\\\"
45+ (map stringToLaTeX authors)) ++ "}\n"
46+ datetext = if date == ""
47+ then ""
48+ else "\\date{" ++ stringToLaTeX date ++ "}\n"
49+ maketitle = if null title then "" else "\\maketitle\n"
50+ secnumline = if (writerNumberSections options)
51+ then ""
52+ else "\\setcounter{secnumdepth}{0}\n"
53+ header = writerHeader options in
54+ header ++ secnumline ++ titletext ++ authorstext ++ datetext ++
55+ "\\begin{document}\n" ++ maketitle
5256
5357-- escape things as needed for LaTeX (also ldots, dashes, quotes, etc.)
5458
@@ -77,7 +81,8 @@ escapeSingleQuotes =
7781 gsub "([^[:punct:][:space:]])`(s|S)" "\\1'\\2" . -- catch possessives
7882 gsub "^'([^[:punct:][:space:]])" "`\\1" . -- 'word left
7983 gsub "([[:space:]])'" "\\1`" . -- never right quote after space
80− gsub "([[:space:]])'([^[:punct:][:space:]])" "\\1`\\2" -- 'word left (leave possessives)
84+ gsub "([[:space:]])'([^[:punct:][:space:]])" "\\1`\\2"
85+ -- 'word left (leave possessives)
8186
8287escapeEllipses = gsub "\\.\\.\\.|\\. \\. \\." "\\ldots{}"
8388
@@ -85,12 +90,14 @@ escapeDashes = gsub "([0-9])-([0-9])" "\\1--\\2" .
8590 gsub " *--- *" "---" .
8691 gsub "([^-])--([^-])" "\\1---\\2"
8792
88−escapeSmart = escapeDashes . escapeSingleQuotes . escapeDoubleQuotes . escapeEllipses
93+escapeSmart = escapeDashes . escapeSingleQuotes . escapeDoubleQuotes .
94+ escapeEllipses
8995
9096-- | Escape string for LaTeX (including smart quotes, dashes, ellipses)
9197stringToLaTeX :: String -> String
9298stringToLaTeX = escapeSmart . escapeGt . escapeLt . escapeBar . escapeHat .
93− escapeSpecial . fixBackslash . escapeBrackets . escapeBackslash
99+ escapeSpecial . fixBackslash . escapeBrackets .
100+ escapeBackslash
94101
95102-- | Remove all code elements from list of inline elements
96103-- (because it's illegal to have a \\verb inside a command argument)
@@ -107,43 +114,47 @@ blockToLaTeX notes Blank = "\n"
107114blockToLaTeX notes Null = ""
108115blockToLaTeX notes (Plain lst) = inlineListToLaTeX notes lst ++ "\n"
109116blockToLaTeX notes (Para lst) = (inlineListToLaTeX notes lst) ++ "\n\n"
110−blockToLaTeX notes (BlockQuote lst) =
111− "\\begin{quote}\n" ++ (concatMap (blockToLaTeX notes) lst) ++ "\\end{quote}\n"
117+blockToLaTeX notes (BlockQuote lst) = "\\begin{quote}\n" ++
118+ (concatMap (blockToLaTeX notes) lst) ++ "\\end{quote}\n"
112119blockToLaTeX notes (Note ref lst) = ""
113120blockToLaTeX notes (Key _ _) = ""
114−blockToLaTeX notes (CodeBlock str) = "\\begin{verbatim}\n" ++ str ++ "\n\\end{verbatim}\n"
121+blockToLaTeX notes (CodeBlock str) = "\\begin{verbatim}\n" ++ str ++
122+ "\n\\end{verbatim}\n"
115123blockToLaTeX notes (RawHtml str) = ""
116−blockToLaTeX notes (BulletList lst) =
117− "\\begin{itemize}\n" ++ (concatMap (listItemToLaTeX notes) lst) ++ "\\end{itemize}\n"
118−blockToLaTeX notes (OrderedList lst) =
119− "\\begin{enumerate}\n" ++ (concatMap (listItemToLaTeX notes) lst) ++ "\\end{enumerate}\n"
120−blockToLaTeX notes HorizontalRule = "\\begin{center}\\rule{3in}{0.4pt}\\end{center}\n\n"
124+blockToLaTeX notes (BulletList lst) = "\\begin{itemize}\n" ++
125+ (concatMap (listItemToLaTeX notes) lst) ++ "\\end{itemize}\n"
126+blockToLaTeX notes (OrderedList lst) = "\\begin{enumerate}\n" ++
127+ (concatMap (listItemToLaTeX notes) lst) ++ "\\end{enumerate}\n"
128+blockToLaTeX notes HorizontalRule =
129+ "\\begin{center}\\rule{3in}{0.4pt}\\end{center}\n\n"
121130blockToLaTeX notes (Header level lst) =
122− if (level > 0) && (level <= 3) then
123− "\\" ++ (concat (replicate (level - 1) "sub")) ++ "section{" ++
124− (inlineListToLaTeX notes (deVerb lst)) ++ "}\n\n"
125− else
126− (inlineListToLaTeX notes lst) ++ "\n\n"
127−listItemToLaTeX notes list = "\\item " ++ (concatMap (blockToLaTeX notes) list)
131+ if (level > 0) && (level <= 3)
132+ then "\\" ++ (concat (replicate (level - 1) "sub")) ++ "section{" ++
133+ (inlineListToLaTeX notes (deVerb lst)) ++ "}\n\n"
134+ else (inlineListToLaTeX notes lst) ++ "\n\n"
135+listItemToLaTeX notes list = "\\item " ++
136+ (concatMap (blockToLaTeX notes) list)
128137
129138-- | Convert list of inline elements to LaTeX.
130139inlineListToLaTeX :: [Block] -- ^ List of note blocks to use in resolving note refs
131140 -> [Inline] -- ^ Inlines to convert
132141 -> String
133142inlineListToLaTeX notes lst =
134− -- first, consolidate Str and Space for more effective smartquotes:
135− let lst' = consolidateList lst in
136− concatMap (inlineToLaTeX notes) lst'
143+ -- first, consolidate Str and Space for more effective smartquotes:
144+ let lst' = consolidateList lst in
145+ concatMap (inlineToLaTeX notes) lst'
137146
138147-- | Convert inline element to LaTeX
139148inlineToLaTeX :: [Block] -- ^ List of note blocks to use in resolving note refs
140149 -> Inline -- ^ Inline to convert
141150 -> String
142−inlineToLaTeX notes (Emph lst) = "\\emph{" ++ (inlineListToLaTeX notes (deVerb lst)) ++ "}"
143−inlineToLaTeX notes (Strong lst) = "\\textbf{" ++ (inlineListToLaTeX notes (deVerb lst)) ++ "}"
151+inlineToLaTeX notes (Emph lst) = "\\emph{" ++
152+ (inlineListToLaTeX notes (deVerb lst)) ++ "}"
153+inlineToLaTeX notes (Strong lst) = "\\textbf{" ++
154+ (inlineListToLaTeX notes (deVerb lst)) ++ "}"
144155inlineToLaTeX notes (Code str) = "\\verb" ++ [chr] ++ stuffing ++ [chr]
145− where stuffing = str
146− chr = ((enumFromTo '!' '~') \\ stuffing) !! 0
156+ where stuffing = str
157+ chr = ((enumFromTo '!' '~') \\ stuffing) !! 0
147158inlineToLaTeX notes (Str str) = stringToLaTeX str
148159inlineToLaTeX notes (TeX str) = str
149160inlineToLaTeX notes (HtmlInline str) = ""
@@ -151,18 +162,22 @@ inlineToLaTeX notes (LineBreak) = "\\\\\n"
151162inlineToLaTeX notes Space = " "
152163inlineToLaTeX notes (Link text (Src src tit)) =
153164 "\\href{" ++ src ++ "}{" ++ (inlineListToLaTeX notes (deVerb text)) ++ "}"
154−inlineToLaTeX notes (Link text (Ref [])) = "[" ++ (inlineListToLaTeX notes text) ++ "]"
155−inlineToLaTeX notes (Link text (Ref ref)) = "[" ++ (inlineListToLaTeX notes text) ++ "][" ++
156− (inlineListToLaTeX notes ref) ++ "]" -- this is what markdown does, for better or worse
157−inlineToLaTeX notes (Image alternate (Src source tit)) = "\\includegraphics{" ++ source ++ "}"
165+inlineToLaTeX notes (Link text (Ref [])) = "[" ++
166+ (inlineListToLaTeX notes text) ++ "]"
167+inlineToLaTeX notes (Link text (Ref ref)) = "[" ++
168+ (inlineListToLaTeX notes text) ++ "][" ++ (inlineListToLaTeX notes ref) ++
169+ "]" -- this is what markdown does, for better or worse
170+inlineToLaTeX notes (Image alternate (Src source tit)) =
171+ "\\includegraphics{" ++ source ++ "}"
158172inlineToLaTeX notes (Image alternate (Ref [])) =
159173 "![" ++ (inlineListToLaTeX notes alternate) ++ "]"
160174inlineToLaTeX notes (Image alternate (Ref ref)) =
161− "![" ++ (inlineListToLaTeX notes alternate) ++ "][" ++ (inlineListToLaTeX notes ref) ++ "]"
175+ "![" ++ (inlineListToLaTeX notes alternate) ++ "][" ++
176+ (inlineListToLaTeX notes ref) ++ "]"
162177inlineToLaTeX [] (NoteRef ref) = ""
163178inlineToLaTeX ((Note firstref firstblocks):rest) (NoteRef ref) =
164− if (firstref == ref) then
165− "\\footnote{" ++ (stripTrailingNewlines (concatMap (blockToLaTeX rest) firstblocks)) ++ "}"
166− else
167− inlineToLaTeX rest (NoteRef ref)
179+ if (firstref == ref)
180+ then "\\footnote{" ++ (stripTrailingNewlines
181+ (concatMap (blockToLaTeX rest) firstblocks)) ++ "}"
182+ else inlineToLaTeX rest (NoteRef ref)
168183
src/Text/Pandoc/Writers/Markdown.hs+86−62
@@ -1,4 +1,16 @@
1−-- | Converts Pandoc to Markdown.
1+{- |
2+ Module : Text.Pandoc.Writers.Markdown
3+ Copyright : Copyright (C) 2006 John MacFarlane
4+ License : GNU GPL, version 2 or above
5+
6+ Maintainer : John MacFarlane <jgm at berkeley dot edu>
7+ Stability : unstable
8+ Portability : portable
9+
10+Conversion of 'Pandoc' documents to markdown-formatted plain text.
11+
12+Markdown: http://daringfireball.net/projects/markdown/
13+-}
214module Text.Pandoc.Writers.Markdown (
315 writeMarkdown
416 ) where
@@ -11,11 +23,11 @@ import Text.PrettyPrint.HughesPJ hiding ( Str )
1123writeMarkdown :: WriterOptions -> Pandoc -> String
1224writeMarkdown options (Pandoc meta blocks) =
1325 let body = text (writerIncludeBefore options) <>
14− vcat (map (blockToMarkdown (writerTabStop options)) (formatKeys blocks)) $$ text (writerIncludeAfter options) in
15− let head = if (writerStandalone options) then
16− ((metaToMarkdown meta) $$ text (writerHeader options))
17− else
18− empty in
26+ vcat (map (blockToMarkdown (writerTabStop options))
27+ (formatKeys blocks)) $$ text (writerIncludeAfter options) in
28+ let head = if (writerStandalone options)
29+ then ((metaToMarkdown meta) $$ text (writerHeader options))
30+ else empty in
1931 render $ head <> body
2032
2133-- | Escape special characters for Markdown.
@@ -28,13 +40,15 @@ escapeLinkTitle = gsub "\"" "\\\\\""
2840
2941-- | Take list of inline elements and return wrapped doc.
3042wrappedMarkdown :: [Inline] -> Doc
31−wrappedMarkdown lst = fsep $ map (fcat . (map inlineToMarkdown)) (splitBySpace lst)
43+wrappedMarkdown lst = fsep $
44+ map (fcat . (map inlineToMarkdown)) (splitBySpace lst)
3245
3346-- | Insert Blank block between key and non-key
3447formatKeys :: [Block] -> [Block]
3548formatKeys [] = []
3649formatKeys [x] = [x]
37−formatKeys ((Key x1 y1):(Key x2 y2):rest) = (Key x1 y1):(formatKeys ((Key x2 y2):rest))
50+formatKeys ((Key x1 y1):(Key x2 y2):rest) =
51+ (Key x1 y1):(formatKeys ((Key x2 y2):rest))
3852formatKeys ((Key x1 y1):rest) = (Key x1 y1):Blank:(formatKeys rest)
3953formatKeys (x:(Key x1 y1):rest) = x:Blank:(formatKeys ((Key x1 y1):rest))
4054formatKeys (x:rest) = x:(formatKeys rest)
@@ -43,17 +57,18 @@ formatKeys (x:rest) = x:(formatKeys rest)
4357metaToMarkdown :: Meta -> Doc
4458metaToMarkdown (Meta [] [] "") = empty
4559metaToMarkdown (Meta title [] "") = (titleToMarkdown title) <> (text "\n")
46−metaToMarkdown (Meta title authors "") =
47− (titleToMarkdown title) <> (text "\n") <> (authorsToMarkdown authors) <> (text "\n")
48−metaToMarkdown (Meta title authors date) =
49− (titleToMarkdown title) <> (text "\n") <> (authorsToMarkdown authors) <>
50− (text "\n") <> (dateToMarkdown date) <> (text "\n")
60+metaToMarkdown (Meta title authors "") = (titleToMarkdown title) <>
61+ (text "\n") <> (authorsToMarkdown authors) <> (text "\n")
62+metaToMarkdown (Meta title authors date) = (titleToMarkdown title) <>
63+ (text "\n") <> (authorsToMarkdown authors) <> (text "\n") <>
64+ (dateToMarkdown date) <> (text "\n")
5165
5266titleToMarkdown :: [Inline] -> Doc
5367titleToMarkdown lst = text "% " <> (inlineListToMarkdown lst)
5468
5569authorsToMarkdown :: [String] -> Doc
56−authorsToMarkdown lst = text "% " <> text (joinWithSep ", " (map escapeString lst))
70+authorsToMarkdown lst =
71+ text "% " <> text (joinWithSep ", " (map escapeString lst))
5772
5873dateToMarkdown :: String -> Doc
5974dateToMarkdown str = text "% " <> text (escapeString str)
@@ -67,33 +82,34 @@ blockToMarkdown tabStop Null = empty
6782blockToMarkdown tabStop (Plain lst) = wrappedMarkdown lst
6883blockToMarkdown tabStop (Para lst) = (wrappedMarkdown lst) <> (text "\n")
6984blockToMarkdown tabStop (BlockQuote lst) =
70− (vcat $ map (\line -> (text "> ") <> (text line)) $ lines $ render $ vcat $
71− map (blockToMarkdown tabStop) lst) <> (text "\n")
85+ (vcat $ map (\line -> (text "> ") <> (text line)) $ lines $ render $ vcat $
86+ map (blockToMarkdown tabStop) lst) <> (text "\n")
7287blockToMarkdown tabStop (Note ref lst) =
73− let lns = lines $ render $ vcat $ map (blockToMarkdown tabStop) lst in
74− if null lns then
75− empty
76− else
77− let first = head lns
78− rest = tail lns in
79− text ("[^" ++ (escapeString ref) ++ "]: ") <> (text first) $$ (vcat $
80− map (\line -> (text " ") <> (text line)) rest) <> text "\n"
88+ let lns = lines $ render $ vcat $ map (blockToMarkdown tabStop) lst in
89+ if null lns
90+ then empty
91+ else let first = head lns
92+ rest = tail lns in
93+ text ("[^" ++ (escapeString ref) ++ "]: ") <> (text first) $$
94+ (vcat $ map (\line -> (text " ") <> (text line)) rest) <>
95+ text "\n"
8196blockToMarkdown tabStop (Key txt (Src src tit)) =
82− text " " <> char '[' <> inlineListToMarkdown txt <> char ']' <> text ": " <> text src <>
83− (if tit /= "" then (text (" \"" ++ (escapeLinkTitle tit) ++ "\"")) else empty)
84−blockToMarkdown tabStop (CodeBlock str) = (nest tabStop $ vcat $ map text (lines str)) <>
85− text "\n"
97+ text " " <> char '[' <> inlineListToMarkdown txt <> char ']' <>
98+ text ": " <> text src <>
99+ if tit /= "" then text (" \"" ++ (escapeLinkTitle tit) ++ "\"") else empty
100+blockToMarkdown tabStop (CodeBlock str) =
101+ (nest tabStop $ vcat $ map text (lines str)) <> text "\n"
86102blockToMarkdown tabStop (RawHtml str) = text str
87103blockToMarkdown tabStop (BulletList lst) =
88− vcat (map (bulletListItemToMarkdown tabStop) lst) <> text "\n"
104+ vcat (map (bulletListItemToMarkdown tabStop) lst) <> text "\n"
89105blockToMarkdown tabStop (OrderedList lst) =
90− vcat (zipWith (orderedListItemToMarkdown tabStop) (enumFromTo 1 (length lst)) lst) <>
91− text "\n"
106+ vcat (zipWith (orderedListItemToMarkdown tabStop)
107+ (enumFromTo 1 (length lst)) lst) <> text "\n"
92108blockToMarkdown tabStop HorizontalRule = text "\n* * * * *\n"
93−blockToMarkdown tabStop (Header level lst) =
94− text ((replicate level '#') ++ " ") <> (inlineListToMarkdown lst) <> (text "\n")
109+blockToMarkdown tabStop (Header level lst) = text ((replicate level '#') ++
110+ " ") <> (inlineListToMarkdown lst) <> (text "\n")
95111bulletListItemToMarkdown tabStop list =
96− hang (text "- ") tabStop (vcat (map (blockToMarkdown tabStop) list))
112+ hang (text "- ") tabStop (vcat (map (blockToMarkdown tabStop) list))
97113
98114-- | Convert ordered list item (a list of blocks) to markdown.
99115orderedListItemToMarkdown :: Int -- ^ tab stop
@@ -101,8 +117,9 @@ orderedListItemToMarkdown :: Int -- ^ tab stop
101117 -> [Block] -- ^ list item (list of blocks)
102118 -> Doc
103119orderedListItemToMarkdown tabStop num list =
104− hang (text ((show num) ++ "." ++ spacer)) tabStop (vcat (map (blockToMarkdown tabStop) list))
105− where spacer = if (num < 10) then " " else ""
120+ hang (text ((show num) ++ "." ++ spacer)) tabStop
121+ (vcat (map (blockToMarkdown tabStop) list))
122+ where spacer = if (num < 10) then " " else ""
106123
107124-- | Convert list of Pandoc inline elements to markdown.
108125inlineListToMarkdown :: [Inline] -> Doc
@@ -110,39 +127,46 @@ inlineListToMarkdown lst = hcat $ map inlineToMarkdown lst
110127
111128-- | Convert Pandoc inline element to markdown.
112129inlineToMarkdown :: Inline -> Doc
113−inlineToMarkdown (Emph lst) = text "*" <> (inlineListToMarkdown lst) <> text "*"
114−inlineToMarkdown (Strong lst) = text "**" <> (inlineListToMarkdown lst) <> text "**"
130+inlineToMarkdown (Emph lst) = text "*" <>
131+ (inlineListToMarkdown lst) <> text "*"
132+inlineToMarkdown (Strong lst) = text "**" <>
133+ (inlineListToMarkdown lst) <> text "**"
115134inlineToMarkdown (Code str) =
116− case (matchRegex (mkRegex "``") str) of
117− Just match -> text ("` " ++ str ++ " `")
118− Nothing -> case (matchRegex (mkRegex "`") str) of
119− Just match -> text ("`` " ++ str ++ " ``")
120− Nothing -> text ("`" ++ str ++ "`")
135+ case (matchRegex (mkRegex "``") str) of
136+ Just match -> text ("` " ++ str ++ " `")
137+ Nothing -> case (matchRegex (mkRegex "`") str) of
138+ Just match -> text ("`` " ++ str ++ " ``")
139+ Nothing -> text ("`" ++ str ++ "`")
121140inlineToMarkdown (Str str) = text $ escapeString str
122141inlineToMarkdown (TeX str) = text str
123142inlineToMarkdown (HtmlInline str) = text str
124143inlineToMarkdown (LineBreak) = text " \n"
125144inlineToMarkdown Space = char ' '
126145inlineToMarkdown (Link txt (Src src tit)) =
127− let linktext = if (null txt) || (txt == [Str ""]) then
128− text "link"
129− else
130− inlineListToMarkdown txt in
131− char '[' <> linktext <> char ']' <> char '(' <> text src <>
132− (if tit /= "" then (text (" \"" ++ (escapeLinkTitle tit) ++ "\"")) else empty) <> char ')'
133−inlineToMarkdown (Link txt (Ref [])) = char '[' <> inlineListToMarkdown txt <> text "][]"
134−inlineToMarkdown (Link txt (Ref ref)) = char '[' <> inlineListToMarkdown txt <> char ']' <>
135− char '[' <> inlineListToMarkdown ref <> char ']'
146+ let linktext = if (null txt) || (txt == [Str ""])
147+ then text "link"
148+ else inlineListToMarkdown txt in
149+ char '[' <> linktext <> char ']' <> char '(' <> text src <>
150+ (if tit /= ""
151+ then text (" \"" ++ (escapeLinkTitle tit) ++ "\"")
152+ else empty) <> char ')'
153+inlineToMarkdown (Link txt (Ref [])) =
154+ char '[' <> inlineListToMarkdown txt <> text "][]"
155+inlineToMarkdown (Link txt (Ref ref)) =
156+ char '[' <> inlineListToMarkdown txt <> char ']' <> char '[' <>
157+ inlineListToMarkdown ref <> char ']'
136158inlineToMarkdown (Image alternate (Src source tit)) =
137− let alt = if (null alternate) || (alternate == [Str ""]) then
138− text "image"
139− else
140− inlineListToMarkdown alternate in
141− char '!' <> char '[' <> alt <> char ']' <> char '(' <> text source <>
142− (if tit /= "" then (text (" \"" ++ (escapeLinkTitle tit) ++ "\"")) else empty) <> char ')'
159+ let alt = if (null alternate) || (alternate == [Str ""])
160+ then text "image"
161+ else inlineListToMarkdown alternate in
162+ char '!' <> char '[' <> alt <> char ']' <> char '(' <> text source <>
163+ (if tit /= ""
164+ then text (" \"" ++ (escapeLinkTitle tit) ++ "\"")
165+ else empty) <> char ')'
143166inlineToMarkdown (Image alternate (Ref [])) =
144− char '!' <> char '[' <> inlineListToMarkdown alternate <> char ']'
167+ char '!' <> char '[' <> inlineListToMarkdown alternate <> char ']'
145168inlineToMarkdown (Image alternate (Ref ref)) =
146− char '!' <> char '[' <> inlineListToMarkdown alternate <> char ']' <>
147− char '[' <> inlineListToMarkdown ref <> char ']'
148−inlineToMarkdown (NoteRef ref) = text "[^" <> text (escapeString ref) <> char ']'
169+ char '!' <> char '[' <> inlineListToMarkdown alternate <> char ']' <>
170+ char '[' <> inlineListToMarkdown ref <> char ']'
171+inlineToMarkdown (NoteRef ref) =
172+ text "[^" <> text (escapeString ref) <> char ']'
src/Text/Pandoc/Writers/RST.hs+98−77
@@ -1,4 +1,16 @@
1−-- | Converts Pandoc to reStructuredText.
1+{- |
2+ Module : Text.Pandoc.Writers.RST
3+ Copyright : Copyright (C) 2006 John MacFarlane
4+ License : GNU GPL, version 2 or above
5+
6+ Maintainer : John MacFarlane <jgm at berkeley dot edu>
7+ Stability : unstable
8+ Portability : portable
9+
10+Conversion of 'Pandoc' documents to reStructuredText.
11+
12+reStructuredText: http://docutils.sourceforge.net/rst.html
13+-}
214module Text.Pandoc.Writers.RST (
315 writeRST
416 ) where
@@ -10,40 +22,44 @@ import Text.PrettyPrint.HughesPJ hiding ( Str )
1022-- | Convert Pandoc to reStructuredText.
1123writeRST :: WriterOptions -> Pandoc -> String
1224writeRST options (Pandoc meta blocks) =
13− let (main, refs) = unzip $ map (blockToRST (writerTabStop options))
25+ let (main, refs) = unzip $ map (blockToRST (writerTabStop options))
1426 (reformatBlocks $ replaceReferenceLinks blocks)
15− top = if (writerStandalone options) then
16− (metaToRST meta) $$ text (writerHeader options)
17− else
18− empty in
19− -- remove duplicate keys
20− let refs' = nubBy (\x y -> (render x) == (render y)) refs in
21− let body = text (writerIncludeBefore options) <>
22− vcat main $$ text (writerIncludeAfter options) in
23− render $ top <> body $$ vcat refs' $$ text "\n"
27+ top = if (writerStandalone options)
28+ then (metaToRST meta) $$ text (writerHeader options)
29+ else empty in
30+ -- remove duplicate keys
31+ let refs' = nubBy (\x y -> (render x) == (render y)) refs in
32+ let body = text (writerIncludeBefore options) <>
33+ vcat main $$ text (writerIncludeAfter options) in
34+ render $ top <> body $$ vcat refs' $$ text "\n"
2435
2536-- | Escape special RST characters.
2637escapeString :: String -> String
2738escapeString = backslashEscape "`\\|*_"
2839
29−-- | Convert list of inline elements into one 'Doc' of wrapped text and another
30−-- containing references.
40+-- | Convert list of inline elements into one 'Doc' of wrapped text
41+-- and another containing references.
3142wrappedRST :: [Inline] -> (Doc, Doc)
3243wrappedRST lst =
33− let words = splitBySpace lst in
34− (fsep $ map (fcat . (map (fst . inlineToRST))) words, vcat (map (snd . inlineToRST) lst))
44+ let words = splitBySpace lst in
45+ ( fsep $ map (fcat . (map (fst . inlineToRST))) words,
46+ vcat (map (snd . inlineToRST) lst) )
3547
3648-- | Remove reference keys, and make sure there are blanks before each list.
3749reformatBlocks :: [Block] -> [Block]
3850reformatBlocks [] = []
3951reformatBlocks ((Plain x):(OrderedList y):rest) =
4052 (Para x):(reformatBlocks ((OrderedList y):rest))
41−reformatBlocks ((Plain x):(BulletList y):rest) = (Para x):(reformatBlocks ((BulletList y):rest))
53+reformatBlocks ((Plain x):(BulletList y):rest) =
54+ (Para x):(reformatBlocks ((BulletList y):rest))
4255reformatBlocks ((OrderedList x):rest) =
4356 (OrderedList (map reformatBlocks x)):(reformatBlocks rest)
44−reformatBlocks ((BulletList x):rest) = (BulletList (map reformatBlocks x)):(reformatBlocks rest)
45−reformatBlocks ((BlockQuote x):rest) = (BlockQuote (reformatBlocks x)):(reformatBlocks rest)
46−reformatBlocks ((Note ref x):rest) = (Note ref (reformatBlocks x)):(reformatBlocks rest)
57+reformatBlocks ((BulletList x):rest) =
58+ (BulletList (map reformatBlocks x)):(reformatBlocks rest)
59+reformatBlocks ((BlockQuote x):rest) =
60+ (BlockQuote (reformatBlocks x)):(reformatBlocks rest)
61+reformatBlocks ((Note ref x):rest) =
62+ (Note ref (reformatBlocks x)):(reformatBlocks rest)
4763reformatBlocks ((Key x1 y1):rest) = reformatBlocks rest
4864reformatBlocks (x:rest) = x:(reformatBlocks rest)
4965
@@ -56,15 +72,16 @@ metaToRST (Meta title authors date) =
5672titleToRST :: [Inline] -> Doc
5773titleToRST [] = empty
5874titleToRST lst =
59− let title = fst $ inlineListToRST lst in
60− let titleLength = length $ render title in
61− let border = text (replicate titleLength '=') in
62− border <> char '\n' <> title <> char '\n' <> border <> text "\n\n"
75+ let title = fst $ inlineListToRST lst in
76+ let titleLength = length $ render title in
77+ let border = text (replicate titleLength '=') in
78+ border <> char '\n' <> title <> char '\n' <> border <> text "\n\n"
6379
6480-- | Convert author list to 'Doc'.
6581authorsToRST :: [String] -> Doc
6682authorsToRST [] = empty
67−authorsToRST (first:rest) = text ":Author: " <> text first <> char '\n' <> (authorsToRST rest)
83+authorsToRST (first:rest) = text ":Author: " <> text first <>
84+ char '\n' <> (authorsToRST rest)
6885
6986-- | Convert date to 'Doc'.
7087dateToRST :: String -> Doc
@@ -80,36 +97,38 @@ blockToRST tabStop Blank = (text "\n", empty)
8097blockToRST tabStop Null = (empty, empty)
8198blockToRST tabStop (Plain lst) = wrappedRST lst
8299blockToRST tabStop (Para [TeX str]) = -- raw latex block
83− let str' = if (endsWith '\n' str) then (str ++ "\n") else (str ++ "\n\n") in
84− (hang (text "\n.. raw:: latex\n") 3 (vcat $ map text (lines str')), empty)
85−blockToRST tabStop (Para lst) = ((fst $ wrappedRST lst) <> (text "\n"), snd $ wrappedRST lst)
100+ let str' = if (endsWith '\n' str) then (str ++ "\n") else (str ++ "\n\n") in
101+ (hang (text "\n.. raw:: latex\n") 3 (vcat $ map text (lines str')), empty)
102+blockToRST tabStop (Para lst) = ( (fst $ wrappedRST lst) <> (text "\n"),
103+ snd $ wrappedRST lst )
86104blockToRST tabStop (BlockQuote lst) =
87− let (main, refs) = unzip $ map (blockToRST tabStop) lst in
88− ((nest tabStop $ vcat $ main) <> text "\n", vcat refs)
105+ let (main, refs) = unzip $ map (blockToRST tabStop) lst in
106+ ((nest tabStop $ vcat $ main) <> text "\n", vcat refs)
89107blockToRST tabStop (Note ref blocks) =
90− let (main, refs) = unzip $ map (blockToRST tabStop) blocks in
91− ((hang (text ".. [" <> text (escapeString ref) <> text "] ") 3 (vcat main)), vcat refs)
108+ let (main, refs) = unzip $ map (blockToRST tabStop) blocks in
109+ ((hang (text ".. [" <> text (escapeString ref) <> text "] ") 3 (vcat main)),
110+ vcat refs)
92111blockToRST tabStop (Key txt (Src src tit)) =
93− (text "ERROR - KEY FOUND", empty) -- shouldn't have a key here
94−blockToRST tabStop (CodeBlock str) =
95− (hang (text "::\n") tabStop (vcat $ map text (lines ('\n':(str ++ "\n\n")))), empty)
112+ (text "ERROR - KEY FOUND", empty) -- shouldn't have a key here
113+blockToRST tabStop (CodeBlock str) = (hang (text "::\n") tabStop
114+ (vcat $ map text (lines ('\n':(str ++ "\n\n")))), empty)
96115blockToRST tabStop (RawHtml str) =
97− let str' = if (endsWith '\n' str) then (str ++ "\n") else (str ++ "\n\n") in
98− (hang (text "\n.. raw:: html\n") 3 (vcat $ map text (lines str')), empty)
116+ let str' = if (endsWith '\n' str) then (str ++ "\n") else (str ++ "\n\n") in
117+ (hang (text "\n.. raw:: html\n") 3 (vcat $ map text (lines str')), empty)
99118blockToRST tabStop (BulletList lst) =
100− let (main, refs) = unzip $ map (bulletListItemToRST tabStop) lst in
101− (vcat main <> text "\n", vcat refs)
119+ let (main, refs) = unzip $ map (bulletListItemToRST tabStop) lst in
120+ (vcat main <> text "\n", vcat refs)
102121blockToRST tabStop (OrderedList lst) =
103− let (main, refs) =
104− unzip $ zipWith (orderedListItemToRST tabStop) (enumFromTo 1 (length lst)) lst in
105− (vcat main <> text "\n", vcat refs)
122+ let (main, refs) = unzip $ zipWith (orderedListItemToRST tabStop)
123+ (enumFromTo 1 (length lst)) lst in
124+ (vcat main <> text "\n", vcat refs)
106125blockToRST tabStop HorizontalRule = (text "--------------\n", empty)
107126blockToRST tabStop (Header level lst) =
108− let (headerText, refs) = inlineListToRST lst in
109− let headerLength = length $ render headerText in
110− let headerChar = if (level > 5) then ' ' else "=-~^'" !! (level - 1) in
111− let border = text $ replicate headerLength headerChar in
112− (headerText <> char '\n' <> border <> char '\n', refs)
127+ let (headerText, refs) = inlineListToRST lst in
128+ let headerLength = length $ render headerText in
129+ let headerChar = if (level > 5) then ' ' else "=-~^'" !! (level - 1) in
130+ let border = text $ replicate headerLength headerChar in
131+ (headerText <> char '\n' <> border <> char '\n', refs)
113132
114133-- | Convert bullet list item (list of blocks) to reStructuredText.
115134-- Returns a pair of 'Doc', the first the main text, the second references
@@ -117,8 +136,8 @@ bulletListItemToRST :: Int -- ^ tab stop
117136 -> [Block] -- ^ list item (list of blocks)
118137 -> (Doc, Doc)
119138bulletListItemToRST tabStop list =
120− let (main, refs) = unzip $ map (blockToRST tabStop) list in
121− (hang (text "- ") tabStop (vcat main), (vcat refs))
139+ let (main, refs) = unzip $ map (blockToRST tabStop) list in
140+ (hang (text "- ") tabStop (vcat main), (vcat refs))
122141
123142-- | Convert an ordered list item (list of blocks) to reStructuredText.
124143-- Returns a pair of 'Doc', the first the main text, the second references
@@ -127,9 +146,9 @@ orderedListItemToRST :: Int -- ^ tab stop
127146 -> [Block] -- ^ list item (list of blocks)
128147 -> (Doc, Doc)
129148orderedListItemToRST tabStop num list =
130− let (main, refs) = unzip $ map (blockToRST tabStop) list
131− spacer = if (length (show num) < 2) then " " else "" in
132− (hang (text ((show num) ++ "." ++ spacer)) tabStop (vcat main), (vcat refs))
149+ let (main, refs) = unzip $ map (blockToRST tabStop) list
150+ spacer = if (length (show num) < 2) then " " else "" in
151+ (hang (text ((show num) ++ "." ++ spacer)) tabStop (vcat main), (vcat refs))
133152
134153-- | Convert a list of inline elements to reStructuredText.
135154-- Returns a pair of 'Doc', the first the main text, the second references.
@@ -151,39 +170,41 @@ inlineToRST (HtmlInline str) = (empty, empty)
151170inlineToRST (LineBreak) = inlineToRST Space -- RST doesn't have line breaks
152171inlineToRST Space = (char ' ', empty)
153172--
154−-- Note: can assume reference links have been replaced where possible with explicit links.
173+-- Note: can assume reference links have been replaced where possible
174+-- with explicit links.
155175--
156176inlineToRST (Link txt (Src src tit)) =
157− let (linktext, ref') = if (null txt) || (txt == [Str ""]) then
158− (text "link", empty)
159− else
160− inlineListToRST $ normalizeSpaces txt in
161− let link = char '`' <> linktext <> text "`_"
162− linktext' = render linktext in
163− let linktext'' = if (':' `elem` linktext') then "`" ++ linktext' ++ "`" else linktext' in
177+ let (linktext, ref') = if (null txt) || (txt == [Str ""])
178+ then (text "link", empty)
179+ else inlineListToRST $ normalizeSpaces txt in
180+ let link = char '`' <> linktext <> text "`_"
181+ linktext' = render linktext in
182+ let linktext'' = if (':' `elem` linktext')
183+ then "`" ++ linktext' ++ "`"
184+ else linktext' in
164185 let ref = text ".. _" <> text linktext'' <> text ": " <> text src in
165186 (link, ref' $$ ref)
166187inlineToRST (Link txt (Ref [])) =
167− let (linktext, refs) = inlineListToRST txt in
168− (char '[' <> linktext <> char ']', refs)
188+ let (linktext, refs) = inlineListToRST txt in
189+ (char '[' <> linktext <> char ']', refs)
169190inlineToRST (Link txt (Ref ref)) =
170− let (linktext, refs1) = inlineListToRST txt
171− (reftext, refs2) = inlineListToRST ref in
172− (char '[' <> linktext <> text "][" <> reftext <> char ']', refs1 $$ refs2)
191+ let (linktext, refs1) = inlineListToRST txt
192+ (reftext, refs2) = inlineListToRST ref in
193+ (char '[' <> linktext <> text "][" <> reftext <> char ']', refs1 $$ refs2)
173194inlineToRST (Image alternate (Src source tit)) =
174− let (alt, ref') = if (null alternate) || (alternate == [Str ""]) then
175− (text "image", empty)
176− else
177− inlineListToRST $ normalizeSpaces alternate in
178− let link = char '|' <> alt <> char '|' in
179− let ref = text ".. " <> link <> text " image:: " <> text source in
180− (link, ref' $$ ref)
195+ let (alt, ref') = if (null alternate) || (alternate == [Str ""])
196+ then (text "image", empty)
197+ else inlineListToRST $ normalizeSpaces alternate in
198+ let link = char '|' <> alt <> char '|' in
199+ let ref = text ".. " <> link <> text " image:: " <> text source in
200+ (link, ref' $$ ref)
181201inlineToRST (Image alternate (Ref [])) =
182− let (alttext, refs) = inlineListToRST alternate in
183− (char '|' <> alttext <> char '|', refs)
202+ let (alttext, refs) = inlineListToRST alternate in
203+ (char '|' <> alttext <> char '|', refs)
184204-- The following case won't normally occur...
185205inlineToRST (Image alternate (Ref ref)) =
186− let (alttext, refs1) = inlineListToRST alternate
187− (reftext, refs2) = inlineListToRST ref in
188− (char '|' <> alttext <> char '|', refs1 $$ refs2)
189−inlineToRST (NoteRef ref) = (text " [" <> text (escapeString ref) <> char ']' <> char '_', empty)
206+ let (alttext, refs1) = inlineListToRST alternate
207+ (reftext, refs2) = inlineListToRST ref in
208+ (char '|' <> alttext <> char '|', refs1 $$ refs2)
209+inlineToRST (NoteRef ref) =
210+ (text " [" <> text (escapeString ref) <> char ']' <> char '_', empty)
src/Text/Pandoc/Writers/RTF.hs+90−65
@@ -1,4 +1,14 @@
1−-- | Convert Pandoc to rich text format.
1+{- |
2+ Module :
3+ Copyright : Copyright (C) 2006 John MacFarlane
4+ License : GNU GPL, version 2 or above
5+
6+ Maintainer : John MacFarlane <jgm at berkeley dot edu>
7+ Stability : unstable
8+ Portability : portable
9+
10+Conversion of 'Pandoc' documents to RTF (rich text format).
11+-}
212module Text.Pandoc.Writers.RTF (
313 writeRTF
414 ) where
@@ -10,24 +20,24 @@ import Char ( ord, chr )
1020-- | Convert Pandoc to a string in rich text format.
1121writeRTF :: WriterOptions -> Pandoc -> String
1222writeRTF options (Pandoc meta blocks) =
13− let notes = filter isNoteBlock blocks in -- assumes all notes are at outer level
14− let head = if writerStandalone options then
15− rtfHeader notes (writerHeader options) meta
16− else
17− ""
18− foot = if writerStandalone options then "\n}\n" else ""
19− body = (writerIncludeBefore options) ++
20− (concatMap (blockToRTF notes 0) (replaceReferenceLinks blocks)) ++
21− (writerIncludeAfter options) in
22− head ++ body ++ foot
23+ -- assumes all notes are at outer level
24+ let notes = filter isNoteBlock blocks in
25+ let head = if writerStandalone options
26+ then rtfHeader notes (writerHeader options) meta
27+ else ""
28+ foot = if writerStandalone options then "\n}\n" else ""
29+ body = (writerIncludeBefore options) ++ (concatMap (blockToRTF notes 0)
30+ (replaceReferenceLinks blocks)) ++
31+ (writerIncludeAfter options) in
32+ head ++ body ++ foot
2333
2434-- | Convert unicode characters (> 127) into rich text format representation.
2535handleUnicode :: String -> String
2636handleUnicode [] = []
27−handleUnicode (c:cs) = if (ord c) > 127 then
28− '\\':'u':(show (ord c)) ++ "?" ++ (handleUnicode cs)
29− else
30− c:(handleUnicode cs)
37+handleUnicode (c:cs) = if (ord c) > 127
38+ then '\\':'u':(show (ord c)) ++ "?" ++
39+ (handleUnicode cs)
40+ else c:(handleUnicode cs)
3141
3242escapeSpecial = backslashEscape "{\\}"
3343escapeTab = gsub "\\\\t" "\\\\tab "
@@ -56,8 +66,8 @@ rtfParSpaced :: Int -- ^ space after (in twips)
5666 -> String -- ^ string with content
5767 -> String
5868rtfParSpaced spaceAfter indent firstLineIndent content =
59− "{\\pard \\f0 \\sa" ++ (show spaceAfter) ++ " \\li" ++ (show indent) ++
60− " \\fi" ++ (show firstLineIndent) ++ " " ++ content ++ "\\par}\n"
69+ "{\\pard \\f0 \\sa" ++ (show spaceAfter) ++ " \\li" ++ (show indent) ++
70+ " \\fi" ++ (show firstLineIndent) ++ " " ++ content ++ "\\par}\n"
6171
6272-- | Default paragraph.
6373rtfPar :: Int -- ^ block indent (in twips)
@@ -85,9 +95,10 @@ bulletMarker indent = case (indent `mod` 720) of
8595
8696-- | Returns appropriate (list of) ordered list markers for indent level.
8797orderedMarkers :: Int -> [String]
88−orderedMarkers indent = case (indent `mod` 720) of
89− 0 -> map (\x -> show x ++ ".") [1..]
90− otherwise -> map (\x -> show x ++ ".") $ cycle ['a'..'z']
98+orderedMarkers indent =
99+ case (indent `mod` 720) of
100+ 0 -> map (\x -> show x ++ ".") [1..]
101+ otherwise -> map (\x -> show x ++ ".") $ cycle ['a'..'z']
91102
92103-- | Returns RTF header.
93104rtfHeader :: [Block] -- ^ list of note blocks
@@ -95,16 +106,20 @@ rtfHeader :: [Block] -- ^ list of note blocks
95106 -> Meta -- ^ bibliographic information
96107 -> String
97108rtfHeader notes headerText (Meta title authors date) =
98− let titletext = if null title then
99− ""
100− else
101− rtfPar 0 0 ("\\qc \\b \\fs36 " ++ inlineListToRTF notes title)
102− authorstext = if null authors then
103− ""
104− else
105− rtfPar 0 0 ("\\qc " ++ (joinWithSep "\\" (map stringToRTF authors)))
106− datetext = if date == "" then "" else rtfPar 0 0 ("\\qc " ++ stringToRTF date) in
107− let spacer = if null (titletext ++ authorstext ++ datetext) then "" else rtfPar 0 0 "" in
109+ let titletext = if null title
110+ then ""
111+ else rtfPar 0 0 ("\\qc \\b \\fs36 " ++
112+ inlineListToRTF notes title)
113+ authorstext = if null authors
114+ then ""
115+ else rtfPar 0 0 ("\\qc " ++ (joinWithSep "\\"
116+ (map stringToRTF authors)))
117+ datetext = if date == ""
118+ then ""
119+ else rtfPar 0 0 ("\\qc " ++ stringToRTF date) in
120+ let spacer = if null (titletext ++ authorstext ++ datetext)
121+ then ""
122+ else rtfPar 0 0 "" in
108123 headerText ++ titletext ++ authorstext ++ datetext ++ spacer
109124
110125-- | Convert Pandoc block element to RTF.
@@ -114,32 +129,36 @@ blockToRTF :: [Block] -- ^ list of note blocks
114129 -> String
115130blockToRTF notes indent Blank = rtfPar indent 0 ""
116131blockToRTF notes indent Null = ""
117−blockToRTF notes indent (Plain lst) = rtfCompact indent 0 (inlineListToRTF notes lst)
118−blockToRTF notes indent (Para lst) = rtfPar indent 0 (inlineListToRTF notes lst)
132+blockToRTF notes indent (Plain lst) =
133+ rtfCompact indent 0 (inlineListToRTF notes lst)
134+blockToRTF notes indent (Para lst) =
135+ rtfPar indent 0 (inlineListToRTF notes lst)
119136blockToRTF notes indent (BlockQuote lst) =
120− concatMap (blockToRTF notes (indent + indentIncrement)) lst
121−blockToRTF notes indent (Note ref lst) = "" -- there shouldn't be any after filtering
137+ concatMap (blockToRTF notes (indent + indentIncrement)) lst
138+blockToRTF notes indent (Note ref lst) = "" -- shouldn't be any aftr filtering
122139blockToRTF notes indent (Key _ _) = ""
123−blockToRTF notes indent (CodeBlock str) = rtfPar indent 0 ("\\f1 " ++ (codeStringToRTF str))
140+blockToRTF notes indent (CodeBlock str) =
141+ rtfPar indent 0 ("\\f1 " ++ (codeStringToRTF str))
124142blockToRTF notes indent (RawHtml str) = ""
125143blockToRTF notes indent (BulletList lst) =
126− spaceAtEnd $ concatMap (listItemToRTF notes indent (bulletMarker indent)) lst
144+ spaceAtEnd $
145+ concatMap (listItemToRTF notes indent (bulletMarker indent)) lst
127146blockToRTF notes indent (OrderedList lst) =
128− spaceAtEnd $ concat $ zipWith (listItemToRTF notes indent) (orderedMarkers indent) lst
147+ spaceAtEnd $ concat $
148+ zipWith (listItemToRTF notes indent) (orderedMarkers indent) lst
129149blockToRTF notes indent HorizontalRule =
130− rtfPar indent 0 "\\qc \\emdash\\emdash\\emdash\\emdash\\emdash"
150+ rtfPar indent 0 "\\qc \\emdash\\emdash\\emdash\\emdash\\emdash"
131151blockToRTF notes indent (Header level lst) =
132− rtfPar indent 0 ("\\b \\fs" ++ (show (40 - (level * 4))) ++ " " ++
133− (inlineListToRTF notes lst))
152+ rtfPar indent 0 ("\\b \\fs" ++ (show (40 - (level * 4))) ++ " " ++
153+ (inlineListToRTF notes lst))
134154
135155-- | Ensure that there's the same amount of space after compact
136156-- lists as after regular lists.
137157spaceAtEnd :: String -> String
138158spaceAtEnd str =
139− if isSuffixOf "\\par}\n" str then
140− (take ((length str) - 6) str) ++ "\\sa180\\par}\n"
141− else
142− str
159+ if isSuffixOf "\\par}\n" str
160+ then (take ((length str) - 6) str) ++ "\\sa180\\par}\n"
161+ else str
143162
144163-- | Convert list item (list of blocks) to RTF.
145164listItemToRTF :: [Block] -- ^ list of note blocks
@@ -148,13 +167,14 @@ listItemToRTF :: [Block] -- ^ list of note blocks
148167 -> [Block] -- ^ list item (list of blocks)
149168 -> [Char]
150169listItemToRTF notes indent marker [] =
151− rtfCompact (indent + listIncrement) (0 - listIncrement)
152− (marker ++ "\\tx" ++ (show listIncrement) ++ "\\tab ")
170+ rtfCompact (indent + listIncrement) (0 - listIncrement)
171+ (marker ++ "\\tx" ++ (show listIncrement) ++ "\\tab ")
153172listItemToRTF notes indent marker list =
154− let (first:rest) = map (blockToRTF notes (indent + listIncrement)) list in
155− let modFirst = gsub "\\\\fi-?[0-9]+" ("\\\\fi" ++ (show (0 - listIncrement)) ++
156− " " ++ marker ++ "\\\\tx" ++ (show listIncrement) ++ "\\\\tab") first in
157− modFirst ++ (concat rest)
173+ let (first:rest) = map (blockToRTF notes (indent + listIncrement)) list in
174+ let modFirst = gsub "\\\\fi-?[0-9]+" ("\\\\fi" ++
175+ (show (0 - listIncrement)) ++ " " ++ marker ++
176+ "\\\\tx" ++ (show listIncrement) ++ "\\\\tab") first in
177+ modFirst ++ (concat rest)
158178
159179-- | Convert list of inline items to RTF.
160180inlineListToRTF :: [Block] -- ^ list of note blocks
@@ -167,7 +187,8 @@ inlineToRTF :: [Block] -- ^ list of note blocks
167187 -> Inline -- ^ inline to convert
168188 -> String
169189inlineToRTF notes (Emph lst) = "{\\i " ++ (inlineListToRTF notes lst) ++ "} "
170−inlineToRTF notes (Strong lst) = "{\\b " ++ (inlineListToRTF notes lst) ++ "} "
190+inlineToRTF notes (Strong lst) =
191+ "{\\b " ++ (inlineListToRTF notes lst) ++ "} "
171192inlineToRTF notes (Code str) = "{\\f1 " ++ (codeStringToRTF str) ++ "} "
172193inlineToRTF notes (Str str) = stringToRTF str
173194inlineToRTF notes (TeX str) = latexToRTF str
@@ -175,20 +196,24 @@ inlineToRTF notes (HtmlInline str) = ""
175196inlineToRTF notes (LineBreak) = "\\line "
176197inlineToRTF notes Space = " "
177198inlineToRTF notes (Link text (Src src tit)) =
178− "{\\field{\\*\\fldinst{HYPERLINK \"" ++ (codeStringToRTF src) ++ "\"}}{\\fldrslt{\\ul\n"
179− ++ (inlineListToRTF notes text) ++ "\n}}}\n"
180−inlineToRTF notes (Link text (Ref [])) = "[" ++ (inlineListToRTF notes text) ++ "]"
181−inlineToRTF notes (Link text (Ref ref)) = "[" ++ (inlineListToRTF notes text) ++ "][" ++
182− (inlineListToRTF notes ref) ++ "]" -- this is what markdown does, for better or worse
183−inlineToRTF notes (Image alternate (Src source tit)) = "{\\cf1 [image: " ++ source ++ "]\\cf0}"
184−inlineToRTF notes (Image alternate (Ref [])) = "![" ++ (inlineListToRTF notes alternate) ++ "]"
185−inlineToRTF notes (Image alternate (Ref ref)) = "![" ++ (inlineListToRTF notes alternate) ++
186− "][" ++ (inlineListToRTF notes ref) ++ "]"
199+ "{\\field{\\*\\fldinst{HYPERLINK \"" ++ (codeStringToRTF src) ++
200+ "\"}}{\\fldrslt{\\ul\n" ++ (inlineListToRTF notes text) ++ "\n}}}\n"
201+inlineToRTF notes (Link text (Ref [])) =
202+ "[" ++ (inlineListToRTF notes text) ++ "]"
203+inlineToRTF notes (Link text (Ref ref)) =
204+ "[" ++ (inlineListToRTF notes text) ++ "][" ++
205+ (inlineListToRTF notes ref) ++ "]" -- this is what markdown does
206+inlineToRTF notes (Image alternate (Src source tit)) =
207+ "{\\cf1 [image: " ++ source ++ "]\\cf0}"
208+inlineToRTF notes (Image alternate (Ref [])) =
209+ "![" ++ (inlineListToRTF notes alternate) ++ "]"
210+inlineToRTF notes (Image alternate (Ref ref)) = "![" ++
211+ (inlineListToRTF notes alternate) ++ "][" ++
212+ (inlineListToRTF notes ref) ++ "]"
187213inlineToRTF [] (NoteRef ref) = ""
188214inlineToRTF ((Note firstref firstblocks):rest) (NoteRef ref) =
189− if firstref == ref then
190− "{\\super\\chftn}{\\*\\footnote\\chftn\\~\\plain\\pard " ++
191− (concatMap (blockToRTF rest 0) firstblocks) ++ "}"
192− else
193− inlineToRTF rest (NoteRef ref)
215+ if firstref == ref
216+ then "{\\super\\chftn}{\\*\\footnote\\chftn\\~\\plain\\pard " ++
217+ (concatMap (blockToRTF rest 0) firstblocks) ++ "}"
218+ else inlineToRTF rest (NoteRef ref)
194219
src/Text/ParserCombinators/Pandoc.hs+17−7
@@ -1,4 +1,14 @@
1−-- | Special parser combinators for Pandoc readers.
1+{- |
2+ Module : Text.ParserCombinators.Pandoc
3+ Copyright : Copyright (C) 2006 John MacFarlane
4+ License : GNU GPL, version 2 or above
5+
6+ Maintainer : John MacFarlane <jgm at berkeley dot edu>
7+ Stability : unstable
8+ Portability : portable
9+
10+Special parser combinators for Pandoc readers.
11+-}
212module Text.ParserCombinators.Pandoc (
313 many1Till,
414 followedBy',
@@ -79,8 +89,9 @@ many1Till p end = try (do
7989 rest <- manyTill p end
8090 return (first:rest))
8191
82−-- | A more general form of @notFollowedBy@. This one allows any type of parser to
83−-- be specified, and succeeds only if that parser fails. It does not consume any input.
92+-- | A more general form of @notFollowedBy@. This one allows any
93+-- type of parser to be specified, and succeeds only if that parser fails.
94+-- It does not consume any input.
8495notFollowedBy' :: Show b => GenParser a st b -> GenParser a st ()
8596notFollowedBy' parser = try (do { c <- try parser; unexpected (show c) }
8697 <|> return ())
@@ -90,10 +101,9 @@ notFollowedBy' parser = try (do { c <- try parser; unexpected (show c) }
90101followedBy' :: (Show b) => GenParser a st b -> GenParser a st ()
91102followedBy' parser = do
92103 isNotFollowed <- option False (do{ notFollowedBy' parser; return True})
93− if isNotFollowed then
94− fail "not followed by parser"
95− else
96− return ()
104+ if isNotFollowed
105+ then fail "not followed by parser"
106+ else return ()
97107
98108-- | Parses one of a list of strings (tried in order).
99109oneOfStrings :: [String] -> GenParser Char st String