megaparsec/Text/Megaparsec.hs

189 lines
4.2 KiB
Haskell
Raw Normal View History

2015-07-28 16:32:19 +03:00
-- |
-- Module : Text.Megaparsec
2016-01-09 15:56:33 +03:00
-- Copyright : © 20152016 Megaparsec contributors
-- © 2007 Paolo Martini
-- © 19992001 Daan Leijen
-- License : FreeBSD
2015-07-28 16:32:19 +03:00
--
-- Maintainer : Mark Karpov <markkarpov@opmbx.org>
2015-07-29 11:38:32 +03:00
-- Stability : experimental
2015-07-28 16:32:19 +03:00
-- Portability : portable
--
-- This module includes everything you need to get started writing a parser.
--
-- By default this module is set up to parse character data. If you'd like to
-- parse the result of your own tokenizer you should start with the following
-- imports:
--
-- > import Text.Megaparsec.Prim
-- > import Text.Megaparsec.Combinator
2015-07-28 16:32:19 +03:00
--
-- Then you can implement your own version of 'satisfy' on top of the
-- 'token' primitive.
--
-- Typical import section looks like this:
--
-- > import Text.Megaparsec
-- > import Text.Megaparsec.String
-- > -- import Text.Megaparsec.ByteString
-- > -- import Text.Megaparsec.ByteString.Lazy
-- > -- import Text.Megaparsec.Text
-- > -- import Text.Megaparsec.Text.Lazy
--
-- As you can see the second import depends on data type you want to use as
-- input stream. It just defines useful type-synonym @Parser@.
--
-- Megaparsec is capable of a lot. Apart from this standard functionality
-- you can parse permutation phrases with "Text.Megaparsec.Perm" and even
-- entire languages with "Text.Megaparsec.Lexer". These modules should be
-- imported explicitly along with the two modules mentioned above.
module Text.Megaparsec
( -- * Running parser
Parsec
, ParsecT
2015-08-12 20:51:06 +03:00
, runParser
, runParser'
, runParserT
, runParserT'
2015-08-12 20:51:06 +03:00
, parse
, parseMaybe
2015-08-12 20:51:06 +03:00
, parseTest
, parseFromFile
2015-08-12 20:51:06 +03:00
-- * Combinators
, (A.<|>)
-- $assocbo
, A.many
-- $many
, A.some
-- $some
, A.optional
-- $optional
, unexpected
, failure
2015-08-12 20:51:06 +03:00
, (<?>)
, label
, hidden
2015-08-12 20:51:06 +03:00
, try
, lookAhead
, notFollowedBy
, withRecovery
, eof
, token
, tokens
, between
2015-08-12 20:51:06 +03:00
, choice
, count
, count'
, endBy
, endBy1
, manyTill
2015-08-23 19:58:42 +03:00
, someTill
2015-08-12 20:51:06 +03:00
, option
, sepBy
, sepBy1
, sepEndBy
, sepEndBy1
, skipMany
, skipSome
2015-08-12 20:51:06 +03:00
-- * Character parsing
, newline
, crlf
, eol
, tab
, space
, controlChar
, spaceChar
, upperChar
, lowerChar
, letterChar
, alphaNumChar
, printChar
, digitChar
, octDigitChar
, hexDigitChar
, markChar
, numberChar
, punctuationChar
, symbolChar
, separatorChar
, asciiChar
, latin1Char
, charCategory
, char
, char'
2015-08-12 20:51:06 +03:00
, anyChar
, oneOf
, oneOf'
2015-08-12 20:51:06 +03:00
, noneOf
, noneOf'
2015-08-12 20:51:06 +03:00
, satisfy
, string
, string'
2015-08-12 20:51:06 +03:00
-- * Error messages
, Message (..)
, messageString
, badMessage
, ParseError
, errorPos
, errorMessages
, errorIsUnknown
2015-09-22 20:19:56 +03:00
-- * Textual source position
2015-08-12 20:51:06 +03:00
, SourcePos
, sourceName
, sourceLine
, sourceColumn
-- * Low-level operations
, Stream (..)
, StorableStream (..)
2015-08-12 20:51:06 +03:00
, State (..)
, getInput
, setInput
, getPosition
, setPosition
, getTabWidth
, setTabWidth
2015-08-12 20:51:06 +03:00
, getParserState
, setParserState
, updateParserState )
2015-07-28 16:32:19 +03:00
where
2008-01-13 20:53:15 +03:00
import qualified Control.Applicative as A
import Text.Megaparsec.Char
import Text.Megaparsec.Combinator
import Text.Megaparsec.Error
import Text.Megaparsec.Pos
import Text.Megaparsec.Prim
-- $assocbo
--
-- 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.
--
-- 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.
-- $many
--
-- @many p@ applies the parser @p@ /zero/ or more times. Returns a list of
-- the returned values of @p@.
--
-- > identifier = (:) <$> letter <*> many (alphaNum <|> char '_')
-- $some
--
-- @some p@ applies the parser @p@ /one/ or more times. Returns a list of
-- the returned values of @p@.
--
-- > word = some letter
-- $optional
--
-- @optional p@ tries to apply parser @p@. It will parse @p@ or nothing. It
-- only fails if @p@ fails after consuming input. On success result of @p@
-- is returned inside of 'Just', on failure 'Nothing' is returned.