110 lines
4 KiB
Haskell
110 lines
4 KiB
Haskell
|
-- | 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))
|