parsec-3.1.14.0: Monadic parser combinators
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

Text.ParserCombinators.Parsec.Prim

Description

Parsec compatibility module

Synopsis

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.

type GenParser tok st = Parsec [tok] st 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.

token Source #

Arguments

:: 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 Just x . The source position of the 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 #

tokenPrim Source #

Arguments

:: 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 Just x . The token can be shown using 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

getState :: Monad m => ParsecT s u m u Source #

Returns the current user state.

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 .

getInput :: Monad m => ParsecT s u m s Source #

Returns the current input

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.

getParserState :: Monad m => ParsecT s u m ( State s u) Source #

Returns the full parser state as a State record.

setParserState :: Monad m => State s u -> ParsecT s u m ( State s u) Source #

setParserState st set the full parser state to st .