dc9c645 · typeable/pandoc

git.iko.soy/typeable/pandoc

on master help sign in

+ Added module data for haddock.

dc9c645fiddlosopher20 years ago

src/Main.hs+59−40

compare with master

unifiedsplit

@@ -1,5 +1,15 @@

1+{- |

2+ Module : Main

4+ License : GNU GPL, version 2 or above

6+ Maintainer : John MacFarlane <jgm at berkeley dot edu>

7+ Stability : unstable

8+ Portability : portable

1−-- | Main Pandoc program. Parses command-line options and calls the

10+Parses command-line options and calls the appropriate readers and

2−-- appropriate readers and writers.

11+writers.

12+-}

3module Main where

13module Main where

4import Text.Pandoc.UTF8 ( decodeUTF8, encodeUTF8 )

14import Text.Pandoc.UTF8 ( decodeUTF8, encodeUTF8 )

5import Text.Pandoc.Readers.Markdown ( readMarkdown )

15import Text.Pandoc.Readers.Markdown ( readMarkdown )

@@ -13,7 +23,8 @@ import Text.Pandoc.Writers.LaTeX ( writeLaTeX )

13import Text.Pandoc.Readers.LaTeX ( readLaTeX )

23import Text.Pandoc.Readers.LaTeX ( readLaTeX )

14import Text.Pandoc.Writers.RTF ( writeRTF )

24import Text.Pandoc.Writers.RTF ( writeRTF )

15import Text.Pandoc.Writers.Markdown ( writeMarkdown )

25import 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 )

17import Text.Pandoc.Definition

28import Text.Pandoc.Definition

18import Text.Pandoc.Shared

29import Text.Pandoc.Shared

19import System ( exitWith, getArgs, getProgName )

30import System ( exitWith, getArgs, getProgName )

@@ -58,23 +69,24 @@ writeDoc options = prettyPandoc

59-- | Data structure for command line options.

70-- | Data structure for command line options.

60data Opt = Opt

71data Opt = Opt

61− { optPreserveTabs :: Bool -- ^ If @False@, convert tabs to spaces

72+ { optPreserveTabs :: Bool -- ^ If @False@, convert tabs to spaces

62− , optTabStop :: Int -- ^ Number of spaces per tab

73+ , optTabStop :: Int -- ^ Number of spaces per tab

63− , optStandalone :: Bool -- ^ If @True@, include header and footer

74+ , optStandalone :: Bool -- ^ If @True@, include header, footer

64− , optReader :: ParserState -> String -> Pandoc -- ^ Reader to use

75+ , optReader :: ParserState -> String -> Pandoc -- ^ Read format

65− , optWriter :: WriterOptions -> Pandoc -> String -- ^ Writer to use

76+ , optWriter :: WriterOptions -> Pandoc -> String -- ^ Write fmt

66− , optParseRaw :: Bool -- ^ If @True@, parse unconvertable HTML and TeX

77+ , optParseRaw :: Bool -- ^ If @True@, parse unconvertable

78+ -- HTML and TeX

67− , optCSS :: String -- ^ CSS file to link to

79+ , optCSS :: String -- ^ CSS file to link to

68− , optIncludeInHeader :: String -- ^ File to include in header

80+ , optIncludeInHeader :: String -- ^ File to include in header

69− , optIncludeBeforeBody :: String -- ^ File to include at beginning of body

81+ , optIncludeBeforeBody :: String -- ^ File to include at top of body

70− , optIncludeAfterBody :: String -- ^ File to include at end of body

82+ , optIncludeAfterBody :: String -- ^ File to include at end of body

71− , optCustomHeader :: String -- ^ Custom header to use, or "DEFAULT"

83+ , optCustomHeader :: String -- ^ Custom header to use, or "DEFAULT"

72− , optDefaultHeader :: String -- ^ Default header

84+ , optDefaultHeader :: String -- ^ Default header

73− , optTitlePrefix :: String -- ^ Optional prefix for HTML title

85+ , optTitlePrefix :: String -- ^ Optional prefix for HTML title

74− , optNumberSections :: Bool -- ^ If @True@, number sections in LaTeX

86+ , optNumberSections :: Bool -- ^ If @True@, number sections in LaTeX

75− , optIncremental :: Bool -- ^ If @True@, show lists incrementally in S5

87+ , optIncremental :: Bool -- ^ If @True@, incremental lists in S5

76− , optSmart :: Bool -- ^ If @True@, use smart quotes, dashes, ...

88+ , optSmart :: Bool -- ^ If @True@, use smart typography

77− , optASCIIMathML :: Bool -- ^ If @True@, use ASCIIMathML in HTML or S5

89+ , optASCIIMathML :: Bool -- ^ If @True@, use ASCIIMathML in HTML

78 }

90 }

80-- | Defaults for command-line options.

92-- | Defaults for command-line options.

@@ -121,18 +133,19 @@ options =

121 , Option "fr" ["from","read"]

133 , Option "fr" ["from","read"]

122 (ReqArg

134 (ReqArg

123 (\arg opt -> case (lookup (map toLower arg) readers) of

135 (\arg opt -> case (lookup (map toLower arg) readers) of

124− Just reader -> return opt { optReader = reader }

136+ Just reader -> return opt { optReader = reader }

125− Nothing -> error ("Unknown reader: " ++ arg) )

137+ Nothing -> error ("Unknown reader: " ++ arg) )

126 "FORMAT")

138 "FORMAT")

139+ ("Source format (" ++

127− ("Source format (" ++ (concatMap (\(name, fn) -> " " ++ name) readers) ++ " )")

140+ (concatMap (\(name, fn) -> " " ++ name) readers) ++ " )")

128

141

129 , Option "tw" ["to","write"]

142 , Option "tw" ["to","write"]

130 (ReqArg

143 (ReqArg

131 (\arg opt -> case (lookup (map toLower arg) writers) of

144 (\arg opt -> case (lookup (map toLower arg) writers) of

132− Just (writer, defaultHeader) ->

145+ Just (writer, defaultHeader) ->

133− return opt { optWriter = writer,

146+ return opt { optWriter = writer,

134− optDefaultHeader = defaultHeader }

147+ optDefaultHeader = defaultHeader }

135− Nothing -> error ("Unknown writer: " ++ arg) )

148+ Nothing -> error ("Unknown writer: " ++ arg) )

136 "FORMAT")

149 "FORMAT")

137 ("Output format (" ++ (concatMap (\(name, fn) -> " " ++ name) writers) ++ " )")

150 ("Output format (" ++ (concatMap (\(name, fn) -> " " ++ name) writers) ++ " )")

138

151

@@ -164,7 +177,8 @@ options =

164

177

165 , Option "m" ["asciimathml"]

178 , Option "m" ["asciimathml"]

166 (NoArg

179 (NoArg

167− (\opt -> return opt { optASCIIMathML = True, optStandalone = True }))

180+ (\opt -> return opt { optASCIIMathML = True,

181+ optStandalone = True }))

168 "Use ASCIIMathML script in html output"

182 "Use ASCIIMathML script in html output"

169

183

170 , Option "i" ["incremental"]

184 , Option "i" ["incremental"]

@@ -179,7 +193,8 @@ options =

179

193

180 , Option "c" ["css"]

194 , Option "c" ["css"]

181 (ReqArg

195 (ReqArg

182− (\arg opt -> return opt { optCSS = arg, optStandalone = True })

196+ (\arg opt -> return opt { optCSS = arg,

197+ optStandalone = True })

183 "CSS")

198 "CSS")

184 "Link to CSS style sheet"

199 "Link to CSS style sheet"

185

200

@@ -187,7 +202,8 @@ options =

187 (ReqArg

202 (ReqArg

188 (\arg opt -> do

203 (\arg opt -> do

189 text <- readFile arg

204 text <- readFile arg

190− return opt { optIncludeInHeader = text, optStandalone = True })

205+ return opt { optIncludeInHeader = text,

206+ optStandalone = True })

191 "FILENAME")

207 "FILENAME")

192 "File to include at end of header (implies -s)"

208 "File to include at end of header (implies -s)"

193

209

@@ -211,13 +227,15 @@ options =

211 (ReqArg

227 (ReqArg

212 (\arg opt -> do

228 (\arg opt -> do

213 text <- readFile arg

229 text <- readFile arg

214− return opt { optCustomHeader = text, optStandalone = True })

230+ return opt { optCustomHeader = text,

231+ optStandalone = True })

215 "FILENAME")

232 "FILENAME")

216 "File to use for custom header (implies -s)"

233 "File to use for custom header (implies -s)"

217

234

218 , Option "T" ["title-prefix"]

235 , Option "T" ["title-prefix"]

219 (ReqArg

236 (ReqArg

220− (\arg opt -> return opt { optTitlePrefix = arg, optStandalone = True })

237+ (\arg opt -> return opt { optTitlePrefix = arg,

238+ optStandalone = True })

221 "STRING")

239 "STRING")

222 "String to prefix to HTML window title"

240 "String to prefix to HTML window title"

223

241

@@ -225,8 +243,8 @@ options =

225 (ReqArg

243 (ReqArg

226 (\arg opt -> do

244 (\arg opt -> do

227 let header = case (lookup arg writers) of

245 let header = case (lookup arg writers) of

228− Just (writer, head) -> head

246+ Just (writer, head) -> head

229− Nothing -> error ("Unknown reader: " ++ arg)

247+ Nothing -> error ("Unknown reader: " ++ arg)

230 hPutStrLn stdout header

248 hPutStrLn stdout header

231 exitWith ExitSuccess)

249 exitWith ExitSuccess)

232 "FORMAT")

250 "FORMAT")

@@ -267,13 +285,14 @@ main = do

267 let startParserState = defaultParserState { stateParseRaw = parseRaw,

285 let startParserState = defaultParserState { stateParseRaw = parseRaw,

268 stateTabStop = tabStop,

286 stateTabStop = tabStop,

269 stateStandalone = standalone }

287 stateStandalone = standalone }

270− let csslink = if (css == "") then

288+ let csslink = if (css == "")

271− ""

289+ then ""

272− else

273− "<link rel=\"stylesheet\" href=\"" ++ css ++

290+ else "<link rel=\"stylesheet\" href=\"" ++ css ++

274− "\" type=\"text/css\" media=\"all\" />\n"

291+ "\" type=\"text/css\" media=\"all\" />\n"

275 let asciiMathMLLink = if asciiMathML then asciiMathMLScript else ""

292 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) ++

277 csslink ++ asciiMathMLLink ++ includeHeader

296 csslink ++ asciiMathMLLink ++ includeHeader

278 let writerOptions = WriterOptions { writerStandalone = standalone,

297 let writerOptions = WriterOptions { writerStandalone = standalone,

279 writerHeader = header,

298 writerHeader = header,

src/Text/Pandoc/Definition.hs+24−10

@@ -1,5 +1,15 @@

1+{- |

2+ Module : Text.Pandoc.Definition

4+ License : GNU GPL, version 2 or above

6+ Maintainer : John MacFarlane <jgm at berkeley dot edu>

7+ Stability : unstable

8+ Portability : portable

1−-- | Definition of 'Pandoc' data structure for format-neutral representation

10+Definition of 'Pandoc' data structure for format-neutral representation

2−-- of documents.

11+of documents.

12+-}

3module Text.Pandoc.Definition where

13module Text.Pandoc.Definition where

5data Pandoc = Pandoc Meta [Block] deriving (Eq, Read, Show)

15data Pandoc = Pandoc Meta [Block] deriving (Eq, Read, Show)

@@ -17,21 +27,24 @@ data Block

17 | Blank -- ^ A blank line

27 | Blank -- ^ A blank line

18 | Null -- ^ Nothing

28 | Null -- ^ Nothing

19 | Para [Inline] -- ^ Paragraph

29 | 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'

21 | CodeBlock String -- ^ Code block (literal)

31 | CodeBlock String -- ^ Code block (literal)

22 | RawHtml String -- ^ Raw HTML block (literal)

32 | RawHtml String -- ^ Raw HTML block (literal)

23 | BlockQuote [Block] -- ^ Block quote (list of blocks)

33 | BlockQuote [Block] -- ^ Block quote (list of blocks)

24− | OrderedList [[Block]] -- ^ Ordered list (list of items, each a list of blocks)

34+ | OrderedList [[Block]] -- ^ Ordered list (list of items, each

35+ -- a list of blocks)

25− | BulletList [[Block]] -- ^ Bullet list (list of items, each a list of blocks)

36+ | BulletList [[Block]] -- ^ Bullet list (list of items, each

37+ -- a list of blocks)

26− | Header Int [Inline] -- ^ Header - level (integer) and text (list of inlines)

38+ | Header Int [Inline] -- ^ Header - level (integer) and text (inlines)

27 | HorizontalRule -- ^ Horizontal rule

39 | 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)

29 deriving (Eq, Read, Show)

42 deriving (Eq, Read, Show)

31-- | Target for a link: either a URL or an indirect (labeled) reference.

44-- | Target for a link: either a URL or an indirect (labeled) reference.

32data Target

45data Target

33 = Src String String -- ^ First string is URL, second is title

46 = 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

35 deriving (Show, Eq, Read)

48 deriving (Show, Eq, Read)

37-- | Inline elements.

50-- | Inline elements.

@@ -42,9 +55,10 @@ data Inline

42 | Code String -- ^ Inline code (literal)

55 | Code String -- ^ Inline code (literal)

43 | Space -- ^ Inter-word space

56 | Space -- ^ Inter-word space

44 | LineBreak -- ^ Hard line break

57 | LineBreak -- ^ Hard line break

45− | TeX String -- ^ LaTeX code (literal)

58+ | TeX String -- ^ LaTeX code (literal)

46 | HtmlInline String -- ^ HTML code (literal)

59 | HtmlInline String -- ^ HTML code (literal)

47 | Link [Inline] Target -- ^ Hyperlink: text (list of inlines) and target

60 | 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

49 | NoteRef String -- ^ Footnote or endnote reference

63 | NoteRef String -- ^ Footnote or endnote reference

50 deriving (Show, Eq, Read)

64 deriving (Show, Eq, Read)

src/Text/Pandoc/HtmlEntities.hs+21−10

@@ -1,12 +1,22 @@

1+{- |

2+ Module : Text.Pandoc.HtmlEntities

4+ License : GNU GPL, version 2 or above

6+ Maintainer : John MacFarlane <jgm at berkeley dot edu>

7+ Stability : unstable

8+ Portability : portable

1−-- | Functions for encoding unicode characters as HTML entity

10+Functions for encoding unicode characters as HTML entity references,

2−-- references, and vice versa.

11+and vice versa.

12+-}

3module Text.Pandoc.HtmlEntities (

13module Text.Pandoc.HtmlEntities (

4 htmlEntityToChar,

14 htmlEntityToChar,

5 charToHtmlEntity,

15 charToHtmlEntity,

6 decodeEntities,

16 decodeEntities,

7 encodeEntities

17 encodeEntities

8 ) where

18 ) where

9−import Char ( chr, ord )

19+import Data.Char ( chr, ord )

10import Text.Regex ( mkRegex, matchRegexAll )

20import Text.Regex ( mkRegex, matchRegexAll )

11import Maybe ( fromMaybe )

21import Maybe ( fromMaybe )

@@ -19,13 +29,15 @@ characterEntity = mkRegex "&#[0-9]+;|&[A-Za-z0-9]+;"

19decodeEntities :: String -> String

29decodeEntities :: String -> String

20decodeEntities str =

30decodeEntities str =

21 case (matchRegexAll characterEntity str) of

31 case (matchRegexAll characterEntity str) of

22− Nothing -> str

32+ Nothing -> str

23− Just (before, match, rest, _) -> before ++ replacement ++ (decodeEntities rest)

33+ Just (before, match, rest, _) -> before ++ replacement ++

34+ (decodeEntities rest)

24 where replacement = case (htmlEntityToChar match) of

35 where replacement = case (htmlEntityToChar match) of

25 Just ch -> [ch]

36 Just ch -> [ch]

26 Nothing -> match

37 Nothing -> match

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.

29encodeEntities :: String -> String

41encodeEntities :: String -> String

30encodeEntities = concatMap (\c -> fromMaybe [c] (charToHtmlEntity c))

42encodeEntities = concatMap (\c -> fromMaybe [c] (charToHtmlEntity c))

@@ -44,10 +56,9 @@ htmlEntityToChar entity =

44charToHtmlEntity :: Char -> Maybe String

56charToHtmlEntity :: Char -> Maybe String

45charToHtmlEntity char =

57charToHtmlEntity char =

46 let matches = filter (\(entity, character) -> (character == char)) htmlEntityTable in

58 let matches = filter (\(entity, character) -> (character == char)) htmlEntityTable in

47− if (length matches) == 0 then

59+ if (length matches) == 0

48− Nothing

60+ then Nothing

49− else

50− Just (fst (head matches))

61+ else Just (fst (head matches))

52htmlEntityTable :: [(String, Char)]

63htmlEntityTable :: [(String, Char)]

53htmlEntityTable = [

64htmlEntityTable = [

src/Text/Pandoc/Readers/HTML.hs+47−38

@@ -1,4 +1,14 @@

1+{- |

2+ Module : Text.Pandoc.Readers.HTML

4+ License : GNU GPL, version 2 or above

6+ Maintainer : John MacFarlane <jgm at berkeley dot edu>

7+ Stability : unstable

8+ Portability : portable

1−-- | Converts HTML to 'Pandoc' document.

10+Conversion of HTML to 'Pandoc' document.

11+-}

2module Text.Pandoc.Readers.HTML (

12module Text.Pandoc.Readers.HTML (

3 readHtml,

13 readHtml,

4 rawHtmlInline,

14 rawHtmlInline,

@@ -30,10 +40,11 @@ testString = testStringWith parseHtml

30-- Constants

40-- Constants

31--

41--

33−inlineHtmlTags = ["a", "abbr", "acronym", "b", "basefont", "bdo", "big", "br", "cite",

43+inlineHtmlTags = ["a", "abbr", "acronym", "b", "basefont", "bdo", "big",

34− "code", "dfn", "em", "font", "i", "img", "input", "kbd", "label", "q",

44+ "br", "cite", "code", "dfn", "em", "font", "i", "img",

45+ "input", "kbd", "label", "q", "s", "samp", "select",

35− "s", "samp", "select", "small", "span", "strike", "strong", "sub",

46+ "small", "span", "strike", "strong", "sub", "sup",

36− "sup", "textarea", "tt", "u", "var"]

47+ "textarea", "tt", "u", "var"]

38--

49--

39-- HTML utility functions

50-- HTML utility functions

@@ -50,9 +61,10 @@ inlinesTilEnd tag = try (do

50 return inlines)

61 return inlines)

52-- extract type from a tag: e.g. br from <br>, < br >, </br>, etc.

63-- extract type from a tag: e.g. br from <br>, < br >, </br>, etc.

64+extractTagType tag =

53−extractTagType tag = case (matchRegex (mkRegex "<[[:space:]]*/?([A-Za-z0-9]+)") tag) of

65+ case (matchRegex (mkRegex "<[[:space:]]*/?([A-Za-z0-9]+)") tag) of

54− Just [match] -> (map toLower match)

66+ Just [match] -> (map toLower match)

55− Nothing -> ""

67+ Nothing -> ""

57anyHtmlTag = try (do

69anyHtmlTag = try (do

58 char '<'

70 char '<'

@@ -90,7 +102,8 @@ htmlTag tag = try (do

102

91-- parses a quoted html attribute value

103-- parses a quoted html attribute value

92quoted quoteChar = do

104quoted quoteChar = do

93− result <- between (char quoteChar) (char quoteChar) (many (noneOf [quoteChar]))

105+ result <- between (char quoteChar) (char quoteChar)

106+ (many (noneOf [quoteChar]))

94 return (result, [quoteChar])

107 return (result, [quoteChar])

108

96htmlAttributes = do

109htmlAttributes = do

@@ -116,9 +129,11 @@ htmlRegularAttribute = try (do

116 spaces

129 spaces

117 (content, quoteStr) <- choice [ (quoted '\''),

130 (content, quoteStr) <- choice [ (quoted '\''),

118 (quoted '"'),

131 (quoted '"'),

132+ (do

119− (do{ a <- (many (alphaNum <|> (oneOf "-._:")));

133+ a <- many (alphaNum <|> (oneOf "-._:"))

120− return (a,"")} ) ]

134+ return (a,"")) ]

135+ return (name, content,

121− return (name, content, (" " ++ name ++ "=" ++ quoteStr ++ content ++ quoteStr)))

136+ (" " ++ name ++ "=" ++ quoteStr ++ content ++ quoteStr)))

122

137

123htmlEndTag tag = try (do

138htmlEndTag tag = try (do

124 char '<'

139 char '<'

@@ -135,17 +150,11 @@ isInline tag = (extractTagType tag) `elem` inlineHtmlTags

135

150

136anyHtmlBlockTag = try (do

151anyHtmlBlockTag = try (do

137 tag <- choice [anyHtmlTag, anyHtmlEndTag]

152 tag <- choice [anyHtmlTag, anyHtmlEndTag]

138− if isInline tag then

153+ if isInline tag then fail "inline tag" else return tag)

139− fail "inline tag"

140− else

141− return tag)

142

154

143anyHtmlInlineTag = try (do

155anyHtmlInlineTag = try (do

144 tag <- choice [ anyHtmlTag, anyHtmlEndTag ]

156 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")

149

158

150-- scripts must be treated differently, because they can contain <> etc.

159-- scripts must be treated differently, because they can contain <> etc.

151htmlScript = try (do

160htmlScript = try (do

@@ -155,13 +164,11 @@ htmlScript = try (do

155

164

156rawHtmlBlock = try (do

165rawHtmlBlock = try (do

157 notFollowedBy' (choice [htmlTag "/body", htmlTag "/html"])

166 notFollowedBy' (choice [htmlTag "/body", htmlTag "/html"])

158− body <- choice [htmlScript, anyHtmlBlockTag, htmlComment, xmlDec, definition]

167+ body <- choice [htmlScript, anyHtmlBlockTag, htmlComment, xmlDec,

168+ definition]

159 sp <- (many space)

169 sp <- (many space)

160 state <- getState

170 state <- getState

161− if stateParseRaw state then

171+ if stateParseRaw state then return (RawHtml (body ++ sp)) else return Null)

162− return (RawHtml (body ++ sp))

163− else

164− return Null)

165

172

166htmlComment = try (do

173htmlComment = try (do

167 string "<!--"

174 string "<!--"

@@ -266,10 +273,10 @@ headerLevel n = try (do

266hrule = try (do

273hrule = try (do

267 (tag, attribs) <- htmlTag "hr"

274 (tag, attribs) <- htmlTag "hr"

268 state <- getState

275 state <- getState

269− if (not (null attribs)) && (stateParseRaw state) then

276+ if (not (null attribs)) && (stateParseRaw state)

270− unexpected "attributes in hr" -- in this case we want to parse it as raw html

277+ then -- in this case we want to parse it as raw html

271− else

278+ unexpected "attributes in hr"

272− return HorizontalRule)

279+ else return HorizontalRule)

273

280

274--

281--

275-- code blocks

282-- code blocks

@@ -352,29 +359,31 @@ inline = choice [ text, special ] <?> "inline"

352

359

353text = choice [ entity, strong, emph, code, str, linebreak, whitespace ] <?> "text"

360text = choice [ entity, strong, emph, code, str, linebreak, whitespace ] <?> "text"

354

361

355−special = choice [ link, image, rawHtmlInline ] <?> "link, inline html, or image"

362+special = choice [ link, image, rawHtmlInline ] <?>

363+ "link, inline html, or image"

356

364

357entity = try (do

365entity = try (do

358 char '&'

366 char '&'

359− body <- choice [(many1 letter),

367+ body <- choice [(many1 letter), (try (do

368+ char '#'

360− (try (do{ char '#'; num <- many1 digit; return ("#" ++ num)}))]

369+ num <- many1 digit

370+ return ("#" ++ num)))]

361 char ';'

371 char ';'

362 return (Str [fromMaybe '?' (htmlEntityToChar ("&" ++ body ++ ";"))]))

372 return (Str [fromMaybe '?' (htmlEntityToChar ("&" ++ body ++ ";"))]))

363

373

364code = try (do

374code = try (do

365 htmlTag "code"

375 htmlTag "code"

366 result <- manyTill anyChar (htmlEndTag "code")

376 result <- manyTill anyChar (htmlEndTag "code")

367− -- remove internal line breaks, leading and trailing space, and decode entities

377+ -- remove internal line breaks, leading and trailing space,

378+ -- and decode entities

368− let result' = decodeEntities $ removeLeadingTrailingSpace $ joinWithSep " " $ lines result

379+ let result' = decodeEntities $ removeLeadingTrailingSpace $

380+ joinWithSep " " $ lines result

369 return (Code result'))

381 return (Code result'))

370

382

371rawHtmlInline = do

383rawHtmlInline = do

372 result <- choice [htmlScript, anyHtmlInlineTag]

384 result <- choice [htmlScript, anyHtmlInlineTag]

373 state <- getState

385 state <- getState

374− if stateParseRaw state then

386+ if stateParseRaw state then return (HtmlInline result) else return (Str "")

375− return (HtmlInline result)

376− else

377− return (Str "")

378

387

379betweenTags tag = try (do

388betweenTags tag = try (do

380 htmlTag tag

389 htmlTag tag

src/Text/Pandoc/Readers/LaTeX.hs+66−52

@@ -1,4 +1,14 @@

1+{- |

2+ Module : Text.Pandoc.Readers.LaTeX

4+ License : GNU GPL, version 2 or above

6+ Maintainer : John MacFarlane <jgm at berkeley dot edu>

7+ Stability : unstable

8+ Portability : portable

1−-- | Converts LaTeX to 'Pandoc' document.

10+Conversion of LaTeX to 'Pandoc' document.

11+-}

2module Text.Pandoc.Readers.LaTeX (

12module Text.Pandoc.Readers.LaTeX (

3 readLaTeX,

13 readLaTeX,

4 rawLaTeXInline,

14 rawLaTeXInline,

@@ -81,7 +91,8 @@ end name = try (do

81 spaces

91 spaces

82 return name)

92 return name)

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.

85environment name = try (do

96environment name = try (do

86 begin name

97 begin name

87 spaces

98 spaces

@@ -104,15 +115,16 @@ anyEnvironment = try (do

104

115

105-- | Process LaTeX preamble, extracting metadata.

116-- | Process LaTeX preamble, extracting metadata.

106processLaTeXPreamble = do

117processLaTeXPreamble = do

107− manyTill (choice [bibliographic, comment, unknownCommand, nullBlock]) (try (string "\\begin{document}"))

118+ manyTill (choice [bibliographic, comment, unknownCommand, nullBlock])

119+ (try (string "\\begin{document}"))

108 spaces

120 spaces

109

121

110-- | Parse LaTeX and return 'Pandoc'.

122-- | Parse LaTeX and return 'Pandoc'.

111parseLaTeX = do

123parseLaTeX = do

112− option () processLaTeXPreamble -- preamble might not be present, if a fragment

124+ option () processLaTeXPreamble -- preamble might not be present (fragment)

113 blocks <- parseBlocks

125 blocks <- parseBlocks

114 spaces

126 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)

116 spaces

128 spaces

117 eof

129 eof

118 state <- getState

130 state <- getState

@@ -122,7 +134,8 @@ parseLaTeX = do

122 let title' = stateTitle state

134 let title' = stateTitle state

123 let authors' = stateAuthors state

135 let authors' = stateAuthors state

124 let date' = stateDate state

136 let date' = stateDate state

137+ return (Pandoc (Meta title' authors' date')

125− return (Pandoc (Meta title' authors' date') (blocks' ++ (reverse noteBlocks) ++ (reverse keyBlocks)))

138+ (blocks' ++ (reverse noteBlocks) ++ (reverse keyBlocks)))

126

139

127--

140--

128-- parsing blocks

141-- parsing blocks

@@ -133,9 +146,10 @@ parseBlocks = do

133 result <- many block

146 result <- many block

134 return result

147 return result

135

148

136−block = choice [ hrule, codeBlock, header, list, blockQuote, mathBlock, comment,

149+block = choice [ hrule, codeBlock, header, list, blockQuote, mathBlock,

137− bibliographic, para, specialEnvironment, itemBlock, unknownEnvironment,

150+ comment, bibliographic, para, specialEnvironment,

138− unknownCommand ] <?> "block"

151+ itemBlock, unknownEnvironment, unknownCommand ] <?>

152+ "block"

139

153

140--

154--

141-- header blocks

155-- header blocks

@@ -157,7 +171,8 @@ headerLevel n = try (do

157--

171--

158

172

159hrule = try (do

173hrule = 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" ]

161 spaces

176 spaces

162 return HorizontalRule)

177 return HorizontalRule)

163

178

@@ -166,8 +181,10 @@ hrule = try (do

166--

181--

167

182

168codeBlock = try (do

183codeBlock = try (do

169− string "\\begin{verbatim}" -- don't use begin function because it gobbles whitespace

184+ string "\\begin{verbatim}" -- don't use begin function because it

185+ -- gobbles whitespace

170− option "" blanklines -- we want to gobble blank lines, but not leading space

186+ option "" blanklines -- we want to gobble blank lines, but not

187+ -- leading space

171 contents <- manyTill anyChar (try (string "\\end{verbatim}"))

188 contents <- manyTill anyChar (try (string "\\end{verbatim}"))

172 spaces

189 spaces

173 return (CodeBlock (stripTrailingNewlines contents)))

190 return (CodeBlock (stripTrailingNewlines contents)))

@@ -266,7 +283,8 @@ authors = try (do

266 string "\\author{"

283 string "\\author{"

267 authors <- manyTill anyChar (char '}')

284 authors <- manyTill anyChar (char '}')

268 spaces

285 spaces

269− let authors' = map removeLeadingTrailingSpace $ lines $ gsub "\\\\\\\\" "\n" authors

286+ let authors' = map removeLeadingTrailingSpace $ lines $

287+ gsub "\\\\\\\\" "\n" authors

270 updateState (\state -> state { stateAuthors = authors' })

288 updateState (\state -> state { stateAuthors = authors' })

271 return Null)

289 return Null)

272

290

@@ -286,21 +304,19 @@ date = try (do

286itemBlock = try (do

304itemBlock = try (do

287 ("item", _, args) <- command

305 ("item", _, args) <- command

288 state <- getState

306 state <- getState

289− if (stateParserContext state == ListItemState) then

307+ if (stateParserContext state == ListItemState)

290− fail "item should be handled by list block"

308+ then fail "item should be handled by list block"

291− else

292− if null args then

309+ else if null args

293− return Null

310+ then return Null

294− else

295− return (Plain [Str (stripFirstAndLast (head args))]))

311+ else return (Plain [Str (stripFirstAndLast (head args))]))

296

312

297--

313--

298-- raw LaTeX

314-- raw LaTeX

299--

315--

300

316

301specialEnvironment = do -- these are always parsed as raw

317specialEnvironment = do -- these are always parsed as raw

302− followedBy' (choice (map (\name -> begin name) ["tabular", "figure", "tabbing", "eqnarry",

318+ followedBy' (choice (map (\name -> begin name) ["tabular", "figure",

303− "picture", "table", "verse", "theorem"]))

319+ "tabbing", "eqnarry", "picture", "table", "verse", "theorem"]))

304 rawLaTeXEnvironment

320 rawLaTeXEnvironment

305

321

306-- | Parse any LaTeX environment and return a Para block containing

322-- | Parse any LaTeX environment and return a Para block containing

@@ -316,18 +332,20 @@ rawLaTeXEnvironment = try (do

316 args <- option [] commandArgs

332 args <- option [] commandArgs

317 let argStr = concat args

333 let argStr = concat args

318 contents <- manyTill (choice [(many1 (noneOf "\\")),

334 contents <- manyTill (choice [(many1 (noneOf "\\")),

335+ (do

319− (do{ (Para [TeX str]) <- rawLaTeXEnvironment; return str }),

336+ (Para [TeX str]) <- rawLaTeXEnvironment

337+ return str),

338+ string "\\" ])

320− string "\\"]) (end name')

339+ (end name')

321 spaces

340 spaces

322 return (Para [TeX ("\\begin{" ++ name' ++ "}" ++ argStr ++

341 return (Para [TeX ("\\begin{" ++ name' ++ "}" ++ argStr ++

323− (concat contents) ++ "\\end{" ++ name' ++ "}")]))

342+ (concat contents) ++ "\\end{" ++ name' ++ "}")]))

324

343

325unknownEnvironment = try (do

344unknownEnvironment = try (do

326 state <- getState

345 state <- getState

327− result <- if stateParseRaw state then -- check to see whether we should include raw TeX

346+ result <- if stateParseRaw state -- check whether we should include raw TeX

328− rawLaTeXEnvironment -- if so, get the whole raw environment

347+ then rawLaTeXEnvironment -- if so, get whole raw environment

329− else

330− anyEnvironment -- otherwise just the contents

348+ else anyEnvironment -- otherwise just the contents

331 return result)

349 return result)

332

350

333unknownCommand = try (do

351unknownCommand = try (do

@@ -338,14 +356,12 @@ unknownCommand = try (do

338 spaces

356 spaces

339 let argStr = concat args

357 let argStr = concat args

340 state <- getState

358 state <- getState

341− if (name == "item") && ((stateParserContext state) == ListItemState) then

359+ if (name == "item") && ((stateParserContext state) == ListItemState)

342− fail "should not be parsed as raw"

360+ then fail "should not be parsed as raw"

343− else

344− string ""

361+ else string ""

345− if stateParseRaw state then

362+ if stateParseRaw state

346− return (Plain [TeX ("\\" ++ name ++ star ++ argStr)])

363+ then return (Plain [TeX ("\\" ++ name ++ star ++ argStr)])

347− else

348− return (Plain [Str (joinWithSep " " args)]))

364+ else return (Plain [Str (joinWithSep " " args)]))

349

365

350-- latex comment

366-- latex comment

351comment = try (do

367comment = try (do

@@ -358,9 +374,9 @@ comment = try (do

358-- inline

374-- inline

359--

375--

360

376

361−inline = choice [ strong, emph, ref, lab, code, linebreak, math, ldots, accentedChar,

377+inline = choice [ strong, emph, ref, lab, code, linebreak, math, ldots,

362− specialChar, specialInline, escapedChar, unescapedChar, str,

378+ accentedChar, specialChar, specialInline, escapedChar,

363− endline, whitespace ] <?> "inline"

379+ unescapedChar, str, endline, whitespace ] <?> "inline"

364

380

365specialInline = choice [ link, image, footnote, rawLaTeXInline ] <?>

381specialInline = choice [ link, image, footnote, rawLaTeXInline ] <?>

366 "link, raw TeX, note, or image"

382 "link, raw TeX, note, or image"

@@ -397,8 +413,8 @@ accentTable =

397 ('o', [('`', 242), ('\'', 243), ('^', 244), ('~', 245), ('"', 246)]),

413 ('o', [('`', 242), ('\'', 243), ('^', 244), ('~', 245), ('"', 246)]),

398 ('u', [('`', 249), ('\'', 250), ('^', 251), ('"', 252)]) ]

414 ('u', [('`', 249), ('\'', 250), ('^', 251), ('"', 252)]) ]

399

415

400−specialAccentedChar = choice [ ccedil, aring, iuml, szlig, aelig, oslash, pound,

416+specialAccentedChar = choice [ ccedil, aring, iuml, szlig, aelig,

401− euro, copyright, sect ]

417+ oslash, pound, euro, copyright, sect ]

402

418

403ccedil = try (do

419ccedil = try (do

404 char '\\'

420 char '\\'

@@ -563,15 +579,14 @@ image = try (do

563

579

564footnote = try (do

580footnote = try (do

565 (name, _, (contents:[])) <- command

581 (name, _, (contents:[])) <- command

566− if ((name == "footnote") || (name == "thanks")) then

582+ if ((name == "footnote") || (name == "thanks"))

567− string ""

583+ then string ""

568− else

569− fail "not a footnote or thanks command"

584+ else fail "not a footnote or thanks command"

570 let contents' = stripFirstAndLast contents

585 let contents' = stripFirstAndLast contents

571 state <- getState

586 state <- getState

572 let blocks = case runParser parseBlocks state "footnote" contents of

587 let blocks = case runParser parseBlocks state "footnote" contents of

573− Left err -> error $ "Input:\n" ++ show contents' ++

588+ Left err -> error $ "Input:\n" ++ show contents' ++

574− "\nError:\n" ++ show err

589+ "\nError:\n" ++ show err

575 Right result -> result

590 Right result -> result

576 let notes = stateNoteBlocks state

591 let notes = stateNoteBlocks state

577 let nextRef = case notes of

592 let nextRef = case notes of

@@ -586,8 +601,7 @@ rawLaTeXInline = try (do

586 (name, star, args) <- command

601 (name, star, args) <- command

587 let argStr = concat args

602 let argStr = concat args

588 state <- getState

603 state <- getState

589− if ((name == "begin") || (name == "end") || (name == "item")) then

604+ if ((name == "begin") || (name == "end") || (name == "item"))

590− fail "not an inline command"

605+ then fail "not an inline command"

591− else

592− string ""

606+ else string ""

593 return (TeX ("\\" ++ name ++ star ++ argStr)))

607 return (TeX ("\\" ++ name ++ star ++ argStr)))

src/Text/Pandoc/Readers/Markdown.hs+312−289

@@ -1,4 +1,14 @@

1+{- |

2+ Module : Text.Pandoc.Readers.Markdown

4+ License : GNU GPL, version 2 or above

6+ Maintainer : John MacFarlane <jgm at berkeley dot edu>

7+ Stability : unstable

8+ Portability : portable

1−-- | Convert markdown to Pandoc document.

10+Conversion of markdown-formatted plain text to 'Pandoc' document.

11+-}

2module Text.Pandoc.Readers.Markdown (

12module Text.Pandoc.Readers.Markdown (

3 readMarkdown

13 readMarkdown

4 ) where

14 ) where

@@ -8,8 +18,8 @@ import Text.ParserCombinators.Pandoc

8import Text.Pandoc.Definition

18import Text.Pandoc.Definition

9import Text.Pandoc.Readers.LaTeX ( rawLaTeXInline, rawLaTeXEnvironment )

19import Text.Pandoc.Readers.LaTeX ( rawLaTeXInline, rawLaTeXEnvironment )

10import Text.Pandoc.Shared

20import Text.Pandoc.Shared

11−import Text.Pandoc.Readers.HTML ( rawHtmlInline, rawHtmlBlock, anyHtmlBlockTag,

21+import Text.Pandoc.Readers.HTML ( rawHtmlInline, rawHtmlBlock,

12− anyHtmlInlineTag )

22+ anyHtmlBlockTag, anyHtmlInlineTag )

13import Text.Pandoc.HtmlEntities ( decodeEntities )

23import Text.Pandoc.HtmlEntities ( decodeEntities )

14import Text.Regex ( matchRegex, mkRegex )

24import Text.Regex ( matchRegex, mkRegex )

15import Text.ParserCombinators.Parsec

25import Text.ParserCombinators.Parsec

@@ -57,9 +67,10 @@ blockQuoteChar = '>'

57hyphenChar = '-'

67hyphenChar = '-'

59-- treat these as potentially non-text when parsing inline:

69-- treat these as potentially non-text when parsing inline:

60−specialChars = [escapeChar, labelStart, labelEnd, emphStart, emphEnd, emphStartAlt,

70+specialChars = [escapeChar, labelStart, labelEnd, emphStart, emphEnd,

61− emphEndAlt, codeStart, codeEnd, autoLinkEnd, autoLinkStart, mathStart,

71+ emphStartAlt, emphEndAlt, codeStart, codeEnd, autoLinkEnd,

62− mathEnd, imageStart, noteStart, hyphenChar]

72+ autoLinkStart, mathStart, mathEnd, imageStart, noteStart,

73+ hyphenChar]

64--

75--

65-- auxiliary functions

76-- auxiliary functions

@@ -115,14 +126,16 @@ numberOfNote (Note ref _) = (read ref)

115numberOfNote _ = 0

126numberOfNote _ = 0

116

127

117parseMarkdown = do

128parseMarkdown = 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

119 (title, author, date) <- option ([],[],"") titleBlock

131 (title, author, date) <- option ([],[],"") titleBlock

120 blocks <- parseBlocks

132 blocks <- parseBlocks

121 let blocks' = filter (/= Null) blocks

133 let blocks' = filter (/= Null) blocks

122 state <- getState

134 state <- getState

123 let keys = reverse $ stateKeyBlocks state

135 let keys = reverse $ stateKeyBlocks state

124 let notes = reverse $ stateNoteBlocks state

136 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

126 return (Pandoc (Meta title author date) (blocks' ++ sortedNotes ++ keys))

139 return (Pandoc (Meta title author date) (blocks' ++ sortedNotes ++ keys))

127

140

128--

141--

@@ -133,8 +146,9 @@ parseBlocks = do

133 result <- manyTill block eof

146 result <- manyTill block eof

134 return result

147 return result

135

148

136−block = choice [ codeBlock, note, referenceKey, header, hrule, list, blockQuote, rawHtmlBlocks,

149+block = choice [ codeBlock, note, referenceKey, header, hrule, list,

150+ blockQuote, rawHtmlBlocks, rawLaTeXEnvironment, para,

137− rawLaTeXEnvironment, para, plain, blankBlock, nullBlock ] <?> "block"

151+ plain, blankBlock, nullBlock ] <?> "block"

138

152

139--

153--

140-- header blocks

154-- header blocks

@@ -154,33 +168,33 @@ atxClosing = try (do

154 newline

168 newline

155 option "" blanklines)

169 option "" blanklines)

156

170

171+setextHeader = choice $

157−setextHeader = choice (map (\x -> setextH x) (enumFromTo 1 (length setextHChars)))

172+ map (\x -> setextH x) (enumFromTo 1 (length setextHChars))

158

173

159setextH n = try (do

174setextH n = try (do

160− txt <- many1 (do {notFollowedBy newline; inline})

175+ txt <- many1 (do {notFollowedBy newline; inline})

161− endline

176+ endline

162− many1 (char (setextHChars !! (n-1)))

177+ many1 (char (setextHChars !! (n-1)))

163− skipSpaces

178+ skipSpaces

164− newline

179+ newline

165− option "" blanklines

180+ option "" blanklines

166− return (Header n (normalizeSpaces txt)))

181+ return (Header n (normalizeSpaces txt)))

167

182

168--

183--

169-- hrule block

184-- hrule block

170--

185--

171

186

172−hruleWith chr =

187+hruleWith chr = try (do

173− try (do

174− skipSpaces

188+ skipSpaces

175− char chr

189+ char chr

176− skipSpaces

190+ skipSpaces

177− char chr

191+ char chr

178− skipSpaces

192+ skipSpaces

179− char chr

193+ char chr

180− skipMany (oneOf (chr:spaceChars))

194+ skipMany (oneOf (chr:spaceChars))

181− newline

195+ newline

182− option "" blanklines

196+ option "" blanklines

183− return HorizontalRule)

197+ return HorizontalRule)

184

198

185hrule = choice (map hruleWith hruleChars) <?> "hrule"

199hrule = choice (map hruleWith hruleChars) <?> "hrule"

186

200

@@ -189,9 +203,9 @@ hrule = choice (map hruleWith hruleChars) <?> "hrule"

189--

203--

190

204

191indentedLine = try (do

205indentedLine = try (do

192− indentSpaces

206+ indentSpaces

193− result <- manyTill anyChar newline

207+ result <- manyTill anyChar newline

194− return (result ++ "\n"))

208+ return (result ++ "\n"))

195

209

196-- two or more indented lines, possibly separated by blank lines

210-- two or more indented lines, possibly separated by blank lines

197indentedBlock = try (do

211indentedBlock = try (do

@@ -201,62 +215,66 @@ indentedBlock = try (do

201 return (res1 ++ blanks ++ res2))

215 return (res1 ++ blanks ++ res2))

202

216

203codeBlock = do

217codeBlock = do

204− result <- choice [indentedBlock, indentedLine]

218+ result <- choice [indentedBlock, indentedLine]

205− option "" blanklines

219+ option "" blanklines

206− return (CodeBlock (stripTrailingNewlines result))

220+ return (CodeBlock (stripTrailingNewlines result))

207

221

208--

222--

209-- note block

223-- note block

210--

224--

211

225

212rawLine = try (do

226rawLine = try (do

213− notFollowedBy' blankline

227+ notFollowedBy' blankline

214− notFollowedBy' noteMarker

228+ notFollowedBy' noteMarker

215− contents <- many1 nonEndline

229+ contents <- many1 nonEndline

216− end <- option "" (do

230+ end <- option "" (do

217− newline

231+ newline

218− option "" indentSpaces

232+ option "" indentSpaces

219− return "\n")

233+ return "\n")

220− return (contents ++ end))

234+ return (contents ++ end))

221

235

222rawLines = do

236rawLines = do

223 lines <- many1 rawLine

237 lines <- many1 rawLine

224 return (concat lines)

238 return (concat lines)

225

239

226note = try (do

240note = try (do

227− ref <- noteMarker

241+ ref <- noteMarker

228− char ':'

242+ char ':'

229− skipSpaces

243+ skipSpaces

230− skipEndline

244+ skipEndline

231− raw <- sepBy rawLines (try (do {blankline; indentSpaces}))

245+ raw <- sepBy rawLines (try (do {blankline; indentSpaces}))

232− option "" blanklines

246+ option "" blanklines

233− -- parse the extracted text, which may contain various block elements:

247+ -- parse the extracted text, which may contain various block elements:

234− state <- getState

248+ state <- getState

249+ let parsed = case runParser parseBlocks

235− let parsed = case runParser parseBlocks (state {stateParserContext = BlockQuoteState}) "block" ((joinWithSep "\n" raw) ++ "\n\n") of

250+ (state {stateParserContext = BlockQuoteState}) "block"

251+ ((joinWithSep "\n" raw) ++ "\n\n") of

236− Left err -> error $ "Raw block:\n" ++ show raw ++ "\nError:\n" ++ show err

252+ Left err -> error $ "Raw block:\n" ++ show raw ++

253+ "\nError:\n" ++ show err

237− Right result -> result

254+ Right result -> result

238− let identifiers = stateNoteIdentifiers state

255+ let identifiers = stateNoteIdentifiers state

239− case (findIndex (== ref) identifiers) of

256+ case (findIndex (== ref) identifiers) of

240− Just n -> updateState (\s -> s {stateNoteBlocks =

257+ Just n -> updateState (\s -> s {stateNoteBlocks =

241− (Note (show (n+1)) parsed):(stateNoteBlocks s)})

258+ (Note (show (n+1)) parsed):(stateNoteBlocks s)})

242− Nothing -> updateState id

259+ Nothing -> updateState id

243− return Null)

260+ return Null)

244

261

245--

262--

246-- block quotes

263-- block quotes

247--

264--

248

265

249emacsBoxQuote = try (do

266emacsBoxQuote = try (do

250− string ",----"

267+ string ",----"

251− manyTill anyChar newline

268+ manyTill anyChar newline

252− raw <- manyTill (try (do{ char '|';

269+ raw <- manyTill (try (do

270+ char '|'

253− option ' ' (char ' ');

271+ option ' ' (char ' ')

254− result <- manyTill anyChar newline;

272+ result <- manyTill anyChar newline

255− return result}))

273+ return result))

256− (string "`----")

274+ (string "`----")

257− manyTill anyChar newline

275+ manyTill anyChar newline

258− option "" blanklines

276+ option "" blanklines

259− return raw)

277+ return raw)

260

278

261emailBlockQuoteStart = try (do

279emailBlockQuoteStart = try (do

262 skipNonindentSpaces

280 skipNonindentSpaces

@@ -265,24 +283,28 @@ emailBlockQuoteStart = try (do

265 return "> ")

283 return "> ")

266

284

267emailBlockQuote = try (do

285emailBlockQuote = try (do

268− emailBlockQuoteStart

286+ emailBlockQuoteStart

269− raw <- sepBy (many (choice [nonEndline,

287+ raw <- sepBy (many (choice [nonEndline,

288+ (try (do

270− (try (do{ endline;

289+ endline

271− notFollowedBy' emailBlockQuoteStart;

290+ notFollowedBy' emailBlockQuoteStart

272− return '\n'}))]))

291+ return '\n'))]))

273− (try (do {newline; emailBlockQuoteStart}))

292+ (try (do {newline; emailBlockQuoteStart}))

274− newline <|> (do{ eof; return '\n'})

293+ newline <|> (do{ eof; return '\n' })

275− option "" blanklines

294+ option "" blanklines

276− return raw)

295+ return raw)

277

296

278blockQuote = do

297blockQuote = do

279− raw <- choice [ emailBlockQuote, emacsBoxQuote ]

298+ raw <- choice [ emailBlockQuote, emacsBoxQuote ]

280− -- parse the extracted block, which may contain various block elements:

299+ -- parse the extracted block, which may contain various block elements:

281− state <- getState

300+ state <- getState

301+ let parsed = case runParser parseBlocks

282− let parsed = case runParser parseBlocks (state {stateParserContext = BlockQuoteState}) "block" ((joinWithSep "\n" raw) ++ "\n\n") of

302+ (state {stateParserContext = BlockQuoteState}) "block"

303+ ((joinWithSep "\n" raw) ++ "\n\n") of

283− Left err -> error $ "Raw block:\n" ++ show raw ++ "\nError:\n" ++ show err

304+ Left err -> error $ "Raw block:\n" ++ show raw ++

305+ "\nError:\n" ++ show err

284− Right result -> result

306+ Right result -> result

285− return (BlockQuote parsed)

307+ return (BlockQuote parsed)

286

308

287--

309--

288-- list blocks

310-- list blocks

@@ -290,85 +312,81 @@ blockQuote = do

290

312

291list = choice [ bulletList, orderedList ] <?> "list"

313list = choice [ bulletList, orderedList ] <?> "list"

292

314

293−bulletListStart =

315+bulletListStart = try (do

294− try (do

295− option ' ' newline -- if preceded by a Plain block in a list context

316+ option ' ' newline -- if preceded by a Plain block in a list context

296− skipNonindentSpaces

317+ skipNonindentSpaces

297− notFollowedBy' hrule -- because hrules start out just like lists

318+ notFollowedBy' hrule -- because hrules start out just like lists

298− oneOf bulletListMarkers

319+ oneOf bulletListMarkers

299− spaceChar

320+ spaceChar

300− skipSpaces)

321+ skipSpaces)

301−

322+

302−orderedListStart =

323+orderedListStart = try (do

303− try (do

304− option ' ' newline -- if preceded by a Plain block in a list context

324+ option ' ' newline -- if preceded by a Plain block in a list context

305− skipNonindentSpaces

325+ skipNonindentSpaces

306− many1 digit <|> count 1 letter

326+ many1 digit <|> count 1 letter

307− oneOf orderedListDelimiters

327+ oneOf orderedListDelimiters

308− oneOf spaceChars

328+ oneOf spaceChars

309− skipSpaces)

329+ skipSpaces)

310

330

311-- parse a line of a list item (start = parser for beginning of list item)

331-- parse a line of a list item (start = parser for beginning of list item)

312listLine start = try (do

332listLine start = try (do

313 notFollowedBy' start

333 notFollowedBy' start

314 notFollowedBy blankline

334 notFollowedBy blankline

315− notFollowedBy' (do{ indentSpaces;

335+ notFollowedBy' (do

336+ indentSpaces

316− many (spaceChar);

337+ many (spaceChar)

317− choice [bulletListStart, orderedListStart]})

338+ choice [bulletListStart, orderedListStart])

318 line <- manyTill anyChar newline

339 line <- manyTill anyChar newline

319 return (line ++ "\n"))

340 return (line ++ "\n"))

320

341

321-- parse raw text for one list item, excluding start marker and continuations

342-- parse raw text for one list item, excluding start marker and continuations

322−rawListItem start =

343+rawListItem start = try (do

323− try (do

324− start

344+ start

325− result <- many1 (listLine start)

345+ result <- many1 (listLine start)

326− blanks <- many blankline

346+ blanks <- many blankline

327− return ((concat result) ++ blanks))

347+ return ((concat result) ++ blanks))

328

348

329-- continuation of a list item - indented and separated by blankline

349-- continuation of a list item - indented and separated by blankline

330-- or (in compact lists) endline.

350-- or (in compact lists) endline.

331-- note: nested lists are parsed as continuations

351-- note: nested lists are parsed as continuations

332−listContinuation start =

352+listContinuation start = try (do

333− try (do

334− followedBy' indentSpaces

353+ followedBy' indentSpaces

335− result <- many1 (listContinuationLine start)

354+ result <- many1 (listContinuationLine start)

336− blanks <- many blankline

355+ blanks <- many blankline

337− return ((concat result) ++ blanks))

356+ return ((concat result) ++ blanks))

338

357

339listContinuationLine start = try (do

358listContinuationLine start = try (do

340− notFollowedBy' blankline

359+ notFollowedBy' blankline

341− notFollowedBy' start

360+ notFollowedBy' start

342− option "" indentSpaces

361+ option "" indentSpaces

343− result <- manyTill anyChar newline

362+ result <- manyTill anyChar newline

344− return (result ++ "\n"))

363+ return (result ++ "\n"))

345−

364+

346−listItem start =

365+listItem start = try (do

347− try (do

348− first <- rawListItem start

366+ first <- rawListItem start

349− rest <- many (listContinuation start)

367+ rest <- many (listContinuation start)

350− -- parsing with ListItemState forces markers at beginning of lines to

368+ -- parsing with ListItemState forces markers at beginning of lines to

351− -- count as list item markers, even if not separated by blank space.

369+ -- count as list item markers, even if not separated by blank space.

352− -- see definition of "endline"

370+ -- see definition of "endline"

353− state <- getState

371+ state <- getState

372+ let parsed = case runParser parseBlocks

354− let parsed = case runParser parseBlocks (state {stateParserContext = ListItemState})

373+ (state {stateParserContext = ListItemState})

355− "block" raw of

374+ "block" raw of

356− Left err -> error $ "Raw block:\n" ++ raw ++ "\nError:\n" ++ show err

375+ Left err -> error $ "Raw block:\n" ++ raw ++

376+ "\nError:\n" ++ show err

357− Right result -> result

377+ Right result -> result

358− where raw = concat (first:rest)

378+ where raw = concat (first:rest)

359− return parsed)

379+ return parsed)

360−

380+

361−orderedList =

381+orderedList = try (do

362− try (do

363− items <- many1 (listItem orderedListStart)

382+ items <- many1 (listItem orderedListStart)

364− let items' = compactify items

383+ let items' = compactify items

365− return (OrderedList items'))

384+ return (OrderedList items'))

366−

385+

367−bulletList =

386+bulletList = try (do

368− try (do

369− items <- many1 (listItem bulletListStart)

387+ items <- many1 (listItem bulletListStart)

370− let items' = compactify items

388+ let items' = compactify items

371− return (BulletList items'))

389+ return (BulletList items'))

372

390

373--

391--

374-- paragraph block

392-- paragraph block

@@ -377,7 +395,10 @@ bulletList =

377para = try (do

395para = try (do

378 result <- many1 inline

396 result <- many1 inline

379 newline

397 newline

398+ choice [ (do

380− choice [ (do{ followedBy' (oneOfStrings [">", ",----"]); return "" }), blanklines ]

399+ followedBy' (oneOfStrings [">", ",----"])

400+ return "" ),

401+ blanklines ]

381 let result' = normalizeSpaces result

402 let result' = normalizeSpaces result

382 return (Para result'))

403 return (Para result'))

383

404

@@ -391,30 +412,28 @@ plain = do

391--

412--

392

413

393rawHtmlBlocks = try (do

414rawHtmlBlocks = try (do

394− htmlBlocks <- many1 rawHtmlBlock

415+ htmlBlocks <- many1 rawHtmlBlock

395− let combined = concatMap (\(RawHtml str) -> str) htmlBlocks

416+ let combined = concatMap (\(RawHtml str) -> str) htmlBlocks

396− let combined' = if (last combined == '\n') then

417+ let combined' = if (last combined == '\n')

397− init combined -- strip extra newline

418+ then init combined -- strip extra newline

398− else

399− combined

419+ else combined

400− return (RawHtml combined'))

420+ return (RawHtml combined'))

401

421

402--

422--

403-- reference key

423-- reference key

404--

424--

405

425

406−referenceKey =

426+referenceKey = try (do

407− try (do

408− skipSpaces

427+ skipSpaces

409− label <- reference

428+ label <- reference

410− char labelSep

429+ char labelSep

411− skipSpaces

430+ skipSpaces

412− option ' ' (char autoLinkStart)

431+ option ' ' (char autoLinkStart)

413− src <- many (noneOf (titleOpeners ++ [autoLinkEnd] ++ endLineChars))

432+ src <- many (noneOf (titleOpeners ++ [autoLinkEnd] ++ endLineChars))

414− option ' ' (char autoLinkEnd)

433+ option ' ' (char autoLinkEnd)

415− tit <- option "" title

434+ tit <- option "" title

416− blanklines

435+ blanklines

417− return (Key label (Src (removeTrailingSpace src) tit)))

436+ return (Key label (Src (removeTrailingSpace src) tit)))

418

437

419--

438--

420-- inline

439-- inline

@@ -423,10 +442,11 @@ referenceKey =

423text = choice [ math, strong, emph, code2, code1, str, linebreak, tabchar,

442text = choice [ math, strong, emph, code2, code1, str, linebreak, tabchar,

424 whitespace, endline ] <?> "text"

443 whitespace, endline ] <?> "text"

425

444

426−inline = choice [ rawLaTeXInline, escapedChar, special, hyphens, text, ltSign, symbol ] <?> "inline"

445+inline = choice [ rawLaTeXInline, escapedChar, special, hyphens, text,

446+ ltSign, symbol ] <?> "inline"

427

447

428−special = choice [ noteRef, inlineNote, link, referenceLink, rawHtmlInline, autoLink,

448+special = choice [ noteRef, inlineNote, link, referenceLink, rawHtmlInline,

429− image ] <?> "link, inline html, note, or image"

449+ autoLink, image ] <?> "link, inline html, note, or image"

430

450

431escapedChar = escaped anyChar

451escapedChar = escaped anyChar

432

452

@@ -443,30 +463,33 @@ symbol = do

443

463

444hyphens = try (do

464hyphens = try (do

445 result <- many1 (char '-')

465 result <- many1 (char '-')

446− if (length result) == 1 then

466+ if (length result) == 1

447− skipEndline -- don't want to treat endline after hyphen as a space

467+ then skipEndline -- don't want to treat endline after hyphen as a space

448− else

449− do{ string ""; return Space }

468+ else do{ string ""; return Space }

450 return (Str result))

469 return (Str result))

451

470

452-- parses inline code, between codeStart and codeEnd

471-- parses inline code, between codeStart and codeEnd

453−code1 =

472+code1 = try (do

454− try (do

455− char codeStart

473+ char codeStart

456− result <- many (noneOf [codeEnd])

474+ result <- many (noneOf [codeEnd])

457− char codeEnd

475+ char codeEnd

458− let result' = removeLeadingTrailingSpace $ joinWithSep " " $ lines result -- get rid of any internal newlines

476+ -- get rid of any internal newlines

477+ let result' = removeLeadingTrailingSpace $ joinWithSep " " $ lines result

459− return (Code result'))

478+ return (Code result'))

460

479

461-- parses inline code, between 2 codeStarts and 2 codeEnds

480-- parses inline code, between 2 codeStarts and 2 codeEnds

462−code2 =

481+code2 = try (do

463− try (do

464− string [codeStart, codeStart]

482+ string [codeStart, codeStart]

465− result <- manyTill anyChar (try (string [codeEnd, codeEnd]))

483+ result <- manyTill anyChar (try (string [codeEnd, codeEnd]))

466− let result' = removeLeadingTrailingSpace $ joinWithSep " " $ lines result -- get rid of any internal newlines

484+ let result' = removeLeadingTrailingSpace $ joinWithSep " " $ lines result

485+ -- get rid of any internal newlines

467− return (Code result'))

486+ return (Code result'))

468−

487+

469−mathWord = many1 (choice [(noneOf (" \t\n\\" ++ [mathEnd])), (try (do {c <- char '\\'; notFollowedBy (char mathEnd); return c}))])

488+mathWord = many1 (choice [ (noneOf (" \t\n\\" ++ [mathEnd])),

489+ (try (do

490+ c <- char '\\'

491+ notFollowedBy (char mathEnd)

492+ return c))])

470

493

471math = try (do

494math = try (do

472 char mathStart

495 char mathStart

@@ -477,12 +500,14 @@ math = try (do

477

500

478emph = do

501emph = do

479 result <- choice [ (enclosed (char emphStart) (char emphEnd) inline),

502 result <- choice [ (enclosed (char emphStart) (char emphEnd) inline),

480− (enclosed (char emphStartAlt) (char emphEndAlt) inline) ]

503+ (enclosed (char emphStartAlt) (char emphEndAlt) inline) ]

481 return (Emph (normalizeSpaces result))

504 return (Emph (normalizeSpaces result))

482

505

483strong = do

506strong = do

484− result <- choice [ (enclosed (count 2 (char emphStart)) (count 2 (char emphEnd)) inline),

507+ result <- choice [ (enclosed (count 2 (char emphStart))

508+ (count 2 (char emphEnd)) inline),

485− (enclosed (count 2 (char emphStartAlt)) (count 2 (char emphEndAlt)) inline)]

509+ (enclosed (count 2 (char emphStartAlt))

510+ (count 2 (char emphEndAlt)) inline) ]

486 return (Strong (normalizeSpaces result))

511 return (Strong (normalizeSpaces result))

487

512

488whitespace = do

513whitespace = do

@@ -507,23 +532,21 @@ str = do

507 return (Str (decodeEntities result))

532 return (Str (decodeEntities result))

508

533

509-- an endline character that can be treated as a space, not a structural break

534-- an endline character that can be treated as a space, not a structural break

510−endline =

535+endline = try (do

511− try (do

512− newline

536+ newline

513− -- next line would allow block quotes without preceding blank line

537+ -- next line would allow block quotes without preceding blank line

514− -- Markdown.pl does allow this, but there's a chance of a wrapped

538+ -- Markdown.pl does allow this, but there's a chance of a wrapped

515− -- greater-than sign triggering a block quote by accident...

539+ -- greater-than sign triggering a block quote by accident...

516−-- notFollowedBy' (choice [emailBlockQuoteStart, string ",----"])

540+ -- notFollowedBy' (choice [emailBlockQuoteStart, string ",----"])

517− notFollowedBy blankline

541+ notFollowedBy blankline

518− -- parse potential list starts at beginning of line differently if in a list:

542+ -- parse potential list-starts differently if in a list:

519− st <- getState

543+ st <- getState

520− if (stateParserContext st) == ListItemState then

544+ if (stateParserContext st) == ListItemState

521− do

545+ then do

522− notFollowedBy' orderedListStart

546+ notFollowedBy' orderedListStart

523− notFollowedBy' bulletListStart

547+ notFollowedBy' bulletListStart

524− else

525− option () pzero

548+ else option () pzero

526− return Space)

549+ return Space)

527

550

528--

551--

529-- links

552-- links

@@ -537,92 +560,92 @@ reference = do

537 return (normalizeSpaces label)

560 return (normalizeSpaces label)

538

561

539-- source for a link, with optional title

562-- source for a link, with optional title

540−source =

563+source = try (do

541− try (do

542− char srcStart

564+ char srcStart

543− option ' ' (char autoLinkStart)

565+ option ' ' (char autoLinkStart)

544− src <- many (noneOf ([srcEnd, autoLinkEnd] ++ titleOpeners))

566+ src <- many (noneOf ([srcEnd, autoLinkEnd] ++ titleOpeners))

545− option ' ' (char autoLinkEnd)

567+ option ' ' (char autoLinkEnd)

546− tit <- option "" title

568+ tit <- option "" title

547− skipSpaces

569+ skipSpaces

548− char srcEnd

570+ char srcEnd

549− return (Src (removeTrailingSpace src) tit))

571+ return (Src (removeTrailingSpace src) tit))

550−

572+

551−titleWith startChar endChar =

573+titleWith startChar endChar = try (do

552− try (do

553− skipSpaces

574+ skipSpaces

554− skipEndline -- a title can be on the next line from the source

575+ skipEndline -- a title can be on the next line from the source

555− skipSpaces

576+ skipSpaces

556− char startChar

577+ char startChar

557− tit <- manyTill (choice [ try (do {char '\\'; char endChar}),

578+ tit <- manyTill (choice [ try (do {char '\\'; char endChar}),

558− (noneOf (endChar:endLineChars)) ]) (char endChar)

579+ (noneOf (endChar:endLineChars)) ]) (char endChar)

559− let tit' = gsub "\"" """ tit

580+ let tit' = gsub "\"" """ tit

560− return tit')

581+ return tit')

561−

582+

562−title = choice [titleWith '(' ')', titleWith '"' '"', titleWith '\'' '\''] <?> "title"

583+title = choice [ titleWith '(' ')',

584+ titleWith '"' '"',

585+ titleWith '\'' '\''] <?> "title"

563

586

564link = choice [explicitLink, referenceLink] <?> "link"

587link = choice [explicitLink, referenceLink] <?> "link"

565

588

566−explicitLink =

589+explicitLink = try (do

567− try (do

568− label <- reference

590+ label <- reference

569− src <- source

591+ src <- source

570− return (Link label src))

592+ return (Link label src))

571

593

572referenceLink = choice [referenceLinkDouble, referenceLinkSingle]

594referenceLink = choice [referenceLinkDouble, referenceLinkSingle]

573

595

596+-- a link like [this][/url/]

574−referenceLinkDouble = -- a link like [this][/url/]

597+referenceLinkDouble = try (do

575− try (do

576− label <- reference

598+ label <- reference

577− skipSpaces

599+ skipSpaces

578− skipEndline

600+ skipEndline

579− skipSpaces

601+ skipSpaces

580− ref <- reference

602+ ref <- reference

581− return (Link label (Ref ref)))

603+ return (Link label (Ref ref)))

582−

604+

605+-- a link like [this]

583−referenceLinkSingle = -- a link like [this]

606+referenceLinkSingle = try (do

584− try (do

585− label <- reference

607+ label <- reference

586− return (Link label (Ref [])))

608+ return (Link label (Ref [])))

587−

609+

588−autoLink = -- a link <like.this.com>

610+-- a link <like.this.com>

589− try (do

611+autoLink = try (do

590− notFollowedBy' anyHtmlBlockTag

612+ notFollowedBy' anyHtmlBlockTag

591− src <- between (char autoLinkStart) (char autoLinkEnd)

613+ src <- between (char autoLinkStart) (char autoLinkEnd)

592− (many (noneOf (spaceChars ++ endLineChars ++ [autoLinkEnd])))

614+ (many (noneOf (spaceChars ++ endLineChars ++ [autoLinkEnd])))

593− case (matchRegex emailAddress src) of

615+ case (matchRegex emailAddress src) of

594− Just _ -> return (Link [Str src] (Src ("mailto:" ++ src) ""))

616+ Just _ -> return (Link [Str src] (Src ("mailto:" ++ src) ""))

595− Nothing -> return (Link [Str src] (Src src "")))

617+ Nothing -> return (Link [Str src] (Src src "")))

596−

618+

619+emailAddress =

597−emailAddress = mkRegex "([^@:/]+)@(([^.]+[.]?)*([^.]+))" -- presupposes no whitespace

620+ mkRegex "([^@:/]+)@(([^.]+[.]?)*([^.]+))" -- presupposes no whitespace

598−

621+

599−image =

622+image = try (do

600− try (do

601− char imageStart

623+ char imageStart

602− (Link label src) <- link

624+ (Link label src) <- link

603− return (Image label src))

625+ return (Image label src))

604

626

605noteMarker = try (do

627noteMarker = try (do

606− char labelStart

628+ char labelStart

607− char noteStart

629+ char noteStart

608− manyTill (noneOf " \t\n") (char labelEnd))

630+ manyTill (noneOf " \t\n") (char labelEnd))

609

631

610noteRef = try (do

632noteRef = try (do

611− ref <- noteMarker

633+ ref <- noteMarker

612− state <- getState

634+ state <- getState

613− let identifiers = (stateNoteIdentifiers state) ++ [ref]

635+ let identifiers = (stateNoteIdentifiers state) ++ [ref]

614− updateState (\st -> st {stateNoteIdentifiers = identifiers})

636+ updateState (\st -> st {stateNoteIdentifiers = identifiers})

615− return (NoteRef (show (length identifiers))))

637+ return (NoteRef (show (length identifiers))))

616

638

617inlineNote = try (do

639inlineNote = try (do

618− char noteStart

640+ char noteStart

619− char labelStart

641+ char labelStart

620− contents <- manyTill inline (char labelEnd)

642+ contents <- manyTill inline (char labelEnd)

621− state <- getState

643+ state <- getState

622− let identifiers = stateNoteIdentifiers state

644+ let identifiers = stateNoteIdentifiers state

623− let ref = show $ (length identifiers) + 1

645+ let ref = show $ (length identifiers) + 1

624− let noteBlocks = stateNoteBlocks state

646+ let noteBlocks = stateNoteBlocks state

625− updateState (\st -> st {stateNoteIdentifiers = (identifiers ++ [ref]),

647+ updateState (\st -> st {stateNoteIdentifiers = (identifiers ++ [ref]),

648+ stateNoteBlocks =

626− stateNoteBlocks = (Note ref [Para contents]):noteBlocks})

649+ (Note ref [Para contents]):noteBlocks})

627− return (NoteRef ref))

650+ return (NoteRef ref))

628

651

src/Text/Pandoc/Readers/RST.hs+325−306

@@ -1,4 +1,14 @@

1+{- |

2+ Module : Text.Pandoc.Readers.RST

4+ License : GNU GPL, version 2 or above

6+ Maintainer : John MacFarlane <jgm at berkeley dot edu>

7+ Stability : unstable

8+ Portability : portable

1−-- | Parse reStructuredText and return Pandoc document.

10+Conversion from reStructuredText to 'Pandoc' document.

11+-}

2module Text.Pandoc.Readers.RST (

12module Text.Pandoc.Readers.RST (

3 readRST

13 readRST

4 ) where

14 ) where

@@ -61,16 +71,14 @@ promoteHeaders num [] = []

61-- promote all the other headers.

71-- promote all the other headers.

62titleTransform :: [Block] -- ^ list of blocks

72titleTransform :: [Block] -- ^ list of blocks

63 -> ([Block], [Inline]) -- ^ modified list of blocks, title

73 -> ([Block], [Inline]) -- ^ modified list of blocks, title

64−titleTransform ((Header 1 head1):(Header 2 head2):rest) = -- title and subtitle

74+titleTransform ((Header 1 head1):(Header 2 head2):rest) = -- title subtitle

65− if (any isHeader1 rest) || (any isHeader2 rest) then

75+ if (any isHeader1 rest) || (any isHeader2 rest)

66− ((Header 1 head1):(Header 2 head2):rest, [])

76+ then ((Header 1 head1):(Header 2 head2):rest, [])

67− else

68− ((promoteHeaders 2 rest), head1 ++ [Str ":", Space] ++ head2)

77+ else ((promoteHeaders 2 rest), head1 ++ [Str ":", Space] ++ head2)

69titleTransform ((Header 1 head1):rest) = -- title, no subtitle

78titleTransform ((Header 1 head1):rest) = -- title, no subtitle

70− if (any isHeader1 rest) then

79+ if (any isHeader1 rest)

71− ((Header 1 head1):rest, [])

80+ then ((Header 1 head1):rest, [])

72− else

73− ((promoteHeaders 1 rest), head1)

81+ else ((promoteHeaders 1 rest), head1)

74titleTransform blocks = (blocks, [])

82titleTransform blocks = (blocks, [])

76parseRST = do

84parseRST = do

@@ -78,17 +86,18 @@ parseRST = do

78 input <- getInput

86 input <- getInput

79 blocks <- parseBlocks -- first pass

87 blocks <- parseBlocks -- first pass

80 let anonymousKeys = filter isAnonKeyBlock blocks

88 let anonymousKeys = filter isAnonKeyBlock blocks

81− let blocks' = if (null anonymousKeys) then

89+ let blocks' = if (null anonymousKeys)

82− blocks

90+ then blocks

83− else -- run parser again to fill in anonymous links...

91+ else -- run parser again to fill in anonymous links...

92+ case runParser parseBlocks

84− case runParser parseBlocks (state { stateKeyBlocks = anonymousKeys })

93+ (state { stateKeyBlocks = anonymousKeys })

85 "RST source, second pass" input of

94 "RST source, second pass" input of

86− Left err -> error $ "\nError:\n" ++ show err

95+ Left err -> error $ "\nError:\n" ++ show err

96+ Right result ->

87− Right result -> (filter isNotAnonKeyBlock result)

97+ (filter isNotAnonKeyBlock result)

88− let (blocks'', title) = if stateStandalone state then

98+ let (blocks'', title) = if stateStandalone state

89− titleTransform blocks'

99+ then titleTransform blocks'

90− else

91− (blocks', [])

100+ else (blocks', [])

92 state <- getState

101 state <- getState

93 let authors = stateAuthors state

102 let authors = stateAuthors state

94 let date = stateDate state

103 let date = stateDate state

@@ -103,9 +112,10 @@ parseBlocks = do

103 result <- manyTill block eof

112 result <- manyTill block eof

104 return result

113 return result

105

114

106−block = choice [ codeBlock, rawHtmlBlock, rawLaTeXBlock, blockQuote, referenceKey,

115+block = choice [ codeBlock, rawHtmlBlock, rawLaTeXBlock, blockQuote,

107− imageBlock, unknownDirective, header, hrule, list, fieldList, lineBlock,

116+ referenceKey, imageBlock, unknownDirective, header,

117+ hrule, list, fieldList, lineBlock, para, plain,

108− para, plain, blankBlock, nullBlock ] <?> "block"

118+ blankBlock, nullBlock ] <?> "block"

109

119

110--

120--

111-- field list

121-- field list

@@ -117,28 +127,32 @@ fieldListItem = try (do

117 string ": "

127 string ": "

118 skipSpaces

128 skipSpaces

119 first <- manyTill anyChar newline

129 first <- manyTill anyChar newline

130+ rest <- many (do

120− rest <- many (do{ notFollowedBy (char ':');

131+ notFollowedBy (char ':')

121− notFollowedBy blankline;

132+ notFollowedBy blankline

122− skipSpaces;

133+ skipSpaces

123− manyTill anyChar newline })

134+ manyTill anyChar newline )

124 return (name, (joinWithSep " " (first:rest))))

135 return (name, (joinWithSep " " (first:rest))))

125

136

126fieldList = try (do

137fieldList = try (do

127 items <- many1 fieldListItem

138 items <- many1 fieldListItem

128 blanklines

139 blanklines

129 let authors = case (lookup "Authors" items) of

140 let authors = case (lookup "Authors" items) of

130− Just auth -> [auth]

141+ Just auth -> [auth]

131− Nothing -> map snd (filter (\(x,y) -> x == "Author") items)

142+ Nothing -> map snd (filter (\(x,y) -> x == "Author") items)

132 let date = case (lookup "Date" items) of

143 let date = case (lookup "Date" items) of

133− Just dat -> dat

144+ Just dat -> dat

134− Nothing -> ""

145+ Nothing -> ""

135 let title = case (lookup "Title" items) of

146 let title = case (lookup "Title" items) of

136− Just tit -> [Str tit]

147+ Just tit -> [Str tit]

137− Nothing -> []

148+ Nothing -> []

138− let remaining = filter (\(x,y) -> (x /= "Authors") && (x /= "Author") && (x /= "Date") &&

149+ let remaining = filter (\(x,y) -> (x /= "Authors") && (x /= "Author") &&

139− (x /= "Title")) items

150+ (x /= "Date") && (x /= "Title")) items

151+ let result = map (\(x,y) ->

140− let result = map (\(x,y) -> Para [Strong [Str x], Str ":", Space, Str y]) remaining

152+ Para [Strong [Str x], Str ":", Space, Str y]) remaining

141− updateState (\st -> st { stateAuthors = authors, stateDate = date, stateTitle = title })

153+ updateState (\st -> st { stateAuthors = authors,

154+ stateDate = date,

155+ stateTitle = title })

142 return (BlockQuote result))

156 return (BlockQuote result))

143

157

144--

158--

@@ -164,18 +178,17 @@ lineBlock = try (do

164para = choice [ paraBeforeCodeBlock, paraNormal ] <?> "paragraph"

178para = choice [ paraBeforeCodeBlock, paraNormal ] <?> "paragraph"

165

179

166codeBlockStart = try (do

180codeBlockStart = try (do

167− string "::"

181+ string "::"

168− blankline

182+ blankline

169− blankline)

183+ blankline)

170

184

171-- paragraph that ends in a :: starting a code block

185-- paragraph that ends in a :: starting a code block

172paraBeforeCodeBlock = try (do

186paraBeforeCodeBlock = try (do

173 result <- many1 (do {notFollowedBy' codeBlockStart; inline})

187 result <- many1 (do {notFollowedBy' codeBlockStart; inline})

174 followedBy' (string "::")

188 followedBy' (string "::")

175− return (Para (if (last result == Space) then

189+ return (Para (if (last result == Space)

176− normalizeSpaces result

190+ then normalizeSpaces result

177− else

178− (normalizeSpaces result) ++ [Str ":"])))

191+ else (normalizeSpaces result) ++ [Str ":"])))

179

192

180-- regular paragraph

193-- regular paragraph

181paraNormal = try (do

194paraNormal = try (do

@@ -195,9 +208,9 @@ plain = do

195--

208--

196

209

197imageBlock = try (do

210imageBlock = try (do

198− string ".. image:: "

211+ string ".. image:: "

199− src <- manyTill anyChar newline

212+ src <- manyTill anyChar newline

200− return (Plain [Image [Str "image"] (Src src "")]))

213+ return (Plain [Image [Str "image"] (Src src "")]))

201

214

202--

215--

203-- header blocks

216-- header blocks

@@ -207,59 +220,58 @@ header = choice [ doubleHeader, singleHeader ] <?> "header"

207

220

208-- a header with lines on top and bottom

221-- a header with lines on top and bottom

209doubleHeader = try (do

222doubleHeader = try (do

210− c <- oneOf underlineChars

223+ c <- oneOf underlineChars

211− rest <- many (char c) -- the top line

224+ rest <- many (char c) -- the top line

212− let lenTop = length (c:rest)

225+ let lenTop = length (c:rest)

213− skipSpaces

226+ skipSpaces

214− newline

227+ newline

215− txt <- many1 (do {notFollowedBy blankline; inline})

228+ txt <- many1 (do {notFollowedBy blankline; inline})

216− pos <- getPosition

229+ pos <- getPosition

217− let len = (sourceColumn pos) - 1

230+ let len = (sourceColumn pos) - 1

218− if (len > lenTop) then fail "title longer than border" else (do {return ()})

231+ if (len > lenTop) then fail "title longer than border" else (do {return ()})

219− blankline -- spaces and newline

232+ blankline -- spaces and newline

220− count lenTop (char c) -- the bottom line

233+ count lenTop (char c) -- the bottom line

221− blanklines

234+ blanklines

222− -- check to see if we've had this kind of header before.

235+ -- check to see if we've had this kind of header before.

223− -- if so, get appropriate level. if not, add to list.

236+ -- if so, get appropriate level. if not, add to list.

224− state <- getState

237+ state <- getState

225− let headerTable = stateHeaderTable state

238+ let headerTable = stateHeaderTable state

226− let (headerTable', level) = case findIndex (== DoubleHeader c) headerTable of

239+ let (headerTable',level) = case findIndex (== DoubleHeader c) headerTable of

227− Just ind -> (headerTable, ind + 1)

240+ Just ind -> (headerTable, ind + 1)

228− Nothing -> (headerTable ++ [DoubleHeader c], (length headerTable) + 1)

241+ Nothing -> (headerTable ++ [DoubleHeader c], (length headerTable) + 1)

229− setState (state { stateHeaderTable = headerTable' })

242+ setState (state { stateHeaderTable = headerTable' })

230− return (Header level (normalizeSpaces txt)))

243+ return (Header level (normalizeSpaces txt)))

231

244

232-- a header with line on the bottom only

245-- a header with line on the bottom only

233singleHeader = try (do

246singleHeader = try (do

234− notFollowedBy' whitespace

247+ notFollowedBy' whitespace

235− txt <- many1 (do {notFollowedBy blankline; inline})

248+ txt <- many1 (do {notFollowedBy blankline; inline})

236− pos <- getPosition

249+ pos <- getPosition

237− let len = (sourceColumn pos) - 1

250+ let len = (sourceColumn pos) - 1

238− blankline

251+ blankline

239− c <- oneOf underlineChars

252+ c <- oneOf underlineChars

240− rest <- count (len - 1) (char c)

253+ rest <- count (len - 1) (char c)

241− many (char c)

254+ many (char c)

242− blanklines

255+ blanklines

243− state <- getState

256+ state <- getState

244− let headerTable = stateHeaderTable state

257+ let headerTable = stateHeaderTable state

245− let (headerTable', level) = case findIndex (== SingleHeader c) headerTable of

258+ let (headerTable',level) = case findIndex (== SingleHeader c) headerTable of

246− Just ind -> (headerTable, ind + 1)

259+ Just ind -> (headerTable, ind + 1)

247− Nothing -> (headerTable ++ [SingleHeader c], (length headerTable) + 1)

260+ Nothing -> (headerTable ++ [SingleHeader c], (length headerTable) + 1)

248− setState (state { stateHeaderTable = headerTable' })

261+ setState (state { stateHeaderTable = headerTable' })

249− return (Header level (normalizeSpaces txt)))

262+ return (Header level (normalizeSpaces txt)))

250

263

251--

264--

252-- hrule block

265-- hrule block

253--

266--

254

267

255−hruleWith chr =

268+hruleWith chr = try (do

256− try (do

257− count 4 (char chr)

269+ count 4 (char chr)

258− skipMany (char chr)

270+ skipMany (char chr)

259− skipSpaces

271+ skipSpaces

260− newline

272+ newline

261− blanklines

273+ blanklines

262− return HorizontalRule)

274+ return HorizontalRule)

263

275

264hrule = choice (map hruleWith underlineChars) <?> "hrule"

276hrule = choice (map hruleWith underlineChars) <?> "hrule"

265

277

@@ -269,9 +281,9 @@ hrule = choice (map hruleWith underlineChars) <?> "hrule"

269

281

270-- read a line indented by a given string

282-- read a line indented by a given string

271indentedLine indents = try (do

283indentedLine indents = try (do

272− string indents

284+ string indents

273− result <- manyTill anyChar newline

285+ result <- manyTill anyChar newline

274− return (result ++ "\n"))

286+ return (result ++ "\n"))

275

287

276-- two or more indented lines, possibly separated by blank lines

288-- two or more indented lines, possibly separated by blank lines

277-- if variable = True, then any indent will work, but it must be consistent through the block

289-- if variable = True, then any indent will work, but it must be consistent through the block

@@ -279,54 +291,59 @@ indentedLine indents = try (do

279indentedBlock variable = try (do

291indentedBlock variable = try (do

280 state <- getState

292 state <- getState

281 let tabStop = stateTabStop state

293 let tabStop = stateTabStop state

282− indents <- if variable then

294+ indents <- if variable

283− many1 (oneOf " \t")

295+ then many1 (oneOf " \t")

284− else

285− oneOfStrings ["\t", (replicate tabStop ' ')]

296+ else oneOfStrings ["\t", (replicate tabStop ' ')]

286 firstline <- manyTill anyChar newline

297 firstline <- manyTill anyChar newline

287 rest <- many (choice [ indentedLine indents,

298 rest <- many (choice [ indentedLine indents,

299+ try (do

300+ b <- blanklines

288− try (do {b <- blanklines; l <- indentedLine indents; return (b ++ l)})])

301+ l <- indentedLine indents

302+ return (b ++ l))])

289 option "" blanklines

303 option "" blanklines

290 return (firstline ++ "\n" ++ (concat rest)))

304 return (firstline ++ "\n" ++ (concat rest)))

291

305

292codeBlock = try (do

306codeBlock = try (do

293− codeBlockStart

307+ codeBlockStart

308+ result <- indentedBlock False

294− result <- indentedBlock False -- the False means we want one tab stop indent on each line

309+ -- the False means we want one tab stop indent on each line

295− return (CodeBlock (stripTrailingNewlines result)))

310+ return (CodeBlock (stripTrailingNewlines result)))

296

311

297--

312--

298-- raw html

313-- raw html

299--

314--

300

315

301rawHtmlBlock = try (do

316rawHtmlBlock = try (do

302− string ".. raw:: html"

317+ string ".. raw:: html"

303− blanklines

318+ blanklines

304− result <- indentedBlock True

319+ result <- indentedBlock True

305− return (RawHtml result))

320+ return (RawHtml result))

306

321

307--

322--

308-- raw latex

323-- raw latex

309--

324--

310

325

311rawLaTeXBlock = try (do

326rawLaTeXBlock = try (do

312− string ".. raw:: latex"

327+ string ".. raw:: latex"

313− blanklines

328+ blanklines

314− result <- indentedBlock True

329+ result <- indentedBlock True

315− return (Para [(TeX result)]))

330+ return (Para [(TeX result)]))

316

331

317--

332--

318-- block quotes

333-- block quotes

319--

334--

320

335

321blockQuote = try (do

336blockQuote = try (do

322− block <- indentedBlock True

337+ block <- indentedBlock True

323− -- parse the extracted block, which may contain various block elements:

338+ -- parse the extracted block, which may contain various block elements:

324− state <- getState

339+ state <- getState

340+ let parsed = case runParser parseBlocks

325− let parsed = case runParser parseBlocks (state {stateParserContext = BlockQuoteState})

341+ (state {stateParserContext = BlockQuoteState})

326− "block" (block ++ "\n\n") of

342+ "block" (block ++ "\n\n") of

327− Left err -> error $ "Raw block:\n" ++ show block ++ "\nError:\n" ++ show err

343+ Left err -> error $ "Raw block:\n" ++ show block ++

344+ "\nError:\n" ++ show err

328− Right result -> result

345+ Right result -> result

329− return (BlockQuote parsed))

346+ return (BlockQuote parsed))

330

347

331--

348--

332-- list blocks

349-- list blocks

@@ -335,34 +352,36 @@ blockQuote = try (do

335list = choice [ bulletList, orderedList ] <?> "list"

352list = choice [ bulletList, orderedList ] <?> "list"

336

353

337-- parses bullet list start and returns its length (inc. following whitespace)

354-- parses bullet list start and returns its length (inc. following whitespace)

338−bulletListStart =

355+bulletListStart = try (do

339− try (do

340− notFollowedBy' hrule -- because hrules start out just like lists

356+ notFollowedBy' hrule -- because hrules start out just like lists

341− marker <- oneOf bulletListMarkers

357+ marker <- oneOf bulletListMarkers

342− white <- many1 spaceChar

358+ white <- many1 spaceChar

343− let len = length (marker:white)

359+ let len = length (marker:white)

344− return len)

360+ return len)

345

361

346withPeriodSuffix parser = try (do

362withPeriodSuffix parser = try (do

347− a <- parser

363+ a <- parser

348− b <- char '.'

364+ b <- char '.'

349− return (a ++ [b]))

365+ return (a ++ [b]))

350

366

351withParentheses parser = try (do

367withParentheses parser = try (do

352− a <- char '('

368+ a <- char '('

353− b <- parser

369+ b <- parser

354− c <- char ')'

370+ c <- char ')'

355− return ([a] ++ b ++ [c]))

371+ return ([a] ++ b ++ [c]))

356

372

357withRightParen parser = try (do

373withRightParen parser = try (do

358− a <- parser

374+ a <- parser

359− b <- char ')'

375+ b <- char ')'

360− return (a ++ [b]))

376+ return (a ++ [b]))

361

377

362upcaseWord = map toUpper

378upcaseWord = map toUpper

363

379

364romanNumeral = do

380romanNumeral = 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" ]

366 let upperNumerals = map upcaseWord lowerNumerals

385 let upperNumerals = map upcaseWord lowerNumerals

367 result <- choice $ map string (lowerNumerals ++ upperNumerals)

386 result <- choice $ map string (lowerNumerals ++ upperNumerals)

368 return result

387 return result

@@ -372,15 +391,14 @@ orderedListEnumerator = choice [ many1 digit,

372 count 1 letter,

391 count 1 letter,

373 romanNumeral ]

392 romanNumeral ]

374

393

375−-- parses ordered list start and returns its length (inc. following whitespace)

394+-- parses ordered list start and returns its length (inc following whitespace)

376−orderedListStart =

395+orderedListStart = try (do

377− try (do

378− marker <- choice [ withPeriodSuffix orderedListEnumerator,

396+ marker <- choice [ withPeriodSuffix orderedListEnumerator,

379− withParentheses orderedListEnumerator,

397+ withParentheses orderedListEnumerator,

380− withRightParen orderedListEnumerator ]

398+ withRightParen orderedListEnumerator ]

381− white <- many1 spaceChar

399+ white <- many1 spaceChar

382− let len = length (marker ++ white)

400+ let len = length (marker ++ white)

383− return len)

401+ return len)

384

402

385-- parse a line of a list item

403-- parse a line of a list item

386listLine markerLength = try (do

404listLine markerLength = try (do

@@ -393,72 +411,73 @@ listLine markerLength = try (do

393indentWith num = do

411indentWith num = do

394 state <- getState

412 state <- getState

395 let tabStop = stateTabStop state

413 let tabStop = stateTabStop state

396− if (num < tabStop) then

414+ if (num < tabStop)

397− count num (char ' ')

415+ then count num (char ' ')

398− else

399− choice [ try (count num (char ' ')),

416+ else choice [ try (count num (char ' ')),

400− (try (do {char '\t'; count (num - tabStop) (char ' ')})) ]

417+ (try (do {char '\t'; count (num - tabStop) (char ' ')})) ]

401

418

402-- parse raw text for one list item, excluding start marker and continuations

419-- parse raw text for one list item, excluding start marker and continuations

403−rawListItem start =

420+rawListItem start = try (do

404− try (do

405− markerLength <- start

421+ markerLength <- start

406− firstLine <- manyTill anyChar newline

422+ firstLine <- manyTill anyChar newline

407− restLines <- many (listLine markerLength)

423+ restLines <- many (listLine markerLength)

408− return (markerLength, (firstLine ++ "\n" ++ (concat restLines))))

424+ return (markerLength, (firstLine ++ "\n" ++ (concat restLines))))

409−

425+

410−-- continuation of a list item - indented and separated by blankline or (in compact lists)

426+-- continuation of a list item - indented and separated by blankline or

427+-- (in compact lists) endline.

411−-- endline. Note: nested lists are parsed as continuations.

428+-- Note: nested lists are parsed as continuations.

412−listContinuation markerLength =

429+listContinuation markerLength = try (do

413− try (do

414− blanks <- many1 blankline

430+ blanks <- many1 blankline

415− result <- many1 (listLine markerLength)

431+ result <- many1 (listLine markerLength)

416− return (blanks ++ (concat result)))

432+ return (blanks ++ (concat result)))

417−

433+

418−listItem start =

434+listItem start = try (do

419− try (do

420− (markerLength, first) <- rawListItem start

435+ (markerLength, first) <- rawListItem start

421− rest <- many (listContinuation markerLength)

436+ rest <- many (listContinuation markerLength)

422− blanks <- choice [ try (do {b <- many blankline; followedBy' start; return b}),

437+ blanks <- choice [ try (do

438+ b <- many blankline

439+ followedBy' start

440+ return b),

423− many1 blankline ] -- whole list must end with blank

441+ many1 blankline ] -- whole list must end with blank

424− -- parsing with ListItemState forces markers at beginning of lines to

442+ -- parsing with ListItemState forces markers at beginning of lines to

425− -- count as list item markers, even if not separated by blank space.

443+ -- count as list item markers, even if not separated by blank space.

426− -- see definition of "endline"

444+ -- see definition of "endline"

427− state <- getState

445+ state <- getState

428− let parsed = case runParser parseBlocks (state {stateParserContext = ListItemState})

446+ let parsed = case runParser parseBlocks

447+ (state {stateParserContext = ListItemState}) "list item"

429− "list item" raw of

448+ raw of

430− Left err -> error $ "Raw:\n" ++ raw ++ "\nError:\n" ++ show err

449+ Left err -> error $ "Raw:\n" ++ raw ++

450+ "\nError:\n" ++ show err

431− Right result -> result

451+ Right result -> result

432− where raw = concat (first:rest) ++ blanks

452+ where raw = concat (first:rest) ++ blanks

433− return parsed)

453+ return parsed)

434−

454+

435−orderedList =

455+orderedList = try (do

436− try (do

437− items <- many1 (listItem orderedListStart)

456+ items <- many1 (listItem orderedListStart)

438− let items' = compactify items

457+ let items' = compactify items

439− return (OrderedList items'))

458+ return (OrderedList items'))

440−

459+

441−bulletList =

460+bulletList = try (do

442− try (do

443− items <- many1 (listItem bulletListStart)

461+ items <- many1 (listItem bulletListStart)

444− let items' = compactify items

462+ let items' = compactify items

445− return (BulletList items'))

463+ return (BulletList items'))

446

464

447--

465--

448-- unknown directive (e.g. comment)

466-- unknown directive (e.g. comment)

449--

467--

450

468

451unknownDirective = try (do

469unknownDirective = try (do

452− string ".. "

470+ string ".. "

453− manyTill anyChar newline

471+ manyTill anyChar newline

454− many (do {string " ";

472+ many (do

473+ string " "

455− char ':';

474+ char ':'

456− many1 (noneOf "\n:");

475+ many1 (noneOf "\n:")

457− char ':';

476+ char ':'

458− many1 (noneOf "\n");

477+ many1 (noneOf "\n")

459− newline})

478+ newline)

460− option "" blanklines

479+ option "" blanklines

461− return Null)

480+ return Null)

462

481

463--

482--

464-- reference key

483-- reference key

@@ -467,39 +486,43 @@ unknownDirective = try (do

467referenceKey = choice [imageKey, anonymousKey, regularKeyQuoted, regularKey]

486referenceKey = choice [imageKey, anonymousKey, regularKeyQuoted, regularKey]

468

487

469imageKey = try (do

488imageKey = try (do

470− string ".. |"

489+ string ".. |"

471− ref <- manyTill inline (char '|')

490+ ref <- manyTill inline (char '|')

472− skipSpaces

491+ skipSpaces

473− string "image::"

492+ string "image::"

474− src <- manyTill anyChar newline

493+ src <- manyTill anyChar newline

494+ return (Key (normalizeSpaces ref)

475− return (Key (normalizeSpaces ref) (Src (removeLeadingTrailingSpace src) "")))

495+ (Src (removeLeadingTrailingSpace src) "")))

476

496

477anonymousKey = try (do

497anonymousKey = try (do

478− choice [string ".. __:", string "__"]

498+ choice [string ".. __:", string "__"]

479− skipSpaces

499+ skipSpaces

480− src <- manyTill anyChar newline

500+ src <- manyTill anyChar newline

481− state <- getState

501+ state <- getState

482− return (Key [Str "_"] (Src (removeLeadingTrailingSpace src) "")))

502+ return (Key [Str "_"] (Src (removeLeadingTrailingSpace src) "")))

483

503

484regularKeyQuoted = try (do

504regularKeyQuoted = try (do

485− string ".. _`"

505+ string ".. _`"

486− ref <- manyTill inline (string "`:")

506+ ref <- manyTill inline (string "`:")

487− skipSpaces

507+ skipSpaces

488− src <- manyTill anyChar newline

508+ src <- manyTill anyChar newline

509+ return (Key (normalizeSpaces ref)

489− return (Key (normalizeSpaces ref) (Src (removeLeadingTrailingSpace src) "")))

510+ (Src (removeLeadingTrailingSpace src) "")))

490

511

491regularKey = try (do

512regularKey = try (do

492− string ".. _"

513+ string ".. _"

493− ref <- manyTill inline (char ':')

514+ ref <- manyTill inline (char ':')

494− skipSpaces

515+ skipSpaces

495− src <- manyTill anyChar newline

516+ src <- manyTill anyChar newline

517+ return (Key (normalizeSpaces ref)

496− return (Key (normalizeSpaces ref) (Src (removeLeadingTrailingSpace src) "")))

518+ (Src (removeLeadingTrailingSpace src) "")))

497

519

498 --

520 --

499 -- inline

521 -- inline

500 --

522 --

501

523

502−text = choice [ strong, emph, code, str, tabchar, whitespace, endline ] <?> "text"

524+text = choice [ strong, emph, code, str, tabchar, whitespace,

525+ endline ] <?> "text"

503

526

504inline = choice [ escapedChar, special, hyphens, text, symbol ] <?> "inline"

527inline = choice [ escapedChar, special, hyphens, text, symbol ] <?> "inline"

505

528

@@ -507,7 +530,8 @@ special = choice [ link, image ] <?> "link, inline html, or image"

507

530

508hyphens = try (do

531hyphens = try (do

509 result <- many1 (char '-')

532 result <- many1 (char '-')

533+ option Space endline

510− option Space endline -- don't want to treat endline after hyphen or dash as a space

534+ -- don't want to treat endline after hyphen or dash as a space

511 return (Str result))

535 return (Str result))

512

536

513escapedChar = escaped anyChar

537escapedChar = escaped anyChar

@@ -517,12 +541,11 @@ symbol = do

517 return (Str [result])

541 return (Str [result])

518

542

519-- parses inline code, between codeStart and codeEnd

543-- parses inline code, between codeStart and codeEnd

520−code =

521− try (do

544+code = try (do

522− string "``"

545+ string "``"

523− result <- manyTill anyChar (string "``")

546+ result <- manyTill anyChar (string "``")

524− let result' = removeLeadingTrailingSpace $ joinWithSep " " $ lines result

547+ let result' = removeLeadingTrailingSpace $ joinWithSep " " $ lines result

525− return (Code result'))

548+ return (Code result'))

526

549

527emph = do

550emph = do

528 result <- enclosed (char '*') (char '*') inline

551 result <- enclosed (char '*') (char '*') inline

@@ -546,99 +569,95 @@ str = do

546 return (Str result)

569 return (Str result)

547

570

548-- an endline character that can be treated as a space, not a structural break

571-- an endline character that can be treated as a space, not a structural break

549−endline =

572+endline = try (do

550− try (do

551− newline

573+ newline

552− notFollowedBy blankline

574+ notFollowedBy blankline

553− -- parse potential list starts at beginning of line differently if in a list:

575+ -- parse potential list-starts at beginning of line differently in a list:

554− st <- getState

576+ st <- getState

555− if ((stateParserContext st) == ListItemState) then

577+ if ((stateParserContext st) == ListItemState)

556− notFollowedBy' (choice [orderedListStart, bulletListStart])

578+ then notFollowedBy' (choice [orderedListStart, bulletListStart])

557− else

558− option () pzero

579+ else option () pzero

559− return Space)

580+ return Space)

560

581

561--

582--

562-- links

583-- links

563--

584--

564

585

565−link = choice [explicitLink, referenceLink, autoLink, oneWordReferenceLink] <?> "link"

586+link = choice [explicitLink, referenceLink, autoLink,

566−

587+ oneWordReferenceLink] <?> "link"

588+

567−explicitLink =

589+explicitLink = try (do

568− try (do

569− char '`'

590+ char '`'

570− label <- manyTill inline (try (do {spaces; char '<'}))

591+ label <- manyTill inline (try (do {spaces; char '<'}))

571− src <- manyTill (noneOf ">\n ") (char '>')

592+ src <- manyTill (noneOf ">\n ") (char '>')

572− skipSpaces

593+ skipSpaces

573− string "`_"

594+ string "`_"

595+ return (Link (normalizeSpaces label)

574− return (Link (normalizeSpaces label) (Src (removeLeadingTrailingSpace src) "")))

596+ (Src (removeLeadingTrailingSpace src) "")))

575−

597+

576−anonymousLinkEnding =

598+anonymousLinkEnding = try (do

577− try (do

578− char '_'

599+ char '_'

579− state <- getState

600+ state <- getState

580− let anonKeys = stateKeyBlocks state

601+ let anonKeys = stateKeyBlocks state

581− -- if there's a list of anon key refs (from previous pass), pop one off.

602+ -- 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...

603+ -- otherwise return an anon key ref for the next pass to take care of...

583− case anonKeys of

604+ case anonKeys of

584− (Key [Str "_"] src):rest ->

605+ (Key [Str "_"] src):rest ->

606+ do

585− do{ setState (state { stateKeyBlocks = rest });

607+ setState (state { stateKeyBlocks = rest })

586− return src }

608+ return src

587− otherwise -> return (Ref [Str "_"]))

609+ otherwise -> return (Ref [Str "_"]))

588−

610+

589−referenceLink =

611+referenceLink = try (do

590− try (do

591− char '`'

612+ char '`'

592− label <- manyTill inline (string "`_")

613+ label <- manyTill inline (string "`_")

593− src <- option (Ref []) anonymousLinkEnding

614+ src <- option (Ref []) anonymousLinkEnding

594− return (Link (normalizeSpaces label) src))

615+ return (Link (normalizeSpaces label) src))

595−

616+

596−oneWordReferenceLink =

617+oneWordReferenceLink = try (do

597− try (do

598− label <- many1 alphaNum

618+ label <- many1 alphaNum

599− char '_'

619+ char '_'

600− src <- option (Ref []) anonymousLinkEnding

620+ src <- option (Ref []) anonymousLinkEnding

601− notFollowedBy alphaNum -- because this_is_not a link

621+ notFollowedBy alphaNum -- because this_is_not a link

602− return (Link [Str label] src))

622+ return (Link [Str label] src))

603−

623+

604−uriScheme = oneOfStrings [ "http://", "https://", "ftp://", "file://", "mailto:",

624+uriScheme = oneOfStrings [ "http://", "https://", "ftp://", "file://",

605− "news:", "telnet:" ]

625+ "mailto:", "news:", "telnet:" ]

606

626

607uri = try (do

627uri = try (do

608− scheme <- uriScheme

628+ scheme <- uriScheme

609− identifier <- many1 (noneOf " \t\n")

629+ identifier <- many1 (noneOf " \t\n")

610− return (scheme ++ identifier))

630+ return (scheme ++ identifier))

611

631

612autoURI = try (do

632autoURI = try (do

613− src <- uri

633+ src <- uri

614− return (Link [Str src] (Src src "")))

634+ return (Link [Str src] (Src src "")))

615

635

616emailChar = alphaNum <|> oneOf "-+_."

636emailChar = alphaNum <|> oneOf "-+_."

617

637

618emailAddress = try (do

638emailAddress = try (do

619− firstLetter <- alphaNum

639+ firstLetter <- alphaNum

620− restAddr <- many emailChar

640+ restAddr <- many emailChar

621− let addr = firstLetter:restAddr

641+ let addr = firstLetter:restAddr

622− char '@'

642+ char '@'

623− dom <- domain

643+ dom <- domain

624− return (addr ++ '@':dom))

644+ return (addr ++ '@':dom))

625

645

626domainChar = alphaNum <|> char '-'

646domainChar = alphaNum <|> char '-'

627

647

628domain = try (do

648domain = try (do

629− first <- many1 domainChar

649+ first <- many1 domainChar

630− dom <- many1 (try (do{ char '.'; many1 domainChar }))

650+ dom <- many1 (try (do{ char '.'; many1 domainChar }))

631− return (joinWithSep "." (first:dom)))

651+ return (joinWithSep "." (first:dom)))

632

652

633autoEmail = try (do

653autoEmail = try (do

634− src <- emailAddress

654+ src <- emailAddress

635− return (Link [Str src] (Src ("mailto:" ++ src) "")))

655+ return (Link [Str src] (Src ("mailto:" ++ src) "")))

636

656

637autoLink = autoURI <|> autoEmail

657autoLink = autoURI <|> autoEmail

638

658

639-- For now, we assume that all substitution references are for images.

659-- For now, we assume that all substitution references are for images.

640−image =

660+image = try (do

641− try (do

642− char '|'

661+ char '|'

643− ref <- manyTill inline (char '|')

662+ ref <- manyTill inline (char '|')

644− return (Image (normalizeSpaces ref) (Ref ref)))

663+ return (Image (normalizeSpaces ref) (Ref ref)))

src/Text/Pandoc/Shared.hs+163−104

@@ -1,4 +1,14 @@

1+{- |

2+ Module : Text.Pandoc.Shared

4+ License : GNU GPL, version 2 or above

6+ Maintainer : John MacFarlane <jgm at berkeley dot edu>

7+ Stability : unstable

8+ Portability : portable

1−-- | Utility functions and definitions used by the various Pandoc modules.

10+Utility functions and definitions used by the various Pandoc modules.

11+-}

2module Text.Pandoc.Shared (

12module Text.Pandoc.Shared (

3 -- * Text processing

13 -- * Text processing

4 gsub,

14 gsub,

@@ -50,17 +60,16 @@ readWith :: GenParser Char ParserState a -- ^ parser

50 -> a

60 -> a

51readWith parser state input =

61readWith parser state input =

52 case runParser parser state "source" input of

62 case runParser parser state "source" input of

53− Left err -> error $ "\nError:\n" ++ show err

63+ Left err -> error $ "\nError:\n" ++ show err

54 Right result -> result

64 Right result -> result

56-- | Parse a string with @parser@ (for testing).

66-- | Parse a string with @parser@ (for testing).

57testStringWith :: (Show a) =>

67testStringWith :: (Show a) =>

58 GenParser Char ParserState a

68 GenParser Char ParserState a

59− -> String

69+ -> String

60− -> IO ()

70+ -> IO ()

61−testStringWith parser str = putStrLn $ show $ readWith parser defaultParserState str

71+testStringWith parser str = putStrLn $ show $

62−

72+ readWith parser defaultParserState str

63−-- | Parser state

65data HeaderType

74data HeaderType

66 = SingleHeader Char -- ^ Single line of characters underneath

75 = SingleHeader Char -- ^ Single line of characters underneath

@@ -68,24 +77,28 @@ data HeaderType

68 deriving (Eq, Show)

77 deriving (Eq, Show)

70data ParserContext

79data ParserContext

71− = BlockQuoteState -- ^ Used when running parser on contents of blockquote

80+ = BlockQuoteState -- ^ Used when running parser on contents of blockquote

72− | ListItemState -- ^ Used when running parser on list item contents

81+ | ListItemState -- ^ Used when running parser on list item contents

73− | NullState -- ^ Default state

82+ | NullState -- ^ Default state

74 deriving (Eq, Show)

83 deriving (Eq, Show)

76data ParserState = ParserState

85data ParserState = ParserState

77− { stateParseRaw :: Bool, -- ^ Parse untranslatable HTML and LaTeX?

86+ { stateParseRaw :: Bool, -- ^ Parse untranslatable HTML

87+ -- and LaTeX?

78− stateParserContext :: ParserContext, -- ^ What are we parsing?

88+ stateParserContext :: ParserContext, -- ^ What are we parsing?

79− stateKeyBlocks :: [Block], -- ^ List of reference key blocks

89+ stateKeyBlocks :: [Block], -- ^ List of reference key blocks

80− stateKeysUsed :: [[Inline]], -- ^ List of references used so far

90+ stateKeysUsed :: [[Inline]], -- ^ List of references used

81− stateNoteBlocks :: [Block], -- ^ List of note blocks

91+ stateNoteBlocks :: [Block], -- ^ List of note blocks

82− stateNoteIdentifiers :: [String], -- ^ List of footnote identifiers, in order encountered

92+ stateNoteIdentifiers :: [String], -- ^ List of footnote identifiers

93+ -- in the order encountered

83− stateTabStop :: Int, -- ^ Tab stop

94+ stateTabStop :: Int, -- ^ Tab stop

84− stateStandalone :: Bool, -- ^ If @True@, parse bibliographic info

95+ stateStandalone :: Bool, -- ^ If @True@, parse

96+ -- bibliographic info

85− stateTitle :: [Inline], -- ^ Title of document

97+ stateTitle :: [Inline], -- ^ Title of document

86− stateAuthors :: [String], -- ^ Authors of document

98+ stateAuthors :: [String], -- ^ Authors of document

87− stateDate :: String, -- ^ Date of document

99+ stateDate :: String, -- ^ Date of document

88− stateHeaderTable :: [HeaderType] -- ^ List of header types used, in what order (for reStructuredText only)

100+ stateHeaderTable :: [HeaderType] -- ^ List of header types used,

101+ -- in what order (rst only)

89 }

102 }

90 deriving Show

103 deriving Show

104

@@ -115,9 +128,9 @@ consolidateList (inline:rest) = inline:(consolidateList rest)

115consolidateList [] = []

128consolidateList [] = []

116

129

117-- | Indent string as a block.

130-- | Indent string as a block.

118−indentBy :: Int -- ^ Number of spaces to indent the block

131+indentBy :: Int -- ^ Number of spaces to indent the block

119− -> Int -- ^ Number of spaces to indent first line, relative to block

132+ -> Int -- ^ Number of spaces (rel to block) to indent first line

120− -> String -- ^ Contents of block to indent

133+ -> String -- ^ Contents of block to indent

121 -> String

134 -> String

122indentBy num first [] = ""

135indentBy num first [] = ""

123indentBy num first str =

136indentBy num first str =

@@ -130,19 +143,27 @@ prettyBlockList :: Int -- ^ Number of spaces to indent list of blocks

130 -> [Block] -- ^ List of blocks

143 -> [Block] -- ^ List of blocks

131 -> String

144 -> String

132prettyBlockList indent [] = indentBy indent 0 "[]"

145prettyBlockList 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)) ++ " ]"

134

148

135-- | Prettyprint Pandoc block element.

149-- | Prettyprint Pandoc block element.

136prettyBlock :: Block -> String

150prettyBlock :: Block -> String

137−prettyBlock (BlockQuote blocks) = "BlockQuote\n " ++ (prettyBlockList 2 blocks)

151+prettyBlock (BlockQuote blocks) = "BlockQuote\n " ++

152+ (prettyBlockList 2 blocks)

138−prettyBlock (Note ref blocks) = "Note " ++ (show ref) ++ "\n " ++ (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 ", "

139−prettyBlock (OrderedList blockLists) = "OrderedList\n" ++ indentBy 2 0 ("[ " ++ (joinWithSep ", " (map (\blocks -> prettyBlockList 2 blocks) blockLists))) ++ " ]"

157+ (map (\blocks -> prettyBlockList 2 blocks) blockLists))) ++ " ]"

140−prettyBlock (BulletList blockLists) = "BulletList\n" ++ indentBy 2 0 ("[ " ++ (joinWithSep ", " (map (\blocks -> prettyBlockList 2 blocks) blockLists))) ++ " ]"

158+prettyBlock (BulletList blockLists) = "BulletList\n" ++

159+ indentBy 2 0 ("[ " ++ (joinWithSep ", "

160+ (map (\blocks -> prettyBlockList 2 blocks) blockLists))) ++ " ]"

141prettyBlock block = show block

161prettyBlock block = show block

142

162

143-- | Prettyprint Pandoc document.

163-- | Prettyprint Pandoc document.

144prettyPandoc :: Pandoc -> String

164prettyPandoc :: 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"

146

167

147-- | Convert tabs to spaces (with adjustable tab stop).

168-- | Convert tabs to spaces (with adjustable tab stop).

148tabsToSpaces :: Int -- ^ Tabstop

169tabsToSpaces :: Int -- ^ Tabstop

@@ -160,7 +181,9 @@ tabsInLine num tabstop "" = ""

160tabsInLine num tabstop (c:cs) =

181tabsInLine num tabstop (c:cs) =

161 let replacement = (if (c == '\t') then (replicate num ' ') else [c]) in

182 let replacement = (if (c == '\t') then (replicate num ' ') else [c]) in

162 let nextnumraw = (num - (length replacement)) in

183 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

164 replacement ++ (tabsInLine nextnum tabstop cs)

187 replacement ++ (tabsInLine nextnum tabstop cs)

165

188

166-- | Substitute string for every occurrence of regular expression.

189-- | Substitute string for every occurrence of regular expression.

@@ -175,10 +198,9 @@ backslashEscape :: [Char] -- ^ list of special characters to escape

175 -> String -- ^ string input

198 -> String -- ^ string input

176 -> String

199 -> String

177backslashEscape special [] = []

200backslashEscape special [] = []

178−backslashEscape special (x:xs) = if x `elem` special then

201+backslashEscape special (x:xs) = if x `elem` special

179− '\\':x:(backslashEscape special xs)

202+ then '\\':x:(backslashEscape special xs)

180− else

181− x:(backslashEscape special xs)

203+ else x:(backslashEscape special xs)

182

204

183-- | Escape string by applying a function, but don't touch anything that matches regex.

205-- | Escape string by applying a function, but don't touch anything that matches regex.

184escapePreservingRegex :: (String -> String) -- ^ Escaping function

206escapePreservingRegex :: (String -> String) -- ^ Escaping function

@@ -187,10 +209,9 @@ escapePreservingRegex :: (String -> String) -- ^ Escaping function

187 -> String

209 -> String

188escapePreservingRegex escapeFunction regex str =

210escapePreservingRegex escapeFunction regex str =

189 case (matchRegexAll regex str) of

211 case (matchRegexAll regex str) of

190− Nothing -> escapeFunction str

212+ Nothing -> escapeFunction str

191− Just (before, matched, after, _) ->

213+ Just (before, matched, after, _) -> (escapeFunction before) ++

192− (escapeFunction before) ++ matched ++

193− (escapePreservingRegex escapeFunction regex after)

214+ matched ++ (escapePreservingRegex escapeFunction regex after)

194

215

195-- | Returns @True@ if string ends with given character.

216-- | Returns @True@ if string ends with given character.

196endsWith :: Char -> [Char] -> Bool

217endsWith :: Char -> [Char] -> Bool

@@ -213,10 +234,9 @@ joinWithSep sep lst = foldr1 (\a b -> a ++ sep ++ b) lst

213stripTrailingNewlines :: String -> String

234stripTrailingNewlines :: String -> String

214stripTrailingNewlines "" = ""

235stripTrailingNewlines "" = ""

215stripTrailingNewlines str =

236stripTrailingNewlines str =

216− if (last str) == '\n' then

237+ if (last str) == '\n'

217− stripTrailingNewlines (init str)

238+ then stripTrailingNewlines (init str)

218− else

239+ else str

219− str

220

240

221-- | Remove leading and trailing space (including newlines) from string.

241-- | Remove leading and trailing space (including newlines) from string.

222removeLeadingTrailingSpace :: String -> String

242removeLeadingTrailingSpace :: String -> String

@@ -224,7 +244,8 @@ removeLeadingTrailingSpace = removeLeadingSpace . removeTrailingSpace

224

244

225-- | Remove leading space (including newlines) from string.

245-- | Remove leading space (including newlines) from string.

226removeLeadingSpace :: String -> String

246removeLeadingSpace :: String -> String

227−removeLeadingSpace = dropWhile (\x -> (x == ' ') || (x == '\n') || (x == '\t'))

247+removeLeadingSpace = dropWhile (\x -> (x == ' ') || (x == '\n') ||

248+ (x == '\t'))

228

249

229-- | Remove trailing space (including newlines) from string.

250-- | Remove trailing space (including newlines) from string.

230removeTrailingSpace :: String -> String

251removeTrailingSpace :: String -> String

@@ -248,12 +269,17 @@ normalizeSpaces list =

248 removeDoubles (Space:Space:rest) = removeDoubles (Space:rest)

269 removeDoubles (Space:Space:rest) = removeDoubles (Space:rest)

249 removeDoubles (x:rest) = x:(removeDoubles rest) in

270 removeDoubles (x:rest) = x:(removeDoubles rest) in

250 let removeLeading [] = []

271 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

252 let removeTrailing [] = []

275 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

254 removeLeading $ removeTrailing $ removeDoubles list

279 removeLeading $ removeTrailing $ removeDoubles list

255

280

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.

257compactify :: [[Block]] -- ^ List of list items (each a list of blocks)

283compactify :: [[Block]] -- ^ List of list items (each a list of blocks)

258 -> [[Block]]

284 -> [[Block]]

259compactify [] = []

285compactify [] = []

@@ -261,30 +287,34 @@ compactify items =

261 let final = last items

287 let final = last items

262 others = init items in

288 others = init items in

263 case final of

289 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]]

265 otherwise -> items

293 otherwise -> items

266

294

267containsPara :: [Block] -> Bool

295containsPara :: [Block] -> Bool

268containsPara [] = False

296containsPara [] = False

269containsPara ((Para a):rest) = True

297containsPara ((Para a):rest) = True

270−containsPara ((BulletList items):rest) = (any containsPara items) || (containsPara rest)

298+containsPara ((BulletList items):rest) = (any containsPara items) ||

299+ (containsPara rest)

271−containsPara ((OrderedList items):rest) = (any containsPara items) || (containsPara rest)

300+containsPara ((OrderedList items):rest) = (any containsPara items) ||

301+ (containsPara rest)

272containsPara (x:rest) = containsPara rest

302containsPara (x:rest) = containsPara rest

273

303

274-- | Options for writers

304-- | Options for writers

275data WriterOptions = WriterOptions

305data WriterOptions = WriterOptions

276− { writerStandalone :: Bool -- ^ If @True@, writer header and footer

306+ { writerStandalone :: Bool -- ^ If @True@, writer header and footer

277− , writerTitlePrefix :: String -- ^ Prefix for HTML titles

307+ , writerTitlePrefix :: String -- ^ Prefix for HTML titles

278− , writerHeader :: String -- ^ Header for the document

308+ , writerHeader :: String -- ^ Header for the document

279− , writerIncludeBefore :: String -- ^ String to include before the document body

309+ , writerIncludeBefore :: String -- ^ String to include before the body

280− , writerIncludeAfter :: String -- ^ String to include after the document body

310+ , writerIncludeAfter :: String -- ^ String to include after the body

281− , writerSmart :: Bool -- ^ If @True@, use smart quotes, dashes, and ellipses

311+ , writerSmart :: Bool -- ^ If @True@, use smart typography

282− , writerS5 :: Bool -- ^ @True@ if we're writing S5 instead of normal HTML

312+ , writerS5 :: Bool -- ^ @True@ if we're writing S5

283− , writerIncremental :: Bool -- ^ If @True@, display S5 lists incrementally

313+ , writerIncremental :: Bool -- ^ If @True@, inceremental S5 lists

284− , writerNumberSections :: Bool -- ^ If @True@, number sections in LaTeX

314+ , writerNumberSections :: Bool -- ^ If @True@, number sections in LaTeX

285− , writerTabStop :: Int -- ^ Tabstop for conversion between spaces and tabs

315+ , writerTabStop :: Int -- ^ Tabstop for conversion between

286− }

316+ -- spaces and tabs

287− deriving Show

317+ } deriving Show

288

318

289--

319--

290-- Functions for constructing lists of reference keys

320-- Functions for constructing lists of reference keys

@@ -296,10 +326,9 @@ keyFoundIn :: [Block] -- ^ List of key blocks to search

296 -> Target -- ^ Target to search for

326 -> Target -- ^ Target to search for

297 -> Maybe String

327 -> Maybe String

298keyFoundIn [] src = Nothing

328keyFoundIn [] src = Nothing

299−keyFoundIn ((Key [Str num] src1):rest) src = if (src1 == src) then

329+keyFoundIn ((Key [Str num] src1):rest) src = if (src1 == src)

300− Just num

330+ then Just num

301− else

302− keyFoundIn rest src

331+ else keyFoundIn rest src

303keyFoundIn (_:rest) src = keyFoundIn rest src

332keyFoundIn (_:rest) src = keyFoundIn rest src

304

333

305-- | Return next unique numerical key, given keyList

334-- | Return next unique numerical key, given keyList

@@ -308,7 +337,7 @@ nextUniqueKey keys =

308 let nums = [1..10000]

337 let nums = [1..10000]

309 notAKey n = not (any (== [Str (show n)]) keys) in

338 notAKey n = not (any (== [Str (show n)]) keys) in

310 case (find notAKey nums) of

339 case (find notAKey nums) of

311− Just x -> show x

340+ Just x -> show x

312 Nothing -> error "Could not find unique key for reference link"

341 Nothing -> error "Could not find unique key for reference link"

313

342

314-- | Generate a reference for a URL (either an existing reference, if

343-- | Generate a reference for a URL (either an existing reference, if

@@ -325,8 +354,10 @@ generateReference url title = do

325 Just num -> return (Ref [Str num])

354 Just num -> return (Ref [Str num])

326 Nothing -> do

355 Nothing -> do

327 let nextNum = nextUniqueKey keysUsed

356 let nextNum = nextUniqueKey keysUsed

328− updateState (\st -> st {stateKeyBlocks = (Key [Str nextNum] src):keyBlocks,

357+ updateState (\st -> st { stateKeyBlocks =

358+ (Key [Str nextNum] src):keyBlocks,

359+ stateKeysUsed =

329− stateKeysUsed = [Str nextNum]:keysUsed})

360+ [Str nextNum]:keysUsed })

330 return (Ref [Str nextNum])

361 return (Ref [Str nextNum])

331

362

332--

363--

@@ -348,21 +379,25 @@ keyTable ((Key ref target):lst) = (((ref, target):table), rest)

348 where (table, rest) = keyTable lst

379 where (table, rest) = keyTable lst

349keyTable (Null:lst) = keyTable lst -- get rid of Nulls

380keyTable (Null:lst) = keyTable lst -- get rid of Nulls

350keyTable (Blank:lst) = keyTable lst -- get rid of Blanks

381keyTable (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))

352 where (table1, rest1) = keyTable blocks

384 where (table1, rest1) = keyTable blocks

353 (table2, rest2) = keyTable lst

385 (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))

355 where (table1, rest1) = keyTable blocks

388 where (table1, rest1) = keyTable blocks

356 (table2, rest2) = keyTable lst

389 (table2, rest2) = keyTable lst

357−keyTable ((OrderedList blockLists):lst) = ((table1 ++ table2), ((OrderedList rest1):rest2))

390+keyTable ((OrderedList blockLists):lst) = ((table1 ++ table2),

391+ ((OrderedList rest1):rest2))

358− where results = map keyTable blockLists

392+ where results = map keyTable blockLists

359− rest1 = map snd results

393+ rest1 = map snd results

360− table1 = concatMap fst results

394+ table1 = concatMap fst results

361 (table2, rest2) = keyTable lst

395 (table2, rest2) = keyTable lst

362−keyTable ((BulletList blockLists):lst) = ((table1 ++ table2), ((BulletList rest1):rest2))

396+keyTable ((BulletList blockLists):lst) = ((table1 ++ table2),

397+ ((BulletList rest1):rest2))

363− where results = map keyTable blockLists

398+ where results = map keyTable blockLists

364− rest1 = map snd results

399+ rest1 = map snd results

365− table1 = concatMap fst results

400+ table1 = concatMap fst results

366 (table2, rest2) = keyTable lst

401 (table2, rest2) = keyTable lst

367keyTable (other:lst) = (table, (other:rest))

402keyTable (other:lst) = (table, (other:rest))

368 where (table, rest) = keyTable lst

403 where (table, rest) = keyTable lst

@@ -372,55 +407,79 @@ lookupKeySrc :: KeyTable -- ^ Key table

372 -> [Inline] -- ^ Key

407 -> [Inline] -- ^ Key

373 -> Maybe Target

408 -> Maybe Target

374lookupKeySrc table key = case table of

409lookupKeySrc table key = case table of

375− [] -> Nothing

410+ [] -> Nothing

376− (k, src):rest -> if (refsMatch k key) then Just src else lookupKeySrc rest key

411+ (k, src):rest -> if (refsMatch k key)

412+ then Just src

413+ else lookupKeySrc rest key

377

414

378-- | Returns @True@ if keys match (case insensitive).

415-- | Returns @True@ if keys match (case insensitive).

379refsMatch :: [Inline] -> [Inline] -> Bool

416refsMatch :: [Inline] -> [Inline] -> Bool

417+refsMatch ((Str x):restx) ((Str y):resty) =

380−refsMatch ((Str x):restx) ((Str y):resty) = ((map toLower x) == (map toLower y)) && refsMatch restx resty

418+ ((map toLower x) == (map toLower y)) && refsMatch restx resty

419+refsMatch ((Code x):restx) ((Code y):resty) =

381−refsMatch ((Code x):restx) ((Code y):resty) = ((map toLower x) == (map toLower y)) && refsMatch restx resty

420+ ((map toLower x) == (map toLower y)) && refsMatch restx resty

421+refsMatch ((TeX x):restx) ((TeX y):resty) =

382−refsMatch ((TeX x):restx) ((TeX y):resty) = ((map toLower x) == (map toLower y)) && refsMatch restx resty

422+ ((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

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) =

384−refsMatch ((NoteRef x):restx) ((NoteRef y):resty) = ((map toLower x) == (map toLower y)) && refsMatch restx resty

426+ ((map toLower x) == (map toLower y)) && refsMatch restx resty

427+refsMatch ((Emph x):restx) ((Emph y):resty) =

385−refsMatch ((Emph x):restx) ((Emph y):resty) = refsMatch x y && refsMatch restx resty

428+ refsMatch x y && refsMatch restx resty

386−refsMatch ((Strong x):restx) ((Strong y):resty) = refsMatch x y && refsMatch restx resty

429+refsMatch ((Strong x):restx) ((Strong y):resty) =

430+ refsMatch x y && refsMatch restx resty

387refsMatch (x:restx) (y:resty) = (x == y) && refsMatch restx resty

431refsMatch (x:restx) (y:resty) = (x == y) && refsMatch restx resty

388refsMatch [] x = null x

432refsMatch [] x = null x

389refsMatch x [] = null x

433refsMatch x [] = null x

390

434

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.

392replaceReferenceLinks :: [Block] -> [Block]

437replaceReferenceLinks :: [Block] -> [Block]

393replaceReferenceLinks blocks =

438replaceReferenceLinks blocks =

394 let (keytable, purged) = keyTable blocks in

439 let (keytable, purged) = keyTable blocks in

395 replaceRefLinksBlockList keytable purged

440 replaceRefLinksBlockList keytable purged

396

441

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

398replaceRefLinksBlockList :: KeyTable -> [Block] -> [Block]

444replaceRefLinksBlockList :: KeyTable -> [Block] -> [Block]

399−replaceRefLinksBlockList keytable lst = map (replaceRefLinksBlock keytable) lst

445+replaceRefLinksBlockList keytable lst =

446+ map (replaceRefLinksBlock keytable) lst

400

447

401-- | Use key table to replace reference links with explicit links in a block

448-- | Use key table to replace reference links with explicit links in a block

402replaceRefLinksBlock :: KeyTable -> Block -> Block

449replaceRefLinksBlock :: KeyTable -> Block -> Block

450+replaceRefLinksBlock keytable (Plain lst) =

403−replaceRefLinksBlock keytable (Plain lst) = Plain (map (replaceRefLinksInline keytable) lst)

451+ Plain (map (replaceRefLinksInline keytable) lst)

452+replaceRefLinksBlock keytable (Para lst) =

404−replaceRefLinksBlock keytable (Para lst) = Para (map (replaceRefLinksInline keytable) lst)

453+ Para (map (replaceRefLinksInline keytable) lst)

454+replaceRefLinksBlock keytable (Header lvl lst) =

405−replaceRefLinksBlock keytable (Header lvl lst) = Header lvl (map (replaceRefLinksInline keytable) lst)

455+ Header lvl (map (replaceRefLinksInline keytable) lst)

456+replaceRefLinksBlock keytable (BlockQuote lst) =

406−replaceRefLinksBlock keytable (BlockQuote lst) = BlockQuote (map (replaceRefLinksBlock keytable) lst)

457+ BlockQuote (map (replaceRefLinksBlock keytable) lst)

458+replaceRefLinksBlock keytable (Note ref lst) =

407−replaceRefLinksBlock keytable (Note ref lst) = Note ref (map (replaceRefLinksBlock keytable) lst)

459+ Note ref (map (replaceRefLinksBlock keytable) lst)

460+replaceRefLinksBlock keytable (OrderedList lst) =

408−replaceRefLinksBlock keytable (OrderedList lst) = OrderedList (map (replaceRefLinksBlockList keytable) lst)

461+ OrderedList (map (replaceRefLinksBlockList keytable) lst)

462+replaceRefLinksBlock keytable (BulletList lst) =

409−replaceRefLinksBlock keytable (BulletList lst) = BulletList (map (replaceRefLinksBlockList keytable) lst)

463+ BulletList (map (replaceRefLinksBlockList keytable) lst)

410replaceRefLinksBlock keytable other = other

464replaceRefLinksBlock keytable other = other

411

465

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.

413replaceRefLinksInline :: KeyTable -> Inline -> Inline

468replaceRefLinksInline :: KeyTable -> Inline -> Inline

414replaceRefLinksInline keytable (Link text (Ref ref)) = (Link newText newRef)

469replaceRefLinksInline 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

416 Nothing -> (Ref ref)

472 Nothing -> (Ref ref)

417 Just src -> src

473 Just src -> src

418 newText = map (replaceRefLinksInline keytable) text

474 newText = map (replaceRefLinksInline keytable) text

419replaceRefLinksInline keytable (Image text (Ref ref)) = (Image newText newRef)

475replaceRefLinksInline 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

421 Nothing -> (Ref ref)

478 Nothing -> (Ref ref)

422 Just src -> src

479 Just src -> src

423 newText = map (replaceRefLinksInline keytable) text

480 newText = map (replaceRefLinksInline keytable) text

481+replaceRefLinksInline keytable (Emph lst) =

424−replaceRefLinksInline keytable (Emph lst) = Emph (map (replaceRefLinksInline keytable) lst)

482+ Emph (map (replaceRefLinksInline keytable) lst)

483+replaceRefLinksInline keytable (Strong lst) =

425−replaceRefLinksInline keytable (Strong lst) = Strong (map (replaceRefLinksInline keytable) lst)

484+ Strong (map (replaceRefLinksInline keytable) lst)

426replaceRefLinksInline keytable other = other

485replaceRefLinksInline keytable other = other

src/Text/Pandoc/UTF8.hs+2−1

@@ -4,7 +4,8 @@

5-- Science University.

6--

7+-- Modified by Martin Norbaeck

7−-- Modified by Martin Norbaeck to pass illegal UTF-8 sequences through unchanged.

8+-- to pass illegal UTF-8 sequences through unchanged.

8module Text.Pandoc.UTF8 (

9module Text.Pandoc.UTF8 (

9 decodeUTF8,

10 decodeUTF8,

10 encodeUTF8

11 encodeUTF8

src/Text/Pandoc/Writers/HTML.hs+176−135

@@ -1,4 +1,14 @@

1+{- |

2+ Module : Text.Pandoc.Writers.HTML

4+ License : GNU GPL, version 2 or above

6+ Maintainer : John MacFarlane <jgm at berkeley dot edu>

7+ Stability : unstable

8+ Portability : portable

1−-- | Converts Pandoc to HTML.

10+Conversion of 'Pandoc' documents to HTML.

11+-}

2module Text.Pandoc.Writers.HTML (

12module Text.Pandoc.Writers.HTML (

3 writeHtml

13 writeHtml

4 ) where

14 ) where

@@ -13,94 +23,108 @@ import Data.List ( isPrefixOf, partition )

13-- | Convert Pandoc document to string in HTML format.

23-- | Convert Pandoc document to string in HTML format.

14writeHtml :: WriterOptions -> Pandoc -> String

24writeHtml :: WriterOptions -> Pandoc -> String

15writeHtml options (Pandoc (Meta title authors date) blocks) =

25writeHtml options (Pandoc (Meta title authors date) blocks) =

16− let titlePrefix = writerTitlePrefix options in

26+ let titlePrefix = writerTitlePrefix options in

17− let topTitle = if not (null titlePrefix) then

27+ let topTitle = if not (null titlePrefix)

18− [Str titlePrefix] ++ (if not (null title) then [Str " - "] ++ title else [])

28+ then [Str titlePrefix] ++ (if not (null title)

19− else

29+ then [Str " - "] ++ title

30+ else [])

20− title in

31+ else title in

21− let head = if (writerStandalone options) then

32+ let head = if (writerStandalone options)

22− htmlHeader options (Meta topTitle authors date)

33+ then htmlHeader options (Meta topTitle authors date)

23− else

34+ else ""

24− ""

25− titleBlocks = if (writerStandalone options) && (not (null title)) &&

35+ titleBlocks = if (writerStandalone options) && (not (null title)) &&

26− (not (writerS5 options)) then

36+ (not (writerS5 options))

27− [RawHtml "<h1 class=\"title\">", Plain title, RawHtml "</h1>\n"]

37+ then [RawHtml "<h1 class=\"title\">", Plain title,

38+ RawHtml "</h1>\n"]

28− else

39+ else []

29− []

30− foot = if (writerStandalone options) then "</body>\n</html>\n" else ""

40+ foot = if (writerStandalone options) then "</body>\n</html>\n" else ""

31− blocks' = replaceReferenceLinks (titleBlocks ++ blocks)

41+ blocks' = replaceReferenceLinks (titleBlocks ++ blocks)

32− (noteBlocks, blocks'') = partition isNoteBlock blocks'

42+ (noteBlocks, blocks'') = partition isNoteBlock blocks'

33− body = (writerIncludeBefore options) ++

43+ body = (writerIncludeBefore options) ++

34− concatMap (blockToHtml options) blocks'' ++

44+ concatMap (blockToHtml options) blocks'' ++

35− footnoteSection options noteBlocks ++

45+ footnoteSection options noteBlocks ++

36− (writerIncludeAfter options) in

46+ (writerIncludeAfter options) in

37− head ++ body ++ foot

47+ head ++ body ++ foot

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.

40footnoteSection :: WriterOptions -> [Block] -> String

51footnoteSection :: WriterOptions -> [Block] -> String

41footnoteSection options notes =

52footnoteSection options notes =

42− if null notes

53+ if null notes

43− then ""

54+ then ""

44− else "<div class=\"footnotes\">\n<hr />\n<ol>\n" ++

55+ else "<div class=\"footnotes\">\n<hr />\n<ol>\n" ++

45− concatMap (blockToHtml options) notes ++

56+ concatMap (blockToHtml options) notes ++

46− "</ol>\n</div>\n"

57+ "</ol>\n</div>\n"

48-- | Obfuscate a "mailto:" link using Javascript.

59-- | Obfuscate a "mailto:" link using Javascript.

49obfuscateLink :: WriterOptions -> [Inline] -> String -> String

60obfuscateLink :: WriterOptions -> [Inline] -> String -> String

50obfuscateLink options text src =

61obfuscateLink options text src =

51 let text' = inlineListToHtml options text in

62 let text' = inlineListToHtml options text in

52− let linkText = if src == ("mailto:" ++ text') then "e" else "'" ++ text' ++ "'"

63+ let linkText = if src == ("mailto:" ++ text')

64+ then "e"

65+ else "'" ++ text' ++ "'"

53− altText = if src == ("mailto:" ++ text') then "\\1 [at] \\2" else text' ++ " (\\1 [at] \\2)" in

66+ altText = if src == ("mailto:" ++ text')

67+ then "\\1 [at] \\2"

68+ else text' ++ " (\\1 [at] \\2)" in

54 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

69 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

56-- | Obfuscate character as entity.

71-- | Obfuscate character as entity.

57obfuscateChar :: Char -> String

72obfuscateChar :: Char -> String

58−obfuscateChar char = let num = ord char in

73+obfuscateChar char =

74+ let num = ord char in

59− let numstr = if even num then (show num) else ("x" ++ (showHex num "")) in

75+ let numstr = if even num then (show num) else ("x" ++ (showHex num "")) in

60− "&#" ++ numstr ++ ";"

76+ "&#" ++ numstr ++ ";"

62-- | Escape string, preserving character entities and quote.

78-- | Escape string, preserving character entities and quote.

63stringToHtml :: String -> String

79stringToHtml :: String -> String

64−stringToHtml str = escapePreservingRegex stringToHtmlString (mkRegex "\"|(&[[:alnum:]]*;)") str

80+stringToHtml str = escapePreservingRegex stringToHtmlString

81+ (mkRegex "\"|(&[[:alnum:]]*;)") str

66-- | Escape string as in 'stringToHtml' but add smart typography filter.

83-- | Escape string as in 'stringToHtml' but add smart typography filter.

67stringToSmartHtml :: String -> String

84stringToSmartHtml :: String -> String

68stringToSmartHtml =

85stringToSmartHtml =

69− let escapeDoubleQuotes =

86+ let escapeDoubleQuotes =

70− gsub "(\"|")" "”" . -- rest are right quotes

87+ gsub "(\"|")" "”" . -- rest are right quotes

88+ gsub "(\"|")(&r[sd]quo;)" "”\\2" .

71− gsub "(\"|")(&r[sd]quo;)" "”\\2" . -- never left quo before right quo

89+ -- never left quo before right quo

90+ gsub "(&l[sd]quo;)(\"|")" "\\2“" .

72− gsub "(&l[sd]quo;)(\"|")" "\\2“" . -- never right quo after left quo

91+ -- never right quo after left quo

92+ gsub "([ \t])(\"|")" "\\1“" .

73− gsub "([ \t])(\"|")" "\\1“" . -- never right quo after space

93+ -- never right quo after space

74− gsub "(\"|")([^,.;:!?^) \t-])" "“\\2" . -- "word left

94+ gsub "(\"|")([^,.;:!?^) \t-])" "“\\2" . -- "word left

95+ gsub "(\"|")('|`|‘)" "”’" .

75− gsub "(\"|")('|`|‘)" "”’" . -- right if it got through last filter

96+ -- right if it got through last filter

76− gsub "(\"|")('|`|‘)([^,.;:!?^) \t-])" "“‘\\3" . -- "'word left

97+ gsub "(\"|")('|`|‘)([^,.;:!?^) \t-])" "“‘\\3" .

98+ -- "'word left

77− gsub "``" "“" .

99+ gsub "``" "“" .

78− gsub "''" "”"

100+ gsub "''" "”"

79− escapeSingleQuotes =

101+ escapeSingleQuotes =

80− gsub "'" "’" . -- otherwise right

102+ gsub "'" "’" . -- otherwise right

81− gsub "'(&r[sd]quo;)" "’\\1" . -- never left quo before right quo

103+ gsub "'(&r[sd]quo;)" "’\\1" . -- never left quo before right quo

82− gsub "(&l[sd]quo;)'" "\\1‘" . -- never right quo after left quo

104+ gsub "(&l[sd]quo;)'" "\\1‘" . -- never right quo after left quo

83− gsub "([ \t])'" "\\1‘" . -- never right quo after space

105+ gsub "([ \t])'" "\\1‘" . -- never right quo after space

84− gsub "`" "‘" . -- ` is left

106+ gsub "`" "‘" . -- ` is left

85− gsub "([^,.;:!?^) \t-])'" "\\1’" . -- word' right

107+ gsub "([^,.;:!?^) \t-])'" "\\1’" . -- word' right

86− gsub "^('|`)([^,.;:!?^) \t-])" "‘\\2" . -- 'word left

108+ gsub "^('|`)([^,.;:!?^) \t-])" "‘\\2" . -- 'word left

87− gsub "('|`)(\"|"|“|``)" "‘“" . -- '"word left

109+ gsub "('|`)(\"|"|“|``)" "‘“" . -- '"word left

88− gsub "([^,.;:!?^) \t-])'(s|S)" "\\1’\\2" . -- possessive

110+ gsub "([^,.;:!?^) \t-])'(s|S)" "\\1’\\2" . -- possessive

89− gsub "([[:space:]])'([^,.;:!?^) \t-])" "\\1‘\\2" . -- 'word left

111+ gsub "([[:space:]])'([^,.;:!?^) \t-])" "\\1‘\\2" . -- 'word left

90− gsub "'([0-9][0-9](s|S))" "’\\1" -- '80s - decade abbrevs.

112+ gsub "'([0-9][0-9](s|S))" "’\\1" -- '80s - decade abbrevs.

91− escapeDashes = gsub " ?-- ?" "—" .

113+ escapeDashes =

114+ gsub " ?-- ?" "—" .

92− gsub " ?--- ?" "—" .

115+ gsub " ?--- ?" "—" .

93− gsub "([0-9])--?([0-9])" "\\1–\\2"

116+ gsub "([0-9])--?([0-9])" "\\1–\\2"

94− escapeEllipses = gsub "\\.\\.\\.|\\. \\. \\." "…" in

117+ escapeEllipses = gsub "\\.\\.\\.|\\. \\. \\." "…" in

95− escapeSingleQuotes . escapeDoubleQuotes . escapeDashes . escapeEllipses . stringToHtml

118+ escapeSingleQuotes . escapeDoubleQuotes . escapeDashes .

119+ escapeEllipses . stringToHtml

120

97-- | Escape code string as needed for HTML.

121-- | Escape code string as needed for HTML.

98codeStringToHtml :: String -> String

122codeStringToHtml :: String -> String

99codeStringToHtml [] = []

123codeStringToHtml [] = []

100codeStringToHtml (x:xs) = case x of

124codeStringToHtml (x:xs) = case x of

101− '&' -> "&" ++ codeStringToHtml xs

125+ '&' -> "&" ++ codeStringToHtml xs

102− '<' -> "<" ++ codeStringToHtml xs

126+ '<' -> "<" ++ codeStringToHtml xs

103− _ -> x:(codeStringToHtml xs)

127+ _ -> x:(codeStringToHtml xs)

104

128

105-- | Escape string to HTML appropriate for attributes

129-- | Escape string to HTML appropriate for attributes

106attributeStringToHtml :: String -> String

130attributeStringToHtml :: String -> String

@@ -109,17 +133,19 @@ attributeStringToHtml = gsub "\"" """

109-- | Returns an HTML header with appropriate bibliographic information.

133-- | Returns an HTML header with appropriate bibliographic information.

110htmlHeader :: WriterOptions -> Meta -> String

134htmlHeader :: WriterOptions -> Meta -> String

111htmlHeader options (Meta title authors date) =

135htmlHeader options (Meta title authors date) =

112− let titletext = "<title>" ++ (inlineListToHtml options title) ++ "</title>\n"

136+ let titletext = "<title>" ++ (inlineListToHtml options title) ++

137+ "</title>\n"

113− authortext = if (null authors) then

138+ authortext = if (null authors)

114− ""

139+ then ""

115− else

116− "<meta name=\"author\" content=\"" ++

140+ else "<meta name=\"author\" content=\"" ++

117− (joinWithSep ", " (map stringToHtml authors)) ++ "\" />\n"

141+ (joinWithSep ", " (map stringToHtml authors)) ++

142+ "\" />\n"

118− datetext = if (date == "") then

143+ datetext = if (date == "")

119− ""

144+ then ""

120− else

145+ else "<meta name=\"date\" content=\"" ++

121− "<meta name=\"date\" content=\"" ++ (stringToHtml date) ++ "\" />\n" in

146+ (stringToHtml date) ++ "\" />\n" in

122− (writerHeader options) ++ authortext ++ datetext ++ titletext ++ "</head>\n<body>\n"

147+ (writerHeader options) ++ authortext ++ datetext ++ titletext ++

148+ "</head>\n<body>\n"

123

149

124-- | Convert Pandoc block element to HTML.

150-- | Convert Pandoc block element to HTML.

125blockToHtml :: WriterOptions -> Block -> String

151blockToHtml :: WriterOptions -> Block -> String

@@ -128,85 +154,100 @@ blockToHtml options Null = ""

128blockToHtml options (Plain lst) = inlineListToHtml options lst

154blockToHtml options (Plain lst) = inlineListToHtml options lst

129blockToHtml options (Para lst) = "<p>" ++ (inlineListToHtml options lst) ++ "</p>\n"

155blockToHtml options (Para lst) = "<p>" ++ (inlineListToHtml options lst) ++ "</p>\n"

130blockToHtml options (BlockQuote blocks) =

156blockToHtml options (BlockQuote blocks) =

157+ if (writerS5 options)

131− if (writerS5 options) then -- in S5, treat list in blockquote specially

158+ then -- in S5, treat list in blockquote specially

132− -- if default is incremental, make it nonincremental; otherwise incremental

159+ -- if default is incremental, make it nonincremental;

160+ -- otherwise incremental

133− let inc = not (writerIncremental options) in

161+ let inc = not (writerIncremental options) in

134− case blocks of

162+ case blocks of

135− [BulletList lst] -> blockToHtml (options {writerIncremental = inc}) (BulletList lst)

163+ [BulletList lst] -> blockToHtml (options {writerIncremental =

164+ inc}) (BulletList lst)

136− [OrderedList lst] -> blockToHtml (options {writerIncremental = inc}) (OrderedList lst)

165+ [OrderedList lst] -> blockToHtml (options {writerIncremental =

166+ inc}) (OrderedList lst)

167+ otherwise -> "<blockquote>\n" ++

137− otherwise -> "<blockquote>\n" ++ (concatMap (blockToHtml options) blocks) ++

168+ (concatMap (blockToHtml options) blocks) ++

138− "</blockquote>\n"

169+ "</blockquote>\n"

139− else

140− "<blockquote>\n" ++ (concatMap (blockToHtml options) blocks) ++ "</blockquote>\n"

170+ else "<blockquote>\n" ++ (concatMap (blockToHtml options) blocks) ++

171+ "</blockquote>\n"

141blockToHtml options (Note ref lst) =

172blockToHtml options (Note ref lst) =

142− let contents = (concatMap (blockToHtml options) lst) in

173+ let contents = (concatMap (blockToHtml options) lst) in

143− "<li id=\"fn" ++ ref ++ "\">" ++ contents ++ " <a href=\"#fnref" ++ ref ++

174+ "<li id=\"fn" ++ ref ++ "\">" ++ contents ++ " <a href=\"#fnref" ++ ref ++

144− "\" class=\"footnoteBacklink\" title=\"Jump back to footnote " ++ ref ++

175+ "\" class=\"footnoteBacklink\" title=\"Jump back to footnote " ++ ref ++

145− "\">↩</a></li>\n"

176+ "\">↩</a></li>\n"

146blockToHtml options (Key _ _) = ""

177blockToHtml options (Key _ _) = ""

147−blockToHtml options (CodeBlock str) = "<pre><code>" ++ (codeStringToHtml str) ++

178+blockToHtml options (CodeBlock str) =

148− "\n</code></pre>\n"

179+ "<pre><code>" ++ (codeStringToHtml str) ++ "\n</code></pre>\n"

149blockToHtml options (RawHtml str) = str

180blockToHtml options (RawHtml str) = str

150blockToHtml options (BulletList lst) =

181blockToHtml options (BulletList lst) =

151− let attribs = if (writerIncremental options) then " class=\"incremental\"" else "" in

182+ let attribs = if (writerIncremental options)

183+ then " class=\"incremental\""

184+ else "" in

152− "<ul" ++ attribs ++ ">\n" ++ (concatMap (listItemToHtml options) lst) ++ "</ul>\n"

185+ "<ul" ++ attribs ++ ">\n" ++ (concatMap (listItemToHtml options) lst) ++

186+ "</ul>\n"

153blockToHtml options (OrderedList lst) =

187blockToHtml options (OrderedList lst) =

154− let attribs = if (writerIncremental options) then " class=\"incremental\"" else "" in

188+ let attribs = if (writerIncremental options)

189+ then " class=\"incremental\""

190+ else "" in

155− "<ol" ++ attribs ++ ">\n" ++ (concatMap (listItemToHtml options) lst) ++ "</ol>\n"

191+ "<ol" ++ attribs ++ ">\n" ++ (concatMap (listItemToHtml options) lst) ++

192+ "</ol>\n"

156blockToHtml options HorizontalRule = "<hr />\n"

193blockToHtml options HorizontalRule = "<hr />\n"

157blockToHtml options (Header level lst) =

194blockToHtml options (Header level lst) =

158− let contents = inlineListToHtml options lst in

195+ let contents = inlineListToHtml options lst in

159− let simplify = gsub "<[^>]*>" "" . gsub " " "_" in

196+ let simplify = gsub "<[^>]*>" "" . gsub " " "_" in

160− if ((level > 0) && (level <= 6))

197+ if ((level > 0) && (level <= 6))

161− then "<a id=\"" ++ simplify contents ++ "\"></a>\n" ++

198+ then "<a id=\"" ++ simplify contents ++ "\"></a>\n" ++

162− "<h" ++ (show level) ++ ">" ++ contents ++

199+ "<h" ++ (show level) ++ ">" ++ contents ++

163− "</h" ++ (show level) ++ ">\n"

200+ "</h" ++ (show level) ++ ">\n"

164− else "<p>" ++ contents ++ "</p>\n"

201+ else "<p>" ++ contents ++ "</p>\n"

202+listItemToHtml options list =

165−listItemToHtml options list = "<li>" ++ (concatMap (blockToHtml options) list) ++ "</li>\n"

203+ "<li>" ++ (concatMap (blockToHtml options) list) ++ "</li>\n"

166

204

167-- | Convert list of Pandoc inline elements to HTML.

205-- | Convert list of Pandoc inline elements to HTML.

168inlineListToHtml :: WriterOptions -> [Inline] -> String

206inlineListToHtml :: WriterOptions -> [Inline] -> String

169inlineListToHtml options lst =

207inlineListToHtml options lst =

170− -- consolidate adjacent Str and Space elements for more intelligent

208+ -- consolidate adjacent Str and Space elements for more intelligent

171− -- smart typography filtering

209+ -- smart typography filtering

172− let lst' = consolidateList lst in

210+ let lst' = consolidateList lst in

173− concatMap (inlineToHtml options) lst'

211+ concatMap (inlineToHtml options) lst'

174

212

175-- | Convert Pandoc inline element to HTML.

213-- | Convert Pandoc inline element to HTML.

176inlineToHtml :: WriterOptions -> Inline -> String

214inlineToHtml :: WriterOptions -> Inline -> String

215+inlineToHtml options (Emph lst) =

177−inlineToHtml options (Emph lst) = "<em>" ++ (inlineListToHtml options lst) ++ "</em>"

216+ "<em>" ++ (inlineListToHtml options lst) ++ "</em>"

217+inlineToHtml options (Strong lst) =

178−inlineToHtml options (Strong lst) = "<strong>" ++ (inlineListToHtml options lst) ++ "</strong>"

218+ "<strong>" ++ (inlineListToHtml options lst) ++ "</strong>"

219+inlineToHtml options (Code str) =

179−inlineToHtml options (Code str) = "<code>" ++ (codeStringToHtml str) ++ "</code>"

220+ "<code>" ++ (codeStringToHtml str) ++ "</code>"

180−inlineToHtml options (Str str) = if (writerSmart options) then

221+inlineToHtml options (Str str) =

181− stringToSmartHtml str

222+ if (writerSmart options) then stringToSmartHtml str else stringToHtml str

182− else

183− stringToHtml str

184inlineToHtml options (TeX str) = (codeStringToHtml str)

223inlineToHtml options (TeX str) = (codeStringToHtml str)

185inlineToHtml options (HtmlInline str) = str

224inlineToHtml options (HtmlInline str) = str

186inlineToHtml options (LineBreak) = "<br />\n"

225inlineToHtml options (LineBreak) = "<br />\n"

187inlineToHtml options Space = " "

226inlineToHtml options Space = " "

188inlineToHtml options (Link text (Src src tit)) =

227inlineToHtml options (Link text (Src src tit)) =

189− let title = attributeStringToHtml tit in

228+ let title = attributeStringToHtml tit in

190− if (isPrefixOf "mailto:" src) then

229+ if (isPrefixOf "mailto:" src)

191− obfuscateLink options text src

230+ then obfuscateLink options text src

192− else

193− "<a href=\"" ++ (codeStringToHtml src) ++ "\"" ++

231+ else "<a href=\"" ++ (codeStringToHtml src) ++ "\"" ++

194− (if tit /= "" then " title=\"" ++ title ++ "\">" else ">") ++

232+ (if tit /= "" then " title=\"" ++ title ++ "\">" else ">") ++

195− (inlineListToHtml options text) ++ "</a>"

233+ (inlineListToHtml options text) ++ "</a>"

196−inlineToHtml options (Link text (Ref [])) = "[" ++ (inlineListToHtml options text) ++ "]"

234+inlineToHtml options (Link text (Ref [])) =

235+ "[" ++ (inlineListToHtml options text) ++ "]"

197−inlineToHtml options (Link text (Ref ref)) = "[" ++ (inlineListToHtml options text) ++ "][" ++

236+inlineToHtml options (Link text (Ref ref)) =

237+ "[" ++ (inlineListToHtml options text) ++ "][" ++

238+ (inlineListToHtml options ref) ++ "]"

198− (inlineListToHtml options ref) ++ "]" -- this is what markdown does, for better or worse

239+ -- this is what markdown does, for better or worse

199inlineToHtml options (Image alt (Src source tit)) =

240inlineToHtml options (Image alt (Src source tit)) =

200− let title = attributeStringToHtml tit

241+ let title = attributeStringToHtml tit

201− alternate = inlineListToHtml options alt in

242+ alternate = inlineListToHtml options alt in

202− "<img src=\"" ++ source ++ "\"" ++

243+ "<img src=\"" ++ source ++ "\"" ++

203− (if tit /= "" then " title=\"" ++ title ++ "\"" else "") ++

244+ (if tit /= "" then " title=\"" ++ title ++ "\"" else "") ++

204− (if alternate /= "" then " alt=\"" ++ alternate ++ "\"" else "") ++ ">"

245+ (if alternate /= "" then " alt=\"" ++ alternate ++ "\"" else "") ++ ">"

205inlineToHtml options (Image alternate (Ref [])) =

246inlineToHtml options (Image alternate (Ref [])) =

206− "![" ++ (inlineListToHtml options alternate) ++ "]"

247+ "![" ++ (inlineListToHtml options alternate) ++ "]"

207inlineToHtml options (Image alternate (Ref ref)) =

248inlineToHtml options (Image alternate (Ref ref)) =

208− "![" ++ (inlineListToHtml options alternate) ++ "][" ++ (inlineListToHtml options ref) ++ "]"

249+ "![" ++ (inlineListToHtml options alternate) ++ "][" ++

250+ (inlineListToHtml options ref) ++ "]"

209inlineToHtml options (NoteRef ref) =

251inlineToHtml options (NoteRef ref) =

210− "<sup class=\"footnoteRef\" id=\"fnref" ++ ref ++ "\"><a href=\"#fn" ++ ref ++

252+ "<sup class=\"footnoteRef\" id=\"fnref" ++ ref ++ "\"><a href=\"#fn" ++

211− "\">" ++ ref ++ "</a></sup>"

253+ ref ++ "\">" ++ ref ++ "</a></sup>"

212−

src/Text/Pandoc/Writers/LaTeX.hs+85−70

@@ -1,4 +1,14 @@

1+{- |

2+ Module : Text.Pandoc.Writers.LaTeX

4+ License : GNU GPL, version 2 or above

6+ Maintainer : John MacFarlane <jgm at berkeley dot edu>

7+ Stability : unstable

8+ Portability : portable

1−-- | Convert Pandoc to LaTeX.

10+Conversion of 'Pandoc' format into LaTeX.

11+-}

2module Text.Pandoc.Writers.LaTeX (

12module Text.Pandoc.Writers.LaTeX (

3 writeLaTeX

13 writeLaTeX

4 ) where

14 ) where

@@ -9,46 +19,40 @@ import List ( (\\) )

9-- | Convert Pandoc to LaTeX.

19-- | Convert Pandoc to LaTeX.

10writeLaTeX :: WriterOptions -> Pandoc -> String

20writeLaTeX :: WriterOptions -> Pandoc -> String

11writeLaTeX options (Pandoc meta blocks) =

21writeLaTeX options (Pandoc meta blocks) =

12− let notes = filter isNoteBlock blocks in -- assumes all notes are at outer level

22+ let notes = filter isNoteBlock blocks in -- assumes all notes at outer level

13− let body = (writerIncludeBefore options) ++

23+ let body = (writerIncludeBefore options) ++

24+ (concatMap (blockToLaTeX notes)

14− (concatMap (blockToLaTeX notes) (replaceReferenceLinks blocks)) ++

25+ (replaceReferenceLinks blocks)) ++

15− (writerIncludeAfter options) in

26+ (writerIncludeAfter options) in

16− let head = if writerStandalone options then

27+ let head = if writerStandalone options

17− latexHeader notes options meta

28+ then latexHeader notes options meta

18− else

29+ else "" in

19− "" in

20− let foot = if writerStandalone options then "\n\\end{document}\n" else "" in

30+ let foot = if writerStandalone options then "\n\\end{document}\n" else "" in

21− head ++ body ++ foot

31+ head ++ body ++ foot

23-- | Insert bibliographic information into LaTeX header.

33-- | Insert bibliographic information into LaTeX header.

24−latexHeader :: [Block] -- ^ List of note blocks to use in resolving note refs

34+latexHeader :: [Block] -- ^ List of note blocks to use in resolving note refs

25− -> WriterOptions -- ^ Options, including LaTeX header

35+ -> WriterOptions -- ^ Options, including LaTeX header

26− -> Meta -- ^ Meta with bibliographic information

36+ -> Meta -- ^ Meta with bibliographic information

27 -> String

37 -> String

28latexHeader notes options (Meta title authors date) =

38latexHeader notes options (Meta title authors date) =

29− let titletext = if null title then

39+ let titletext = if null title

30− ""

40+ then ""

31− else

32− "\\title{" ++ inlineListToLaTeX notes title ++ "}\n"

41+ else "\\title{" ++ inlineListToLaTeX notes title ++ "}\n"

33− authorstext = if null authors then

42+ authorstext = if null authors

34− ""

43+ then ""

35− else

44+ else "\\author{" ++ (joinWithSep "\\\\"

36− "\\author{" ++ (joinWithSep "\\\\" (map stringToLaTeX authors)) ++ "}\n"

45+ (map stringToLaTeX authors)) ++ "}\n"

37− datetext = if date == "" then

46+ datetext = if date == ""

38− ""

47+ then ""

39− else

40− "\\date{" ++ stringToLaTeX date ++ "}\n"

48+ else "\\date{" ++ stringToLaTeX date ++ "}\n"

41− maketitle = if null title then

49+ maketitle = if null title then "" else "\\maketitle\n"

42− ""

43− else

44− "\\maketitle\n"

45− secnumline = if (writerNumberSections options) then

50+ secnumline = if (writerNumberSections options)

46− ""

51+ then ""

47− else

48− "\\setcounter{secnumdepth}{0}\n"

52+ else "\\setcounter{secnumdepth}{0}\n"

49− header = writerHeader options in

53+ header = writerHeader options in

50− header ++ secnumline ++ titletext ++ authorstext ++ datetext ++ "\\begin{document}\n" ++ maketitle

54+ header ++ secnumline ++ titletext ++ authorstext ++ datetext ++

51−

55+ "\\begin{document}\n" ++ maketitle

53-- escape things as needed for LaTeX (also ldots, dashes, quotes, etc.)

57-- escape things as needed for LaTeX (also ldots, dashes, quotes, etc.)

@@ -77,7 +81,8 @@ escapeSingleQuotes =

77 gsub "([^[:punct:][:space:]])`(s|S)" "\\1'\\2" . -- catch possessives

81 gsub "([^[:punct:][:space:]])`(s|S)" "\\1'\\2" . -- catch possessives

78 gsub "^'([^[:punct:][:space:]])" "`\\1" . -- 'word left

82 gsub "^'([^[:punct:][:space:]])" "`\\1" . -- 'word left

79 gsub "([[:space:]])'" "\\1`" . -- never right quote after space

83 gsub "([[:space:]])'" "\\1`" . -- never right quote after space

84+ gsub "([[:space:]])'([^[:punct:][:space:]])" "\\1`\\2"

80− gsub "([[:space:]])'([^[:punct:][:space:]])" "\\1`\\2" -- 'word left (leave possessives)

85+ -- 'word left (leave possessives)

82escapeEllipses = gsub "\\.\\.\\.|\\. \\. \\." "\\ldots{}"

87escapeEllipses = gsub "\\.\\.\\.|\\. \\. \\." "\\ldots{}"

@@ -85,12 +90,14 @@ escapeDashes = gsub "([0-9])-([0-9])" "\\1--\\2" .

85 gsub " *--- *" "---" .

90 gsub " *--- *" "---" .

86 gsub "([^-])--([^-])" "\\1---\\2"

91 gsub "([^-])--([^-])" "\\1---\\2"

88−escapeSmart = escapeDashes . escapeSingleQuotes . escapeDoubleQuotes . escapeEllipses

93+escapeSmart = escapeDashes . escapeSingleQuotes . escapeDoubleQuotes .

94+ escapeEllipses

90-- | Escape string for LaTeX (including smart quotes, dashes, ellipses)

96-- | Escape string for LaTeX (including smart quotes, dashes, ellipses)

91stringToLaTeX :: String -> String

97stringToLaTeX :: String -> String

92stringToLaTeX = escapeSmart . escapeGt . escapeLt . escapeBar . escapeHat .

98stringToLaTeX = escapeSmart . escapeGt . escapeLt . escapeBar . escapeHat .

93− escapeSpecial . fixBackslash . escapeBrackets . escapeBackslash

99+ escapeSpecial . fixBackslash . escapeBrackets .

100+ escapeBackslash

101

95-- | Remove all code elements from list of inline elements

102-- | Remove all code elements from list of inline elements

96-- (because it's illegal to have a \\verb inside a command argument)

103-- (because it's illegal to have a \\verb inside a command argument)

@@ -107,43 +114,47 @@ blockToLaTeX notes Blank = "\n"

107blockToLaTeX notes Null = ""

114blockToLaTeX notes Null = ""

108blockToLaTeX notes (Plain lst) = inlineListToLaTeX notes lst ++ "\n"

115blockToLaTeX notes (Plain lst) = inlineListToLaTeX notes lst ++ "\n"

109blockToLaTeX notes (Para lst) = (inlineListToLaTeX notes lst) ++ "\n\n"

116blockToLaTeX notes (Para lst) = (inlineListToLaTeX notes lst) ++ "\n\n"

110−blockToLaTeX notes (BlockQuote lst) =

117+blockToLaTeX notes (BlockQuote lst) = "\\begin{quote}\n" ++

111− "\\begin{quote}\n" ++ (concatMap (blockToLaTeX notes) lst) ++ "\\end{quote}\n"

118+ (concatMap (blockToLaTeX notes) lst) ++ "\\end{quote}\n"

112blockToLaTeX notes (Note ref lst) = ""

119blockToLaTeX notes (Note ref lst) = ""

113blockToLaTeX notes (Key _ _) = ""

120blockToLaTeX 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"

115blockToLaTeX notes (RawHtml str) = ""

123blockToLaTeX notes (RawHtml str) = ""

116−blockToLaTeX notes (BulletList lst) =

124+blockToLaTeX notes (BulletList lst) = "\\begin{itemize}\n" ++

117− "\\begin{itemize}\n" ++ (concatMap (listItemToLaTeX notes) lst) ++ "\\end{itemize}\n"

125+ (concatMap (listItemToLaTeX notes) lst) ++ "\\end{itemize}\n"

118−blockToLaTeX notes (OrderedList lst) =

126+blockToLaTeX notes (OrderedList lst) = "\\begin{enumerate}\n" ++

119− "\\begin{enumerate}\n" ++ (concatMap (listItemToLaTeX notes) lst) ++ "\\end{enumerate}\n"

127+ (concatMap (listItemToLaTeX notes) lst) ++ "\\end{enumerate}\n"

128+blockToLaTeX notes HorizontalRule =

120−blockToLaTeX notes HorizontalRule = "\\begin{center}\\rule{3in}{0.4pt}\\end{center}\n\n"

129+ "\\begin{center}\\rule{3in}{0.4pt}\\end{center}\n\n"

121blockToLaTeX notes (Header level lst) =

130blockToLaTeX notes (Header level lst) =

122− if (level > 0) && (level <= 3) then

131+ if (level > 0) && (level <= 3)

123− "\\" ++ (concat (replicate (level - 1) "sub")) ++ "section{" ++

132+ then "\\" ++ (concat (replicate (level - 1) "sub")) ++ "section{" ++

124− (inlineListToLaTeX notes (deVerb lst)) ++ "}\n\n"

133+ (inlineListToLaTeX notes (deVerb lst)) ++ "}\n\n"

125− else

126− (inlineListToLaTeX notes lst) ++ "\n\n"

134+ else (inlineListToLaTeX notes lst) ++ "\n\n"

135+listItemToLaTeX notes list = "\\item " ++

127−listItemToLaTeX notes list = "\\item " ++ (concatMap (blockToLaTeX notes) list)

136+ (concatMap (blockToLaTeX notes) list)

128

137

129-- | Convert list of inline elements to LaTeX.

138-- | Convert list of inline elements to LaTeX.

130inlineListToLaTeX :: [Block] -- ^ List of note blocks to use in resolving note refs

139inlineListToLaTeX :: [Block] -- ^ List of note blocks to use in resolving note refs

131 -> [Inline] -- ^ Inlines to convert

140 -> [Inline] -- ^ Inlines to convert

132 -> String

141 -> String

133inlineListToLaTeX notes lst =

142inlineListToLaTeX notes lst =

134− -- first, consolidate Str and Space for more effective smartquotes:

143+ -- first, consolidate Str and Space for more effective smartquotes:

135− let lst' = consolidateList lst in

144+ let lst' = consolidateList lst in

136− concatMap (inlineToLaTeX notes) lst'

145+ concatMap (inlineToLaTeX notes) lst'

137

146

138-- | Convert inline element to LaTeX

147-- | Convert inline element to LaTeX

139inlineToLaTeX :: [Block] -- ^ List of note blocks to use in resolving note refs

148inlineToLaTeX :: [Block] -- ^ List of note blocks to use in resolving note refs

140 -> Inline -- ^ Inline to convert

149 -> Inline -- ^ Inline to convert

141 -> String

150 -> String

151+inlineToLaTeX notes (Emph lst) = "\\emph{" ++

142−inlineToLaTeX notes (Emph lst) = "\\emph{" ++ (inlineListToLaTeX notes (deVerb lst)) ++ "}"

152+ (inlineListToLaTeX notes (deVerb lst)) ++ "}"

143−inlineToLaTeX notes (Strong lst) = "\\textbf{" ++ (inlineListToLaTeX notes (deVerb lst)) ++ "}"

153+inlineToLaTeX notes (Strong lst) = "\\textbf{" ++

154+ (inlineListToLaTeX notes (deVerb lst)) ++ "}"

144inlineToLaTeX notes (Code str) = "\\verb" ++ [chr] ++ stuffing ++ [chr]

155inlineToLaTeX notes (Code str) = "\\verb" ++ [chr] ++ stuffing ++ [chr]

145− where stuffing = str

156+ where stuffing = str

146− chr = ((enumFromTo '!' '~') \\ stuffing) !! 0

157+ chr = ((enumFromTo '!' '~') \\ stuffing) !! 0

147inlineToLaTeX notes (Str str) = stringToLaTeX str

158inlineToLaTeX notes (Str str) = stringToLaTeX str

148inlineToLaTeX notes (TeX str) = str

159inlineToLaTeX notes (TeX str) = str

149inlineToLaTeX notes (HtmlInline str) = ""

160inlineToLaTeX notes (HtmlInline str) = ""

@@ -151,18 +162,22 @@ inlineToLaTeX notes (LineBreak) = "\\\\\n"

151inlineToLaTeX notes Space = " "

162inlineToLaTeX notes Space = " "

152inlineToLaTeX notes (Link text (Src src tit)) =

163inlineToLaTeX notes (Link text (Src src tit)) =

153 "\\href{" ++ src ++ "}{" ++ (inlineListToLaTeX notes (deVerb text)) ++ "}"

164 "\\href{" ++ src ++ "}{" ++ (inlineListToLaTeX notes (deVerb text)) ++ "}"

154−inlineToLaTeX notes (Link text (Ref [])) = "[" ++ (inlineListToLaTeX notes text) ++ "]"

165+inlineToLaTeX notes (Link text (Ref [])) = "[" ++

166+ (inlineListToLaTeX notes text) ++ "]"

155−inlineToLaTeX notes (Link text (Ref ref)) = "[" ++ (inlineListToLaTeX notes text) ++ "][" ++

167+inlineToLaTeX notes (Link text (Ref ref)) = "[" ++

168+ (inlineListToLaTeX notes text) ++ "][" ++ (inlineListToLaTeX notes ref) ++

156− (inlineListToLaTeX notes ref) ++ "]" -- this is what markdown does, for better or worse

169+ "]" -- this is what markdown does, for better or worse

157−inlineToLaTeX notes (Image alternate (Src source tit)) = "\\includegraphics{" ++ source ++ "}"

170+inlineToLaTeX notes (Image alternate (Src source tit)) =

171+ "\\includegraphics{" ++ source ++ "}"

158inlineToLaTeX notes (Image alternate (Ref [])) =

172inlineToLaTeX notes (Image alternate (Ref [])) =

159 "![" ++ (inlineListToLaTeX notes alternate) ++ "]"

173 "![" ++ (inlineListToLaTeX notes alternate) ++ "]"

160inlineToLaTeX notes (Image alternate (Ref ref)) =

174inlineToLaTeX notes (Image alternate (Ref ref)) =

161− "![" ++ (inlineListToLaTeX notes alternate) ++ "][" ++ (inlineListToLaTeX notes ref) ++ "]"

175+ "![" ++ (inlineListToLaTeX notes alternate) ++ "][" ++

176+ (inlineListToLaTeX notes ref) ++ "]"

162inlineToLaTeX [] (NoteRef ref) = ""

177inlineToLaTeX [] (NoteRef ref) = ""

163inlineToLaTeX ((Note firstref firstblocks):rest) (NoteRef ref) =

178inlineToLaTeX ((Note firstref firstblocks):rest) (NoteRef ref) =

164− if (firstref == ref) then

179+ if (firstref == ref)

180+ then "\\footnote{" ++ (stripTrailingNewlines

165− "\\footnote{" ++ (stripTrailingNewlines (concatMap (blockToLaTeX rest) firstblocks)) ++ "}"

181+ (concatMap (blockToLaTeX rest) firstblocks)) ++ "}"

166− else

167− inlineToLaTeX rest (NoteRef ref)

182+ else inlineToLaTeX rest (NoteRef ref)

168

183

src/Text/Pandoc/Writers/Markdown.hs+86−62

@@ -1,4 +1,16 @@

1−-- | Converts Pandoc to Markdown.

1+{- |

2+ Module : Text.Pandoc.Writers.Markdown

4+ License : GNU GPL, version 2 or above

6+ Maintainer : John MacFarlane <jgm at berkeley dot edu>

7+ Stability : unstable

8+ Portability : portable

10+Conversion of 'Pandoc' documents to markdown-formatted plain text.

11+

12+Markdown: http://daringfireball.net/projects/markdown/

13+-}

2module Text.Pandoc.Writers.Markdown (

14module Text.Pandoc.Writers.Markdown (

3 writeMarkdown

15 writeMarkdown

4 ) where

16 ) where

@@ -11,11 +23,11 @@ import Text.PrettyPrint.HughesPJ hiding ( Str )

11writeMarkdown :: WriterOptions -> Pandoc -> String

23writeMarkdown :: WriterOptions -> Pandoc -> String

12writeMarkdown options (Pandoc meta blocks) =

24writeMarkdown options (Pandoc meta blocks) =

13 let body = text (writerIncludeBefore options) <>

25 let body = text (writerIncludeBefore options) <>

26+ vcat (map (blockToMarkdown (writerTabStop options))

14− vcat (map (blockToMarkdown (writerTabStop options)) (formatKeys blocks)) $$ text (writerIncludeAfter options) in

27+ (formatKeys blocks)) $$ text (writerIncludeAfter options) in

15− let head = if (writerStandalone options) then

28+ let head = if (writerStandalone options)

16− ((metaToMarkdown meta) $$ text (writerHeader options))

29+ then ((metaToMarkdown meta) $$ text (writerHeader options))

17− else

18− empty in

30+ else empty in

19 render $ head <> body

31 render $ head <> body

21-- | Escape special characters for Markdown.

33-- | Escape special characters for Markdown.

@@ -28,13 +40,15 @@ escapeLinkTitle = gsub "\"" "\\\\\""

29-- | Take list of inline elements and return wrapped doc.

41-- | Take list of inline elements and return wrapped doc.

30wrappedMarkdown :: [Inline] -> Doc

42wrappedMarkdown :: [Inline] -> Doc

43+wrappedMarkdown lst = fsep $

31−wrappedMarkdown lst = fsep $ map (fcat . (map inlineToMarkdown)) (splitBySpace lst)

44+ map (fcat . (map inlineToMarkdown)) (splitBySpace lst)

33-- | Insert Blank block between key and non-key

46-- | Insert Blank block between key and non-key

34formatKeys :: [Block] -> [Block]

47formatKeys :: [Block] -> [Block]

35formatKeys [] = []

48formatKeys [] = []

36formatKeys [x] = [x]

49formatKeys [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))

38formatKeys ((Key x1 y1):rest) = (Key x1 y1):Blank:(formatKeys rest)

52formatKeys ((Key x1 y1):rest) = (Key x1 y1):Blank:(formatKeys rest)

39formatKeys (x:(Key x1 y1):rest) = x:Blank:(formatKeys ((Key x1 y1):rest))

53formatKeys (x:(Key x1 y1):rest) = x:Blank:(formatKeys ((Key x1 y1):rest))

40formatKeys (x:rest) = x:(formatKeys rest)

54formatKeys (x:rest) = x:(formatKeys rest)

@@ -43,17 +57,18 @@ formatKeys (x:rest) = x:(formatKeys rest)

43metaToMarkdown :: Meta -> Doc

57metaToMarkdown :: Meta -> Doc

44metaToMarkdown (Meta [] [] "") = empty

58metaToMarkdown (Meta [] [] "") = empty

45metaToMarkdown (Meta title [] "") = (titleToMarkdown title) <> (text "\n")

59metaToMarkdown (Meta title [] "") = (titleToMarkdown title) <> (text "\n")

46−metaToMarkdown (Meta title authors "") =

60+metaToMarkdown (Meta title authors "") = (titleToMarkdown title) <>

47− (titleToMarkdown title) <> (text "\n") <> (authorsToMarkdown authors) <> (text "\n")

61+ (text "\n") <> (authorsToMarkdown authors) <> (text "\n")

48−metaToMarkdown (Meta title authors date) =

62+metaToMarkdown (Meta title authors date) = (titleToMarkdown title) <>

49− (titleToMarkdown title) <> (text "\n") <> (authorsToMarkdown authors) <>

63+ (text "\n") <> (authorsToMarkdown authors) <> (text "\n") <>

50− (text "\n") <> (dateToMarkdown date) <> (text "\n")

64+ (dateToMarkdown date) <> (text "\n")

52titleToMarkdown :: [Inline] -> Doc

66titleToMarkdown :: [Inline] -> Doc

53titleToMarkdown lst = text "% " <> (inlineListToMarkdown lst)

67titleToMarkdown lst = text "% " <> (inlineListToMarkdown lst)

55authorsToMarkdown :: [String] -> Doc

69authorsToMarkdown :: [String] -> Doc

70+authorsToMarkdown lst =

56−authorsToMarkdown lst = text "% " <> text (joinWithSep ", " (map escapeString lst))

71+ text "% " <> text (joinWithSep ", " (map escapeString lst))

58dateToMarkdown :: String -> Doc

73dateToMarkdown :: String -> Doc

59dateToMarkdown str = text "% " <> text (escapeString str)

74dateToMarkdown str = text "% " <> text (escapeString str)

@@ -67,33 +82,34 @@ blockToMarkdown tabStop Null = empty

67blockToMarkdown tabStop (Plain lst) = wrappedMarkdown lst

82blockToMarkdown tabStop (Plain lst) = wrappedMarkdown lst

68blockToMarkdown tabStop (Para lst) = (wrappedMarkdown lst) <> (text "\n")

83blockToMarkdown tabStop (Para lst) = (wrappedMarkdown lst) <> (text "\n")

69blockToMarkdown tabStop (BlockQuote lst) =

84blockToMarkdown tabStop (BlockQuote lst) =

70− (vcat $ map (\line -> (text "> ") <> (text line)) $ lines $ render $ vcat $

85+ (vcat $ map (\line -> (text "> ") <> (text line)) $ lines $ render $ vcat $

71− map (blockToMarkdown tabStop) lst) <> (text "\n")

86+ map (blockToMarkdown tabStop) lst) <> (text "\n")

72blockToMarkdown tabStop (Note ref lst) =

87blockToMarkdown tabStop (Note ref lst) =

73− let lns = lines $ render $ vcat $ map (blockToMarkdown tabStop) lst in

88+ let lns = lines $ render $ vcat $ map (blockToMarkdown tabStop) lst in

74− if null lns then

89+ if null lns

75− empty

90+ then empty

76− else

77− let first = head lns

91+ else let first = head lns

78− rest = tail lns in

92+ rest = tail lns in

79− text ("[^" ++ (escapeString ref) ++ "]: ") <> (text first) $$ (vcat $

93+ text ("[^" ++ (escapeString ref) ++ "]: ") <> (text first) $$

80− map (\line -> (text " ") <> (text line)) rest) <> text "\n"

94+ (vcat $ map (\line -> (text " ") <> (text line)) rest) <>

95+ text "\n"

81blockToMarkdown tabStop (Key txt (Src src tit)) =

96blockToMarkdown tabStop (Key txt (Src src tit)) =

82− text " " <> char '[' <> inlineListToMarkdown txt <> char ']' <> text ": " <> text src <>

97+ text " " <> char '[' <> inlineListToMarkdown txt <> char ']' <>

98+ text ": " <> text src <>

83− (if tit /= "" then (text (" \"" ++ (escapeLinkTitle tit) ++ "\"")) else empty)

99+ if tit /= "" then text (" \"" ++ (escapeLinkTitle tit) ++ "\"") else empty

84−blockToMarkdown tabStop (CodeBlock str) = (nest tabStop $ vcat $ map text (lines str)) <>

100+blockToMarkdown tabStop (CodeBlock str) =

85− text "\n"

101+ (nest tabStop $ vcat $ map text (lines str)) <> text "\n"

86blockToMarkdown tabStop (RawHtml str) = text str

102blockToMarkdown tabStop (RawHtml str) = text str

87blockToMarkdown tabStop (BulletList lst) =

103blockToMarkdown tabStop (BulletList lst) =

88− vcat (map (bulletListItemToMarkdown tabStop) lst) <> text "\n"

104+ vcat (map (bulletListItemToMarkdown tabStop) lst) <> text "\n"

89blockToMarkdown tabStop (OrderedList lst) =

105blockToMarkdown tabStop (OrderedList lst) =

90− vcat (zipWith (orderedListItemToMarkdown tabStop) (enumFromTo 1 (length lst)) lst) <>

106+ vcat (zipWith (orderedListItemToMarkdown tabStop)

91− text "\n"

107+ (enumFromTo 1 (length lst)) lst) <> text "\n"

92blockToMarkdown tabStop HorizontalRule = text "\n* * * * *\n"

108blockToMarkdown tabStop HorizontalRule = text "\n* * * * *\n"

93−blockToMarkdown tabStop (Header level lst) =

109+blockToMarkdown tabStop (Header level lst) = text ((replicate level '#') ++

94− text ((replicate level '#') ++ " ") <> (inlineListToMarkdown lst) <> (text "\n")

110+ " ") <> (inlineListToMarkdown lst) <> (text "\n")

95bulletListItemToMarkdown tabStop list =

111bulletListItemToMarkdown tabStop list =

96− hang (text "- ") tabStop (vcat (map (blockToMarkdown tabStop) list))

112+ hang (text "- ") tabStop (vcat (map (blockToMarkdown tabStop) list))

113

98-- | Convert ordered list item (a list of blocks) to markdown.

114-- | Convert ordered list item (a list of blocks) to markdown.

99orderedListItemToMarkdown :: Int -- ^ tab stop

115orderedListItemToMarkdown :: Int -- ^ tab stop

@@ -101,8 +117,9 @@ orderedListItemToMarkdown :: Int -- ^ tab stop

101 -> [Block] -- ^ list item (list of blocks)

117 -> [Block] -- ^ list item (list of blocks)

102 -> Doc

118 -> Doc

103orderedListItemToMarkdown tabStop num list =

119orderedListItemToMarkdown tabStop num list =

120+ hang (text ((show num) ++ "." ++ spacer)) tabStop

104− hang (text ((show num) ++ "." ++ spacer)) tabStop (vcat (map (blockToMarkdown tabStop) list))

121+ (vcat (map (blockToMarkdown tabStop) list))

105− where spacer = if (num < 10) then " " else ""

122+ where spacer = if (num < 10) then " " else ""

106

123

107-- | Convert list of Pandoc inline elements to markdown.

124-- | Convert list of Pandoc inline elements to markdown.

108inlineListToMarkdown :: [Inline] -> Doc

125inlineListToMarkdown :: [Inline] -> Doc

@@ -110,39 +127,46 @@ inlineListToMarkdown lst = hcat $ map inlineToMarkdown lst

110

127

111-- | Convert Pandoc inline element to markdown.

128-- | Convert Pandoc inline element to markdown.

112inlineToMarkdown :: Inline -> Doc

129inlineToMarkdown :: Inline -> Doc

113−inlineToMarkdown (Emph lst) = text "*" <> (inlineListToMarkdown lst) <> text "*"

130+inlineToMarkdown (Emph lst) = text "*" <>

131+ (inlineListToMarkdown lst) <> text "*"

114−inlineToMarkdown (Strong lst) = text "**" <> (inlineListToMarkdown lst) <> text "**"

132+inlineToMarkdown (Strong lst) = text "**" <>

133+ (inlineListToMarkdown lst) <> text "**"

115inlineToMarkdown (Code str) =

134inlineToMarkdown (Code str) =

116− case (matchRegex (mkRegex "``") str) of

135+ case (matchRegex (mkRegex "``") str) of

117− Just match -> text ("` " ++ str ++ " `")

136+ Just match -> text ("` " ++ str ++ " `")

118− Nothing -> case (matchRegex (mkRegex "`") str) of

137+ Nothing -> case (matchRegex (mkRegex "`") str) of

119− Just match -> text ("`` " ++ str ++ " ``")

138+ Just match -> text ("`` " ++ str ++ " ``")

120− Nothing -> text ("`" ++ str ++ "`")

139+ Nothing -> text ("`" ++ str ++ "`")

121inlineToMarkdown (Str str) = text $ escapeString str

140inlineToMarkdown (Str str) = text $ escapeString str

122inlineToMarkdown (TeX str) = text str

141inlineToMarkdown (TeX str) = text str

123inlineToMarkdown (HtmlInline str) = text str

142inlineToMarkdown (HtmlInline str) = text str

124inlineToMarkdown (LineBreak) = text " \n"

143inlineToMarkdown (LineBreak) = text " \n"

125inlineToMarkdown Space = char ' '

144inlineToMarkdown Space = char ' '

126inlineToMarkdown (Link txt (Src src tit)) =

145inlineToMarkdown (Link txt (Src src tit)) =

127− let linktext = if (null txt) || (txt == [Str ""]) then

146+ let linktext = if (null txt) || (txt == [Str ""])

128− text "link"

147+ then text "link"

129− else

130− inlineListToMarkdown txt in

148+ else inlineListToMarkdown txt in

131− char '[' <> linktext <> char ']' <> char '(' <> text src <>

149+ char '[' <> linktext <> char ']' <> char '(' <> text src <>

150+ (if tit /= ""

132− (if tit /= "" then (text (" \"" ++ (escapeLinkTitle tit) ++ "\"")) else empty) <> char ')'

151+ then text (" \"" ++ (escapeLinkTitle tit) ++ "\"")

152+ else empty) <> char ')'

153+inlineToMarkdown (Link txt (Ref [])) =

133−inlineToMarkdown (Link txt (Ref [])) = char '[' <> inlineListToMarkdown txt <> text "][]"

154+ char '[' <> inlineListToMarkdown txt <> text "][]"

134−inlineToMarkdown (Link txt (Ref ref)) = char '[' <> inlineListToMarkdown txt <> char ']' <>

155+inlineToMarkdown (Link txt (Ref ref)) =

156+ char '[' <> inlineListToMarkdown txt <> char ']' <> char '[' <>

135− char '[' <> inlineListToMarkdown ref <> char ']'

157+ inlineListToMarkdown ref <> char ']'

136inlineToMarkdown (Image alternate (Src source tit)) =

158inlineToMarkdown (Image alternate (Src source tit)) =

137− let alt = if (null alternate) || (alternate == [Str ""]) then

159+ let alt = if (null alternate) || (alternate == [Str ""])

138− text "image"

160+ then text "image"

139− else

140− inlineListToMarkdown alternate in

161+ else inlineListToMarkdown alternate in

141− char '!' <> char '[' <> alt <> char ']' <> char '(' <> text source <>

162+ char '!' <> char '[' <> alt <> char ']' <> char '(' <> text source <>

163+ (if tit /= ""

142− (if tit /= "" then (text (" \"" ++ (escapeLinkTitle tit) ++ "\"")) else empty) <> char ')'

164+ then text (" \"" ++ (escapeLinkTitle tit) ++ "\"")

165+ else empty) <> char ')'

143inlineToMarkdown (Image alternate (Ref [])) =

166inlineToMarkdown (Image alternate (Ref [])) =

144− char '!' <> char '[' <> inlineListToMarkdown alternate <> char ']'

167+ char '!' <> char '[' <> inlineListToMarkdown alternate <> char ']'

145inlineToMarkdown (Image alternate (Ref ref)) =

168inlineToMarkdown (Image alternate (Ref ref)) =

146− char '!' <> char '[' <> inlineListToMarkdown alternate <> char ']' <>

169+ char '!' <> char '[' <> inlineListToMarkdown alternate <> char ']' <>

147− char '[' <> inlineListToMarkdown ref <> char ']'

170+ char '[' <> inlineListToMarkdown ref <> char ']'

171+inlineToMarkdown (NoteRef ref) =

148−inlineToMarkdown (NoteRef ref) = text "[^" <> text (escapeString ref) <> char ']'

172+ text "[^" <> text (escapeString ref) <> char ']'

src/Text/Pandoc/Writers/RST.hs+98−77

@@ -1,4 +1,16 @@

1+{- |

2+ Module : Text.Pandoc.Writers.RST

4+ License : GNU GPL, version 2 or above

6+ Maintainer : John MacFarlane <jgm at berkeley dot edu>

7+ Stability : unstable

8+ Portability : portable

1−-- | Converts Pandoc to reStructuredText.

10+Conversion of 'Pandoc' documents to reStructuredText.

11+

12+reStructuredText: http://docutils.sourceforge.net/rst.html

13+-}

2module Text.Pandoc.Writers.RST (

14module Text.Pandoc.Writers.RST (

3 writeRST

15 writeRST

4 ) where

16 ) where

@@ -10,40 +22,44 @@ import Text.PrettyPrint.HughesPJ hiding ( Str )

10-- | Convert Pandoc to reStructuredText.

22-- | Convert Pandoc to reStructuredText.

11writeRST :: WriterOptions -> Pandoc -> String

23writeRST :: WriterOptions -> Pandoc -> String

12writeRST options (Pandoc meta blocks) =

24writeRST options (Pandoc meta blocks) =

13− let (main, refs) = unzip $ map (blockToRST (writerTabStop options))

25+ let (main, refs) = unzip $ map (blockToRST (writerTabStop options))

14 (reformatBlocks $ replaceReferenceLinks blocks)

26 (reformatBlocks $ replaceReferenceLinks blocks)

15− top = if (writerStandalone options) then

27+ top = if (writerStandalone options)

16− (metaToRST meta) $$ text (writerHeader options)

28+ then (metaToRST meta) $$ text (writerHeader options)

17− else

18− empty in

29+ else empty in

19− -- remove duplicate keys

30+ -- remove duplicate keys

20− let refs' = nubBy (\x y -> (render x) == (render y)) refs in

31+ let refs' = nubBy (\x y -> (render x) == (render y)) refs in

21− let body = text (writerIncludeBefore options) <>

32+ let body = text (writerIncludeBefore options) <>

22− vcat main $$ text (writerIncludeAfter options) in

33+ vcat main $$ text (writerIncludeAfter options) in

23− render $ top <> body $$ vcat refs' $$ text "\n"

34+ render $ top <> body $$ vcat refs' $$ text "\n"

25-- | Escape special RST characters.

36-- | Escape special RST characters.

26escapeString :: String -> String

37escapeString :: String -> String

27escapeString = backslashEscape "`\\|*_"

38escapeString = backslashEscape "`\\|*_"

29−-- | Convert list of inline elements into one 'Doc' of wrapped text and another

40+-- | Convert list of inline elements into one 'Doc' of wrapped text

30−-- containing references.

41+-- and another containing references.

31wrappedRST :: [Inline] -> (Doc, Doc)

42wrappedRST :: [Inline] -> (Doc, Doc)

32wrappedRST lst =

43wrappedRST lst =

33− let words = splitBySpace lst in

44+ let words = splitBySpace lst in

34− (fsep $ map (fcat . (map (fst . inlineToRST))) words, vcat (map (snd . inlineToRST) lst))

45+ ( fsep $ map (fcat . (map (fst . inlineToRST))) words,

46+ vcat (map (snd . inlineToRST) lst) )

36-- | Remove reference keys, and make sure there are blanks before each list.

48-- | Remove reference keys, and make sure there are blanks before each list.

37reformatBlocks :: [Block] -> [Block]

49reformatBlocks :: [Block] -> [Block]

38reformatBlocks [] = []

50reformatBlocks [] = []

39reformatBlocks ((Plain x):(OrderedList y):rest) =

51reformatBlocks ((Plain x):(OrderedList y):rest) =

40 (Para x):(reformatBlocks ((OrderedList y):rest))

52 (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))

42reformatBlocks ((OrderedList x):rest) =

55reformatBlocks ((OrderedList x):rest) =

43 (OrderedList (map reformatBlocks x)):(reformatBlocks rest)

56 (OrderedList (map reformatBlocks x)):(reformatBlocks rest)

57+reformatBlocks ((BulletList x):rest) =

44−reformatBlocks ((BulletList x):rest) = (BulletList (map reformatBlocks x)):(reformatBlocks rest)

58+ (BulletList (map reformatBlocks x)):(reformatBlocks rest)

59+reformatBlocks ((BlockQuote x):rest) =

45−reformatBlocks ((BlockQuote x):rest) = (BlockQuote (reformatBlocks x)):(reformatBlocks rest)

60+ (BlockQuote (reformatBlocks x)):(reformatBlocks rest)

61+reformatBlocks ((Note ref x):rest) =

46−reformatBlocks ((Note ref x):rest) = (Note ref (reformatBlocks x)):(reformatBlocks rest)

62+ (Note ref (reformatBlocks x)):(reformatBlocks rest)

47reformatBlocks ((Key x1 y1):rest) = reformatBlocks rest

63reformatBlocks ((Key x1 y1):rest) = reformatBlocks rest

48reformatBlocks (x:rest) = x:(reformatBlocks rest)

64reformatBlocks (x:rest) = x:(reformatBlocks rest)

@@ -56,15 +72,16 @@ metaToRST (Meta title authors date) =

56titleToRST :: [Inline] -> Doc

72titleToRST :: [Inline] -> Doc

57titleToRST [] = empty

73titleToRST [] = empty

58titleToRST lst =

74titleToRST lst =

59− let title = fst $ inlineListToRST lst in

75+ let title = fst $ inlineListToRST lst in

60− let titleLength = length $ render title in

76+ let titleLength = length $ render title in

61− let border = text (replicate titleLength '=') in

77+ let border = text (replicate titleLength '=') in

62− border <> char '\n' <> title <> char '\n' <> border <> text "\n\n"

78+ border <> char '\n' <> title <> char '\n' <> border <> text "\n\n"

64-- | Convert author list to 'Doc'.

80-- | Convert author list to 'Doc'.

65authorsToRST :: [String] -> Doc

81authorsToRST :: [String] -> Doc

66authorsToRST [] = empty

82authorsToRST [] = 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)

69-- | Convert date to 'Doc'.

86-- | Convert date to 'Doc'.

70dateToRST :: String -> Doc

87dateToRST :: String -> Doc

@@ -80,36 +97,38 @@ blockToRST tabStop Blank = (text "\n", empty)

80blockToRST tabStop Null = (empty, empty)

97blockToRST tabStop Null = (empty, empty)

81blockToRST tabStop (Plain lst) = wrappedRST lst

98blockToRST tabStop (Plain lst) = wrappedRST lst

82blockToRST tabStop (Para [TeX str]) = -- raw latex block

99blockToRST tabStop (Para [TeX str]) = -- raw latex block

83− let str' = if (endsWith '\n' str) then (str ++ "\n") else (str ++ "\n\n") in

100+ 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)

101+ (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)

102+blockToRST tabStop (Para lst) = ( (fst $ wrappedRST lst) <> (text "\n"),

103+ snd $ wrappedRST lst )

86blockToRST tabStop (BlockQuote lst) =

104blockToRST tabStop (BlockQuote lst) =

87− let (main, refs) = unzip $ map (blockToRST tabStop) lst in

105+ let (main, refs) = unzip $ map (blockToRST tabStop) lst in

88− ((nest tabStop $ vcat $ main) <> text "\n", vcat refs)

106+ ((nest tabStop $ vcat $ main) <> text "\n", vcat refs)

89blockToRST tabStop (Note ref blocks) =

107blockToRST tabStop (Note ref blocks) =

90− let (main, refs) = unzip $ map (blockToRST tabStop) blocks in

108+ let (main, refs) = unzip $ map (blockToRST tabStop) blocks in

91− ((hang (text ".. [" <> text (escapeString ref) <> text "] ") 3 (vcat main)), vcat refs)

109+ ((hang (text ".. [" <> text (escapeString ref) <> text "] ") 3 (vcat main)),

110+ vcat refs)

92blockToRST tabStop (Key txt (Src src tit)) =

111blockToRST tabStop (Key txt (Src src tit)) =

93− (text "ERROR - KEY FOUND", empty) -- shouldn't have a key here

112+ (text "ERROR - KEY FOUND", empty) -- shouldn't have a key here

94−blockToRST tabStop (CodeBlock str) =

113+blockToRST tabStop (CodeBlock str) = (hang (text "::\n") tabStop

95− (hang (text "::\n") tabStop (vcat $ map text (lines ('\n':(str ++ "\n\n")))), empty)

114+ (vcat $ map text (lines ('\n':(str ++ "\n\n")))), empty)

96blockToRST tabStop (RawHtml str) =

115blockToRST tabStop (RawHtml str) =

97− let str' = if (endsWith '\n' str) then (str ++ "\n") else (str ++ "\n\n") in

116+ 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)

117+ (hang (text "\n.. raw:: html\n") 3 (vcat $ map text (lines str')), empty)

99blockToRST tabStop (BulletList lst) =

118blockToRST tabStop (BulletList lst) =

100− let (main, refs) = unzip $ map (bulletListItemToRST tabStop) lst in

119+ let (main, refs) = unzip $ map (bulletListItemToRST tabStop) lst in

101− (vcat main <> text "\n", vcat refs)

120+ (vcat main <> text "\n", vcat refs)

102blockToRST tabStop (OrderedList lst) =

121blockToRST tabStop (OrderedList lst) =

103− let (main, refs) =

104− unzip $ zipWith (orderedListItemToRST tabStop) (enumFromTo 1 (length lst)) lst in

122+ let (main, refs) = unzip $ zipWith (orderedListItemToRST tabStop)

123+ (enumFromTo 1 (length lst)) lst in

105− (vcat main <> text "\n", vcat refs)

124+ (vcat main <> text "\n", vcat refs)

106blockToRST tabStop HorizontalRule = (text "--------------\n", empty)

125blockToRST tabStop HorizontalRule = (text "--------------\n", empty)

107blockToRST tabStop (Header level lst) =

126blockToRST tabStop (Header level lst) =

108− let (headerText, refs) = inlineListToRST lst in

127+ let (headerText, refs) = inlineListToRST lst in

109− let headerLength = length $ render headerText in

128+ let headerLength = length $ render headerText in

110− let headerChar = if (level > 5) then ' ' else "=-~^'" !! (level - 1) in

129+ let headerChar = if (level > 5) then ' ' else "=-~^'" !! (level - 1) in

111− let border = text $ replicate headerLength headerChar in

130+ let border = text $ replicate headerLength headerChar in

112− (headerText <> char '\n' <> border <> char '\n', refs)

131+ (headerText <> char '\n' <> border <> char '\n', refs)

113

132

114-- | Convert bullet list item (list of blocks) to reStructuredText.

133-- | Convert bullet list item (list of blocks) to reStructuredText.

115-- Returns a pair of 'Doc', the first the main text, the second references

134-- Returns a pair of 'Doc', the first the main text, the second references

@@ -117,8 +136,8 @@ bulletListItemToRST :: Int -- ^ tab stop

117 -> [Block] -- ^ list item (list of blocks)

136 -> [Block] -- ^ list item (list of blocks)

118 -> (Doc, Doc)

137 -> (Doc, Doc)

119bulletListItemToRST tabStop list =

138bulletListItemToRST tabStop list =

120− let (main, refs) = unzip $ map (blockToRST tabStop) list in

139+ let (main, refs) = unzip $ map (blockToRST tabStop) list in

121− (hang (text "- ") tabStop (vcat main), (vcat refs))

140+ (hang (text "- ") tabStop (vcat main), (vcat refs))

122

141

123-- | Convert an ordered list item (list of blocks) to reStructuredText.

142-- | Convert an ordered list item (list of blocks) to reStructuredText.

124-- Returns a pair of 'Doc', the first the main text, the second references

143-- Returns a pair of 'Doc', the first the main text, the second references

@@ -127,9 +146,9 @@ orderedListItemToRST :: Int -- ^ tab stop

127 -> [Block] -- ^ list item (list of blocks)

146 -> [Block] -- ^ list item (list of blocks)

128 -> (Doc, Doc)

147 -> (Doc, Doc)

129orderedListItemToRST tabStop num list =

148orderedListItemToRST tabStop num list =

130− let (main, refs) = unzip $ map (blockToRST tabStop) list

149+ let (main, refs) = unzip $ map (blockToRST tabStop) list

131− spacer = if (length (show num) < 2) then " " else "" in

150+ spacer = if (length (show num) < 2) then " " else "" in

132− (hang (text ((show num) ++ "." ++ spacer)) tabStop (vcat main), (vcat refs))

151+ (hang (text ((show num) ++ "." ++ spacer)) tabStop (vcat main), (vcat refs))

133

152

134-- | Convert a list of inline elements to reStructuredText.

153-- | Convert a list of inline elements to reStructuredText.

135-- Returns a pair of 'Doc', the first the main text, the second references.

154-- Returns a pair of 'Doc', the first the main text, the second references.

@@ -151,39 +170,41 @@ inlineToRST (HtmlInline str) = (empty, empty)

151inlineToRST (LineBreak) = inlineToRST Space -- RST doesn't have line breaks

170inlineToRST (LineBreak) = inlineToRST Space -- RST doesn't have line breaks

152inlineToRST Space = (char ' ', empty)

171inlineToRST Space = (char ' ', empty)

153--

172--

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.

155--

175--

156inlineToRST (Link txt (Src src tit)) =

176inlineToRST (Link txt (Src src tit)) =

157− let (linktext, ref') = if (null txt) || (txt == [Str ""]) then

177+ let (linktext, ref') = if (null txt) || (txt == [Str ""])

158− (text "link", empty)

178+ then (text "link", empty)

159− else

160− inlineListToRST $ normalizeSpaces txt in

179+ else inlineListToRST $ normalizeSpaces txt in

161− let link = char '`' <> linktext <> text "`_"

180+ let link = char '`' <> linktext <> text "`_"

162− linktext' = render linktext in

181+ linktext' = render linktext in

163− let linktext'' = if (':' `elem` linktext') then "`" ++ linktext' ++ "`" else linktext' in

182+ let linktext'' = if (':' `elem` linktext')

183+ then "`" ++ linktext' ++ "`"

184+ else linktext' in

164 let ref = text ".. _" <> text linktext'' <> text ": " <> text src in

185 let ref = text ".. _" <> text linktext'' <> text ": " <> text src in

165 (link, ref' $$ ref)

186 (link, ref' $$ ref)

166inlineToRST (Link txt (Ref [])) =

187inlineToRST (Link txt (Ref [])) =

167− let (linktext, refs) = inlineListToRST txt in

188+ let (linktext, refs) = inlineListToRST txt in

168− (char '[' <> linktext <> char ']', refs)

189+ (char '[' <> linktext <> char ']', refs)

169inlineToRST (Link txt (Ref ref)) =

190inlineToRST (Link txt (Ref ref)) =

170− let (linktext, refs1) = inlineListToRST txt

191+ let (linktext, refs1) = inlineListToRST txt

171− (reftext, refs2) = inlineListToRST ref in

192+ (reftext, refs2) = inlineListToRST ref in

172− (char '[' <> linktext <> text "][" <> reftext <> char ']', refs1 $$ refs2)

193+ (char '[' <> linktext <> text "][" <> reftext <> char ']', refs1 $$ refs2)

173inlineToRST (Image alternate (Src source tit)) =

194inlineToRST (Image alternate (Src source tit)) =

174− let (alt, ref') = if (null alternate) || (alternate == [Str ""]) then

195+ let (alt, ref') = if (null alternate) || (alternate == [Str ""])

175− (text "image", empty)

196+ then (text "image", empty)

176− else

177− inlineListToRST $ normalizeSpaces alternate in

197+ else inlineListToRST $ normalizeSpaces alternate in

178− let link = char '|' <> alt <> char '|' in

198+ let link = char '|' <> alt <> char '|' in

179− let ref = text ".. " <> link <> text " image:: " <> text source in

199+ let ref = text ".. " <> link <> text " image:: " <> text source in

180− (link, ref' $$ ref)

200+ (link, ref' $$ ref)

181inlineToRST (Image alternate (Ref [])) =

201inlineToRST (Image alternate (Ref [])) =

182− let (alttext, refs) = inlineListToRST alternate in

202+ let (alttext, refs) = inlineListToRST alternate in

183− (char '|' <> alttext <> char '|', refs)

203+ (char '|' <> alttext <> char '|', refs)

184-- The following case won't normally occur...

204-- The following case won't normally occur...

185inlineToRST (Image alternate (Ref ref)) =

205inlineToRST (Image alternate (Ref ref)) =

186− let (alttext, refs1) = inlineListToRST alternate

206+ let (alttext, refs1) = inlineListToRST alternate

187− (reftext, refs2) = inlineListToRST ref in

207+ (reftext, refs2) = inlineListToRST ref in

188− (char '|' <> alttext <> char '|', refs1 $$ refs2)

208+ (char '|' <> alttext <> char '|', refs1 $$ refs2)

209+inlineToRST (NoteRef ref) =

189−inlineToRST (NoteRef ref) = (text " [" <> text (escapeString ref) <> char ']' <> char '_', empty)

210+ (text " [" <> text (escapeString ref) <> char ']' <> char '_', empty)

src/Text/Pandoc/Writers/RTF.hs+90−65

@@ -1,4 +1,14 @@

1+{- |

2+ Module :

4+ License : GNU GPL, version 2 or above

6+ Maintainer : John MacFarlane <jgm at berkeley dot edu>

7+ Stability : unstable

8+ Portability : portable

1−-- | Convert Pandoc to rich text format.

10+Conversion of 'Pandoc' documents to RTF (rich text format).

11+-}

2module Text.Pandoc.Writers.RTF (

12module Text.Pandoc.Writers.RTF (

3 writeRTF

13 writeRTF

4 ) where

14 ) where

@@ -10,24 +20,24 @@ import Char ( ord, chr )

10-- | Convert Pandoc to a string in rich text format.

20-- | Convert Pandoc to a string in rich text format.

11writeRTF :: WriterOptions -> Pandoc -> String

21writeRTF :: WriterOptions -> Pandoc -> String

12writeRTF options (Pandoc meta blocks) =

22writeRTF options (Pandoc meta blocks) =

13− let notes = filter isNoteBlock blocks in -- assumes all notes are at outer level

23+ -- assumes all notes are at outer level

24+ let notes = filter isNoteBlock blocks in

14− let head = if writerStandalone options then

25+ let head = if writerStandalone options

15− rtfHeader notes (writerHeader options) meta

26+ then rtfHeader notes (writerHeader options) meta

16− else

27+ else ""

17− ""

18− foot = if writerStandalone options then "\n}\n" else ""

28+ foot = if writerStandalone options then "\n}\n" else ""

19− body = (writerIncludeBefore options) ++

29+ body = (writerIncludeBefore options) ++ (concatMap (blockToRTF notes 0)

20− (concatMap (blockToRTF notes 0) (replaceReferenceLinks blocks)) ++

30+ (replaceReferenceLinks blocks)) ++

21− (writerIncludeAfter options) in

31+ (writerIncludeAfter options) in

22− head ++ body ++ foot

32+ head ++ body ++ foot

24-- | Convert unicode characters (> 127) into rich text format representation.

34-- | Convert unicode characters (> 127) into rich text format representation.

25handleUnicode :: String -> String

35handleUnicode :: String -> String

26handleUnicode [] = []

36handleUnicode [] = []

27−handleUnicode (c:cs) = if (ord c) > 127 then

37+handleUnicode (c:cs) = if (ord c) > 127

38+ then '\\':'u':(show (ord c)) ++ "?" ++

28− '\\':'u':(show (ord c)) ++ "?" ++ (handleUnicode cs)

39+ (handleUnicode cs)

29− else

30− c:(handleUnicode cs)

40+ else c:(handleUnicode cs)

32escapeSpecial = backslashEscape "{\\}"

42escapeSpecial = backslashEscape "{\\}"

33escapeTab = gsub "\\\\t" "\\\\tab "

43escapeTab = gsub "\\\\t" "\\\\tab "

@@ -56,8 +66,8 @@ rtfParSpaced :: Int -- ^ space after (in twips)

56 -> String -- ^ string with content

66 -> String -- ^ string with content

57 -> String

67 -> String

58rtfParSpaced spaceAfter indent firstLineIndent content =

68rtfParSpaced spaceAfter indent firstLineIndent content =

59− "{\\pard \\f0 \\sa" ++ (show spaceAfter) ++ " \\li" ++ (show indent) ++

69+ "{\\pard \\f0 \\sa" ++ (show spaceAfter) ++ " \\li" ++ (show indent) ++

60− " \\fi" ++ (show firstLineIndent) ++ " " ++ content ++ "\\par}\n"

70+ " \\fi" ++ (show firstLineIndent) ++ " " ++ content ++ "\\par}\n"

62-- | Default paragraph.

72-- | Default paragraph.

63rtfPar :: Int -- ^ block indent (in twips)

73rtfPar :: Int -- ^ block indent (in twips)

@@ -85,9 +95,10 @@ bulletMarker indent = case (indent `mod` 720) of

86-- | Returns appropriate (list of) ordered list markers for indent level.

96-- | Returns appropriate (list of) ordered list markers for indent level.

87orderedMarkers :: Int -> [String]

97orderedMarkers :: Int -> [String]

88−orderedMarkers indent = case (indent `mod` 720) of

98+orderedMarkers indent =

99+ case (indent `mod` 720) of

89− 0 -> map (\x -> show x ++ ".") [1..]

100+ 0 -> map (\x -> show x ++ ".") [1..]

90− otherwise -> map (\x -> show x ++ ".") $ cycle ['a'..'z']

101+ otherwise -> map (\x -> show x ++ ".") $ cycle ['a'..'z']

102

92-- | Returns RTF header.

103-- | Returns RTF header.

93rtfHeader :: [Block] -- ^ list of note blocks

104rtfHeader :: [Block] -- ^ list of note blocks

@@ -95,16 +106,20 @@ rtfHeader :: [Block] -- ^ list of note blocks

95 -> Meta -- ^ bibliographic information

106 -> Meta -- ^ bibliographic information

96 -> String

107 -> String

97rtfHeader notes headerText (Meta title authors date) =

108rtfHeader notes headerText (Meta title authors date) =

98− let titletext = if null title then

109+ let titletext = if null title

99− ""

110+ then ""

100− else

111+ else rtfPar 0 0 ("\\qc \\b \\fs36 " ++

101− rtfPar 0 0 ("\\qc \\b \\fs36 " ++ inlineListToRTF notes title)

112+ inlineListToRTF notes title)

102− authorstext = if null authors then

113+ authorstext = if null authors

103− ""

114+ then ""

104− else

115+ else rtfPar 0 0 ("\\qc " ++ (joinWithSep "\\"

105− rtfPar 0 0 ("\\qc " ++ (joinWithSep "\\" (map stringToRTF authors)))

116+ (map stringToRTF authors)))

117+ datetext = if date == ""

118+ then ""

106− datetext = if date == "" then "" else rtfPar 0 0 ("\\qc " ++ stringToRTF date) in

119+ else rtfPar 0 0 ("\\qc " ++ stringToRTF date) in

107− let spacer = if null (titletext ++ authorstext ++ datetext) then "" else rtfPar 0 0 "" in

120+ let spacer = if null (titletext ++ authorstext ++ datetext)

121+ then ""

122+ else rtfPar 0 0 "" in

108 headerText ++ titletext ++ authorstext ++ datetext ++ spacer

123 headerText ++ titletext ++ authorstext ++ datetext ++ spacer

109

124

110-- | Convert Pandoc block element to RTF.

125-- | Convert Pandoc block element to RTF.

@@ -114,32 +129,36 @@ blockToRTF :: [Block] -- ^ list of note blocks

114 -> String

129 -> String

115blockToRTF notes indent Blank = rtfPar indent 0 ""

130blockToRTF notes indent Blank = rtfPar indent 0 ""

116blockToRTF notes indent Null = ""

131blockToRTF notes indent Null = ""

132+blockToRTF notes indent (Plain lst) =

117−blockToRTF notes indent (Plain lst) = rtfCompact indent 0 (inlineListToRTF notes lst)

133+ rtfCompact indent 0 (inlineListToRTF notes lst)

134+blockToRTF notes indent (Para lst) =

118−blockToRTF notes indent (Para lst) = rtfPar indent 0 (inlineListToRTF notes lst)

135+ rtfPar indent 0 (inlineListToRTF notes lst)

119blockToRTF notes indent (BlockQuote lst) =

136blockToRTF notes indent (BlockQuote lst) =

120− concatMap (blockToRTF notes (indent + indentIncrement)) lst

137+ concatMap (blockToRTF notes (indent + indentIncrement)) lst

121−blockToRTF notes indent (Note ref lst) = "" -- there shouldn't be any after filtering

138+blockToRTF notes indent (Note ref lst) = "" -- shouldn't be any aftr filtering

122blockToRTF notes indent (Key _ _) = ""

139blockToRTF 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))

124blockToRTF notes indent (RawHtml str) = ""

142blockToRTF notes indent (RawHtml str) = ""

125blockToRTF notes indent (BulletList lst) =

143blockToRTF notes indent (BulletList lst) =

144+ spaceAtEnd $

126− spaceAtEnd $ concatMap (listItemToRTF notes indent (bulletMarker indent)) lst

145+ concatMap (listItemToRTF notes indent (bulletMarker indent)) lst

127blockToRTF notes indent (OrderedList lst) =

146blockToRTF notes indent (OrderedList lst) =

147+ spaceAtEnd $ concat $

128− spaceAtEnd $ concat $ zipWith (listItemToRTF notes indent) (orderedMarkers indent) lst

148+ zipWith (listItemToRTF notes indent) (orderedMarkers indent) lst

129blockToRTF notes indent HorizontalRule =

149blockToRTF notes indent HorizontalRule =

130− rtfPar indent 0 "\\qc \\emdash\\emdash\\emdash\\emdash\\emdash"

150+ rtfPar indent 0 "\\qc \\emdash\\emdash\\emdash\\emdash\\emdash"

131blockToRTF notes indent (Header level lst) =

151blockToRTF notes indent (Header level lst) =

132− rtfPar indent 0 ("\\b \\fs" ++ (show (40 - (level * 4))) ++ " " ++

152+ rtfPar indent 0 ("\\b \\fs" ++ (show (40 - (level * 4))) ++ " " ++

133− (inlineListToRTF notes lst))

153+ (inlineListToRTF notes lst))

134

154

135-- | Ensure that there's the same amount of space after compact

155-- | Ensure that there's the same amount of space after compact

136-- lists as after regular lists.

156-- lists as after regular lists.

137spaceAtEnd :: String -> String

157spaceAtEnd :: String -> String

138spaceAtEnd str =

158spaceAtEnd str =

139− if isSuffixOf "\\par}\n" str then

159+ if isSuffixOf "\\par}\n" str

140− (take ((length str) - 6) str) ++ "\\sa180\\par}\n"

160+ then (take ((length str) - 6) str) ++ "\\sa180\\par}\n"

141− else

161+ else str

142− str

143

162

144-- | Convert list item (list of blocks) to RTF.

163-- | Convert list item (list of blocks) to RTF.

145listItemToRTF :: [Block] -- ^ list of note blocks

164listItemToRTF :: [Block] -- ^ list of note blocks

@@ -148,13 +167,14 @@ listItemToRTF :: [Block] -- ^ list of note blocks

148 -> [Block] -- ^ list item (list of blocks)

167 -> [Block] -- ^ list item (list of blocks)

149 -> [Char]

168 -> [Char]

150listItemToRTF notes indent marker [] =

169listItemToRTF notes indent marker [] =

151− rtfCompact (indent + listIncrement) (0 - listIncrement)

170+ rtfCompact (indent + listIncrement) (0 - listIncrement)

152− (marker ++ "\\tx" ++ (show listIncrement) ++ "\\tab ")

171+ (marker ++ "\\tx" ++ (show listIncrement) ++ "\\tab ")

153listItemToRTF notes indent marker list =

172listItemToRTF notes indent marker list =

154− let (first:rest) = map (blockToRTF notes (indent + listIncrement)) list in

173+ let (first:rest) = map (blockToRTF notes (indent + listIncrement)) list in

155− let modFirst = gsub "\\\\fi-?[0-9]+" ("\\\\fi" ++ (show (0 - listIncrement)) ++

174+ let modFirst = gsub "\\\\fi-?[0-9]+" ("\\\\fi" ++

175+ (show (0 - listIncrement)) ++ " " ++ marker ++

156− " " ++ marker ++ "\\\\tx" ++ (show listIncrement) ++ "\\\\tab") first in

176+ "\\\\tx" ++ (show listIncrement) ++ "\\\\tab") first in

157− modFirst ++ (concat rest)

177+ modFirst ++ (concat rest)

158

178

159-- | Convert list of inline items to RTF.

179-- | Convert list of inline items to RTF.

160inlineListToRTF :: [Block] -- ^ list of note blocks

180inlineListToRTF :: [Block] -- ^ list of note blocks

@@ -167,7 +187,8 @@ inlineToRTF :: [Block] -- ^ list of note blocks

167 -> Inline -- ^ inline to convert

187 -> Inline -- ^ inline to convert

168 -> String

188 -> String

169inlineToRTF notes (Emph lst) = "{\\i " ++ (inlineListToRTF notes lst) ++ "} "

189inlineToRTF 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) ++ "} "

171inlineToRTF notes (Code str) = "{\\f1 " ++ (codeStringToRTF str) ++ "} "

192inlineToRTF notes (Code str) = "{\\f1 " ++ (codeStringToRTF str) ++ "} "

172inlineToRTF notes (Str str) = stringToRTF str

193inlineToRTF notes (Str str) = stringToRTF str

173inlineToRTF notes (TeX str) = latexToRTF str

194inlineToRTF notes (TeX str) = latexToRTF str

@@ -175,20 +196,24 @@ inlineToRTF notes (HtmlInline str) = ""

175inlineToRTF notes (LineBreak) = "\\line "

196inlineToRTF notes (LineBreak) = "\\line "

176inlineToRTF notes Space = " "

197inlineToRTF notes Space = " "

177inlineToRTF notes (Link text (Src src tit)) =

198inlineToRTF notes (Link text (Src src tit)) =

178− "{\\field{\\*\\fldinst{HYPERLINK \"" ++ (codeStringToRTF src) ++ "\"}}{\\fldrslt{\\ul\n"

199+ "{\\field{\\*\\fldinst{HYPERLINK \"" ++ (codeStringToRTF src) ++

179− ++ (inlineListToRTF notes text) ++ "\n}}}\n"

200+ "\"}}{\\fldrslt{\\ul\n" ++ (inlineListToRTF notes text) ++ "\n}}}\n"

180−inlineToRTF notes (Link text (Ref [])) = "[" ++ (inlineListToRTF notes text) ++ "]"

201+inlineToRTF notes (Link text (Ref [])) =

202+ "[" ++ (inlineListToRTF notes text) ++ "]"

181−inlineToRTF notes (Link text (Ref ref)) = "[" ++ (inlineListToRTF notes text) ++ "][" ++

203+inlineToRTF notes (Link text (Ref ref)) =

204+ "[" ++ (inlineListToRTF notes text) ++ "][" ++

182− (inlineListToRTF notes ref) ++ "]" -- this is what markdown does, for better or worse

205+ (inlineListToRTF notes ref) ++ "]" -- this is what markdown does

183−inlineToRTF notes (Image alternate (Src source tit)) = "{\\cf1 [image: " ++ source ++ "]\\cf0}"

206+inlineToRTF notes (Image alternate (Src source tit)) =

207+ "{\\cf1 [image: " ++ source ++ "]\\cf0}"

184−inlineToRTF notes (Image alternate (Ref [])) = "![" ++ (inlineListToRTF notes alternate) ++ "]"

208+inlineToRTF notes (Image alternate (Ref [])) =

209+ "![" ++ (inlineListToRTF notes alternate) ++ "]"

185−inlineToRTF notes (Image alternate (Ref ref)) = "![" ++ (inlineListToRTF notes alternate) ++

210+inlineToRTF notes (Image alternate (Ref ref)) = "![" ++

211+ (inlineListToRTF notes alternate) ++ "][" ++

186− "][" ++ (inlineListToRTF notes ref) ++ "]"

212+ (inlineListToRTF notes ref) ++ "]"

187inlineToRTF [] (NoteRef ref) = ""

213inlineToRTF [] (NoteRef ref) = ""

188inlineToRTF ((Note firstref firstblocks):rest) (NoteRef ref) =

214inlineToRTF ((Note firstref firstblocks):rest) (NoteRef ref) =

189− if firstref == ref then

215+ if firstref == ref

190− "{\\super\\chftn}{\\*\\footnote\\chftn\\~\\plain\\pard " ++

216+ then "{\\super\\chftn}{\\*\\footnote\\chftn\\~\\plain\\pard " ++

191− (concatMap (blockToRTF rest 0) firstblocks) ++ "}"

217+ (concatMap (blockToRTF rest 0) firstblocks) ++ "}"

192− else

193− inlineToRTF rest (NoteRef ref)

218+ else inlineToRTF rest (NoteRef ref)

194

219

src/Text/ParserCombinators/Pandoc.hs+17−7

@@ -1,4 +1,14 @@

1+{- |

2+ Module : Text.ParserCombinators.Pandoc

4+ License : GNU GPL, version 2 or above

6+ Maintainer : John MacFarlane <jgm at berkeley dot edu>

7+ Stability : unstable

8+ Portability : portable

1−-- | Special parser combinators for Pandoc readers.

10+Special parser combinators for Pandoc readers.

11+-}

2module Text.ParserCombinators.Pandoc (

12module Text.ParserCombinators.Pandoc (

3 many1Till,

13 many1Till,

4 followedBy',

14 followedBy',

@@ -79,8 +89,9 @@ many1Till p end = try (do

79 rest <- manyTill p end

89 rest <- manyTill p end

80 return (first:rest))

90 return (first:rest))

82−-- | A more general form of @notFollowedBy@. This one allows any type of parser to

92+-- | A more general form of @notFollowedBy@. This one allows any

83−-- be specified, and succeeds only if that parser fails. It does not consume any input.

93+-- type of parser to be specified, and succeeds only if that parser fails.

94+-- It does not consume any input.

84notFollowedBy' :: Show b => GenParser a st b -> GenParser a st ()

95notFollowedBy' :: Show b => GenParser a st b -> GenParser a st ()

85notFollowedBy' parser = try (do { c <- try parser; unexpected (show c) }

96notFollowedBy' parser = try (do { c <- try parser; unexpected (show c) }

86 <|> return ())

97 <|> return ())

@@ -90,10 +101,9 @@ notFollowedBy' parser = try (do { c <- try parser; unexpected (show c) }

90followedBy' :: (Show b) => GenParser a st b -> GenParser a st ()

101followedBy' :: (Show b) => GenParser a st b -> GenParser a st ()

91followedBy' parser = do

102followedBy' parser = do

92 isNotFollowed <- option False (do{ notFollowedBy' parser; return True})

103 isNotFollowed <- option False (do{ notFollowedBy' parser; return True})

93− if isNotFollowed then

104+ if isNotFollowed

94− fail "not followed by parser"

105+ then fail "not followed by parser"

95− else

96− return ()

106+ else return ()

107

98-- | Parses one of a list of strings (tried in order).

108-- | Parses one of a list of strings (tried in order).

99oneOfStrings :: [String] -> GenParser Char st String

109oneOfStrings :: [String] -> GenParser Char st String