Copyright | (c) Paolo Martini 2007 |
---|---|
License | BSD-style (see the LICENSE file) |
Maintainer | derek.a.elkins@gmail.com |
Stability | provisional |
Portability | portable |
Safe Haskell | Safe |
Language | Haskell2010 |
Parsec compatibility module
Synopsis
- (<?>) :: ParsecT s u m a -> String -> ParsecT s u m a
- (<|>) :: ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
- type Parser = Parsec String ()
- type GenParser tok st = Parsec [tok] st
- runParser :: GenParser tok st a -> st -> SourceName -> [tok] -> Either ParseError a
- parse :: Stream s Identity t => Parsec s () a -> SourceName -> s -> Either ParseError a
- parseFromFile :: Parser a -> FilePath -> IO ( Either ParseError a)
- parseTest :: ( Stream s Identity t, Show a) => Parsec s () a -> s -> IO ()
- token :: Stream s Identity t => (t -> String ) -> (t -> SourcePos ) -> (t -> Maybe a) -> Parsec s u a
- tokens :: ( Stream s m t, Eq t) => ([t] -> String ) -> ( SourcePos -> [t] -> SourcePos ) -> [t] -> ParsecT s u m [t]
- tokenPrim :: Stream s m t => (t -> String ) -> ( SourcePos -> t -> s -> SourcePos ) -> (t -> Maybe a) -> ParsecT s u m a
- tokenPrimEx :: Stream s m t => (t -> String ) -> ( SourcePos -> t -> s -> SourcePos ) -> Maybe ( SourcePos -> t -> s -> u -> u) -> (t -> Maybe a) -> ParsecT s u m a
- try :: GenParser tok st a -> GenParser tok st a
- label :: ParsecT s u m a -> String -> ParsecT s u m a
- labels :: ParsecT s u m a -> [ String ] -> ParsecT s u m a
- unexpected :: Stream s m t => String -> ParsecT s u m a
- pzero :: GenParser tok st a
- many :: ParsecT s u m a -> ParsecT s u m [a]
- skipMany :: ParsecT s u m a -> ParsecT s u m ()
- getState :: Monad m => ParsecT s u m u
- setState :: Monad m => u -> ParsecT s u m ()
- updateState :: Monad m => (u -> u) -> ParsecT s u m ()
- getPosition :: Monad m => ParsecT s u m SourcePos
- setPosition :: Monad m => SourcePos -> ParsecT s u m ()
- getInput :: Monad m => ParsecT s u m s
- setInput :: Monad m => s -> ParsecT s u m ()
-
data
State
s u =
State
{
- stateInput :: s
- statePos :: ! SourcePos
- stateUser :: !u
- getParserState :: Monad m => ParsecT s u m ( State s u)
- setParserState :: Monad m => State s u -> ParsecT s u m ( State s u)
Documentation
(<?>) :: ParsecT s u m a -> String -> ParsecT s u m a infix 0 Source #
The parser
p <?> msg
behaves as parser
p
, but whenever the
parser
p
fails
without consuming any input
, it replaces expect
error messages with the expect error message
msg
.
This is normally used at the end of a set alternatives where we want
to return an error message in terms of a higher level construct
rather than returning all possible characters. For example, if the
expr
parser from the
try
example would fail, the error
message is: '...: expecting expression'. Without the
(<?>)
combinator, the message would be like '...: expecting "let" or
letter', which is less friendly.
(<|>) :: ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a infixr 1 Source #
This combinator implements choice. The parser
p <|> q
first
applies
p
. If it succeeds, the value of
p
is returned. If
p
fails
without consuming any input
, parser
q
is tried. This
combinator is defined equal to the
mplus
member of the
MonadPlus
class and the (
<|>
) member of
Alternative
.
The parser is called
predictive
since
q
is only tried when
parser
p
didn't consume any input (i.e.. the look ahead is 1).
This non-backtracking behaviour allows for both an efficient
implementation of the parser combinators and the generation of good
error messages.
runParser :: GenParser tok st a -> st -> SourceName -> [tok] -> Either ParseError a Source #
parse :: Stream s Identity t => Parsec s () a -> SourceName -> s -> Either ParseError a Source #
parse p filePath input
runs a parser
p
over Identity without user
state. The
filePath
is only used in error messages and may be the
empty string. Returns either a
ParseError
(
Left
)
or a value of type
a
(
Right
).
main = case (parse numbers "" "11, 2, 43") of Left err -> print err Right xs -> print (sum xs) numbers = commaSep integer
parseFromFile :: Parser a -> FilePath -> IO ( Either ParseError a) Source #
parseFromFile p filePath
runs a string parser
p
on the
input read from
filePath
using
readFile
. 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) }
parseTest :: ( Stream s Identity 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
parsers.
:: Stream s Identity t | |
=> (t -> String ) |
Token pretty-printing function. |
-> (t -> SourcePos ) |
Computes the position of a token. |
-> (t -> Maybe a) |
Matching function for the token to parse. |
-> Parsec s u a |
The parser
token showTok posFromTok testTok
accepts a token
t
with result
x
when the function
testTok t
returns
. The
source position of the
Just
x
t
should be returned by
posFromTok t
and
the token can be shown using
showTok t
.
This combinator is expressed in terms of
tokenPrim
.
It is used to accept user defined token streams. For example,
suppose that we have a stream of basic tokens tupled with source
positions. We can then define a parser that accepts single tokens as:
mytoken x = token showTok posFromTok testTok where showTok (pos,t) = show t posFromTok (pos,t) = pos testTok (pos,t) = if x == t then Just t else Nothing
tokens :: ( Stream s m t, Eq t) => ([t] -> String ) -> ( SourcePos -> [t] -> SourcePos ) -> [t] -> ParsecT s u m [t] Source #
:: Stream s m t | |
=> (t -> String ) |
Token pretty-printing function. |
-> ( SourcePos -> t -> s -> SourcePos ) |
Next position calculating function. |
-> (t -> Maybe a) |
Matching function for the token to parse. |
-> ParsecT s u m a |
The parser
tokenPrim showTok nextPos testTok
accepts a token
t
with result
x
when the function
testTok t
returns
. The
token can be shown using
Just
x
showTok t
. The position of the
next
token should be returned when
nextPos
is called with the current
source position
pos
, the current token
t
and the rest of the
tokens
toks
,
nextPos pos t toks
.
This is the most primitive combinator for accepting tokens. For
example, the
char
parser could be implemented as:
char c = tokenPrim showChar nextPos testChar where showChar x = "'" ++ x ++ "'" testChar x = if x == c then Just x else Nothing nextPos pos x xs = updatePosChar pos x
tokenPrimEx :: Stream s m t => (t -> String ) -> ( SourcePos -> t -> s -> SourcePos ) -> Maybe ( SourcePos -> t -> s -> u -> u) -> (t -> Maybe a) -> ParsecT s u m a Source #
label :: ParsecT s u m a -> String -> ParsecT s u m a Source #
A synonym for
<?>
, but as a function instead of an operator.
unexpected :: Stream s m t => String -> ParsecT s u m a Source #
The parser
unexpected msg
always fails with an unexpected error
message
msg
without consuming any input.
The parsers
fail
, (
<?>
) and
unexpected
are the three parsers
used to generate error messages. Of these, only (
<?>
) is commonly
used. For an example of the use of
unexpected
, see the definition
of
notFollowedBy
.
many :: ParsecT s u m a -> ParsecT s u m [a] Source #
many p
applies the parser
p
zero
or more times. Returns a
list of the returned values of
p
.
identifier = do{ c <- letter ; cs <- many (alphaNum <|> char '_') ; return (c:cs) }
skipMany :: ParsecT s u m a -> ParsecT s u m () Source #
skipMany p
applies the parser
p
zero
or more times, skipping
its result.
spaces = skipMany space
setState :: Monad m => u -> ParsecT s u m () Source #
An alias for putState for backwards compatibility.
updateState :: Monad m => (u -> u) -> ParsecT s u m () Source #
An alias for modifyState for backwards compatibility.
getPosition :: Monad m => ParsecT s u m SourcePos Source #
Returns the current source position. See also
SourcePos
.
setPosition :: Monad m => SourcePos -> ParsecT s u m () Source #
setPosition pos
sets the current source position to
pos
.
setInput :: Monad m => s -> ParsecT s u m () Source #
setInput input
continues parsing with
input
. The
getInput
and
setInput
functions can for example be used to deal with #include
files.