@@ -47,30 +47,40 @@ import Text.ParserCombinators.Parsec
48-- | Read markdown from an input string and return a Pandoc document.
48-- | Read markdown from an input string and return a Pandoc document.
49readMarkdown :: ParserState -> String -> Pandoc
49readMarkdown :: ParserState -> String -> Pandoc
50−readMarkdown state str = (readWith parseMarkdown) state (str ++ "\n\n")
50+readMarkdown state s = (readWith parseMarkdown) state (s ++ "\n\n")
53-- Constants and data structure definitions
53-- Constants and data structure definitions
56spaceChars = " \t"
57spaceChars = " \t"
59+bulletListMarkers :: [Char]
57bulletListMarkers = "*+-"
60bulletListMarkers = "*+-"
58hruleChars = "*-_"
63hruleChars = "*-_"
65+setextHChars :: [Char]
59setextHChars = "=-"
66setextHChars = "=-"
61-- treat these as potentially non-text when parsing inline:
68-- treat these as potentially non-text when parsing inline:
69+specialChars :: [Char]
62specialChars = "\\[]*_~`<>$!^-.&'\"\8216\8217\8220\8221"
70specialChars = "\\[]*_~`<>$!^-.&'\"\8216\8217\8220\8221"
65-- auxiliary functions
73-- auxiliary functions
76+indentSpaces :: GenParser Char ParserState [Char]
68indentSpaces = try $ do
77indentSpaces = try $ do
69 state <- getState
78 state <- getState
70 let tabStop = stateTabStop state
79 let tabStop = stateTabStop state
71 try (count tabStop (char ' ')) <|>
80 try (count tabStop (char ' ')) <|>
72 (many (char ' ') >> string "\t") <?> "indentation"
81 (many (char ' ') >> string "\t") <?> "indentation"
83+nonindentSpaces :: GenParser Char ParserState [Char]
74nonindentSpaces = do
84nonindentSpaces = do
75 state <- getState
85 state <- getState
76 let tabStop = stateTabStop state
86 let tabStop = stateTabStop state
@@ -80,11 +90,13 @@ nonindentSpaces = do
80 else unexpected "indented line"
90 else unexpected "indented line"
82-- | Fail unless we're at beginning of a line.
92-- | Fail unless we're at beginning of a line.
93+failUnlessBeginningOfLine :: GenParser tok st ()
83failUnlessBeginningOfLine = do
94failUnlessBeginningOfLine = do
84 pos <- getPosition
95 pos <- getPosition
85 if sourceColumn pos == 1 then return () else fail "not beginning of line"
96 if sourceColumn pos == 1 then return () else fail "not beginning of line"
87-- | Fail unless we're in "smart typography" mode.
98-- | Fail unless we're in "smart typography" mode.
99+failUnlessSmart :: GenParser tok ParserState ()
88failUnlessSmart = do
100failUnlessSmart = do
89 state <- getState
101 state <- getState
90 if stateSmart state then return () else fail "Smart typography feature"
102 if stateSmart state then return () else fail "Smart typography feature"
@@ -109,8 +121,10 @@ inlinesInBalancedBrackets parser = try $ do
109-- document structure
121-- document structure
124+titleLine :: GenParser Char ParserState [Inline]
112titleLine = try $ char '%' >> skipSpaces >> manyTill inline newline
125titleLine = try $ char '%' >> skipSpaces >> manyTill inline newline
127+authorsLine :: GenParser Char st [String]
114authorsLine = try $ do
128authorsLine = try $ do
116 skipSpaces
130 skipSpaces
@@ -118,6 +132,7 @@ authorsLine = try $ do
119 return $ map (decodeCharacterReferences . removeLeadingTrailingSpace) authors
133 return $ map (decodeCharacterReferences . removeLeadingTrailingSpace) authors
135+dateLine :: GenParser Char st String
121dateLine = try $ do
136dateLine = try $ do
123 skipSpaces
138 skipSpaces
@@ -125,6 +140,7 @@ dateLine = try $ do
126 return $ decodeCharacterReferences $ removeTrailingSpace date
141 return $ decodeCharacterReferences $ removeTrailingSpace date
143+titleBlock :: GenParser Char ParserState ([Inline], [String], [Char])
128titleBlock = try $ do
144titleBlock = try $ do
129 failIfStrict
145 failIfStrict
130 title <- option [] titleLine
146 title <- option [] titleLine
@@ -133,6 +149,7 @@ titleBlock = try $ do
133 optional blanklines
149 optional blanklines
134 return (title, author, date)
150 return (title, author, date)
152+parseMarkdown :: GenParser Char ParserState Pandoc
136parseMarkdown = do
153parseMarkdown = do
137 -- markdown allows raw HTML
154 -- markdown allows raw HTML
138 updateState (\state -> state { stateParseRaw = True })
155 updateState (\state -> state { stateParseRaw = True })
@@ -149,9 +166,9 @@ parseMarkdown = do
149 then return ()
166 then return ()
150 else do docMinusNotes <- manyTill (noteBlock <|> lineClump) eof >>=
167 else do docMinusNotes <- manyTill (noteBlock <|> lineClump) eof >>=
151 return . concat
168 return . concat
152− st <- getState
169+ st' <- getState
153− let reversedNotes = stateNotes st
170+ let reversedNotes = stateNotes st'
154− updateState $ \st -> st { stateNotes = reverse reversedNotes }
171+ updateState $ \s -> s { stateNotes = reverse reversedNotes }
155 setInput docMinusNotes
172 setInput docMinusNotes
156 setPosition startPos
173 setPosition startPos
157 -- now parse it for real...
174 -- now parse it for real...
@@ -163,10 +180,11 @@ parseMarkdown = do
163-- initial pass for references and notes
180-- initial pass for references and notes
183+referenceKey :: GenParser Char ParserState [Char]
166referenceKey = try $ do
184referenceKey = try $ do
167 startPos <- getPosition
185 startPos <- getPosition
168 nonindentSpaces
186 nonindentSpaces
169− label <- reference
187+ lab <- reference
171 skipSpaces
189 skipSpaces
172 optional (char '<')
190 optional (char '<')
@@ -175,13 +193,14 @@ referenceKey = try $ do
175 tit <- option "" referenceTitle
193 tit <- option "" referenceTitle
176 blanklines
194 blanklines
177 endPos <- getPosition
195 endPos <- getPosition
178− let newkey = (label, (removeTrailingSpace src, tit))
196+ let newkey = (lab, (removeTrailingSpace src, tit))
179 st <- getState
197 st <- getState
180 let oldkeys = stateKeys st
198 let oldkeys = stateKeys st
181− updateState $ \st -> st { stateKeys = newkey : oldkeys }
199+ updateState $ \s -> s { stateKeys = newkey : oldkeys }
182 -- return blanks so line count isn't affected
200 -- return blanks so line count isn't affected
183 return $ replicate (sourceLine endPos - sourceLine startPos) '\n'
201 return $ replicate (sourceLine endPos - sourceLine startPos) '\n'
203+referenceTitle :: GenParser Char st String
185referenceTitle = try $ do
204referenceTitle = try $ do
186 (many1 spaceChar >> option '\n' newline) <|> newline
205 (many1 spaceChar >> option '\n' newline) <|> newline
187 skipSpaces
206 skipSpaces
@@ -191,8 +210,10 @@ referenceTitle = try $ do
191 notFollowedBy (noneOf ")\n")))
210 notFollowedBy (noneOf ")\n")))
192 return $ decodeCharacterReferences tit
211 return $ decodeCharacterReferences tit
213+noteMarker :: GenParser Char st [Char]
194noteMarker = string "[^" >> manyTill (noneOf " \t\n") (char ']')
214noteMarker = string "[^" >> manyTill (noneOf " \t\n") (char ']')
216+rawLine :: GenParser Char ParserState [Char]
196rawLine = do
217rawLine = do
197 notFollowedBy blankline
218 notFollowedBy blankline
198 notFollowedBy' noteMarker
219 notFollowedBy' noteMarker
@@ -200,8 +221,10 @@ rawLine = do
200 end <- option "" (newline >> optional indentSpaces >> return "\n")
221 end <- option "" (newline >> optional indentSpaces >> return "\n")
201 return $ contents ++ end
222 return $ contents ++ end
224+rawLines :: GenParser Char ParserState [Char]
203rawLines = many1 rawLine >>= return . concat
225rawLines = many1 rawLine >>= return . concat
227+noteBlock :: GenParser Char ParserState [Char]
205noteBlock = try $ do
228noteBlock = try $ do
206 startPos <- getPosition
229 startPos <- getPosition
207 ref <- noteMarker
230 ref <- noteMarker
@@ -216,7 +239,7 @@ noteBlock = try $ do
216 let newnote = (ref, contents)
239 let newnote = (ref, contents)
217 st <- getState
240 st <- getState
218 let oldnotes = stateNotes st
241 let oldnotes = stateNotes st
219− updateState $ \st -> st { stateNotes = newnote : oldnotes }
242+ updateState $ \s -> s { stateNotes = newnote : oldnotes }
220 -- return blanks so line count isn't affected
243 -- return blanks so line count isn't affected
221 return $ replicate (sourceLine endPos - sourceLine startPos) '\n'
244 return $ replicate (sourceLine endPos - sourceLine startPos) '\n'
@@ -224,8 +247,10 @@ noteBlock = try $ do
224-- parsing blocks
247-- parsing blocks
250+parseBlocks :: GenParser Char ParserState [Block]
227parseBlocks = manyTill block eof
251parseBlocks = manyTill block eof
253+block :: GenParser Char ParserState Block
229block = do
254block = do
230 st <- getState
255 st <- getState
231 choice (if stateStrict st
256 choice (if stateStrict st
@@ -258,8 +283,10 @@ block = do
258-- header blocks
283-- header blocks
286+header :: GenParser Char ParserState Block
261header = atxHeader <|> setextHeader <?> "header"
287header = atxHeader <|> setextHeader <?> "header"
289+atxHeader :: GenParser Char ParserState Block
263atxHeader = try $ do
290atxHeader = try $ do
264 level <- many1 (char '#') >>= return . length
291 level <- many1 (char '#') >>= return . length
265 notFollowedBy (char '.' <|> char ')') -- this would be a list
292 notFollowedBy (char '.' <|> char ')') -- this would be a list
@@ -267,8 +294,10 @@ atxHeader = try $ do
267 text <- manyTill inline atxClosing >>= return . normalizeSpaces
294 text <- manyTill inline atxClosing >>= return . normalizeSpaces
268 return $ Header level text
295 return $ Header level text
297+atxClosing :: GenParser Char st [Char]
270atxClosing = try $ skipMany (char '#') >> blanklines
298atxClosing = try $ skipMany (char '#') >> blanklines
300+setextHeader :: GenParser Char ParserState Block
272setextHeader = try $ do
301setextHeader = try $ do
273 text <- many1Till inline newline
302 text <- many1Till inline newline
274 underlineChar <- oneOf setextHChars
303 underlineChar <- oneOf setextHChars
@@ -281,6 +310,7 @@ setextHeader = try $ do
281-- hrule block
310-- hrule block
313+hrule :: GenParser Char st Block
284hrule = try $ do
314hrule = try $ do
285 skipSpaces
315 skipSpaces
286 start <- oneOf hruleChars
316 start <- oneOf hruleChars
@@ -294,8 +324,11 @@ hrule = try $ do
294-- code blocks
324-- code blocks
327+indentedLine :: GenParser Char ParserState [Char]
297indentedLine = indentSpaces >> manyTill anyChar newline >>= return . (++ "\n")
328indentedLine = indentSpaces >> manyTill anyChar newline >>= return . (++ "\n")
330+codeBlockDelimiter :: Maybe Int
331+ -> GenParser Char st (Int, ([Char], [[Char]], [([Char], [Char])]))
299codeBlockDelimiter len = try $ do
332codeBlockDelimiter len = try $ do
300 size <- case len of
333 size <- case len of
301 Just l -> count l (char '~') >> many (char '~') >> return l
334 Just l -> count l (char '~') >> many (char '~') >> return l
@@ -306,32 +339,38 @@ codeBlockDelimiter len = try $ do
306 blankline
339 blankline
307 return (size, attr)
340 return (size, attr)
342+attributes :: GenParser Char st ([Char], [[Char]], [([Char], [Char])])
309attributes = try $ do
343attributes = try $ do
311 many spaceChar
345 many spaceChar
312 attrs <- many (attribute >>~ many spaceChar)
346 attrs <- many (attribute >>~ many spaceChar)
314 let (ids, classes, keyvals) = unzip3 attrs
348 let (ids, classes, keyvals) = unzip3 attrs
315− let id = if null ids then "" else head ids
349+ let id' = if null ids then "" else head ids
316− return (id, concat classes, concat keyvals)
350+ return (id', concat classes, concat keyvals)
352+attribute :: GenParser Char st ([Char], [[Char]], [([Char], [Char])])
318attribute = identifierAttr <|> classAttr <|> keyValAttr
353attribute = identifierAttr <|> classAttr <|> keyValAttr
355+identifier :: GenParser Char st [Char]
320identifier = do
356identifier = do
321 first <- letter
357 first <- letter
322 rest <- many alphaNum
358 rest <- many alphaNum
323 return (first:rest)
359 return (first:rest)
361+identifierAttr :: GenParser Char st ([Char], [a], [a1])
325identifierAttr = try $ do
362identifierAttr = try $ do
327 result <- identifier
364 result <- identifier
328 return (result,[],[])
365 return (result,[],[])
367+classAttr :: GenParser Char st ([Char], [[Char]], [a])
330classAttr = try $ do
368classAttr = try $ do
332 result <- identifier
370 result <- identifier
333 return ("",[result],[])
371 return ("",[result],[])
373+keyValAttr :: GenParser Char st ([Char], [a], [([Char], [Char])])
335keyValAttr = try $ do
374keyValAttr = try $ do
336 key <- identifier
375 key <- identifier
@@ -339,12 +378,14 @@ keyValAttr = try $ do
339 val <- manyTill (noneOf "\n") (char '"')
378 val <- manyTill (noneOf "\n") (char '"')
340 return ("",[],[(key,val)])
379 return ("",[],[(key,val)])
381+codeBlockDelimited :: GenParser Char st Block
342codeBlockDelimited = try $ do
382codeBlockDelimited = try $ do
343 (size, attr) <- codeBlockDelimiter Nothing
383 (size, attr) <- codeBlockDelimiter Nothing
344 contents <- manyTill anyLine (codeBlockDelimiter (Just size))
384 contents <- manyTill anyLine (codeBlockDelimiter (Just size))
345 blanklines
385 blanklines
346 return $ CodeBlock attr $ joinWithSep "\n" contents
386 return $ CodeBlock attr $ joinWithSep "\n" contents
388+codeBlockIndented :: GenParser Char ParserState Block
348codeBlockIndented = do
389codeBlockIndented = do
349 contents <- many1 (indentedLine <|>
390 contents <- many1 (indentedLine <|>
350 try (do b <- blanklines
391 try (do b <- blanklines
@@ -357,8 +398,10 @@ codeBlockIndented = do
357-- block quotes
398-- block quotes
401+emailBlockQuoteStart :: GenParser Char ParserState Char
360emailBlockQuoteStart = try $ nonindentSpaces >> char '>' >>~ optional (char ' ')
402emailBlockQuoteStart = try $ nonindentSpaces >> char '>' >>~ optional (char ' ')
404+emailBlockQuote :: GenParser Char ParserState [[Char]]
362emailBlockQuote = try $ do
405emailBlockQuote = try $ do
363 emailBlockQuoteStart
406 emailBlockQuoteStart
364 raw <- sepBy (many (nonEndline <|>
407 raw <- sepBy (many (nonEndline <|>
@@ -369,6 +412,7 @@ emailBlockQuote = try $ do
369 optional blanklines
412 optional blanklines
370 return raw
413 return raw
415+blockQuote :: GenParser Char ParserState Block
372blockQuote = do
416blockQuote = do
373 raw <- emailBlockQuote
417 raw <- emailBlockQuote
374 -- parse the extracted block, which may contain various block elements:
418 -- parse the extracted block, which may contain various block elements:
@@ -379,6 +423,7 @@ blockQuote = do
379-- list blocks
423-- list blocks
426+bulletListStart :: GenParser Char ParserState ()
382bulletListStart = try $ do
427bulletListStart = try $ do
383 optional newline -- if preceded by a Plain block in a list context
428 optional newline -- if preceded by a Plain block in a list context
384 nonindentSpaces
429 nonindentSpaces
@@ -387,6 +432,7 @@ bulletListStart = try $ do
387 spaceChar
432 spaceChar
388 skipSpaces
433 skipSpaces
435+anyOrderedListStart :: GenParser Char ParserState (Int, ListNumberStyle, ListNumberDelim)
390anyOrderedListStart = try $ do
436anyOrderedListStart = try $ do
391 optional newline -- if preceded by a Plain block in a list context
437 optional newline -- if preceded by a Plain block in a list context
392 nonindentSpaces
438 nonindentSpaces
@@ -399,6 +445,9 @@ anyOrderedListStart = try $ do
399 return (1, DefaultStyle, DefaultDelim)
445 return (1, DefaultStyle, DefaultDelim)
400 else anyOrderedListMarker >>~ spaceChar
446 else anyOrderedListMarker >>~ spaceChar
448+orderedListStart :: ListNumberStyle
450+ -> GenParser Char ParserState ()
402orderedListStart style delim = try $ do
451orderedListStart style delim = try $ do
403 optional newline -- if preceded by a Plain block in a list context
452 optional newline -- if preceded by a Plain block in a list context
404 nonindentSpaces
453 nonindentSpaces
@@ -415,6 +464,8 @@ orderedListStart style delim = try $ do
415 skipSpaces
464 skipSpaces
417-- parse a line of a list item (start = parser for beginning of list item)
466-- parse a line of a list item (start = parser for beginning of list item)
467+listLine :: GenParser Char ParserState ()
468+ -> GenParser Char ParserState [Char]
418listLine start = try $ do
469listLine start = try $ do
419 notFollowedBy' start
470 notFollowedBy' start
420 notFollowedBy blankline
471 notFollowedBy blankline
@@ -425,6 +476,8 @@ listLine start = try $ do
425 return $ line ++ "\n"
476 return $ line ++ "\n"
427-- parse raw text for one list item, excluding start marker and continuations
478-- parse raw text for one list item, excluding start marker and continuations
479+rawListItem :: GenParser Char ParserState ()
480+ -> GenParser Char ParserState [Char]
428rawListItem start = try $ do
481rawListItem start = try $ do
430 result <- many1 (listLine start)
483 result <- many1 (listLine start)
@@ -434,12 +487,15 @@ rawListItem start = try $ do
434-- continuation of a list item - indented and separated by blankline
487-- continuation of a list item - indented and separated by blankline
435-- or (in compact lists) endline.
488-- or (in compact lists) endline.
436-- note: nested lists are parsed as continuations
489-- note: nested lists are parsed as continuations
490+listContinuation :: GenParser Char ParserState () -> GenParser Char ParserState [Char]
437listContinuation start = try $ do
491listContinuation start = try $ do
438 lookAhead indentSpaces
492 lookAhead indentSpaces
439 result <- many1 (listContinuationLine start)
493 result <- many1 (listContinuationLine start)
440 blanks <- many blankline
494 blanks <- many blankline
441 return $ concat result ++ blanks
495 return $ concat result ++ blanks
497+listContinuationLine :: GenParser Char ParserState ()
498+ -> GenParser Char ParserState [Char]
443listContinuationLine start = try $ do
499listContinuationLine start = try $ do
444 notFollowedBy blankline
500 notFollowedBy blankline
445 notFollowedBy' start
501 notFollowedBy' start
@@ -447,6 +503,8 @@ listContinuationLine start = try $ do
447 result <- manyTill anyChar newline
503 result <- manyTill anyChar newline
448 return $ result ++ "\n"
504 return $ result ++ "\n"
506+listItem :: GenParser Char ParserState ()
507+ -> GenParser Char ParserState [Block]
450listItem start = try $ do
508listItem start = try $ do
451 first <- rawListItem start
509 first <- rawListItem start
452 continuations <- many (listContinuation start)
510 continuations <- many (listContinuation start)
@@ -462,16 +520,19 @@ listItem start = try $ do
462 updateState (\st -> st {stateParserContext = oldContext})
520 updateState (\st -> st {stateParserContext = oldContext})
463 return contents
521 return contents
523+orderedList :: GenParser Char ParserState Block
465orderedList = try $ do
524orderedList = try $ do
466 (start, style, delim) <- lookAhead anyOrderedListStart
525 (start, style, delim) <- lookAhead anyOrderedListStart
467 items <- many1 (listItem (orderedListStart style delim))
526 items <- many1 (listItem (orderedListStart style delim))
468 return $ OrderedList (start, style, delim) $ compactify items
527 return $ OrderedList (start, style, delim) $ compactify items
529+bulletList :: GenParser Char ParserState Block
470bulletList = many1 (listItem bulletListStart) >>=
530bulletList = many1 (listItem bulletListStart) >>=
471 return . BulletList . compactify
531 return . BulletList . compactify
473-- definition lists
533-- definition lists
535+definitionListItem :: GenParser Char ParserState ([Inline], [Block])
475definitionListItem = try $ do
536definitionListItem = try $ do
476 notFollowedBy blankline
537 notFollowedBy blankline
477 notFollowedBy' indentSpaces
538 notFollowedBy' indentSpaces
@@ -486,6 +547,7 @@ definitionListItem = try $ do
486 updateState (\st -> st {stateParserContext = oldContext})
547 updateState (\st -> st {stateParserContext = oldContext})
487 return ((normalizeSpaces term), contents)
548 return ((normalizeSpaces term), contents)
550+defRawBlock :: GenParser Char ParserState [Char]
489defRawBlock = try $ do
551defRawBlock = try $ do
491 state <- getState
553 state <- getState
@@ -496,6 +558,7 @@ defRawBlock = try $ do
496 trailing <- option "" blanklines
558 trailing <- option "" blanklines
497 return $ firstline ++ "\n" ++ unlines rawlines ++ trailing
559 return $ firstline ++ "\n" ++ unlines rawlines ++ trailing
561+definitionList :: GenParser Char ParserState Block
499definitionList = do
562definitionList = do
500 items <- many1 definitionListItem
563 items <- many1 definitionListItem
501 let (terms, defs) = unzip items
564 let (terms, defs) = unzip items
@@ -507,11 +570,13 @@ definitionList = do
507-- paragraph block
570-- paragraph block
573+isHtmlOrBlank :: Inline -> Bool
510isHtmlOrBlank (HtmlInline _) = True
574isHtmlOrBlank (HtmlInline _) = True
511−isHtmlOrBlank (Space) = True
575+isHtmlOrBlank (Space) = True
512−isHtmlOrBlank (LineBreak) = True
576+isHtmlOrBlank (LineBreak) = True
513−isHtmlOrBlank _ = False
577+isHtmlOrBlank _ = False
579+para :: GenParser Char ParserState Block
515para = try $ do
580para = try $ do
516 result <- many1 inline
581 result <- many1 inline
517 if all isHtmlOrBlank result
582 if all isHtmlOrBlank result
@@ -524,14 +589,17 @@ para = try $ do
524 else pzero
589 else pzero
525 return $ Para $ normalizeSpaces result
590 return $ Para $ normalizeSpaces result
592+plain :: GenParser Char ParserState Block
527plain = many1 inline >>= return . Plain . normalizeSpaces
593plain = many1 inline >>= return . Plain . normalizeSpaces
530-- raw html
596-- raw html
599+htmlElement :: GenParser Char ParserState [Char]
533htmlElement = strictHtmlBlock <|> htmlBlockElement <?> "html element"
600htmlElement = strictHtmlBlock <|> htmlBlockElement <?> "html element"
602+htmlBlock :: GenParser Char ParserState Block
535htmlBlock = try $ do
603htmlBlock = try $ do
536 failUnlessBeginningOfLine
604 failUnlessBeginningOfLine
537 first <- htmlElement
605 first <- htmlElement
@@ -540,9 +608,11 @@ htmlBlock = try $ do
540 return $ RawHtml $ first ++ finalSpace ++ finalNewlines
608 return $ RawHtml $ first ++ finalSpace ++ finalNewlines
542-- True if tag is self-closing
610-- True if tag is self-closing
611+isSelfClosing :: [Char] -> Bool
543isSelfClosing tag =
612isSelfClosing tag =
544 isSuffixOf "/>" $ filter (not . (`elem` " \n\t")) tag
613 isSuffixOf "/>" $ filter (not . (`elem` " \n\t")) tag
615+strictHtmlBlock :: GenParser Char ParserState [Char]
546strictHtmlBlock = try $ do
616strictHtmlBlock = try $ do
547 tag <- anyHtmlBlockTag
617 tag <- anyHtmlBlockTag
548 let tag' = extractTagType tag
618 let tag' = extractTagType tag
@@ -553,6 +623,7 @@ strictHtmlBlock = try $ do
553 end <- htmlEndTag tag'
623 end <- htmlEndTag tag'
554 return $ tag ++ concat contents ++ end
624 return $ tag ++ concat contents ++ end
626+rawHtmlBlocks :: GenParser Char ParserState Block
556rawHtmlBlocks = do
627rawHtmlBlocks = do
557 htmlBlocks <- many1 $ do (RawHtml blk) <- rawHtmlBlock
628 htmlBlocks <- many1 $ do (RawHtml blk) <- rawHtmlBlock
558 sps <- do sp1 <- many spaceChar
629 sps <- do sp1 <- many spaceChar
@@ -574,6 +645,8 @@ rawHtmlBlocks = do
575-- Parse a dashed line with optional trailing spaces; return its length
646-- Parse a dashed line with optional trailing spaces; return its length
576-- and the length including trailing space.
647-- and the length including trailing space.
649+ -> GenParser Char st (Int, Int)
577dashedLine ch = do
650dashedLine ch = do
578 dashes <- many1 (char ch)
651 dashes <- many1 (char ch)
579 sp <- many spaceChar
652 sp <- many spaceChar
@@ -581,24 +654,29 @@ dashedLine ch = do
582-- Parse a table header with dashed lines of '-' preceded by
655-- Parse a table header with dashed lines of '-' preceded by
583-- one line of text.
656-- one line of text.
657+simpleTableHeader :: GenParser Char ParserState ([[Char]], [Alignment], [Int])
584simpleTableHeader = try $ do
658simpleTableHeader = try $ do
585 rawContent <- anyLine
659 rawContent <- anyLine
586 initSp <- nonindentSpaces
660 initSp <- nonindentSpaces
587 dashes <- many1 (dashedLine '-')
661 dashes <- many1 (dashedLine '-')
589− let (lengths, lines) = unzip dashes
663+ let (lengths, lines') = unzip dashes
590− let indices = scanl (+) (length initSp) lines
664+ let indices = scanl (+) (length initSp) lines'
591 let rawHeads = tail $ splitByIndices (init indices) rawContent
665 let rawHeads = tail $ splitByIndices (init indices) rawContent
592 let aligns = zipWith alignType (map (\a -> [a]) rawHeads) lengths
666 let aligns = zipWith alignType (map (\a -> [a]) rawHeads) lengths
593 return (rawHeads, aligns, indices)
667 return (rawHeads, aligns, indices)
595-- Parse a table footer - dashed lines followed by blank line.
669-- Parse a table footer - dashed lines followed by blank line.
670+tableFooter :: GenParser Char ParserState [Char]
596tableFooter = try $ nonindentSpaces >> many1 (dashedLine '-') >> blanklines
671tableFooter = try $ nonindentSpaces >> many1 (dashedLine '-') >> blanklines
598-- Parse a table separator - dashed line.
673-- Parse a table separator - dashed line.
674+tableSep :: GenParser Char ParserState String
599tableSep = try $ nonindentSpaces >> many1 (dashedLine '-') >> string "\n"
675tableSep = try $ nonindentSpaces >> many1 (dashedLine '-') >> string "\n"
601-- Parse a raw line and split it into chunks by indices.
677-- Parse a raw line and split it into chunks by indices.
678+rawTableLine :: [Int]
679+ -> GenParser Char ParserState [String]
602rawTableLine indices = do
680rawTableLine indices = do
603 notFollowedBy' (blanklines <|> tableFooter)
681 notFollowedBy' (blanklines <|> tableFooter)
604 line <- many1Till anyChar newline
682 line <- many1Till anyChar newline
@@ -606,9 +684,13 @@ rawTableLine indices = do
606 splitByIndices (init indices) line
684 splitByIndices (init indices) line
608-- Parse a table line and return a list of lists of blocks (columns).
686-- Parse a table line and return a list of lists of blocks (columns).
688+ -> GenParser Char ParserState [[Block]]
609tableLine indices = rawTableLine indices >>= mapM (parseFromString (many plain))
689tableLine indices = rawTableLine indices >>= mapM (parseFromString (many plain))
611-- Parse a multiline table row and return a list of blocks (columns).
691-- Parse a multiline table row and return a list of blocks (columns).
692+multilineRow :: [Int]
693+ -> GenParser Char ParserState [[Block]]
612multilineRow indices = do
694multilineRow indices = do
613 colLines <- many1 (rawTableLine indices)
695 colLines <- many1 (rawTableLine indices)
614 optional blanklines
696 optional blanklines
@@ -631,6 +713,7 @@ widthsFromIndices numColumns indices =
632-- Parses a table caption: inlines beginning with 'Table:'
714-- Parses a table caption: inlines beginning with 'Table:'
633-- and followed by blank lines.
715-- and followed by blank lines.
716+tableCaption :: GenParser Char ParserState [Inline]
634tableCaption = try $ do
717tableCaption = try $ do
635 nonindentSpaces
718 nonindentSpaces
636 string "Table:"
719 string "Table:"
@@ -639,33 +722,40 @@ tableCaption = try $ do
639 return $ normalizeSpaces result
722 return $ normalizeSpaces result
641-- Parse a table using 'headerParser', 'lineParser', and 'footerParser'.
724-- 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
642tableWith headerParser lineParser footerParser = try $ do
729tableWith headerParser lineParser footerParser = try $ do
643 (rawHeads, aligns, indices) <- headerParser
730 (rawHeads, aligns, indices) <- headerParser
644− lines <- many1Till (lineParser indices) footerParser
731+ lines' <- many1Till (lineParser indices) footerParser
645 caption <- option [] tableCaption
732 caption <- option [] tableCaption
646 heads <- mapM (parseFromString (many plain)) rawHeads
733 heads <- mapM (parseFromString (many plain)) rawHeads
647 state <- getState
734 state <- getState
648 let numColumns = stateColumns state
735 let numColumns = stateColumns state
649 let widths = widthsFromIndices numColumns indices
736 let widths = widthsFromIndices numColumns indices
650− return $ Table caption aligns widths heads lines
737+ return $ Table caption aligns widths heads lines'
652-- Parse a simple table with '---' header and one line per row.
739-- Parse a simple table with '---' header and one line per row.
740+simpleTable :: GenParser Char ParserState Block
653simpleTable = tableWith simpleTableHeader tableLine blanklines
741simpleTable = tableWith simpleTableHeader tableLine blanklines
655-- Parse a multiline table: starts with row of '-' on top, then header
743-- Parse a multiline table: starts with row of '-' on top, then header
656-- (which may be multiline), then the rows,
744-- (which may be multiline), then the rows,
657-- which may be multiline, separated by blank lines, and
745-- which may be multiline, separated by blank lines, and
658-- ending with a footer (dashed line followed by blank line).
746-- ending with a footer (dashed line followed by blank line).
747+multilineTable :: GenParser Char ParserState Block
659multilineTable = tableWith multilineTableHeader multilineRow tableFooter
748multilineTable = tableWith multilineTableHeader multilineRow tableFooter
750+multilineTableHeader :: GenParser Char ParserState ([String], [Alignment], [Int])
661multilineTableHeader = try $ do
751multilineTableHeader = try $ do
662 tableSep
752 tableSep
663 rawContent <- many1 (notFollowedBy' tableSep >> many1Till anyChar newline)
753 rawContent <- many1 (notFollowedBy' tableSep >> many1Till anyChar newline)
664 initSp <- nonindentSpaces
754 initSp <- nonindentSpaces
665 dashes <- many1 (dashedLine '-')
755 dashes <- many1 (dashedLine '-')
667− let (lengths, lines) = unzip dashes
757+ let (lengths, lines') = unzip dashes
668− let indices = scanl (+) (length initSp) lines
758+ let indices = scanl (+) (length initSp) lines'
669 let rawHeadsList = transpose $ map
759 let rawHeadsList = transpose $ map
670 (\ln -> tail $ splitByIndices (init indices) ln)
760 (\ln -> tail $ splitByIndices (init indices) ln)
671 rawContent
761 rawContent
@@ -676,27 +766,32 @@ multilineTableHeader = try $ do
676-- Returns an alignment type for a table, based on a list of strings
766-- Returns an alignment type for a table, based on a list of strings
677-- (the rows of the column header) and a number (the length of the
767-- (the rows of the column header) and a number (the length of the
678-- dashed line under the rows.
768-- dashed line under the rows.
679−alignType :: [String] -> Int -> Alignment
769+alignType :: [String]
680−alignType [] len = AlignDefault
772+alignType [] _ = AlignDefault
681alignType strLst len =
773alignType strLst len =
682− let str = head $ sortBy (comparing length) $
774+ let s = head $ sortBy (comparing length) $
683 map removeTrailingSpace strLst
775 map removeTrailingSpace strLst
684− leftSpace = if null str then False else (str !! 0) `elem` " \t"
776+ leftSpace = if null s then False else (s !! 0) `elem` " \t"
685− rightSpace = length str < len || (str !! (len - 1)) `elem` " \t"
777+ rightSpace = length s < len || (s !! (len - 1)) `elem` " \t"
686 in case (leftSpace, rightSpace) of
778 in case (leftSpace, rightSpace) of
687 (True, False) -> AlignRight
779 (True, False) -> AlignRight
688 (False, True) -> AlignLeft
780 (False, True) -> AlignLeft
689 (True, True) -> AlignCenter
781 (True, True) -> AlignCenter
690 (False, False) -> AlignDefault
782 (False, False) -> AlignDefault
784+table :: GenParser Char ParserState Block
692table = simpleTable <|> multilineTable <?> "table"
785table = simpleTable <|> multilineTable <?> "table"
791+inline :: GenParser Char ParserState Inline
698inline = choice inlineParsers <?> "inline"
792inline = choice inlineParsers <?> "inline"
794+inlineParsers :: [GenParser Char ParserState Inline]
700inlineParsers = [ abbrev
795inlineParsers = [ abbrev
702 , smartPunctuation
797 , smartPunctuation
@@ -721,13 +816,16 @@ inlineParsers = [ abbrev
722 , ltSign ]
817 , ltSign ]
819+inlineNonLink :: GenParser Char ParserState Inline
724inlineNonLink = (choice $
820inlineNonLink = (choice $
725 map (\parser -> try (parser >>= failIfLink)) inlineParsers)
821 map (\parser -> try (parser >>= failIfLink)) inlineParsers)
726 <?> "inline (non-link)"
822 <?> "inline (non-link)"
824+failIfLink :: Inline -> GenParser tok st Inline
728failIfLink (Link _ _) = pzero
825failIfLink (Link _ _) = pzero
729−failIfLink elt = return elt
826+failIfLink elt = return elt
828+escapedChar :: GenParser Char ParserState Inline
731escapedChar = do
829escapedChar = do
732 char '\\'
830 char '\\'
733 state <- getState
831 state <- getState
@@ -739,6 +837,7 @@ escapedChar = do
739 else result
837 else result
740 return $ Str [result']
838 return $ Str [result']
840+ltSign :: GenParser Char ParserState Inline
742ltSign = do
841ltSign = do
743 st <- getState
842 st <- getState
744 if stateStrict st
843 if stateStrict st
@@ -746,13 +845,16 @@ ltSign = do
746 else notFollowedBy' rawHtmlBlocks >> char '<' -- unless it starts html
845 else notFollowedBy' rawHtmlBlocks >> char '<' -- unless it starts html
747 return $ Str ['<']
846 return $ Str ['<']
848+specialCharsMinusLt :: [Char]
749specialCharsMinusLt = filter (/= '<') specialChars
849specialCharsMinusLt = filter (/= '<') specialChars
851+symbol :: GenParser Char ParserState Inline
751symbol = do
852symbol = do
752 result <- oneOf specialCharsMinusLt
853 result <- oneOf specialCharsMinusLt
753 return $ Str [result]
854 return $ Str [result]
755-- parses inline code, between n `s and n `s
856-- parses inline code, between n `s and n `s
857+code :: GenParser Char ParserState Inline
756code = try $ do
858code = try $ do
757 starts <- many1 (char '`')
859 starts <- many1 (char '`')
758 skipSpaces
860 skipSpaces
@@ -762,43 +864,52 @@ code = try $ do
762 notFollowedBy (char '`')))
864 notFollowedBy (char '`')))
763 return $ Code $ removeLeadingTrailingSpace $ concat result
865 return $ Code $ removeLeadingTrailingSpace $ concat result
867+mathWord :: GenParser Char st [Char]
765mathWord = many1 ((noneOf " \t\n\\$") <|>
868mathWord = many1 ((noneOf " \t\n\\$") <|>
766 (try (char '\\') >>~ notFollowedBy (char '$')))
869 (try (char '\\') >>~ notFollowedBy (char '$')))
871+math :: GenParser Char ParserState Inline
768math = try $ do
872math = try $ do
769 failIfStrict
873 failIfStrict
771 notFollowedBy space
875 notFollowedBy space
772− words <- sepBy1 mathWord (many1 space)
876+ words' <- sepBy1 mathWord (many1 space)
774− return $ Math $ joinWithSep " " words
878+ return $ Math $ joinWithSep " " words'
880+emph :: GenParser Char ParserState Inline
776emph = ((enclosed (char '*') (notFollowedBy' strong >> char '*') inline) <|>
881emph = ((enclosed (char '*') (notFollowedBy' strong >> char '*') inline) <|>
777 (enclosed (char '_') (notFollowedBy' strong >> char '_' >>
882 (enclosed (char '_') (notFollowedBy' strong >> char '_' >>
778 notFollowedBy alphaNum) inline)) >>=
883 notFollowedBy alphaNum) inline)) >>=
779 return . Emph . normalizeSpaces
884 return . Emph . normalizeSpaces
886+strong :: GenParser Char ParserState Inline
781strong = ((enclosed (string "**") (try $ string "**") inline) <|>
887strong = ((enclosed (string "**") (try $ string "**") inline) <|>
782 (enclosed (string "__") (try $ string "__") inline)) >>=
888 (enclosed (string "__") (try $ string "__") inline)) >>=
783 return . Strong . normalizeSpaces
889 return . Strong . normalizeSpaces
891+strikeout :: GenParser Char ParserState Inline
785strikeout = failIfStrict >> enclosed (string "~~") (try $ string "~~") inline >>=
892strikeout = failIfStrict >> enclosed (string "~~") (try $ string "~~") inline >>=
786 return . Strikeout . normalizeSpaces
893 return . Strikeout . normalizeSpaces
895+superscript :: GenParser Char ParserState Inline
788superscript = failIfStrict >> enclosed (char '^') (char '^')
896superscript = failIfStrict >> enclosed (char '^') (char '^')
789 (notFollowedBy' whitespace >> inline) >>= -- may not contain Space
897 (notFollowedBy' whitespace >> inline) >>= -- may not contain Space
790 return . Superscript
898 return . Superscript
900+subscript :: GenParser Char ParserState Inline
792subscript = failIfStrict >> enclosed (char '~') (char '~')
901subscript = failIfStrict >> enclosed (char '~') (char '~')
793 (notFollowedBy' whitespace >> inline) >>= -- may not contain Space
902 (notFollowedBy' whitespace >> inline) >>= -- may not contain Space
794 return . Subscript
903 return . Subscript
905+abbrev :: GenParser Char ParserState Inline
796abbrev = failUnlessSmart >>
906abbrev = failUnlessSmart >>
797 (assumedAbbrev <|> knownAbbrev) >>= return . Str . (++ ".\160")
907 (assumedAbbrev <|> knownAbbrev) >>= return . Str . (++ ".\160")
799-- an string of letters followed by a period that does not end a sentence
909-- an string of letters followed by a period that does not end a sentence
800-- is assumed to be an abbreviation. It is assumed that sentences don't
910-- is assumed to be an abbreviation. It is assumed that sentences don't
801-- start with lowercase letters or numerals.
911-- start with lowercase letters or numerals.
912+assumedAbbrev :: GenParser Char ParserState [Char]
802assumedAbbrev = try $ do
913assumedAbbrev = try $ do
803 result <- many1 $ satisfy isAlpha
914 result <- many1 $ satisfy isAlpha
804 string ". "
915 string ". "
@@ -807,20 +918,27 @@ assumedAbbrev = try $ do
808-- these strings are treated as abbreviations even if they are followed
919-- these strings are treated as abbreviations even if they are followed
809-- by a capital letter (such as a name).
920-- by a capital letter (such as a name).
921+knownAbbrev :: GenParser Char ParserState [Char]
810knownAbbrev = try $ do
922knownAbbrev = try $ do
811 result <- oneOfStrings [ "Mr", "Mrs", "Ms", "Capt", "Dr", "Prof", "Gen",
923 result <- oneOfStrings [ "Mr", "Mrs", "Ms", "Capt", "Dr", "Prof", "Gen",
812 "Gov", "e.g", "i.e", "Sgt", "St", "vol", "vs",
924 "Gov", "e.g", "i.e", "Sgt", "St", "vol", "vs",
813 "Sen", "Rep", "Pres", "Hon", "Rev" ]
925 "Sen", "Rep", "Pres", "Hon", "Rev" ]
814 string ". "
926 string ". "
815 return result
927 return result
929+smartPunctuation :: GenParser Char ParserState Inline
817smartPunctuation = failUnlessSmart >>
930smartPunctuation = failUnlessSmart >>
818 choice [ quoted, apostrophe, dash, ellipses ]
931 choice [ quoted, apostrophe, dash, ellipses ]
933+apostrophe :: GenParser Char ParserState Inline
820apostrophe = (char '\'' <|> char '\8217') >> return Apostrophe
934apostrophe = (char '\'' <|> char '\8217') >> return Apostrophe
936+quoted :: GenParser Char ParserState Inline
822quoted = doubleQuoted <|> singleQuoted
937quoted = doubleQuoted <|> singleQuoted
939+withQuoteContext :: QuoteContext
940+ -> (GenParser Char ParserState Inline)
941+ -> GenParser Char ParserState Inline
824withQuoteContext context parser = do
942withQuoteContext context parser = do
825 oldState <- getState
943 oldState <- getState
826 let oldQuoteContext = stateQuoteContext oldState
944 let oldQuoteContext = stateQuoteContext oldState
@@ -830,22 +948,26 @@ withQuoteContext context parser = do
830 setState newState { stateQuoteContext = oldQuoteContext }
948 setState newState { stateQuoteContext = oldQuoteContext }
831 return result
949 return result
951+singleQuoted :: GenParser Char ParserState Inline
833singleQuoted = try $ do
952singleQuoted = try $ do
834 singleQuoteStart
953 singleQuoteStart
835 withQuoteContext InSingleQuote $ many1Till inline singleQuoteEnd >>=
954 withQuoteContext InSingleQuote $ many1Till inline singleQuoteEnd >>=
836 return . Quoted SingleQuote . normalizeSpaces
955 return . Quoted SingleQuote . normalizeSpaces
957+doubleQuoted :: GenParser Char ParserState Inline
838doubleQuoted = try $ do
958doubleQuoted = try $ do
839 doubleQuoteStart
959 doubleQuoteStart
840 withQuoteContext InDoubleQuote $ many1Till inline doubleQuoteEnd >>=
960 withQuoteContext InDoubleQuote $ many1Till inline doubleQuoteEnd >>=
841 return . Quoted DoubleQuote . normalizeSpaces
961 return . Quoted DoubleQuote . normalizeSpaces
963+failIfInQuoteContext :: QuoteContext -> GenParser tok ParserState ()
843failIfInQuoteContext context = do
964failIfInQuoteContext context = do
844 st <- getState
965 st <- getState
845 if stateQuoteContext st == context
966 if stateQuoteContext st == context
846 then fail "already inside quotes"
967 then fail "already inside quotes"
847 else return ()
968 else return ()
970+singleQuoteStart :: GenParser Char ParserState Char
849singleQuoteStart = do
971singleQuoteStart = do
850 failIfInQuoteContext InSingleQuote
972 failIfInQuoteContext InSingleQuote
851 char '\8216' <|>
973 char '\8216' <|>
@@ -856,11 +978,13 @@ singleQuoteStart = do
856 -- possess/contraction
978 -- possess/contraction
857 return '\'')
979 return '\'')
981+singleQuoteEnd :: GenParser Char st Char
859singleQuoteEnd = try $ do
982singleQuoteEnd = try $ do
860 char '\8217' <|> char '\''
983 char '\8217' <|> char '\''
861 notFollowedBy alphaNum
984 notFollowedBy alphaNum
862 return '\''
985 return '\''
987+doubleQuoteStart :: GenParser Char ParserState Char
864doubleQuoteStart = do
988doubleQuoteStart = do
865 failIfInQuoteContext InDoubleQuote
989 failIfInQuoteContext InDoubleQuote
866 char '\8220' <|>
990 char '\8220' <|>
@@ -868,29 +992,39 @@ doubleQuoteStart = do
868 notFollowedBy (oneOf " \t\n")
992 notFollowedBy (oneOf " \t\n")
869 return '"')
993 return '"')
995+doubleQuoteEnd :: GenParser Char st Char
871doubleQuoteEnd = char '\8221' <|> char '"'
996doubleQuoteEnd = char '\8221' <|> char '"'
998+ellipses :: GenParser Char st Inline
873ellipses = oneOfStrings ["...", " . . . ", ". . .", " . . ."] >> return Ellipses
999ellipses = oneOfStrings ["...", " . . . ", ". . .", " . . ."] >> return Ellipses
1001+dash :: GenParser Char st Inline
875dash = enDash <|> emDash
1002dash = enDash <|> emDash
1004+enDash :: GenParser Char st Inline
877enDash = try $ char '-' >> notFollowedBy (noneOf "0123456789") >> return EnDash
1005enDash = try $ char '-' >> notFollowedBy (noneOf "0123456789") >> return EnDash
1007+emDash :: GenParser Char st Inline
879emDash = oneOfStrings ["---", "--"] >> return EmDash
1008emDash = oneOfStrings ["---", "--"] >> return EmDash
1010+whitespace :: GenParser Char ParserState Inline
881whitespace = do
1011whitespace = do
882 sps <- many1 (oneOf spaceChars)
1012 sps <- many1 (oneOf spaceChars)
883 if length sps >= 2
1013 if length sps >= 2
884 then option Space (endline >> return LineBreak)
1014 then option Space (endline >> return LineBreak)
885 else return Space <?> "whitespace"
1015 else return Space <?> "whitespace"
1017+nonEndline :: GenParser Char st Char
887nonEndline = satisfy (/='\n')
1018nonEndline = satisfy (/='\n')
1020+strChar :: GenParser Char st Char
889strChar = noneOf (specialChars ++ spaceChars ++ "\n")
1021strChar = noneOf (specialChars ++ spaceChars ++ "\n")
1023+str :: GenParser Char st Inline
891str = many1 strChar >>= return . Str
1024str = many1 strChar >>= return . Str
893-- an endline character that can be treated as a space, not a structural break
1026-- an endline character that can be treated as a space, not a structural break
1027+endline :: GenParser Char ParserState Inline
894endline = try $ do
1028endline = try $ do
896 notFollowedBy blankline
1030 notFollowedBy blankline
@@ -911,11 +1045,13 @@ endline = try $ do
913-- a reference label for a link
1047-- a reference label for a link
1048+reference :: GenParser Char ParserState [Inline]
914reference = do notFollowedBy' (string "[^") -- footnote reference
1049reference = do notFollowedBy' (string "[^") -- footnote reference
915 result <- inlinesInBalancedBrackets inlineNonLink
1050 result <- inlinesInBalancedBrackets inlineNonLink
916 return $ normalizeSpaces result
1051 return $ normalizeSpaces result
918-- source for a link, with optional title
1053-- source for a link, with optional title
1054+source :: GenParser Char st (String, [Char])
920 (try $ charsInBalanced '(' ')' >>= parseFromString source') <|>
1056 (try $ charsInBalanced '(' ')' >>= parseFromString source') <|>
921 -- the following is needed for cases like: [ref](/url(a).
1057 -- the following is needed for cases like: [ref](/url(a).
@@ -923,6 +1059,7 @@ source =
923 parseFromString source')
1059 parseFromString source')
925-- auxiliary function for source
1061-- auxiliary function for source
1062+source' :: GenParser Char st (String, [Char])
926source' = do
1063source' = do
927 skipSpaces
1064 skipSpaces
928 src <- try (char '<' >>
1065 src <- try (char '<' >>
@@ -934,6 +1071,7 @@ source' = do
935 return (removeTrailingSpace src, tit)
1072 return (removeTrailingSpace src, tit)
1074+linkTitle :: GenParser Char st String
937linkTitle = try $ do
1075linkTitle = try $ do
938 (many1 spaceChar >> option '\n' newline) <|> newline
1076 (many1 spaceChar >> option '\n' newline) <|> newline
939 skipSpaces
1077 skipSpaces
@@ -942,24 +1080,28 @@ linkTitle = try $ do
942 (try (char delim >> skipSpaces >> eof))
1080 (try (char delim >> skipSpaces >> eof))
943 return $ decodeCharacterReferences tit
1081 return $ decodeCharacterReferences tit
1083+link :: GenParser Char ParserState Inline
945link = try $ do
1084link = try $ do
946− label <- reference
1085+ lab <- reference
947− src <- source <|> referenceLink label
1086+ src <- source <|> referenceLink lab
948 sanitize <- getState >>= return . stateSanitizeHTML
1087 sanitize <- getState >>= return . stateSanitizeHTML
949 if sanitize && unsanitaryURI (fst src)
1088 if sanitize && unsanitaryURI (fst src)
950 then fail "Unsanitary URI"
1089 then fail "Unsanitary URI"
951− else return $ Link label src
1090+ else return $ Link lab src
953-- a link like [this][ref] or [this][] or [this]
1092-- 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
955 ref <- option [] (try (optional (char ' ') >>
1096 ref <- option [] (try (optional (char ' ') >>
956 optional (newline >> skipSpaces) >> reference))
1097 optional (newline >> skipSpaces) >> reference))
957− let ref' = if null ref then label else ref
1098+ let ref' = if null ref then lab else ref
958 state <- getState
1099 state <- getState
959 case lookupKeySrc (stateKeys state) ref' of
1100 case lookupKeySrc (stateKeys state) ref' of
960 Nothing -> fail "no corresponding key"
1101 Nothing -> fail "no corresponding key"
961 Just target -> return target
1102 Just target -> return target
1104+autoLink :: GenParser Char ParserState Inline
963autoLink = try $ do
1105autoLink = try $ do
964 char '<'
1106 char '<'
965 src <- uri <|> (emailAddress >>= (return . ("mailto:" ++)))
1107 src <- uri <|> (emailAddress >>= (return . ("mailto:" ++)))
@@ -975,11 +1117,13 @@ autoLink = try $ do
975 then Link [Str src'] (src, "")
1117 then Link [Str src'] (src, "")
976 else Link [Code src'] (src, "")
1118 else Link [Code src'] (src, "")
1120+image :: GenParser Char ParserState Inline
978image = try $ do
1121image = try $ do
979 char '!'
1122 char '!'
980− (Link label src) <- link
1123+ (Link lab src) <- link
981− return $ Image label src
1124+ return $ Image lab src
1126+note :: GenParser Char ParserState Inline
983note = try $ do
1127note = try $ do
984 failIfStrict
1128 failIfStrict
985 ref <- noteMarker
1129 ref <- noteMarker
@@ -989,14 +1133,17 @@ note = try $ do
989 Nothing -> fail "note not found"
1133 Nothing -> fail "note not found"
990 Just contents -> return $ Note contents
1134 Just contents -> return $ Note contents
1136+inlineNote :: GenParser Char ParserState Inline
992inlineNote = try $ do
1137inlineNote = try $ do
993 failIfStrict
1138 failIfStrict
994 char '^'
1139 char '^'
995 contents <- inlinesInBalancedBrackets inline
1140 contents <- inlinesInBalancedBrackets inline
996 return $ Note [Para contents]
1141 return $ Note [Para contents]
1143+rawLaTeXInline' :: GenParser Char ParserState Inline
998rawLaTeXInline' = failIfStrict >> rawLaTeXInline
1144rawLaTeXInline' = failIfStrict >> rawLaTeXInline
1146+rawHtmlInline' :: GenParser Char ParserState Inline
1000rawHtmlInline' = do
1147rawHtmlInline' = do
1001 st <- getState
1148 st <- getState
1002 result <- if stateStrict st
1149 result <- if stateStrict st