Copyright |
© 2015–present Megaparsec contributors
© 2007 Paolo Martini © 1999–2001 Daan Leijen |
---|---|
License | FreeBSD |
Maintainer | Mark Karpov <markkarpov92@gmail.com> |
Stability | experimental |
Portability | portable |
Safe Haskell | Safe |
Language | Haskell2010 |
This module includes everything you need to get started writing a parser. If you are new to Megaparsec and don't know where to begin, take a look at the tutorial https://markkarpov.com/tutorial/megaparsec.html .
In addition to the
Text.Megaparsec
module, which exports and re-exports
almost everything that you may need, we advise to import
Text.Megaparsec.Char
if you plan to work with a stream of
Char
tokens
or
Text.Megaparsec.Byte
if you intend to parse binary data.
It is common to start working with the library by defining a type synonym like this:
type Parser = Parsec Void Text ^ ^ | | Custom error component Input stream type
Then you can write type signatures like
Parser
—for a parser that
returns an
Int
Int
for example.
Similarly (since it's known to cause confusion), you should use
ParseErrorBundle
type parametrized like this:
ParseErrorBundle Text Void ^ ^ | | Input stream type Custom error component (the same you used in Parser)
Megaparsec uses some type-level machinery to provide flexibility without
compromising on type safety. Thus type signatures are sometimes necessary
to avoid ambiguous types. If you're seeing an error message that reads
like “Type variable
e0
is ambiguous …”, you need to give an explicit
signature to your parser to resolve the ambiguity. It's a good idea to
provide type signatures for all top-level definitions.
Synopsis
- module Text.Megaparsec.Pos
- module Text.Megaparsec.Error
- module Text.Megaparsec.Stream
- module Control.Monad.Combinators
-
data
State
s e =
State
{
- stateInput :: s
- stateOffset :: ! Int
- statePosState :: PosState s
- stateParseErrors :: [ ParseError s e]
-
data
PosState
s =
PosState
{
- pstateInput :: s
- pstateOffset :: ! Int
- pstateSourcePos :: ! SourcePos
- pstateTabWidth :: Pos
- pstateLinePrefix :: String
- type Parsec e s = ParsecT e s Identity
- data ParsecT e s m a
- parse :: Parsec e s a -> String -> s -> Either ( ParseErrorBundle s e) a
- parseMaybe :: ( Ord e, Stream s) => Parsec e s a -> s -> Maybe a
- parseTest :: ( ShowErrorComponent e, Show a, VisualStream s, TraversableStream s) => Parsec e s a -> s -> IO ()
- runParser :: Parsec e s a -> String -> s -> Either ( ParseErrorBundle s e) a
- runParser' :: Parsec e s a -> State s e -> ( State s e, Either ( ParseErrorBundle s e) a)
- runParserT :: Monad m => ParsecT e s m a -> String -> s -> m ( Either ( ParseErrorBundle s e) a)
- runParserT' :: Monad m => ParsecT e s m a -> State s e -> m ( State s e, Either ( ParseErrorBundle s e) a)
-
class
(
Stream
s,
MonadPlus
m) =>
MonadParsec
e s m | m -> e s
where
- parseError :: ParseError s e -> 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 s e -> m a) -> m a -> m a
- observing :: m a -> m ( Either ( ParseError s e) a)
- eof :: m ()
- token :: ( Token s -> Maybe a) -> Set ( ErrorItem ( Token s)) -> m a
- tokens :: ( Tokens s -> Tokens s -> Bool ) -> Tokens s -> m ( Tokens s)
- takeWhileP :: Maybe String -> ( Token s -> Bool ) -> m ( Tokens s)
- takeWhile1P :: Maybe String -> ( Token s -> Bool ) -> m ( Tokens s)
- takeP :: Maybe String -> Int -> m ( Tokens s)
- getParserState :: m ( State s e)
- updateParserState :: ( State s e -> State s e) -> m ()
- failure :: MonadParsec e s m => Maybe ( ErrorItem ( Token s)) -> Set ( ErrorItem ( Token s)) -> m a
- fancyFailure :: MonadParsec e s m => Set ( ErrorFancy e) -> m a
- unexpected :: MonadParsec e s m => ErrorItem ( Token s) -> m a
- customFailure :: MonadParsec e s m => e -> m a
- region :: MonadParsec e s m => ( ParseError s e -> ParseError s e) -> m a -> m a
- registerParseError :: MonadParsec e s m => ParseError s e -> m ()
- registerFailure :: MonadParsec e s m => Maybe ( ErrorItem ( Token s)) -> Set ( ErrorItem ( Token s)) -> m ()
- registerFancyFailure :: MonadParsec e s m => Set ( ErrorFancy e) -> m ()
- single :: MonadParsec e s m => Token s -> m ( Token s)
- satisfy :: MonadParsec e s m => ( Token s -> Bool ) -> m ( Token s)
- anySingle :: MonadParsec e s m => m ( Token s)
- anySingleBut :: MonadParsec e s m => Token s -> m ( Token s)
- oneOf :: ( Foldable f, MonadParsec e s m) => f ( Token s) -> m ( Token s)
- noneOf :: ( Foldable f, MonadParsec e s m) => f ( Token s) -> m ( Token s)
- chunk :: MonadParsec e s m => Tokens s -> m ( Tokens s)
- (<?>) :: MonadParsec e s m => m a -> String -> m a
- match :: MonadParsec e s m => m a -> m ( Tokens s, a)
- takeRest :: MonadParsec e s m => m ( Tokens s)
- atEnd :: MonadParsec e s m => m Bool
- getInput :: MonadParsec e s m => m s
- setInput :: MonadParsec e s m => s -> m ()
- getSourcePos :: ( TraversableStream s, MonadParsec e s m) => m SourcePos
- getOffset :: MonadParsec e s m => m Int
- setOffset :: MonadParsec e s m => Int -> m ()
- setParserState :: MonadParsec e s m => State s e -> m ()
Re-exports
Note that we re-export monadic combinators from
Control.Monad.Combinators
because these are more efficient than
Applicative
-based ones. Thus
many
and
some
may clash with the
functions from
Control.Applicative
. You need to hide the functions like
this:
import Control.Applicative hiding (many, some)
Also note that you can import
Control.Monad.Combinators.NonEmpty
if you
wish that combinators like
some
return
NonEmpty
lists. The module
lives in the
parser-combinators
package (you need at least version
0.4.0
).
This module is intended to be imported qualified:
import qualified Control.Monad.Combinators.NonEmpty as NE
Other modules of interest are:
- Control.Monad.Combinators.Expr for parsing of expressions.
- Control.Applicative.Permutations for parsing of permutations phrases.
module Text.Megaparsec.Pos
module Text.Megaparsec.Error
module Text.Megaparsec.Stream
module Control.Monad.Combinators
Data types
This is the Megaparsec's state parametrized over stream type
s
and
custom error component type
e
.
State | |
|
Instances
( Eq ( ParseError s e), Eq s) => Eq ( State s e) Source # | |
( Data e, Data ( ParseError s e), Data s) => Data ( State s e) Source # | |
Defined in Text.Megaparsec.State gfoldl :: ( forall d b. Data d => c (d -> b) -> d -> c b) -> ( forall g. g -> c g) -> State s e -> c ( State s e) Source # gunfold :: ( forall b r. Data b => c (b -> r) -> c r) -> ( forall r. r -> c r) -> Constr -> c ( State s e) Source # toConstr :: State s e -> Constr Source # dataTypeOf :: State s e -> DataType Source # dataCast1 :: Typeable t => ( forall d. Data d => c (t d)) -> Maybe (c ( State s e)) Source # dataCast2 :: Typeable t => ( forall d e0. ( Data d, Data e0) => c (t d e0)) -> Maybe (c ( State s e)) Source # gmapT :: ( forall b. Data b => b -> b) -> State s e -> State s e Source # gmapQl :: (r -> r' -> r) -> r -> ( forall d. Data d => d -> r') -> State s e -> r Source # gmapQr :: forall r r'. (r' -> r -> r) -> r -> ( forall d. Data d => d -> r') -> State s e -> r Source # gmapQ :: ( forall d. Data d => d -> u) -> State s e -> [u] Source # gmapQi :: Int -> ( forall d. Data d => d -> u) -> State s e -> u Source # gmapM :: Monad m => ( forall d. Data d => d -> m d) -> State s e -> m ( State s e) Source # gmapMp :: MonadPlus m => ( forall d. Data d => d -> m d) -> State s e -> m ( State s e) Source # gmapMo :: MonadPlus m => ( forall d. Data d => d -> m d) -> State s e -> m ( State s e) Source # |
|
( Show ( ParseError s e), Show s) => Show ( State s e) Source # | |
Generic ( State s e) Source # | |
( NFData s, NFData ( ParseError s e)) => NFData ( State s e) Source # | |
Defined in Text.Megaparsec.State |
|
type Rep ( State s e) Source # | |
Defined in Text.Megaparsec.State
type
Rep
(
State
s e) =
D1
('
MetaData
"State" "Text.Megaparsec.State" "megaparsec-9.2.1-EI4cRL0SAfYAOxBOfPeCV9" '
False
) (
C1
('
MetaCons
"State" '
PrefixI
'
True
) ((
S1
('
MetaSel
('
Just
"stateInput") '
NoSourceUnpackedness
'
NoSourceStrictness
'
DecidedLazy
) (
Rec0
s)
:*:
S1
('
MetaSel
('
Just
"stateOffset") '
SourceUnpack
'
SourceStrict
'
DecidedStrict
) (
Rec0
Int
))
:*:
(
S1
('
MetaSel
('
Just
"statePosState") '
NoSourceUnpackedness
'
NoSourceStrictness
'
DecidedLazy
) (
Rec0
(
PosState
s))
:*:
S1
('
MetaSel
('
Just
"stateParseErrors") '
NoSourceUnpackedness
'
NoSourceStrictness
'
DecidedLazy
) (
Rec0
[
ParseError
s e]))))
|
A special kind of state that is used to calculate line/column positions on demand.
Since: 7.0.0
PosState | |
|
Instances
Eq s => Eq ( PosState s) Source # | |
Data s => Data ( PosState s) Source # | |
Defined in Text.Megaparsec.State gfoldl :: ( forall d b. Data d => c (d -> b) -> d -> c b) -> ( forall g. g -> c g) -> PosState s -> c ( PosState s) Source # gunfold :: ( forall b r. Data b => c (b -> r) -> c r) -> ( forall r. r -> c r) -> Constr -> c ( PosState s) Source # toConstr :: PosState s -> Constr Source # dataTypeOf :: PosState s -> DataType Source # dataCast1 :: Typeable t => ( forall d. Data d => c (t d)) -> Maybe (c ( PosState s)) Source # dataCast2 :: Typeable t => ( forall d e. ( Data d, Data e) => c (t d e)) -> Maybe (c ( PosState s)) Source # gmapT :: ( forall b. Data b => b -> b) -> PosState s -> PosState s Source # gmapQl :: (r -> r' -> r) -> r -> ( forall d. Data d => d -> r') -> PosState s -> r Source # gmapQr :: forall r r'. (r' -> r -> r) -> r -> ( forall d. Data d => d -> r') -> PosState s -> r Source # gmapQ :: ( forall d. Data d => d -> u) -> PosState s -> [u] Source # gmapQi :: Int -> ( forall d. Data d => d -> u) -> PosState s -> u Source # gmapM :: Monad m => ( forall d. Data d => d -> m d) -> PosState s -> m ( PosState s) Source # gmapMp :: MonadPlus m => ( forall d. Data d => d -> m d) -> PosState s -> m ( PosState s) Source # gmapMo :: MonadPlus m => ( forall d. Data d => d -> m d) -> PosState s -> m ( PosState s) Source # |
|
Show s => Show ( PosState s) Source # | |
Generic ( PosState s) Source # | |
NFData s => NFData ( PosState s) Source # | |
Defined in Text.Megaparsec.State |
|
type Rep ( PosState s) Source # | |
Defined in Text.Megaparsec.State
type
Rep
(
PosState
s) =
D1
('
MetaData
"PosState" "Text.Megaparsec.State" "megaparsec-9.2.1-EI4cRL0SAfYAOxBOfPeCV9" '
False
) (
C1
('
MetaCons
"PosState" '
PrefixI
'
True
) ((
S1
('
MetaSel
('
Just
"pstateInput") '
NoSourceUnpackedness
'
NoSourceStrictness
'
DecidedLazy
) (
Rec0
s)
:*:
S1
('
MetaSel
('
Just
"pstateOffset") '
NoSourceUnpackedness
'
SourceStrict
'
DecidedStrict
) (
Rec0
Int
))
:*:
(
S1
('
MetaSel
('
Just
"pstateSourcePos") '
NoSourceUnpackedness
'
SourceStrict
'
DecidedStrict
) (
Rec0
SourcePos
)
:*:
(
S1
('
MetaSel
('
Just
"pstateTabWidth") '
NoSourceUnpackedness
'
NoSourceStrictness
'
DecidedLazy
) (
Rec0
Pos
)
:*:
S1
('
MetaSel
('
Just
"pstateLinePrefix") '
NoSourceUnpackedness
'
NoSourceStrictness
'
DecidedLazy
) (
Rec0
String
)))))
|
is a parser with custom data component of error
ParsecT
e s m a
e
, stream type
s
, underlying monad
m
and return type
a
.
Instances
( Ord e, Stream s) => MonadParsec e s ( ParsecT e s m) Source # | |
Defined in Text.Megaparsec.Internal parseError :: ParseError s e -> ParsecT e s m a Source # label :: String -> ParsecT e s m a -> ParsecT e s m a Source # hidden :: ParsecT e s m a -> ParsecT e s m a Source # try :: ParsecT e s m a -> ParsecT e s m a Source # lookAhead :: ParsecT e s m a -> ParsecT e s m a Source # notFollowedBy :: ParsecT e s m a -> ParsecT e s m () Source # withRecovery :: ( ParseError s e -> ParsecT e s m a) -> ParsecT e s m a -> ParsecT e s m a Source # observing :: ParsecT e s m a -> ParsecT e s m ( Either ( ParseError s e) a) Source # eof :: ParsecT e s m () Source # token :: ( Token s -> Maybe a) -> Set ( ErrorItem ( Token s)) -> ParsecT e s m a Source # tokens :: ( Tokens s -> Tokens s -> Bool ) -> Tokens s -> ParsecT e s m ( Tokens s) Source # takeWhileP :: Maybe String -> ( Token s -> Bool ) -> ParsecT e s m ( Tokens s) Source # takeWhile1P :: Maybe String -> ( Token s -> Bool ) -> ParsecT e s m ( Tokens s) Source # takeP :: Maybe String -> Int -> ParsecT e s m ( Tokens s) Source # getParserState :: ParsecT e s m ( State s e) Source # updateParserState :: ( State s e -> State s e) -> ParsecT e s m () Source # |
|
( Stream s, MonadState st m) => MonadState st ( ParsecT e s m) Source # | |
( Stream s, MonadReader r m) => MonadReader r ( ParsecT e s m) Source # | |
( Stream s, MonadError e' m) => MonadError e' ( ParsecT e s m) Source # | |
Defined in Text.Megaparsec.Internal throwError :: e' -> ParsecT e s m a Source # catchError :: ParsecT e s m a -> (e' -> ParsecT e s m a) -> ParsecT e s m a Source # |
|
Stream s => MonadTrans ( ParsecT e s) Source # | |
Stream s => Monad ( ParsecT e s m) Source # |
|
Functor ( ParsecT e s m) Source # | |
( Stream s, MonadFix m) => MonadFix ( ParsecT e s m) Source # |
Since: 6.0.0 |
Stream s => MonadFail ( ParsecT e s m) Source # | |
Stream s => Applicative ( ParsecT e s m) Source # |
|
Defined in Text.Megaparsec.Internal pure :: a -> ParsecT e s m a Source # (<*>) :: ParsecT e s m (a -> b) -> ParsecT e s m a -> ParsecT e s m b Source # liftA2 :: (a -> b -> c) -> ParsecT e s m a -> ParsecT e s m b -> ParsecT e s m c Source # (*>) :: ParsecT e s m a -> ParsecT e s m b -> ParsecT e s m b Source # (<*) :: ParsecT e s m a -> ParsecT e s m b -> ParsecT e s m a Source # |
|
( Stream s, MonadIO m) => MonadIO ( ParsecT e s m) Source # | |
( Ord e, Stream s) => Alternative ( ParsecT e s m) Source # |
|
( Ord e, Stream s) => MonadPlus ( ParsecT e s m) Source # |
Note : strictly speaking, this instance is unlawful. The right identity law does not hold, e.g. in general this is not true: v >> mzero = mero However the following holds: try v >> mzero = mzero |
( Stream s, MonadCont m) => MonadCont ( ParsecT e s m) Source # | |
(a ~ Tokens s, IsString a, Eq a, Stream s, Ord e) => IsString ( ParsecT e s m a) Source # |
Since: 6.3.0 |
Defined in Text.Megaparsec.Internal fromString :: String -> ParsecT e s m a Source # |
|
( Stream s, Semigroup a) => Semigroup ( ParsecT e s m a) Source # |
Since: 5.3.0 |
( Stream s, Monoid a) => Monoid ( ParsecT e s m a) Source # |
Since: 5.3.0 |
Running parser
:: Parsec e s a |
Parser to run |
-> String |
Name of source file |
-> s |
Input for parser |
-> Either ( ParseErrorBundle s e) a |
runs parser
parse
p file input
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
ParseErrorBundle
(
Left
) or a value of type
a
(
Right
).
errorBundlePretty
can be used to turn
ParseErrorBundle
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 bundle -> putStr (errorBundlePretty bundle) Right xs -> print (sum xs) numbers = decimal `sepBy` char ','
parseMaybe :: ( Ord e, Stream s) => Parsec e s a -> s -> Maybe a Source #
runs the parser
parseMaybe
p input
p
on
input
and returns the
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 names) are not important and entire input should be consumed. For example, it can be used for parsing of a single number according to a specification of its format.
:: ( ShowErrorComponent e, Show a, VisualStream s, TraversableStream s) | |
=> Parsec e s a |
Parser to run |
-> s |
Input for parser |
-> IO () |
The expression
applies the parser
parseTest
p input
p
on the
input
input
and prints the result to stdout. Useful for testing.
:: Parsec e s a |
Parser to run |
-> String |
Name of source file |
-> s |
Input for parser |
-> Either ( ParseErrorBundle s e) a |
runs parser
runParser
p file input
p
on the input stream of
tokens
input
, obtained from source
file
. The
file
is only used in
error messages and may be the empty string. Returns either a
ParseErrorBundle
(
Left
) or a value of type
a
(
Right
).
parseFromFile p file = runParser p file <$> readFile file
:: Parsec e s a |
Parser to run |
-> State s e |
Initial state |
-> ( State s e, Either ( ParseErrorBundle s e) a) |
:: Monad m | |
=> ParsecT e s m a |
Parser to run |
-> String |
Name of source file |
-> s |
Input for parser |
-> m ( Either ( ParseErrorBundle s e) a) |
runs parser
runParserT
p file input
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
ParseErrorBundle
(
Left
) or
a value of type
a
(
Right
).
:: Monad m | |
=> ParsecT e s m a |
Parser to run |
-> State s e |
Initial state |
-> m ( State s e, Either ( ParseErrorBundle s e) 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
Primitive combinators
class ( Stream s, MonadPlus m) => MonadParsec e s m | m -> e s where Source #
Type class describing monads that implement the full set of primitive parsers.
Note
that the following primitives are “fast” and should be taken
advantage of as much as possible if your aim is a fast parser:
tokens
,
takeWhileP
,
takeWhile1P
, and
takeP
.
parseError , label , try , lookAhead , notFollowedBy , withRecovery , observing , eof , token , tokens , takeWhileP , takeWhile1P , takeP , getParserState , updateParserState
parseError :: ParseError s e -> m a Source #
Stop parsing and report the
ParseError
. This is the only way to
control position of the error without manipulating the parser state
manually.
Since: 8.0.0
label :: String -> m a -> m a Source #
The parser
behaves as parser
label
name p
p
, but whenever the
parser
p
fails
without consuming any input
, it replaces names of
“expected” tokens with the name
name
.
behaves just like parser
hidden
p
p
, but it doesn't show any
“expected” tokens in error message when
p
fails.
The parser
behaves like the parser
try
p
p
, except that it
backtracks the parser state when
p
fails (either consuming input or
not).
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 if the first
parser failed while consuming input.
For example, here is a parser that is supposed to parse the word “let” or the word “lexical”:
>>>
parseTest (string "let" <|> string "lexical") "lexical"
1:1: unexpected "lex" expecting "let"
What happens here? The 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"
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. You still need to use
try
when your
alternatives are complex, composite parsers.
lookAhead :: m a -> m a Source #
If
p
in
succeeds (either consuming input or not)
the whole parser behaves like
lookAhead
p
p
succeeded without consuming anything
(parser state is not updated as well). If
p
fails,
lookAhead
has no
effect, i.e. it will fail consuming input if
p
fails consuming input.
Combine with
try
if this is undesirable.
notFollowedBy :: m a -> m () Source #
only succeeds when the parser
notFollowedBy
p
p
fails. This
parser
never consumes
any input and
never modifies
parser state. It
can be used to implement the “longest match” rule.
:: ( ParseError s e -> m a) |
How to recover from failure |
-> m a |
Original parser |
-> m a |
Parser that can recover from failures |
allows us to continue parsing even if the parser
withRecovery
r p
p
fails. In this case
r
is called with the actual
ParseError
as
its argument. Typical usage is to return a value signifying failure to
parse this particular object and to consume some part of the input up
to the point where the next object starts.
Note that if
r
fails, the original error message is reported as if
without
withRecovery
. In no way recovering parser
r
can influence
error messages.
Since: 4.4.0
:: m a |
The parser to run |
-> m ( Either ( ParseError s e) a) |
allows us to “observe” failure of the
observing
p
p
parser,
should it happen, without actually ending parsing but instead getting
the
ParseError
in
Left
. On success parsed value is returned in
Right
as usual. Note that this primitive just allows you to observe
parse errors as they happen, it does not backtrack or change how the
p
parser works in any way.
Since: 5.1.0
This parser only succeeds at the end of input.
:: ( Token s -> Maybe a) |
Matching function for the token to parse |
-> Set ( ErrorItem ( Token s)) |
Used in the error message to mention the items that were expected |
-> m a |
The parser
accepts tokens for which the
matching function
token
test expected
test
returns
Just
results. If
Nothing
is
returned the
expected
set is used to report the items that were
expected.
For example, the
satisfy
parser is implemented as:
satisfy f = token testToken Set.empty where testToken x = if f x then Just x else Nothing
Note : type signature of this primitive was changed in the version 7.0.0 .
:: ( Tokens s -> Tokens s -> Bool ) |
Predicate to check equality of chunks |
-> Tokens s |
Chunk of input to match against |
-> m ( Tokens s) |
The parser
parses a chunk of input
tokens
test chk
chk
and
returns it. The supplied predicate
test
is used to check equality of
given and parsed chunks after a candidate chunk of correct length is
fetched from the stream.
This can be used for example to write
chunk
:
chunk = tokens (==)
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 feature
does not
affect
performance in any way.
:: Maybe String |
Name for a single token in the row |
-> ( Token s -> Bool ) |
Predicate to use to test tokens |
-> m ( Tokens s) |
A chunk of matching tokens |
Parse
zero
or more tokens for which the supplied predicate holds.
Try to use this as much as possible because for many streams this
combinator is much faster than parsers built with
many
and
satisfy
.
takeWhileP (Just "foo") f = many (satisfy f <?> "foo") takeWhileP Nothing f = many (satisfy f)
The combinator never fails, although it may parse the empty chunk.
Since: 6.0.0
:: Maybe String |
Name for a single token in the row |
-> ( Token s -> Bool ) |
Predicate to use to test tokens |
-> m ( Tokens s) |
A chunk of matching tokens |
Similar to
takeWhileP
, but fails if it can't parse at least one
token. Try to use this as much as possible because for many streams
this combinator is much faster than parsers built with
some
and
satisfy
.
takeWhile1P (Just "foo") f = some (satisfy f <?> "foo") takeWhile1P Nothing f = some (satisfy f)
Note that the combinator either succeeds or fails without consuming any
input, so
try
is not necessary with it.
Since: 6.0.0
:: Maybe String |
Name for a single token in the row |
-> Int |
How many tokens to extract |
-> m ( Tokens s) |
A chunk of matching tokens |
Extract the specified number of tokens from the input stream and return them packed as a chunk of stream. If there is not enough tokens in the stream, a parse error will be signaled. It's guaranteed that if the parser succeeds, the requested number of tokens will be returned.
The parser is roughly equivalent to:
takeP (Just "foo") n = count n (anySingle <?> "foo") takeP Nothing n = count n anySingle
Note that if the combinator fails due to insufficient number of tokens
in the input stream, it backtracks automatically. No
try
is necessary
with
takeP
.
Since: 6.0.0
getParserState :: m ( State s e) Source #
Return the full parser state as a
State
record.
updateParserState :: ( State s e -> State s e) -> m () Source #
applies the function
updateParserState
f
f
to the parser state.
Instances
Signaling parse errors
The most general function to fail and end parsing is
parseError
. These
are built on top of it. The section also includes functions starting with
the
register
prefix which allow users to register “delayed”
ParseError
s.
:: MonadParsec e s m | |
=> Maybe ( ErrorItem ( Token s)) |
Unexpected item (if any) |
-> Set ( ErrorItem ( Token s)) |
Expected items |
-> m a |
Stop parsing and report a trivial
ParseError
.
Since: 6.0.0
:: MonadParsec e s m | |
=> Set ( ErrorFancy e) |
Fancy error components |
-> m a |
Stop parsing and report a fancy
ParseError
. To report a single custom
parse error, see
customFailure
.
Since: 6.0.0
unexpected :: MonadParsec e s m => ErrorItem ( Token s) -> m a Source #
The parser
fails with an error message telling
about unexpected item
unexpected
item
item
without consuming any input.
unexpected item = failure (Just item) Set.empty
customFailure :: MonadParsec e s m => e -> m a Source #
Report a custom parse error. For a more general version, see
fancyFailure
.
customFailure = fancyFailure . Set.singleton . ErrorCustom
Since: 6.3.0
:: MonadParsec e s m | |
=> ( ParseError s e -> ParseError s e) |
How to process
|
-> m a |
The “region” that the processing applies to |
-> m a |
Specify how to process
ParseError
s that happen inside of this
wrapper. This applies to both normal and delayed
ParseError
s.
As a side-effect of the implementation the inner computation will start
with empty collection of delayed errors and they will be updated and
“restored” on the way out of
region
.
Since: 5.3.0
registerParseError :: MonadParsec e s m => ParseError s e -> m () Source #
Register a
ParseError
for later reporting. This action does not end
parsing and has no effect except for adding the given
ParseError
to the
collection of “delayed”
ParseError
s which will be taken into
consideration at the end of parsing. Only if this collection is empty the
parser will succeed. This is the main way to report several parse errors
at once.
Since: 8.0.0
:: MonadParsec e s m | |
=> Maybe ( ErrorItem ( Token s)) |
Unexpected item (if any) |
-> Set ( ErrorItem ( Token s)) |
Expected items |
-> m () |
Like
failure
, but for delayed
ParseError
s.
Since: 8.0.0
:: MonadParsec e s m | |
=> Set ( ErrorFancy e) |
Fancy error components |
-> m () |
Like
fancyFailure
, but for delayed
ParseError
s.
Since: 8.0.0
Derivatives of primitive combinators
:: MonadParsec e s m | |
=> Token s |
Token to match |
-> m ( Token s) |
:: MonadParsec e s m | |
=> ( Token s -> Bool ) |
Predicate to apply |
-> m ( Token s) |
The parser
succeeds for any token for which the supplied
function
satisfy
f
f
returns
True
.
digitChar = satisfy isDigit <?> "digit" oneOf cs = satisfy (`elem` cs)
Performance note
: when you need to parse a single token, it is often
a good idea to use
satisfy
with the right predicate function instead of
creating a complex parser using the combinators.
See also:
anySingle
,
anySingleBut
,
oneOf
,
noneOf
.
Since: 7.0.0
anySingle :: MonadParsec e s m => m ( Token s) Source #
Parse and return a single token. It's a good idea to attach a
label
to this parser.
anySingle = satisfy (const True)
See also:
satisfy
,
anySingleBut
.
Since: 7.0.0
:: MonadParsec e s m | |
=> Token s |
Token we should not match |
-> m ( Token s) |
:: ( Foldable f, MonadParsec e s m) | |
=> f ( Token s) |
Collection of matching tokens |
-> m ( Token s) |
succeeds if the current token is in the supplied
collection of tokens
oneOf
ts
ts
. Returns the parsed token. Note that this
parser cannot automatically generate the “expected” component of error
message, so usually you should label it manually with
label
or (
<?>
).
oneOf cs = satisfy (`elem` cs)
See also:
satisfy
.
digit = oneOf ['0'..'9'] <?> "digit"
Performance note
: prefer
satisfy
when you can because it's faster
when you have only a couple of tokens to compare to:
quoteFast = satisfy (\x -> x == '\'' || x == '\"') quoteSlow = oneOf "'\""
Since: 7.0.0
:: ( Foldable f, MonadParsec e s m) | |
=> f ( Token s) |
Collection of taken we should not match |
-> m ( Token s) |
As the dual of
oneOf
,
succeeds if the current token
not
in the supplied list of tokens
noneOf
ts
ts
. Returns the parsed character.
Note that this parser cannot automatically generate the “expected”
component of error message, so usually you should label it manually with
label
or (
<?>
).
noneOf cs = satisfy (`notElem` cs)
See also:
satisfy
.
Performance note
: prefer
satisfy
and
anySingleBut
when you can
because it's faster.
Since: 7.0.0
:: MonadParsec e s m | |
=> Tokens s |
Chunk to match |
-> m ( Tokens s) |
(<?>) :: MonadParsec e s m => m a -> String -> m a infix 0 Source #
A synonym for
label
in the form of an operator.
match :: MonadParsec e s m => m a -> m ( Tokens s, a) Source #
Return both the result of a parse and a chunk of input that was
consumed during parsing. This relies on the change of the
stateOffset
value to evaluate how many tokens were consumed. If you mess with it
manually in the argument parser, prepare for troubles.
Since: 5.3.0
takeRest :: MonadParsec e s m => m ( Tokens s) Source #
Consume the rest of the input and return it as a chunk. This parser never fails, but may return the empty chunk.
takeRest = takeWhileP Nothing (const True)
Since: 6.0.0
atEnd :: MonadParsec e s m => m Bool Source #
Return
True
when end of input has been reached.
atEnd = option False (True <$ hidden eof)
Since: 6.0.0
Parser state combinators
getInput :: MonadParsec e s m => m s Source #
Return the current input.
setInput :: MonadParsec e s m => s -> m () Source #
continues parsing with
setInput
input
input
.
getSourcePos :: ( TraversableStream s, MonadParsec e s m) => m SourcePos Source #
Return the current source position. This function
is not cheap
, do
not call it e.g. on matching of every token, that's a bad idea. Still you
can use it to get
SourcePos
to attach to things that you parse.
The function works under the assumption that we move in the input stream only forwards and never backwards, which is always true unless the user abuses the library.
Since: 7.0.0
getOffset :: MonadParsec e s m => m Int Source #
setOffset :: MonadParsec e s m => Int -> m () Source #
setParserState :: MonadParsec e s m => State s e -> m () Source #
sets the parser state to
setParserState
st
st
.
See also:
getParserState
,
updateParserState
.