mirror of
https://github.com/mrkkrp/megaparsec.git
synced 2024-12-24 08:43:14 +03:00
3c69bc8f48
These functions are now re-exported from ‘Control.Applicative’ module. ‘many’ and ‘some’ are now part of ‘Alternative’ instance of ‘ParsecT’. Note that these functions are re-exported only in ‘Text.MegaParsec’ module, but not in ‘Text.MegaParsec.Prim’ to avoid duplication of floating doc-strings. Others internal modules now just casually import ‘Control.Applicative’ for their needs. Note that ‘many1’ was renamed to ‘some’, the same is done for other parsers that had ‘many1’ part in their names (for consistency).
234 lines
8.2 KiB
Haskell
234 lines
8.2 KiB
Haskell
-- |
|
||
-- Module : Text.MegaParsec.Combinator
|
||
-- Copyright : © 2015 MegaParsec contributors
|
||
-- © 2007 Paolo Martini
|
||
-- © 1999–2001 Daan Leijen
|
||
-- License : BSD3
|
||
--
|
||
-- Maintainer : Mark Karpov <markkarpov@opmbx.org>
|
||
-- Stability : experimental
|
||
-- Portability : portable
|
||
--
|
||
-- Commonly used generic combinators.
|
||
|
||
module Text.MegaParsec.Combinator
|
||
( choice
|
||
, count
|
||
, between
|
||
, option
|
||
, optionMaybe
|
||
, skipSome
|
||
, sepBy
|
||
, sepBy1
|
||
, endBy
|
||
, endBy1
|
||
, sepEndBy
|
||
, sepEndBy1
|
||
, chainl
|
||
, chainl1
|
||
, chainr
|
||
, chainr1
|
||
, eof
|
||
, notFollowedBy
|
||
, manyTill
|
||
, lookAhead
|
||
, anyToken )
|
||
where
|
||
|
||
import Control.Applicative ((<|>), many, some)
|
||
import Control.Monad
|
||
|
||
import Text.MegaParsec.Prim
|
||
|
||
-- | @choice ps@ tries to apply the parsers in the list @ps@ in order,
|
||
-- until one of them succeeds. Returns the value of the succeeding parser.
|
||
|
||
choice :: Stream s m t => [ParsecT s u m a] -> ParsecT s u m a
|
||
choice = foldr (<|>) mzero
|
||
|
||
-- | @option x p@ tries to apply parser @p@. If @p@ fails without
|
||
-- consuming input, it returns the value @x@, otherwise the value returned
|
||
-- by @p@.
|
||
--
|
||
-- > priority = option 0 (digitToInt <$> digit)
|
||
|
||
option :: Stream s m t => a -> ParsecT s u m a -> ParsecT s u m a
|
||
option x p = p <|> return x
|
||
|
||
-- | @optionMaybe p@ tries to apply parser @p@. If @p@ fails without
|
||
-- consuming input, it return 'Nothing', otherwise it returns 'Just' the
|
||
-- value returned by @p@.
|
||
|
||
optionMaybe :: Stream s m t => ParsecT s u m a -> ParsecT s u m (Maybe a)
|
||
optionMaybe p = option Nothing (Just <$> p)
|
||
|
||
-- -- | @optional p@ tries to apply parser @p@. It will parse @p@ or nothing.
|
||
-- -- It only fails if @p@ fails after consuming input. It discards the result
|
||
-- -- of @p@.
|
||
|
||
-- optional :: Stream s m t => ParsecT s u m a -> ParsecT s u m ()
|
||
-- optional p = (p *> return ()) <|> return ()
|
||
|
||
-- | @between open close p@ parses @open@, followed by @p@ and @close@.
|
||
-- Returns the value returned by @p@.
|
||
--
|
||
-- > braces = between (symbol "{") (symbol "}")
|
||
|
||
between :: Stream s m t => ParsecT s u m open ->
|
||
ParsecT s u m close -> ParsecT s u m a -> ParsecT s u m a
|
||
between open close p = open *> p <* close
|
||
|
||
-- | @skipSome p@ applies the parser @p@ /one/ or more times, skipping
|
||
-- its result.
|
||
|
||
skipSome :: Stream s m t => ParsecT s u m a -> ParsecT s u m ()
|
||
skipSome p = p *> skipMany p
|
||
|
||
-- | @sepBy p sep@ parses /zero/ or more occurrences of @p@, separated
|
||
-- by @sep@. Returns a list of values returned by @p@.
|
||
--
|
||
-- > commaSep p = p `sepBy` (symbol ",")
|
||
|
||
sepBy :: Stream s m t =>
|
||
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
|
||
sepBy p sep = sepBy1 p sep <|> return []
|
||
|
||
-- | @sepBy1 p sep@ parses /one/ or more occurrences of @p@, separated
|
||
-- by @sep@. Returns a list of values returned by @p@.
|
||
|
||
sepBy1 :: Stream s m t =>
|
||
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
|
||
sepBy1 p sep = (:) <$> p <*> many (sep *> p)
|
||
|
||
-- | @sepEndBy1 p sep@ parses /one/ or more occurrences of @p@,
|
||
-- separated and optionally ended by @sep@. Returns a list of values
|
||
-- returned by @p@.
|
||
|
||
sepEndBy1 :: Stream s m t =>
|
||
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
|
||
sepEndBy1 p sep = p >>= \x -> ((x:) <$> (sep *> sepEndBy p sep)) <|> return [x]
|
||
|
||
-- | @sepEndBy p sep@ parses /zero/ or more occurrences of @p@,
|
||
-- separated and optionally ended by @sep@, i.e. haskell style
|
||
-- statements. Returns a list of values returned by @p@.
|
||
--
|
||
-- > haskellStatements = haskellStatement `sepEndBy` semi
|
||
|
||
sepEndBy :: Stream s m t =>
|
||
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
|
||
sepEndBy p sep = sepEndBy1 p sep <|> return []
|
||
|
||
-- | @endBy1 p sep@ parses /one/ or more occurrences of @p@, separated
|
||
-- and ended by @sep@. Returns a list of values returned by @p@.
|
||
|
||
endBy1 :: Stream s m t =>
|
||
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
|
||
endBy1 p sep = some (p <* sep)
|
||
|
||
-- | @endBy p sep@ parses /zero/ or more occurrences of @p@, separated
|
||
-- and ended by @sep@. Returns a list of values returned by @p@.
|
||
--
|
||
-- > cStatements = cStatement `endBy` semi
|
||
|
||
endBy :: Stream s m t =>
|
||
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
|
||
endBy p sep = many (p <* sep)
|
||
|
||
-- | @count n p@ parses @n@ occurrences of @p@. If @n@ is smaller or
|
||
-- equal to zero, the parser equals to @return []@. Returns a list of
|
||
-- @n@ values returned by @p@.
|
||
|
||
count :: Stream s m t => Int -> ParsecT s u m a -> ParsecT s u m [a]
|
||
count n p
|
||
| n <= 0 = return []
|
||
| otherwise = replicateM n p
|
||
|
||
-- | @chainr p op x@ parses /zero/ or more occurrences of @p@,
|
||
-- separated by @op@ Returns a value obtained by a /right/ associative
|
||
-- application of all functions returned by @op@ to the values returned by
|
||
-- @p@. If there are no occurrences of @p@, the value @x@ is returned.
|
||
|
||
chainr :: Stream s m t => ParsecT s u m a ->
|
||
ParsecT s u m (a -> a -> a) -> a -> ParsecT s u m a
|
||
chainr p op x = chainr1 p op <|> return x
|
||
|
||
-- | @chainl p op x@ parses /zero/ or more occurrences of @p@,
|
||
-- separated by @op@. Returns a value obtained by a /left/ associative
|
||
-- application of all functions returned by @op@ to the values returned by
|
||
-- @p@. If there are zero occurrences of @p@, the value @x@ is returned.
|
||
|
||
chainl :: Stream s m t => ParsecT s u m a ->
|
||
ParsecT s u m (a -> a -> a) -> a -> ParsecT s u m a
|
||
chainl p op x = chainl1 p op <|> return x
|
||
|
||
-- | @chainl1 p op@ parses /one/ or more occurrences of @p@,
|
||
-- separated by @op@ Returns a value obtained by a /left/ associative
|
||
-- application of all functions returned by @op@ to the values returned by
|
||
-- @p@. This parser can for example be used to eliminate left recursion
|
||
-- which typically occurs in expression grammars.
|
||
--
|
||
-- > expr = term `chainl1` addop
|
||
-- > term = factor `chainl1` mulop
|
||
-- > factor = parens expr <|> integer
|
||
-- >
|
||
-- > mulop = (symbol "*" >> return (*))
|
||
-- > <|> (symbol "/" >> return (div))
|
||
-- >
|
||
-- > addop = (symbol "+" >> return (+))
|
||
-- > <|> (symbol "-" >> return (-))
|
||
|
||
chainl1 :: Stream s m t =>
|
||
ParsecT s u m a -> ParsecT s u m (a -> a -> a) -> ParsecT s u m a
|
||
chainl1 p op = p >>= rest
|
||
where rest x = ((($ x) <$> op <*> p) >>= rest) <|> return x
|
||
|
||
-- | @chainr1 p op@ parses /one/ or more occurrences of |p|,
|
||
-- separated by @op@ Returns a value obtained by a /right/ associative
|
||
-- application of all functions returned by @op@ to the values returned by
|
||
-- @p@.
|
||
|
||
chainr1 :: Stream s m t =>
|
||
ParsecT s u m a -> ParsecT s u m (a -> a -> a) -> ParsecT s u m a
|
||
chainr1 p op = p >>= rest
|
||
where rest x = (($ x) <$> op <*> chainr1 p op) <|> return x
|
||
|
||
-- | The parser @anyToken@ accepts any kind of token. It is for example
|
||
-- used to implement 'eof'. Returns the accepted token.
|
||
|
||
anyToken :: (Stream s m t, Show t) => ParsecT s u m t
|
||
anyToken = tokenPrim show (\pos _ _ -> pos) Just
|
||
|
||
-- | This parser only succeeds at the end of the input. This is not a
|
||
-- primitive parser but it is defined using 'notFollowedBy'.
|
||
--
|
||
-- > eof = notFollowedBy anyToken <?> "end of input"
|
||
|
||
eof :: (Stream s m t, Show t) => ParsecT s u m ()
|
||
eof = notFollowedBy anyToken <?> "end of input"
|
||
|
||
-- | @notFollowedBy p@ only succeeds when parser @p@ fails. This parser
|
||
-- does not consume any input. This parser can be used to implement the
|
||
-- \'longest match\' rule. For example, when recognizing keywords (for
|
||
-- example @let@), we want to make sure that a keyword is not followed by a
|
||
-- legal identifier character, in which case the keyword is actually an
|
||
-- identifier (for example @lets@). We can program this behaviour as
|
||
-- follows:
|
||
--
|
||
-- > keywordLet = try (string "let" >> notFollowedBy alphaNum)
|
||
|
||
notFollowedBy :: (Stream s m t, Show a) => ParsecT s u m a -> ParsecT s u m ()
|
||
notFollowedBy p = try ((try p >>= (unexpected . show)) <|> return ())
|
||
|
||
-- | @manyTill p end@ applies parser @p@ /zero/ or more times until
|
||
-- parser @end@ succeeds. Returns the list of values returned by @p@. This
|
||
-- parser can be used to scan comments:
|
||
--
|
||
-- > simpleComment = string "<!--" >> manyTill anyChar (string "-->")
|
||
--
|
||
-- Note that although parsers @anyChar@ and @string \"-->\"@ overlap, the
|
||
-- combinator uses 'try' internally to parse @end@, so it's OK.
|
||
|
||
manyTill :: Stream s m t =>
|
||
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
|
||
manyTill p end = (try end *> return []) <|> ((:) <$> p <*> manyTill p end)
|