Copyright | © 2015–2016 Megaparsec contributors © 2007 Paolo Martini © 1999–2001 Daan Leijen |
---|---|
License | FreeBSD |
Maintainer | Mark Karpov <markkarpov@opmbx.org> |
Stability | experimental |
Portability | non-portable (MPTC with FD) |
Safe Haskell | None |
Language | Haskell2010 |
The primitive parser combinators.
- data State s = State {
- stateInput :: s
- statePos :: !SourcePos
- stateTabWidth :: !Int
- class (ShowToken t, ShowToken [t]) => Stream s t | s -> t where
- class Stream s t => StorableStream s t where
- type Parsec s = ParsecT s Identity
- data ParsecT s m a
- class (Alternative m, MonadPlus m, Stream s t) => MonadParsec s m t | m -> s t where
- failure :: [Message] -> m a
- label :: String -> m a -> m a
- hidden :: m a -> m a
- try :: m a -> m a
- lookAhead :: m a -> m a
- notFollowedBy :: m a -> m ()
- withRecovery :: (ParseError -> m a) -> m a -> m a
- eof :: m ()
- token :: (Int -> SourcePos -> t -> SourcePos) -> (t -> Either [Message] a) -> m a
- tokens :: Eq t => (Int -> SourcePos -> [t] -> SourcePos) -> (t -> t -> Bool) -> [t] -> m [t]
- getParserState :: m (State s)
- updateParserState :: (State s -> State s) -> m ()
- (<?>) :: MonadParsec s m t => m a -> String -> m a
- unexpected :: MonadParsec s m t => String -> m a
- getInput :: MonadParsec s m t => m s
- setInput :: MonadParsec s m t => s -> m ()
- getPosition :: MonadParsec s m t => m SourcePos
- setPosition :: MonadParsec s m t => SourcePos -> m ()
- getTabWidth :: MonadParsec s m t => m Int
- setTabWidth :: MonadParsec s m t => Int -> m ()
- setParserState :: MonadParsec s m t => State s -> m ()
- runParser :: Stream s t => Parsec s a -> String -> s -> Either ParseError a
- runParser' :: Stream s t => Parsec s a -> State s -> (State s, Either ParseError a)
- runParserT :: (Monad m, Stream s t) => ParsecT s m a -> String -> s -> m (Either ParseError a)
- runParserT' :: (Monad m, Stream s t) => ParsecT s m a -> State s -> m (State s, Either ParseError a)
- parse :: Stream s t => Parsec s a -> String -> s -> Either ParseError a
- parseMaybe :: Stream s t => Parsec s a -> s -> Maybe a
- parseTest :: (Stream s t, Show a) => Parsec s a -> s -> IO ()
- parseFromFile :: StorableStream s t => Parsec s a -> FilePath -> IO (Either ParseError a)
Data types
This is Megaparsec state, it's parametrized over stream type s
.
State | |
|
class (ShowToken t, ShowToken [t]) => Stream s t | s -> t where Source
An instance of Stream s t
has stream type s
, and token type t
determined by the stream.
class Stream s t => StorableStream s t where Source
StorableStream
abstracts ability of some streams to be stored in a
file. This is used by the polymorphic function parseFromFile
.
type Parsec s = ParsecT s Identity Source
Parsec
is non-transformer variant of more general ParsecT
monad transformer.
ParsecT s m a
is a parser with stream type s
, underlying monad m
and return type a
.
MonadError e m => MonadError e (ParsecT s m) Source | |
MonadReader r m => MonadReader r (ParsecT s m) Source | |
MonadState s m => MonadState s (ParsecT s' m) Source | |
Stream s t => MonadParsec s (ParsecT s m) t Source | |
MonadTrans (ParsecT s) Source | |
Monad (ParsecT s m) Source | |
Functor (ParsecT s m) Source | |
Applicative (ParsecT s m) Source | |
Alternative (ParsecT s m) Source | |
MonadPlus (ParsecT s m) Source | |
MonadFail (ParsecT s m) Source | |
MonadIO m => MonadIO (ParsecT s m) Source | |
MonadCont m => MonadCont (ParsecT s m) Source |
Primitive combinators
class (Alternative m, MonadPlus m, Stream s t) => MonadParsec s m t | m -> s t where Source
Type class describing parsers independent of input type.
failure, label, try, lookAhead, notFollowedBy, withRecovery, eof, token, tokens, getParserState, updateParserState
failure :: [Message] -> m a Source
The most general way to stop parsing and report ParseError
.
unexpected
is defined in terms of the function:
unexpected = failure . pure . Unexpected
Since: 4.2.0
label :: String -> m a -> m a Source
The parser label name p
behaves as parser p
, but whenever the
parser p
fails without consuming any input, it replaces names of
“expected” tokens with the name name
.
hidden p
behaves just like parser p
, but it doesn't show any
“expected” tokens in error message when p
fails.
The parser try p
behaves like parser p
, except that it
pretends that it hasn't consumed any input when an error occurs.
This combinator is used whenever arbitrary look ahead is needed. Since
it pretends that it hasn't consumed any input when p
fails, the
(<|>
) combinator will try its second alternative even when the
first parser failed while consuming input.
For example, here is a parser that will try (sorry for the pun) to parse word “let” or “lexical”:
>>>
parseTest (string "let" <|> string "lexical") "lexical"
1:1: unexpected "lex" expecting "let"
What happens here? First parser consumes “le” and fails (because it
doesn't see a “t”). The second parser, however, isn't tried, since the
first parser has already consumed some input! try
fixes this
behavior and allows backtracking to work:
>>>
parseTest (try (string "let") <|> string "lexical") "lexical"
"lexical"
try
also improves error messages in case of overlapping alternatives,
because Megaparsec's hint system can be used:
>>>
parseTest (try (string "let") <|> string "lexical") "le"
1:1: unexpected "le" expecting "let" or "lexical"
Please note that as of Megaparsec 4.4.0, string
backtracks
automatically (see tokens
), so it does not need try
. However, the
examples above demonstrate the idea behind try
so well that it was
decided to keep them.
lookAhead :: m a -> m a Source
lookAhead p
parses p
without consuming any input.
If p
fails and consumes some input, so does lookAhead
. Combine with
try
if this is undesirable.
notFollowedBy :: m a -> m () Source
notFollowedBy p
only succeeds when parser p
fails. This parser
does not consume any input and can be used to implement the “longest
match” rule.
:: (ParseError -> m a) | How to recover from failure |
-> m a | Original parser |
-> m a | Parser that can recover from failures |
withRecovery r p
allows continue parsing even if parser p
fails. In this case r
is called with actual ParseError
as its
argument. Typical usage is to return value signifying failure to parse
this particular object and to consume some part of input up to start of
next object.
Note that if r
fails, original error message is reported as if
without withRecovery
. In no way recovering parser r
can influence
error messages.
Since: 4.4.0
This parser only succeeds at the end of the input.
:: (Int -> SourcePos -> t -> SourcePos) | Next position calculating function |
-> (t -> Either [Message] a) | Matching function for the token to parse |
-> m a |
The parser token nextPos testTok
accepts a token t
with result
x
when the function testTok t
returns
. The position of
the next token should be returned when Right
xnextPos
is called with the
tab width, current source position, and the current token.
This is the most primitive combinator for accepting tokens. For
example, the char
parser could be implemented
as:
char c = token updatePosChar testChar where testChar x = if x == c then Right x else Left . pure . Unexpected . showToken $ x
:: Eq t | |
=> (Int -> SourcePos -> [t] -> SourcePos) | Computes position of tokens |
-> (t -> t -> Bool) | Predicate to check equality of tokens |
-> [t] | List of tokens to parse |
-> m [t] |
The parser tokens posFromTok test
parses list of tokens and returns
it. posFromTok
is called with three arguments: tab width, initial
position, and collection of tokens to parse. The resulting parser will
use showToken
to pretty-print the collection of tokens in error
messages. Supplied predicate test
is used to check equality of given
and parsed tokens.
This can be used for example to write string
:
string = tokens updatePosString (==)
Note that beginning from Megaparsec 4.4.0, this is an auto-backtracking
primitive, which means that if it fails, it never consumes any
input. This is done to make its consumption model match how error
messages for this primitive are reported (which becomes an important
thing as user gets more control with primitives like withRecovery
):
>>>
parseTest (string "abc") "abd"
1:1: unexpected "abd" expecting "abc"
This means, in particular, that it's no longer necessary to use try
with tokens
-based parsers, such as string
and
string'
. This new feature does not affect
performance in any way.
getParserState :: m (State s) Source
Returns the full parser state as a State
record.
updateParserState :: (State s -> State s) -> m () Source
updateParserState f
applies function f
to the parser state.
MonadParsec s m t => MonadParsec s (IdentityT m) t Source | |
(Monoid w, MonadParsec s m t) => MonadParsec s (WriterT w m) t Source | |
(Monoid w, MonadParsec s m t) => MonadParsec s (WriterT w m) t Source | |
MonadParsec s m t => MonadParsec s (ReaderT e m) t Source | |
MonadParsec s m t => MonadParsec s (StateT e m) t Source | |
MonadParsec s m t => MonadParsec s (StateT e m) t Source | |
Stream s t => MonadParsec s (ParsecT s m) t Source |
(<?>) :: MonadParsec s m t => m a -> String -> m a infix 0 Source
A synonym for label
in form of an operator.
unexpected :: MonadParsec s m t => String -> m a Source
The parser unexpected msg
always fails with an unexpected error
message msg
without consuming any input.
The parsers fail
, label
and unexpected
are the three parsers used
to generate error messages. Of these, only label
is commonly used.
Parser state combinators
getInput :: MonadParsec s m t => m s Source
Returns the current input.
setInput :: MonadParsec s m t => s -> m () Source
setInput input
continues parsing with input
. The getInput
and
setInput
functions can for example be used to deal with #include files.
getPosition :: MonadParsec s m t => m SourcePos Source
Returns the current source position.
See also: SourcePos
.
setPosition :: MonadParsec s m t => SourcePos -> m () Source
setPosition pos
sets the current source position to pos
.
getTabWidth :: MonadParsec s m t => m Int Source
Returns tab width. Default tab width is equal to defaultTabWidth
. You
can set different tab width with help of setTabWidth
.
setTabWidth :: MonadParsec s m t => Int -> m () Source
Set tab width. If argument of the function is not positive number,
defaultTabWidth
will be used.
setParserState :: MonadParsec s m t => State s -> m () Source
setParserState st
set the full parser state to st
.
Running parser
:: Stream s t | |
=> Parsec s a | Parser to run |
-> String | Name of source file |
-> s | Input for parser |
-> Either ParseError a |
runParser p file input
runs parser p
on the input list of tokens
input
, obtained from source file
. The file
is only used in error
messages and may be the empty string. Returns either a ParseError
(Left
) or a value of type a
(Right
).
parseFromFile p file = runParser p file <$> readFile file
:: (Monad m, Stream s t) | |
=> ParsecT s m a | Parser to run |
-> String | Name of source file |
-> s | Input for parser |
-> m (Either ParseError a) |
runParserT p file input
runs parser p
on the input list of tokens
input
, obtained from source file
. The file
is only used in error
messages and may be the empty string. Returns a computation in the
underlying monad m
that returns either a ParseError
(Left
) or a
value of type a
(Right
).
:: (Monad m, Stream s t) | |
=> ParsecT s m a | Parser to run |
-> State s | Initial state |
-> m (State s, Either ParseError a) |
This function is similar to runParserT
, but like runParser'
it
accepts and returns parser state. This is thus the most general way to
run a parser.
Since: 4.2.0
:: Stream s t | |
=> Parsec s a | Parser to run |
-> String | Name of source file |
-> s | Input for parser |
-> Either ParseError a |
parse p file input
runs parser p
over Identity
(see runParserT
if you're using the ParsecT
monad transformer; parse
itself is just a
synonym for runParser
). It returns either a ParseError
(Left
) or a
value of type a
(Right
). show
or print
can be used to turn
ParseError
into the string representation of the error message. See
Text.Megaparsec.Error if you need to do more advanced error analysis.
main = case (parse numbers "" "11, 2, 43") of Left err -> print err Right xs -> print (sum xs) numbers = commaSep integer
parseMaybe :: Stream s t => Parsec s a -> s -> Maybe a Source
parseMaybe p input
runs parser p
on input
and returns result
inside Just
on success and Nothing
on failure. This function also
parses eof
, so if the parser doesn't consume all of its input, it will
fail.
The function is supposed to be useful for lightweight parsing, where error messages (and thus file name) are not important and entire input should be parsed. For example it can be used when parsing of single number according to specification of its format is desired.
parseTest :: (Stream s t, Show a) => Parsec s a -> s -> IO () Source
The expression parseTest p input
applies a parser p
against
input input
and prints the result to stdout. Used for testing.
:: StorableStream s t | |
=> Parsec s a | Parser to run |
-> FilePath | Name of file to parse |
-> IO (Either ParseError a) |
parseFromFile p filename
runs parser p
on the input read from
filename
. Returns either a ParseError
(Left
) or a value of type a
(Right
).
main = do result <- parseFromFile numbers "digits.txt" case result of Left err -> print err Right xs -> print $ sum xs