diff options
Diffstat (limited to 'src/Text/Pandoc/Readers')
-rw-r--r-- | src/Text/Pandoc/Readers/Markdown.hs | 47 |
1 files changed, 34 insertions, 13 deletions
diff --git a/src/Text/Pandoc/Readers/Markdown.hs b/src/Text/Pandoc/Readers/Markdown.hs index 6f51dfd9a..26721cf5c 100644 --- a/src/Text/Pandoc/Readers/Markdown.hs +++ b/src/Text/Pandoc/Readers/Markdown.hs @@ -44,6 +44,7 @@ import Text.Pandoc.Readers.HTML ( htmlTag, htmlInBalanced, isInlineTag, isBlockT import Text.Pandoc.CharacterReferences ( decodeCharacterReferences ) import Text.ParserCombinators.Parsec import Control.Monad (when, liftM, guard) +import Control.Applicative ((<$>), (*>), (<*)) import Text.HTML.TagSoup import Text.HTML.TagSoup.Match (tagOpen) @@ -907,7 +908,7 @@ inlineParsers = [ whitespace , str , endline , code - , (fourOrMore '*' <|> fourOrMore '_') + , fours , strong , emph , note @@ -1018,24 +1019,44 @@ mathInline = try $ do -- to avoid performance problems, treat 4 or more _ or * in a row as a literal -- rather than attempting to parse for emph/strong -fourOrMore :: Char -> GenParser Char st Inline -fourOrMore c = try $ count 4 (char c) >> many (char c) >>= \s -> - return (Str $ replicate 4 c ++ s) +fours :: GenParser Char st Inline +fours = try $ do + x <- char '*' <|> char '_' + count 2 $ satisfy (==x) + rest <- many1 (satisfy (==x)) + return $ Str (x:x:x:rest) + +-- | Parses a list of inlines between start and end delimiters. +inlinesBetween :: (Show b) + => GenParser Char ParserState a + -> GenParser Char ParserState b + -> GenParser Char ParserState [Inline] +inlinesBetween start end = + normalizeSpaces <$> try (start *> many1Till inner end) + where inner = innerSpace <|> (notFollowedBy' whitespace *> inline) + innerSpace = try $ whitespace <* notFollowedBy' end emph :: GenParser Char ParserState Inline -emph = ((enclosed (char '*') (notFollowedBy' strong >> char '*') inline) <|> - (enclosed (char '_') (notFollowedBy' strong >> char '_' >> - notFollowedBy alphaNum) inline)) >>= - return . Emph . normalizeSpaces +emph = Emph <$> + (inlinesBetween starStart starEnd <|> inlinesBetween ulStart ulEnd) + where starStart = char '*' *> lookAhead nonspaceChar + starEnd = notFollowedBy' strong *> char '*' + ulStart = char '_' *> lookAhead nonspaceChar + ulEnd = notFollowedBy' strong *> char '_' strong :: GenParser Char ParserState Inline -strong = ((enclosed (string "**") (try $ string "**") inline) <|> - (enclosed (string "__") (try $ string "__") inline)) >>= - return . Strong . normalizeSpaces +strong = Strong <$> + (inlinesBetween starStart starEnd <|> inlinesBetween ulStart ulEnd) + where starStart = string "**" *> lookAhead nonspaceChar + starEnd = try $ string "**" + ulStart = string "__" *> lookAhead nonspaceChar + ulEnd = try $ string "__" strikeout :: GenParser Char ParserState Inline -strikeout = failIfStrict >> enclosed (string "~~") (try $ string "~~") inline >>= - return . Strikeout . normalizeSpaces +strikeout = Strikeout <$> (failIfStrict >> inlinesBetween strikeStart strikeEnd) + where strikeStart = string "~~" *> lookAhead nonspaceChar + *> notFollowedBy (char '~') + strikeEnd = try $ string "~~" superscript :: GenParser Char ParserState Inline superscript = failIfStrict >> enclosed (char '^') (char '^') |