diff options
Diffstat (limited to 'src/Text/ParserCombinators/Pandoc.hs')
-rw-r--r-- | src/Text/ParserCombinators/Pandoc.hs | 109 |
1 files changed, 109 insertions, 0 deletions
diff --git a/src/Text/ParserCombinators/Pandoc.hs b/src/Text/ParserCombinators/Pandoc.hs new file mode 100644 index 000000000..9bf0a76f7 --- /dev/null +++ b/src/Text/ParserCombinators/Pandoc.hs @@ -0,0 +1,109 @@ +-- | Special parser combinators for Pandoc readers. +module Text.ParserCombinators.Pandoc ( + many1Till, + followedBy', + notFollowedBy', + oneOfStrings, + spaceChar, + skipSpaces, + blankline, + blanklines, + escaped, + enclosed, + blankBlock, + nullBlock, + stringAnyCase + ) where +import Text.ParserCombinators.Parsec +import Text.Pandoc.Definition +import Text.Pandoc.Shared +import Char ( toUpper, toLower ) + +-- | Parses a character and returns 'Null' (so that the parser can move on +-- if it gets stuck). +nullBlock :: GenParser Char st Block +nullBlock = do + anyChar + return Null + +-- | Parses one or more blank lines; returns 'Blank'. +blankBlock :: GenParser Char st Block +blankBlock = do + blanklines + return Blank + +-- | Parses a space or tab. +spaceChar :: CharParser st Char +spaceChar = oneOf " \t" + +-- | Skips zero or more spaces or tabs. +skipSpaces :: GenParser Char st () +skipSpaces = skipMany spaceChar + +-- | Skips zero or more spaces or tabs, then reads a newline. +blankline :: GenParser Char st Char +blankline = try (do + skipSpaces + newline) + +-- | Parses one or more blank lines and returns a string of newlines. +blanklines :: GenParser Char st [Char] +blanklines = try (do + many1 blankline) + +-- | Parses backslash, then applies character parser. +escaped :: GenParser Char st Char -- ^ Parser for character to escape + -> GenParser Char st Inline +escaped parser = try (do + char '\\' + result <- parser + return (Str [result])) + +-- | Parses material enclosed between start and end parsers. +enclosed :: GenParser Char st t -- ^ start parser + -> GenParser Char st end -- ^ end parser + -> GenParser Char st a -- ^ content parser (to be used repeatedly) + -> GenParser Char st [a] +enclosed start end parser = try (do + start + notFollowedBy space + result <- many1Till parser (try end) + return result) + +-- | Like @manyTill@, but reads at least one item. +many1Till :: GenParser tok st a + -> GenParser tok st end + -> GenParser tok st [a] +many1Till p end = try (do + first <- p + rest <- manyTill p end + return (first:rest)) + +-- | A more general form of @notFollowedBy@. This one allows any type of parser to +-- be specified, and succeeds only if that parser fails. It does not consume any input. +notFollowedBy' :: Show b => GenParser a st b -> GenParser a st () +notFollowedBy' parser = try (do{ c <- parser; unexpected (show c) } + <|> return () + ) + +-- | The inverse of @notFollowedBy'@. Fails if parser will fail, otherwise +-- returns @()@ (but does not consume any input). +followedBy' :: (Show b) => GenParser a st b -> GenParser a st () +followedBy' parser = do + isNotFollowed <- option False (do{ notFollowedBy' parser; return True}) + if isNotFollowed then + fail "not followed by parser" + else + return () + +-- | Parses one of a list of strings (tried in order). +oneOfStrings :: [String] -> GenParser Char st String +oneOfStrings listOfStrings = choice $ map (try . string) listOfStrings + +-- | Parse string, case insensitive. +stringAnyCase :: [Char] -> CharParser st String +stringAnyCase [] = string "" +stringAnyCase (x:xs) = try (do + firstChar <- choice [ char (toUpper x), char (toLower x) ] + rest <- stringAnyCase xs + return (firstChar:rest)) |