mrkkrp/megaparsec
1
1
Fork 0
mirror of https://github.com/mrkkrp/megaparsec.git synced 2024-11-23 19:38:05 +03:00
Code Issues Projects Releases Wiki Activity

refactoring, phase 1

Browse Source
This commit is contained in:
mrkkrp 2015-07-28 19:32:19 +06:00
parent 8649d131bc
commit 227667f829
41 changed files with 974 additions and 1354 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
.travis.yml
View File

@ -1,9 +1,6 @@
language: c
env:
- CABALVER=1.16 GHCVER=7.4.2
- CABALVER=1.18 GHCVER=7.6.3
- CABALVER=1.18 GHCVER=7.8.3
- CABALVER=1.22 GHCVER=7.10.1
- CABALVER=head GHCVER=head

7
CHANGELOG.md
View File

@ -1,3 +1,10 @@
## MegaParsec 4.0.0
* Cosmetic changes in entire source code, numerous improvements and
elimination of warnings.
* Fixed typos in source code and other files.
## Parsec 3.1.9
* Many and various updates to documentation and package description

98
Text/Parsec.hs → Text/MegaParsec.hs
View File

@ -1,31 +1,29 @@
{-|
Module : Text.Parsec
Copyright : (c) Daan Leijen 1999-2001, (c) Paolo Martini 2007
License : BSD-style (see the LICENSE file)
-- |
-- Module : Text.MegaParsec
-- Copyright : © 1999–2001 Daan Leijen, © 2007 Paolo Martini, © 2015 MegaParsec contributors
-- License : BSD3
--
-- Maintainer : Mark Karpov <markkarpov@opmbx.org>
-- Stability : provisional
-- 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
-- @
--
-- Then you can implement your own version of 'satisfy' on top of the
-- 'tokenPrim' primitive.
Maintainer : aslatter@gmail.com
Stability : provisional
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.Parsec.Prim
import Text.Parsec.Combinator
@
Then you can implement your own version of 'satisfy' on top of the 'tokenPrim'
primitive.
-}
module Text.Parsec
( -- * Parsers
module Text.MegaParsec
(
-- * Parsers
ParsecT
, Parsec
, token
@ -39,7 +37,7 @@ module Text.Parsec
, getState
, putState
, modifyState
-- * Combinators
-- * Combinators
, (<|>)
, (<?>)
, label
@ -71,18 +69,36 @@ module Text.Parsec
, manyTill
, lookAhead
, anyToken
-- * Character Parsing
, module Text.Parsec.Char
-- * Error messages
-- * Character parsing
, oneOf
, noneOf
, spaces
, space
, newline
, crlf
, endOfLine
, tab
, upper
, lower
, alphaNum
, letter
, digit
, hexDigit
, octDigit
, char
, anyChar
, satisfy
, string
-- * Error messages
, ParseError
, errorPos
-- * Position
-- * Position
, SourcePos
, SourceName, Line, Column
, sourceName, sourceLine, sourceColumn
, incSourceLine, incSourceColumn
, setSourceLine, setSourceColumn, setSourceName
-- * Low-level operations
-- * Low-level operations
, manyAccum
, tokenPrim
, tokenPrimEx
@ -102,7 +118,7 @@ module Text.Parsec
, State (..)
, setPosition
, setInput
-- * Other stuff
-- * Other
, setState
, updateState
, parsecMap
@ -110,11 +126,11 @@ module Text.Parsec
, parserBind
, parserFail
, parserZero
, parserPlus
) where
, parserPlus )
where
import Text.Parsec.Pos
import Text.Parsec.Error
import Text.Parsec.Prim
import Text.Parsec.Char
import Text.Parsec.Combinator
import Text.MegaParsec.Char
import Text.MegaParsec.Combinator
import Text.MegaParsec.Error
import Text.MegaParsec.Pos
import Text.MegaParsec.Prim

39
Text/MegaParsec/ByteString.hs Normal file
View File

@ -0,0 +1,39 @@
-- |
-- Module : Text.MegaParsec.ByteString
-- Copyright : © 2007 Paolo Martini, © 2015 MegaParsec contributors
-- License : BSD3
--
-- Maintainer : Mark Karpov <markkarpov@opmbx.org>
-- Stability : provisional
-- Portability : portable
--
-- Convenience definitions for working with 'C.ByteString's.
module Text.MegaParsec.ByteString
( Parser
, GenParser
, parseFromFile )
where
import Text.MegaParsec.Error
import Text.MegaParsec.Prim
import qualified Data.ByteString.Char8 as C
type Parser = Parsec C.ByteString ()
type GenParser t st = Parsec C.ByteString st
-- | @parseFromFile p filePath@ runs a strict bytestring parser @p@ on the
-- input read from @filePath@ using 'ByteString.Char8.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)
-- @
parseFromFile :: Parser a -> String -> IO (Either ParseError a)
parseFromFile p fname = runP p () fname <$> C.readFile fname

40
Text/MegaParsec/ByteString/Lazy.hs Normal file
View File

@ -0,0 +1,40 @@
-- |
-- Module : Text.MegaParsec.ByteString.Lazy
-- Copyright : © 2007 Paolo Martini, © 2015 MegaParsec contributors
-- License : BSD3
--
-- Maintainer : Mark Karpov <markkarpov@opmbx.org>
-- Stability : provisional
-- Portability : portable
--
-- Convenience definitions for working with lazy 'C.ByteString's.
module Text.MegaParsec.ByteString.Lazy
( Parser
, GenParser
, parseFromFile )
where
import Text.MegaParsec.Error
import Text.MegaParsec.Prim
import qualified Data.ByteString.Lazy.Char8 as C
type Parser = Parsec C.ByteString ()
type GenParser t st = Parsec C.ByteString st
-- | @parseFromFile p filePath@ runs a lazy bytestring parser @p@ on the
-- input read from @filePath@ using
-- 'ByteString.Lazy.Char8.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)
-- @
parseFromFile :: Parser a -> String -> IO (Either ParseError a)
parseFromFile p fname = runP p () fname <$> C.readFile fname

161
Text/MegaParsec/Char.hs Normal file
View File

@ -0,0 +1,161 @@
-- |
-- Module : Text.MegaParsec.Char
-- Copyright : © 1999–2001 Daan Leijen, © 2007 Paolo Martini, © 2015 MegaParsec contributors
-- License : BSD3
--
-- Maintainer : Mark Karpov <markkarpov@opmbx.org>
-- Stability : provisional
-- Portability : portable
--
-- Commonly used character parsers.
{-# LANGUAGE FlexibleContexts #-}
module Text.MegaParsec.Char
( oneOf
, noneOf
, spaces
, space
, newline
, crlf
, endOfLine
, tab
, upper
, lower
, alphaNum
, letter
, digit
, hexDigit
, octDigit
, char
, anyChar
, satisfy
, string )
where
import Data.Char
import Text.MegaParsec.Pos
import Text.MegaParsec.Prim
-- | @oneOf cs@ succeeds if the current character is in the supplied
-- list of characters @cs@. Returns the parsed character. See also
-- 'satisfy'.
--
-- > vowel = oneOf "aeiou"
oneOf :: Stream s m Char => String -> ParsecT s u m Char
oneOf cs = satisfy (`elem` cs)
-- | As the dual of 'oneOf', @noneOf cs@ succeeds if the current
-- character /not/ in the supplied list of characters @cs@. Returns the
-- parsed character.
--
-- > consonant = noneOf "aeiou"
noneOf :: Stream s m Char => String -> ParsecT s u m Char
noneOf cs = satisfy (`notElem` cs)
-- | Skips /zero/ or more white space characters. See also 'skipMany'.
spaces :: Stream s m Char => ParsecT s u m ()
spaces = skipMany space <?> "white space"
-- | Parses a white space character (any character which satisfies 'isSpace')
-- Returns the parsed character.
space :: Stream s m Char => ParsecT s u m Char
space = satisfy isSpace <?> "space"
-- | Parses a newline character (\'\\n\'). Returns a newline character.
newline :: Stream s m Char => ParsecT s u m Char
newline = char '\n' <?> "lf new-line"
-- | Parses a carriage return character (\'\\r\') followed by a newline
-- character (\'\\n\'). Returns a newline character.
crlf :: Stream s m Char => ParsecT s u m Char
crlf = char '\r' *> char '\n' <?> "crlf new-line"
-- | Parses a CRLF (see 'crlf') or LF (see 'newline') end-of-line.
-- Returns a newline character (\'\\n\').
--
-- > endOfLine = newline <|> crlf
endOfLine :: Stream s m Char => ParsecT s u m Char
endOfLine = newline <|> crlf <?> "new-line"
-- | Parses a tab character (\'\\t\').
tab :: Stream s m Char => ParsecT s u m Char
tab = char '\t' <?> "tab"
-- | Parses an upper case letter (a character between \'A\' and \'Z\').
upper :: Stream s m Char => ParsecT s u m Char
upper = satisfy isUpper <?> "uppercase letter"
-- | Parses a lower case character (a character between \'a\' and \'z\').
lower :: Stream s m Char => ParsecT s u m Char
lower = satisfy isLower <?> "lowercase letter"
-- | Parses a letter or digit (a character between \'0\' and \'9\').
alphaNum :: Stream s m Char => ParsecT s u m Char
alphaNum = satisfy isAlphaNum <?> "letter or digit"
-- | Parses a letter (an upper case or lower case character).
letter :: Stream s m Char => ParsecT s u m Char
letter = satisfy isAlpha <?> "letter"
-- | Parses a digit.
digit :: Stream s m Char => ParsecT s u m Char
digit = satisfy isDigit <?> "digit"
-- | Parses a hexadecimal digit (a digit or a letter between \'a\' and
-- \'f\' or \'A\' and \'F\').
hexDigit :: Stream s m Char => ParsecT s u m Char
hexDigit = satisfy isHexDigit <?> "hexadecimal digit"
-- | Parses an octal digit (a character between \'0\' and \'7\').
octDigit :: Stream s m Char => ParsecT s u m Char
octDigit = satisfy isOctDigit <?> "octal digit"
-- | @char c@ parses a single character @c@.
--
-- > semiColon = char ';'
char :: Stream s m Char => Char -> ParsecT s u m Char
char c = satisfy (== c) <?> show [c]
-- | This parser succeeds for any character. Returns the parsed character.
anyChar :: Stream s m Char => ParsecT s u m Char
anyChar = satisfy (const True)
-- | The parser @satisfy f@ succeeds for any character for which the
-- supplied function @f@ returns 'True'. Returns the character that is
-- actually parsed.
--
-- > digit = satisfy isDigit
-- > oneOf cs = satisfy (`elem` cs)
satisfy :: Stream s m Char => (Char -> Bool) -> ParsecT s u m Char
satisfy f = tokenPrim showCh nextPos testChar
where showCh x = show [x]
nextPos pos x _ = updatePosChar pos x
testChar x = if f x then Just x else Nothing
-- | @string s@ parses a sequence of characters given by @s@. Returns
-- the parsed string (i.e. @s@).
--
-- > divOrMod = string "div" <|> string "mod"
string :: Stream s m Char => String -> ParsecT s u m String
string = tokens show updatePosString

256
Text/MegaParsec/Combinator.hs Normal file
View File

@ -0,0 +1,256 @@
-- |
-- Module : Text.MegaParsec.Combinator
-- Copyright : © 1999–2001 Daan Leijen, © 2007 Paolo Martini, © 2015 MegaParsec contributors
-- License : BSD3
--
-- Maintainer : Mark Karpov <markkarpov@opmbx.org>
-- Stability : provisional
-- Portability : portable
--
-- Commonly used generic combinators.
module Text.MegaParsec.Combinator
( choice
, count
, between
, option
, optionMaybe
, optional
, skipMany1
, many1
, sepBy
, sepBy1
, endBy
, endBy1
, sepEndBy
, sepEndBy1
, chainl
, chainl1
, chainr
, chainr1
, eof
, notFollowedBy
, manyTill
, lookAhead
, anyToken )
where
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
-- | @skipMany1 p@ applies the parser @p@ /one/ or more times, skipping
-- its result.
skipMany1 :: Stream s m t => ParsecT s u m a -> ParsecT s u m ()
skipMany1 p = p *> skipMany p
-- | @many1 p@ applies the parser @p@ /one/ or more times. Returns a
-- list of the returned values of @p@.
--
-- > word = many1 letter
many1 :: Stream s m t => ParsecT s u m a -> ParsecT s u m [a]
many1 p = (:) <$> p <*> many 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 = many1 (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 x@ 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 = do{ x <- p; rest x }
where rest x = do{ f <- op
; y <- p
; rest (f x y)
}
<|> return x
-- | @chainr1 p op x@ 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 = scan
where
scan = do{ x <- p; rest x }
rest x = do{ f <- op
; y <- scan
; return (f x y)
}
<|> 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 = do{ string "<!--"
-- > ; manyTill anyChar (try (string "-->"))
-- > }
--
-- Note the overlapping parsers @anyChar@ and @string \"-->\"@, and
-- therefore the use of the 'try' combinator.
manyTill :: Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill p end = scan
where
scan = do{ end; return [] }
<|>
do{ x <- p; xs <- scan; return (x:xs) }

49
Text/Parsec/Error.hs → Text/MegaParsec/Error.hs
View File

@ -1,30 +1,33 @@
-----------------------------------------------------------------------------
-- |
-- Module : Text.Parsec.Error
-- Copyright : (c) Daan Leijen 1999-2001, (c) Paolo Martini 2007
-- License : BSD-style (see the LICENSE file)
--
-- Maintainer : derek.a.elkins@gmail.com
-- Module : Text.MegaParsec.Error
-- Copyright : © 1999–2001 Daan Leijen, © 2007 Paolo Martini, © 2015 MegaParsec contributors
-- License : BSD3
--
-- Maintainer : Mark Karpov <markkarpov@opmbx.org>
-- Stability : provisional
-- Portability : portable
--
-- Parse errors
--
-----------------------------------------------------------------------------
--
-- Parse errors.
module Text.Parsec.Error
( Message ( SysUnExpect, UnExpect, Expect, Message )
module Text.MegaParsec.Error
( Message (SysUnExpect, UnExpect, Expect, Message)
, messageString
, ParseError, errorPos, errorMessages, errorIsUnknown
, ParseError
, errorPos
, errorMessages
, errorIsUnknown
, showErrorMessages
, newErrorMessage, newErrorUnknown
, addErrorMessage, setErrorPos, setErrorMessage
, mergeError
) where
, newErrorMessage
, newErrorUnknown
, addErrorMessage
, setErrorPos
, setErrorMessage
, mergeError )
where
import Data.List ( nub, sort )
import Data.List (nub, sort)
import Text.Parsec.Pos
import Text.MegaParsec.Pos
-- | This abstract data type represents parse error messages. There are
-- four kinds of messages:
@ -33,7 +36,7 @@ import Text.Parsec.Pos
-- > | UnExpect String
-- > | Expect String
-- > | Message String
--
--
-- The fine distinction between different kinds of parse errors allows
-- the system to generate quite good error messages for the user. It
-- also allows error messages that are formatted in different
@ -51,7 +54,7 @@ import Text.Parsec.Pos
-- combinator. The argument describes the expected item.
--
-- * A 'Message' message is generated by the 'fail'
-- combinator. The argument is some general parser message.
-- combinator. The argument is some general parser message.
data Message = SysUnExpect !String -- @ library generated unexpect
| UnExpect !String -- @ unexpected something
@ -73,13 +76,13 @@ instance Eq Message where
-- < Compares two error messages without looking at their content. Only
-- the constructors are compared where:
--
--
-- > 'SysUnExpect' < 'UnExpect' < 'Expect' < 'Message'
instance Ord Message where
compare msg1 msg2 = compare (fromEnum msg1) (fromEnum msg2)
-- | Extract the message string from an error message
-- | Extract the message string from an error message
messageString :: Message -> String
messageString (SysUnExpect s) = s

33
Text/Parsec/Expr.hs → Text/MegaParsec/Expr.hs
View File

@ -1,25 +1,24 @@
-----------------------------------------------------------------------------
-- |
-- Module : Text.Parsec.Expr
-- Copyright : (c) Daan Leijen 1999-2001, (c) Paolo Martini 2007
-- License : BSD-style (see the LICENSE file)
--
-- Maintainer : derek.a.elkins@gmail.com
-- Module : Text.MegaParsec.Expr
-- Copyright : © 1999–2001 Daan Leijen, © 2007 Paolo Martini, © 2015 MegaParsec contributors
-- License : BSD3
--
-- Maintainer : Mark Karpov <markkarpov@opmbx.org>
-- Stability : provisional
-- Portability : non-portable
--
--
-- A helper module to parse \"expressions\".
-- Builds a parser given a table of operators and associativities.
--
-----------------------------------------------------------------------------
module Text.Parsec.Expr
( Assoc(..), Operator(..), OperatorTable
, buildExpressionParser
) where
module Text.MegaParsec.Expr
( Assoc (..)
, Operator (..)
, OperatorTable
, buildExpressionParser )
where
import Text.Parsec.Prim
import Text.Parsec.Combinator
import Text.MegaParsec.Combinator
import Text.MegaParsec.Prim
-----------------------------------------------------------
-- Assoc and OperatorTable
@ -68,7 +67,7 @@ type OperatorTable s u m a = [[Operator s u m a]]
-- > expr = buildExpressionParser table term
-- > <?> "expression"
-- >
-- > term = parens expr
-- > term = parens expr
-- > <|> natural
-- > <?> "simple expression"
-- >
@ -77,7 +76,7 @@ type OperatorTable s u m a = [[Operator s u m a]]
-- > , [binary "*" (*) AssocLeft, binary "/" (div) AssocLeft ]
-- > , [binary "+" (+) AssocLeft, binary "-" (-) AssocLeft ]
-- > ]
-- >
-- >
-- > binary name fun assoc = Infix (do{ reservedOp name; return fun }) assoc
-- > prefix name fun = Prefix (do{ reservedOp name; return fun })
-- > postfix name fun = Postfix (do{ reservedOp name; return fun })

73
Text/Parsec/Language.hs → Text/MegaParsec/Language.hs
View File

@ -1,30 +1,29 @@
-----------------------------------------------------------------------------
-- |
-- Module : Text.Parsec.Language
-- Copyright : (c) Daan Leijen 1999-2001, (c) Paolo Martini 2007
-- License : BSD-style (see the LICENSE file)
--
-- Maintainer : derek.a.elkins@gmail.com
-- Module : Text.MegaParsec.Language
-- Copyright : © 1999–2001 Daan Leijen, © 2007 Paolo Martini, © 2015 MegaParsec contributors
-- License : BSD3
--
-- Maintainer : Mark Karpov <markkarpov@opmbx.org>
-- Stability : provisional
-- Portability : non-portable (uses non-portable module Text.Parsec.Token)
--
-- A helper module that defines some language definitions that can be used
-- to instantiate a token parser (see "Text.Parsec.Token").
--
-----------------------------------------------------------------------------
module Text.Parsec.Language
( haskellDef, haskell
, mondrianDef, mondrian
module Text.MegaParsec.Language
( haskellDef
, haskell
, mondrianDef
, mondrian
, emptyDef
, haskellStyle
, javaStyle
, LanguageDef
, GenLanguageDef
) where
, GenLanguageDef )
where
import Text.Parsec
import Text.Parsec.Token
import Text.MegaParsec
import Text.MegaParsec.Token
-----------------------------------------------------------
-- Styles: haskellStyle, javaStyle
@ -41,9 +40,9 @@ haskellStyle = emptyDef
, commentLine = "--"
, nestedComments = True
, identStart = letter
, identLetter = alphaNum <|> oneOf "_'"
, opStart = opLetter haskellStyle
, opLetter = oneOf ":!#$%&*+./<=>?@\\^|-~"
, identLetter = alphaNum <|> oneOf "_'"
, opStart = opLetter haskellStyle
, opLetter = oneOf ":!#$%&*+./<=>?@\\^|-~"
, reservedOpNames= []
, reservedNames = []
, caseSensitive = True
@ -55,16 +54,16 @@ haskellStyle = emptyDef
javaStyle :: LanguageDef st
javaStyle = emptyDef
{ commentStart = "/*"
, commentEnd = "*/"
, commentLine = "//"
, nestedComments = True
, identStart = letter
, identLetter = alphaNum <|> oneOf "_'"
, reservedNames = []
, reservedOpNames= []
{ commentStart = "/*"
, commentEnd = "*/"
, commentLine = "//"
, nestedComments = True
, identStart = letter
, identLetter = alphaNum <|> oneOf "_'"
, reservedNames = []
, reservedOpNames= []
, caseSensitive = False
}
}
-----------------------------------------------------------
-- minimal language definition
@ -105,12 +104,12 @@ haskell = makeTokenParser haskellDef
haskellDef :: LanguageDef st
haskellDef = haskell98Def
{ identLetter = identLetter haskell98Def <|> char '#'
, reservedNames = reservedNames haskell98Def ++
["foreign","import","export","primitive"
,"_ccall_","_casm_"
,"forall"
]
{ identLetter = identLetter haskell98Def <|> char '#'
, reservedNames = reservedNames haskell98Def ++
["foreign","import","export","primitive"
,"_ccall_","_casm_"
,"forall"
]
}
-- | The language definition for the language Haskell98.
@ -142,8 +141,8 @@ mondrian = makeTokenParser mondrianDef
mondrianDef :: LanguageDef st
mondrianDef = javaStyle
{ reservedNames = [ "case", "class", "default", "extends"
, "import", "in", "let", "new", "of", "package"
]
{ reservedNames = [ "case", "class", "default", "extends"
, "import", "in", "let", "new", "of", "package"
]
, caseSensitive = True
}
}

54
Text/Parsec/Perm.hs → Text/MegaParsec/Perm.hs
View File

@ -1,42 +1,38 @@
-----------------------------------------------------------------------------
-- |
-- Module : Text.Parsec.Perm
-- Copyright : (c) Daan Leijen 1999-2001, (c) Paolo Martini 2007
-- License : BSD-style (see the file libraries/parsec/LICENSE)
--
-- Maintainer : derek.a.elkins@gmail.com
-- Module : Text.MegaParsec.Perm
-- Copyright : © 1999–2001 Daan Leijen, © 2007 Paolo Martini, © 2015 MegaParsec contributors
-- License : BSD3
--
-- Maintainer : Mark Karpov <markkarpov@opmbx.org>
-- Stability : provisional
-- Portability : non-portable (uses existentially quantified data constructors)
--
-- This module implements permutation parsers. The algorithm used
-- is fairly complex since we push the type system to its limits :-)
-- The algorithm is described in:
--
-- /Parsing Permutation Phrases,/
-- by Arthur Baars, Andres Loh and Doaitse Swierstra.
-- Published as a functional pearl at the Haskell Workshop 2001.
--
-----------------------------------------------------------------------------
--
-- This module implements permutation parsers. The algorithm used is fairly
-- complex since we push the type system to its limits :-) The algorithm is
-- described in:
--
-- /Parsing Permutation Phrases,/ by Arthur Baars, Andres Loh and Doaitse
-- Swierstra. Published as a functional pearl at the Haskell Workshop 2001.
{-# LANGUAGE ExistentialQuantification #-}
module Text.Parsec.Perm
module Text.MegaParsec.Perm
( PermParser
, StreamPermParser -- abstract
, permute
, (<||>), (<$$>)
, (<|?>), (<$?>)
) where
import Text.Parsec
, (<||>)
, (<$$>)
, (<|?>)
, (<$?>) )
where
import Control.Monad.Identity
import Text.MegaParsec
infixl 1 <||>, <|?>
infixl 2 <$$>, <$?>
{---------------------------------------------------------------
test -- parse a permutation of
* an optional string of 'a's
@ -62,7 +58,7 @@ ptest
-- | The expression @perm \<||> p@ adds parser @p@ to the permutation
-- parser @perm@. The parser @p@ is not allowed to accept empty input -
-- use the optional combinator ('<|?>') instead. Returns a
-- new permutation parser that includes @p@.
-- new permutation parser that includes @p@.
(<||>) :: (Stream s Identity tok) => StreamPermParser s st (a -> b) -> Parsec s st a -> StreamPermParser s st b
(<||>) perm p = add perm p
@ -87,7 +83,7 @@ ptest
-- | The expression @perm \<||> (x,p)@ adds parser @p@ to the
-- permutation parser @perm@. The parser @p@ is optional - if it can
-- not be applied, the default value @x@ will be used instead. Returns
-- a new permutation parser that includes the optional parser @p@.
-- a new permutation parser that includes the optional parser @p@.
(<|?>) :: (Stream s Identity tok) => StreamPermParser s st (a -> b) -> (a, Parsec s st a) -> StreamPermParser s st b
(<|?>) perm (x,p) = addopt perm x p
@ -96,7 +92,7 @@ ptest
-- consisting of parser @p@. The the final result of the permutation
-- parser is the function @f@ applied to the return value of @p@. The
-- parser @p@ is optional - if it can not be applied, the default value
-- @x@ will be used instead.
-- @x@ will be used instead.
(<$?>) :: (Stream s Identity tok) => (a -> b) -> (a, Parsec s st a) -> StreamPermParser s st b
(<$?>) f (x,p) = newperm f <|?> (x,p)
@ -110,7 +106,7 @@ ptest
type PermParser tok st a = StreamPermParser String st a
-- | The type @StreamPermParser s st a@ denotes a permutation parser that,
-- when converted by the 'permute' function, parses
-- when converted by the 'permute' function, parses
-- @s@ streams with user state @st@ and returns a value of
-- type @a@ on success.
--
@ -130,7 +126,7 @@ data StreamBranch s st a = forall b. Branch (StreamPermParser s st (b -> a)) (Pa
-- This can be described by:
--
-- > test = permute (tuple <$?> ("",many1 (char 'a'))
-- > <||> char 'b'
-- > <||> char 'b'
-- > <|?> ('_',char 'c'))
-- > where
-- > tuple a b c = (a,b,c)

72
Text/Parsec/Pos.hs → Text/MegaParsec/Pos.hs
View File

@ -1,51 +1,55 @@
-----------------------------------------------------------------------------
-- |
-- Module : Text.Parsec.Pos
-- Copyright : (c) Daan Leijen 1999-2001, (c) Paolo Martini 2007
-- License : BSD-style (see the LICENSE file)
--
-- Maintainer : derek.a.elkins@gmail.com
-- Module : Text.MegaParsec.Pos
-- Copyright : © 1999–2001 Daan Leijen, © 2007 Paolo Martini, © 2015 MegaParsec contributors
-- License : BSD3
--
-- Maintainer : Mark Karpov <markkarpov@opmbx.org>
-- Stability : provisional
-- Portability : portable
--
--
-- Textual source positions.
--
-----------------------------------------------------------------------------
module Text.Parsec.Pos
( SourceName, Line, Column
module Text.MegaParsec.Pos
( SourceName
, Line
, Column
, SourcePos
, sourceLine, sourceColumn, sourceName
, incSourceLine, incSourceColumn
, setSourceLine, setSourceColumn, setSourceName
, newPos, initialPos
, updatePosChar, updatePosString
) where
, sourceLine
, sourceColumn
, sourceName
, incSourceLine
, incSourceColumn
, setSourceLine
, setSourceColumn
, setSourceName
, newPos
, initialPos
, updatePosChar
, updatePosString )
where
import Data.Data (Data)
import Data.Typeable (Typeable)
-- < Source positions: a file name, a line and a column
-- upper left is (1,1)
-- Source positions: a file name, a line and a column upper left is (1,1)
type SourceName = String
type Line = Int
type Column = Int
-- | The abstract data type @SourcePos@ represents source positions. It
-- contains the name of the source (i.e. file name), a line number and
-- a column number. @SourcePos@ is an instance of the 'Show', 'Eq' and
-- 'Ord' class.
-- contains the name of the source (i.e. file name), a line number and a
-- column number. @SourcePos@ is an instance of the 'Show', 'Eq' and 'Ord'
-- class.
data SourcePos = SourcePos SourceName !Line !Column
data SourcePos = SourcePos SourceName !Line !Column
deriving ( Eq, Ord, Data, Typeable)
-- | Create a new 'SourcePos' with the given source name,
-- line number and column number.
newPos :: SourceName -> Line -> Column -> SourcePos
newPos name line column
= SourcePos name line column
newPos = SourcePos
-- | Create a new 'SourcePos' with the given source name,
-- and line number and column number set to 1, the upper left.
@ -54,27 +58,27 @@ initialPos :: SourceName -> SourcePos
initialPos name
= newPos name 1 1
-- | Extracts the name of the source from a source position.
-- | Extracts the name of the source from a source position.
sourceName :: SourcePos -> SourceName
sourceName (SourcePos name _line _column) = name
-- | Extracts the line number from a source position.
-- | Extracts the line number from a source position.
sourceLine :: SourcePos -> Line
sourceLine (SourcePos _name line _column) = line
-- | Extracts the column number from a source position.
-- | Extracts the column number from a source position.
sourceColumn :: SourcePos -> Column
sourceColumn (SourcePos _name _line column) = column
-- | Increments the line number of a source position.
-- | Increments the line number of a source position.
incSourceLine :: SourcePos -> Line -> SourcePos
incSourceLine (SourcePos name line column) n = SourcePos name (line+n) column
-- | Increments the column number of a source position.
-- | Increments the column number of a source position.
incSourceColumn :: SourcePos -> Column -> SourcePos
incSourceColumn (SourcePos name line column) n = SourcePos name line (column+n)
@ -84,19 +88,19 @@ incSourceColumn (SourcePos name line column) n = SourcePos name line (column+n)
setSourceName :: SourcePos -> SourceName -> SourcePos
setSourceName (SourcePos _name line column) n = SourcePos n line column
-- | Set the line number of a source position.
-- | Set the line number of a source position.
setSourceLine :: SourcePos -> Line -> SourcePos
setSourceLine (SourcePos name _line column) n = SourcePos name n column
-- | Set the column number of a source position.
-- | Set the column number of a source position.
setSourceColumn :: SourcePos -> Column -> SourcePos
setSourceColumn (SourcePos name line _column) n = SourcePos name line n
-- | The expression @updatePosString pos s@ updates the source position
-- @pos@ by calling 'updatePosChar' on every character in @s@, ie.
-- @foldl updatePosChar pos string@.
-- @foldl updatePosChar pos string@.
updatePosString :: SourcePos -> String -> SourcePos
updatePosString pos string
@ -107,7 +111,7 @@ updatePosString pos string
-- incremented by 1. If the character is a tab (\'\t\') the column
-- number is incremented to the nearest 8'th column, ie. @column + 8 -
-- ((column-1) \`mod\` 8)@. In all other cases, the column is
-- incremented by 1.
-- incremented by 1.
updatePosChar :: SourcePos -> Char -> SourcePos
updatePosChar (SourcePos name line column) c

105
Text/Parsec/Prim.hs → Text/MegaParsec/Prim.hs
View File

@ -1,22 +1,21 @@
-----------------------------------------------------------------------------
-- |
-- Module : Text.Parsec.Prim
-- Copyright : (c) Daan Leijen 1999-2001, (c) Paolo Martini 2007
-- License : BSD-style (see the LICENSE file)
--
-- Maintainer : derek.a.elkins@gmail.com
-- Module : Text.MegaParsec.Prim
-- Copyright : © 1999–2001 Daan Leijen, © 2007 Paolo Martini, © 2015 MegaParsec contributors
-- License : BSD3
--
-- Maintainer : Mark Karpov <markkarpov@opmbx.org>
-- Stability : provisional
-- Portability : portable
--
--
-- The primitive parser combinators.
--
-----------------------------------------------------------------------------
{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, FlexibleContexts,
UndecidableInstances #-}
{-# OPTIONS_HADDOCK not-home #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_HADDOCK not-home #-}
module Text.Parsec.Prim
module Text.MegaParsec.Prim
( unknownError
, sysUnExpectError
, unexpected
@ -24,9 +23,9 @@ module Text.Parsec.Prim
, runParsecT
, mkPT
, Parsec
, Consumed(..)
, Reply(..)
, State(..)
, Consumed (..)
, Reply (..)
, State (..)
, parsecMap
, parserReturn
, parserBind
@ -39,7 +38,7 @@ module Text.Parsec.Prim
, label
, labels
, lookAhead
, Stream(..)
, Stream (..)
, tokens
, try
, token
@ -65,9 +64,8 @@ module Text.Parsec.Prim
, putState
, modifyState
, setState
, updateState
) where
, updateState )
where
import qualified Data.ByteString.Lazy.Char8 as CL
import qualified Data.ByteString.Char8 as C
@ -75,36 +73,35 @@ import qualified Data.ByteString.Char8 as C
import qualified Data.Text as Text
import qualified Data.Text.Lazy as TextL
import qualified Control.Applicative as Applicative ( Applicative(..), Alternative(..) )
import Control.Monad()
import Control.Monad.Trans
import Control.Monad
import Control.Monad.Identity
import Control.Monad.Trans
import Control.Monad.Reader.Class
import Control.Monad.State.Class
import Control.Monad.Cont.Class
import Control.Monad.Error.Class
import Text.Parsec.Pos
import Text.Parsec.Error
import qualified Control.Applicative as A (Applicative (..), Alternative (..))
import Text.MegaParsec.Pos
import Text.MegaParsec.Error
unknownError :: State s u -> ParseError
unknownError state = newErrorUnknown (statePos state)
unknownError state = newErrorUnknown (statePos state)
sysUnExpectError :: String -> SourcePos -> Reply s u a
sysUnExpectError msg pos = Error (newErrorMessage (SysUnExpect msg) pos)
sysUnExpectError msg pos = Error (newErrorMessage (SysUnExpect msg) pos)
-- | 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 'Text.Parsec.Combinator.notFollowedBy'.
-- 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
-- 'Text.Parsec.Combinator.notFollowedBy'.
unexpected :: (Stream s m t) => String -> ParsecT s u m a
unexpected msg
= ParsecT $ \s _ _ _ eerr ->
unexpected :: Stream s m t => String -> ParsecT s u m a
unexpected msg = ParsecT $ \s _ _ _ eerr ->
eerr $ newErrorMessage (UnExpect msg) (statePos s)
-- | ParserT monad transformer and Parser type
@ -179,11 +176,11 @@ parsecMap f p
= ParsecT $ \s cok cerr eok eerr ->
unParser p s (cok . f) cerr (eok . f) eerr
instance Applicative.Applicative (ParsecT s u m) where
instance A.Applicative (ParsecT s u m) where
pure = return
(<*>) = ap -- TODO: Can this be optimized?
instance Applicative.Alternative (ParsecT s u m) where
instance A.Alternative (ParsecT s u m) where
empty = mzero
(<|>) = mplus
@ -234,7 +231,7 @@ parserBind m k
-- if (k x) consumes, those go straigt up
pcok = cok
pcerr = cerr
-- if (k x) doesn't consume input, but is okay,
-- we still return in the consumed continuation
peok x s err' = cok x s (mergeError err err')
@ -243,7 +240,7 @@ parserBind m k
-- we return the error in the 'consumed-error'
-- continuation
peerr err' = cerr (mergeError err err')
in unParser (k x) s pcok pcerr peok peerr
in unParser (k x) s pcok pcerr peok peerr
-- empty-ok case for m
meok x s err =
@ -252,7 +249,7 @@ parserBind m k
pcok = cok
peok x s err' = eok x s (mergeError err err')
pcerr = cerr
peerr err' = eerr (mergeError err err')
peerr err' = eerr (mergeError err err')
in unParser (k x) s pcok pcerr peok peerr
-- consumed-error case for m
mcerr = cerr
@ -279,7 +276,7 @@ instance MonadPlus (ParsecT s u m) where
mplus p1 p2 = parserPlus p1 p2
-- | @parserZero@ always fails without consuming any input. @parserZero@ is defined
-- equal to the 'mzero' member of the 'MonadPlus' class and to the 'Control.Applicative.empty' member
-- equal to the 'mzero' member of the 'MonadPlus' class and to the 'Control.Applicative.empty' member
-- of the 'Control.Applicative.Alternative' class.
parserZero :: ParsecT s u m a
@ -362,7 +359,7 @@ labels p msgs =
-- TODO: There should be a stronger statement that can be made about this
-- | An instance of @Stream@ has stream type @s@, underlying monad @m@ and token type @t@ determined by the stream
--
--
-- Some rough guidelines for a \"correct\" instance of Stream:
--
-- * unfoldM uncons gives the [t] corresponding to the stream
@ -403,7 +400,7 @@ tokens _ _ []
= ParsecT $ \s _ _ eok _ ->
eok [] s $ unknownError s
tokens showTokens nextposs tts@(tok:toks)
= ParsecT $ \(State input pos u) cok cerr eok eerr ->
= ParsecT $ \(State input pos u) cok cerr eok eerr ->
let
errEof = (setErrorMessage (Expect (showTokens tts))
(newErrorMessage (SysUnExpect "") pos))
@ -429,7 +426,7 @@ tokens showTokens nextposs tts@(tok:toks)
Just (x,xs)
| tok == x -> walk toks xs
| otherwise -> eerr $ errExpect x
-- | The parser @try p@ behaves like parser @p@, except that it
-- pretends that it hasn't consumed any input when an error occurs.
--
@ -531,10 +528,10 @@ tokenPrim :: (Stream s m t)
tokenPrim showToken nextpos test = tokenPrimEx showToken nextpos Nothing test
tokenPrimEx :: (Stream s m t)
=> (t -> String)
=> (t -> String)
-> (SourcePos -> t -> s -> SourcePos)
-> Maybe (SourcePos -> t -> s -> u -> u)
-> (t -> Maybe a)
-> (t -> Maybe a)
-> ParsecT s u m a
{-# INLINE tokenPrimEx #-}
tokenPrimEx showToken nextpos Nothing test
@ -687,13 +684,13 @@ getPosition :: (Monad m) => ParsecT s u m SourcePos
getPosition = do state <- getParserState
return (statePos state)
-- | Returns the current input
-- | Returns the current input
getInput :: (Monad m) => ParsecT s u m s
getInput = do state <- getParserState
return (stateInput state)
-- | @setPosition pos@ sets the current source position to @pos@.
-- | @setPosition pos@ sets the current source position to @pos@.
setPosition :: (Monad m) => SourcePos -> ParsecT s u m ()
setPosition pos
@ -702,7 +699,7 @@ setPosition pos
-- | @setInput input@ continues parsing with @input@. The 'getInput' and
-- @setInput@ functions can for example be used to deal with #include
-- files.
-- files.
setInput :: (Monad m) => s -> ParsecT s u m ()
setInput input
@ -714,7 +711,7 @@ setInput input
getParserState :: (Monad m) => ParsecT s u m (State s u)
getParserState = updateParserState id
-- | @setParserState st@ set the full parser state to @st@.
-- | @setParserState st@ set the full parser state to @st@.
setParserState :: (Monad m) => State s u -> ParsecT s u m (State s u)
setParserState st = updateParserState (const st)
@ -724,17 +721,17 @@ setParserState st = updateParserState (const st)
updateParserState :: (State s u -> State s u) -> ParsecT s u m (State s u)
updateParserState f =
ParsecT $ \s _ _ eok _ ->
let s' = f s
in eok s' s' $ unknownError s'
let s' = f s
in eok s' s' $ unknownError s'
-- < User state combinators
-- | Returns the current user state.
-- | Returns the current user state.
getState :: (Monad m) => ParsecT s u m u
getState = stateUser `liftM` getParserState
-- | @putState st@ set the user state to @st@.
-- | @putState st@ set the user state to @st@.
putState :: (Monad m) => u -> ParsecT s u m ()
putState u = do updateParserState $ \s -> s { stateUser = u }

37
Text/MegaParsec/String.hs Normal file
View File

@ -0,0 +1,37 @@
-- |
-- Module : Text.MegaParsec.String
-- Copyright : © 2007 Paolo Martini, © 2015 MegaParsec contributors
-- License : BSD3
--
-- Maintainer : Mark Karpov <markkarpov@opmbx.org>
-- Stability : provisional
-- Portability : portable
--
-- Make Strings an instance of 'Stream' with 'Char' token type.
module Text.MegaParsec.String
( Parser
, GenParser
, parseFromFile )
where
import Text.MegaParsec.Error
import Text.MegaParsec.Prim
type Parser = Parsec String ()
type GenParser tok st = Parsec [tok] st
-- | @parseFromFile p filePath@ runs a string parser @p@ on the
-- input read from @filePath@ using 'Prelude.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)
-- @
parseFromFile :: Parser a -> String -> IO (Either ParseError a)
parseFromFile p fname = runP p () fname <$> readFile fname

39
Text/MegaParsec/Text.hs Normal file
View File

@ -0,0 +1,39 @@
-- |
-- Module : Text.MegaParsec.Text
-- Copyright : © 2011 Antoine Latter, © 2015 MegaParsec contributors
-- License : BSD3
--
-- Maintainer : Mark Karpov <markkarpov@opmbx.org>
-- Stability : provisional
-- Portability : portable
--
-- Convenience definitions for working with 'Text.Text'.
module Text.MegaParsec.Text
( Parser
, GenParser
, parseFromFile )
where
import Text.MegaParsec.Error
import Text.MegaParsec.Prim
import qualified Data.Text as T
import qualified Data.Text.IO as T
type Parser = Parsec T.Text ()
type GenParser st = Parsec T.Text st
-- | @parseFromFile p filePath@ runs a lazy text parser @p@ on the
-- input read from @filePath@ using 'Prelude.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)
-- @
parseFromFile :: Parser a -> String -> IO (Either ParseError a)
parseFromFile p fname = runP p () fname <$> T.readFile fname

39
Text/MegaParsec/Text/Lazy.hs Normal file
View File

@ -0,0 +1,39 @@
-- |
-- Module : Text.MegaParsec.Text.Lazy
-- Copyright : © 2011 Antoine Latter, © 2015 MegaParsec contributors
-- License : BSD3
--
-- Maintainer : Mark Karpov <markkarpov@opmbx.org>
-- Stability : provisional
-- Portability : portable
--
-- Convenience definitions for working with lazy 'Text.Text'.
module Text.MegaParsec.Text.Lazy
( Parser
, GenParser
, parseFromFile )
where
import Text.MegaParsec.Error
import Text.MegaParsec.Prim
import qualified Data.Text.Lazy as T
import qualified Data.Text.Lazy.IO as T
type Parser = Parsec T.Text ()
type GenParser st = Parsec T.Text st
-- | @parseFromFile p filePath@ runs a lazy text parser @p@ on the
-- input read from @filePath@ using 'Prelude.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)
-- @
parseFromFile :: Parser a -> String -> IO (Either ParseError a)
parseFromFile p fname = runP p () fname <$> T.readFile fname

120
Text/Parsec/Token.hs → Text/MegaParsec/Token.hs
View File

@ -1,35 +1,33 @@
-----------------------------------------------------------------------------
-- |
-- Module : Text.Parsec.Token
-- Copyright : (c) Daan Leijen 1999-2001, (c) Paolo Martini 2007
-- License : BSD-style (see the LICENSE file)
--
-- Maintainer : derek.a.elkins@gmail.com
-- Module : Text.MegaParsec.Token
-- Copyright : © 1999–2001 Daan Leijen, © 2007 Paolo Martini, © 2015 MegaParsec contributors
-- License : BSD3
--
-- Maintainer : Mark Karpov <markkarpov@opmbx.org>
-- Stability : provisional
-- Portability : non-portable (uses local universal quantification: PolymorphicComponents)
--
--
-- A helper module to parse lexical elements (tokens). See 'makeTokenParser'
-- for a description of how to use it.
--
-----------------------------------------------------------------------------
{-# LANGUAGE PolymorphicComponents #-}
{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
module Text.Parsec.Token
module Text.MegaParsec.Token
( LanguageDef
, GenLanguageDef (..)
, TokenParser
, GenTokenParser (..)
, makeTokenParser
) where
, makeTokenParser )
where
import Data.Char ( isAlpha, toLower, toUpper, isSpace, digitToInt )
import Data.List ( nub, sort )
import Data.Char (isAlpha, toLower, toUpper, isSpace, digitToInt)
import Data.List (nub, sort)
import Control.Monad.Identity
import Text.Parsec.Prim
import Text.Parsec.Char
import Text.Parsec.Combinator
import Text.MegaParsec.Prim
import Text.MegaParsec.Char
import Text.MegaParsec.Combinator
-----------------------------------------------------------
-- Language Definition
@ -42,58 +40,58 @@ type LanguageDef st = GenLanguageDef String st Identity
-- contains some default definitions.
data GenLanguageDef s u m
= LanguageDef {
= LanguageDef {
-- | Describes the start of a block comment. Use the empty string if the
-- language doesn't support block comments. For example \"\/*\".
-- language doesn't support block comments. For example \"\/*\".
commentStart :: String,
-- | Describes the end of a block comment. Use the empty string if the
-- language doesn't support block comments. For example \"*\/\".
-- language doesn't support block comments. For example \"*\/\".
commentEnd :: String,
-- | Describes the start of a line comment. Use the empty string if the
-- language doesn't support line comments. For example \"\/\/\".
-- language doesn't support line comments. For example \"\/\/\".
commentLine :: String,
-- | Set to 'True' if the language supports nested block comments.
-- | Set to 'True' if the language supports nested block comments.
nestedComments :: Bool,
-- | This parser should accept any start characters of identifiers. For
-- example @letter \<|> char \'_\'@.
-- example @letter \<|> char \'_\'@.
identStart :: ParsecT s u m Char,
-- | This parser should accept any legal tail characters of identifiers.
-- For example @alphaNum \<|> char \'_\'@.
-- For example @alphaNum \<|> char \'_\'@.
identLetter :: ParsecT s u m Char,
-- | This parser should accept any start characters of operators. For
-- example @oneOf \":!#$%&*+.\/\<=>?\@\\\\^|-~\"@
-- example @oneOf \":!#$%&*+.\/\<=>?\@\\\\^|-~\"@
opStart :: ParsecT s u m Char,
-- | This parser should accept any legal tail characters of operators.
-- Note that this parser should even be defined if the language doesn't
-- support user-defined operators, or otherwise the 'reservedOp'
-- parser won't work correctly.
-- parser won't work correctly.
opLetter :: ParsecT s u m Char,
-- | The list of reserved identifiers.
-- | The list of reserved identifiers.
reservedNames :: [String],
-- | The list of reserved operators.
-- | The list of reserved operators.
reservedOpNames:: [String],
-- | Set to 'True' if the language is case sensitive.
-- | Set to 'True' if the language is case sensitive.
caseSensitive :: Bool
@ -119,11 +117,11 @@ data GenTokenParser s u m
-- a single token using 'try'.
identifier :: ParsecT s u m String,
-- | The lexeme parser @reserved name@ parses @symbol
-- | The lexeme parser @reserved name@ parses @symbol
-- name@, but it also checks that the @name@ is not a prefix of a
-- valid identifier. A @reserved@ word is treated as a single token
-- using 'try'.
-- using 'try'.
reserved :: String -> ParsecT s u m (),
@ -132,14 +130,14 @@ data GenTokenParser s u m
-- operators. Legal operator (start) characters and reserved operators
-- are defined in the 'LanguageDef' that is passed to
-- 'makeTokenParser'. An @operator@ is treated as a
-- single token using 'try'.
-- single token using 'try'.
operator :: ParsecT s u m String,
-- |The lexeme parser @reservedOp name@ parses @symbol
-- name@, but it also checks that the @name@ is not a prefix of a
-- valid operator. A @reservedOp@ is treated as a single token using
-- 'try'.
-- 'try'.
reservedOp :: String -> ParsecT s u m (),
@ -148,7 +146,7 @@ data GenTokenParser s u m
-- literal character value. This parsers deals correctly with escape
-- sequences. The literal character is parsed according to the grammar
-- rules defined in the Haskell report (which matches most programming
-- languages quite closely).
-- languages quite closely).
charLiteral :: ParsecT s u m Char,
@ -156,7 +154,7 @@ data GenTokenParser s u m
-- string value. This parsers deals correctly with escape sequences and
-- gaps. The literal string is parsed according to the grammar rules
-- defined in the Haskell report (which matches most programming
-- languages quite closely).
-- languages quite closely).
stringLiteral :: ParsecT s u m String,
@ -164,7 +162,7 @@ data GenTokenParser s u m
-- number). Returns the value of the number. The number can be
-- specified in 'decimal', 'hexadecimal' or
-- 'octal'. The number is parsed according to the grammar
-- rules in the Haskell report.
-- rules in the Haskell report.
natural :: ParsecT s u m Integer,
@ -173,42 +171,42 @@ data GenTokenParser s u m
-- sign (i.e. \'-\' or \'+\'). Returns the value of the number. The
-- number can be specified in 'decimal', 'hexadecimal'
-- or 'octal'. The number is parsed according
-- to the grammar rules in the Haskell report.
-- to the grammar rules in the Haskell report.
integer :: ParsecT s u m Integer,
-- | This lexeme parser parses a floating point value. Returns the value
-- of the number. The number is parsed according to the grammar rules
-- defined in the Haskell report.
-- defined in the Haskell report.
float :: ParsecT s u m Double,
-- | This lexeme parser parses either 'natural' or a 'float'.
-- Returns the value of the number. This parsers deals with
-- any overlap in the grammar rules for naturals and floats. The number
-- is parsed according to the grammar rules defined in the Haskell report.
-- is parsed according to the grammar rules defined in the Haskell report.
naturalOrFloat :: ParsecT s u m (Either Integer Double),
-- | Parses a positive whole number in the decimal system. Returns the
-- value of the number.
-- value of the number.
decimal :: ParsecT s u m Integer,
-- | Parses a positive whole number in the hexadecimal system. The number
-- should be prefixed with \"0x\" or \"0X\". Returns the value of the
-- number.
-- number.
hexadecimal :: ParsecT s u m Integer,
-- | Parses a positive whole number in the octal system. The number
-- should be prefixed with \"0o\" or \"0O\". Returns the value of the
-- number.
-- number.
octal :: ParsecT s u m Integer,
-- | Lexeme parser @symbol s@ parses 'string' @s@ and skips
-- trailing white space.
-- trailing white space.
symbol :: String -> ParsecT s u m String,
@ -217,7 +215,7 @@ data GenTokenParser s u m
-- token (lexeme) is defined using @lexeme@, this way every parse
-- starts at a point without white space. Parsers that use @lexeme@ are
-- called /lexeme/ parsers in this document.
--
--
-- The only point where the 'whiteSpace' parser should be
-- called explicitly is the start of the main parser in order to skip
-- any leading white space.
@ -234,7 +232,7 @@ data GenTokenParser s u m
-- occurrences of a 'space', a line comment or a block (multi
-- line) comment. Block comments may be nested. How comments are
-- started and ended is defined in the 'LanguageDef'
-- that is passed to 'makeTokenParser'.
-- that is passed to 'makeTokenParser'.
whiteSpace :: ParsecT s u m (),
@ -244,17 +242,17 @@ data GenTokenParser s u m
parens :: forall a. ParsecT s u m a -> ParsecT s u m a,
-- | Lexeme parser @braces p@ parses @p@ enclosed in braces (\'{\' and
-- \'}\'), returning the value of @p@.
-- \'}\'), returning the value of @p@.
braces :: forall a. ParsecT s u m a -> ParsecT s u m a,
-- | Lexeme parser @angles p@ parses @p@ enclosed in angle brackets (\'\<\'
-- and \'>\'), returning the value of @p@.
-- and \'>\'), returning the value of @p@.
angles :: forall a. ParsecT s u m a -> ParsecT s u m a,
-- | Lexeme parser @brackets p@ parses @p@ enclosed in brackets (\'[\'
-- and \']\'), returning the value of @p@.
-- and \']\'), returning the value of @p@.
brackets :: forall a. ParsecT s u m a -> ParsecT s u m a,
@ -263,22 +261,22 @@ data GenTokenParser s u m
squares :: forall a. ParsecT s u m a -> ParsecT s u m a,
-- | Lexeme parser |semi| parses the character \';\' and skips any
-- trailing white space. Returns the string \";\".
-- trailing white space. Returns the string \";\".
semi :: ParsecT s u m String,
-- | Lexeme parser @comma@ parses the character \',\' and skips any
-- trailing white space. Returns the string \",\".
-- trailing white space. Returns the string \",\".
comma :: ParsecT s u m String,
-- | Lexeme parser @colon@ parses the character \':\' and skips any
-- trailing white space. Returns the string \":\".
-- trailing white space. Returns the string \":\".
colon :: ParsecT s u m String,
-- | Lexeme parser @dot@ parses the character \'.\' and skips any
-- trailing white space. Returns the string \".\".
-- trailing white space. Returns the string \".\".
dot :: ParsecT s u m String,
@ -289,19 +287,19 @@ data GenTokenParser s u m
semiSep :: forall a . ParsecT s u m a -> ParsecT s u m [a],
-- | Lexeme parser @semiSep1 p@ parses /one/ or more occurrences of @p@
-- separated by 'semi'. Returns a list of values returned by @p@.
-- separated by 'semi'. Returns a list of values returned by @p@.
semiSep1 :: forall a . ParsecT s u m a -> ParsecT s u m [a],
-- | Lexeme parser @commaSep p@ parses /zero/ or more occurrences of
-- @p@ separated by 'comma'. Returns a list of values returned
-- by @p@.
-- by @p@.
commaSep :: forall a . ParsecT s u m a -> ParsecT s u m [a],
-- | Lexeme parser @commaSep1 p@ parses /one/ or more occurrences of
-- @p@ separated by 'comma'. Returns a list of values returned
-- by @p@.
-- by @p@.
commaSep1 :: forall a . ParsecT s u m a -> ParsecT s u m [a]
}
@ -330,11 +328,11 @@ data GenTokenParser s u m
-- > expr = parens expr
-- > <|> identifier
-- > <|> ...
-- >
-- >
-- >
-- > -- The lexer
-- > lexer = P.makeTokenParser haskellDef
-- >
-- > lexer = P.makeTokenParser haskellDef
-- >
-- > parens = P.parens lexer
-- > braces = P.braces lexer
-- > identifier = P.identifier lexer

40
Text/Parsec/ByteString.hs
View File

@ -1,40 +0,0 @@
-----------------------------------------------------------------------------
-- |
-- Module : Text.Parsec.ByteString
-- Copyright : (c) Paolo Martini 2007
-- License : BSD-style (see the LICENSE file)
--
-- Maintainer : derek.a.elkins@gmail.com
-- Stability : provisional
-- Portability : portable
--
-- Convinience definitions for working with 'C.ByteString's.
--
-----------------------------------------------------------------------------
module Text.Parsec.ByteString
( Parser, GenParser, parseFromFile
) where
import Text.Parsec.Error
import Text.Parsec.Prim
import qualified Data.ByteString.Char8 as C
type Parser = Parsec C.ByteString ()
type GenParser t st = Parsec C.ByteString st
-- | @parseFromFile p filePath@ runs a strict bytestring parser @p@ on the
-- input read from @filePath@ using 'ByteString.Char8.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)
-- > }
parseFromFile :: Parser a -> String -> IO (Either ParseError a)
parseFromFile p fname
= do input <- C.readFile fname
return (runP p () fname input)

39
Text/Parsec/ByteString/Lazy.hs
View File

@ -1,39 +0,0 @@
-----------------------------------------------------------------------------
-- |
-- Module : Text.Parsec.ByteString.Lazy
-- Copyright : (c) Paolo Martini 2007
-- License : BSD-style (see the LICENSE file)
--
-- Maintainer : derek.a.elkins@gmail.com
-- Stability : provisional
-- Portability : portable
--
-- Convinience definitions for working with lazy 'C.ByteString's.
--
-----------------------------------------------------------------------------
module Text.Parsec.ByteString.Lazy
( Parser, GenParser, parseFromFile
) where
import Text.Parsec.Error
import Text.Parsec.Prim
import qualified Data.ByteString.Lazy.Char8 as C
type Parser = Parsec C.ByteString ()
type GenParser t st = Parsec C.ByteString st
-- | @parseFromFile p filePath@ runs a lazy bytestring parser @p@ on the
-- input read from @filePath@ using 'ByteString.Lazy.Char8.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)
-- > }
parseFromFile :: Parser a -> String -> IO (Either ParseError a)
parseFromFile p fname
= do input <- C.readFile fname
return (runP p () fname input)

151
Text/Parsec/Char.hs
View File

@ -1,151 +0,0 @@
-----------------------------------------------------------------------------
-- |
-- Module : Text.Parsec.Char
-- Copyright : (c) Daan Leijen 1999-2001, (c) Paolo Martini 2007
-- License : BSD-style (see the LICENSE file)
--
-- Maintainer : derek.a.elkins@gmail.com
-- Stability : provisional
-- Portability : portable
--
-- Commonly used character parsers.
--
-----------------------------------------------------------------------------
{-# LANGUAGE FlexibleContexts #-}
module Text.Parsec.Char where
import Data.Char
import Text.Parsec.Pos
import Text.Parsec.Prim
import Control.Applicative ((*>))
-- | @oneOf cs@ succeeds if the current character is in the supplied
-- list of characters @cs@. Returns the parsed character. See also
-- 'satisfy'.
--
-- > vowel = oneOf "aeiou"
oneOf :: (Stream s m Char) => [Char] -> ParsecT s u m Char
oneOf cs = satisfy (\c -> elem c cs)
-- | As the dual of 'oneOf', @noneOf cs@ succeeds if the current
-- character /not/ in the supplied list of characters @cs@. Returns the
-- parsed character.
--
-- > consonant = noneOf "aeiou"
noneOf :: (Stream s m Char) => [Char] -> ParsecT s u m Char
noneOf cs = satisfy (\c -> not (elem c cs))
-- | Skips /zero/ or more white space characters. See also 'skipMany'.
spaces :: (Stream s m Char) => ParsecT s u m ()
spaces = skipMany space <?> "white space"
-- | Parses a white space character (any character which satisfies 'isSpace')
-- Returns the parsed character.
space :: (Stream s m Char) => ParsecT s u m Char
space = satisfy isSpace <?> "space"
-- | Parses a newline character (\'\\n\'). Returns a newline character.
newline :: (Stream s m Char) => ParsecT s u m Char
newline = char '\n' <?> "lf new-line"
-- | Parses a carriage return character (\'\\r\') followed by a newline character (\'\\n\').
-- Returns a newline character.
crlf :: (Stream s m Char) => ParsecT s u m Char
crlf = char '\r' *> char '\n' <?> "crlf new-line"
-- | Parses a CRLF (see 'crlf') or LF (see 'newline') end-of-line.
-- Returns a newline character (\'\\n\').
--
-- > endOfLine = newline <|> crlf
--
endOfLine :: (Stream s m Char) => ParsecT s u m Char
endOfLine = newline <|> crlf <?> "new-line"
-- | Parses a tab character (\'\\t\'). Returns a tab character.
tab :: (Stream s m Char) => ParsecT s u m Char
tab = char '\t' <?> "tab"
-- | Parses an upper case letter (a character between \'A\' and \'Z\').
-- Returns the parsed character.
upper :: (Stream s m Char) => ParsecT s u m Char
upper = satisfy isUpper <?> "uppercase letter"
-- | Parses a lower case character (a character between \'a\' and \'z\').
-- Returns the parsed character.
lower :: (Stream s m Char) => ParsecT s u m Char
lower = satisfy isLower <?> "lowercase letter"
-- | Parses a letter or digit (a character between \'0\' and \'9\').
-- Returns the parsed character.
alphaNum :: (Stream s m Char => ParsecT s u m Char)
alphaNum = satisfy isAlphaNum <?> "letter or digit"
-- | Parses a letter (an upper case or lower case character). Returns the
-- parsed character.
letter :: (Stream s m Char) => ParsecT s u m Char
letter = satisfy isAlpha <?> "letter"
-- | Parses a digit. Returns the parsed character.
digit :: (Stream s m Char) => ParsecT s u m Char
digit = satisfy isDigit <?> "digit"
-- | Parses a hexadecimal digit (a digit or a letter between \'a\' and
-- \'f\' or \'A\' and \'F\'). Returns the parsed character.
hexDigit :: (Stream s m Char) => ParsecT s u m Char
hexDigit = satisfy isHexDigit <?> "hexadecimal digit"
-- | Parses an octal digit (a character between \'0\' and \'7\'). Returns
-- the parsed character.
octDigit :: (Stream s m Char) => ParsecT s u m Char
octDigit = satisfy isOctDigit <?> "octal digit"
-- | @char c@ parses a single character @c@. Returns the parsed
-- character (i.e. @c@).
--
-- > semiColon = char ';'
char :: (Stream s m Char) => Char -> ParsecT s u m Char
char c = satisfy (==c) <?> show [c]
-- | This parser succeeds for any character. Returns the parsed character.
anyChar :: (Stream s m Char) => ParsecT s u m Char
anyChar = satisfy (const True)
-- | The parser @satisfy f@ succeeds for any character for which the
-- supplied function @f@ returns 'True'. Returns the character that is
-- actually parsed.
-- > digit = satisfy isDigit
-- > oneOf cs = satisfy (\c -> c `elem` cs)
satisfy :: (Stream s m Char) => (Char -> Bool) -> ParsecT s u m Char
satisfy f = tokenPrim (\c -> show [c])
(\pos c _cs -> updatePosChar pos c)
(\c -> if f c then Just c else Nothing)
-- | @string s@ parses a sequence of characters given by @s@. Returns
-- the parsed string (i.e. @s@).
--
-- > divOrMod = string "div"
-- > <|> string "mod"
string :: (Stream s m Char) => String -> ParsecT s u m String
string s = tokens show updatePosString s

277
Text/Parsec/Combinator.hs
View File

@ -1,277 +0,0 @@
-----------------------------------------------------------------------------
-- |
-- Module : Text.Parsec.Combinator
-- Copyright : (c) Daan Leijen 1999-2001, (c) Paolo Martini 2007
-- License : BSD-style (see the LICENSE file)
--
-- Maintainer : derek.a.elkins@gmail.com
-- Stability : provisional
-- Portability : portable
--
-- Commonly used generic combinators
--
-----------------------------------------------------------------------------
module Text.Parsec.Combinator
( choice
, count
, between
, option, optionMaybe, optional
, skipMany1
, many1
, sepBy, sepBy1
, endBy, endBy1
, sepEndBy, sepEndBy1
, chainl, chainl1
, chainr, chainr1
, eof, notFollowedBy
-- tricky combinators
, manyTill, lookAhead, anyToken
) where
import Control.Monad
import Text.Parsec.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 ps = foldr (<|>) mzero ps
-- | @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 (do{ d <- digit
-- > ; return (digitToInt d)
-- > })
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 (liftM 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 = do{ 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
= do{ open; x <- p; close; return x }
-- | @skipMany1 p@ applies the parser @p@ /one/ or more times, skipping
-- its result.
skipMany1 :: (Stream s m t) => ParsecT s u m a -> ParsecT s u m ()
skipMany1 p = do{ p; skipMany p }
{-
skipMany p = scan
where
scan = do{ p; scan } <|> return ()
-}
-- | @many1 p@ applies the parser @p@ /one/ or more times. Returns a
-- list of the returned values of @p@.
--
-- > word = many1 letter
many1 :: (Stream s m t) => ParsecT s u m a -> ParsecT s u m [a]
many1 p = do{ x <- p; xs <- many p; return (x:xs) }
{-
many p = scan id
where
scan f = do{ x <- p
; scan (\tail -> f (x:tail))
}
<|> return (f [])
-}
-- | @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 = do{ x <- p
; xs <- many (sep >> p)
; return (x:xs)
}
-- | @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 = do{ x <- p
; do{ sep
; xs <- sepEndBy p sep
; return (x:xs)
}
<|> return [x]
}
-- | @sepEndBy p sep@ parses /zero/ or more occurrences of @p@,
-- separated and optionally ended by @sep@, ie. 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 = many1 (do{ x <- p; sep; return x })
-- | @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 (do{ x <- p; sep; return x })
-- | @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 = sequence (replicate 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 x@ 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 = do{ symbol "*"; return (*) }
-- > <|> do{ symbol "/"; return (div) }
-- >
-- > addop = do{ symbol "+"; return (+) }
-- > <|> do{ 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 = do{ x <- p; rest x }
where
rest x = do{ f <- op
; y <- p
; rest (f x y)
}
<|> return x
-- | @chainr1 p op x@ 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 = scan
where
scan = do{ x <- p; rest x }
rest x = do{ f <- op
; y <- scan
; return (f x y)
}
<|> return x
-----------------------------------------------------------
-- Tricky combinators
-----------------------------------------------------------
-- | 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 _tok _toks -> 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 (do{ string "let"
-- > ; notFollowedBy alphaNum
-- > })
notFollowedBy :: (Stream s m t, Show a) => ParsecT s u m a -> ParsecT s u m ()
notFollowedBy p = try (do{ c <- try p; unexpected (show c) }
<|> 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 = do{ string "<!--"
-- > ; manyTill anyChar (try (string "-->"))
-- > }
--
-- Note the overlapping parsers @anyChar@ and @string \"-->\"@, and
-- therefore the use of the 'try' combinator.
manyTill :: (Stream s m t) => ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill p end = scan
where
scan = do{ end; return [] }
<|>
do{ x <- p; xs <- scan; return (x:xs) }

37
Text/Parsec/String.hs
View File

@ -1,37 +0,0 @@
-----------------------------------------------------------------------------
-- |
-- Module : Text.Parsec.String
-- Copyright : (c) Paolo Martini 2007
-- License : BSD-style (see the file libraries/parsec/LICENSE)
--
-- Maintainer : derek.a.elkins@gmail.com
-- Stability : provisional
-- Portability : portable
--
-- Make Strings an instance of 'Stream' with 'Char' token type.
--
-----------------------------------------------------------------------------
module Text.Parsec.String
( Parser, GenParser, parseFromFile
) where
import Text.Parsec.Error
import Text.Parsec.Prim
type Parser = Parsec String ()
type GenParser tok st = Parsec [tok] st
-- | @parseFromFile p filePath@ runs a string parser @p@ on the
-- input read from @filePath@ using 'Prelude.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)
-- > }
parseFromFile :: Parser a -> String -> IO (Either ParseError a)
parseFromFile p fname
= do input <- readFile fname
return (runP p () fname input)

24
Text/Parsec/Text.hs
View File

@ -1,24 +0,0 @@
-----------------------------------------------------------------------------
-- |
-- Module : Text.Parsec.String
-- Copyright : (c) Antoine Latter 2011
-- License : BSD-style (see the file libraries/parsec/LICENSE)
--
-- Maintainer : aslatter@gmail.com
-- Stability : provisional
-- Portability : portable
--
-- Convinience definitions for working with 'Text.Text'.
--
-----------------------------------------------------------------------------
module Text.Parsec.Text
( Parser, GenParser
) where
import qualified Data.Text as Text
import Text.Parsec.Error
import Text.Parsec.Prim
type Parser = Parsec Text.Text ()
type GenParser st = Parsec Text.Text st

24
Text/Parsec/Text/Lazy.hs
View File

@ -1,24 +0,0 @@
-----------------------------------------------------------------------------
-- |
-- Module : Text.Parsec.String
-- Copyright : (c) Antoine Latter 2011
-- License : BSD-style (see the file libraries/parsec/LICENSE)
--
-- Maintainer : aslatter@gmail.com
-- Stability : provisional
-- Portability : portable
--
-- Convinience definitions for working with lazy 'Text.Text'.
--
-----------------------------------------------------------------------------
module Text.Parsec.Text.Lazy
( Parser, GenParser
) where
import qualified Data.Text.Lazy as Text
import Text.Parsec.Error
import Text.Parsec.Prim
type Parser = Parsec Text.Text ()
type GenParser st = Parsec Text.Text st

41
Text/ParserCombinators/Parsec.hs
View File

@ -1,41 +0,0 @@
-----------------------------------------------------------------------------
-- |
-- Module : Text.ParserCombinators.Parsec
-- Copyright : (c) Paolo Martini 2007
-- License : BSD-style (see the LICENSE file)
--
-- Maintainer : derek.a.elkins@gmail.com
-- Stability : provisional
-- Portability : portable
--
-- Parsec compatibility module
--
-----------------------------------------------------------------------------
module Text.ParserCombinators.Parsec
( -- complete modules
module Text.ParserCombinators.Parsec.Prim
, module Text.ParserCombinators.Parsec.Combinator
, module Text.ParserCombinators.Parsec.Char
-- module Text.ParserCombinators.Parsec.Error
, ParseError
, errorPos
-- module Text.ParserCombinators.Parsec.Pos
, SourcePos
, SourceName, Line, Column
, sourceName, sourceLine, sourceColumn
, incSourceLine, incSourceColumn
, setSourceLine, setSourceColumn, setSourceName
) where
import Text.Parsec.String()
import Text.ParserCombinators.Parsec.Prim
import Text.ParserCombinators.Parsec.Combinator
import Text.ParserCombinators.Parsec.Char
import Text.ParserCombinators.Parsec.Error
import Text.ParserCombinators.Parsec.Pos

40
Text/ParserCombinators/Parsec/Char.hs
View File

@ -1,40 +0,0 @@
-----------------------------------------------------------------------------
-- |
-- Module : Text.ParserCombinators.Parsec.Char
-- Copyright : (c) Paolo Martini 2007
-- License : BSD-style (see the LICENSE file)
--
-- Maintainer : derek.a.elkins@gmail.com
-- Stability : provisional
-- Portability : portable
--
-- Parsec compatibility module
--
-----------------------------------------------------------------------------
module Text.ParserCombinators.Parsec.Char
( CharParser,
spaces,
space,
newline,
tab,
upper,
lower,
alphaNum,
letter,
digit,
hexDigit,
octDigit,
char,
string,
anyChar,
oneOf,
noneOf,
satisfy
) where
import Text.Parsec.Char
import Text.Parsec.String
type CharParser st = GenParser Char st

42
Text/ParserCombinators/Parsec/Combinator.hs
View File

@ -1,42 +0,0 @@
-----------------------------------------------------------------------------
-- |
-- Module : Text.ParserCombinators.Parsec.Combinator
-- Copyright : (c) Paolo Martini 2007
-- License : BSD-style (see the LICENSE file)
--
-- Maintainer : derek.a.elkins@gmail.com
-- Stability : provisional
-- Portability : portable
--
-- Parsec compatibility module
--
-----------------------------------------------------------------------------
module Text.ParserCombinators.Parsec.Combinator
( choice,
count,
between,
option,
optionMaybe,
optional,
skipMany1,
many1,
sepBy,
sepBy1,
endBy,
endBy1,
sepEndBy,
sepEndBy1,
chainl,
chainl1,
chainr,
chainr1,
eof,
notFollowedBy,
manyTill,
lookAhead,
anyToken
) where
import Text.Parsec.Combinator

40
Text/ParserCombinators/Parsec/Error.hs
View File

@ -1,40 +0,0 @@
-----------------------------------------------------------------------------
-- |
-- Module : Text.ParserCombinators.Parsec.Error
-- Copyright : (c) Paolo Martini 2007
-- License : BSD-style (see the LICENSE file)
--
-- Maintainer : derek.a.elkins@gmail.com
-- Stability : provisional
-- Portability : portable
--
-- Parsec compatibility module
--
-----------------------------------------------------------------------------
module Text.ParserCombinators.Parsec.Error
( Message (SysUnExpect,UnExpect,Expect,Message),
messageString,
messageCompare,
messageEq,
ParseError,
errorPos,
errorMessages,
errorIsUnknown,
showErrorMessages,
newErrorMessage,
newErrorUnknown,
addErrorMessage,
setErrorPos,
setErrorMessage,
mergeError
) where
import Text.Parsec.Error
messageCompare :: Message -> Message -> Ordering
messageCompare = compare
messageEq :: Message -> Message -> Bool
messageEq = (==)

42
Text/ParserCombinators/Parsec/Expr.hs
View File

@ -1,42 +0,0 @@
-----------------------------------------------------------------------------
-- |
-- Module : Text.ParserCombinators.Parsec.Expr
-- Copyright : (c) Paolo Martini 2007
-- License : BSD-style (see the LICENSE file)
--
-- Maintainer : derek.a.elkins@gmail.com
-- Stability : provisional
-- Portability : portable
--
-- Parsec compatibility module
--
-----------------------------------------------------------------------------
module Text.ParserCombinators.Parsec.Expr
( Assoc (AssocNone,AssocLeft,AssocRight),
Operator(..),
OperatorTable,
buildExpressionParser
) where
import Text.Parsec.Expr(Assoc(..))
import qualified Text.Parsec.Expr as N
import Text.ParserCombinators.Parsec(GenParser)
import Control.Monad.Identity
data Operator tok st a = Infix (GenParser tok st (a -> a -> a)) Assoc
| Prefix (GenParser tok st (a -> a))
| Postfix (GenParser tok st (a -> a))
type OperatorTable tok st a = [[Operator tok st a]]
convert :: Operator tok st a -> N.Operator [tok] st Identity a
convert (Infix p a) = N.Infix p a
convert (Prefix p) = N.Prefix p
convert (Postfix p) = N.Postfix p
buildExpressionParser :: OperatorTable tok st a
-> GenParser tok st a
-> GenParser tok st a
buildExpressionParser = N.buildExpressionParser . map (map convert)

28
Text/ParserCombinators/Parsec/Language.hs
View File

@ -1,28 +0,0 @@
-----------------------------------------------------------------------------
-- |
-- Module : Text.ParserCombinators.Parsec.Language
-- Copyright : (c) Paolo Martini 2007
-- License : BSD-style (see the LICENSE file)
--
-- Maintainer : derek.a.elkins@gmail.com
-- Stability : provisional
-- Portability : portable
--
-- Parsec compatibility module
--
-----------------------------------------------------------------------------
module Text.ParserCombinators.Parsec.Language
( haskellDef,
haskell,
mondrianDef,
mondrian,
emptyDef,
haskellStyle,
javaStyle,
LanguageDef,
GenLanguageDef(..),
) where
import Text.Parsec.Token
import Text.Parsec.Language

24
Text/ParserCombinators/Parsec/Perm.hs
View File

@ -1,24 +0,0 @@
-----------------------------------------------------------------------------
-- |
-- Module : Text.ParserCombinators.Parsec.Perm
-- Copyright : (c) Paolo Martini 2007
-- License : BSD-style (see the LICENSE file)
--
-- Maintainer : derek.a.elkins@gmail.com
-- Stability : provisional
-- Portability : portable
--
-- Parsec compatibility module
--
-----------------------------------------------------------------------------
module Text.ParserCombinators.Parsec.Perm
( PermParser,
permute,
(<||>),
(<$$>),
(<|?>),
(<$?>)
) where
import Text.Parsec.Perm

35
Text/ParserCombinators/Parsec/Pos.hs
View File

@ -1,35 +0,0 @@
-----------------------------------------------------------------------------
-- |
-- Module : Text.ParserCombinators.Parsec.Pos
-- Copyright : (c) Paolo Martini 2007
-- License : BSD-style (see the LICENSE file)
--
-- Maintainer : derek.a.elkins@gmail.com
-- Stability : provisional
-- Portability : portable
--
-- Parsec compatibility module
--
-----------------------------------------------------------------------------
module Text.ParserCombinators.Parsec.Pos
( SourceName,
Line,
Column,
SourcePos,
sourceLine,
sourceColumn,
sourceName,
incSourceLine,
incSourceColumn,
setSourceLine,
setSourceColumn,
setSourceName,
newPos,
initialPos,
updatePosChar,
updatePosString
) where
import Text.Parsec.Pos

65
Text/ParserCombinators/Parsec/Prim.hs
View File

@ -1,65 +0,0 @@
-----------------------------------------------------------------------------
-- |
-- Module : Text.ParserCombinators.Parsec.Prim
-- Copyright : (c) Paolo Martini 2007
-- License : BSD-style (see the LICENSE file)
--
-- Maintainer : derek.a.elkins@gmail.com
-- Stability : provisional
-- Portability : portable
--
-- Parsec compatibility module
--
-----------------------------------------------------------------------------
module Text.ParserCombinators.Parsec.Prim
( (<?>),
(<|>),
Parser,
GenParser,
runParser,
parse,
parseFromFile,
parseTest,
token,
tokens,
tokenPrim,
tokenPrimEx,
try,
label,
labels,
unexpected,
pzero,
many,
skipMany,
getState,
setState,
updateState,
getPosition,
setPosition,
getInput,
setInput,
State(..),
getParserState,
setParserState
) where
import Text.Parsec.Prim hiding (runParser, try)
import qualified Text.Parsec.Prim as N -- 'N' for 'New'
import Text.Parsec.String
import Text.Parsec.Error
import Text.Parsec.Pos
pzero :: GenParser tok st a
pzero = parserZero
runParser :: GenParser tok st a
-> st
-> SourceName
-> [tok]
-> Either ParseError a
runParser = N.runParser
try :: GenParser tok st a -> GenParser tok st a
try = N.try

23
Text/ParserCombinators/Parsec/Token.hs
View File

@ -1,23 +0,0 @@
-----------------------------------------------------------------------------
-- |
-- Module : Text.ParserCombinators.Parsec.Token
-- Copyright : (c) Paolo Martini 2007
-- License : BSD-style (see the LICENSE file)
--
-- Maintainer : derek.a.elkins@gmail.com
-- Stability : provisional
-- Portability : portable
--
-- Parsec compatibility module
--
-----------------------------------------------------------------------------
module Text.ParserCombinators.Parsec.Token
( LanguageDef,
GenLanguageDef(..),
TokenParser,
GenTokenParser(..),
makeTokenParser
) where
import Text.Parsec.Token

48
parsec.cabal → megaparsec.cabal
View File

@ -27,8 +27,8 @@
-- any way out of the use of this software, even if advised of the
-- possibility of such damage.
name: parsec
version: 3.1.9
name: megaparsec
version: 4.0.0
cabal-version: >= 1.8
license: BSD3
license-file: LICENSE.md
@ -47,7 +47,7 @@ description:
extra-source-files: AUTHORS.md, CHANGELOG.md
library
build-depends: base >= 4 && < 5
build-depends: base >= 4.8 && < 5
, mtl
, bytestring
, text >= 0.2 && < 1.3
@ -58,31 +58,21 @@ library
, FlexibleContexts
, DeriveDataTypeable
, CPP
exposed-modules: Text.Parsec
, Text.Parsec.String
, Text.Parsec.ByteString
, Text.Parsec.ByteString.Lazy
, Text.Parsec.Text
, Text.Parsec.Text.Lazy
, Text.Parsec.Pos
, Text.Parsec.Error
, Text.Parsec.Prim
, Text.Parsec.Char
, Text.Parsec.Combinator
, Text.Parsec.Token
, Text.Parsec.Expr
, Text.Parsec.Language
, Text.Parsec.Perm
, Text.ParserCombinators.Parsec
, Text.ParserCombinators.Parsec.Char
, Text.ParserCombinators.Parsec.Combinator
, Text.ParserCombinators.Parsec.Error
, Text.ParserCombinators.Parsec.Expr
, Text.ParserCombinators.Parsec.Language
, Text.ParserCombinators.Parsec.Perm
, Text.ParserCombinators.Parsec.Pos
, Text.ParserCombinators.Parsec.Prim
, Text.ParserCombinators.Parsec.Token
exposed-modules: Text.MegaParsec
, Text.MegaParsec.String
, Text.MegaParsec.ByteString
, Text.MegaParsec.ByteString.Lazy
, Text.MegaParsec.Text
, Text.MegaParsec.Text.Lazy
, Text.MegaParsec.Pos
, Text.MegaParsec.Error
, Text.MegaParsec.Prim
, Text.MegaParsec.Char
, Text.MegaParsec.Combinator
, Text.MegaParsec.Token
, Text.MegaParsec.Expr
, Text.MegaParsec.Language
, Text.MegaParsec.Perm
ghc-options: -O2 -Wall
-- The test-suite should be rewritten using QuickCheck. For now let the old
@ -98,7 +88,7 @@ test-suite tests
, Bugs.Bug9
, Util
build-depends: base
, parsec
, megaparsec >= 4.0.0
, HUnit == 1.2.*
, test-framework >= 0.6 && < 0.9
, test-framework-hunit >= 0.2 && < 0.4

7
test/Bugs.hs
View File

@ -1,7 +1,5 @@
module Bugs
( bugs
) where
module Bugs (bugs) where
import Test.Framework
@ -12,5 +10,4 @@ import qualified Bugs.Bug9
bugs :: [Test]
bugs = [ Bugs.Bug2.main
, Bugs.Bug6.main
, Bugs.Bug9.main
]
, Bugs.Bug9.main ]

19
test/Bugs/Bug2.hs
View File

@ -1,28 +1,21 @@
module Bugs.Bug2
( main
) where
module Bugs.Bug2 (main) where
import Test.HUnit hiding ( Test )
import Test.HUnit hiding (Test)
import Test.Framework
import Test.Framework.Providers.HUnit
import Text.Parsec
import Text.Parsec.String
import qualified Text.Parsec.Token as P
import Text.Parsec.Language (haskellDef)
import Text.MegaParsec
import Text.MegaParsec.Language (haskellDef)
import qualified Text.MegaParsec.Token as P
main :: Test
main =
testCase "Control Char Parsing (#2)" $
parseString "\"test\\^Bstring\"" @?= "test\^Bstring"
where
parseString :: String -> String
parseString input =
case parse parser "Example" input of
Left{} -> error "Parse failure"
Right str -> str
parser :: Parser String
parser = P.stringLiteral $ P.makeTokenParser haskellDef
parser = P.stringLiteral $ P.makeTokenParser haskellDef

10
test/Bugs/Bug6.hs
View File

@ -1,14 +1,12 @@
module Bugs.Bug6
( main
) where
module Bugs.Bug6 (main) where
import Test.HUnit hiding ( Test )
import Test.HUnit hiding (Test)
import Test.Framework
import Test.Framework.Providers.HUnit
import Text.Parsec
import Text.Parsec.String
import Text.MegaParsec
import Text.MegaParsec.String
import Util

29
test/Bugs/Bug9.hs
View File

@ -1,32 +1,29 @@
module Bugs.Bug9 ( main ) where
module Bugs.Bug9 (main) where
import Control.Applicative ((<*), (<$>), (<$))
import Text.Parsec
import Text.Parsec.Language (haskellStyle)
import Text.Parsec.String (Parser)
import Text.Parsec.Expr
import qualified Text.Parsec.Token as P
import Text.MegaParsec
import Text.MegaParsec.Language (haskellStyle)
import Text.MegaParsec.String (Parser)
import Text.MegaParsec.Expr
import qualified Text.MegaParsec.Token as P
import Test.HUnit hiding ( Test )
import Test.HUnit hiding (Test)
import Test.Framework
import Test.Framework.Providers.HUnit
import Util
data Expr = Const Integer | Op Expr Expr
deriving Show
data Expr = Const Integer | Op Expr Expr deriving Show
main :: Test
main =
testCase "Tracing of current position in error message (#9)"
$ result @?= ["unexpected '>'","expecting operator or end of input"]
$ result @?= ["unexpected '>'", "expecting operator or end of input"]
where
result :: [String]
result = parseErrors parseTopLevel "4 >> 5"
-- Syntax analaysis
-- Syntax analysis
parseTopLevel :: Parser Expr
parseTopLevel = parseExpr <* eof
@ -35,12 +32,6 @@ parseExpr :: Parser Expr
parseExpr = buildExpressionParser table (Const <$> integer)
where
table = [[ Infix (Op <$ reserved ">>>") AssocLeft ]]
-- Lexical analysis
lexer = P.makeTokenParser haskellStyle { P.reservedOpNames = [">>>"] }
integer = P.integer lexer
reserved = P.reserved lexer
reservedOp = P.reservedOp lexer

5
test/Main.hs
View File

@ -4,7 +4,4 @@ import Test.Framework
import Bugs ( bugs )
main :: IO ()
main = do
defaultMain
[ testGroup "Bugs" bugs
]
main = defaultMain [testGroup "Bugs" bugs]

13
test/Util.hs
View File

@ -1,14 +1,13 @@
module Util where
import Text.Parsec
import Text.Parsec.String ( Parser )
import Text.MegaParsec
import Text.MegaParsec.String (Parser)
-- | Returns the error messages associated with a failed parse.
-- | Returns the error messages associated
-- with a failed parse.
parseErrors :: Parser a -> String -> [String]
parseErrors p input =
case parse p "" input of
Left err ->
drop 1 $ lines $ show err
Right{} -> []
Left err -> drop 1 $ lines $ show err
Right _ -> []