MaintainerCS 131, Programming Languages (Melissa O'Neill, Chris Stone, Ben Wiedermann)
Safe HaskellSafe

ParserCombinators

Contents

Description

 
Synopsis

Types

data Parser a #

Has the capacity to invoke a parsing function on an input string, and look for a result of type a.

Instances
Monad Parser # 
Instance details

Defined in ParserBase

Methods

(>>=) :: Parser a -> (a -> Parser b) -> Parser b #

(>>) :: Parser a -> Parser b -> Parser b

return :: a -> Parser a #

fail :: String -> Parser a #

Functor Parser # 
Instance details

Defined in ParserBase

Methods

fmap :: (a -> b) -> Parser a -> Parser b

(<$) :: a -> Parser b -> Parser a

Applicative Parser # 
Instance details

Defined in ParserBase

Methods

pure :: a -> Parser a

(<*>) :: Parser (a -> b) -> Parser a -> Parser b

liftA2 :: (a -> b -> c) -> Parser a -> Parser b -> Parser c

(*>) :: Parser a -> Parser b -> Parser b

(<*) :: Parser a -> Parser b -> Parser a

Alternative Parser # 
Instance details

Defined in ParserBase

Methods

empty :: Parser a #

(<|>) :: Parser a -> Parser a -> Parser a #

some :: Parser a -> Parser [a] #

many :: Parser a -> Parser [a] #

MonadPlus Parser # 
Instance details

Defined in ParserBase

Methods

mzero :: Parser a

mplus :: Parser a -> Parser a -> Parser a

Primitive parsers and combinators

The types of these items are a little strange because we implement them using a more general feature of Haskell (Alternatives and Monads). If you want to learn more about the types and purposes of these items, see the documentation for basic parsers on the course website.

get :: Parser Char #

Get a single character from the input. Fails if the input is empty.

return :: Monad m => a -> m a #

A parser that always succeeds and returns the specified value. Think of the type as:

 return :: a -> Parser a

pfail :: Parser a #

A parser that always fails.

fail :: Monad m => String -> m a #

A parser that always fails with the given message. Think of the type as:

 return :: String -> Parser a

(<|>) :: Alternative f => f a -> f a -> f a #

Alternatives. Succeeds if either parser succeeds. Think of the type as:

 (<|>) :: Parser a -> Parser a -> Parser a

(>>=) :: Monad m => m a -> (a -> m b) -> m b #

The "and then" (or "bind") operator. Think of the type as:

 (>>=) :: Parser a -> (a -> Parser b) -> Parser b

Parsing functions

parse :: Parser a -> String -> a #

Given a 'Parser a' and an input string, return a value of type a if the parser matches the entire input string.

parseFile :: Parser a -> String -> IO a #

Given a 'Parser a' and the path to a file, return a value of type 'IO a' if the parser matches the entire contents of the file.

Useful combinators

Variations on >>=

(>>=:) :: Functor parser => parser a -> (a -> b) -> parser b infixl 1 #

Given a parser, transform its result by passing it through a provided function

Think of the type as

(>>=:) :: Parser a -> (a -> b) -> Parser b

(>>:) :: Functor parser => parser a -> b -> parser b infixl 1 #

Given a parser, ignore is result and instead, if the parser succeeds always return a specific value.

Think of the type as

(>>:) :: Parser a -> b -> Parser b

Combining multiple parsers and parse results

(<+>) :: Applicative parser => parser a -> parser b -> parser (a, b) infixl 6 #

Given two parsers, p and q, makes a new parser for "p then q" that 1. runs the first parser on the input 2. runs the second parser on what remains in the input 3. returns a pair of their results If either of the parsers fail, the whole thing fails.

Think of the type as

(<+>) :: Parser a -> Parser b -> Parser (a, b)

(<+->) :: Applicative parser => parser a -> parser b -> parser a infixl 6 #

Given two parsers, p and q, makes a new parser for "p then q" that 1. runs the first parser on the input 2. runs the second parser on what remains in the input 3. returns ONLY the results of the first one.

For example: *ParserCombinators> parse (get +- get) "ab" a

Think of the type as

(<+->) :: Parser a -> Parser b -> Parser a

(<-+>) :: Applicative parser => parser a -> parser b -> parser b infixl 6 #

Given two parsers, p and q, makes a new parser for "p then q" that 1. runs the first parser on the input 2. runs the second parser on what remains in the input 3. returns ONLY the results of the second one.

For example: *ParserCombinators> parse (get -+ get) "ab" b

Think of the type as

(<-+>) :: Parser a -> Parser b -> Parser b

(<-+->) :: Applicative parser => parser a -> parser b -> parser () infixl 6 #

Given two parsers, p and q, makes a new parser for "p then q" that 1. runs the first parser on the input 2. runs the second parser on what remains in the input 3. ignores both results and returns a Haskell unit, ---[i.e., this]--> ()

For example: *ParserCombinators> parse (get -+- get) "ab" ()

Think of the type as

(<-+->) :: Parser a -> Parser b -> Parser ()

(<:>) :: Applicative parser => parser a -> parser [a] -> parser [a] infixr 5 #

Given two parsers, p and q, makes a new parser for "p then q" that 1. runs the first parser on the input to generate a thing 2. runs the second parser on what remains in the input to make a list of the same kind of thing 3. returns a list of things If either of the parsers fail, the whole thing fails.

Think of the type as

(<:>) :: Parser a -> Parser [a] -> Parser [a]

(<++>) :: Applicative parser => parser [a] -> parser [a] -> parser [a] infixr 5 #

Given two parsers, p and q, makes a new parser for "p then q" that 1. runs the first parser on the input to generate a list 2. runs the second parser on what remains in the input to generate another list 3. concatenate the two lists If either of the parsers fail, the whole thing fails.

Think of the type as

(<++>) :: Parser [a] -> Parser [a] -> Parser [a]

Filtering

(<=>) :: MonadPlus parser => parser a -> (a -> Bool) -> parser a infix 7 #

Given a parser and a predicate, return the result of the parser only if it also satisfies the predicate.

Think of the type as

(<=>) :: Parser a -> (a -> Bool) -> Parser a

Single characters

getCharThat :: (Char -> Bool) -> Parser Char #

Return a character result only if the character satisfies a given predicate

digit :: Parser Char #

Parse a single character that is a digit

letter :: Parser Char #

Parse a single alphabetic character (uppercase or lowercase)

space :: Parser Char #

Parse a character that is whitespace (e.g., space, tab, newline, etc.)

alphanum :: Parser Char #

Parse a character that is either a digit or a letter

char :: Char -> Parser Char #

Returns c, if c is the next character in the input NOTE: This parser adds a better error message using ??. To see the difference, compare the error messages from these two parsers that look for a single x: parse (get = (== x)) "y" parse (char x) "y"

Strings

text :: String -> Parser String #

Like string but skips any whitespace that precedes the string.

string :: String -> Parser String #

Returns a specific sequence of characters, if those are exactly the next characters in the input

litstring :: Parser String #

A string literal is a sequence of string characters inside quotation marks, optionally surrounded by some whitespace.

stringchar :: Parser Char #

A string character is either any character that is not a double quote, or the escape sequence " (which we interpret as a double quote character inside our string)

Symbols

sym :: Char -> Parser Char #

Like char but skips any whitespace that precedes the char.

openparen :: Parser Char #

Parses the character '('

closeparen :: Parser Char #

Parses the character ')'

parens :: Parser a -> Parser a #

Given a parser p, succeeds if the input string contains a parenthesis-delimited string that matches the parser p.

openbrace :: Parser Char #

Parses the character '{'

closebrace :: Parser Char #

Parses the character '}'

braces :: Parser a -> Parser a #

Given a parser p, succeeds if the input string contains a braces-delimited string that matches the parser p.

Whitespace

whitespace :: Parser () #

A parser that ignores whitespace (by consuming it from the input and returning unit).

skipws :: Parser a -> Parser a #

Returns a parser that parses what p does, but skips any whitespace that appears at the beginning of the input string.

Identifiers and reserved words

identifier :: Parser String #

Parse an identifier, defined here as a letter, followed by zero or more alphanumeric characters.

ident :: Parser String #

Like identifier but skips any whitespace that precedes the identifier.

reservedword :: String -> Parser String #

A parser for a reserved word. A reserved word has the same restrictions as an identifier, but also has a particular name (e.g., "while")

rword :: String -> Parser String #

Like reservedword but skips any whitespace that precedes the reserved word.

Numbers

number :: Parser Integer #

Parse an Integer

num :: Parser Integer #

Like number but skips any whitespace that precedes the number.

double :: Parser Double #

Parse a double, ignoring whitespace

Repetition, alternation, options, and delimiting

many :: Alternative f => f a -> f [a] #

Zero or more matches. Think of the type as:

many :: Parser a -> Parser [a]

some :: Alternative f => f a -> f [a] #

One or more matches. Think of the type as:

some :: Parser a -> Parser [a]

many1 :: Parser a -> Parser [a] #

Equivalent to some (because some people like to call the "some" parser "many1")

skipMany :: Alternative f => f a -> f () #

Like many but instead of returning the results, throws them away. Think of the type as:

skipMany :: Parser a -> Parser ()

skipMany1 :: Alternative parser => parser a -> parser () #

Like many1 but instead of returning the results, throws them away. Think of the type as:

skipMany1 :: Parser a -> Parser ()

optional :: (Alternative parser, Alternative t) => parser a -> parser (t a) #

Tries to parse a p, but also succeeds if it doesn't find a p You can think of the type of optional as being either of these:

optional :: Parser a -> Parser (Maybe a)
optional :: Parser a -> Parser [a]

but actually we use a more general type .

perhaps :: (Alternative p, Monad m, Alternative m) => p (m a) -> p (m a) #

Like optional p, but has different type, it assumes we're trying to parse something type that has a built-in notion of emptiness (e.g., strings with "", lists with [], etc.), specifically something with mzero value. If we can't parse the thing, we return that empty value. You can think of the type of perhaps as being one of these:

perhaps :: Parser String -> Parser String
perhaps :: Parser [a] -> Parser [a]
perhaps :: Parser (Maybe a) -> Parser (Maybe a)

but actually we use a more general type.

manyEndingWith :: Alternative parser => parser b -> parser a -> parser [a] #

Equivalent to many p +- end *except* that it the above might give error messages related to not being able to parse end (because many always succeeds), whereas this version can give the best error message out of the one for not parsing p and not parsing end.

In practice, our strategy of choosing the deepest error message should mean that we don't need this function.

Think of the type as:

manyEndingWith :: Parser a -> Parser b -> Parser [b]

someEndingWith :: Alternative parser => parser b -> parser a -> parser [a] #

Equivalent to some p +- end *except* that it the above might give error messages related to not being able to parse end (because some always succeeds if it can read at least one p), whereas this version can give the best error message out of the one for not parsing p and not parsing end.

In practice, our strategy of choosing the deepest error message should mean that we don't need this function.

Think of the type as:

someEndingWith :: Parser a -> Parser b -> Parser [b]

between :: Applicative parser => parser open -> parser close -> parser a -> parser a #

Parse something that is surrounded by delimiters (e.g., parentheses). Note the order of its arguments: it takes the parser's delimiters *first*, and *then* the thing to parse inside them

Think of the type as:

between :: Parser a -> Parser b -> Parser c -> Parser c

sepBy :: Alternative parser => parser a -> parser sep -> parser [a] #

Given two parsers p and sep, succeeds if the input string contains a sep-delimited sequence of zero or more things that match p. The delimiters will be thrown away and we'll be left with a (possibly empty) list of all the matches for p.

Think of the type as:

sepBy :: Parser a -> Parser b -> Parser [a]

sepBy1 :: Alternative parser => parser a -> parser sep -> parser [a] #

Given two parsers p and sep, succeeds if the input string contains a sep-delimited sequence of one or more things that match p. The delimiters will be thrown away and we'll be left with a list of all the matches for p.

Think of the type as:

sepBy1 :: Parser a -> Parser b -> Parser [a]

endBy :: Alternative parser => parser a -> parser sep -> parser [a] #

Similar to sepBy, but the delimiter must also appear at the end.

Think of the type as:

endBy :: Parser a -> Parser b -> Parser [a]

endBy1 :: Alternative parser => parser a -> parser sep -> parser [a] #

Similar to sepBy1, but the delimiter must also appear at the end.

Think of the type as:

endBy1 :: Parser a -> Parser b -> Parser [a]

chainr1 :: Alternative parser => parser a -> parser (a -> a -> a) -> parser a #

Adapts foldr to work on parse results

Think of the type as:

chainr1 :: Parser a -> Parser (a -> a -> a) -> Parser a

chainl1 :: Alternative parser => parser a -> parser (a -> a -> a) -> parser a #

Adapts foldl to work on parse results

Think of the type as:

chainl1 :: Parser a -> Parser (a -> a -> a) -> Parser a

Error messages

(<??>) :: Parser a -> String -> Parser a infixl 3 #

Given a parser p, makes a new parser where if p fails, the new parser also fails, but unconditionally replaces p's error message with errMsg. All error information from p (including how far it got) is thrown away. (This operator uses <||> which is identical to <|> except that it handles error messages slightly differently).

(<???>) :: Parser a -> String -> Parser a infixl 3 #

Given a parser p, makes a new parser where if p fails, the new parser also fails, but it can replace a parser's failure error message with a new one. But unlike <??>, we only do the replacement if the parser got *nowhere* with things. If it made some headway at all, we let its error message stand, in the hope it'll be more useful.