7701a87 · typeable/pandoc

git.iko.soy/typeable/pandoc

on master help sign in

Code cleanup - RST reader.

7701a87fiddlosopher18 years ago

Text/Pandoc/Readers/RST.hs+93−23

compare with master

unifiedsplit

@@ -37,27 +37,29 @@ import Data.List ( findIndex, delete )

38-- | Parse reStructuredText string and return Pandoc document.

39readRST :: ParserState -> String -> Pandoc

40−readRST state str = (readWith parseRST) state (str ++ "\n\n")

40+readRST state s = (readWith parseRST) state (s ++ "\n\n")

42--

43-- Constants and data structure definitions

44---

46+bulletListMarkers :: [Char]

46bulletListMarkers = "*+-"

47bulletListMarkers = "*+-"

48+

49+underlineChars :: [Char]

47underlineChars = "!\"#$&'()*+,-./:;<=>?@[\\]^_`{|}~"

50underlineChars = "!\"#$&'()*+,-./:;<=>?@[\\]^_`{|}~"

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

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

53+specialChars :: [Char]

50specialChars = "\\`|*_<>$:[-"

54specialChars = "\\`|*_<>$:[-"

52--

56--

53-- parsing documents

57-- parsing documents

54--

58--

56−isAnonKey (ref, src) = ref == [Str "_"]

57−

58isHeader :: Int -> Block -> Bool

60isHeader :: Int -> Block -> Bool

59isHeader n (Header x _) = x == n

61isHeader n (Header x _) = x == n

60−isHeader _ _ = False

62+isHeader _ _ = False

62-- | Promote all headers in a list of blocks. (Part of

64-- | Promote all headers in a list of blocks. (Part of

63-- title transformation for RST.)

65-- title transformation for RST.)

@@ -65,7 +67,7 @@ promoteHeaders :: Int -> [Block] -> [Block]

65promoteHeaders num ((Header level text):rest) =

67promoteHeaders num ((Header level text):rest) =

66 (Header (level - num) text):(promoteHeaders num rest)

68 (Header (level - num) text):(promoteHeaders num rest)

67promoteHeaders num (other:rest) = other:(promoteHeaders num rest)

69promoteHeaders num (other:rest) = other:(promoteHeaders num rest)

68−promoteHeaders num [] = []

70+promoteHeaders _ [] = []

70-- | If list of blocks starts with a header (or a header and subheader)

72-- | If list of blocks starts with a header (or a header and subheader)

71-- of level that are not found elsewhere, return it as a title and

73-- of level that are not found elsewhere, return it as a title and

@@ -82,6 +84,7 @@ titleTransform ((Header 1 head1):rest) = -- title, no subtitle

82 else ((promoteHeaders 1 rest), head1)

84 else ((promoteHeaders 1 rest), head1)

83titleTransform blocks = (blocks, [])

85titleTransform blocks = (blocks, [])

87+parseRST :: GenParser Char ParserState Pandoc

85parseRST = do

88parseRST = do

86 startPos <- getPosition

89 startPos <- getPosition

87 -- go through once just to get list of reference keys

90 -- go through once just to get list of reference keys

@@ -91,7 +94,7 @@ parseRST = do

91 setPosition startPos

94 setPosition startPos

92 st <- getState

95 st <- getState

93 let reversedKeys = stateKeys st

96 let reversedKeys = stateKeys st

94− updateState $ \st -> st { stateKeys = reverse reversedKeys }

97+ updateState $ \s -> s { stateKeys = reverse reversedKeys }

95 -- now parse it for real...

98 -- now parse it for real...

96 blocks <- parseBlocks

99 blocks <- parseBlocks

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

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

@@ -108,8 +111,10 @@ parseRST = do

108-- parsing blocks

111-- parsing blocks

109--

112--

110

113

114+parseBlocks :: GenParser Char ParserState [Block]

111parseBlocks = manyTill block eof

115parseBlocks = manyTill block eof

112

116

117+block :: GenParser Char ParserState Block

113block = choice [ codeBlock

118block = choice [ codeBlock

114 , rawHtmlBlock

119 , rawHtmlBlock

115 , rawLaTeXBlock

120 , rawLaTeXBlock

@@ -129,6 +134,7 @@ block = choice [ codeBlock

129-- field list

134-- field list

130--

135--

131

136

137+fieldListItem :: String -> GenParser Char st ([Char], [Char])

132fieldListItem indent = try $ do

138fieldListItem indent = try $ do

133 string indent

139 string indent

134 char ':'

140 char ':'

@@ -140,13 +146,14 @@ fieldListItem indent = try $ do

140 indentedBlock

146 indentedBlock

141 return (name, joinWithSep " " (first:(lines rest)))

147 return (name, joinWithSep " " (first:(lines rest)))

142

148

149+fieldList :: GenParser Char ParserState Block

143fieldList = try $ do

150fieldList = try $ do

144 indent <- lookAhead $ many (oneOf " \t")

151 indent <- lookAhead $ many (oneOf " \t")

145 items <- many1 $ fieldListItem indent

152 items <- many1 $ fieldListItem indent

146 blanklines

153 blanklines

147 let authors = case lookup "Authors" items of

154 let authors = case lookup "Authors" items of

148 Just auth -> [auth]

155 Just auth -> [auth]

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

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

150 if null authors

157 if null authors

151 then return ()

158 then return ()

152 else updateState $ \st -> st {stateAuthors = authors}

159 else updateState $ \st -> st {stateAuthors = authors}

@@ -157,7 +164,7 @@ fieldList = try $ do

157 Just tit -> parseFromString (many inline) tit >>=

164 Just tit -> parseFromString (many inline) tit >>=

158 \t -> updateState $ \st -> st {stateTitle = t}

165 \t -> updateState $ \st -> st {stateTitle = t}

159 Nothing -> return ()

166 Nothing -> return ()

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

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

161 (x /= "Date") && (x /= "Title")) items

168 (x /= "Date") && (x /= "Title")) items

162 if null remaining

169 if null remaining

163 then return Null

170 then return Null

@@ -170,26 +177,31 @@ fieldList = try $ do

170-- line block

177-- line block

171--

178--

172

179

180+lineBlockLine :: GenParser Char ParserState [Inline]

173lineBlockLine = try $ do

181lineBlockLine = try $ do

174 string "| "

182 string "| "

175 white <- many (oneOf " \t")

183 white <- many (oneOf " \t")

176 line <- manyTill inline newline

184 line <- manyTill inline newline

177 return $ (if null white then [] else [Str white]) ++ line ++ [LineBreak]

185 return $ (if null white then [] else [Str white]) ++ line ++ [LineBreak]

178

186

187+lineBlock :: GenParser Char ParserState Block

179lineBlock = try $ do

188lineBlock = try $ do

180− lines <- many1 lineBlockLine

189+ lines' <- many1 lineBlockLine

181 blanklines

190 blanklines

182− return $ Para (concat lines)

191+ return $ Para (concat lines')

183

192

184--

193--

185-- paragraph block

194-- paragraph block

186--

195--

187

196

197+para :: GenParser Char ParserState Block

188para = paraBeforeCodeBlock <|> paraNormal <?> "paragraph"

198para = paraBeforeCodeBlock <|> paraNormal <?> "paragraph"

189

199

200+codeBlockStart :: GenParser Char st Char

190codeBlockStart = string "::" >> blankline >> blankline

201codeBlockStart = string "::" >> blankline >> blankline

191

202

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

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

204+paraBeforeCodeBlock :: GenParser Char ParserState Block

193paraBeforeCodeBlock = try $ do

205paraBeforeCodeBlock = try $ do

194 result <- many1 (notFollowedBy' codeBlockStart >> inline)

206 result <- many1 (notFollowedBy' codeBlockStart >> inline)

195 lookAhead (string "::")

207 lookAhead (string "::")

@@ -198,18 +210,21 @@ paraBeforeCodeBlock = try $ do

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

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

199

211

200-- regular paragraph

212-- regular paragraph

213+paraNormal :: GenParser Char ParserState Block

201paraNormal = try $ do

214paraNormal = try $ do

202 result <- many1 inline

215 result <- many1 inline

203 newline

216 newline

204 blanklines

217 blanklines

205 return $ Para $ normalizeSpaces result

218 return $ Para $ normalizeSpaces result

206

219

220+plain :: GenParser Char ParserState Block

207plain = many1 inline >>= return . Plain . normalizeSpaces

221plain = many1 inline >>= return . Plain . normalizeSpaces

208

222

209--

223--

210-- image block

224-- image block

211--

225--

212

226

227+imageBlock :: GenParser Char st Block

213imageBlock = try $ do

228imageBlock = try $ do

214 string ".. image:: "

229 string ".. image:: "

215 src <- manyTill anyChar newline

230 src <- manyTill anyChar newline

@@ -223,9 +238,11 @@ imageBlock = try $ do

223-- header blocks

238-- header blocks

224--

239--

225

240

241+header :: GenParser Char ParserState Block

226header = doubleHeader <|> singleHeader <?> "header"

242header = doubleHeader <|> singleHeader <?> "header"

227

243

228-- a header with lines on top and bottom

244-- a header with lines on top and bottom

245+doubleHeader :: GenParser Char ParserState Block

229doubleHeader = try $ do

246doubleHeader = try $ do

230 c <- oneOf underlineChars

247 c <- oneOf underlineChars

231 rest <- many (char c) -- the top line

248 rest <- many (char c) -- the top line

@@ -250,6 +267,7 @@ doubleHeader = try $ do

250 return $ Header level (normalizeSpaces txt)

267 return $ Header level (normalizeSpaces txt)

251

268

252-- a header with line on the bottom only

269-- a header with line on the bottom only

270+singleHeader :: GenParser Char ParserState Block

253singleHeader = try $ do

271singleHeader = try $ do

254 notFollowedBy' whitespace

272 notFollowedBy' whitespace

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

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

@@ -257,7 +275,7 @@ singleHeader = try $ do

257 let len = (sourceColumn pos) - 1

275 let len = (sourceColumn pos) - 1

258 blankline

276 blankline

259 c <- oneOf underlineChars

277 c <- oneOf underlineChars

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

278+ count (len - 1) (char c)

261 many (char c)

279 many (char c)

262 blanklines

280 blanklines

263 state <- getState

281 state <- getState

@@ -272,6 +290,7 @@ singleHeader = try $ do

272-- hrule block

290-- hrule block

273--

291--

274

292

293+hrule :: GenParser Char st Block

275hrule = try $ do

294hrule = try $ do

276 chr <- oneOf underlineChars

295 chr <- oneOf underlineChars

277 count 3 (char chr)

296 count 3 (char chr)

@@ -285,6 +304,7 @@ hrule = try $ do

285--

304--

286

305

287-- read a line indented by a given string

306-- read a line indented by a given string

307+indentedLine :: String -> GenParser Char st [Char]

288indentedLine indents = try $ do

308indentedLine indents = try $ do

289 string indents

309 string indents

290 result <- manyTill anyChar newline

310 result <- manyTill anyChar newline

@@ -292,6 +312,7 @@ indentedLine indents = try $ do

292

312

293-- two or more indented lines, possibly separated by blank lines.

313-- two or more indented lines, possibly separated by blank lines.

294-- any amount of indentation will work.

314-- any amount of indentation will work.

315+indentedBlock :: GenParser Char st [Char]

295indentedBlock = do

316indentedBlock = do

296 indents <- lookAhead $ many1 (oneOf " \t")

317 indents <- lookAhead $ many1 (oneOf " \t")

297 lns <- many $ choice $ [ indentedLine indents,

318 lns <- many $ choice $ [ indentedLine indents,

@@ -301,6 +322,7 @@ indentedBlock = do

301 optional blanklines

322 optional blanklines

302 return $ concat lns

323 return $ concat lns

303

324

325+codeBlock :: GenParser Char st Block

304codeBlock = try $ do

326codeBlock = try $ do

305 codeBlockStart

327 codeBlockStart

306 result <- indentedBlock

328 result <- indentedBlock

@@ -310,6 +332,7 @@ codeBlock = try $ do

310-- raw html

332-- raw html

311--

333--

312

334

335+rawHtmlBlock :: GenParser Char st Block

313rawHtmlBlock = try $ string ".. raw:: html" >> blanklines >>

336rawHtmlBlock = try $ string ".. raw:: html" >> blanklines >>

314 indentedBlock >>= return . RawHtml

337 indentedBlock >>= return . RawHtml

315

338

@@ -317,6 +340,7 @@ rawHtmlBlock = try $ string ".. raw:: html" >> blanklines >>

317-- raw latex

340-- raw latex

318--

341--

319

342

343+rawLaTeXBlock :: GenParser Char st Block

320rawLaTeXBlock = try $ do

344rawLaTeXBlock = try $ do

321 string ".. raw:: latex"

345 string ".. raw:: latex"

322 blanklines

346 blanklines

@@ -327,6 +351,7 @@ rawLaTeXBlock = try $ do

327-- block quotes

351-- block quotes

328--

352--

329

353

354+blockQuote :: GenParser Char ParserState Block

330blockQuote = do

355blockQuote = do

331 raw <- indentedBlock

356 raw <- indentedBlock

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

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

@@ -337,8 +362,10 @@ blockQuote = do

337-- list blocks

362-- list blocks

338--

363--

339

364

365+list :: GenParser Char ParserState Block

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

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

341

367

368+definitionListItem :: GenParser Char ParserState ([Inline], [Block])

342definitionListItem = try $ do

369definitionListItem = try $ do

343 term <- many1Till inline endline

370 term <- many1Till inline endline

344 raw <- indentedBlock

371 raw <- indentedBlock

@@ -346,9 +373,11 @@ definitionListItem = try $ do

346 contents <- parseFromString parseBlocks $ raw ++ "\n\n"

373 contents <- parseFromString parseBlocks $ raw ++ "\n\n"

347 return (normalizeSpaces term, contents)

374 return (normalizeSpaces term, contents)

348

375

376+definitionList :: GenParser Char ParserState Block

349definitionList = many1 definitionListItem >>= return . DefinitionList

377definitionList = many1 definitionListItem >>= return . DefinitionList

350

378

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

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

380+bulletListStart :: GenParser Char st Int

352bulletListStart = try $ do

381bulletListStart = try $ do

353 notFollowedBy' hrule -- because hrules start out just like lists

382 notFollowedBy' hrule -- because hrules start out just like lists

354 marker <- oneOf bulletListMarkers

383 marker <- oneOf bulletListMarkers

@@ -356,12 +385,16 @@ bulletListStart = try $ do

356 return $ length (marker:white)

385 return $ length (marker:white)

357

386

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

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

388+orderedListStart :: ListNumberStyle

389+ -> ListNumberDelim

390+ -> GenParser Char st Int

359orderedListStart style delim = try $ do

391orderedListStart style delim = try $ do

360 (_, markerLen) <- withHorizDisplacement (orderedListMarker style delim)

392 (_, markerLen) <- withHorizDisplacement (orderedListMarker style delim)

361 white <- many1 spaceChar

393 white <- many1 spaceChar

362 return $ markerLen + length white

394 return $ markerLen + length white

363

395

364-- parse a line of a list item

396-- parse a line of a list item

397+listLine :: Int -> GenParser Char ParserState [Char]

365listLine markerLength = try $ do

398listLine markerLength = try $ do

366 notFollowedBy blankline

399 notFollowedBy blankline

367 indentWith markerLength

400 indentWith markerLength

@@ -369,6 +402,7 @@ listLine markerLength = try $ do

369 return $ line ++ "\n"

402 return $ line ++ "\n"

370

403

371-- indent by specified number of spaces (or equiv. tabs)

404-- indent by specified number of spaces (or equiv. tabs)

405+indentWith :: Int -> GenParser Char ParserState [Char]

372indentWith num = do

406indentWith num = do

373 state <- getState

407 state <- getState

374 let tabStop = stateTabStop state

408 let tabStop = stateTabStop state

@@ -378,6 +412,8 @@ indentWith num = do

378 (try (char '\t' >> count (num - tabStop) (char ' '))) ]

412 (try (char '\t' >> count (num - tabStop) (char ' '))) ]

379

413

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

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

415+rawListItem :: GenParser Char ParserState Int

416+ -> GenParser Char ParserState (Int, [Char])

381rawListItem start = try $ do

417rawListItem start = try $ do

382 markerLength <- start

418 markerLength <- start

383 firstLine <- manyTill anyChar newline

419 firstLine <- manyTill anyChar newline

@@ -387,11 +423,14 @@ rawListItem start = try $ do

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

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

388-- (in compact lists) endline.

424-- (in compact lists) endline.

389-- Note: nested lists are parsed as continuations.

425-- Note: nested lists are parsed as continuations.

426+listContinuation :: Int -> GenParser Char ParserState [Char]

390listContinuation markerLength = try $ do

427listContinuation markerLength = try $ do

391 blanks <- many1 blankline

428 blanks <- many1 blankline

392 result <- many1 (listLine markerLength)

429 result <- many1 (listLine markerLength)

393 return $ blanks ++ concat result

430 return $ blanks ++ concat result

394

431

432+listItem :: GenParser Char ParserState Int

433+ -> GenParser Char ParserState [Block]

395listItem start = try $ do

434listItem start = try $ do

396 (markerLength, first) <- rawListItem start

435 (markerLength, first) <- rawListItem start

397 rest <- many (listContinuation markerLength)

436 rest <- many (listContinuation markerLength)

@@ -408,12 +447,14 @@ listItem start = try $ do

408 updateState (\st -> st {stateParserContext = oldContext})

447 updateState (\st -> st {stateParserContext = oldContext})

409 return parsed

448 return parsed

410

449

450+orderedList :: GenParser Char ParserState Block

411orderedList = try $ do

451orderedList = try $ do

412 (start, style, delim) <- lookAhead (anyOrderedListMarker >>~ spaceChar)

452 (start, style, delim) <- lookAhead (anyOrderedListMarker >>~ spaceChar)

413 items <- many1 (listItem (orderedListStart style delim))

453 items <- many1 (listItem (orderedListStart style delim))

414 let items' = compactify items

454 let items' = compactify items

415 return $ OrderedList (start, style, delim) items'

455 return $ OrderedList (start, style, delim) items'

416

456

457+bulletList :: GenParser Char ParserState Block

417bulletList = many1 (listItem bulletListStart) >>=

458bulletList = many1 (listItem bulletListStart) >>=

418 return . BulletList . compactify

459 return . BulletList . compactify

419

460

@@ -421,6 +462,7 @@ bulletList = many1 (listItem bulletListStart) >>=

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

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

422--

463--

423

464

465+unknownDirective :: GenParser Char st Block

424unknownDirective = try $ do

466unknownDirective = try $ do

425 string ".. "

467 string ".. "

426 manyTill anyChar newline

468 manyTill anyChar newline

@@ -433,37 +475,44 @@ unknownDirective = try $ do

433-- reference key

475-- reference key

434--

476--

435

477

478+quotedReferenceName :: GenParser Char ParserState [Inline]

436quotedReferenceName = try $ do

479quotedReferenceName = try $ do

437 char '`' >> notFollowedBy (char '`') -- `` means inline code!

480 char '`' >> notFollowedBy (char '`') -- `` means inline code!

438− label <- many1Till inline (char '`')

481+ label' <- many1Till inline (char '`')

439− return label

482+ return label'

440

483

484+unquotedReferenceName :: GenParser Char ParserState [Inline]

441unquotedReferenceName = try $ do

485unquotedReferenceName = try $ do

442− label <- many1Till inline (lookAhead $ char ':')

486+ label' <- many1Till inline (lookAhead $ char ':')

443− return label

487+ return label'

444

488

489+isolated :: Char -> GenParser Char st Char

445isolated ch = try $ char ch >>~ notFollowedBy (char ch)

490isolated ch = try $ char ch >>~ notFollowedBy (char ch)

446

491

492+simpleReferenceName :: GenParser Char st [Inline]

447simpleReferenceName = do

493simpleReferenceName = do

448 raw <- many1 (alphaNum <|> isolated '-' <|> isolated '.' <|>

494 raw <- many1 (alphaNum <|> isolated '-' <|> isolated '.' <|>

449 (try $ char '_' >>~ lookAhead alphaNum))

495 (try $ char '_' >>~ lookAhead alphaNum))

450 return [Str raw]

496 return [Str raw]

451

497

498+referenceName :: GenParser Char ParserState [Inline]

452referenceName = quotedReferenceName <|>

499referenceName = quotedReferenceName <|>

453 (try $ simpleReferenceName >>~ lookAhead (char ':')) <|>

500 (try $ simpleReferenceName >>~ lookAhead (char ':')) <|>

454 unquotedReferenceName

501 unquotedReferenceName

455

502

503+referenceKey :: GenParser Char ParserState [Char]

456referenceKey = do

504referenceKey = do

457 startPos <- getPosition

505 startPos <- getPosition

458 key <- choice [imageKey, anonymousKey, regularKey]

506 key <- choice [imageKey, anonymousKey, regularKey]

459 st <- getState

507 st <- getState

460 let oldkeys = stateKeys st

508 let oldkeys = stateKeys st

461− updateState $ \st -> st { stateKeys = key : oldkeys }

509+ updateState $ \s -> s { stateKeys = key : oldkeys }

462 optional blanklines

510 optional blanklines

463 endPos <- getPosition

511 endPos <- getPosition

464 -- return enough blanks to replace key

512 -- return enough blanks to replace key

465 return $ replicate (sourceLine endPos - sourceLine startPos) '\n'

513 return $ replicate (sourceLine endPos - sourceLine startPos) '\n'

466

514

515+targetURI :: GenParser Char st [Char]

467targetURI = do

516targetURI = do

468 skipSpaces

517 skipSpaces

469 optional newline

518 optional newline

@@ -472,6 +521,7 @@ targetURI = do

472 blanklines

521 blanklines

473 return contents

522 return contents

474

523

524+imageKey :: GenParser Char ParserState ([Inline], (String, [Char]))

475imageKey = try $ do

525imageKey = try $ do

476 string ".. |"

526 string ".. |"

477 ref <- manyTill inline (char '|')

527 ref <- manyTill inline (char '|')

@@ -480,12 +530,13 @@ imageKey = try $ do

480 src <- targetURI

530 src <- targetURI

481 return (normalizeSpaces ref, (removeLeadingTrailingSpace src, ""))

531 return (normalizeSpaces ref, (removeLeadingTrailingSpace src, ""))

482

532

533+anonymousKey :: GenParser Char st ([Inline], (String, [Char]))

483anonymousKey = try $ do

534anonymousKey = try $ do

484 oneOfStrings [".. __:", "__"]

535 oneOfStrings [".. __:", "__"]

485 src <- targetURI

536 src <- targetURI

486− state <- getState

487 return ([Str "_"], (removeLeadingTrailingSpace src, ""))

537 return ([Str "_"], (removeLeadingTrailingSpace src, ""))

488

538

539+regularKey :: GenParser Char ParserState ([Inline], (String, [Char]))

489regularKey = try $ do

540regularKey = try $ do

490 string ".. _"

541 string ".. _"

491 ref <- referenceName

542 ref <- referenceName

@@ -497,6 +548,7 @@ regularKey = try $ do

497 -- inline

548 -- inline

498 --

549 --

499

550

551+inline :: GenParser Char ParserState Inline

500inline = choice [ link

552inline = choice [ link

501 , str

553 , str

502 , whitespace

554 , whitespace

@@ -511,46 +563,57 @@ inline = choice [ link

511 , escapedChar

563 , escapedChar

512 , symbol ] <?> "inline"

564 , symbol ] <?> "inline"

513

565

566+hyphens :: GenParser Char ParserState Inline

514hyphens = do

567hyphens = do

515 result <- many1 (char '-')

568 result <- many1 (char '-')

516 option Space endline

569 option Space endline

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

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

518 return $ Str result

571 return $ Str result

519

572

573+escapedChar :: GenParser Char st Inline

520escapedChar = escaped anyChar

574escapedChar = escaped anyChar

521

575

576+symbol :: GenParser Char ParserState Inline

522symbol = do

577symbol = do

523 result <- oneOf specialChars

578 result <- oneOf specialChars

524 return $ Str [result]

579 return $ Str [result]

525

580

526-- parses inline code, between codeStart and codeEnd

581-- parses inline code, between codeStart and codeEnd

582+code :: GenParser Char ParserState Inline

527code = try $ do

583code = try $ do

528 string "``"

584 string "``"

529 result <- manyTill anyChar (try (string "``"))

585 result <- manyTill anyChar (try (string "``"))

530 return $ Code $ removeLeadingTrailingSpace $ joinWithSep " " $ lines result

586 return $ Code $ removeLeadingTrailingSpace $ joinWithSep " " $ lines result

531

587

588+emph :: GenParser Char ParserState Inline

532emph = enclosed (char '*') (char '*') inline >>=

589emph = enclosed (char '*') (char '*') inline >>=

533 return . Emph . normalizeSpaces

590 return . Emph . normalizeSpaces

534

591

592+strong :: GenParser Char ParserState Inline

535strong = enclosed (string "**") (try $ string "**") inline >>=

593strong = enclosed (string "**") (try $ string "**") inline >>=

536 return . Strong . normalizeSpaces

594 return . Strong . normalizeSpaces

537

595

596+interpreted :: [Char] -> GenParser Char st [Inline]

538interpreted role = try $ do

597interpreted role = try $ do

539 optional $ try $ string "\\ "

598 optional $ try $ string "\\ "

540 result <- enclosed (string $ ":" ++ role ++ ":`") (char '`') anyChar

599 result <- enclosed (string $ ":" ++ role ++ ":`") (char '`') anyChar

541− nextChar <- lookAhead anyChar

542 try (string "\\ ") <|> lookAhead (count 1 $ oneOf " \t\n") <|> (eof >> return "")

600 try (string "\\ ") <|> lookAhead (count 1 $ oneOf " \t\n") <|> (eof >> return "")

543 return [Str result]

601 return [Str result]

544

602

603+superscript :: GenParser Char ParserState Inline

545superscript = interpreted "sup" >>= (return . Superscript)

604superscript = interpreted "sup" >>= (return . Superscript)

546

605

606+subscript :: GenParser Char ParserState Inline

547subscript = interpreted "sub" >>= (return . Subscript)

607subscript = interpreted "sub" >>= (return . Subscript)

548

608

609+whitespace :: GenParser Char ParserState Inline

549whitespace = many1 spaceChar >> return Space <?> "whitespace"

610whitespace = many1 spaceChar >> return Space <?> "whitespace"

550

611

612+str :: GenParser Char ParserState Inline

551str = many1 (noneOf (specialChars ++ "\t\n ")) >>= return . Str

613str = many1 (noneOf (specialChars ++ "\t\n ")) >>= return . Str

552

614

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

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

616+endline :: GenParser Char ParserState Inline

554endline = try $ do

617endline = try $ do

555 newline

618 newline

556 notFollowedBy blankline

619 notFollowedBy blankline

@@ -566,21 +629,24 @@ endline = try $ do

566-- links

629-- links

567--

630--

568

631

632+link :: GenParser Char ParserState Inline

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

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

570

634

635+explicitLink :: GenParser Char ParserState Inline

571explicitLink = try $ do

636explicitLink = try $ do

572 char '`'

637 char '`'

573 notFollowedBy (char '`') -- `` marks start of inline code

638 notFollowedBy (char '`') -- `` marks start of inline code

574− label <- manyTill (notFollowedBy (char '`') >> inline)

639+ label' <- manyTill (notFollowedBy (char '`') >> inline)

575 (try (spaces >> char '<'))

640 (try (spaces >> char '<'))

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

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

577 skipSpaces

642 skipSpaces

578 string "`_"

643 string "`_"

579− return $ Link (normalizeSpaces label) (removeLeadingTrailingSpace src, "")

644+ return $ Link (normalizeSpaces label') (removeLeadingTrailingSpace src, "")

580

645

646+referenceLink :: GenParser Char ParserState Inline

581referenceLink = try $ do

647referenceLink = try $ do

582− label <- (quotedReferenceName <|> simpleReferenceName) >>~ char '_'

648+ label' <- (quotedReferenceName <|> simpleReferenceName) >>~ char '_'

583− key <- option label (do{char '_'; return [Str "_"]}) -- anonymous link

649+ key <- option label' (do{char '_'; return [Str "_"]}) -- anonymous link

584 state <- getState

650 state <- getState

585 let keyTable = stateKeys state

651 let keyTable = stateKeys state

586 src <- case lookupKeySrc keyTable key of

652 src <- case lookupKeySrc keyTable key of

@@ -591,19 +657,23 @@ referenceLink = try $ do

591 then delete ([Str "_"], src) keyTable -- remove first anon key

657 then delete ([Str "_"], src) keyTable -- remove first anon key

592 else keyTable

658 else keyTable

593 setState $ state { stateKeys = keyTable' }

659 setState $ state { stateKeys = keyTable' }

594− return $ Link (normalizeSpaces label) src

660+ return $ Link (normalizeSpaces label') src

595

661

662+autoURI :: GenParser Char ParserState Inline

596autoURI = do

663autoURI = do

597 src <- uri

664 src <- uri

598 return $ Link [Str src] (src, "")

665 return $ Link [Str src] (src, "")

599

666

667+autoEmail :: GenParser Char ParserState Inline

600autoEmail = do

668autoEmail = do

601 src <- emailAddress

669 src <- emailAddress

602 return $ Link [Str src] ("mailto:" ++ src, "")

670 return $ Link [Str src] ("mailto:" ++ src, "")

603

671

672+autoLink :: GenParser Char ParserState Inline

604autoLink = autoURI <|> autoEmail

673autoLink = autoURI <|> autoEmail

605

674

606-- For now, we assume that all substitution references are for images.

675-- For now, we assume that all substitution references are for images.

676+image :: GenParser Char ParserState Inline

607image = try $ do

677image = try $ do

608 char '|'

678 char '|'

609 ref <- manyTill inline (char '|')

679 ref <- manyTill inline (char '|')