@@ -47,30 +47,40 @@ import Text.ParserCombinators.Parsec
4747
4848-- | Read markdown from an input string and return a Pandoc document.
4949readMarkdown :: ParserState -> String -> Pandoc
50−readMarkdown state str = (readWith parseMarkdown) state (str ++ "\n\n")
50+readMarkdown state s = (readWith parseMarkdown) state (s ++ "\n\n")
5151
5252--
5353-- Constants and data structure definitions
5454--
5555
56+spaceChars :: [Char]
5657spaceChars = " \t"
58+
59+bulletListMarkers :: [Char]
5760bulletListMarkers = "*+-"
61+
62+hruleChars :: [Char]
5863hruleChars = "*-_"
64+
65+setextHChars :: [Char]
5966setextHChars = "=-"
6067
6168-- treat these as potentially non-text when parsing inline:
69+specialChars :: [Char]
6270specialChars = "\\[]*_~`<>$!^-.&'\"\8216\8217\8220\8221"
6371
6472--
6573-- auxiliary functions
6674--
6775
76+indentSpaces :: GenParser Char ParserState [Char]
6877indentSpaces = try $ do
6978 state <- getState
7079 let tabStop = stateTabStop state
7180 try (count tabStop (char ' ')) <|>
7281 (many (char ' ') >> string "\t") <?> "indentation"
7382
83+nonindentSpaces :: GenParser Char ParserState [Char]
7484nonindentSpaces = do
7585 state <- getState
7686 let tabStop = stateTabStop state
@@ -80,11 +90,13 @@ nonindentSpaces = do
8090 else unexpected "indented line"
8191
8292-- | Fail unless we're at beginning of a line.
93+failUnlessBeginningOfLine :: GenParser tok st ()
8394failUnlessBeginningOfLine = do
8495 pos <- getPosition
8596 if sourceColumn pos == 1 then return () else fail "not beginning of line"
8697
8798-- | Fail unless we're in "smart typography" mode.
99+failUnlessSmart :: GenParser tok ParserState ()
88100failUnlessSmart = do
89101 state <- getState
90102 if stateSmart state then return () else fail "Smart typography feature"
@@ -109,8 +121,10 @@ inlinesInBalancedBrackets parser = try $ do
109121-- document structure
110122--
111123
124+titleLine :: GenParser Char ParserState [Inline]
112125titleLine = try $ char '%' >> skipSpaces >> manyTill inline newline
113126
127+authorsLine :: GenParser Char st [String]
114128authorsLine = try $ do
115129 char '%'
116130 skipSpaces
@@ -118,6 +132,7 @@ authorsLine = try $ do
118132 newline
119133 return $ map (decodeCharacterReferences . removeLeadingTrailingSpace) authors
120134
135+dateLine :: GenParser Char st String
121136dateLine = try $ do
122137 char '%'
123138 skipSpaces
@@ -125,6 +140,7 @@ dateLine = try $ do
125140 newline
126141 return $ decodeCharacterReferences $ removeTrailingSpace date
127142
143+titleBlock :: GenParser Char ParserState ([Inline], [String], [Char])
128144titleBlock = try $ do
129145 failIfStrict
130146 title <- option [] titleLine
@@ -133,6 +149,7 @@ titleBlock = try $ do
133149 optional blanklines
134150 return (title, author, date)
135151
152+parseMarkdown :: GenParser Char ParserState Pandoc
136153parseMarkdown = do
137154 -- markdown allows raw HTML
138155 updateState (\state -> state { stateParseRaw = True })
@@ -149,9 +166,9 @@ parseMarkdown = do
149166 then return ()
150167 else do docMinusNotes <- manyTill (noteBlock <|> lineClump) eof >>=
151168 return . concat
152− st <- getState
153− let reversedNotes = stateNotes st
154− updateState $ \st -> st { stateNotes = reverse reversedNotes }
169+ st' <- getState
170+ let reversedNotes = stateNotes st'
171+ updateState $ \s -> s { stateNotes = reverse reversedNotes }
155172 setInput docMinusNotes
156173 setPosition startPos
157174 -- now parse it for real...
@@ -163,10 +180,11 @@ parseMarkdown = do
163180-- initial pass for references and notes
164181--
165182
183+referenceKey :: GenParser Char ParserState [Char]
166184referenceKey = try $ do
167185 startPos <- getPosition
168186 nonindentSpaces
169− label <- reference
187+ lab <- reference
170188 char ':'
171189 skipSpaces
172190 optional (char '<')
@@ -175,13 +193,14 @@ referenceKey = try $ do
175193 tit <- option "" referenceTitle
176194 blanklines
177195 endPos <- getPosition
178− let newkey = (label, (removeTrailingSpace src, tit))
196+ let newkey = (lab, (removeTrailingSpace src, tit))
179197 st <- getState
180198 let oldkeys = stateKeys st
181− updateState $ \st -> st { stateKeys = newkey : oldkeys }
199+ updateState $ \s -> s { stateKeys = newkey : oldkeys }
182200 -- return blanks so line count isn't affected
183201 return $ replicate (sourceLine endPos - sourceLine startPos) '\n'
184202
203+referenceTitle :: GenParser Char st String
185204referenceTitle = try $ do
186205 (many1 spaceChar >> option '\n' newline) <|> newline
187206 skipSpaces
@@ -191,8 +210,10 @@ referenceTitle = try $ do
191210 notFollowedBy (noneOf ")\n")))
192211 return $ decodeCharacterReferences tit
193212
213+noteMarker :: GenParser Char st [Char]
194214noteMarker = string "[^" >> manyTill (noneOf " \t\n") (char ']')
195215
216+rawLine :: GenParser Char ParserState [Char]
196217rawLine = do
197218 notFollowedBy blankline
198219 notFollowedBy' noteMarker
@@ -200,8 +221,10 @@ rawLine = do
200221 end <- option "" (newline >> optional indentSpaces >> return "\n")
201222 return $ contents ++ end
202223
224+rawLines :: GenParser Char ParserState [Char]
203225rawLines = many1 rawLine >>= return . concat
204226
227+noteBlock :: GenParser Char ParserState [Char]
205228noteBlock = try $ do
206229 startPos <- getPosition
207230 ref <- noteMarker
@@ -216,7 +239,7 @@ noteBlock = try $ do
216239 let newnote = (ref, contents)
217240 st <- getState
218241 let oldnotes = stateNotes st
219− updateState $ \st -> st { stateNotes = newnote : oldnotes }
242+ updateState $ \s -> s { stateNotes = newnote : oldnotes }
220243 -- return blanks so line count isn't affected
221244 return $ replicate (sourceLine endPos - sourceLine startPos) '\n'
222245
@@ -224,8 +247,10 @@ noteBlock = try $ do
224247-- parsing blocks
225248--
226249
250+parseBlocks :: GenParser Char ParserState [Block]
227251parseBlocks = manyTill block eof
228252
253+block :: GenParser Char ParserState Block
229254block = do
230255 st <- getState
231256 choice (if stateStrict st
@@ -258,8 +283,10 @@ block = do
258283-- header blocks
259284--
260285
286+header :: GenParser Char ParserState Block
261287header = atxHeader <|> setextHeader <?> "header"
262288
289+atxHeader :: GenParser Char ParserState Block
263290atxHeader = try $ do
264291 level <- many1 (char '#') >>= return . length
265292 notFollowedBy (char '.' <|> char ')') -- this would be a list
@@ -267,8 +294,10 @@ atxHeader = try $ do
267294 text <- manyTill inline atxClosing >>= return . normalizeSpaces
268295 return $ Header level text
269296
297+atxClosing :: GenParser Char st [Char]
270298atxClosing = try $ skipMany (char '#') >> blanklines
271299
300+setextHeader :: GenParser Char ParserState Block
272301setextHeader = try $ do
273302 text <- many1Till inline newline
274303 underlineChar <- oneOf setextHChars
@@ -281,6 +310,7 @@ setextHeader = try $ do
281310-- hrule block
282311--
283312
313+hrule :: GenParser Char st Block
284314hrule = try $ do
285315 skipSpaces
286316 start <- oneOf hruleChars
@@ -294,8 +324,11 @@ hrule = try $ do
294324-- code blocks
295325--
296326
327+indentedLine :: GenParser Char ParserState [Char]
297328indentedLine = indentSpaces >> manyTill anyChar newline >>= return . (++ "\n")
298329
330+codeBlockDelimiter :: Maybe Int
331+ -> GenParser Char st (Int, ([Char], [[Char]], [([Char], [Char])]))
299332codeBlockDelimiter len = try $ do
300333 size <- case len of
301334 Just l -> count l (char '~') >> many (char '~') >> return l
@@ -306,32 +339,38 @@ codeBlockDelimiter len = try $ do
306339 blankline
307340 return (size, attr)
308341
342+attributes :: GenParser Char st ([Char], [[Char]], [([Char], [Char])])
309343attributes = try $ do
310344 char '{'
311345 many spaceChar
312346 attrs <- many (attribute >>~ many spaceChar)
313347 char '}'
314348 let (ids, classes, keyvals) = unzip3 attrs
315− let id = if null ids then "" else head ids
316− return (id, concat classes, concat keyvals)
349+ let id' = if null ids then "" else head ids
350+ return (id', concat classes, concat keyvals)
317351
352+attribute :: GenParser Char st ([Char], [[Char]], [([Char], [Char])])
318353attribute = identifierAttr <|> classAttr <|> keyValAttr
319354
355+identifier :: GenParser Char st [Char]
320356identifier = do
321357 first <- letter
322358 rest <- many alphaNum
323359 return (first:rest)
324360
361+identifierAttr :: GenParser Char st ([Char], [a], [a1])
325362identifierAttr = try $ do
326363 char '#'
327364 result <- identifier
328365 return (result,[],[])
329366
367+classAttr :: GenParser Char st ([Char], [[Char]], [a])
330368classAttr = try $ do
331369 char '.'
332370 result <- identifier
333371 return ("",[result],[])
334372
373+keyValAttr :: GenParser Char st ([Char], [a], [([Char], [Char])])
335374keyValAttr = try $ do
336375 key <- identifier
337376 char '='
@@ -339,12 +378,14 @@ keyValAttr = try $ do
339378 val <- manyTill (noneOf "\n") (char '"')
340379 return ("",[],[(key,val)])
341380
381+codeBlockDelimited :: GenParser Char st Block
342382codeBlockDelimited = try $ do
343383 (size, attr) <- codeBlockDelimiter Nothing
344384 contents <- manyTill anyLine (codeBlockDelimiter (Just size))
345385 blanklines
346386 return $ CodeBlock attr $ joinWithSep "\n" contents
347387
388+codeBlockIndented :: GenParser Char ParserState Block
348389codeBlockIndented = do
349390 contents <- many1 (indentedLine <|>
350391 try (do b <- blanklines
@@ -357,8 +398,10 @@ codeBlockIndented = do
357398-- block quotes
358399--
359400
401+emailBlockQuoteStart :: GenParser Char ParserState Char
360402emailBlockQuoteStart = try $ nonindentSpaces >> char '>' >>~ optional (char ' ')
361403
404+emailBlockQuote :: GenParser Char ParserState [[Char]]
362405emailBlockQuote = try $ do
363406 emailBlockQuoteStart
364407 raw <- sepBy (many (nonEndline <|>
@@ -369,6 +412,7 @@ emailBlockQuote = try $ do
369412 optional blanklines
370413 return raw
371414
415+blockQuote :: GenParser Char ParserState Block
372416blockQuote = do
373417 raw <- emailBlockQuote
374418 -- parse the extracted block, which may contain various block elements:
@@ -379,6 +423,7 @@ blockQuote = do
379423-- list blocks
380424--
381425
426+bulletListStart :: GenParser Char ParserState ()
382427bulletListStart = try $ do
383428 optional newline -- if preceded by a Plain block in a list context
384429 nonindentSpaces
@@ -387,6 +432,7 @@ bulletListStart = try $ do
387432 spaceChar
388433 skipSpaces
389434
435+anyOrderedListStart :: GenParser Char ParserState (Int, ListNumberStyle, ListNumberDelim)
390436anyOrderedListStart = try $ do
391437 optional newline -- if preceded by a Plain block in a list context
392438 nonindentSpaces
@@ -399,6 +445,9 @@ anyOrderedListStart = try $ do
399445 return (1, DefaultStyle, DefaultDelim)
400446 else anyOrderedListMarker >>~ spaceChar
401447
448+orderedListStart :: ListNumberStyle
449+ -> ListNumberDelim
450+ -> GenParser Char ParserState ()
402451orderedListStart style delim = try $ do
403452 optional newline -- if preceded by a Plain block in a list context
404453 nonindentSpaces
@@ -415,6 +464,8 @@ orderedListStart style delim = try $ do
415464 skipSpaces
416465
417466-- parse a line of a list item (start = parser for beginning of list item)
467+listLine :: GenParser Char ParserState ()
468+ -> GenParser Char ParserState [Char]
418469listLine start = try $ do
419470 notFollowedBy' start
420471 notFollowedBy blankline
@@ -425,6 +476,8 @@ listLine start = try $ do
425476 return $ line ++ "\n"
426477
427478-- parse raw text for one list item, excluding start marker and continuations
479+rawListItem :: GenParser Char ParserState ()
480+ -> GenParser Char ParserState [Char]
428481rawListItem start = try $ do
429482 start
430483 result <- many1 (listLine start)
@@ -434,12 +487,15 @@ rawListItem start = try $ do
434487-- continuation of a list item - indented and separated by blankline
435488-- or (in compact lists) endline.
436489-- note: nested lists are parsed as continuations
490+listContinuation :: GenParser Char ParserState () -> GenParser Char ParserState [Char]
437491listContinuation start = try $ do
438492 lookAhead indentSpaces
439493 result <- many1 (listContinuationLine start)
440494 blanks <- many blankline
441495 return $ concat result ++ blanks
442496
497+listContinuationLine :: GenParser Char ParserState ()
498+ -> GenParser Char ParserState [Char]
443499listContinuationLine start = try $ do
444500 notFollowedBy blankline
445501 notFollowedBy' start
@@ -447,6 +503,8 @@ listContinuationLine start = try $ do
447503 result <- manyTill anyChar newline
448504 return $ result ++ "\n"
449505
506+listItem :: GenParser Char ParserState ()
507+ -> GenParser Char ParserState [Block]
450508listItem start = try $ do
451509 first <- rawListItem start
452510 continuations <- many (listContinuation start)
@@ -462,16 +520,19 @@ listItem start = try $ do
462520 updateState (\st -> st {stateParserContext = oldContext})
463521 return contents
464522
523+orderedList :: GenParser Char ParserState Block
465524orderedList = try $ do
466525 (start, style, delim) <- lookAhead anyOrderedListStart
467526 items <- many1 (listItem (orderedListStart style delim))
468527 return $ OrderedList (start, style, delim) $ compactify items
469528
529+bulletList :: GenParser Char ParserState Block
470530bulletList = many1 (listItem bulletListStart) >>=
471531 return . BulletList . compactify
472532
473533-- definition lists
474534
535+definitionListItem :: GenParser Char ParserState ([Inline], [Block])
475536definitionListItem = try $ do
476537 notFollowedBy blankline
477538 notFollowedBy' indentSpaces
@@ -486,6 +547,7 @@ definitionListItem = try $ do
486547 updateState (\st -> st {stateParserContext = oldContext})
487548 return ((normalizeSpaces term), contents)
488549
550+defRawBlock :: GenParser Char ParserState [Char]
489551defRawBlock = try $ do
490552 char ':'
491553 state <- getState
@@ -496,6 +558,7 @@ defRawBlock = try $ do
496558 trailing <- option "" blanklines
497559 return $ firstline ++ "\n" ++ unlines rawlines ++ trailing
498560
561+definitionList :: GenParser Char ParserState Block
499562definitionList = do
500563 items <- many1 definitionListItem
501564 let (terms, defs) = unzip items
@@ -507,11 +570,13 @@ definitionList = do
507570-- paragraph block
508571--
509572
573+isHtmlOrBlank :: Inline -> Bool
510574isHtmlOrBlank (HtmlInline _) = True
511−isHtmlOrBlank (Space) = True
512−isHtmlOrBlank (LineBreak) = True
513−isHtmlOrBlank _ = False
575+isHtmlOrBlank (Space) = True
576+isHtmlOrBlank (LineBreak) = True
577+isHtmlOrBlank _ = False
514578
579+para :: GenParser Char ParserState Block
515580para = try $ do
516581 result <- many1 inline
517582 if all isHtmlOrBlank result
@@ -524,14 +589,17 @@ para = try $ do
524589 else pzero
525590 return $ Para $ normalizeSpaces result
526591
592+plain :: GenParser Char ParserState Block
527593plain = many1 inline >>= return . Plain . normalizeSpaces
528594
529595--
530596-- raw html
531597--
532598
599+htmlElement :: GenParser Char ParserState [Char]
533600htmlElement = strictHtmlBlock <|> htmlBlockElement <?> "html element"
534601
602+htmlBlock :: GenParser Char ParserState Block
535603htmlBlock = try $ do
536604 failUnlessBeginningOfLine
537605 first <- htmlElement
@@ -540,9 +608,11 @@ htmlBlock = try $ do
540608 return $ RawHtml $ first ++ finalSpace ++ finalNewlines
541609
542610-- True if tag is self-closing
611+isSelfClosing :: [Char] -> Bool
543612isSelfClosing tag =
544613 isSuffixOf "/>" $ filter (not . (`elem` " \n\t")) tag
545614
615+strictHtmlBlock :: GenParser Char ParserState [Char]
546616strictHtmlBlock = try $ do
547617 tag <- anyHtmlBlockTag
548618 let tag' = extractTagType tag
@@ -553,6 +623,7 @@ strictHtmlBlock = try $ do
553623 end <- htmlEndTag tag'
554624 return $ tag ++ concat contents ++ end
555625
626+rawHtmlBlocks :: GenParser Char ParserState Block
556627rawHtmlBlocks = do
557628 htmlBlocks <- many1 $ do (RawHtml blk) <- rawHtmlBlock
558629 sps <- do sp1 <- many spaceChar
@@ -574,6 +645,8 @@ rawHtmlBlocks = do
574645
575646-- Parse a dashed line with optional trailing spaces; return its length
576647-- and the length including trailing space.
648+dashedLine :: Char
649+ -> GenParser Char st (Int, Int)
577650dashedLine ch = do
578651 dashes <- many1 (char ch)
579652 sp <- many spaceChar
@@ -581,24 +654,29 @@ dashedLine ch = do
581654
582655-- Parse a table header with dashed lines of '-' preceded by
583656-- one line of text.
657+simpleTableHeader :: GenParser Char ParserState ([[Char]], [Alignment], [Int])
584658simpleTableHeader = try $ do
585659 rawContent <- anyLine
586660 initSp <- nonindentSpaces
587661 dashes <- many1 (dashedLine '-')
588662 newline
589− let (lengths, lines) = unzip dashes
590− let indices = scanl (+) (length initSp) lines
663+ let (lengths, lines') = unzip dashes
664+ let indices = scanl (+) (length initSp) lines'
591665 let rawHeads = tail $ splitByIndices (init indices) rawContent
592666 let aligns = zipWith alignType (map (\a -> [a]) rawHeads) lengths
593667 return (rawHeads, aligns, indices)
594668
595669-- Parse a table footer - dashed lines followed by blank line.
670+tableFooter :: GenParser Char ParserState [Char]
596671tableFooter = try $ nonindentSpaces >> many1 (dashedLine '-') >> blanklines
597672
598673-- Parse a table separator - dashed line.
674+tableSep :: GenParser Char ParserState String
599675tableSep = try $ nonindentSpaces >> many1 (dashedLine '-') >> string "\n"
600676
601677-- Parse a raw line and split it into chunks by indices.
678+rawTableLine :: [Int]
679+ -> GenParser Char ParserState [String]
602680rawTableLine indices = do
603681 notFollowedBy' (blanklines <|> tableFooter)
604682 line <- many1Till anyChar newline
@@ -606,9 +684,13 @@ rawTableLine indices = do
606684 splitByIndices (init indices) line
607685
608686-- Parse a table line and return a list of lists of blocks (columns).
687+tableLine :: [Int]
688+ -> GenParser Char ParserState [[Block]]
609689tableLine indices = rawTableLine indices >>= mapM (parseFromString (many plain))
610690
611691-- Parse a multiline table row and return a list of blocks (columns).
692+multilineRow :: [Int]
693+ -> GenParser Char ParserState [[Block]]
612694multilineRow indices = do
613695 colLines <- many1 (rawTableLine indices)
614696 optional blanklines
@@ -631,6 +713,7 @@ widthsFromIndices numColumns indices =
631713
632714-- Parses a table caption: inlines beginning with 'Table:'
633715-- and followed by blank lines.
716+tableCaption :: GenParser Char ParserState [Inline]
634717tableCaption = try $ do
635718 nonindentSpaces
636719 string "Table:"
@@ -639,33 +722,40 @@ tableCaption = try $ do
639722 return $ normalizeSpaces result
640723
641724-- Parse a table using 'headerParser', 'lineParser', and 'footerParser'.
725+tableWith :: GenParser Char ParserState ([[Char]], [Alignment], [Int])
726+ -> ([Int] -> GenParser Char ParserState [[Block]])
727+ -> GenParser Char ParserState end
728+ -> GenParser Char ParserState Block
642729tableWith headerParser lineParser footerParser = try $ do
643730 (rawHeads, aligns, indices) <- headerParser
644− lines <- many1Till (lineParser indices) footerParser
731+ lines' <- many1Till (lineParser indices) footerParser
645732 caption <- option [] tableCaption
646733 heads <- mapM (parseFromString (many plain)) rawHeads
647734 state <- getState
648735 let numColumns = stateColumns state
649736 let widths = widthsFromIndices numColumns indices
650− return $ Table caption aligns widths heads lines
737+ return $ Table caption aligns widths heads lines'
651738
652739-- Parse a simple table with '---' header and one line per row.
740+simpleTable :: GenParser Char ParserState Block
653741simpleTable = tableWith simpleTableHeader tableLine blanklines
654742
655743-- Parse a multiline table: starts with row of '-' on top, then header
656744-- (which may be multiline), then the rows,
657745-- which may be multiline, separated by blank lines, and
658746-- ending with a footer (dashed line followed by blank line).
747+multilineTable :: GenParser Char ParserState Block
659748multilineTable = tableWith multilineTableHeader multilineRow tableFooter
660749
750+multilineTableHeader :: GenParser Char ParserState ([String], [Alignment], [Int])
661751multilineTableHeader = try $ do
662752 tableSep
663753 rawContent <- many1 (notFollowedBy' tableSep >> many1Till anyChar newline)
664754 initSp <- nonindentSpaces
665755 dashes <- many1 (dashedLine '-')
666756 newline
667− let (lengths, lines) = unzip dashes
668− let indices = scanl (+) (length initSp) lines
757+ let (lengths, lines') = unzip dashes
758+ let indices = scanl (+) (length initSp) lines'
669759 let rawHeadsList = transpose $ map
670760 (\ln -> tail $ splitByIndices (init indices) ln)
671761 rawContent
@@ -676,27 +766,32 @@ multilineTableHeader = try $ do
676766-- Returns an alignment type for a table, based on a list of strings
677767-- (the rows of the column header) and a number (the length of the
678768-- dashed line under the rows.
679−alignType :: [String] -> Int -> Alignment
680−alignType [] len = AlignDefault
769+alignType :: [String]
770+ -> Int
771+ -> Alignment
772+alignType [] _ = AlignDefault
681773alignType strLst len =
682− let str = head $ sortBy (comparing length) $
774+ let s = head $ sortBy (comparing length) $
683775 map removeTrailingSpace strLst
684− leftSpace = if null str then False else (str !! 0) `elem` " \t"
685− rightSpace = length str < len || (str !! (len - 1)) `elem` " \t"
776+ leftSpace = if null s then False else (s !! 0) `elem` " \t"
777+ rightSpace = length s < len || (s !! (len - 1)) `elem` " \t"
686778 in case (leftSpace, rightSpace) of
687779 (True, False) -> AlignRight
688780 (False, True) -> AlignLeft
689781 (True, True) -> AlignCenter
690782 (False, False) -> AlignDefault
691783
784+table :: GenParser Char ParserState Block
692785table = simpleTable <|> multilineTable <?> "table"
693786
694787--
695788-- inline
696789--
697790
791+inline :: GenParser Char ParserState Inline
698792inline = choice inlineParsers <?> "inline"
699793
794+inlineParsers :: [GenParser Char ParserState Inline]
700795inlineParsers = [ abbrev
701796 , str
702797 , smartPunctuation
@@ -721,13 +816,16 @@ inlineParsers = [ abbrev
721816 , symbol
722817 , ltSign ]
723818
819+inlineNonLink :: GenParser Char ParserState Inline
724820inlineNonLink = (choice $
725821 map (\parser -> try (parser >>= failIfLink)) inlineParsers)
726822 <?> "inline (non-link)"
727823
824+failIfLink :: Inline -> GenParser tok st Inline
728825failIfLink (Link _ _) = pzero
729−failIfLink elt = return elt
826+failIfLink elt = return elt
730827
828+escapedChar :: GenParser Char ParserState Inline
731829escapedChar = do
732830 char '\\'
733831 state <- getState
@@ -739,6 +837,7 @@ escapedChar = do
739837 else result
740838 return $ Str [result']
741839
840+ltSign :: GenParser Char ParserState Inline
742841ltSign = do
743842 st <- getState
744843 if stateStrict st
@@ -746,13 +845,16 @@ ltSign = do
746845 else notFollowedBy' rawHtmlBlocks >> char '<' -- unless it starts html
747846 return $ Str ['<']
748847
848+specialCharsMinusLt :: [Char]
749849specialCharsMinusLt = filter (/= '<') specialChars
750850
851+symbol :: GenParser Char ParserState Inline
751852symbol = do
752853 result <- oneOf specialCharsMinusLt
753854 return $ Str [result]
754855
755856-- parses inline code, between n `s and n `s
857+code :: GenParser Char ParserState Inline
756858code = try $ do
757859 starts <- many1 (char '`')
758860 skipSpaces
@@ -762,43 +864,52 @@ code = try $ do
762864 notFollowedBy (char '`')))
763865 return $ Code $ removeLeadingTrailingSpace $ concat result
764866
867+mathWord :: GenParser Char st [Char]
765868mathWord = many1 ((noneOf " \t\n\\$") <|>
766869 (try (char '\\') >>~ notFollowedBy (char '$')))
767870
871+math :: GenParser Char ParserState Inline
768872math = try $ do
769873 failIfStrict
770874 char '$'
771875 notFollowedBy space
772− words <- sepBy1 mathWord (many1 space)
876+ words' <- sepBy1 mathWord (many1 space)
773877 char '$'
774− return $ Math $ joinWithSep " " words
878+ return $ Math $ joinWithSep " " words'
775879
880+emph :: GenParser Char ParserState Inline
776881emph = ((enclosed (char '*') (notFollowedBy' strong >> char '*') inline) <|>
777882 (enclosed (char '_') (notFollowedBy' strong >> char '_' >>
778883 notFollowedBy alphaNum) inline)) >>=
779884 return . Emph . normalizeSpaces
780885
886+strong :: GenParser Char ParserState Inline
781887strong = ((enclosed (string "**") (try $ string "**") inline) <|>
782888 (enclosed (string "__") (try $ string "__") inline)) >>=
783889 return . Strong . normalizeSpaces
784890
891+strikeout :: GenParser Char ParserState Inline
785892strikeout = failIfStrict >> enclosed (string "~~") (try $ string "~~") inline >>=
786893 return . Strikeout . normalizeSpaces
787894
895+superscript :: GenParser Char ParserState Inline
788896superscript = failIfStrict >> enclosed (char '^') (char '^')
789897 (notFollowedBy' whitespace >> inline) >>= -- may not contain Space
790898 return . Superscript
791899
900+subscript :: GenParser Char ParserState Inline
792901subscript = failIfStrict >> enclosed (char '~') (char '~')
793902 (notFollowedBy' whitespace >> inline) >>= -- may not contain Space
794903 return . Subscript
795904
905+abbrev :: GenParser Char ParserState Inline
796906abbrev = failUnlessSmart >>
797907 (assumedAbbrev <|> knownAbbrev) >>= return . Str . (++ ".\160")
798908
799909-- an string of letters followed by a period that does not end a sentence
800910-- is assumed to be an abbreviation. It is assumed that sentences don't
801911-- start with lowercase letters or numerals.
912+assumedAbbrev :: GenParser Char ParserState [Char]
802913assumedAbbrev = try $ do
803914 result <- many1 $ satisfy isAlpha
804915 string ". "
@@ -807,20 +918,27 @@ assumedAbbrev = try $ do
807918
808919-- these strings are treated as abbreviations even if they are followed
809920-- by a capital letter (such as a name).
921+knownAbbrev :: GenParser Char ParserState [Char]
810922knownAbbrev = try $ do
811923 result <- oneOfStrings [ "Mr", "Mrs", "Ms", "Capt", "Dr", "Prof", "Gen",
812924 "Gov", "e.g", "i.e", "Sgt", "St", "vol", "vs",
813925 "Sen", "Rep", "Pres", "Hon", "Rev" ]
814926 string ". "
815927 return result
816−
928+
929+smartPunctuation :: GenParser Char ParserState Inline
817930smartPunctuation = failUnlessSmart >>
818931 choice [ quoted, apostrophe, dash, ellipses ]
819932
933+apostrophe :: GenParser Char ParserState Inline
820934apostrophe = (char '\'' <|> char '\8217') >> return Apostrophe
821935
936+quoted :: GenParser Char ParserState Inline
822937quoted = doubleQuoted <|> singleQuoted
823938
939+withQuoteContext :: QuoteContext
940+ -> (GenParser Char ParserState Inline)
941+ -> GenParser Char ParserState Inline
824942withQuoteContext context parser = do
825943 oldState <- getState
826944 let oldQuoteContext = stateQuoteContext oldState
@@ -830,22 +948,26 @@ withQuoteContext context parser = do
830948 setState newState { stateQuoteContext = oldQuoteContext }
831949 return result
832950
951+singleQuoted :: GenParser Char ParserState Inline
833952singleQuoted = try $ do
834953 singleQuoteStart
835954 withQuoteContext InSingleQuote $ many1Till inline singleQuoteEnd >>=
836955 return . Quoted SingleQuote . normalizeSpaces
837956
957+doubleQuoted :: GenParser Char ParserState Inline
838958doubleQuoted = try $ do
839959 doubleQuoteStart
840960 withQuoteContext InDoubleQuote $ many1Till inline doubleQuoteEnd >>=
841961 return . Quoted DoubleQuote . normalizeSpaces
842962
963+failIfInQuoteContext :: QuoteContext -> GenParser tok ParserState ()
843964failIfInQuoteContext context = do
844965 st <- getState
845966 if stateQuoteContext st == context
846967 then fail "already inside quotes"
847968 else return ()
848969
970+singleQuoteStart :: GenParser Char ParserState Char
849971singleQuoteStart = do
850972 failIfInQuoteContext InSingleQuote
851973 char '\8216' <|>
@@ -856,11 +978,13 @@ singleQuoteStart = do
856978 -- possess/contraction
857979 return '\'')
858980
981+singleQuoteEnd :: GenParser Char st Char
859982singleQuoteEnd = try $ do
860983 char '\8217' <|> char '\''
861984 notFollowedBy alphaNum
862985 return '\''
863986
987+doubleQuoteStart :: GenParser Char ParserState Char
864988doubleQuoteStart = do
865989 failIfInQuoteContext InDoubleQuote
866990 char '\8220' <|>
@@ -868,29 +992,39 @@ doubleQuoteStart = do
868992 notFollowedBy (oneOf " \t\n")
869993 return '"')
870994
995+doubleQuoteEnd :: GenParser Char st Char
871996doubleQuoteEnd = char '\8221' <|> char '"'
872997
998+ellipses :: GenParser Char st Inline
873999ellipses = oneOfStrings ["...", " . . . ", ". . .", " . . ."] >> return Ellipses
8741000
1001+dash :: GenParser Char st Inline
8751002dash = enDash <|> emDash
8761003
1004+enDash :: GenParser Char st Inline
8771005enDash = try $ char '-' >> notFollowedBy (noneOf "0123456789") >> return EnDash
8781006
1007+emDash :: GenParser Char st Inline
8791008emDash = oneOfStrings ["---", "--"] >> return EmDash
8801009
1010+whitespace :: GenParser Char ParserState Inline
8811011whitespace = do
8821012 sps <- many1 (oneOf spaceChars)
8831013 if length sps >= 2
8841014 then option Space (endline >> return LineBreak)
8851015 else return Space <?> "whitespace"
8861016
1017+nonEndline :: GenParser Char st Char
8871018nonEndline = satisfy (/='\n')
8881019
1020+strChar :: GenParser Char st Char
8891021strChar = noneOf (specialChars ++ spaceChars ++ "\n")
8901022
1023+str :: GenParser Char st Inline
8911024str = many1 strChar >>= return . Str
8921025
8931026-- an endline character that can be treated as a space, not a structural break
1027+endline :: GenParser Char ParserState Inline
8941028endline = try $ do
8951029 newline
8961030 notFollowedBy blankline
@@ -911,11 +1045,13 @@ endline = try $ do
9111045--
9121046
9131047-- a reference label for a link
1048+reference :: GenParser Char ParserState [Inline]
9141049reference = do notFollowedBy' (string "[^") -- footnote reference
9151050 result <- inlinesInBalancedBrackets inlineNonLink
9161051 return $ normalizeSpaces result
9171052
9181053-- source for a link, with optional title
1054+source :: GenParser Char st (String, [Char])
9191055source =
9201056 (try $ charsInBalanced '(' ')' >>= parseFromString source') <|>
9211057 -- the following is needed for cases like: [ref](/url(a).
@@ -923,6 +1059,7 @@ source =
9231059 parseFromString source')
9241060
9251061-- auxiliary function for source
1062+source' :: GenParser Char st (String, [Char])
9261063source' = do
9271064 skipSpaces
9281065 src <- try (char '<' >>
@@ -934,6 +1071,7 @@ source' = do
9341071 eof
9351072 return (removeTrailingSpace src, tit)
9361073
1074+linkTitle :: GenParser Char st String
9371075linkTitle = try $ do
9381076 (many1 spaceChar >> option '\n' newline) <|> newline
9391077 skipSpaces
@@ -942,24 +1080,28 @@ linkTitle = try $ do
9421080 (try (char delim >> skipSpaces >> eof))
9431081 return $ decodeCharacterReferences tit
9441082
1083+link :: GenParser Char ParserState Inline
9451084link = try $ do
946− label <- reference
947− src <- source <|> referenceLink label
1085+ lab <- reference
1086+ src <- source <|> referenceLink lab
9481087 sanitize <- getState >>= return . stateSanitizeHTML
9491088 if sanitize && unsanitaryURI (fst src)
9501089 then fail "Unsanitary URI"
951− else return $ Link label src
1090+ else return $ Link lab src
9521091
9531092-- a link like [this][ref] or [this][] or [this]
954−referenceLink label = do
1093+referenceLink :: [Inline]
1094+ -> GenParser Char ParserState (String, [Char])
1095+referenceLink lab = do
9551096 ref <- option [] (try (optional (char ' ') >>
9561097 optional (newline >> skipSpaces) >> reference))
957− let ref' = if null ref then label else ref
1098+ let ref' = if null ref then lab else ref
9581099 state <- getState
9591100 case lookupKeySrc (stateKeys state) ref' of
9601101 Nothing -> fail "no corresponding key"
9611102 Just target -> return target
9621103
1104+autoLink :: GenParser Char ParserState Inline
9631105autoLink = try $ do
9641106 char '<'
9651107 src <- uri <|> (emailAddress >>= (return . ("mailto:" ++)))
@@ -975,11 +1117,13 @@ autoLink = try $ do
9751117 then Link [Str src'] (src, "")
9761118 else Link [Code src'] (src, "")
9771119
1120+image :: GenParser Char ParserState Inline
9781121image = try $ do
9791122 char '!'
980− (Link label src) <- link
981− return $ Image label src
1123+ (Link lab src) <- link
1124+ return $ Image lab src
9821125
1126+note :: GenParser Char ParserState Inline
9831127note = try $ do
9841128 failIfStrict
9851129 ref <- noteMarker
@@ -989,14 +1133,17 @@ note = try $ do
9891133 Nothing -> fail "note not found"
9901134 Just contents -> return $ Note contents
9911135
1136+inlineNote :: GenParser Char ParserState Inline
9921137inlineNote = try $ do
9931138 failIfStrict
9941139 char '^'
9951140 contents <- inlinesInBalancedBrackets inline
9961141 return $ Note [Para contents]
9971142
1143+rawLaTeXInline' :: GenParser Char ParserState Inline
9981144rawLaTeXInline' = failIfStrict >> rawLaTeXInline
9991145
1146+rawHtmlInline' :: GenParser Char ParserState Inline
10001147rawHtmlInline' = do
10011148 st <- getState
10021149 result <- if stateStrict st