@@ -37,27 +37,29 @@ import Data.List ( findIndex, delete )
3737
3838-- | Parse reStructuredText string and return Pandoc document.
3939readRST :: ParserState -> String -> Pandoc
40−readRST state str = (readWith parseRST) state (str ++ "\n\n")
40+readRST state s = (readWith parseRST) state (s ++ "\n\n")
4141
4242--
4343-- Constants and data structure definitions
4444---
4545
46+bulletListMarkers :: [Char]
4647bulletListMarkers = "*+-"
48+
49+underlineChars :: [Char]
4750underlineChars = "!\"#$&'()*+,-./:;<=>?@[\\]^_`{|}~"
4851
4952-- treat these as potentially non-text when parsing inline:
53+specialChars :: [Char]
5054specialChars = "\\`|*_<>$:[-"
5155
5256--
5357-- parsing documents
5458--
5559
56−isAnonKey (ref, src) = ref == [Str "_"]
57−
5860isHeader :: Int -> Block -> Bool
5961isHeader n (Header x _) = x == n
60−isHeader _ _ = False
62+isHeader _ _ = False
6163
6264-- | Promote all headers in a list of blocks. (Part of
6365-- title transformation for RST.)
@@ -65,7 +67,7 @@ promoteHeaders :: Int -> [Block] -> [Block]
6567promoteHeaders num ((Header level text):rest) =
6668 (Header (level - num) text):(promoteHeaders num rest)
6769promoteHeaders num (other:rest) = other:(promoteHeaders num rest)
68−promoteHeaders num [] = []
70+promoteHeaders _ [] = []
6971
7072-- | If list of blocks starts with a header (or a header and subheader)
7173-- 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
8284 else ((promoteHeaders 1 rest), head1)
8385titleTransform blocks = (blocks, [])
8486
87+parseRST :: GenParser Char ParserState Pandoc
8588parseRST = do
8689 startPos <- getPosition
8790 -- go through once just to get list of reference keys
@@ -91,7 +94,7 @@ parseRST = do
9194 setPosition startPos
9295 st <- getState
9396 let reversedKeys = stateKeys st
94− updateState $ \st -> st { stateKeys = reverse reversedKeys }
97+ updateState $ \s -> s { stateKeys = reverse reversedKeys }
9598 -- now parse it for real...
9699 blocks <- parseBlocks
97100 let blocks' = filter (/= Null) blocks
@@ -108,8 +111,10 @@ parseRST = do
108111-- parsing blocks
109112--
110113
114+parseBlocks :: GenParser Char ParserState [Block]
111115parseBlocks = manyTill block eof
112116
117+block :: GenParser Char ParserState Block
113118block = choice [ codeBlock
114119 , rawHtmlBlock
115120 , rawLaTeXBlock
@@ -129,6 +134,7 @@ block = choice [ codeBlock
129134-- field list
130135--
131136
137+fieldListItem :: String -> GenParser Char st ([Char], [Char])
132138fieldListItem indent = try $ do
133139 string indent
134140 char ':'
@@ -140,13 +146,14 @@ fieldListItem indent = try $ do
140146 indentedBlock
141147 return (name, joinWithSep " " (first:(lines rest)))
142148
149+fieldList :: GenParser Char ParserState Block
143150fieldList = try $ do
144151 indent <- lookAhead $ many (oneOf " \t")
145152 items <- many1 $ fieldListItem indent
146153 blanklines
147154 let authors = case lookup "Authors" items of
148155 Just auth -> [auth]
149− Nothing -> map snd (filter (\(x,y) -> x == "Author") items)
156+ Nothing -> map snd (filter (\(x,_) -> x == "Author") items)
150157 if null authors
151158 then return ()
152159 else updateState $ \st -> st {stateAuthors = authors}
@@ -157,7 +164,7 @@ fieldList = try $ do
157164 Just tit -> parseFromString (many inline) tit >>=
158165 \t -> updateState $ \st -> st {stateTitle = t}
159166 Nothing -> return ()
160− let remaining = filter (\(x,y) -> (x /= "Authors") && (x /= "Author") &&
167+ let remaining = filter (\(x,_) -> (x /= "Authors") && (x /= "Author") &&
161168 (x /= "Date") && (x /= "Title")) items
162169 if null remaining
163170 then return Null
@@ -170,26 +177,31 @@ fieldList = try $ do
170177-- line block
171178--
172179
180+lineBlockLine :: GenParser Char ParserState [Inline]
173181lineBlockLine = try $ do
174182 string "| "
175183 white <- many (oneOf " \t")
176184 line <- manyTill inline newline
177185 return $ (if null white then [] else [Str white]) ++ line ++ [LineBreak]
178186
187+lineBlock :: GenParser Char ParserState Block
179188lineBlock = try $ do
180− lines <- many1 lineBlockLine
189+ lines' <- many1 lineBlockLine
181190 blanklines
182− return $ Para (concat lines)
191+ return $ Para (concat lines')
183192
184193--
185194-- paragraph block
186195--
187196
197+para :: GenParser Char ParserState Block
188198para = paraBeforeCodeBlock <|> paraNormal <?> "paragraph"
189199
200+codeBlockStart :: GenParser Char st Char
190201codeBlockStart = string "::" >> blankline >> blankline
191202
192203-- paragraph that ends in a :: starting a code block
204+paraBeforeCodeBlock :: GenParser Char ParserState Block
193205paraBeforeCodeBlock = try $ do
194206 result <- many1 (notFollowedBy' codeBlockStart >> inline)
195207 lookAhead (string "::")
@@ -198,18 +210,21 @@ paraBeforeCodeBlock = try $ do
198210 else (normalizeSpaces result) ++ [Str ":"]
199211
200212-- regular paragraph
213+paraNormal :: GenParser Char ParserState Block
201214paraNormal = try $ do
202215 result <- many1 inline
203216 newline
204217 blanklines
205218 return $ Para $ normalizeSpaces result
206219
220+plain :: GenParser Char ParserState Block
207221plain = many1 inline >>= return . Plain . normalizeSpaces
208222
209223--
210224-- image block
211225--
212226
227+imageBlock :: GenParser Char st Block
213228imageBlock = try $ do
214229 string ".. image:: "
215230 src <- manyTill anyChar newline
@@ -223,9 +238,11 @@ imageBlock = try $ do
223238-- header blocks
224239--
225240
241+header :: GenParser Char ParserState Block
226242header = doubleHeader <|> singleHeader <?> "header"
227243
228244-- a header with lines on top and bottom
245+doubleHeader :: GenParser Char ParserState Block
229246doubleHeader = try $ do
230247 c <- oneOf underlineChars
231248 rest <- many (char c) -- the top line
@@ -250,6 +267,7 @@ doubleHeader = try $ do
250267 return $ Header level (normalizeSpaces txt)
251268
252269-- a header with line on the bottom only
270+singleHeader :: GenParser Char ParserState Block
253271singleHeader = try $ do
254272 notFollowedBy' whitespace
255273 txt <- many1 (do {notFollowedBy blankline; inline})
@@ -257,7 +275,7 @@ singleHeader = try $ do
257275 let len = (sourceColumn pos) - 1
258276 blankline
259277 c <- oneOf underlineChars
260− rest <- count (len - 1) (char c)
278+ count (len - 1) (char c)
261279 many (char c)
262280 blanklines
263281 state <- getState
@@ -272,6 +290,7 @@ singleHeader = try $ do
272290-- hrule block
273291--
274292
293+hrule :: GenParser Char st Block
275294hrule = try $ do
276295 chr <- oneOf underlineChars
277296 count 3 (char chr)
@@ -285,6 +304,7 @@ hrule = try $ do
285304--
286305
287306-- read a line indented by a given string
307+indentedLine :: String -> GenParser Char st [Char]
288308indentedLine indents = try $ do
289309 string indents
290310 result <- manyTill anyChar newline
@@ -292,6 +312,7 @@ indentedLine indents = try $ do
292312
293313-- two or more indented lines, possibly separated by blank lines.
294314-- any amount of indentation will work.
315+indentedBlock :: GenParser Char st [Char]
295316indentedBlock = do
296317 indents <- lookAhead $ many1 (oneOf " \t")
297318 lns <- many $ choice $ [ indentedLine indents,
@@ -301,6 +322,7 @@ indentedBlock = do
301322 optional blanklines
302323 return $ concat lns
303324
325+codeBlock :: GenParser Char st Block
304326codeBlock = try $ do
305327 codeBlockStart
306328 result <- indentedBlock
@@ -310,6 +332,7 @@ codeBlock = try $ do
310332-- raw html
311333--
312334
335+rawHtmlBlock :: GenParser Char st Block
313336rawHtmlBlock = try $ string ".. raw:: html" >> blanklines >>
314337 indentedBlock >>= return . RawHtml
315338
@@ -317,6 +340,7 @@ rawHtmlBlock = try $ string ".. raw:: html" >> blanklines >>
317340-- raw latex
318341--
319342
343+rawLaTeXBlock :: GenParser Char st Block
320344rawLaTeXBlock = try $ do
321345 string ".. raw:: latex"
322346 blanklines
@@ -327,6 +351,7 @@ rawLaTeXBlock = try $ do
327351-- block quotes
328352--
329353
354+blockQuote :: GenParser Char ParserState Block
330355blockQuote = do
331356 raw <- indentedBlock
332357 -- parse the extracted block, which may contain various block elements:
@@ -337,8 +362,10 @@ blockQuote = do
337362-- list blocks
338363--
339364
365+list :: GenParser Char ParserState Block
340366list = choice [ bulletList, orderedList, definitionList ] <?> "list"
341367
368+definitionListItem :: GenParser Char ParserState ([Inline], [Block])
342369definitionListItem = try $ do
343370 term <- many1Till inline endline
344371 raw <- indentedBlock
@@ -346,9 +373,11 @@ definitionListItem = try $ do
346373 contents <- parseFromString parseBlocks $ raw ++ "\n\n"
347374 return (normalizeSpaces term, contents)
348375
376+definitionList :: GenParser Char ParserState Block
349377definitionList = many1 definitionListItem >>= return . DefinitionList
350378
351379-- parses bullet list start and returns its length (inc. following whitespace)
380+bulletListStart :: GenParser Char st Int
352381bulletListStart = try $ do
353382 notFollowedBy' hrule -- because hrules start out just like lists
354383 marker <- oneOf bulletListMarkers
@@ -356,12 +385,16 @@ bulletListStart = try $ do
356385 return $ length (marker:white)
357386
358387-- parses ordered list start and returns its length (inc following whitespace)
388+orderedListStart :: ListNumberStyle
389+ -> ListNumberDelim
390+ -> GenParser Char st Int
359391orderedListStart style delim = try $ do
360392 (_, markerLen) <- withHorizDisplacement (orderedListMarker style delim)
361393 white <- many1 spaceChar
362394 return $ markerLen + length white
363395
364396-- parse a line of a list item
397+listLine :: Int -> GenParser Char ParserState [Char]
365398listLine markerLength = try $ do
366399 notFollowedBy blankline
367400 indentWith markerLength
@@ -369,6 +402,7 @@ listLine markerLength = try $ do
369402 return $ line ++ "\n"
370403
371404-- indent by specified number of spaces (or equiv. tabs)
405+indentWith :: Int -> GenParser Char ParserState [Char]
372406indentWith num = do
373407 state <- getState
374408 let tabStop = stateTabStop state
@@ -378,6 +412,8 @@ indentWith num = do
378412 (try (char '\t' >> count (num - tabStop) (char ' '))) ]
379413
380414-- parse raw text for one list item, excluding start marker and continuations
415+rawListItem :: GenParser Char ParserState Int
416+ -> GenParser Char ParserState (Int, [Char])
381417rawListItem start = try $ do
382418 markerLength <- start
383419 firstLine <- manyTill anyChar newline
@@ -387,11 +423,14 @@ rawListItem start = try $ do
387423-- continuation of a list item - indented and separated by blankline or
388424-- (in compact lists) endline.
389425-- Note: nested lists are parsed as continuations.
426+listContinuation :: Int -> GenParser Char ParserState [Char]
390427listContinuation markerLength = try $ do
391428 blanks <- many1 blankline
392429 result <- many1 (listLine markerLength)
393430 return $ blanks ++ concat result
394431
432+listItem :: GenParser Char ParserState Int
433+ -> GenParser Char ParserState [Block]
395434listItem start = try $ do
396435 (markerLength, first) <- rawListItem start
397436 rest <- many (listContinuation markerLength)
@@ -408,12 +447,14 @@ listItem start = try $ do
408447 updateState (\st -> st {stateParserContext = oldContext})
409448 return parsed
410449
450+orderedList :: GenParser Char ParserState Block
411451orderedList = try $ do
412452 (start, style, delim) <- lookAhead (anyOrderedListMarker >>~ spaceChar)
413453 items <- many1 (listItem (orderedListStart style delim))
414454 let items' = compactify items
415455 return $ OrderedList (start, style, delim) items'
416456
457+bulletList :: GenParser Char ParserState Block
417458bulletList = many1 (listItem bulletListStart) >>=
418459 return . BulletList . compactify
419460
@@ -421,6 +462,7 @@ bulletList = many1 (listItem bulletListStart) >>=
421462-- unknown directive (e.g. comment)
422463--
423464
465+unknownDirective :: GenParser Char st Block
424466unknownDirective = try $ do
425467 string ".. "
426468 manyTill anyChar newline
@@ -433,37 +475,44 @@ unknownDirective = try $ do
433475-- reference key
434476--
435477
478+quotedReferenceName :: GenParser Char ParserState [Inline]
436479quotedReferenceName = try $ do
437480 char '`' >> notFollowedBy (char '`') -- `` means inline code!
438− label <- many1Till inline (char '`')
439− return label
481+ label' <- many1Till inline (char '`')
482+ return label'
440483
484+unquotedReferenceName :: GenParser Char ParserState [Inline]
441485unquotedReferenceName = try $ do
442− label <- many1Till inline (lookAhead $ char ':')
443− return label
486+ label' <- many1Till inline (lookAhead $ char ':')
487+ return label'
444488
489+isolated :: Char -> GenParser Char st Char
445490isolated ch = try $ char ch >>~ notFollowedBy (char ch)
446491
492+simpleReferenceName :: GenParser Char st [Inline]
447493simpleReferenceName = do
448494 raw <- many1 (alphaNum <|> isolated '-' <|> isolated '.' <|>
449495 (try $ char '_' >>~ lookAhead alphaNum))
450496 return [Str raw]
451497
498+referenceName :: GenParser Char ParserState [Inline]
452499referenceName = quotedReferenceName <|>
453500 (try $ simpleReferenceName >>~ lookAhead (char ':')) <|>
454501 unquotedReferenceName
455502
503+referenceKey :: GenParser Char ParserState [Char]
456504referenceKey = do
457505 startPos <- getPosition
458506 key <- choice [imageKey, anonymousKey, regularKey]
459507 st <- getState
460508 let oldkeys = stateKeys st
461− updateState $ \st -> st { stateKeys = key : oldkeys }
509+ updateState $ \s -> s { stateKeys = key : oldkeys }
462510 optional blanklines
463511 endPos <- getPosition
464512 -- return enough blanks to replace key
465513 return $ replicate (sourceLine endPos - sourceLine startPos) '\n'
466514
515+targetURI :: GenParser Char st [Char]
467516targetURI = do
468517 skipSpaces
469518 optional newline
@@ -472,6 +521,7 @@ targetURI = do
472521 blanklines
473522 return contents
474523
524+imageKey :: GenParser Char ParserState ([Inline], (String, [Char]))
475525imageKey = try $ do
476526 string ".. |"
477527 ref <- manyTill inline (char '|')
@@ -480,12 +530,13 @@ imageKey = try $ do
480530 src <- targetURI
481531 return (normalizeSpaces ref, (removeLeadingTrailingSpace src, ""))
482532
533+anonymousKey :: GenParser Char st ([Inline], (String, [Char]))
483534anonymousKey = try $ do
484535 oneOfStrings [".. __:", "__"]
485536 src <- targetURI
486− state <- getState
487537 return ([Str "_"], (removeLeadingTrailingSpace src, ""))
488538
539+regularKey :: GenParser Char ParserState ([Inline], (String, [Char]))
489540regularKey = try $ do
490541 string ".. _"
491542 ref <- referenceName
@@ -497,6 +548,7 @@ regularKey = try $ do
497548 -- inline
498549 --
499550
551+inline :: GenParser Char ParserState Inline
500552inline = choice [ link
501553 , str
502554 , whitespace
@@ -511,46 +563,57 @@ inline = choice [ link
511563 , escapedChar
512564 , symbol ] <?> "inline"
513565
566+hyphens :: GenParser Char ParserState Inline
514567hyphens = do
515568 result <- many1 (char '-')
516569 option Space endline
517570 -- don't want to treat endline after hyphen or dash as a space
518571 return $ Str result
519572
573+escapedChar :: GenParser Char st Inline
520574escapedChar = escaped anyChar
521575
576+symbol :: GenParser Char ParserState Inline
522577symbol = do
523578 result <- oneOf specialChars
524579 return $ Str [result]
525580
526581-- parses inline code, between codeStart and codeEnd
582+code :: GenParser Char ParserState Inline
527583code = try $ do
528584 string "``"
529585 result <- manyTill anyChar (try (string "``"))
530586 return $ Code $ removeLeadingTrailingSpace $ joinWithSep " " $ lines result
531587
588+emph :: GenParser Char ParserState Inline
532589emph = enclosed (char '*') (char '*') inline >>=
533590 return . Emph . normalizeSpaces
534591
592+strong :: GenParser Char ParserState Inline
535593strong = enclosed (string "**") (try $ string "**") inline >>=
536594 return . Strong . normalizeSpaces
537595
596+interpreted :: [Char] -> GenParser Char st [Inline]
538597interpreted role = try $ do
539598 optional $ try $ string "\\ "
540599 result <- enclosed (string $ ":" ++ role ++ ":`") (char '`') anyChar
541− nextChar <- lookAhead anyChar
542600 try (string "\\ ") <|> lookAhead (count 1 $ oneOf " \t\n") <|> (eof >> return "")
543601 return [Str result]
544602
603+superscript :: GenParser Char ParserState Inline
545604superscript = interpreted "sup" >>= (return . Superscript)
546605
606+subscript :: GenParser Char ParserState Inline
547607subscript = interpreted "sub" >>= (return . Subscript)
548608
609+whitespace :: GenParser Char ParserState Inline
549610whitespace = many1 spaceChar >> return Space <?> "whitespace"
550611
612+str :: GenParser Char ParserState Inline
551613str = many1 (noneOf (specialChars ++ "\t\n ")) >>= return . Str
552614
553615-- an endline character that can be treated as a space, not a structural break
616+endline :: GenParser Char ParserState Inline
554617endline = try $ do
555618 newline
556619 notFollowedBy blankline
@@ -566,21 +629,24 @@ endline = try $ do
566629-- links
567630--
568631
632+link :: GenParser Char ParserState Inline
569633link = choice [explicitLink, referenceLink, autoLink] <?> "link"
570634
635+explicitLink :: GenParser Char ParserState Inline
571636explicitLink = try $ do
572637 char '`'
573638 notFollowedBy (char '`') -- `` marks start of inline code
574− label <- manyTill (notFollowedBy (char '`') >> inline)
639+ label' <- manyTill (notFollowedBy (char '`') >> inline)
575640 (try (spaces >> char '<'))
576641 src <- manyTill (noneOf ">\n ") (char '>')
577642 skipSpaces
578643 string "`_"
579− return $ Link (normalizeSpaces label) (removeLeadingTrailingSpace src, "")
644+ return $ Link (normalizeSpaces label') (removeLeadingTrailingSpace src, "")
580645
646+referenceLink :: GenParser Char ParserState Inline
581647referenceLink = try $ do
582− label <- (quotedReferenceName <|> simpleReferenceName) >>~ char '_'
583− key <- option label (do{char '_'; return [Str "_"]}) -- anonymous link
648+ label' <- (quotedReferenceName <|> simpleReferenceName) >>~ char '_'
649+ key <- option label' (do{char '_'; return [Str "_"]}) -- anonymous link
584650 state <- getState
585651 let keyTable = stateKeys state
586652 src <- case lookupKeySrc keyTable key of
@@ -591,19 +657,23 @@ referenceLink = try $ do
591657 then delete ([Str "_"], src) keyTable -- remove first anon key
592658 else keyTable
593659 setState $ state { stateKeys = keyTable' }
594− return $ Link (normalizeSpaces label) src
660+ return $ Link (normalizeSpaces label') src
595661
662+autoURI :: GenParser Char ParserState Inline
596663autoURI = do
597664 src <- uri
598665 return $ Link [Str src] (src, "")
599666
667+autoEmail :: GenParser Char ParserState Inline
600668autoEmail = do
601669 src <- emailAddress
602670 return $ Link [Str src] ("mailto:" ++ src, "")
603671
672+autoLink :: GenParser Char ParserState Inline
604673autoLink = autoURI <|> autoEmail
605674
606675-- For now, we assume that all substitution references are for images.
676+image :: GenParser Char ParserState Inline
607677image = try $ do
608678 char '|'
609679 ref <- manyTill inline (char '|')