Tissevert/pandoc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions 1

Parsing: Provide parseFromString'.

Browse source 
This is a verison of parseFromString specialied to
ParserState, which resets stateLastStrPos at the end.
This is almost always what we want.

This fixes a bug where `_hi_` wasn't treated as emphasis in
the following, because pandoc got confused about the
position of the last word:

    - [o] _hi_

Closes #3690.
This commit is contained in:
John MacFarlane 2017-05-24 22:41:47 +02:00
parent d4ccd1e001
commit bc6aac7b47
8 changed files with 88 additions and 62 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

18
src/Text/Pandoc/Parsing.hs
View file

@ -50,6 +50,7 @@ module Text.Pandoc.Parsing ( anyLine,
enclosed,
stringAnyCase,
parseFromString,
parseFromString',
lineClump,
charsInBalanced,
romanNumeral,
@ -358,7 +359,10 @@ stringAnyCase (x:xs) = do
return (firstChar:rest)
-- | Parse contents of 'str' using 'parser' and return result.
parseFromString :: Monad m => ParserT String st m a -> String -> ParserT String st m a
parseFromString :: Monad m
=> ParserT String st m a
-> String
-> ParserT String st m a
parseFromString parser str = do
oldPos <- getPosition
oldInput <- getInput
@ -370,6 +374,18 @@ parseFromString parser str = do
setPosition oldPos
return result
-- | Like 'parseFromString' but specialized for 'ParserState'.
-- This resets 'stateLastStrPos', which is almost always what we want.
parseFromString' :: Monad m
=> ParserT String ParserState m a
-> String
-> ParserT String ParserState m a
parseFromString' parser str = do
oldStrPos <- stateLastStrPos <$> getState
res <- parseFromString parser str
updateState $ \st -> st{ stateLastStrPos = oldStrPos }
return res
-- | Parse raw line block up to and including blank lines.
lineClump :: Stream [Char] m Char => ParserT [Char] st m String
lineClump = blanklines

12
src/Text/Pandoc/Readers/LaTeX.hs
View file

@ -304,8 +304,8 @@ blockCommand = try $ do
rawcommand <- getRawCommand name'
transformed <- applyMacros' rawcommand
guard $ transformed /= rawcommand
notFollowedBy $ parseFromString inlines transformed
parseFromString blocks transformed
notFollowedBy $ parseFromString' inlines transformed
parseFromString' blocks transformed
lookupListDefault raw [name',name] blockCommands
inBrackets :: Inlines -> Inlines
@ -475,7 +475,7 @@ inlineCommand = try $ do
transformed <- applyMacros' rawcommand
exts <- getOption readerExtensions
if transformed /= rawcommand
then parseFromString inlines transformed
then parseFromString' inlines transformed
else if extensionEnabled Ext_raw_tex exts
then return $ rawInline "latex" rawcommand
else ignore rawcommand
@ -1021,7 +1021,7 @@ rawEnv name = do
(bs, raw) <- withRaw $ env name blocks
raw' <- applyMacros' $ beginCommand ++ raw
if raw' /= beginCommand ++ raw
then parseFromString blocks raw'
then parseFromString' blocks raw'
else if parseRaw
then return $ rawBlock "latex" $ beginCommand ++ raw'
else do
@ -1119,7 +1119,7 @@ keyvals :: PandocMonad m => LP m [(String, String)]
keyvals = try $ char '[' *> manyTill keyval (char ']')
alltt :: PandocMonad m => String -> LP m Blocks
alltt t = walk strToCode <$> parseFromString blocks
alltt t = walk strToCode <$> parseFromString' blocks
(substitute " " "\\ " $ substitute "%" "\\%" $
intercalate "\\\\\n" $ lines t)
where strToCode (Str s) = Code nullAttr s
@ -1503,7 +1503,7 @@ parseTableRow cols prefixes suffixes = try $ do
guard $ length rawcells == cols
let rawcells' = zipWith3 (\c p s -> p ++ trim c ++ s)
rawcells prefixes suffixes
cells' <- mapM (parseFromString tableCell) rawcells'
cells' <- mapM (parseFromString' tableCell) rawcells'
let numcells = length cells'
guard $ numcells <= cols && numcells >= 1
guard $ cells' /= [mempty]

40
src/Text/Pandoc/Readers/Markdown.hs
View file

@ -155,9 +155,11 @@ litChar = escapedChar'
inlinesInBalancedBrackets :: PandocMonad m => MarkdownParser m (F Inlines)
inlinesInBalancedBrackets = do
char '['
pos <- getPosition
(_, raw) <- withRaw $ charsInBalancedBrackets 1
guard $ not $ null raw
parseFromString (trimInlinesF . mconcat <$> many inline) (init raw)
parseFromString' (setPosition pos >>
trimInlinesF . mconcat <$> many inline) (init raw)
charsInBalancedBrackets :: PandocMonad m => Int -> MarkdownParser m ()
charsInBalancedBrackets 0 = return ()
@ -189,7 +191,7 @@ rawTitleBlockLine = do
titleLine :: PandocMonad m => MarkdownParser m (F Inlines)
titleLine = try $ do
raw <- rawTitleBlockLine
res <- parseFromString (many inline) raw
res <- parseFromString' (many inline) raw
return $ trimInlinesF $ mconcat res
authorsLine :: PandocMonad m => MarkdownParser m (F [Inlines])
@ -200,12 +202,12 @@ authorsLine = try $ do
(trimInlinesF . mconcat <$> many
(try $ notFollowedBy sep >> inline))
sep
sequence <$> parseFromString pAuthors raw
sequence <$> parseFromString' pAuthors raw
dateLine :: PandocMonad m => MarkdownParser m (F Inlines)
dateLine = try $ do
raw <- rawTitleBlockLine
res <- parseFromString (many inline) raw
res <- parseFromString' (many inline) raw
return $ trimInlinesF $ mconcat res
titleBlock :: PandocMonad m => MarkdownParser m ()
@ -290,7 +292,7 @@ ignorable t = (T.pack "_") `T.isSuffixOf` t
toMetaValue :: PandocMonad m
=> Text -> MarkdownParser m (F MetaValue)
toMetaValue x = toMeta <$> parseFromString parseBlocks (T.unpack x)
toMetaValue x = toMeta <$> parseFromString' parseBlocks (T.unpack x)
where
toMeta p = do
p' <- p
@ -466,7 +468,7 @@ noteBlock = try $ do
rest <- many $ try $ blanklines >> indentSpaces >> rawLines
let raw = unlines (first:rest) ++ "\n"
optional blanklines
parsed <- parseFromString parseBlocks raw
parsed <- parseFromString' parseBlocks raw
let newnote = (ref, parsed)
oldnotes <- stateNotes' <$> getState
case lookup ref oldnotes of
@ -774,7 +776,7 @@ blockQuote :: PandocMonad m => MarkdownParser m (F Blocks)
blockQuote = do
raw <- emailBlockQuote
-- parse the extracted block, which may contain various block elements:
contents <- parseFromString parseBlocks $ (intercalate "\n" raw) ++ "\n\n"
contents <- parseFromString' parseBlocks $ (intercalate "\n" raw) ++ "\n\n"
return $ B.blockQuote <$> contents
--
@ -887,7 +889,7 @@ listItem start = try $ do
setState $ state {stateParserContext = ListItemState}
-- parse the extracted block, which may contain various block elements:
let raw = concat (first:continuations)
contents <- parseFromString parseBlocks raw
contents <- parseFromString' parseBlocks raw
updateState (\st -> st {stateParserContext = oldContext})
return contents
@ -934,8 +936,8 @@ definitionListItem :: PandocMonad m => Bool -> MarkdownParser m (F (Inlines, [Bl
definitionListItem compact = try $ do
rawLine' <- anyLine
raw <- many1 $ defRawBlock compact
term <- parseFromString (trimInlinesF . mconcat <$> many inline) rawLine'
contents <- mapM (parseFromString parseBlocks . (++"\n")) raw
term <- parseFromString' (trimInlinesF . mconcat <$> many inline) rawLine'
contents <- mapM (parseFromString' parseBlocks . (++"\n")) raw
optional blanklines
return $ liftM2 (,) term (sequence contents)
@ -1127,7 +1129,7 @@ lineBlock :: PandocMonad m => MarkdownParser m (F Blocks)
lineBlock = try $ do
guardEnabled Ext_line_blocks
lines' <- lineBlockLines >>=
mapM (parseFromString (trimInlinesF . mconcat <$> many inline))
mapM (parseFromString' (trimInlinesF . mconcat <$> many inline))
return $ B.lineBlock <$> sequence lines'
--
@ -1170,7 +1172,7 @@ simpleTableHeader headless = try $ do
then replicate (length dashes) ""
else rawHeads
heads <- fmap sequence
$ mapM (parseFromString (mconcat <$> many plain))
$ mapM (parseFromString' (mconcat <$> many plain))
$ map trim rawHeads'
return (heads, aligns, indices)
@ -1216,7 +1218,7 @@ tableLine :: PandocMonad m
=> [Int]
-> MarkdownParser m (F [Blocks])
tableLine indices = rawTableLine indices >>=
fmap sequence . mapM (parseFromString (mconcat <$> many plain))
fmap sequence . mapM (parseFromString' (mconcat <$> many plain))
-- Parse a multiline table row and return a list of blocks (columns).
multilineRow :: PandocMonad m
@ -1225,7 +1227,7 @@ multilineRow :: PandocMonad m
multilineRow indices = do
colLines <- many1 (rawTableLine indices)
let cols = map unlines $ transpose colLines
fmap sequence $ mapM (parseFromString (mconcat <$> many plain)) cols
fmap sequence $ mapM (parseFromString' (mconcat <$> many plain)) cols
-- Parses a table caption: inlines beginning with 'Table:'
-- and followed by blank lines.
@ -1283,7 +1285,7 @@ multilineTableHeader headless = try $ do
then replicate (length dashes) ""
else map (unlines . map trim) rawHeadsList
heads <- fmap sequence $
mapM (parseFromString (mconcat <$> many plain)) $
mapM (parseFromString' (mconcat <$> many plain)) $
map trim rawHeads
return (heads, aligns, indices)
@ -1340,7 +1342,7 @@ pipeTableRow = try $ do
let chunk = void (code <|> math <|> rawHtmlInline <|> escapedChar <|> rawLaTeXInline')
<|> void (noneOf "|\n\r")
let cellContents = ((trim . snd) <$> withRaw (many chunk)) >>=
parseFromString pipeTableCell
parseFromString' pipeTableCell
cells <- cellContents `sepEndBy1` (char '|')
-- surrounding pipes needed for a one-column table:
guard $ not (length cells == 1 && not openPipe)
@ -1747,8 +1749,8 @@ referenceLink constructor (lab, raw) = do
when (raw' == "") $ guardEnabled Ext_shortcut_reference_links
let labIsRef = raw' == "" || raw' == "[]"
let key = toKey $ if labIsRef then raw else raw'
parsedRaw <- parseFromString (mconcat <$> many inline) raw'
fallback <- parseFromString (mconcat <$> many inline) $ dropBrackets raw
parsedRaw <- parseFromString' (mconcat <$> many inline) raw'
fallback <- parseFromString' (mconcat <$> many inline) $ dropBrackets raw
implicitHeaderRefs <- option False $
True <$ guardEnabled Ext_implicit_header_references
let makeFallback = do
@ -1954,7 +1956,7 @@ textualCite = try $ do
let (spaces',raw') = span isSpace raw
spc | null spaces' = mempty
| otherwise = B.space
lab <- parseFromString (mconcat <$> many inline) $ dropBrackets raw'
lab <- parseFromString' (mconcat <$> many inline) $ dropBrackets raw'
fallback <- referenceLink B.linkWith (lab,raw')
return $ do
fallback' <- fallback

50
src/Text/Pandoc/Readers/RST.hs
View file

@ -196,7 +196,7 @@ parseRST = do
parseCitation :: PandocMonad m
=> (String, String) -> RSTParser m (Inlines, [Blocks])
parseCitation (ref, raw) = do
contents <- parseFromString parseBlocks raw
contents <- parseFromString' parseBlocks raw
return $ (B.spanWith (ref, ["citation-label"], []) (B.str ref),
[contents])
@ -246,7 +246,7 @@ fieldListItem :: PandocMonad m => Int -> RSTParser m (Inlines, [Blocks])
fieldListItem minIndent = try $ do
(name, raw) <- rawFieldListItem minIndent
term <- parseInlineFromString name
contents <- parseFromString parseBlocks raw
contents <- parseFromString' parseBlocks raw
optional blanklines
return (term, [contents])
@ -445,7 +445,7 @@ blockQuote :: PandocMonad m => RSTParser m Blocks
blockQuote = do
raw <- indentedBlock
-- parse the extracted block, which may contain various block elements:
contents <- parseFromString parseBlocks $ raw ++ "\n\n"
contents <- parseFromString' parseBlocks $ raw ++ "\n\n"
return $ B.blockQuote contents
{-
@ -533,7 +533,7 @@ definitionListItem = try $ do
term <- trimInlines . mconcat <$> many1Till inline endline
raw <- indentedBlock
-- parse the extracted block, which may contain various block elements:
contents <- parseFromString parseBlocks $ raw ++ "\n"
contents <- parseFromString' parseBlocks $ raw ++ "\n"
return (term, [contents])
definitionList :: PandocMonad m => RSTParser m Blocks
@ -595,7 +595,7 @@ listItem start = try $ do
let oldContext = stateParserContext state
setState $ state {stateParserContext = ListItemState}
-- parse the extracted block, which may itself contain block elements
parsed <- parseFromString parseBlocks $ concat (first:rest) ++ "\n"
parsed <- parseFromString' parseBlocks $ concat (first:rest) ++ "\n"
updateState (\st -> st {stateParserContext = oldContext})
return $ case B.toList parsed of
[Para xs] ->
@ -686,19 +686,19 @@ directive' = do
"line-block" -> lineBlockDirective body'
"raw" -> return $ B.rawBlock (trim top) (stripTrailingNewlines body)
"role" -> addNewRole top $ map (\(k,v) -> (k, trim v)) fields
"container" -> parseFromString parseBlocks body'
"container" -> parseFromString' parseBlocks body'
"replace" -> B.para <$> -- consumed by substKey
parseInlineFromString (trim top)
"unicode" -> B.para <$> -- consumed by substKey
parseInlineFromString (trim $ unicodeTransform top)
"compound" -> parseFromString parseBlocks body'
"pull-quote" -> B.blockQuote <$> parseFromString parseBlocks body'
"epigraph" -> B.blockQuote <$> parseFromString parseBlocks body'
"highlights" -> B.blockQuote <$> parseFromString parseBlocks body'
"compound" -> parseFromString' parseBlocks body'
"pull-quote" -> B.blockQuote <$> parseFromString' parseBlocks body'
"epigraph" -> B.blockQuote <$> parseFromString' parseBlocks body'
"highlights" -> B.blockQuote <$> parseFromString' parseBlocks body'
"rubric" -> B.para . B.strong <$> parseInlineFromString top
_ | label `elem` ["attention","caution","danger","error","hint",
"important","note","tip","warning","admonition"] ->
do bod <- parseFromString parseBlocks $ top ++ "\n\n" ++ body'
do bod <- parseFromString' parseBlocks $ top ++ "\n\n" ++ body'
let lab = case label of
"admonition" -> mempty
(l:ls) -> B.divWith ("",["admonition-title"],[])
@ -711,11 +711,11 @@ directive' = do
(trim top ++ if null subtit
then ""
else (": " ++ subtit))
bod <- parseFromString parseBlocks body'
bod <- parseFromString' parseBlocks body'
return $ B.divWith ("",["sidebar"],[]) $ tit <> bod
"topic" ->
do tit <- B.para . B.strong <$> parseInlineFromString top
bod <- parseFromString parseBlocks body'
bod <- parseFromString' parseBlocks body'
return $ B.divWith ("",["topic"],[]) $ tit <> bod
"default-role" -> mempty <$ updateState (\s ->
s { stateRstDefaultRole =
@ -731,7 +731,7 @@ directive' = do
"math" -> return $ B.para $ mconcat $ map B.displayMath
$ toChunks $ top ++ "\n\n" ++ body
"figure" -> do
(caption, legend) <- parseFromString extractCaption body'
(caption, legend) <- parseFromString' extractCaption body'
let src = escapeURI $ trim top
return $ B.para (B.imageWith (imgAttr "figclass") src "fig:"
caption) <> legend
@ -750,21 +750,21 @@ directive' = do
-- directive content or the first immediately following element
children <- case body of
"" -> block
_ -> parseFromString parseBlocks body'
_ -> parseFromString' parseBlocks body'
return $ B.divWith attrs children
other -> do
pos <- getPosition
logMessage $ SkippedContent (".. " ++ other) pos
bod <- parseFromString parseBlocks $ top ++ "\n\n" ++ body'
bod <- parseFromString' parseBlocks $ top ++ "\n\n" ++ body'
return $ B.divWith ("",[other],[]) bod
tableDirective :: PandocMonad m
=> String -> [(String, String)] -> String -> RSTParser m Blocks
tableDirective top _fields body = do
bs <- parseFromString parseBlocks body
bs <- parseFromString' parseBlocks body
case B.toList bs of
[Table _ aligns' widths' header' rows'] -> do
title <- parseFromString (trimInlines . mconcat <$> many inline) top
title <- parseFromString' (trimInlines . mconcat <$> many inline) top
-- TODO widths
-- align is not applicable since we can't represent whole table align
return $ B.singleton $ Table (B.toList title)
@ -780,8 +780,8 @@ listTableDirective :: PandocMonad m
=> String -> [(String, String)] -> String
-> RSTParser m Blocks
listTableDirective top fields body = do
bs <- parseFromString parseBlocks body
title <- parseFromString (trimInlines . mconcat <$> many inline) top
bs <- parseFromString' parseBlocks body
title <- parseFromString' (trimInlines . mconcat <$> many inline) top
let rows = takeRows $ B.toList bs
headerRowsNum = fromMaybe (0 :: Int) $
lookup "header-rows" fields >>= safeRead
@ -812,7 +812,7 @@ addNewRole :: PandocMonad m
=> String -> [(String, String)] -> RSTParser m Blocks
addNewRole roleString fields = do
pos <- getPosition
(role, parentRole) <- parseFromString inheritedRole roleString
(role, parentRole) <- parseFromString' inheritedRole roleString
customRoles <- stateRstCustomRoles <$> getState
let getBaseRole (r, f, a) roles =
case M.lookup r roles of
@ -1127,7 +1127,7 @@ simpleTableRow indices = do
let cols = map unlines . transpose $ firstLine : conLines ++
[replicate (length indices) ""
| not (null conLines)]
mapM (parseFromString parseBlocks) cols
mapM (parseFromString' parseBlocks) cols
simpleTableSplitLine :: [Int] -> String -> [String]
simpleTableSplitLine indices line =
@ -1150,7 +1150,7 @@ simpleTableHeader headless = try $ do
let rawHeads = if headless
then replicate (length dashes) ""
else simpleTableSplitLine indices rawContent
heads <- mapM (parseFromString (mconcat <$> many plain)) $
heads <- mapM (parseFromString' (mconcat <$> many plain)) $
map trim rawHeads
return (heads, aligns, indices)
@ -1206,7 +1206,7 @@ inline = choice [ note -- can start with whitespace, so try before ws
, symbol ] <?> "inline"
parseInlineFromString :: PandocMonad m => String -> RSTParser m Inlines
parseInlineFromString = parseFromString (trimInlines . mconcat <$> many inline)
parseInlineFromString = parseFromString' (trimInlines . mconcat <$> many inline)
hyphens :: Monad m => RSTParser m Inlines
hyphens = do
@ -1470,7 +1470,7 @@ note = try $ do
-- Note references inside other notes are allowed in reST, but
-- not yet in this implementation.
updateState $ \st -> st{ stateNotes = [] }
contents <- parseFromString parseBlocks raw
contents <- parseFromString' parseBlocks raw
let newnotes = if (ref == "*" || ref == "#") -- auto-numbered
-- delete the note so the next auto-numbered note
-- doesn't get the same contents:

8
src/Text/Pandoc/Readers/TWiki.hs
View file

@ -106,7 +106,7 @@ parseHtmlContentWithAttrs tag parser = do
parsedContent <- try $ parseContent content
return (attr, parsedContent)
where
parseContent = parseFromString $ nested $ manyTill parser endOfContent
parseContent = parseFromString' $ nested $ manyTill parser endOfContent
endOfContent = try $ skipMany blankline >> skipSpaces >> eof
parseHtmlContent :: PandocMonad m => String -> TWParser m a -> TWParser m [a]
@ -233,7 +233,7 @@ listItemLine prefix marker = lineContent >>= parseContent >>= return . mconcat
filterSpaces = reverse . dropWhile (== ' ') . reverse
listContinuation = notFollowedBy (string prefix >> marker) >>
string " " >> lineContent
parseContent = parseFromString $ many1 $ nestedList <|> parseInline
parseContent = parseFromString' $ many1 $ nestedList <|> parseInline
parseInline = many1Till inline (lastNewline <|> newlineBeforeNestedList) >>=
return . B.plain . mconcat
nestedList = list prefix
@ -297,7 +297,7 @@ noautolink = do
setState $ st{ stateAllowLinks = True }
return $ mconcat blocks
where
parseContent = parseFromString $ many $ block
parseContent = parseFromString' $ many $ block
para :: PandocMonad m => TWParser m B.Blocks
para = many1Till inline endOfParaElement >>= return . result . mconcat
@ -525,4 +525,4 @@ linkText = do
return (url, "", content)
where
linkContent = (char '[') >> many1Till anyChar (char ']') >>= parseLinkContent
parseLinkContent = parseFromString $ many1 inline
parseLinkContent = parseFromString' $ many1 inline

8
src/Text/Pandoc/Readers/Textile.hs
View file

@ -315,7 +315,7 @@ definitionListItem = try $ do
optional whitespace >> newline
s <- many1Till anyChar (try (string "=:" >> newline))
-- this ++ "\n\n" does not look very good
ds <- parseFromString parseBlocks (s ++ "\n\n")
ds <- parseFromString' parseBlocks (s ++ "\n\n")
return [ds]
-- raw content
@ -367,7 +367,7 @@ tableCell = try $ do
notFollowedBy blankline
raw <- trim <$>
many (noneOf "|\n" <|> try (char '\n' <* notFollowedBy blankline))
content <- mconcat <$> parseFromString (many inline) raw
content <- mconcat <$> parseFromString' (many inline) raw
return ((isHeader, alignment), B.plain content)
-- | A table row is made of many table cells
@ -389,7 +389,7 @@ table = try $ do
_ <- attributes
char '.'
rawcapt <- trim <$> anyLine
parseFromString (mconcat <$> many inline) rawcapt
parseFromString' (mconcat <$> many inline) rawcapt
rawrows <- many1 $ (skipMany ignorableRow) >> tableRow
skipMany ignorableRow
blanklines
@ -507,7 +507,7 @@ note = try $ do
notes <- stateNotes <$> getState
case lookup ref notes of
Nothing -> fail "note not found"
Just raw -> B.note <$> parseFromString parseBlocks raw
Just raw -> B.note <$> parseFromString' parseBlocks raw
-- | Special chars
markupChars :: [Char]

6
src/Text/Pandoc/Readers/Txt2Tags.hs
View file

@ -212,7 +212,7 @@ quote :: T2T Blocks
quote = try $ do
lookAhead tab
rawQuote <- many1 (tab *> optional spaces *> anyLine)
contents <- parseFromString parseBlocks (intercalate "\n" rawQuote ++ "\n\n")
contents <- parseFromString' parseBlocks (intercalate "\n" rawQuote ++ "\n\n")
return $ B.blockQuote contents
commentLine :: T2T Inlines
@ -264,7 +264,7 @@ listItem start end = try $ do
firstLine <- anyLineNewline
blank <- option "" ("\n" <$ blankline)
rest <- concat <$> many (listContinuation markerLength)
parseFromString end $ firstLine ++ blank ++ rest
parseFromString' end $ firstLine ++ blank ++ rest
-- continuation of a list item - indented and separated by blankline or endline.
-- Note: nested lists are parsed as continuations.
@ -439,7 +439,7 @@ inlineMarkup p f c special = try $ do
Just middle -> do
lastChar <- anyChar
end <- many1 (char c)
let parser inp = parseFromString (mconcat <$> many p) inp
let parser inp = parseFromString' (mconcat <$> many p) inp
let start' = case drop 2 start of
"" -> mempty
xs -> special xs

8
test/command/3690.md Normal file
View file

@ -0,0 +1,8 @@
```
% pandoc
- [o] _hi_
^D
<ul>
<li>[o] <em>hi</em></li>
</ul>
```