parsec 2.1.0.1 → 3.1.18.0
raw patch · 52 files changed
Files
- ChangeLog.md +114/−0
- LICENSE +1/−1
- README.md +102/−0
- Text/ParserCombinators/Parsec.hs +0/−54
- Text/ParserCombinators/Parsec/Char.hs +0/−75
- Text/ParserCombinators/Parsec/Combinator.hs +0/−155
- Text/ParserCombinators/Parsec/Error.hs +0/−164
- Text/ParserCombinators/Parsec/Expr.hs +0/−123
- Text/ParserCombinators/Parsec/Language.hs +0/−124
- Text/ParserCombinators/Parsec/Perm.hs +0/−122
- Text/ParserCombinators/Parsec/Pos.hs +0/−99
- Text/ParserCombinators/Parsec/Prim.hs +0/−456
- Text/ParserCombinators/Parsec/Token.hs +0/−473
- parsec.cabal +176/−32
- src/Text/Parsec.hs +129/−0
- src/Text/Parsec/ByteString.hs +42/−0
- src/Text/Parsec/ByteString/Lazy.hs +42/−0
- src/Text/Parsec/Char.hs +189/−0
- src/Text/Parsec/Combinator.hs +344/−0
- src/Text/Parsec/Error.hs +227/−0
- src/Text/Parsec/Expr.hs +174/−0
- src/Text/Parsec/Language.hs +151/−0
- src/Text/Parsec/Perm.hs +194/−0
- src/Text/Parsec/Pos.hs +129/−0
- src/Text/Parsec/Prim.hs +912/−0
- src/Text/Parsec/String.hs +39/−0
- src/Text/Parsec/Text.hs +45/−0
- src/Text/Parsec/Text/Lazy.hs +45/−0
- src/Text/Parsec/Token.hs +732/−0
- src/Text/ParserCombinators/Parsec.hs +43/−0
- src/Text/ParserCombinators/Parsec/Char.hs +42/−0
- src/Text/ParserCombinators/Parsec/Combinator.hs +44/−0
- src/Text/ParserCombinators/Parsec/Error.hs +42/−0
- src/Text/ParserCombinators/Parsec/Expr.hs +44/−0
- src/Text/ParserCombinators/Parsec/Language.hs +30/−0
- src/Text/ParserCombinators/Parsec/Perm.hs +26/−0
- src/Text/ParserCombinators/Parsec/Pos.hs +37/−0
- src/Text/ParserCombinators/Parsec/Prim.hs +67/−0
- src/Text/ParserCombinators/Parsec/Token.hs +25/−0
- test/Bugs.hs +18/−0
- test/Bugs/Bug2.hs +27/−0
- test/Bugs/Bug35.hs +39/−0
- test/Bugs/Bug6.hs +24/−0
- test/Bugs/Bug9.hs +44/−0
- test/Features.hs +14/−0
- test/Features/Feature150.hs +46/−0
- test/Features/Feature80.hs +47/−0
- test/Main.hs +12/−0
- test/Util.hs +14/−0
- test/issue127.hs +14/−0
- test/issue171.hs +29/−0
- test/issue175.hs +26/−0
+ ChangeLog.md view
@@ -0,0 +1,114 @@+### 3.1.18.0++- Drop support for GHCs prior 8.6.5++### 3.1.17.0++- Move `many1 :: ParsecT s u m a -> ParsecT s u m [a]` to `Text.Parsec.Prim`.+ Drop `Stream` constraint requirement.+- Change the position comparison in `mergeError` to not compare source names.+ This doesn't alter reported error positions when only a single source is parsed.+ This fixes performance issue caused by long source names.+- Add `Exception ParseError` instance++### 3.1.16.0++- Add `tokens'` and `string'` combinators which don't consume the prefix.++### 3.1.15.0++- Add `INLINABLE` pragmas to most overloaded combinators+- Support recent versions of dependencies+- Fix memory leak in `>>=` https://github.com/haskell/parsec/issues/127++### 3.1.14.0++- Add `parseFromFile` to `Text.Parsec.Text.Lazy` and `Text.Parsec.Text` (#103, #104).++- Clarify Haddock documentation in various places (#105,#101,#102).++- Add support for `base-4.13`.++### 3.1.13.0++- Add official support for [`SafeHaskell`](http://downloads.haskell.org/~ghc/latest/docs/html/users_guide/safe_haskell.html)++ **NOTE**: This is the first version whose `SafeHaskell` properties+ have become an intentional part of the API contract; previous+ versions were merely accidentally safe-inferred (or not depending+ on various factors; in other words, this was a fragile+ property). If you rely on `SafeHaskell` to consider module imports+ from `parsec` *safe*, this is the first version of `parsec` which+ actually guarantees a well-defined state; you can declare this+ requirement by either specifying++ build-depends: parsec >= 3.1.13.0 && < 3.2++ or, starting with `cabal-version:2.0`, via++ build-depends: parsec ^>= 3.1.13.0++- Drop support for GHC 7.0, GHC 7.2, and GHC 7.4.1; support window+ starts with GHC 7.4.2.++### 3.1.12.0++- Support limited to GHC 7.0 & GHC 7.2 only++- Add `MonadFail` instance for `ParsecT`+- Add `Semigroup`/`Monoid` instances for `ParsecT` (#80,#82)+- Fix space leak in Applicative/Monad interface (#37)+- Add `parserTrace` and `parserTraced` combinators for debugging.++### 3.1.11++- Include `README.md` in package.++### 3.1.10++- Most types now have a `Typeable` instance. Some instances are dropped from+ older versions of GHC (sorry about that!).+- The token-parser now rejects Unicode numeric escape sequences for characters+ outside the Unicode range.+- The token-parser now loses less precision when parsing literal doubles.+- Documentation fixes and corrections.+- We no longer test parsec builds on GHC 7.4.++### 3.1.9++- Many and various updates to documentation and package description (including+ the homepage links).+- Add an `Eq` instance for `ParseError`+- Fixed a regression from 3.1.6: `runP` is again exported from module+ Text.Parsec.++### 3.1.8++- Fix a regression from 3.1.6 related to exports from the main module.++### 3.1.7++- Fix a regression from 3.1.6 related to the reported position of error messages.+ See bug #9 for details.+- Reset the current error position on success of `lookAhead`.++### 3.1.6++- Export `Text` instances from Text.Parsec+- Make Text.Parsec exports more visible+- Re-arrange Text.Parsec exports+- Add functions `crlf` and `endOfLine` to Text.Parsec.Char for handling+ input streams that do not have normalized line terminators.+- Fix off-by-one error in Token.charControl++### 3.1.4++- Relax dependency on `text`++### 3.1.5++- Relax dependency on `text`++### 3.1.3++- Fix a regression introduced in 3.1.2 related to positions reported by error messages.
LICENSE view
@@ -1,4 +1,4 @@-Copyright 1999-2000, Daan Leijen. All rights reserved.+Copyright 1999-2000, Daan Leijen; 2007, Paolo Martini. All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met:
+ README.md view
@@ -0,0 +1,102 @@+Parsec [](https://travis-ci.org/haskell/parsec)+======++**Please refer to the [package description on Hackage](https://hackage.haskell.org/package/parsec#description) for more information.**++A monadic parser combinator library, written by Daan Leijen. Parsec is designed+from scratch as an industrial-strength parser library. It is simple, safe, well+documented, has extensive libraries, good error messages, and is fast.++Some links:++* [Parsec on Hackage](https://hackage.haskell.org/package/parsec),+ contains the generated documentation.+* The 2001 paper written by Daan Leijen, some what outdated+ ([PDF](https://web.archive.org/web/20140528151730/http://legacy.cs.uu.nl/daan/download/parsec/parsec.pdf),+ [HTML](https://web.archive.org/web/20140528151730/http://legacy.cs.uu.nl/daan/download/parsec/parsec.html),+ thanks to [archive.org](http://web.archive.org);+ and [PDF](https://research.microsoft.com/en-us/um/people/daan/download/parsec/parsec.pdf),+ thanks to Microsoft Research).+* [Using Parsec](http://book.realworldhaskell.org/read/using-parsec.html),+ chapter 16 of [Real World Haskell](http://book.realworldhaskell.org/).+* [An introduction to the Parsec library](https://www.kuniga.me/blog/2014/01/21/an-introduction-to-the-parsec-library.html)+ on Kunigami's blog.+* [An introduction to parsing text in Haskell with Parsec](https://jsdw.me/posts/haskell-parsec-basics/) on Wilson's blog.+* Differences between Parsec and+ [Attoparsec](http://hackage.haskell.org/package/attoparsec)+ (Haskell's other prominent parser library) as explained in+ [an answer on StackExchange](http://stackoverflow.com/a/19213247).+* Differences between Parsec and [Happy](http://www.haskell.org/happy)+ (Haskell's parser generator) as explained in two+ answers on separate StackExchange questions+ ([1](http://stackoverflow.com/a/7270904),+ [2](http://stackoverflow.com/a/14775331)).+* Differences between Parsec and+ [Megaparsec](http://hackage.haskell.org/package/megaparsec)+ (an advanced fork of Parsec) as explained in+ [Megaparsec's README](https://github.com/mrkkrp/megaparsec#megaparsec-vs-parsec).+++By analyzing [Parsec's reverse dependencies on Hackage](http://packdeps.haskellers.com/reverse/parsec)+we can find open source project that make use of Parsec. For example+[bibtex](http://hackage.haskell.org/package/bibtex),+[ConfigFile](http://hackage.haskell.org/package/ConfigFile),+[csv](http://hackage.haskell.org/package/csv) and+[hjson](http://hackage.haskell.org/package/hjson).+++## Getting started++This requires a working version of `cabal` and `ghci`, which are part of+any modern installation of Haskell, such as+[Haskell Platform](https://www.haskell.org/platform).++First install Parsec.++ cabal install parsec++Below we show how a very simple parser that tests matching parentheses+was made from GHCI (the interactive GHC environment), which we started+with the `ghci` command).++```+Prelude> :m +Text.Parsec+Prelude Text.Parsec> let parenSet = char '(' >> many parenSet >> char ')' :: Parsec String () Char+Loading package transformers-0.3.0.0 ... linking ... done.+Loading package array-0.5.0.0 ... linking ... done.+Loading package deepseq-1.3.0.2 ... linking ... done.+Loading package bytestring-0.10.4.0 ... linking ... done.+Loading package mtl-2.1.3.1 ... linking ... done.+Loading package text-1.1.1.3 ... linking ... done.+Loading package parsec-3.1.5 ... linking ... done.+Prelude Text.Parsec> let parens = (many parenSet >> eof) <|> eof+Prelude Text.Parsec> parse parens "" "()"+Right ()+Prelude Text.Parsec> parse parens "" "()(())"+Right ()+Prelude Text.Parsec> parse parens "" "("+Left (line 1, column 2):+unexpected end of input+expecting "(" or ")"+```++The `Right ()` results indicate successes: the parentheses matched.+The `Left [...]` result indicates a parse failure, and is detailed+with an error message.++For a more thorough introduction to Parsec we recommend the links at+the top of this README file.+++## Contributing++Issues (bugs, feature requests or otherwise feedback) may be reported in+[the Github issue tracker for this project](https://github.com/haskell/parsec/issues).++Pull-requests are also welcome.+++## License++See the [LICENSE](https://github.com/haskell/parsec/blob/master/LICENSE)+file in the repository.
− Text/ParserCombinators/Parsec.hs
@@ -1,54 +0,0 @@--------------------------------------------------------------------------------- |--- Module : Text.ParserCombinators.Parsec--- Copyright : (c) Daan Leijen 1999-2001--- License : BSD-style (see the file libraries/parsec/LICENSE)--- --- Maintainer : daan@cs.uu.nl--- Stability : provisional--- Portability : portable------ Parsec, the Fast Monadic Parser combinator library, see--- <http://www.cs.uu.nl/people/daan/parsec.html>.------ Inspired by:------ * Graham Hutton and Erik Meijer:--- Monadic Parser Combinators.--- Technical report NOTTCS-TR-96-4. --- Department of Computer Science, University of Nottingham, 1996. --- <http://www.cs.nott.ac.uk/~gmh/monparsing.ps>------ * Andrew Partridge, David Wright: --- Predictive parser combinators need four values to report errors.--- Journal of Functional Programming 6(2): 355-364, 1996------ This helper module exports elements from the basic libraries.-----------------------------------------------------------------------------------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.ParserCombinators.Parsec.Pos -- textual positions-import Text.ParserCombinators.Parsec.Error -- parse errors-import Text.ParserCombinators.Parsec.Prim -- primitive combinators-import Text.ParserCombinators.Parsec.Combinator -- derived combinators-import Text.ParserCombinators.Parsec.Char -- character parsers-
− Text/ParserCombinators/Parsec/Char.hs
@@ -1,75 +0,0 @@--------------------------------------------------------------------------------- |--- Module : Text.ParserCombinators.Parsec.Char--- Copyright : (c) Daan Leijen 1999-2001--- License : BSD-style (see the file libraries/parsec/LICENSE)--- --- Maintainer : daan@cs.uu.nl--- Stability : provisional--- Portability : portable------ Commonly used character parsers.--- --------------------------------------------------------------------------------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 Prelude-import Data.Char-import Text.ParserCombinators.Parsec.Pos( updatePosChar, updatePosString )-import Text.ParserCombinators.Parsec.Prim---------------------------------------------------------------- Type of character parsers-------------------------------------------------------------type CharParser st a = GenParser Char st a---------------------------------------------------------------- Character parsers-------------------------------------------------------------oneOf, noneOf :: [Char] -> CharParser st Char-oneOf cs = satisfy (\c -> elem c cs)-noneOf cs = satisfy (\c -> not (elem c cs))--spaces :: CharParser st ()-spaces = skipMany space <?> "white space" --space, newline, tab :: CharParser st Char-space = satisfy (isSpace) <?> "space"-newline = char '\n' <?> "new-line"-tab = char '\t' <?> "tab"--upper, lower, alphaNum, letter, digit, hexDigit, octDigit :: CharParser st Char-upper = satisfy (isUpper) <?> "uppercase letter"-lower = satisfy (isLower) <?> "lowercase letter"-alphaNum = satisfy (isAlphaNum) <?> "letter or digit"-letter = satisfy (isAlpha) <?> "letter"-digit = satisfy (isDigit) <?> "digit"-hexDigit = satisfy (isHexDigit) <?> "hexadecimal digit"-octDigit = satisfy (isOctDigit) <?> "octal digit"--char :: Char -> CharParser st Char-char c = satisfy (==c) <?> show [c]--anyChar :: CharParser st Char-anyChar = satisfy (const True)---------------------------------------------------------------- Primitive character parsers-------------------------------------------------------------satisfy :: (Char -> Bool) -> CharParser st Char-satisfy f = tokenPrim (\c -> show [c]) - (\pos c cs -> updatePosChar pos c) - (\c -> if f c then Just c else Nothing)--string :: String -> CharParser st String-string s = tokens show updatePosString s
− Text/ParserCombinators/Parsec/Combinator.hs
@@ -1,155 +0,0 @@--------------------------------------------------------------------------------- |--- Module : Text.ParserCombinators.Parsec.Combinator--- Copyright : (c) Daan Leijen 1999-2001--- License : BSD-style (see the file libraries/parsec/LICENSE)--- --- Maintainer : daan@cs.uu.nl--- Stability : provisional--- Portability : portable------ Commonly used generic combinators--- --------------------------------------------------------------------------------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- - -- tricky combinators- , manyTill, lookAhead, anyToken- ) where--import Control.Monad-import Text.ParserCombinators.Parsec.Prim----------------------------------------------------------------------------------------------------------------------------------------choice :: [GenParser tok st a] -> GenParser tok st a-choice ps = foldr (<|>) mzero ps--option :: a -> GenParser tok st a -> GenParser tok st a-option x p = p <|> return x--optionMaybe :: GenParser tok st a -> GenParser tok st (Maybe a)-optionMaybe p = option Nothing (liftM Just p)--optional :: GenParser tok st a -> GenParser tok st ()-optional p = do{ p; return ()} <|> return ()--between :: GenParser tok st open -> GenParser tok st close - -> GenParser tok st a -> GenParser tok st a-between open close p- = do{ open; x <- p; close; return x }- - -skipMany1 :: GenParser tok st a -> GenParser tok st ()-skipMany1 p = do{ p; skipMany p }-{--skipMany p = scan- where- scan = do{ p; scan } <|> return ()--}--many1 :: GenParser tok st a -> GenParser tok st [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 [])--}--sepBy1,sepBy :: GenParser tok st a -> GenParser tok st sep -> GenParser tok st [a]-sepBy p sep = sepBy1 p sep <|> return []-sepBy1 p sep = do{ x <- p- ; xs <- many (sep >> p)- ; return (x:xs)- }--sepEndBy1, sepEndBy :: GenParser tok st a -> GenParser tok st sep -> GenParser tok st [a]-sepEndBy1 p sep = do{ x <- p- ; do{ sep- ; xs <- sepEndBy p sep- ; return (x:xs)- }- <|> return [x]- }- -sepEndBy p sep = sepEndBy1 p sep <|> return []---endBy1,endBy :: GenParser tok st a -> GenParser tok st sep -> GenParser tok st [a]-endBy1 p sep = many1 (do{ x <- p; sep; return x })-endBy p sep = many (do{ x <- p; sep; return x })--count :: Int -> GenParser tok st a -> GenParser tok st [a]-count n p | n <= 0 = return []- | otherwise = sequence (replicate n p)---chainr,chainl :: GenParser tok st a -> GenParser tok st (a -> a -> a) -> a -> GenParser tok st a-chainr p op x = chainr1 p op <|> return x-chainl p op x = chainl1 p op <|> return x--chainr1,chainl1 :: GenParser tok st a -> GenParser tok st (a -> a -> a) -> GenParser tok st 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 = scan- where- scan = do{ x <- p; rest x }- - rest x = do{ f <- op- ; y <- scan- ; return (f x y)- }- <|> return x---------------------------------------------------------------- Tricky combinators-------------------------------------------------------------anyToken :: Show tok => GenParser tok st tok-anyToken = tokenPrim show (\pos tok toks -> pos) Just--eof :: Show tok => GenParser tok st ()-eof = notFollowedBy anyToken <?> "end of input" --notFollowedBy :: Show tok => GenParser tok st tok -> GenParser tok st () -notFollowedBy p = try (do{ c <- p; unexpected (show [c]) }- <|> return ()- )--manyTill :: GenParser tok st a -> GenParser tok st end -> GenParser tok st [a]-manyTill p end = scan- where- scan = do{ end; return [] }- <|>- do{ x <- p; xs <- scan; return (x:xs) }---lookAhead :: GenParser tok st a -> GenParser tok st a-lookAhead p = do{ state <- getParserState- ; x <- p- ; setParserState state- ; return x- }
− Text/ParserCombinators/Parsec/Error.hs
@@ -1,164 +0,0 @@--------------------------------------------------------------------------------- |--- Module : Text.ParserCombinators.Parsec.Error--- Copyright : (c) Daan Leijen 1999-2001--- License : BSD-style (see the file libraries/parsec/LICENSE)--- --- Maintainer : daan@cs.uu.nl--- Stability : provisional--- Portability : portable------ Parse errors--- --------------------------------------------------------------------------------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 Prelude-import Data.List (nub,sortBy)-import Text.ParserCombinators.Parsec.Pos - --------------------------------------------------------------- Messages------------------------------------------------------------ -data Message = SysUnExpect !String --library generated unexpect - | UnExpect !String --unexpected something - | Expect !String --expecting something- | Message !String --raw message- -messageToEnum msg- = case msg of SysUnExpect _ -> 0- UnExpect _ -> 1- Expect _ -> 2- Message _ -> 3 - -messageCompare :: Message -> Message -> Ordering-messageCompare msg1 msg2- = compare (messageToEnum msg1) (messageToEnum msg2)- -messageString :: Message -> String-messageString msg- = case msg of SysUnExpect s -> s- UnExpect s -> s- Expect s -> s- Message s -> s --messageEq :: Message -> Message -> Bool-messageEq msg1 msg2- = (messageCompare msg1 msg2 == EQ)- - --------------------------------------------------------------- Parse Errors------------------------------------------------------------ -data ParseError = ParseError !SourcePos [Message]--errorPos :: ParseError -> SourcePos-errorPos (ParseError pos msgs)- = pos- -errorMessages :: ParseError -> [Message]-errorMessages (ParseError pos msgs)- = sortBy messageCompare msgs - -errorIsUnknown :: ParseError -> Bool-errorIsUnknown (ParseError pos msgs)- = null msgs- - --------------------------------------------------------------- Create parse errors------------------------------------------------------------ -newErrorUnknown :: SourcePos -> ParseError-newErrorUnknown pos- = ParseError pos []- -newErrorMessage :: Message -> SourcePos -> ParseError-newErrorMessage msg pos - = ParseError pos [msg]--addErrorMessage :: Message -> ParseError -> ParseError-addErrorMessage msg (ParseError pos msgs)- = ParseError pos (msg:msgs)- -setErrorPos :: SourcePos -> ParseError -> ParseError-setErrorPos pos (ParseError _ msgs)- = ParseError pos msgs- -setErrorMessage :: Message -> ParseError -> ParseError-setErrorMessage msg (ParseError pos msgs)- = ParseError pos (msg:filter (not . messageEq msg) msgs)- - -mergeError :: ParseError -> ParseError -> ParseError-mergeError (ParseError pos msgs1) (ParseError _ msgs2)- = ParseError pos (msgs1 ++ msgs2)- ----------------------------------------------------------------- Show Parse Errors------------------------------------------------------------ -instance Show ParseError where- show err- = show (errorPos err) ++ ":" ++ - showErrorMessages "or" "unknown parse error" - "expecting" "unexpected" "end of input"- (errorMessages err)----- | Language independent show function-showErrorMessages ::- String -> String -> String -> String -> String -> [Message] -> String-showErrorMessages msgOr msgUnknown msgExpecting msgUnExpected msgEndOfInput msgs- | null msgs = msgUnknown- | otherwise = concat $ map ("\n"++) $ clean $- [showSysUnExpect,showUnExpect,showExpect,showMessages]- where- (sysUnExpect,msgs1) = span (messageEq (SysUnExpect "")) msgs- (unExpect,msgs2) = span (messageEq (UnExpect "")) msgs1- (expect,messages) = span (messageEq (Expect "")) msgs2- - showExpect = showMany msgExpecting expect- showUnExpect = showMany msgUnExpected unExpect- showSysUnExpect | not (null unExpect) ||- null sysUnExpect = ""- | null firstMsg = msgUnExpected ++ " " ++ msgEndOfInput- | otherwise = msgUnExpected ++ " " ++ firstMsg- where- firstMsg = messageString (head sysUnExpect)- - showMessages = showMany "" messages-- - --helpers - showMany pre msgs = case (clean (map messageString msgs)) of- [] -> ""- ms | null pre -> commasOr ms- | otherwise -> pre ++ " " ++ commasOr ms- - commasOr [] = "" - commasOr [m] = m - commasOr ms = commaSep (init ms) ++ " " ++ msgOr ++ " " ++ last ms- - commaSep = seperate ", " . clean- semiSep = seperate "; " . clean - - seperate sep [] = ""- seperate sep [m] = m- seperate sep (m:ms) = m ++ sep ++ seperate sep ms - - clean = nub . filter (not.null) -
− Text/ParserCombinators/Parsec/Expr.hs
@@ -1,123 +0,0 @@--------------------------------------------------------------------------------- |--- Module : Text.ParserCombinators.Parsec.Expr--- Copyright : (c) Daan Leijen 1999-2001--- License : BSD-style (see the file libraries/parsec/LICENSE)--- --- Maintainer : daan@cs.uu.nl--- Stability : provisional--- Portability : portable------ A helper module to parse \"expressions\".--- Builds a parser given a table of operators and associativities.--- --------------------------------------------------------------------------------module Text.ParserCombinators.Parsec.Expr- ( Assoc(..), Operator(..), OperatorTable- , buildExpressionParser- ) where--import Text.ParserCombinators.Parsec.Prim-import Text.ParserCombinators.Parsec.Combinator----------------------------------------------------------------- Assoc and OperatorTable-------------------------------------------------------------data Assoc = AssocNone - | AssocLeft- | AssocRight- -data Operator t st a = Infix (GenParser t st (a -> a -> a)) Assoc- | Prefix (GenParser t st (a -> a))- | Postfix (GenParser t st (a -> a))--type OperatorTable t st a = [[Operator t st a]]------------------------------------------------------------------ Convert an OperatorTable and basic term parser into--- a full fledged expression parser-------------------------------------------------------------buildExpressionParser :: OperatorTable tok st a -> GenParser tok st a -> GenParser tok st a-buildExpressionParser operators simpleExpr- = foldl (makeParser) simpleExpr operators- where- makeParser term ops- = let (rassoc,lassoc,nassoc- ,prefix,postfix) = foldr splitOp ([],[],[],[],[]) ops- - rassocOp = choice rassoc- lassocOp = choice lassoc- nassocOp = choice nassoc- prefixOp = choice prefix <?> ""- postfixOp = choice postfix <?> ""- - ambigious assoc op= try $- do{ op; fail ("ambiguous use of a " ++ assoc - ++ " associative operator")- }- - ambigiousRight = ambigious "right" rassocOp- ambigiousLeft = ambigious "left" lassocOp- ambigiousNon = ambigious "non" nassocOp - - termP = do{ pre <- prefixP- ; x <- term - ; post <- postfixP- ; return (post (pre x))- }- - postfixP = postfixOp <|> return id- - prefixP = prefixOp <|> return id- - rassocP x = do{ f <- rassocOp- ; y <- do{ z <- termP; rassocP1 z }- ; return (f x y)- }- <|> ambigiousLeft- <|> ambigiousNon- -- <|> return x- - rassocP1 x = rassocP x <|> return x - - lassocP x = do{ f <- lassocOp- ; y <- termP- ; lassocP1 (f x y)- }- <|> ambigiousRight- <|> ambigiousNon- -- <|> return x- - lassocP1 x = lassocP x <|> return x - - nassocP x = do{ f <- nassocOp- ; y <- termP- ; ambigiousRight- <|> ambigiousLeft- <|> ambigiousNon- <|> return (f x y)- } - -- <|> return x - - in do{ x <- termP- ; rassocP x <|> lassocP x <|> nassocP x <|> return x- <?> "operator"- }- -- splitOp (Infix op assoc) (rassoc,lassoc,nassoc,prefix,postfix)- = case assoc of- AssocNone -> (rassoc,lassoc,op:nassoc,prefix,postfix)- AssocLeft -> (rassoc,op:lassoc,nassoc,prefix,postfix)- AssocRight -> (op:rassoc,lassoc,nassoc,prefix,postfix)- - splitOp (Prefix op) (rassoc,lassoc,nassoc,prefix,postfix)- = (rassoc,lassoc,nassoc,op:prefix,postfix)- - splitOp (Postfix op) (rassoc,lassoc,nassoc,prefix,postfix)- = (rassoc,lassoc,nassoc,prefix,op:postfix)-
− Text/ParserCombinators/Parsec/Language.hs
@@ -1,124 +0,0 @@--------------------------------------------------------------------------------- |--- Module : Text.ParserCombinators.Parsec.Language--- Copyright : (c) Daan Leijen 1999-2001--- License : BSD-style (see the file libraries/parsec/LICENSE)--- --- Maintainer : daan@cs.uu.nl--- Stability : provisional--- Portability : non-portable (uses non-portable module Text.ParserCombinators.Parsec.Token)------ A helper module that defines some language definitions that can be used--- to instantiate a token parser (see "Text.ParserCombinators.Parsec.Token").--- --------------------------------------------------------------------------------module Text.ParserCombinators.Parsec.Language- ( haskellDef, haskell- , mondrianDef, mondrian- - , emptyDef- , haskellStyle- , javaStyle - , LanguageDef (..) - ) where-import Text.ParserCombinators.Parsec-import Text.ParserCombinators.Parsec.Token -- --------------------------------------------------------------- Styles: haskellStyle, javaStyle------------------------------------------------------------ -haskellStyle :: LanguageDef st-haskellStyle= emptyDef - { commentStart = "{-"- , commentEnd = "-}"- , commentLine = "--"- , nestedComments = True- , identStart = letter- , identLetter = alphaNum <|> oneOf "_'"- , opStart = opLetter haskellStyle- , opLetter = oneOf ":!#$%&*+./<=>?@\\^|-~" - , reservedOpNames= []- , reservedNames = []- , caseSensitive = True - } - -javaStyle :: LanguageDef st-javaStyle = emptyDef- { commentStart = "/*"- , commentEnd = "*/"- , commentLine = "//"- , nestedComments = True- , identStart = letter- , identLetter = alphaNum <|> oneOf "_'" - , reservedNames = []- , reservedOpNames= [] - , caseSensitive = False - }---------------------------------------------------------------- minimal language definition------------------------------------------------------------ -emptyDef :: LanguageDef st-emptyDef = LanguageDef - { commentStart = ""- , commentEnd = ""- , commentLine = ""- , nestedComments = True- , identStart = letter <|> char '_'- , identLetter = alphaNum <|> oneOf "_'"- , opStart = opLetter emptyDef- , opLetter = oneOf ":!#$%&*+./<=>?@\\^|-~"- , reservedOpNames= []- , reservedNames = []- , caseSensitive = True- }- ----------------------------------------------------------------- Haskell------------------------------------------------------------ -haskell :: TokenParser st-haskell = makeTokenParser haskellDef--haskellDef :: LanguageDef st-haskellDef = haskell98Def- { identLetter = identLetter haskell98Def <|> char '#'- , reservedNames = reservedNames haskell98Def ++ - ["foreign","import","export","primitive"- ,"_ccall_","_casm_"- ,"forall"- ]- }- -haskell98Def :: LanguageDef st-haskell98Def = haskellStyle- { reservedOpNames= ["::","..","=","\\","|","<-","->","@","~","=>"]- , reservedNames = ["let","in","case","of","if","then","else",- "data","type",- "class","default","deriving","do","import",- "infix","infixl","infixr","instance","module",- "newtype","where",- "primitive"- -- "as","qualified","hiding"- ]- } - - --------------------------------------------------------------- Mondrian------------------------------------------------------------ -mondrian :: TokenParser st-mondrian = makeTokenParser mondrianDef--mondrianDef :: LanguageDef st-mondrianDef = javaStyle- { reservedNames = [ "case", "class", "default", "extends"- , "import", "in", "let", "new", "of", "package"- ] - , caseSensitive = True - }--
− Text/ParserCombinators/Parsec/Perm.hs
@@ -1,122 +0,0 @@--------------------------------------------------------------------------------- |--- Module : Text.ParserCombinators.Parsec.Perm--- Copyright : (c) Daan Leijen 1999-2001--- License : BSD-style (see the file libraries/parsec/LICENSE)--- --- Maintainer : daan@cs.uu.nl--- 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.--- --------------------------------------------------------------------------------module Text.ParserCombinators.Parsec.Perm- ( PermParser -- abstract-- , permute- , (<||>), (<$$>)- , (<|?>), (<$?>)- ) where--import Text.ParserCombinators.Parsec--{--------------------------------------------------------------------------------------------------------------------------------}-infixl 1 <||>, <|?>-infixl 2 <$$>, <$?>---{---------------------------------------------------------------- test -- parse a permutation of - * an optional string of 'a's- * a required 'b'- * an optional 'c'----------------------------------------------------------------}-test input- = parse (do{ x <- ptest; eof; return x }) "" input--ptest :: Parser (String,Char,Char)-ptest - = permute $- (,,) <$?> ("",many1 (char 'a'))- <||> char 'b' - <|?> ('_',char 'c')---{---------------------------------------------------------------- Building a permutation parser----------------------------------------------------------------}-(<||>) :: PermParser tok st (a -> b) -> GenParser tok st a -> PermParser tok st b-(<||>) perm p = add perm p --(<$$>) :: (a -> b) -> GenParser tok st a -> PermParser tok st b-(<$$>) f p = newperm f <||> p--(<|?>) :: PermParser tok st (a -> b) -> (a, GenParser tok st a) -> PermParser tok st b-(<|?>) perm (x,p) = addopt perm x p--(<$?>) :: (a -> b) -> (a, GenParser tok st a) -> PermParser tok st b-(<$?>) f (x,p) = newperm f <|?> (x,p)----{---------------------------------------------------------------- The permutation tree----------------------------------------------------------------}-data PermParser tok st a = Perm (Maybe a) [Branch tok st a]-data Branch tok st a = forall b. Branch (PermParser tok st (b -> a)) (GenParser tok st b)----- transform a permutation tree into a normal parser-permute :: PermParser tok st a -> GenParser tok st a-permute (Perm def xs)- = choice (map branch xs ++ empty)- where- empty- = case def of- Nothing -> []- Just x -> [return x]-- branch (Branch perm p)- = do{ x <- p- ; f <- permute perm- ; return (f x)- }---- build permutation trees-newperm :: (a -> b) -> PermParser tok st (a -> b)-newperm f- = Perm (Just f) []--add :: PermParser tok st (a -> b) -> GenParser tok st a -> PermParser tok st b-add perm@(Perm mf fs) p- = Perm Nothing (first:map insert fs)- where- first = Branch perm p- insert (Branch perm' p')- = Branch (add (mapPerms flip perm') p) p'--addopt :: PermParser tok st (a -> b) -> a -> GenParser tok st a -> PermParser tok st b-addopt perm@(Perm mf fs) x p- = Perm (fmap ($ x) mf) (first:map insert fs)- where- first = Branch perm p- insert (Branch perm' p')- = Branch (addopt (mapPerms flip perm') x p) p'---mapPerms :: (a -> b) -> PermParser tok st a -> PermParser tok st b-mapPerms f (Perm x xs)- = Perm (fmap f x) (map (mapBranch f) xs)- where- mapBranch f (Branch perm p)- = Branch (mapPerms (f.) perm) p
− Text/ParserCombinators/Parsec/Pos.hs
@@ -1,99 +0,0 @@--------------------------------------------------------------------------------- |--- Module : Text.ParserCombinators.Parsec.Pos--- Copyright : (c) Daan Leijen 1999-2001--- License : BSD-style (see the file libraries/parsec/LICENSE)--- --- Maintainer : daan@cs.uu.nl--- Stability : provisional--- Portability : portable------ Textual source positions.--- --------------------------------------------------------------------------------module Text.ParserCombinators.Parsec.Pos- ( SourceName, Line, Column - , SourcePos- , sourceLine, sourceColumn, sourceName- , incSourceLine, incSourceColumn- , setSourceLine, setSourceColumn, setSourceName- , newPos, initialPos- , updatePosChar, updatePosString- ) where---------------------------------------------------------------- Source Positions, a file name, a line and a column.--- upper left is (1,1)------------------------------------------------------------ -type SourceName = String-type Line = Int-type Column = Int--data SourcePos = SourcePos SourceName !Line !Column- deriving (Eq,Ord)- --newPos :: SourceName -> Line -> Column -> SourcePos-newPos sourceName line column- = SourcePos sourceName line column--initialPos :: SourceName -> SourcePos-initialPos sourceName- = newPos sourceName 1 1--sourceName :: SourcePos -> SourceName-sourceName (SourcePos name line column) = name --sourceLine :: SourcePos -> Line-sourceLine (SourcePos name line column) = line--sourceColumn :: SourcePos -> Column-sourceColumn (SourcePos name line column) = column--incSourceLine :: SourcePos -> Line -> SourcePos-incSourceLine (SourcePos name line column) n = SourcePos name (line+n) column--incSourceColumn :: SourcePos -> Column -> SourcePos-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--setSourceLine :: SourcePos -> Line -> SourcePos-setSourceLine (SourcePos name line column) n = SourcePos name n column--setSourceColumn :: SourcePos -> Column -> SourcePos-setSourceColumn (SourcePos name line column) n = SourcePos name line n---------------------------------------------------------------- Update source positions on characters-------------------------------------------------------------updatePosString :: SourcePos -> String -> SourcePos-updatePosString pos string- = forcePos (foldl updatePosChar pos string)--updatePosChar :: SourcePos -> Char -> SourcePos-updatePosChar pos@(SourcePos name line column) c - = forcePos $- case c of- '\n' -> SourcePos name (line+1) 1- '\t' -> SourcePos name line (column + 8 - ((column-1) `mod` 8))- _ -> SourcePos name line (column + 1)- --forcePos :: SourcePos -> SourcePos -forcePos pos@(SourcePos name line column)- = seq line (seq column (pos))---------------------------------------------------------------- Show positions ------------------------------------------------------------ -instance Show SourcePos where- show (SourcePos name line column)- | null name = showLineColumn- | otherwise = "\"" ++ name ++ "\" " ++ showLineColumn- where- showLineColumn = "(line " ++ show line ++- ", column " ++ show column ++- ")"
− Text/ParserCombinators/Parsec/Prim.hs
@@ -1,456 +0,0 @@--------------------------------------------------------------------------------- |--- Module : Text.ParserCombinators.Parsec.Prim--- Copyright : (c) Daan Leijen 1999-2001--- License : BSD-style (see the file libraries/parsec/LICENSE)--- --- Maintainer : daan@cs.uu.nl--- Stability : provisional--- Portability : portable------ The primitive parser combinators.--- --------------------------------------------------------------------------------module Text.ParserCombinators.Parsec.Prim- ( -- operators: label a parser, alternative- (<?>), (<|>)-- -- basic types- , Parser, GenParser- , runParser, parse, parseFromFile, parseTest- - -- primitive parsers:- -- instance Functor Parser : fmap- -- instance Monad Parser : return, >>=, fail- -- instance MonadPlus Parser : mzero (pzero), mplus (<|>)- , token, tokens, tokenPrim, tokenPrimEx- , try, label, labels, unexpected, pzero-- -- primitive because of space behaviour- , many, skipMany- - -- user state manipulation- , getState, setState, updateState-- -- state manipulation- , getPosition, setPosition- , getInput, setInput - , State(..), getParserState, setParserState - ) where--import Prelude-import Text.ParserCombinators.Parsec.Pos-import Text.ParserCombinators.Parsec.Error-import Control.Monad--{-# INLINE parsecMap #-}-{-# INLINE parsecReturn #-}-{-# INLINE parsecBind #-}-{-# INLINE parsecZero #-}-{-# INLINE parsecPlus #-}-{-# INLINE token #-}-{-# INLINE tokenPrim #-}---------------------------------------------------------------- Operators:--- <?> gives a name to a parser (which is used in error messages)--- <|> is the choice operator-------------------------------------------------------------infix 0 <?>-infixr 1 <|>--(<?>) :: GenParser tok st a -> String -> GenParser tok st a-p <?> msg = label p msg--(<|>) :: GenParser tok st a -> GenParser tok st a -> GenParser tok st a-p1 <|> p2 = mplus p1 p2----------------------------------------------------------------- User state combinators-------------------------------------------------------------getState :: GenParser tok st st-getState = do{ state <- getParserState- ; return (stateUser state)- }--setState :: st -> GenParser tok st ()-setState st = do{ updateParserState (\(State input pos _) -> State input pos st)- ; return ()- }--updateState :: (st -> st) -> GenParser tok st ()-updateState f = do{ updateParserState (\(State input pos user) -> State input pos (f user))- ; return ()- }----------------------------------------------------------------- Parser state combinators-------------------------------------------------------------getPosition :: GenParser tok st SourcePos-getPosition = do{ state <- getParserState; return (statePos state) }--getInput :: GenParser tok st [tok]-getInput = do{ state <- getParserState; return (stateInput state) }---setPosition :: SourcePos -> GenParser tok st ()-setPosition pos = do{ updateParserState (\(State input _ user) -> State input pos user)- ; return ()- }- -setInput :: [tok] -> GenParser tok st ()-setInput input = do{ updateParserState (\(State _ pos user) -> State input pos user)- ; return ()- }--getParserState :: GenParser tok st (State tok st)-getParserState = updateParserState id --setParserState :: State tok st -> GenParser tok st (State tok st)-setParserState st = updateParserState (const st)------------------------------------------------------------------- Parser definition.--- GenParser tok st a:--- General parser for tokens of type "tok", --- a user state "st" and a result type "a"-------------------------------------------------------------type Parser a = GenParser Char () a--newtype GenParser tok st a = Parser (State tok st -> Consumed (Reply tok st a))-runP (Parser p) = p--data Consumed a = Consumed a --input is consumed- | Empty !a --no input is consumed- -data Reply tok st a = Ok !a !(State tok st) ParseError --parsing succeeded with "a"- | Error ParseError --parsing failed--data State tok st = State { stateInput :: [tok]- , statePos :: !SourcePos- , stateUser :: !st- }----------------------------------------------------------------- run a parser-------------------------------------------------------------parseFromFile :: Parser a -> SourceName -> IO (Either ParseError a)-parseFromFile p fname- = do{ input <- readFile fname- ; return (parse p fname input)- }--parseTest :: Show a => GenParser tok () a -> [tok] -> IO ()-parseTest p input- = case (runParser p () "" input) of- Left err -> do{ putStr "parse error at "- ; print err- }- Right x -> print x---parse :: GenParser tok () a -> SourceName -> [tok] -> Either ParseError a-parse p name input- = runParser p () name input---runParser :: GenParser tok st a -> st -> SourceName -> [tok] -> Either ParseError a-runParser p st name input- = case parserReply (runP p (State input (initialPos name) st)) of- Ok x _ _ -> Right x- Error err -> Left err--parserReply result - = case result of- Consumed reply -> reply- Empty reply -> reply----------------------------------------------------------------- Functor: fmap-------------------------------------------------------------instance Functor (GenParser tok st) where- fmap f p = parsecMap f p--parsecMap :: (a -> b) -> GenParser tok st a -> GenParser tok st b-parsecMap f (Parser p)- = Parser (\state -> - case (p state) of- Consumed reply -> Consumed (mapReply reply)- Empty reply -> Empty (mapReply reply)- )- where- mapReply reply- = case reply of- Ok x state err -> let fx = f x - in seq fx (Ok fx state err)- Error err -> Error err- ---------------------------------------------------------------- Monad: return, sequence (>>=) and fail------------------------------------------------------------ -instance Monad (GenParser tok st) where- return x = parsecReturn x - p >>= f = parsecBind p f- fail msg = parsecFail msg--parsecReturn :: a -> GenParser tok st a-parsecReturn x- = Parser (\state -> Empty (Ok x state (unknownError state))) --parsecBind :: GenParser tok st a -> (a -> GenParser tok st b) -> GenParser tok st b-parsecBind (Parser p) f- = Parser (\state ->- case (p state) of - Consumed reply1 - -> Consumed $- case (reply1) of- Ok x state1 err1 -> case runP (f x) state1 of- Empty reply2 -> mergeErrorReply err1 reply2- Consumed reply2 -> reply2- Error err1 -> Error err1-- Empty reply1 - -> case (reply1) of- Ok x state1 err1 -> case runP (f x) state1 of- Empty reply2 -> Empty (mergeErrorReply err1 reply2)- other -> other - Error err1 -> Empty (Error err1)- ) --mergeErrorReply err1 reply- = case reply of- Ok x state err2 -> Ok x state (mergeError err1 err2)- Error err2 -> Error (mergeError err1 err2)---parsecFail :: String -> GenParser tok st a-parsecFail msg- = Parser (\state -> - Empty (Error (newErrorMessage (Message msg) (statePos state))))----------------------------------------------------------------- MonadPlus: alternative (mplus) and mzero-------------------------------------------------------------instance MonadPlus (GenParser tok st) where- mzero = parsecZero- mplus p1 p2 = parsecPlus p1 p2- --pzero :: GenParser tok st a-pzero = parsecZero--parsecZero :: GenParser tok st a-parsecZero- = Parser (\state -> Empty (Error (unknownError state)))--parsecPlus :: GenParser tok st a -> GenParser tok st a -> GenParser tok st a-parsecPlus (Parser p1) (Parser p2)- = Parser (\state ->- case (p1 state) of - Empty (Error err) -> case (p2 state) of- Empty reply -> Empty (mergeErrorReply err reply)- consumed -> consumed- other -> other- )---{- --- variant that favors a consumed reply over an empty one, even it is not the first alternative.- empty@(Empty reply) -> case reply of- Error err ->- case (p2 state) of- Empty reply -> Empty (mergeErrorReply err reply)- consumed -> consumed- ok ->- case (p2 state) of- Empty reply -> empty- consumed -> consumed- consumed -> consumed--}----------------------------------------------------------------- Primitive Parsers: --- try, token(Prim), label, unexpected and updateState-------------------------------------------------------------try :: GenParser tok st a -> GenParser tok st a-try (Parser p)- = Parser (\state@(State input pos user) -> - case (p state) of- Consumed (Error err) -> Empty (Error (setErrorPos pos err))- Consumed ok -> Consumed ok -- was: Empty ok- empty -> empty- )-- -token :: (tok -> String) -> (tok -> SourcePos) -> (tok -> Maybe a) -> GenParser tok st a -token show tokpos test- = tokenPrim show nextpos test- where- nextpos _ _ (tok:toks) = tokpos tok- nextpos _ tok [] = tokpos tok--tokenPrim :: (tok -> String) -> (SourcePos -> tok -> [tok] -> SourcePos) -> (tok -> Maybe a) -> GenParser tok st a-tokenPrim show nextpos test- = tokenPrimEx show nextpos Nothing test---- | The most primitive token recogniser. The expression @tokenPrimEx show nextpos mbnextstate test@,--- recognises tokens when @test@ returns @Just x@ (and returns the value @x@). Tokens are shown in--- error messages using @show@. The position is calculated using @nextpos@, and finally, @mbnextstate@,--- can hold a function that updates the user state on every token recognised (nice to count tokens :-).--- The function is packed into a 'Maybe' type for performance reasons.-tokenPrimEx :: (tok -> String) -> - (SourcePos -> tok -> [tok] -> SourcePos) -> - Maybe (SourcePos -> tok -> [tok] -> st -> st) ->- (tok -> Maybe a) -> - GenParser tok st a-tokenPrimEx show nextpos mbNextState test- = case mbNextState of- Nothing - -> Parser (\state@(State input pos user) -> - case input of- (c:cs) -> case test c of- Just x -> let newpos = nextpos pos c cs- newstate = State cs newpos user- in seq newpos $ seq newstate $ - Consumed (Ok x newstate (newErrorUnknown newpos))- Nothing -> Empty (sysUnExpectError (show c) pos)- [] -> Empty (sysUnExpectError "" pos)- )- Just nextState- -> Parser (\state@(State input pos user) -> - case input of- (c:cs) -> case test c of- Just x -> let newpos = nextpos pos c cs- newuser = nextState pos c cs user- newstate = State cs newpos newuser- in seq newpos $ seq newstate $ - Consumed (Ok x newstate (newErrorUnknown newpos))- Nothing -> Empty (sysUnExpectError (show c) pos)- [] -> Empty (sysUnExpectError "" pos)- )---label :: GenParser tok st a -> String -> GenParser tok st a -label p msg- = labels p [msg]--labels :: GenParser tok st a -> [String] -> GenParser tok st a-labels (Parser p) msgs- = Parser (\state -> - case (p state) of- Empty reply -> Empty $ - case (reply) of- Error err -> Error (setExpectErrors err msgs)- Ok x state1 err | errorIsUnknown err -> reply- | otherwise -> Ok x state1 (setExpectErrors err msgs)- other -> other- )---updateParserState :: (State tok st -> State tok st) -> GenParser tok st (State tok st)-updateParserState f - = Parser (\state -> let newstate = f state- in Empty (Ok state newstate (unknownError newstate)))- - -unexpected :: String -> GenParser tok st a-unexpected msg- = Parser (\state -> Empty (Error (newErrorMessage (UnExpect msg) (statePos state))))- --setExpectErrors err [] = setErrorMessage (Expect "") err-setExpectErrors err [msg] = setErrorMessage (Expect msg) err-setExpectErrors err (msg:msgs) = foldr (\msg err -> addErrorMessage (Expect msg) err) - (setErrorMessage (Expect msg) err) msgs--sysUnExpectError msg pos = Error (newErrorMessage (SysUnExpect msg) pos)-unknownError state = newErrorUnknown (statePos state)---------------------------------------------------------------- Parsers unfolded for space:--- if many and skipMany are not defined as primitives,--- they will overflow the stack on large inputs------------------------------------------------------------ -many :: GenParser tok st a -> GenParser tok st [a]-many p- = do{ xs <- manyAccum (:) p- ; return (reverse xs)- }--skipMany :: GenParser tok st a -> GenParser tok st ()-skipMany p- = do{ manyAccum (\x xs -> []) p- ; return ()- }--manyAccum :: (a -> [a] -> [a]) -> GenParser tok st a -> GenParser tok st [a]-manyAccum accum (Parser p)- = Parser (\state -> - let walk xs state r = case r of- Empty (Error err) -> Ok xs state err- Empty ok -> error "Text.ParserCombinators.Parsec.Prim.many: combinator 'many' is applied to a parser that accepts an empty string."- Consumed (Error err) -> Error err- Consumed (Ok x state' err) -> let ys = accum x xs- in seq ys (walk ys state' (p state'))- in case (p state) of- Empty reply -> case reply of- Ok x state' err -> error "Text.ParserCombinators.Parsec.Prim.many: combinator 'many' is applied to a parser that accepts an empty string."- Error err -> Empty (Ok [] state err)- consumed -> Consumed $ walk [] state consumed)------------------------------------------------------------------ Parsers unfolded for speed: --- tokens------------------------------------------------------------ --{- specification of @tokens@:-tokens showss nextposs s- = scan s- where- scan [] = return s- scan (c:cs) = do{ token show nextpos c <?> shows s; scan cs } -- show c = shows [c]- nextpos pos c = nextposs pos [c]--}--tokens :: Eq tok => ([tok] -> String) -> (SourcePos -> [tok] -> SourcePos) -> [tok] -> GenParser tok st [tok]-tokens shows nextposs s- = Parser (\state@(State input pos user) -> - let- ok cs = let newpos = nextposs pos s- newstate = State cs newpos user- in seq newpos $ seq newstate $ - (Ok s newstate (newErrorUnknown newpos))- - errEof = Error (setErrorMessage (Expect (shows s))- (newErrorMessage (SysUnExpect "") pos))- errExpect c = Error (setErrorMessage (Expect (shows s))- (newErrorMessage (SysUnExpect (shows [c])) pos))-- walk [] cs = ok cs- walk xs [] = errEof- walk (x:xs) (c:cs)| x == c = walk xs cs- | otherwise = errExpect c-- walk1 [] cs = Empty (ok cs)- walk1 xs [] = Empty (errEof)- walk1 (x:xs) (c:cs)| x == c = Consumed (walk xs cs)- | otherwise = Empty (errExpect c)-- in walk1 s input)--
− Text/ParserCombinators/Parsec/Token.hs
@@ -1,473 +0,0 @@--------------------------------------------------------------------------------- |--- Module : Text.ParserCombinators.Parsec.Token--- Copyright : (c) Daan Leijen 1999-2001--- License : BSD-style (see the file libraries/parsec/LICENSE)--- --- Maintainer : daan@cs.uu.nl--- Stability : provisional--- Portability : non-portable (uses existentially quantified data constructors)------ A helper module to parse lexical elements (tokens).--- --------------------------------------------------------------------------------module Text.ParserCombinators.Parsec.Token- ( LanguageDef (..)- , TokenParser (..)- , makeTokenParser- ) where--import Data.Char (isAlpha,toLower,toUpper,isSpace,digitToInt)-import Data.List (nub,sort)-import Text.ParserCombinators.Parsec----------------------------------------------------------------- Language Definition-------------------------------------------------------------data LanguageDef st - = LanguageDef - { commentStart :: String- , commentEnd :: String- , commentLine :: String- , nestedComments :: Bool - , identStart :: CharParser st Char- , identLetter :: CharParser st Char- , opStart :: CharParser st Char- , opLetter :: CharParser st Char- , reservedNames :: [String]- , reservedOpNames:: [String]- , caseSensitive :: Bool- } - --------------------------------------------------------------- A first class module: TokenParser-------------------------------------------------------------data TokenParser st- = TokenParser{ identifier :: CharParser st String- , reserved :: String -> CharParser st ()- , operator :: CharParser st String- , reservedOp :: String -> CharParser st ()- - , charLiteral :: CharParser st Char- , stringLiteral :: CharParser st String- , natural :: CharParser st Integer- , integer :: CharParser st Integer- , float :: CharParser st Double- , naturalOrFloat :: CharParser st (Either Integer Double)- , decimal :: CharParser st Integer- , hexadecimal :: CharParser st Integer- , octal :: CharParser st Integer- - , symbol :: String -> CharParser st String- , lexeme :: forall a. CharParser st a -> CharParser st a- , whiteSpace :: CharParser st () - - , parens :: forall a. CharParser st a -> CharParser st a - , braces :: forall a. CharParser st a -> CharParser st a- , angles :: forall a. CharParser st a -> CharParser st a- , brackets :: forall a. CharParser st a -> CharParser st a- -- "squares" is deprecated- , squares :: forall a. CharParser st a -> CharParser st a -- , semi :: CharParser st String- , comma :: CharParser st String- , colon :: CharParser st String- , dot :: CharParser st String- , semiSep :: forall a . CharParser st a -> CharParser st [a]- , semiSep1 :: forall a . CharParser st a -> CharParser st [a]- , commaSep :: forall a . CharParser st a -> CharParser st [a]- , commaSep1 :: forall a . CharParser st a -> CharParser st [a] - }---------------------------------------------------------------- Given a LanguageDef, create a token parser.-------------------------------------------------------------makeTokenParser :: LanguageDef st -> TokenParser st-makeTokenParser languageDef- = TokenParser{ identifier = identifier- , reserved = reserved- , operator = operator- , reservedOp = reservedOp- - , charLiteral = charLiteral- , stringLiteral = stringLiteral- , natural = natural- , integer = integer- , float = float- , naturalOrFloat = naturalOrFloat- , decimal = decimal- , hexadecimal = hexadecimal- , octal = octal- - , symbol = symbol- , lexeme = lexeme- , whiteSpace = whiteSpace- - , parens = parens- , braces = braces- , angles = angles- , brackets = brackets- , squares = brackets- , semi = semi- , comma = comma- , colon = colon- , dot = dot- , semiSep = semiSep- , semiSep1 = semiSep1- , commaSep = commaSep- , commaSep1 = commaSep1- }- where- - ------------------------------------------------------------ -- Bracketing- ------------------------------------------------------------ parens p = between (symbol "(") (symbol ")") p- braces p = between (symbol "{") (symbol "}") p- angles p = between (symbol "<") (symbol ">") p- brackets p = between (symbol "[") (symbol "]") p-- semi = symbol ";" - comma = symbol ","- dot = symbol "."- colon = symbol ":"-- commaSep p = sepBy p comma- semiSep p = sepBy p semi-- commaSep1 p = sepBy1 p comma- semiSep1 p = sepBy1 p semi--- ------------------------------------------------------------ -- Chars & Strings- ------------------------------------------------------------ -- charLiteral :: CharParser st Char- charLiteral = lexeme (between (char '\'') - (char '\'' <?> "end of character")- characterChar )- <?> "character"-- characterChar = charLetter <|> charEscape - <?> "literal character"-- charEscape = do{ char '\\'; escapeCode }- charLetter = satisfy (\c -> (c /= '\'') && (c /= '\\') && (c > '\026'))---- -- stringLiteral :: CharParser st String- stringLiteral = lexeme (- do{ str <- between (char '"') - (char '"' <?> "end of string")- (many stringChar) - ; return (foldr (maybe id (:)) "" str)- }- <?> "literal string")-- -- stringChar :: CharParser st (Maybe Char)- stringChar = do{ c <- stringLetter; return (Just c) }- <|> stringEscape - <?> "string character"- - stringLetter = satisfy (\c -> (c /= '"') && (c /= '\\') && (c > '\026'))-- stringEscape = do{ char '\\'- ; do{ escapeGap ; return Nothing }- <|> do{ escapeEmpty; return Nothing }- <|> do{ esc <- escapeCode; return (Just esc) }- }- - escapeEmpty = char '&'- escapeGap = do{ many1 space- ; char '\\' <?> "end of string gap"- }- - - - -- escape codes- escapeCode = charEsc <|> charNum <|> charAscii <|> charControl- <?> "escape code"-- -- charControl :: CharParser st Char- charControl = do{ char '^'- ; code <- upper- ; return (toEnum (fromEnum code - fromEnum 'A'))- }-- -- charNum :: CharParser st Char - charNum = do{ code <- decimal - <|> do{ char 'o'; number 8 octDigit }- <|> do{ char 'x'; number 16 hexDigit }- ; return (toEnum (fromInteger code))- }-- charEsc = choice (map parseEsc escMap)- where- parseEsc (c,code) = do{ char c; return code }- - charAscii = choice (map parseAscii asciiMap)- where- parseAscii (asc,code) = try (do{ string asc; return code })--- -- escape code tables- escMap = zip ("abfnrtv\\\"\'") ("\a\b\f\n\r\t\v\\\"\'")- asciiMap = zip (ascii3codes ++ ascii2codes) (ascii3 ++ ascii2) -- ascii2codes = ["BS","HT","LF","VT","FF","CR","SO","SI","EM",- "FS","GS","RS","US","SP"]- ascii3codes = ["NUL","SOH","STX","ETX","EOT","ENQ","ACK","BEL",- "DLE","DC1","DC2","DC3","DC4","NAK","SYN","ETB",- "CAN","SUB","ESC","DEL"]-- ascii2 = ['\BS','\HT','\LF','\VT','\FF','\CR','\SO','\SI',- '\EM','\FS','\GS','\RS','\US','\SP']- ascii3 = ['\NUL','\SOH','\STX','\ETX','\EOT','\ENQ','\ACK',- '\BEL','\DLE','\DC1','\DC2','\DC3','\DC4','\NAK',- '\SYN','\ETB','\CAN','\SUB','\ESC','\DEL']--- ------------------------------------------------------------ -- Numbers- ------------------------------------------------------------ -- naturalOrFloat :: CharParser st (Either Integer Double)- naturalOrFloat = lexeme (natFloat) <?> "number"-- float = lexeme floating <?> "float"- integer = lexeme int <?> "integer"- natural = lexeme nat <?> "natural"--- -- floats- floating = do{ n <- decimal - ; fractExponent n- }--- natFloat = do{ char '0'- ; zeroNumFloat- }- <|> decimalFloat- - zeroNumFloat = do{ n <- hexadecimal <|> octal- ; return (Left n)- }- <|> decimalFloat- <|> fractFloat 0- <|> return (Left 0) - - decimalFloat = do{ n <- decimal- ; option (Left n) - (fractFloat n)- }-- fractFloat n = do{ f <- fractExponent n- ; return (Right f)- }- - fractExponent n = do{ fract <- fraction- ; expo <- option 1.0 exponent'- ; return ((fromInteger n + fract)*expo)- }- <|>- do{ expo <- exponent'- ; return ((fromInteger n)*expo)- }-- fraction = do{ char '.'- ; digits <- many1 digit <?> "fraction"- ; return (foldr op 0.0 digits)- }- <?> "fraction"- where- op d f = (f + fromIntegral (digitToInt d))/10.0- - exponent' = do{ oneOf "eE"- ; f <- sign- ; e <- decimal <?> "exponent"- ; return (power (f e))- }- <?> "exponent"- where- power e | e < 0 = 1.0/power(-e)- | otherwise = fromInteger (10^e)--- -- integers and naturals- int = do{ f <- lexeme sign- ; n <- nat- ; return (f n)- }- - -- sign :: CharParser st (Integer -> Integer)- sign = (char '-' >> return negate) - <|> (char '+' >> return id) - <|> return id-- nat = zeroNumber <|> decimal- - zeroNumber = do{ char '0'- ; hexadecimal <|> octal <|> decimal <|> return 0- }- <?> "" -- decimal = number 10 digit - hexadecimal = do{ oneOf "xX"; number 16 hexDigit }- octal = do{ oneOf "oO"; number 8 octDigit }-- -- number :: Integer -> CharParser st Char -> CharParser st Integer- number base baseDigit- = do{ digits <- many1 baseDigit- ; let n = foldl (\x d -> base*x + toInteger (digitToInt d)) 0 digits- ; seq n (return n)- } -- ------------------------------------------------------------ -- Operators & reserved ops- ------------------------------------------------------------ reservedOp name = - lexeme $ try $- do{ string name- ; notFollowedBy (opLetter languageDef) <?> ("end of " ++ show name)- }-- operator =- lexeme $ try $- do{ name <- oper- ; if (isReservedOp name)- then unexpected ("reserved operator " ++ show name)- else return name- }- - oper =- do{ c <- (opStart languageDef)- ; cs <- many (opLetter languageDef)- ; return (c:cs)- }- <?> "operator"- - isReservedOp name =- isReserved (sort (reservedOpNames languageDef)) name - - - ------------------------------------------------------------ -- Identifiers & Reserved words- ------------------------------------------------------------ reserved name =- lexeme $ try $- do{ caseString name- ; notFollowedBy (identLetter languageDef) <?> ("end of " ++ show name)- }-- caseString name- | caseSensitive languageDef = string name- | otherwise = do{ walk name; return name }- where- walk [] = return ()- walk (c:cs) = do{ caseChar c <?> msg; walk cs }- - caseChar c | isAlpha c = char (toLower c) <|> char (toUpper c)- | otherwise = char c- - msg = show name- -- identifier =- lexeme $ try $- do{ name <- ident- ; if (isReservedName name)- then unexpected ("reserved word " ++ show name)- else return name- }- - - ident - = do{ c <- identStart languageDef- ; cs <- many (identLetter languageDef)- ; return (c:cs)- }- <?> "identifier"-- isReservedName name- = isReserved theReservedNames caseName- where- caseName | caseSensitive languageDef = name- | otherwise = map toLower name-- - isReserved names name - = scan names- where- scan [] = False- scan (r:rs) = case (compare r name) of- LT -> scan rs- EQ -> True- GT -> False-- theReservedNames- | caseSensitive languageDef = sortedNames- | otherwise = map (map toLower) sortedNames- where- sortedNames = sort (reservedNames languageDef)- --- ------------------------------------------------------------ -- White space & symbols- ------------------------------------------------------------ symbol name- = lexeme (string name)-- lexeme p - = do{ x <- p; whiteSpace; return x }- - - --whiteSpace - whiteSpace - | noLine && noMulti = skipMany (simpleSpace <?> "")- | noLine = skipMany (simpleSpace <|> multiLineComment <?> "")- | noMulti = skipMany (simpleSpace <|> oneLineComment <?> "")- | otherwise = skipMany (simpleSpace <|> oneLineComment <|> multiLineComment <?> "")- where- noLine = null (commentLine languageDef)- noMulti = null (commentStart languageDef) - - - simpleSpace =- skipMany1 (satisfy isSpace) - - oneLineComment =- do{ try (string (commentLine languageDef))- ; skipMany (satisfy (/= '\n'))- ; return ()- }-- multiLineComment =- do { try (string (commentStart languageDef))- ; inComment- }-- inComment - | nestedComments languageDef = inCommentMulti- | otherwise = inCommentSingle- - inCommentMulti - = do{ try (string (commentEnd languageDef)) ; return () }- <|> do{ multiLineComment ; inCommentMulti }- <|> do{ skipMany1 (noneOf startEnd) ; inCommentMulti }- <|> do{ oneOf startEnd ; inCommentMulti }- <?> "end of comment" - where- startEnd = nub (commentEnd languageDef ++ commentStart languageDef)-- inCommentSingle- = do{ try (string (commentEnd languageDef)); return () }- <|> do{ skipMany1 (noneOf startEnd) ; inCommentSingle }- <|> do{ oneOf startEnd ; inCommentSingle }- <?> "end of comment"- where- startEnd = nub (commentEnd languageDef ++ commentStart languageDef)-
parsec.cabal view
@@ -1,35 +1,179 @@-cabal-version: >= 1.2-name: parsec-version: 2.1.0.1-license: BSD3-license-file: LICENSE-author: Daan Leijen <daan@cs.uu.nl>-maintainer: Daan Leijen <daan@cs.uu.nl>-homepage: http://www.cs.uu.nl/~daan/parsec.html-category: Parsing-synopsis: Monadic parser combinators+cabal-version: 1.12+name: parsec+version: 3.1.18.0+synopsis: Monadic parser combinators description:- Parsec is designed from scratch as an industrial-strength parser- library. It is simple, safe, well documented (on the package- homepage), has extensive libraries and good error messages,- and is also fast.-build-type: Simple-library {+ Parsec is designed from scratch as an industrial-strength parser+ library. It is simple, safe, well documented (on the package+ homepage), has extensive libraries, good error messages,+ and is fast. It is defined as a monad transformer that can be+ stacked on arbitrary monads, and it is also parametric in the+ input stream type.+ .+ The main entry point is the "Text.Parsec" module which provides+ defaults for parsing 'Char'acter data.+ .+ The "Text.ParserCombinators.Parsec" module hierarchy contains+ the legacy @parsec-2@ API and may be removed at some point in+ the future.++license: BSD2+license-file: LICENSE+author:+ Daan Leijen <daan@microsoft.com>, Paolo Martini <paolo@nemail.it>, Antoine Latter <aslatter@gmail.com>++maintainer:+ Oleg Grenrus <oleg.grenrus@iki.fi>, Herbert Valerio Riedel <hvr@gnu.org>++homepage: https://github.com/haskell/parsec+bug-reports: https://github.com/haskell/parsec/issues+category: Parsing+build-type: Simple+tested-with:+ GHC ==8.6.5+ || ==8.8.4+ || ==8.10.7+ || ==9.0.2+ || ==9.2.8+ || ==9.4.8+ || ==9.6.4+ || ==9.8.2+ || ==9.10.1+ || ==9.12.1++extra-source-files:+ ChangeLog.md+ README.md++source-repository head+ type: git+ location: https://github.com/haskell/parsec++library+ hs-source-dirs: src exposed-modules:- Text.ParserCombinators.Parsec.Error,- Text.ParserCombinators.Parsec.Char,- Text.ParserCombinators.Parsec.Combinator,- Text.ParserCombinators.Parsec.Expr,- Text.ParserCombinators.Parsec.Perm,- Text.ParserCombinators.Parsec.Pos,- Text.ParserCombinators.Parsec.Prim,+ Text.Parsec+ Text.Parsec.ByteString+ Text.Parsec.ByteString.Lazy+ Text.Parsec.Char+ Text.Parsec.Combinator+ Text.Parsec.Error+ Text.Parsec.Expr+ Text.Parsec.Language+ Text.Parsec.Perm+ Text.Parsec.Pos+ Text.Parsec.Prim+ Text.Parsec.String+ Text.Parsec.Text+ Text.Parsec.Text.Lazy+ Text.Parsec.Token Text.ParserCombinators.Parsec- build-depends: base- extensions: ExistentialQuantification- if !impl(nhc98) {- extensions: PolymorphicComponents- exposed-modules:- Text.ParserCombinators.Parsec.Language,- Text.ParserCombinators.Parsec.Token- }-}+ 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++ build-depends:+ base >=4.12.0.0 && <4.22+ , bytestring >=0.10.8.2 && <0.13+ , mtl >=2.2.2 && <2.4+ , text >=1.2.3.0 && <1.3 || >=2.0 && <2.2++ default-language: Haskell2010+ other-extensions:+ CPP+ DeriveDataTypeable+ ExistentialQuantification+ FlexibleContexts+ FlexibleInstances+ FunctionalDependencies+ MultiParamTypeClasses+ PolymorphicComponents+ Safe+ StandaloneDeriving+ Trustworthy+ UndecidableInstances++ ghc-options: -Wall+ ghc-options:+ -Wcompat -Wnoncanonical-monad-instances -Wno-trustworthy-safe++ if impl(ghc <8.8)+ ghc-options: -Wnoncanonical-monadfail-instances++-- these flags may abort compilation with GHC-8.10+-- https://gitlab.haskell.org/ghc/ghc/-/merge_requests/3295+-- https://gitlab.haskell.org/ghc/ghc/-/issues/22728+-- if impl(ghc >= 9.0)+-- -- ghc-options: -Winferred-safe-imports -Wmissing-safe-haskell-mode++test-suite parsec-tests+ type: exitcode-stdio-1.0+ hs-source-dirs: test+ main-is: Main.hs+ other-modules:+ Bugs+ Bugs.Bug2+ Bugs.Bug35+ Bugs.Bug6+ Bugs.Bug9+ Features+ Features.Feature150+ Features.Feature80+ Util++ build-depends:+ base+ , mtl+ , parsec+ , tasty >=1.4 && <1.6+ , tasty-hunit >=0.10 && <0.11++ -- dependencies whose version bounds are not inherited via lib:parsec+ default-language: Haskell2010+ ghc-options: -Wall++ if impl(ghc >=8.0)+ ghc-options:+ -Wcompat -Wnoncanonical-monad-instances+ -Wnoncanonical-monadfail-instances++ else+ build-depends: semigroups++test-suite parsec-issue127+ default-language: Haskell2010+ type: exitcode-stdio-1.0+ main-is: issue127.hs+ hs-source-dirs: test+ build-depends:+ base+ , parsec++test-suite parsec-issue171+ default-language: Haskell2010+ type: exitcode-stdio-1.0+ main-is: issue171.hs+ hs-source-dirs: test+ build-depends:+ base+ , deepseq+ , parsec+ , tasty+ , tasty-hunit++test-suite parsec-issue175+ default-language: Haskell2010+ type: exitcode-stdio-1.0+ main-is: issue175.hs+ hs-source-dirs: test+ build-depends:+ base+ , parsec+ , tasty+ , tasty-hunit
+ src/Text/Parsec.hs view
@@ -0,0 +1,129 @@+{-# LANGUAGE Safe #-}++{-|+Module : Text.Parsec+Copyright : (c) Daan Leijen 1999-2001, (c) Paolo Martini 2007+License : BSD-style (see the LICENSE file)++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+ ParsecT+ , Parsec+ , token+ , tokens+ , runParserT+ , runParser+ , parse+ , parseTest+ , getPosition+ , getInput+ , getState+ , putState+ , modifyState+ -- * Combinators+ , (<|>)+ , (<?>)+ , label+ , labels+ , try+ , unexpected+ , choice+ , many+ , many1+ , skipMany+ , skipMany1+ , count+ , between+ , option+ , optionMaybe+ , optional+ , sepBy+ , sepBy1+ , endBy+ , endBy1+ , sepEndBy+ , sepEndBy1+ , chainl+ , chainl1+ , chainr+ , chainr1+ , eof+ , notFollowedBy+ , manyTill+ , lookAhead+ , anyToken+ -- * Character Parsing+ , module Text.Parsec.Char+ -- * Error messages+ , ParseError+ , errorPos+ -- * Position+ , SourcePos+ , SourceName, Line, Column+ , sourceName, sourceLine, sourceColumn+ , incSourceLine, incSourceColumn+ , setSourceLine, setSourceColumn, setSourceName+ -- * Debugging+ --+ -- | As a more comprehensive alternative for debugging Parsec parsers,+ -- there's also the [parsec-free](http://hackage.haskell.org/package/parsec-free)+ -- package.+ --+ , parserTrace, parserTraced+ -- * Low-level operations+ , manyAccum+ , tokenPrim+ , tokenPrimEx+ , runPT+ , unknownError+ , sysUnExpectError+ , mergeErrorReply+ , getParserState+ , setParserState+ , updateParserState+ , Stream (..)+ , runParsecT+ , mkPT+ , runP+ , Consumed (..)+ , Reply (..)+ , State (..)+ , setPosition+ , setInput+ -- * Other stuff+ , setState+ , updateState+ , parsecMap+ , parserReturn+ , parserBind+ , parserFail+ , parserZero+ , parserPlus+ ) where++import Text.Parsec.Pos+import Text.Parsec.Error+import Text.Parsec.Prim+import Text.Parsec.Char+import Text.Parsec.Combinator
+ src/Text/Parsec/ByteString.hs view
@@ -0,0 +1,42 @@+{-# LANGUAGE Safe #-}++-----------------------------------------------------------------------------+-- |+-- 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+--+-- Convenience definitions for working with 'C.ByteString's.+--+-----------------------------------------------------------------------------++module Text.Parsec.ByteString+ ( Parser, GenParser, parseFromFile+ ) where++import qualified Data.ByteString.Char8 as C++import Text.Parsec.Error+import Text.Parsec.Prim++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 -> FilePath -> IO (Either ParseError a)+parseFromFile p fname+ = do input <- C.readFile fname+ return (runP p () fname input)
+ src/Text/Parsec/ByteString/Lazy.hs view
@@ -0,0 +1,42 @@+{-# LANGUAGE Safe #-}++-----------------------------------------------------------------------------+-- |+-- 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+--+-- Convenience definitions for working with lazy 'C.ByteString's.+--+-----------------------------------------------------------------------------++module Text.Parsec.ByteString.Lazy+ ( Parser, GenParser, parseFromFile+ ) where++import qualified Data.ByteString.Lazy.Char8 as C++import Text.Parsec.Error+import Text.Parsec.Prim++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 -> FilePath -> IO (Either ParseError a)+parseFromFile p fname+ = do input <- C.readFile fname+ return (runP p () fname input)
+ src/Text/Parsec/Char.hs view
@@ -0,0 +1,189 @@+{-# LANGUAGE FlexibleContexts, Safe #-}++-----------------------------------------------------------------------------+-- |+-- 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.+--+-----------------------------------------------------------------------------++module Text.Parsec.Char where++import Data.Char (isSpace, isUpper, isLower, isAlphaNum, isAlpha, isDigit, isHexDigit, isOctDigit)++import Text.Parsec.Pos+import Text.Parsec.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) => [Char] -> ParsecT s u m Char+{-# INLINABLE oneOf #-}+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+{-# INLINABLE noneOf #-}+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 ()+{-# INLINABLE spaces #-}+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+{-# INLINABLE space #-}+space = satisfy isSpace <?> "space"++-- | Parses a newline character (\'\\n\'). Returns a newline character.++newline :: (Stream s m Char) => ParsecT s u m Char+{-# INLINABLE newline #-}+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+{-# INLINABLE crlf #-}+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+{-# INLINABLE endOfLine #-}+endOfLine = newline <|> crlf <?> "new-line"++-- | Parses a tab character (\'\\t\'). Returns a tab character.++tab :: (Stream s m Char) => ParsecT s u m Char+{-# INLINABLE tab #-}+tab = char '\t' <?> "tab"++-- | Parses an upper case letter (according to 'isUpper').+-- Returns the parsed character.++upper :: (Stream s m Char) => ParsecT s u m Char+{-# INLINABLE upper #-}+upper = satisfy isUpper <?> "uppercase letter"++-- | Parses a lower case character (according to 'isLower').+-- Returns the parsed character.++lower :: (Stream s m Char) => ParsecT s u m Char+{-# INLINABLE lower #-}+lower = satisfy isLower <?> "lowercase letter"++-- | Parses a alphabetic or numeric Unicode characters+-- according to 'isAlphaNum'. Returns the parsed character.+--+-- Note that numeric digits outside the ASCII range (such as arabic-indic digits like e.g. \"٤\" or @U+0664@),+-- as well as numeric characters which aren't digits, are parsed by this function+-- but not by 'digit'.++alphaNum :: (Stream s m Char => ParsecT s u m Char)+{-# INLINABLE alphaNum #-}+alphaNum = satisfy isAlphaNum <?> "letter or digit"++-- | Parses an alphabetic Unicode characters (lower-case, upper-case and title-case letters,+-- plus letters of caseless scripts and modifiers letters according to 'isAlpha').+-- Returns the parsed character.++letter :: (Stream s m Char) => ParsecT s u m Char+{-# INLINABLE letter #-}+letter = satisfy isAlpha <?> "letter"++-- | Parses an ASCII digit. Returns the parsed character.++digit :: (Stream s m Char) => ParsecT s u m Char+{-# INLINABLE digit #-}+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+{-# INLINABLE hexDigit #-}+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+{-# INLINABLE octDigit #-}+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+{-# INLINABLE 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+{-# INLINABLE anyChar #-}+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+{-# INLINABLE satisfy #-}+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"+--+-- Consider using 'string''.++string :: (Stream s m Char) => String -> ParsecT s u m String+{-# INLINABLE string #-}+string s = tokens show updatePosString s++-- | @'string'' s@ parses a sequence of characters given by @s@.+-- Doesn't consume matching prefix.+--+-- > carOrCdr = string' "car"+-- > <|> string' "cdr"+--+-- @since 3.1.16.0++string' :: (Stream s m Char) => String -> ParsecT s u m String+{-# INLINABLE string' #-}+string' s = tokens' show updatePosString s
+ src/Text/Parsec/Combinator.hs view
@@ -0,0 +1,344 @@+-- due to Debug.Trace+{-# LANGUAGE Trustworthy #-}++-----------------------------------------------------------------------------+-- |+-- 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.+--+-- See also the [parser-combinators](http://hackage.haskell.org/package/parser-combinators)+-- package for additional (and generalised) 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+ -- * Debugging+ --+ -- | As a more comprehensive alternative for debugging Parsec parsers,+ -- there's also the [parsec-free](http://hackage.haskell.org/package/parsec-free)+ -- package.+ --+ , parserTrace, parserTraced+ ) where++import Control.Monad (mzero, liftM)+import Debug.Trace (trace)++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+{-# INLINABLE choice #-}+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+{-# INLINABLE option #-}+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)+{-# INLINABLE optionMaybe #-}+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 ()+{-# INLINABLE optional #-}+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+{-# INLINABLE between #-}+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 ()+{-# INLINABLE skipMany1 #-}+skipMany1 p = do{ _ <- p; skipMany p }+{-+skipMany p = scan+ where+ scan = do{ p; scan } <|> return ()+-}++-- | @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]+{-# INLINABLE sepBy #-}+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]+{-# INLINABLE sepBy1 #-}+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]+{-# INLINABLE sepEndBy1 #-}+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]+{-# INLINABLE sepEndBy #-}+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]+{-# INLINABLE endBy1 #-}+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]+{-# INLINABLE endBy #-}+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]+{-# INLINABLE count #-}+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+{-# INLINABLE chainr #-}+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+{-# INLINABLE chainl #-}+chainl p op x = chainl1 p op <|> return x++-- | @chainl1 p op@ parses /one/ or more occurrences of @p@,+-- separated by @op@ Returns a value obtained by a /left/ associative+-- application of all functions returned by @op@ to the values returned+-- by @p@. This parser can for example be used to eliminate left+-- recursion which typically occurs in expression grammars.+--+-- > expr = term `chainl1` addop+-- > term = factor `chainl1` mulop+-- > factor = parens expr <|> integer+-- >+-- > mulop = 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+{-# INLINABLE chainl1 #-}+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+{-# INLINABLE chainr1 #-}+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+{-# INLINABLE anyToken #-}+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 ()+{-# INLINABLE eof #-}+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+-- > })+--+-- __NOTE__: Currently, 'notFollowedBy' exhibits surprising behaviour+-- when applied to a parser @p@ that doesn't consume any input;+-- specifically+--+-- - @'notFollowedBy' . 'notFollowedBy'@ is /not/ equivalent to 'lookAhead', and+--+-- - @'notFollowedBy' 'eof'@ /never/ fails.+--+-- See [haskell/parsec#8](https://github.com/haskell/parsec/issues/8)+-- for more details.++notFollowedBy :: (Stream s m t, Show a) => ParsecT s u m a -> ParsecT s u m ()+{-# INLINABLE notFollowedBy #-}+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]+{-# INLINABLE manyTill #-}+manyTill p end = scan+ where+ scan = do{ _ <- end; return [] }+ <|>+ do{ x <- p; xs <- scan; return (x:xs) }++-- | @parserTrace label@ is an impure function, implemented with "Debug.Trace" that+-- prints to the console the remaining parser state at the time it is invoked.+-- It is intended to be used for debugging parsers by inspecting their intermediate states.+--+-- > *> parseTest (oneOf "aeiou" >> parserTrace "label") "atest"+-- > label: "test"+-- > ...+--+-- @since 3.1.12.0+parserTrace :: (Show t, Stream s m t) => String -> ParsecT s u m ()+{-# INLINABLE parserTrace #-}+parserTrace s = pt <|> return ()+ where+ pt = try $ do+ x <- try $ many1 anyToken+ trace (s++": " ++ show x) $ try $ eof+ fail (show x)++-- | @parserTraced label p@ is an impure function, implemented with "Debug.Trace" that+-- prints to the console the remaining parser state at the time it is invoked.+-- It then continues to apply parser @p@, and if @p@ fails will indicate that+-- the label has been backtracked.+-- It is intended to be used for debugging parsers by inspecting their intermediate states.+--+-- > *> parseTest (oneOf "aeiou" >> parserTraced "label" (oneOf "nope")) "atest"+-- > label: "test"+-- > label backtracked+-- > parse error at (line 1, column 2):+-- > ...+--+-- @since 3.1.12.0+parserTraced :: (Stream s m t, Show t) => String -> ParsecT s u m b -> ParsecT s u m b+{-# INLINABLE parserTraced #-}+parserTraced s p = do+ parserTrace s+ p <|> trace (s ++ " backtracked") (fail s)
+ src/Text/Parsec/Error.hs view
@@ -0,0 +1,227 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE Safe #-}++-----------------------------------------------------------------------------+-- |+-- 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+-- Stability : provisional+-- Portability : portable+--+-- Parse errors+--+-----------------------------------------------------------------------------++module Text.Parsec.Error+ ( Message ( SysUnExpect, UnExpect, Expect, Message )+ , messageString+ , ParseError, errorPos, errorMessages, errorIsUnknown+ , showErrorMessages+ , newErrorMessage, newErrorUnknown+ , addErrorMessage, setErrorPos, setErrorMessage+ , mergeError+ ) where++import Control.Exception ( Exception )+import Data.List ( nub, sort )+import Data.Typeable ( Typeable )+import qualified Data.Monoid as Mon++import Text.Parsec.Pos++-- | This abstract data type represents parse error messages. There are+-- four kinds of messages:+--+-- > data Message = SysUnExpect String+-- > | 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+-- languages. Each kind of message is generated by different combinators:+--+-- * A 'SysUnExpect' message is automatically generated by the+-- 'Text.Parsec.Combinator.satisfy' combinator. The argument is the+-- unexpected input.+--+-- * A 'UnExpect' message is generated by the 'Text.Parsec.Prim.unexpected'+-- combinator. The argument describes the+-- unexpected item.+--+-- * A 'Expect' message is generated by the 'Text.Parsec.Prim.<?>'+-- combinator. The argument describes the expected item.+--+-- * A 'Message' message is generated by the 'fail'+-- combinator. The argument is some general parser message.++data Message = SysUnExpect !String -- @ library generated unexpect+ | UnExpect !String -- @ unexpected something+ | Expect !String -- @ expecting something+ | Message !String -- @ raw message+ deriving ( Typeable )++instance Enum Message where+ fromEnum (SysUnExpect _) = 0+ fromEnum (UnExpect _) = 1+ fromEnum (Expect _) = 2+ fromEnum (Message _) = 3+ toEnum _ = error "toEnum is undefined for Message"++-- < Return 'True' only when 'compare' would return 'EQ'.++instance Eq Message where++ m1 == m2 = fromEnum m1 == fromEnum m2++-- < 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++messageString :: Message -> String+messageString (SysUnExpect s) = s+messageString (UnExpect s) = s+messageString (Expect s) = s+messageString (Message s) = s++-- | The abstract data type @ParseError@ represents parse errors. It+-- provides the source position ('SourcePos') of the error+-- and a list of error messages ('Message'). A @ParseError@+-- can be returned by the function 'Text.Parsec.Prim.parse'. @ParseError@ is an+-- instance of the 'Show' and 'Eq' classes.++data ParseError = ParseError !SourcePos [Message]+ deriving ( Typeable )++-- | Extracts the source position from the parse error++errorPos :: ParseError -> SourcePos+errorPos (ParseError pos _msgs)+ = pos++-- | Extracts the list of error messages from the parse error++errorMessages :: ParseError -> [Message]+errorMessages (ParseError _pos msgs)+ = sort msgs++errorIsUnknown :: ParseError -> Bool+errorIsUnknown (ParseError _pos msgs)+ = null msgs++-- < Create parse errors++newErrorUnknown :: SourcePos -> ParseError+newErrorUnknown pos+ = ParseError pos []++newErrorMessage :: Message -> SourcePos -> ParseError+newErrorMessage msg pos+ = ParseError pos [msg]++addErrorMessage :: Message -> ParseError -> ParseError+addErrorMessage msg (ParseError pos msgs)+ = ParseError pos (msg:msgs)++setErrorPos :: SourcePos -> ParseError -> ParseError+setErrorPos pos (ParseError _ msgs)+ = ParseError pos msgs++setErrorMessage :: Message -> ParseError -> ParseError+setErrorMessage msg (ParseError pos msgs)+ = ParseError pos (msg : filter (msg /=) msgs)++mergeError :: ParseError -> ParseError -> ParseError+mergeError e1@(ParseError pos1 msgs1) e2@(ParseError pos2 msgs2)+ -- prefer meaningful errors+ | null msgs2 && not (null msgs1) = e1+ | null msgs1 && not (null msgs2) = e2+ | otherwise+ -- perfectly we'd compare the consumed token count+ -- https://github.com/haskell/parsec/issues/175+ = case compareErrorPos pos1 pos2 of+ -- select the longest match+ EQ -> ParseError pos1 (msgs1 ++ msgs2)+ GT -> e1+ LT -> e2++compareErrorPos :: SourcePos -> SourcePos -> Ordering+compareErrorPos x y = Mon.mappend (compare (sourceLine x) (sourceLine y)) (compare (sourceColumn x) (sourceColumn y))++instance Show ParseError where+ show err+ = show (errorPos err) ++ ":" +++ showErrorMessages "or" "unknown parse error"+ "expecting" "unexpected" "end of input"+ (errorMessages err)++instance Eq ParseError where+ l == r+ = errorPos l == errorPos r && messageStrs l == messageStrs r+ where+ messageStrs = map messageString . errorMessages++-- | @since 3.1.17.0+instance Exception ParseError++-- Language independent show function++-- TODO+-- < The standard function for showing error messages. Formats a list of+-- error messages in English. This function is used in the |Show|+-- instance of |ParseError <#ParseError>|. The resulting string will be+-- formatted like:+--+-- |unexpected /{The first UnExpect or a SysUnExpect message}/;+-- expecting /{comma separated list of Expect messages}/;+-- /{comma separated list of Message messages}/++showErrorMessages ::+ String -> String -> String -> String -> String -> [Message] -> String+showErrorMessages msgOr msgUnknown msgExpecting msgUnExpected msgEndOfInput msgs+ | null msgs = msgUnknown+ | otherwise = concat $ map ("\n"++) $ clean $+ [showSysUnExpect,showUnExpect,showExpect,showMessages]+ where+ (sysUnExpect,msgs1) = span ((SysUnExpect "") ==) msgs+ (unExpect,msgs2) = span ((UnExpect "") ==) msgs1+ (expect,messages) = span ((Expect "") ==) msgs2++ showExpect = showMany msgExpecting expect+ showUnExpect = showMany msgUnExpected unExpect+ showSysUnExpect+ | not (null unExpect) = ""+ | [] <- sysUnExpect = ""+ | msg : _ <- sysUnExpect+ , null (messageString msg) = msgUnExpected ++ " " ++ msgEndOfInput+ | msg : _ <- sysUnExpect = msgUnExpected ++ " " ++ messageString msg++ showMessages = showMany "" messages++ -- helpers+ showMany pre msgs3 = case clean (map messageString msgs3) of+ [] -> ""+ ms | null pre -> commasOr ms+ | otherwise -> pre ++ " " ++ commasOr ms++ commasOr [] = ""+ commasOr [m] = m+ commasOr ms = commaSep (init ms) ++ " " ++ msgOr ++ " " ++ last ms++ commaSep = separate ", " . clean++ separate _ [] = ""+ separate _ [m] = m+ separate sep (m:ms) = m ++ sep ++ separate sep ms++ clean = nub . filter (not . null)
+ src/Text/Parsec/Expr.hs view
@@ -0,0 +1,174 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE Safe #-}++-----------------------------------------------------------------------------+-- |+-- 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+-- 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++import Data.Typeable ( Typeable )++import Text.Parsec.Prim+import Text.Parsec.Combinator++-----------------------------------------------------------+-- Assoc and OperatorTable+-----------------------------------------------------------++-- | This data type specifies the associativity of operators: left, right+-- or none.++data Assoc = AssocNone+ | AssocLeft+ | AssocRight+ deriving ( Typeable )++-- | This data type specifies operators that work on values of type @a@.+-- An operator is either binary infix or unary prefix or postfix. A+-- binary operator has also an associated associativity.++data Operator s u m a = Infix (ParsecT s u m (a -> a -> a)) Assoc+ | Prefix (ParsecT s u m (a -> a))+ | Postfix (ParsecT s u m (a -> a))+ deriving ( Typeable )++-- | An @OperatorTable s u m a@ is a list of @Operator s u m a@+-- lists. The list is ordered in descending+-- precedence. All operators in one list have the same precedence (but+-- may have a different associativity).++type OperatorTable s u m a = [[Operator s u m a]]++-----------------------------------------------------------+-- Convert an OperatorTable and basic term parser into+-- a full fledged expression parser+-----------------------------------------------------------++-- | @buildExpressionParser table term@ builds an expression parser for+-- terms @term@ with operators from @table@, taking the associativity+-- and precedence specified in @table@ into account. Prefix and postfix+-- operators of the same precedence can only occur once (i.e. @--2@ is+-- not allowed if @-@ is prefix negate). Prefix and postfix operators+-- of the same precedence associate to the left (i.e. if @++@ is+-- postfix increment, than @-2++@ equals @-1@, not @-3@).+--+-- The @buildExpressionParser@ takes care of all the complexity+-- involved in building expression parser. Here is an example of an+-- expression parser that handles prefix signs, postfix increment and+-- basic arithmetic.+--+-- > expr = buildExpressionParser table term+-- > <?> "expression"+-- >+-- > term = parens expr+-- > <|> natural+-- > <?> "simple expression"+-- >+-- > table = [ [prefix "-" negate, prefix "+" id ]+-- > , [postfix "++" (+1)]+-- > , [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 })++buildExpressionParser :: (Stream s m t)+ => OperatorTable s u m a+ -> ParsecT s u m a+ -> ParsecT s u m a+{-# INLINABLE buildExpressionParser #-}+buildExpressionParser operators simpleExpr+ = foldl (makeParser) simpleExpr operators+ where+ makeParser term ops+ = let (rassoc,lassoc,nassoc+ ,prefix,postfix) = foldr splitOp ([],[],[],[],[]) ops++ rassocOp = choice rassoc+ lassocOp = choice lassoc+ nassocOp = choice nassoc+ prefixOp = choice prefix <?> ""+ postfixOp = choice postfix <?> ""++ ambiguous assoc op= try $+ do{ _ <- op; fail ("ambiguous use of a " ++ assoc+ ++ " associative operator")+ }++ ambiguousRight = ambiguous "right" rassocOp+ ambiguousLeft = ambiguous "left" lassocOp+ ambiguousNon = ambiguous "non" nassocOp++ termP = do{ pre <- prefixP+ ; x <- term+ ; post <- postfixP+ ; return (post (pre x))+ }++ postfixP = postfixOp <|> return id++ prefixP = prefixOp <|> return id++ rassocP x = do{ f <- rassocOp+ ; y <- do{ z <- termP; rassocP1 z }+ ; return (f x y)+ }+ <|> ambiguousLeft+ <|> ambiguousNon+ -- <|> return x++ rassocP1 x = rassocP x <|> return x++ lassocP x = do{ f <- lassocOp+ ; y <- termP+ ; lassocP1 (f x y)+ }+ <|> ambiguousRight+ <|> ambiguousNon+ -- <|> return x++ lassocP1 x = lassocP x <|> return x++ nassocP x = do{ f <- nassocOp+ ; y <- termP+ ; ambiguousRight+ <|> ambiguousLeft+ <|> ambiguousNon+ <|> return (f x y)+ }+ -- <|> return x++ in do{ x <- termP+ ; rassocP x <|> lassocP x <|> nassocP x <|> return x+ <?> "operator"+ }+++ splitOp (Infix op assoc) (rassoc,lassoc,nassoc,prefix,postfix)+ = case assoc of+ AssocNone -> (rassoc,lassoc,op:nassoc,prefix,postfix)+ AssocLeft -> (rassoc,op:lassoc,nassoc,prefix,postfix)+ AssocRight -> (op:rassoc,lassoc,nassoc,prefix,postfix)++ splitOp (Prefix op) (rassoc,lassoc,nassoc,prefix,postfix)+ = (rassoc,lassoc,nassoc,op:prefix,postfix)++ splitOp (Postfix op) (rassoc,lassoc,nassoc,prefix,postfix)+ = (rassoc,lassoc,nassoc,prefix,op:postfix)
+ src/Text/Parsec/Language.hs view
@@ -0,0 +1,151 @@+{-# LANGUAGE Safe #-}++-----------------------------------------------------------------------------+-- |+-- 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+-- 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+ , emptyDef+ , haskellStyle+ , javaStyle+ , LanguageDef+ , GenLanguageDef+ ) where++import Text.Parsec+import Text.Parsec.Token++-----------------------------------------------------------+-- Styles: haskellStyle, javaStyle+-----------------------------------------------------------++-- | This is a minimal token definition for Haskell style languages. It+-- defines the style of comments, valid identifiers and case+-- sensitivity. It does not define any reserved words or operators.++haskellStyle :: LanguageDef st+haskellStyle = emptyDef+ { commentStart = "{-"+ , commentEnd = "-}"+ , commentLine = "--"+ , nestedComments = True+ , identStart = letter+ , identLetter = alphaNum <|> oneOf "_'"+ , opStart = opLetter haskellStyle+ , opLetter = oneOf ":!#$%&*+./<=>?@\\^|-~"+ , reservedOpNames= []+ , reservedNames = []+ , caseSensitive = True+ }++-- | This is a minimal token definition for Java style languages. It+-- defines the style of comments, valid identifiers and case+-- sensitivity. It does not define any reserved words or operators.++javaStyle :: LanguageDef st+javaStyle = emptyDef+ { commentStart = "/*"+ , commentEnd = "*/"+ , commentLine = "//"+ , nestedComments = True+ , identStart = letter+ , identLetter = alphaNum <|> oneOf "_'"+ , reservedNames = []+ , reservedOpNames= []+ , caseSensitive = False+ }++-----------------------------------------------------------+-- minimal language definition+--------------------------------------------------------++-- | This is the most minimal token definition. It is recommended to use+-- this definition as the basis for other definitions. @emptyDef@ has+-- no reserved names or operators, is case sensitive and doesn't accept+-- comments, identifiers or operators.++emptyDef :: LanguageDef st+emptyDef = LanguageDef+ { commentStart = ""+ , commentEnd = ""+ , commentLine = ""+ , nestedComments = True+ , identStart = letter <|> char '_'+ , identLetter = alphaNum <|> oneOf "_'"+ , opStart = opLetter emptyDef+ , opLetter = oneOf ":!#$%&*+./<=>?@\\^|-~"+ , reservedOpNames= []+ , reservedNames = []+ , caseSensitive = True+ }++++-----------------------------------------------------------+-- Haskell+-----------------------------------------------------------++-- | A lexer for the Haskell language.++haskell :: TokenParser st+haskell = makeTokenParser haskellDef++-- | The language definition for the Haskell language.++haskellDef :: LanguageDef st+haskellDef = haskell98Def+ { identLetter = identLetter haskell98Def <|> char '#'+ , reservedNames = reservedNames haskell98Def +++ ["foreign","import","export","primitive"+ ,"_ccall_","_casm_"+ ,"forall"+ ]+ }++-- | The language definition for the language Haskell98.++haskell98Def :: LanguageDef st+haskell98Def = haskellStyle+ { reservedOpNames= ["::","..","=","\\","|","<-","->","@","~","=>"]+ , reservedNames = ["let","in","case","of","if","then","else",+ "data","type",+ "class","default","deriving","do","import",+ "infix","infixl","infixr","instance","module",+ "newtype","where",+ "primitive"+ -- "as","qualified","hiding"+ ]+ }+++-----------------------------------------------------------+-- Mondrian+-----------------------------------------------------------++-- | A lexer for the Mondrian language.++mondrian :: TokenParser st+mondrian = makeTokenParser mondrianDef++-- | The language definition for the language Mondrian.++mondrianDef :: LanguageDef st+mondrianDef = javaStyle+ { reservedNames = [ "case", "class", "default", "extends"+ , "import", "in", "let", "new", "of", "package"+ ]+ , caseSensitive = True+ }
+ src/Text/Parsec/Perm.hs view
@@ -0,0 +1,194 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE Safe #-}++-----------------------------------------------------------------------------+-- |+-- 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+-- 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.+--+-- From the abstract: +--+-- A permutation phrase is a sequence of elements (possibly of different types) +-- in which each element occurs exactly once and the order is irrelevant. +-- Some of the permutable elements may be optional.+--+-----------------------------------------------------------------------------+++module Text.Parsec.Perm+ ( PermParser+ , StreamPermParser -- abstract++ , permute+ , (<||>), (<$$>)+ , (<|?>), (<$?>)+ ) where++import Control.Monad.Identity ( Identity )+import Data.Typeable ( Typeable )+import Text.Parsec++infixl 1 <||>, <|?>+infixl 2 <$$>, <$?>+++{---------------------------------------------------------------+ test -- parse a permutation of+ * an optional string of 'a's+ * a required 'b'+ * an optional 'c'+---------------------------------------------------------------}+{-+test input+ = parse (do{ x <- ptest; eof; return x }) "" input++ptest :: Parser (String,Char,Char)+ptest+ = permute $+ (,,) <$?> ("",many1 (char 'a'))+ <||> char 'b'+ <|?> ('_',char 'c')+-}++{---------------------------------------------------------------+ Building a permutation parser+---------------------------------------------------------------}++-- | 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@.++(<||>) :: (Stream s Identity tok) => StreamPermParser s st (a -> b) -> Parsec s st a -> StreamPermParser s st b+(<||>) perm p = add perm p++-- | The expression @f \<$$> p@ creates a fresh permutation parser+-- 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 not allowed to accept empty input - use the optional+-- combinator ('<$?>') instead.+--+-- If the function @f@ takes more than one parameter, the type variable+-- @b@ is instantiated to a functional type which combines nicely with+-- the adds parser @p@ to the ('<||>') combinator. This+-- results in stylized code where a permutation parser starts with a+-- combining function @f@ followed by the parsers. The function @f@+-- gets its parameters in the order in which the parsers are specified,+-- but actual input can be in any order.++(<$$>) :: (Stream s Identity tok) => (a -> b) -> Parsec s st a -> StreamPermParser s st b+(<$$>) f p = newperm f <||> p++-- | 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@.++(<|?>) :: (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++-- | The expression @f \<$?> (x,p)@ creates a fresh permutation parser+-- 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.++(<$?>) :: (Stream s Identity tok) => (a -> b) -> (a, Parsec s st a) -> StreamPermParser s st b+(<$?>) f (x,p) = newperm f <|?> (x,p)++{---------------------------------------------------------------+ The permutation tree+---------------------------------------------------------------}++-- | Provided for backwards compatibility. The tok type is ignored.++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+-- @s@ streams with user state @st@ and returns a value of+-- type @a@ on success.+--+-- Normally, a permutation parser is first build with special operators+-- like ('<||>') and than transformed into a normal parser+-- using 'permute'.++data StreamPermParser s st a = Perm (Maybe a) [StreamBranch s st a]+ deriving ( Typeable )++-- type Branch st a = StreamBranch String st a++data StreamBranch s st a = forall b. Branch (StreamPermParser s st (b -> a)) (Parsec s st b)+ deriving ( Typeable )++-- | The parser @permute perm@ parses a permutation of parser described+-- by @perm@. For example, suppose we want to parse a permutation of:+-- an optional string of @a@'s, the character @b@ and an optional @c@.+-- This can be described by:+--+-- > test = permute (tuple <$?> ("",many1 (char 'a'))+-- > <||> char 'b'+-- > <|?> ('_',char 'c'))+-- > where+-- > tuple a b c = (a,b,c)++-- transform a permutation tree into a normal parser+permute :: (Stream s Identity tok) => StreamPermParser s st a -> Parsec s st a+permute (Perm def xs)+ = choice (map branch xs ++ empty)+ where+ empty+ = case def of+ Nothing -> []+ Just x -> [return x]++ branch (Branch perm p)+ = do{ x <- p+ ; f <- permute perm+ ; return (f x)+ }++-- build permutation trees+newperm :: (Stream s Identity tok) => (a -> b) -> StreamPermParser s st (a -> b)+newperm f+ = Perm (Just f) []++add :: (Stream s Identity tok) => StreamPermParser s st (a -> b) -> Parsec s st a -> StreamPermParser s st b+add perm@(Perm _mf fs) p+ = Perm Nothing (first:map insert fs)+ where+ first = Branch perm p+ insert (Branch perm' p')+ = Branch (add (mapPerms flip perm') p) p'++addopt :: (Stream s Identity tok) => StreamPermParser s st (a -> b) -> a -> Parsec s st a -> StreamPermParser s st b+addopt perm@(Perm mf fs) x p+ = Perm (fmap ($ x) mf) (first:map insert fs)+ where+ first = Branch perm p+ insert (Branch perm' p')+ = Branch (addopt (mapPerms flip perm') x p) p'+++mapPerms :: (Stream s Identity tok) => (a -> b) -> StreamPermParser s st a -> StreamPermParser s st b+mapPerms f (Perm x xs)+ = Perm (fmap f x) (map mapBranch xs)+ where+ mapBranch (Branch perm p)+ = Branch (mapPerms (f.) perm) p
+ src/Text/Parsec/Pos.hs view
@@ -0,0 +1,129 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE Safe #-}++-----------------------------------------------------------------------------+-- |+-- 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+-- Stability : provisional+-- Portability : portable+--+-- Textual source positions.+--+-----------------------------------------------------------------------------++module Text.Parsec.Pos+ ( SourceName, Line, Column+ , SourcePos+ , 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)++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.++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++-- | Create a new 'SourcePos' with the given source name,+-- and line number and column number set to 1, the upper left.++initialPos :: SourceName -> SourcePos+initialPos name+ = newPos name 1 1++-- | 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.++sourceLine :: SourcePos -> Line+sourceLine (SourcePos _name line _column) = line++-- | 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.++incSourceLine :: SourcePos -> Line -> SourcePos+incSourceLine (SourcePos name line column) n = SourcePos name (line+n) column++-- | Increments the column number of a source position.++incSourceColumn :: SourcePos -> Column -> SourcePos+incSourceColumn (SourcePos name line column) n = SourcePos name line (column+n)++-- | Set the name of the source.++setSourceName :: SourcePos -> SourceName -> SourcePos+setSourceName (SourcePos _name line column) n = SourcePos n line column++-- | 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.++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@.++updatePosString :: SourcePos -> String -> SourcePos+updatePosString pos string+ = foldl updatePosChar pos string++-- | Update a source position given a character. If the character is a+-- newline (\'\\n\') or carriage return (\'\\r\') the line number is+-- 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.++updatePosChar :: SourcePos -> Char -> SourcePos+updatePosChar (SourcePos name line column) c+ = case c of+ '\n' -> SourcePos name (line+1) 1+ '\t' -> SourcePos name line (column + 8 - ((column-1) `mod` 8))+ _ -> SourcePos name line (column + 1)++instance Show SourcePos where+ show (SourcePos name line column)+ | null name = showLineColumn+ | otherwise = "\"" ++ name ++ "\" " ++ showLineColumn+ where+ showLineColumn = "(line " ++ show line +++ ", column " ++ show column +++ ")"
+ src/Text/Parsec/Prim.hs view
@@ -0,0 +1,912 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE PolymorphicComponents #-}+{-# LANGUAGE Safe #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE UndecidableInstances #-}++{-# OPTIONS_GHC -fno-warn-name-shadowing #-}++-----------------------------------------------------------------------------+-- |+-- 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+-- Stability : provisional+-- Portability : portable+--+-- The primitive parser combinators.+--+-----------------------------------------------------------------------------++{-# OPTIONS_HADDOCK not-home #-}++module Text.Parsec.Prim+ ( unknownError+ , sysUnExpectError+ , unexpected+ , ParsecT+ , runParsecT+ , mkPT+ , Parsec+ , Consumed(..)+ , Reply(..)+ , State(..)+ , parsecMap+ , parserReturn+ , parserBind+ , mergeErrorReply+ , parserFail+ , parserZero+ , parserPlus+ , (<?>)+ , (<|>)+ , label+ , labels+ , lookAhead+ , Stream(..)+ , tokens+ , tokens'+ , try+ , token+ , tokenPrim+ , tokenPrimEx+ , many+ , skipMany+ , manyAccum+ , many1+ , runPT+ , runP+ , runParserT+ , runParser+ , parse+ , parseTest+ , getPosition+ , getInput+ , setPosition+ , setInput+ , getParserState+ , setParserState+ , updateParserState+ , getState+ , putState+ , modifyState+ , setState+ , updateState+ ) where+++import Prelude hiding (sequence)+import qualified Data.ByteString.Lazy.Char8 as CL+import qualified Data.ByteString.Char8 as C++import Data.Typeable ( Typeable )++import qualified Data.Text as Text+import qualified Data.Text.Lazy as TextL++-- To define Monoid instance+import qualified Data.List.NonEmpty as NE+import Data.List ( genericReplicate )+import Data.Traversable (sequence)+import qualified Data.Functor as Functor ( Functor(..) )+import qualified Data.Semigroup as Semigroup ( Semigroup(..) )+import qualified Data.Monoid as Monoid ( Monoid(..) )++import qualified Control.Applicative as Applicative ( Applicative(..), Alternative(..), liftA2 )+import Control.Monad (MonadPlus (..), ap, void, liftM)+import Control.Monad.Trans (MonadTrans (lift), MonadIO (liftIO))+import Control.Monad.Identity (Identity, runIdentity)+import qualified Control.Monad.Fail as Fail++import Control.Monad.Reader.Class (MonadReader (..))+import Control.Monad.State.Class (MonadState (..))+import Control.Monad.Cont.Class (MonadCont (..))+import Control.Monad.Error.Class (MonadError (..))++import Text.Parsec.Pos+import Text.Parsec.Error++unknownError :: State s u -> ParseError+unknownError state = newErrorUnknown (statePos state)++sysUnExpectError :: String -> SourcePos -> Reply s u a+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'.++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++-- | @ParsecT s u m a@ is a parser with stream type @s@, user state type @u@,+-- underlying monad @m@ and return type @a@. Parsec is strict in the user state.+-- If this is undesirable, simply use a data type like @data Box a = Box a@ and+-- the state type @Box YourStateType@ to add a level of indirection.++newtype ParsecT s u m a+ = ParsecT {unParser :: forall b .+ State s u+ -> (a -> State s u -> ParseError -> m b) -- consumed ok+ -> (ParseError -> m b) -- consumed err+ -> (a -> State s u -> ParseError -> m b) -- empty ok+ -> (ParseError -> m b) -- empty err+ -> m b+ }+ deriving ( Typeable )++-- | Low-level unpacking of the ParsecT type. To run your parser, please look to+-- runPT, runP, runParserT, runParser and other such functions.+runParsecT :: Monad m => ParsecT s u m a -> State s u -> m (Consumed (m (Reply s u a)))+{-# INLINABLE runParsecT #-}+runParsecT p s = unParser p s cok cerr eok eerr+ where cok a s' err = return . Consumed . return $ Ok a s' err+ cerr err = return . Consumed . return $ Error err+ eok a s' err = return . Empty . return $ Ok a s' err+ eerr err = return . Empty . return $ Error err++-- | Low-level creation of the ParsecT type. You really shouldn't have to do this.+mkPT :: Monad m => (State s u -> m (Consumed (m (Reply s u a)))) -> ParsecT s u m a+{-# INLINABLE mkPT #-}+mkPT k = ParsecT $ \s cok cerr eok eerr -> do+ cons <- k s+ case cons of+ Consumed mrep -> do+ rep <- mrep+ case rep of+ Ok x s' err -> cok x s' err+ Error err -> cerr err+ Empty mrep -> do+ rep <- mrep+ case rep of+ Ok x s' err -> eok x s' err+ Error err -> eerr err++type Parsec s u = ParsecT s u Identity++data Consumed a = Consumed a+ | Empty !a+ deriving ( Typeable )++data Reply s u a = Ok a !(State s u) ParseError+ | Error ParseError+ deriving ( Typeable )++data State s u = State {+ stateInput :: s,+ statePos :: !SourcePos,+ stateUser :: !u+ }+ deriving ( Typeable )++-- | The 'Semigroup' instance for 'ParsecT' is used to append the result+-- of several parsers, for example:+--+-- @+-- (many $ char 'a') <> (many $ char 'b')+-- @+--+-- The above will parse a string like @"aabbb"@ and return a successful+-- parse result @"aabbb"@. Compare against the below which will+-- produce a result of @"bbb"@ for the same input:+--+-- @+-- (many $ char 'a') >> (many $ char 'b')+-- (many $ char 'a') *> (many $ char 'b')+-- @+--+-- @since 3.1.12+instance Semigroup.Semigroup a => Semigroup.Semigroup (ParsecT s u m a) where+ -- | Combines two parsers like '*>', '>>' and @do {...;...}@+ -- /but/ also combines their results with (<>) instead of+ -- discarding the first.+ (<>) = Applicative.liftA2 (Semigroup.<>)++ sconcat = fmap Semigroup.sconcat . sequence+ stimes b = Semigroup.sconcat . NE.fromList . genericReplicate b++-- | The 'Monoid' instance for 'ParsecT' is used for the same purposes as+-- the 'Semigroup' instance.+--+-- @since 3.1.12+instance ( Monoid.Monoid a+ , Semigroup.Semigroup (ParsecT s u m a)+ ) => Monoid.Monoid (ParsecT s u m a) where+ -- | A parser that always succeeds, consumes no input, and+ -- returns the underlying 'Monoid''s 'mempty' value+ mempty = Applicative.pure Monoid.mempty++ -- | See 'ParsecT''s 'Semigroup.<>' implementation+ mappend = (Semigroup.<>)++ mconcat = Functor.fmap Monoid.mconcat . sequence++instance Functor Consumed where+ fmap f (Consumed x) = Consumed (f x)+ fmap f (Empty x) = Empty (f x)++instance Functor (Reply s u) where+ fmap f (Ok x s e) = Ok (f x) s e+ fmap _ (Error e) = Error e -- XXX++instance Functor (ParsecT s u m) where+ fmap f p = parsecMap f p++parsecMap :: (a -> b) -> ParsecT s u m a -> ParsecT s u m b+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+ pure = parserReturn+ (<*>) = ap -- TODO: Can this be optimized?+ p1 *> p2 = p1 `parserBind` const p2+ p1 <* p2 = do { x1 <- p1 ; void p2 ; return x1 }++instance Applicative.Alternative (ParsecT s u m) where+ empty = mzero+ (<|>) = mplus++ -- TODO: https://github.com/haskell/parsec/issues/179+ -- investigate what's wrong with haddock+ --+ -- many = many+ -- some = many1++instance Monad (ParsecT s u m) where+ return = Applicative.pure+ p >>= f = parserBind p f+ (>>) = (Applicative.*>)+#if !MIN_VERSION_base(4,13,0)+ fail = Fail.fail+#endif++-- | @since 3.1.12.0+instance Fail.MonadFail (ParsecT s u m) where+ fail = parserFail++instance (MonadIO m) => MonadIO (ParsecT s u m) where+ liftIO = lift . liftIO++instance (MonadReader r m) => MonadReader r (ParsecT s u m) where+ ask = lift ask+ local f p = mkPT $ \s -> local f (runParsecT p s)++-- I'm presuming the user might want a separate, non-backtracking+-- state aside from the Parsec user state.+instance (MonadState s m) => MonadState s (ParsecT s' u m) where+ get = lift get+ put = lift . put++instance (MonadCont m) => MonadCont (ParsecT s u m) where+ callCC f = mkPT $ \s ->+ callCC $ \c ->+ runParsecT (f (\a -> mkPT $ \s' -> c (pack s' a))) s++ where pack s a= Empty $ return (Ok a s (unknownError s))++instance (MonadError e m) => MonadError e (ParsecT s u m) where+ throwError = lift . throwError+ p `catchError` h = mkPT $ \s ->+ runParsecT p s `catchError` \e ->+ runParsecT (h e) s++parserReturn :: a -> ParsecT s u m a+parserReturn x+ = ParsecT $ \s _ _ eok _ ->+ eok x s (unknownError s)++parserBind :: ParsecT s u m a -> (a -> ParsecT s u m b) -> ParsecT s u m b+{-# INLINE parserBind #-}+parserBind m k+ = ParsecT $ \s cok cerr eok eerr ->+ let+ -- consumed-okay case for m+ mcok x s err+ | errorIsUnknown err = unParser (k x) s cok cerr cok cerr+ | otherwise =+ let+ -- if (k x) consumes, those go straight 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')++ -- if (k x) doesn't consume input, but errors,+ -- we return the error in the 'consumed-error'+ -- continuation+ peerr err' = cerr (mergeError err err')+ in unParser (k x) s pcok pcerr peok peerr++ -- empty-ok case for m+ meok x s err+ | errorIsUnknown err = unParser (k x) s cok cerr eok eerr+ | otherwise =+ let+ -- in these cases, (k x) can return as empty+ pcok = cok+ peok x s err' = eok x s (mergeError err err')+ pcerr = cerr+ peerr err' = eerr (mergeError err err')+ in unParser (k x) s pcok pcerr peok peerr+ -- consumed-error case for m+ mcerr = cerr++ -- empty-error case for m+ meerr = eerr++ in unParser m s mcok mcerr meok meerr+++mergeErrorReply :: ParseError -> Reply s u a -> Reply s u a+mergeErrorReply err1 reply -- XXX where to put it?+ = case reply of+ Ok x state err2 -> Ok x state (mergeError err1 err2)+ Error err2 -> Error (mergeError err1 err2)++parserFail :: String -> ParsecT s u m a+parserFail msg+ = ParsecT $ \s _ _ _ eerr ->+ eerr $ newErrorMessage (Message msg) (statePos s)++instance MonadPlus (ParsecT s u m) where+ mzero = parserZero+ 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+-- of the 'Control.Applicative.Alternative' class.++parserZero :: ParsecT s u m a+parserZero+ = ParsecT $ \s _ _ _ eerr ->+ eerr $ unknownError s++parserPlus :: ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a+{-# INLINE parserPlus #-}+parserPlus m n+ = ParsecT $ \s cok cerr eok eerr ->+ let+ meerr err =+ let+ neok y s' err' = eok y s' (mergeError err err')+ neerr err' = eerr $ mergeError err err'+ in unParser n s cok cerr neok neerr+ in unParser m s cok cerr eok meerr++instance MonadTrans (ParsecT s u) where+ lift amb = ParsecT $ \s _ _ eok _ -> do+ a <- amb+ eok a s $ unknownError s++infix 0 <?>+infixr 1 <|>++-- | The parser @p \<?> msg@ behaves as parser @p@, but whenever the+-- parser @p@ fails /without consuming any input/, it replaces expect+-- error messages with the expect error message @msg@.+--+-- This is normally used at the end of a set alternatives where we want+-- to return an error message in terms of a higher level construct+-- rather than returning all possible characters. For example, if the+-- @expr@ parser from the 'try' example would fail, the error+-- message is: '...: expecting expression'. Without the @(\<?>)@+-- combinator, the message would be like '...: expecting \"let\" or+-- letter', which is less friendly.++(<?>) :: (ParsecT s u m a) -> String -> (ParsecT s u m a)+p <?> msg = label p msg++-- | This combinator implements choice. The parser @p \<|> q@ first+-- applies @p@. If it succeeds, the value of @p@ is returned. If @p@+-- fails /without consuming any input/, parser @q@ is tried. This+-- combinator is defined equal to the 'mplus' member of the 'MonadPlus'+-- class and the ('Control.Applicative.<|>') member of 'Control.Applicative.Alternative'.+--+-- The parser is called /predictive/ since @q@ is only tried when+-- parser @p@ didn't consume any input (i.e.. the look ahead is 1).+-- This non-backtracking behaviour allows for both an efficient+-- implementation of the parser combinators and the generation of good+-- error messages.++(<|>) :: (ParsecT s u m a) -> (ParsecT s u m a) -> (ParsecT s u m a)+p1 <|> p2 = mplus p1 p2++-- | A synonym for @\<?>@, but as a function instead of an operator.+label :: ParsecT s u m a -> String -> ParsecT s u m a+label p msg+ = labels p [msg]++labels :: ParsecT s u m a -> [String] -> ParsecT s u m a+labels p msgs =+ ParsecT $ \s cok cerr eok eerr ->+ let eok' x s' error = eok x s' $ if errorIsUnknown error+ then error+ else setExpectErrors error msgs+ eerr' err = eerr $ setExpectErrors err msgs++ in unParser p s cok cerr eok' eerr'++ where+ setExpectErrors err [] = setErrorMessage (Expect "") err+ setExpectErrors err [msg] = setErrorMessage (Expect msg) err+ setExpectErrors err (msg:msgs)+ = foldr (\msg' err' -> addErrorMessage (Expect msg') err')+ (setErrorMessage (Expect msg) err) 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+--+-- * A @Stream@ instance is responsible for maintaining the \"position within the stream\" in the stream state @s@. This is trivial unless you are using the monad in a non-trivial way.++class (Monad m) => Stream s m t | s -> t where+ uncons :: s -> m (Maybe (t,s))++instance (Monad m) => Stream [tok] m tok where+ uncons [] = return $ Nothing+ uncons (t:ts) = return $ Just (t,ts)+ {-# INLINE uncons #-}+++instance (Monad m) => Stream CL.ByteString m Char where+ uncons = return . CL.uncons++instance (Monad m) => Stream C.ByteString m Char where+ uncons = return . C.uncons++instance (Monad m) => Stream Text.Text m Char where+ uncons = return . Text.uncons+ {-# INLINE uncons #-}++instance (Monad m) => Stream TextL.Text m Char where+ uncons = return . TextL.uncons+ {-# INLINE uncons #-}+++tokens :: (Stream s m t, Eq t)+ => ([t] -> String) -- Pretty print a list of tokens+ -> (SourcePos -> [t] -> SourcePos)+ -> [t] -- List of tokens to parse+ -> ParsecT s u m [t]+{-# INLINE tokens #-}+tokens _ _ []+ = ParsecT $ \s _ _ eok _ ->+ eok [] s $ unknownError s+tokens showTokens nextposs tts@(tok:toks)+ = ParsecT $ \(State input pos u) cok cerr _eok eerr ->+ let+ errEof = (setErrorMessage (Expect (showTokens tts))+ (newErrorMessage (SysUnExpect "") pos))++ errExpect x = (setErrorMessage (Expect (showTokens tts))+ (newErrorMessage (SysUnExpect (showTokens [x])) pos))++ walk [] rs = ok rs+ walk (t:ts) rs = do+ sr <- uncons rs+ case sr of+ Nothing -> cerr $ errEof+ Just (x,xs) | t == x -> walk ts xs+ | otherwise -> cerr $ errExpect x++ ok rs = let pos' = nextposs pos tts+ s' = State rs pos' u+ in cok tts s' (newErrorUnknown pos')+ in do+ sr <- uncons input+ case sr of+ Nothing -> eerr $ errEof+ Just (x,xs)+ | tok == x -> walk toks xs+ | otherwise -> eerr $ errExpect x++-- | Like 'tokens', but doesn't consume matching prefix.+--+-- @since 3.1.16.0+tokens' :: (Stream s m t, Eq t)+ => ([t] -> String) -- Pretty print a list of tokens+ -> (SourcePos -> [t] -> SourcePos)+ -> [t] -- List of tokens to parse+ -> ParsecT s u m [t]+{-# INLINE tokens' #-}+tokens' _ _ []+ = ParsecT $ \s _ _ eok _ ->+ eok [] s $ unknownError s+tokens' showTokens nextposs tts@(tok:toks)+ = ParsecT $ \(State input pos u) cok _cerr _eok eerr ->+ let+ errEof = (setErrorMessage (Expect (showTokens tts))+ (newErrorMessage (SysUnExpect "") pos))++ errExpect x = (setErrorMessage (Expect (showTokens tts))+ (newErrorMessage (SysUnExpect (showTokens [x])) pos))++ walk [] rs = ok rs+ walk (t:ts) rs = do+ sr <- uncons rs+ case sr of+ Nothing -> eerr $ errEof+ Just (x,xs) | t == x -> walk ts xs+ | otherwise -> eerr $ errExpect x++ ok rs = let pos' = nextposs pos tts+ s' = State rs pos' u+ in cok tts s' (newErrorUnknown pos')+ in do+ sr <- uncons input+ case sr of+ Nothing -> eerr $ errEof+ 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.+--+-- This combinator is used whenever arbitrary look ahead is needed.+-- Since it pretends that it hasn't consumed any input when @p@ fails,+-- the ('<|>') combinator will try its second alternative even when the+-- first parser failed while consuming input.+--+-- The @try@ combinator can for example be used to distinguish+-- identifiers and reserved words. Both reserved words and identifiers+-- are a sequence of letters. Whenever we expect a certain reserved+-- word where we can also expect an identifier we have to use the @try@+-- combinator. Suppose we write:+--+-- > expr = letExpr <|> identifier <?> "expression"+-- >+-- > letExpr = do{ string "let"; ... }+-- > identifier = many1 letter+--+-- If the user writes \"lexical\", the parser fails with: @unexpected+-- \'x\', expecting \'t\' in \"let\"@. Indeed, since the ('<|>') combinator+-- only tries alternatives when the first alternative hasn't consumed+-- input, the @identifier@ parser is never tried (because the prefix+-- \"le\" of the @string \"let\"@ parser is already consumed). The+-- right behaviour can be obtained by adding the @try@ combinator:+--+-- > expr = letExpr <|> identifier <?> "expression"+-- >+-- > letExpr = do{ try (string "let"); ... }+-- > identifier = many1 letter++try :: ParsecT s u m a -> ParsecT s u m a+try p =+ ParsecT $ \s cok _ eok eerr ->+ unParser p s cok eerr eok eerr++-- | @lookAhead p@ parses @p@ without consuming any input.+--+-- If @p@ fails and consumes some input, so does @lookAhead@. Combine with 'try'+-- if this is undesirable.++lookAhead :: (Stream s m t) => ParsecT s u m a -> ParsecT s u m a+lookAhead p =+ ParsecT $ \s _ cerr eok eerr -> do+ let eok' a _ _ = eok a s (newErrorUnknown (statePos s))+ unParser p s eok' cerr eok' eerr++-- | The parser @token showTok posFromTok testTok@ accepts a token @t@+-- with result @x@ when the function @testTok t@ returns @'Just' x@. The+-- source position of the @t@ should be returned by @posFromTok t@ and+-- the token can be shown using @showTok t@.+--+-- This combinator is expressed in terms of 'tokenPrim'.+-- It is used to accept user defined token streams. For example,+-- suppose that we have a stream of basic tokens tupled with source+-- positions. We can then define a parser that accepts single tokens as:+--+-- > mytoken x+-- > = token showTok posFromTok testTok+-- > where+-- > showTok (pos,t) = show t+-- > posFromTok (pos,t) = pos+-- > testTok (pos,t) = if x == t then Just t else Nothing++token :: (Stream s Identity t)+ => (t -> String) -- ^ Token pretty-printing function.+ -> (t -> SourcePos) -- ^ Computes the position of a token.+ -> (t -> Maybe a) -- ^ Matching function for the token to parse.+ -> Parsec s u a+{-# INLINABLE token #-}+token showToken tokpos test = tokenPrim showToken nextpos test+ where+ nextpos _ tok ts = case runIdentity (uncons ts) of+ Nothing -> tokpos tok+ Just (tok',_) -> tokpos tok'++-- | The parser @tokenPrim showTok nextPos testTok@ accepts a token @t@+-- with result @x@ when the function @testTok t@ returns @'Just' x@. The+-- token can be shown using @showTok t@. The position of the /next/+-- token should be returned when @nextPos@ is called with the current+-- source position @pos@, the current token @t@ and the rest of the+-- tokens @toks@, @nextPos pos t toks@.+--+-- This is the most primitive combinator for accepting tokens. For+-- example, the 'Text.Parsec.Char.char' parser could be implemented as:+--+-- > char c+-- > = tokenPrim showChar nextPos testChar+-- > where+-- > showChar x = "'" ++ x ++ "'"+-- > testChar x = if x == c then Just x else Nothing+-- > nextPos pos x xs = updatePosChar pos x++tokenPrim :: (Stream s m t)+ => (t -> String) -- ^ Token pretty-printing function.+ -> (SourcePos -> t -> s -> SourcePos) -- ^ Next position calculating function.+ -> (t -> Maybe a) -- ^ Matching function for the token to parse.+ -> ParsecT s u m a+{-# INLINE tokenPrim #-}+tokenPrim showToken nextpos test = tokenPrimEx showToken nextpos Nothing test++tokenPrimEx :: (Stream s m t)+ => (t -> String)+ -> (SourcePos -> t -> s -> SourcePos)+ -> Maybe (SourcePos -> t -> s -> u -> u)+ -> (t -> Maybe a)+ -> ParsecT s u m a+{-# INLINE tokenPrimEx #-}+tokenPrimEx showToken nextpos Nothing test+ = ParsecT $ \(State input pos user) cok _cerr _eok eerr -> do+ r <- uncons input+ case r of+ Nothing -> eerr $ unexpectError "" pos+ Just (c,cs)+ -> case test c of+ Just x -> let newpos = nextpos pos c cs+ newstate = State cs newpos user+ in seq newpos $ seq newstate $+ cok x newstate (newErrorUnknown newpos)+ Nothing -> eerr $ unexpectError (showToken c) pos+tokenPrimEx showToken nextpos (Just nextState) test+ = ParsecT $ \(State input pos user) cok _cerr _eok eerr -> do+ r <- uncons input+ case r of+ Nothing -> eerr $ unexpectError "" pos+ Just (c,cs)+ -> case test c of+ Just x -> let newpos = nextpos pos c cs+ newUser = nextState pos c cs user+ newstate = State cs newpos newUser+ in seq newpos $ seq newstate $+ cok x newstate $ newErrorUnknown newpos+ Nothing -> eerr $ unexpectError (showToken c) pos++unexpectError :: String -> SourcePos -> ParseError+unexpectError msg pos = newErrorMessage (SysUnExpect msg) pos+++-- | @many p@ applies the parser @p@ /zero/ or more times. Returns a+-- list of the returned values of @p@.+--+-- > identifier = do{ c <- letter+-- > ; cs <- many (alphaNum <|> char '_')+-- > ; return (c:cs)+-- > }++many :: ParsecT s u m a -> ParsecT s u m [a]+many p+ = do xs <- manyAccum (:) p+ return (reverse xs)++-- | @many1 p@ applies the parser @p@ /one/ or more times. Returns a+-- list of the returned values of @p@.+--+-- > word = many1 letter++many1 :: ParsecT s u m a -> ParsecT s u m [a]+{-# INLINABLE many1 #-}+many1 p = do{ x <- p; xs <- many p; return (x:xs) }++-- | @skipMany p@ applies the parser @p@ /zero/ or more times, skipping+-- its result.+--+-- > spaces = skipMany space++skipMany :: ParsecT s u m a -> ParsecT s u m ()+skipMany p+ = do _ <- manyAccum (\_ _ -> []) p+ return ()++manyAccum :: (a -> [a] -> [a])+ -> ParsecT s u m a+ -> ParsecT s u m [a]+manyAccum acc p =+ ParsecT $ \s cok cerr eok _eerr ->+ let walk xs x s' _err =+ unParser p s'+ (seq xs $ walk $ acc x xs) -- consumed-ok+ cerr -- consumed-err+ manyErr -- empty-ok+ (\e -> cok (acc x xs) s' e) -- empty-err+ in unParser p s (walk []) cerr manyErr (\e -> eok [] s e)++manyErr :: a+manyErr = error "Text.ParserCombinators.Parsec.Prim.many: combinator 'many' is applied to a parser that accepts an empty string."+++-- < Running a parser: monadic (runPT) and pure (runP)++runPT :: (Stream s m t)+ => ParsecT s u m a -> u -> SourceName -> s -> m (Either ParseError a)+{-# INLINABLE runPT #-}+runPT p u name s+ = do res <- runParsecT p (State s (initialPos name) u)+ r <- parserReply res+ case r of+ Ok x _ _ -> return (Right x)+ Error err -> return (Left err)+ where+ parserReply res+ = case res of+ Consumed r -> r+ Empty r -> r++runP :: (Stream s Identity t)+ => Parsec s u a -> u -> SourceName -> s -> Either ParseError a+runP p u name s = runIdentity $ runPT p u name s++-- | The most general way to run a parser. @runParserT p state filePath+-- input@ runs parser @p@ on the input list of tokens @input@,+-- obtained from source @filePath@ with the initial user state @st@.+-- The @filePath@ is only used in error messages and may be the empty+-- string. Returns a computation in the underlying monad @m@ that return either a 'ParseError' ('Left') or a+-- value of type @a@ ('Right').++runParserT :: (Stream s m t)+ => ParsecT s u m a -> u -> SourceName -> s -> m (Either ParseError a)+runParserT = runPT++-- | The most general way to run a parser over the Identity monad. @runParser p state filePath+-- input@ runs parser @p@ on the input list of tokens @input@,+-- obtained from source @filePath@ with the initial user state @st@.+-- The @filePath@ is only used in error messages and may be the empty+-- string. Returns either a 'ParseError' ('Left') or a+-- value of type @a@ ('Right').+--+-- > parseFromFile p fname+-- > = do{ input <- readFile fname+-- > ; return (runParser p () fname input)+-- > }++runParser :: (Stream s Identity t)+ => Parsec s u a -> u -> SourceName -> s -> Either ParseError a+runParser = runP++-- | @parse p filePath input@ runs a parser @p@ over Identity without user+-- state. The @filePath@ is only used in error messages and may be the+-- empty string. Returns either a 'ParseError' ('Left')+-- or a value of type @a@ ('Right').+--+-- > main = case (parse numbers "" "11, 2, 43") of+-- > Left err -> print err+-- > Right xs -> print (sum xs)+-- >+-- > numbers = commaSep integer++parse :: (Stream s Identity t)+ => Parsec s () a -> SourceName -> s -> Either ParseError a+parse p = runP p ()++-- | The expression @parseTest p input@ applies a parser @p@ against+-- input @input@ and prints the result to stdout. Used for testing+-- parsers.++parseTest :: (Stream s Identity t, Show a)+ => Parsec s () a -> s -> IO ()+parseTest p input+ = case parse p "" input of+ Left err -> do putStr "parse error at "+ print err+ Right x -> print x++-- < Parser state combinators++-- | Returns the current source position. See also 'SourcePos'.++getPosition :: (Monad m) => ParsecT s u m SourcePos+getPosition = do state <- getParserState+ return (statePos state)++-- | 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 :: (Monad m) => SourcePos -> ParsecT s u m ()+setPosition pos+ = do _ <- updateParserState (\(State input _ user) -> State input pos user)+ return ()++-- | @setInput input@ continues parsing with @input@. The 'getInput' and+-- @setInput@ functions can for example be used to deal with #include+-- files.++setInput :: (Monad m) => s -> ParsecT s u m ()+setInput input+ = do _ <- updateParserState (\(State _ pos user) -> State input pos user)+ return ()++-- | Returns the full parser state as a 'State' record.++getParserState :: (Monad m) => ParsecT s u m (State s u)+getParserState = updateParserState id++-- | @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)++-- | @updateParserState f@ applies function @f@ to the parser state.++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'++-- < User state combinators++-- | 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 :: (Monad m) => u -> ParsecT s u m ()+putState u = do _ <- updateParserState $ \s -> s { stateUser = u }+ return ()++-- | @modifyState f@ applies function @f@ to the user state. Suppose+-- that we want to count identifiers in a source, we could use the user+-- state as:+--+-- > expr = do{ x <- identifier+-- > ; modifyState (+1)+-- > ; return (Id x)+-- > }++modifyState :: (Monad m) => (u -> u) -> ParsecT s u m ()+modifyState f = do _ <- updateParserState $ \s -> s { stateUser = f (stateUser s) }+ return ()++-- XXX Compat++-- | An alias for putState for backwards compatibility.++setState :: (Monad m) => u -> ParsecT s u m ()+setState = putState++-- | An alias for modifyState for backwards compatibility.++updateState :: (Monad m) => (u -> u) -> ParsecT s u m ()+updateState = modifyState
+ src/Text/Parsec/String.hs view
@@ -0,0 +1,39 @@+{-# LANGUAGE Safe #-}++-----------------------------------------------------------------------------+-- |+-- 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 -> FilePath -> IO (Either ParseError a)+parseFromFile p fname+ = do input <- readFile fname+ return (runP p () fname input)
+ src/Text/Parsec/Text.hs view
@@ -0,0 +1,45 @@+{-# LANGUAGE Safe #-}++-----------------------------------------------------------------------------+-- |+-- 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+--+-- Convenience definitions for working with 'Text.Text'.+--+-----------------------------------------------------------------------------++module Text.Parsec.Text+ ( Parser, GenParser, parseFromFile+ ) where++import qualified Data.Text as Text+import qualified Data.Text.IO as T++import Text.Parsec.Prim+import Text.Parsec.Error++type Parser = Parsec Text.Text ()+type GenParser st = Parsec Text.Text st++-- | @parseFromFile p filePath@ runs a strict text parser @p@ on the+-- input read from @filePath@ using 'Data.Text.IO.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)+-- > }+--+-- @since 3.1.14.0++parseFromFile :: Parser a -> FilePath -> IO (Either ParseError a)+parseFromFile p fname+ = do input <- T.readFile fname+ return (runP p () fname input)
+ src/Text/Parsec/Text/Lazy.hs view
@@ -0,0 +1,45 @@+{-# LANGUAGE Safe #-}++-----------------------------------------------------------------------------+-- |+-- 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+--+-- Convenience definitions for working with lazy 'Text.Text'.+--+-----------------------------------------------------------------------------++module Text.Parsec.Text.Lazy+ ( Parser, GenParser, parseFromFile+ ) where++import qualified Data.Text.Lazy as Text+import qualified Data.Text.Lazy.IO as TL++import Text.Parsec.Prim+import Text.Parsec.Error++type Parser = Parsec Text.Text ()+type GenParser st = Parsec Text.Text st++-- | @parseFromFile p filePath@ runs a strict text parser @p@ on the+-- input read from @filePath@ using 'Data.Text.Lazy.IO.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)+-- > }+--+-- @since 3.1.14.0++parseFromFile :: Parser a -> FilePath -> IO (Either ParseError a)+parseFromFile p fname+ = do input <- TL.readFile fname+ return (runP p () fname input)
+ src/Text/Parsec/Token.hs view
@@ -0,0 +1,732 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE PolymorphicComponents #-}+{-# LANGUAGE Safe #-}++-----------------------------------------------------------------------------+-- |+-- 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+-- 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.+--+-----------------------------------------------------------------------------++{-# OPTIONS_GHC -fno-warn-name-shadowing #-}++module Text.Parsec.Token+ ( LanguageDef+ , GenLanguageDef (..)+ , TokenParser+ , GenTokenParser (..)+ , makeTokenParser+ ) where++import Data.Char ( isAlpha, toLower, toUpper, isSpace, digitToInt )+import Data.Typeable ( Typeable )+import Data.List ( nub, sort )+import Control.Monad.Identity (Identity)++import Text.Parsec.Prim+import Text.Parsec.Char+import Text.Parsec.Combinator++-----------------------------------------------------------+-- Language Definition+-----------------------------------------------------------++type LanguageDef st = GenLanguageDef String st Identity++-- | The @GenLanguageDef@ type is a record that contains all parameterizable+-- features of the "Text.Parsec.Token" module. The module "Text.Parsec.Language"+-- contains some default definitions.++data GenLanguageDef s u m+ = LanguageDef {++ -- | Describes the start of a block comment. Use the empty string if the+ -- 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 \"*\/\".++ commentEnd :: String,++ -- | Describes the start of a line comment. Use the empty string if the+ -- language doesn't support line comments. For example \"\/\/\".++ commentLine :: String,++ -- | 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 \'_\'@.++ identStart :: ParsecT s u m Char,++ -- | This parser should accept any legal tail characters of identifiers.+ -- For example @alphaNum \<|> char \'_\'@.++ identLetter :: ParsecT s u m Char,++ -- | This parser should accept any start characters of operators. For+ -- 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.++ opLetter :: ParsecT s u m Char,++ -- | The list of reserved identifiers.++ reservedNames :: [String],++ -- | The list of reserved operators.++ reservedOpNames:: [String],++ -- | Set to 'True' if the language is case sensitive.++ caseSensitive :: Bool++ }+ deriving ( Typeable )++-----------------------------------------------------------+-- A first class module: TokenParser+-----------------------------------------------------------++type TokenParser st = GenTokenParser String st Identity++-- | The type of the record that holds lexical parsers that work on+-- @s@ streams with state @u@ over a monad @m@.++data GenTokenParser s u m+ = TokenParser {++ -- | This lexeme parser parses a legal identifier. Returns the identifier+ -- string. This parser will fail on identifiers that are reserved+ -- words. Legal identifier (start) characters and reserved words are+ -- defined in the 'LanguageDef' that is passed to+ -- 'makeTokenParser'. An @identifier@ is treated as+ -- a single token using 'try'.++ identifier :: ParsecT s u m String,++ -- | 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'.++ reserved :: String -> ParsecT s u m (),++ -- | This lexeme parser parses a legal operator. Returns the name of the+ -- operator. This parser will fail on any operators that are reserved+ -- 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'.++ 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'.++ reservedOp :: String -> ParsecT s u m (),+++ -- | This lexeme parser parses a single literal character. Returns the+ -- 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).++ charLiteral :: ParsecT s u m Char,++ -- | This lexeme parser parses a literal string. Returns the literal+ -- 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).++ stringLiteral :: ParsecT s u m String,++ -- | This lexeme parser parses a natural number (a non-negative whole+ -- 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.++ natural :: ParsecT s u m Integer,++ -- | This lexeme parser parses an integer (a whole number). This parser+ -- is like 'natural' except that it can be prefixed with+ -- 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.++ 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.++ 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.++ naturalOrFloat :: ParsecT s u m (Either Integer Double),++ -- | Parses a non-negative whole number in the decimal system. Returns the+ -- value of the number.++ decimal :: ParsecT s u m Integer,++ -- | Parses a non-negative whole number in the hexadecimal system. The+ -- number should be prefixed with \"x\" or \"X\". Returns the value of the+ -- number.++ hexadecimal :: ParsecT s u m Integer,++ -- | Parses a non-negative whole number in the octal system. The number+ -- should be prefixed with \"o\" or \"O\". Returns the value of the+ -- number.++ octal :: ParsecT s u m Integer,++ -- | Lexeme parser @symbol s@ parses 'string' @s@ and skips+ -- trailing white space.++ symbol :: String -> ParsecT s u m String,++ -- | @lexeme p@ first applies parser @p@ and then the 'whiteSpace'+ -- parser, returning the value of @p@. Every lexical+ -- 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.+ --+ -- > mainParser = do{ whiteSpace+ -- > ; ds <- many (lexeme digit)+ -- > ; eof+ -- > ; return (sum ds)+ -- > }++ lexeme :: forall a. ParsecT s u m a -> ParsecT s u m a,++ -- | Parses any white space. White space consists of /zero/ or more+ -- 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'.++ whiteSpace :: ParsecT s u m (),++ -- | Lexeme parser @parens p@ parses @p@ enclosed in parenthesis,+ -- returning the value of @p@.++ 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@.++ 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@.++ 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@.++ brackets :: forall a. ParsecT s u m a -> ParsecT s u m a,++ -- | DEPRECATED: Use 'brackets'.++ 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 \";\".++ semi :: ParsecT s u m String,++ -- | Lexeme parser @comma@ parses the character \',\' and skips any+ -- 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 \":\".++ colon :: ParsecT s u m String,++ -- | Lexeme parser @dot@ parses the character \'.\' and skips any+ -- trailing white space. Returns the string \".\".++ dot :: ParsecT s u m String,++ -- | Lexeme parser @semiSep p@ parses /zero/ or more occurrences of @p@+ -- separated by 'semi'. Returns a list of values returned by+ -- @p@.++ 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@.++ 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@.++ 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@.++ commaSep1 :: forall a . ParsecT s u m a -> ParsecT s u m [a]+ }+ deriving ( Typeable )++-----------------------------------------------------------+-- Given a LanguageDef, create a token parser.+-----------------------------------------------------------++-- | The expression @makeTokenParser language@ creates a 'GenTokenParser'+-- record that contains lexical parsers that are+-- defined using the definitions in the @language@ record.+--+-- The use of this function is quite stylized - one imports the+-- appropriate language definition and selects the lexical parsers that+-- are needed from the resulting 'GenTokenParser'.+--+-- > module Main where+-- >+-- > import Text.Parsec+-- > import qualified Text.Parsec.Token as P+-- > import Text.Parsec.Language (haskellDef)+-- >+-- > -- The parser+-- > ...+-- >+-- > expr = parens expr+-- > <|> identifier+-- > <|> ...+-- >+-- >+-- > -- The lexer+-- > lexer = P.makeTokenParser haskellDef+-- >+-- > parens = P.parens lexer+-- > braces = P.braces lexer+-- > identifier = P.identifier lexer+-- > reserved = P.reserved lexer+-- > ...++makeTokenParser :: (Stream s m Char)+ => GenLanguageDef s u m -> GenTokenParser s u m+{-# INLINABLE makeTokenParser #-}+makeTokenParser languageDef+ = TokenParser{ identifier = identifier+ , reserved = reserved+ , operator = operator+ , reservedOp = reservedOp++ , charLiteral = charLiteral+ , stringLiteral = stringLiteral+ , natural = natural+ , integer = integer+ , float = float+ , naturalOrFloat = naturalOrFloat+ , decimal = decimal+ , hexadecimal = hexadecimal+ , octal = octal++ , symbol = symbol+ , lexeme = lexeme+ , whiteSpace = whiteSpace++ , parens = parens+ , braces = braces+ , angles = angles+ , brackets = brackets+ , squares = brackets+ , semi = semi+ , comma = comma+ , colon = colon+ , dot = dot+ , semiSep = semiSep+ , semiSep1 = semiSep1+ , commaSep = commaSep+ , commaSep1 = commaSep1+ }+ where++ -----------------------------------------------------------+ -- Bracketing+ -----------------------------------------------------------+ parens p = between (symbol "(") (symbol ")") p+ braces p = between (symbol "{") (symbol "}") p+ angles p = between (symbol "<") (symbol ">") p+ brackets p = between (symbol "[") (symbol "]") p++ semi = symbol ";"+ comma = symbol ","+ dot = symbol "."+ colon = symbol ":"++ commaSep p = sepBy p comma+ semiSep p = sepBy p semi++ commaSep1 p = sepBy1 p comma+ semiSep1 p = sepBy1 p semi+++ -----------------------------------------------------------+ -- Chars & Strings+ -----------------------------------------------------------+ charLiteral = lexeme (between (char '\'')+ (char '\'' <?> "end of character")+ characterChar )+ <?> "character"++ characterChar = charLetter <|> charEscape+ <?> "literal character"++ charEscape = do{ _ <- char '\\'; escapeCode }+ charLetter = satisfy (\c -> (c /= '\'') && (c /= '\\') && (c > '\026'))++++ stringLiteral = lexeme (+ do{ str <- between (char '"')+ (char '"' <?> "end of string")+ (many stringChar)+ ; return (foldr (maybe id (:)) "" str)+ }+ <?> "literal string")++ stringChar = do{ c <- stringLetter; return (Just c) }+ <|> stringEscape+ <?> "string character"++ stringLetter = satisfy (\c -> (c /= '"') && (c /= '\\') && (c > '\026'))++ stringEscape = do{ _ <- char '\\'+ ; do{ _ <- escapeGap ; return Nothing }+ <|> do{ _ <- escapeEmpty; return Nothing }+ <|> do{ esc <- escapeCode; return (Just esc) }+ }++ escapeEmpty = char '&'+ escapeGap = do{ _ <- many1 space+ ; char '\\' <?> "end of string gap"+ }++++ -- escape codes+ escapeCode = charEsc <|> charNum <|> charAscii <|> charControl+ <?> "escape code"++ charControl = do{ _ <- char '^'+ ; code <- upper+ ; return (toEnum (fromEnum code - fromEnum 'A' + 1))+ }++ charNum = do{ code <- decimal+ <|> do{ _ <- char 'o'; number 8 octDigit }+ <|> do{ _ <- char 'x'; number 16 hexDigit }+ ; if code > 0x10FFFF+ then fail "invalid escape sequence"+ else return (toEnum (fromInteger code))+ }++ charEsc = choice (map parseEsc escMap)+ where+ parseEsc (c,code) = do{ _ <- char c; return code }++ charAscii = choice (map parseAscii asciiMap)+ where+ parseAscii (asc,code) = try (do{ _ <- string asc; return code })+++ -- escape code tables+ escMap = zip ("abfnrtv\\\"\'") ("\a\b\f\n\r\t\v\\\"\'")+ asciiMap = zip (ascii3codes ++ ascii2codes) (ascii3 ++ ascii2)++ ascii2codes = ["BS","HT","LF","VT","FF","CR","SO","SI","EM",+ "FS","GS","RS","US","SP"]+ ascii3codes = ["NUL","SOH","STX","ETX","EOT","ENQ","ACK","BEL",+ "DLE","DC1","DC2","DC3","DC4","NAK","SYN","ETB",+ "CAN","SUB","ESC","DEL"]++ ascii2 = ['\BS','\HT','\LF','\VT','\FF','\CR','\SO','\SI',+ '\EM','\FS','\GS','\RS','\US','\SP']+ ascii3 = ['\NUL','\SOH','\STX','\ETX','\EOT','\ENQ','\ACK',+ '\BEL','\DLE','\DC1','\DC2','\DC3','\DC4','\NAK',+ '\SYN','\ETB','\CAN','\SUB','\ESC','\DEL']+++ -----------------------------------------------------------+ -- Numbers+ -----------------------------------------------------------+ naturalOrFloat = lexeme (natFloat) <?> "number"++ float = lexeme floating <?> "float"+ integer = lexeme int <?> "integer"+ natural = lexeme nat <?> "natural"+++ -- floats+ floating = do{ n <- decimal+ ; fractExponent n+ }+++ natFloat = do{ _ <- char '0'+ ; zeroNumFloat+ }+ <|> decimalFloat++ zeroNumFloat = do{ n <- hexadecimal <|> octal+ ; return (Left n)+ }+ <|> decimalFloat+ <|> fractFloat (0 :: Integer)+ <|> return (Left 0)++ decimalFloat = do{ n <- decimal+ ; option (Left n)+ (fractFloat n)+ }++ fractFloat n = do{ f <- fractExponent n+ ; return (Right f)+ }++ fractExponent n = do{ fract <- fraction+ ; expo <- option "" exponent'+ ; readDouble (show n ++ fract ++ expo)+ }+ <|>+ do{ expo <- exponent'+ ; readDouble (show n ++ expo)+ }+ where+ readDouble s =+ case reads s of+ [(x, "")] -> return x+ _ -> parserZero++ fraction = do{ _ <- char '.'+ ; digits <- many1 digit <?> "fraction"+ ; return ('.' : digits)+ }+ <?> "fraction"++ exponent' = do{ _ <- oneOf "eE"+ ; sign' <- fmap (:[]) (oneOf "+-") <|> return ""+ ; e <- decimal <?> "exponent"+ ; return ('e' : sign' ++ show e)+ }+ <?> "exponent"+++ -- integers and naturals+ int = do{ f <- lexeme sign+ ; n <- nat+ ; return (f n)+ }++ sign = (char '-' >> return negate)+ <|> (char '+' >> return id)+ <|> return id++ nat = zeroNumber <|> decimal++ zeroNumber = do{ _ <- char '0'+ ; hexadecimal <|> octal <|> decimal <|> return 0+ }+ <?> ""++ decimal = number 10 digit+ hexadecimal = do{ _ <- oneOf "xX"; number 16 hexDigit }+ octal = do{ _ <- oneOf "oO"; number 8 octDigit }++ number base baseDigit+ = do{ digits <- many1 baseDigit+ ; let n = foldl (\x d -> base*x + toInteger (digitToInt d)) 0 digits+ ; seq n (return n)+ }++ -----------------------------------------------------------+ -- Operators & reserved ops+ -----------------------------------------------------------+ reservedOp name =+ lexeme $ try $+ do{ _ <- string name+ ; notFollowedBy (opLetter languageDef) <?> ("end of " ++ show name)+ }++ operator =+ lexeme $ try $+ do{ name <- oper+ ; if (isReservedOp name)+ then unexpected ("reserved operator " ++ show name)+ else return name+ }++ oper =+ do{ c <- (opStart languageDef)+ ; cs <- many (opLetter languageDef)+ ; return (c:cs)+ }+ <?> "operator"++ isReservedOp name =+ isReserved (sort (reservedOpNames languageDef)) name+++ -----------------------------------------------------------+ -- Identifiers & Reserved words+ -----------------------------------------------------------+ reserved name =+ lexeme $ try $+ do{ _ <- caseString name+ ; notFollowedBy (identLetter languageDef) <?> ("end of " ++ show name)+ }++ caseString name+ | caseSensitive languageDef = string name+ | otherwise = do{ walk name; return name }+ where+ walk [] = return ()+ walk (c:cs) = do{ _ <- caseChar c <?> msg; walk cs }++ caseChar c | isAlpha c = char (toLower c) <|> char (toUpper c)+ | otherwise = char c++ msg = show name+++ identifier =+ lexeme $ try $+ do{ name <- ident+ ; if (isReservedName name)+ then unexpected ("reserved word " ++ show name)+ else return name+ }+++ ident+ = do{ c <- identStart languageDef+ ; cs <- many (identLetter languageDef)+ ; return (c:cs)+ }+ <?> "identifier"++ isReservedName name+ = isReserved theReservedNames caseName+ where+ caseName | caseSensitive languageDef = name+ | otherwise = map toLower name+++ isReserved names name+ = scan names+ where+ scan [] = False+ scan (r:rs) = case (compare r name) of+ LT -> scan rs+ EQ -> True+ GT -> False++ theReservedNames+ | caseSensitive languageDef = sort reserved+ | otherwise = sort . map (map toLower) $ reserved+ where+ reserved = reservedNames languageDef++++ -----------------------------------------------------------+ -- White space & symbols+ -----------------------------------------------------------+ symbol name+ = lexeme (string name)++ lexeme p+ = do{ x <- p; whiteSpace; return x }+++ --whiteSpace+ whiteSpace+ | noLine && noMulti = skipMany (simpleSpace <?> "")+ | noLine = skipMany (simpleSpace <|> multiLineComment <?> "")+ | noMulti = skipMany (simpleSpace <|> oneLineComment <?> "")+ | otherwise = skipMany (simpleSpace <|> oneLineComment <|> multiLineComment <?> "")+ where+ noLine = null (commentLine languageDef)+ noMulti = null (commentStart languageDef)+++ simpleSpace =+ skipMany1 (satisfy isSpace)++ oneLineComment =+ do{ _ <- try (string (commentLine languageDef))+ ; skipMany (satisfy (/= '\n'))+ ; return ()+ }++ multiLineComment =+ do { _ <- try (string (commentStart languageDef))+ ; inComment+ }++ inComment+ | nestedComments languageDef = inCommentMulti+ | otherwise = inCommentSingle++ inCommentMulti+ = do{ _ <- try (string (commentEnd languageDef)) ; return () }+ <|> do{ multiLineComment ; inCommentMulti }+ <|> do{ skipMany1 (noneOf startEnd) ; inCommentMulti }+ <|> do{ _ <- oneOf startEnd ; inCommentMulti }+ <?> "end of comment"+ where+ startEnd = nub (commentEnd languageDef ++ commentStart languageDef)++ inCommentSingle+ = do{ _ <- try (string (commentEnd languageDef)); return () }+ <|> do{ skipMany1 (noneOf startEnd) ; inCommentSingle }+ <|> do{ _ <- oneOf startEnd ; inCommentSingle }+ <?> "end of comment"+ where+ startEnd = nub (commentEnd languageDef ++ commentStart languageDef)
+ src/Text/ParserCombinators/Parsec.hs view
@@ -0,0 +1,43 @@+{-# LANGUAGE Safe #-}++-----------------------------------------------------------------------------+-- |+-- 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
+ src/Text/ParserCombinators/Parsec/Char.hs view
@@ -0,0 +1,42 @@+{-# LANGUAGE Safe #-}++-----------------------------------------------------------------------------+-- |+-- 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
+ src/Text/ParserCombinators/Parsec/Combinator.hs view
@@ -0,0 +1,44 @@+{-# LANGUAGE Safe #-}++-----------------------------------------------------------------------------+-- |+-- 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
+ src/Text/ParserCombinators/Parsec/Error.hs view
@@ -0,0 +1,42 @@+{-# LANGUAGE Safe #-}++-----------------------------------------------------------------------------+-- |+-- 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 = (==)
+ src/Text/ParserCombinators/Parsec/Expr.hs view
@@ -0,0 +1,44 @@+{-# LANGUAGE Safe #-}++-----------------------------------------------------------------------------+-- |+-- 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 (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)
+ src/Text/ParserCombinators/Parsec/Language.hs view
@@ -0,0 +1,30 @@+{-# LANGUAGE Safe #-}++-----------------------------------------------------------------------------+-- |+-- 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
+ src/Text/ParserCombinators/Parsec/Perm.hs view
@@ -0,0 +1,26 @@+{-# LANGUAGE Safe #-}++-----------------------------------------------------------------------------+-- |+-- 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
+ src/Text/ParserCombinators/Parsec/Pos.hs view
@@ -0,0 +1,37 @@+{-# LANGUAGE Safe #-}++-----------------------------------------------------------------------------+-- |+-- 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
+ src/Text/ParserCombinators/Parsec/Prim.hs view
@@ -0,0 +1,67 @@+{-# LANGUAGE Safe #-}++-----------------------------------------------------------------------------+-- |+-- 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
+ src/Text/ParserCombinators/Parsec/Token.hs view
@@ -0,0 +1,25 @@+{-# LANGUAGE Safe #-}++-----------------------------------------------------------------------------+-- |+-- 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
+ test/Bugs.hs view
@@ -0,0 +1,18 @@++module Bugs+ ( bugs+ ) where++import Test.Tasty++import qualified Bugs.Bug2+import qualified Bugs.Bug6+import qualified Bugs.Bug9+import qualified Bugs.Bug35++bugs :: [TestTree]+bugs = [ Bugs.Bug2.main+ , Bugs.Bug6.main+ , Bugs.Bug9.main+ , Bugs.Bug35.main+ ]
+ test/Bugs/Bug2.hs view
@@ -0,0 +1,27 @@++module Bugs.Bug2+ ( main+ ) where++import Test.Tasty+import Test.Tasty.HUnit++import Text.Parsec+import Text.Parsec.String+import qualified Text.Parsec.Token as P+import Text.Parsec.Language (haskellDef)++main :: TestTree+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
+ test/Bugs/Bug35.hs view
@@ -0,0 +1,39 @@++module Bugs.Bug35 (main) where++import Text.Parsec+import Text.Parsec.Language+import Text.Parsec.String+import qualified Text.Parsec.Token as Token++import Test.Tasty+import Test.Tasty.HUnit++trickyFloats :: [String]+trickyFloats =+ [ "1.5339794352098402e-118"+ , "2.108934760892056e-59"+ , "2.250634744599241e-19"+ , "5.0e-324"+ , "5.960464477539063e-8"+ , "0.25996181067141905"+ , "0.3572019862807257"+ , "0.46817723004874223"+ , "0.9640035681058178"+ , "4.23808622486133"+ , "4.540362294799751"+ , "5.212384849884261"+ , "13.958257048123212"+ , "32.96176575630599"+ , "38.47735512322269"+ ]++float :: Parser Double+float = Token.float (Token.makeTokenParser emptyDef)++testBatch :: Assertion+testBatch = mapM_ testFloat trickyFloats+ where testFloat x = parse float "" x @?= Right (read x :: Double)++main :: TestTree+main = testCase "Quality of output of Text.Parsec.Token.float (#35)" testBatch
+ test/Bugs/Bug6.hs view
@@ -0,0 +1,24 @@++module Bugs.Bug6+ ( main+ ) where++import Test.Tasty+import Test.Tasty.HUnit++import Text.Parsec+import Text.Parsec.String++import Util++main :: TestTree+main =+ testCase "Look-ahead preserving error location (#6)" $+ parseErrors variable "return" @?= ["'return' is a reserved keyword"]++variable :: Parser String+variable = do+ x <- lookAhead (many1 letter)+ if x == "return"+ then fail "'return' is a reserved keyword"+ else string x
+ test/Bugs/Bug9.hs view
@@ -0,0 +1,44 @@+module Bugs.Bug9 ( main ) where++import Control.Applicative ((<$), (<$>), (<*))+import Text.Parsec+import Text.Parsec.Expr+import Text.Parsec.Language (haskellStyle)+import Text.Parsec.String (Parser)+import qualified Text.Parsec.Token as P++import Test.Tasty+import Test.Tasty.HUnit++import Util++data Expr = Const Integer | Op Expr Expr+ deriving Show++main :: TestTree+main =+ testCase "Tracing of current position in error message (#9)"+ $ result @?= ["unexpected '>'","expecting operator or end of input"]++ where+ result :: [String]+ result = parseErrors parseTopLevel "4 >> 5"++-- Syntax analysis++parseTopLevel :: Parser Expr+parseTopLevel = parseExpr <* eof++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+
+ test/Features.hs view
@@ -0,0 +1,14 @@+module Features+ ( features+ ) where++import Test.Tasty++import qualified Features.Feature80+import qualified Features.Feature150++features :: [TestTree]+features =+ [ Features.Feature80.main+ , Features.Feature150.main+ ]
+ test/Features/Feature150.hs view
@@ -0,0 +1,46 @@+module Features.Feature150 ( main ) where++import Control.Applicative ((*>))+import Control.Monad.Identity+import Test.Tasty+import Test.Tasty.HUnit++import Text.Parsec++main :: TestTree+main =+ testCase "string' (#150)" $ do+ parseString (boot <|> bool) "boot" @?= "boot"+ parseFail (boot <|> bool) "bool" @?= "no parse"+ parseFail (boot <|> bool) "booz" @?= "no parse"++ parseString (boot' <|> bool') "boot" @?= "boot"+ parseString (boot' <|> bool') "bool" @?= "bool"+ parseFail (boot' <|> bool') "booz" @?= "no parse"++ parseString (boot' <|> bool' <|> char 'b' *> many anyChar) "boomerang" @?= "oomerang"++ where+ boot :: ParsecT String () Identity String+ boot = string "boot"++ bool :: ParsecT String () Identity String+ bool = string "bool"++ boot' :: ParsecT String () Identity String+ boot' = string' "boot"++ bool' :: ParsecT String () Identity String+ bool' = string' "bool"++ parseString :: ParsecT String () Identity String -> String -> String+ parseString p input =+ case parse p "Example" input of+ Left{} -> error "Parse failure"+ Right str -> str++ parseFail :: ParsecT String () Identity String -> String -> String+ parseFail p input =+ case parse p "Example" input of+ Left{} -> "no parse"+ Right _ -> error "Parsed but shouldn't"
+ test/Features/Feature80.hs view
@@ -0,0 +1,47 @@+module Features.Feature80 ( main ) where++import Control.Applicative (pure)+import Control.Monad.Identity+import Data.List.NonEmpty+import Data.Semigroup+import Test.Tasty+import Test.Tasty.HUnit++import Text.Parsec++main :: TestTree+main =+ testCase "Monoid instance (#80)" $ do+ parseString (as <> bs) "aabbb" @?= "aabbb"+ parseString (mempty <> as) "aabbb" @?= "aa"+ parseString (as <> mempty) "aabbb" @?= "aa"+ parseString (sconcat $ fromList [as, mempty, bs]) "aabbb" @?= "aabbb"+ parseString (mconcat [as, mempty, bs]) "aabbb" @?= "aabbb"+ parseString (mempty :: ParsecT String () Identity String) "aabbb" @?= ""+ parseString (stimes (2::Int) str_a) "aabbb" @?= "aa"+ parseFail (stimes (3::Int) str_a) "aabbb" @?= "no parse"+ parseString ((one ch_a) <> (one ch_a) <> bs) "aabbb" @?= "aabbb"++ where+ one = fmap pure++ as :: ParsecT String () Identity String+ as = many $ char 'a'+ bs :: ParsecT String () Identity String+ bs = many $ char 'b'+ ch_a :: ParsecT String () Identity Char+ ch_a = char 'a'+ str_a :: ParsecT String () Identity String+ str_a = string "a"++ parseString :: ParsecT String () Identity String -> String -> String+ parseString p input =+ case parse p "Example" input of+ Left{} -> error "Parse failure"+ Right str -> str++ parseFail :: ParsecT String () Identity String -> String -> String+ parseFail p input =+ case parse p "Example" input of+ Left{} -> "no parse"+ Right _ -> error "Parsed but shouldn't"
+ test/Main.hs view
@@ -0,0 +1,12 @@++import Test.Tasty++import Bugs ( bugs )+import Features ( features )++main :: IO ()+main = do+ defaultMain $ testGroup "All"+ [ testGroup "Bugs" bugs+ , testGroup "Features" features+ ]
+ test/Util.hs view
@@ -0,0 +1,14 @@++module Util where++import Text.Parsec+import Text.Parsec.String ( Parser )++-- | 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{} -> []
+ test/issue127.hs view
@@ -0,0 +1,14 @@+-- this should run in constant memory+module Main (main) where+ +import Text.Parsec+import System.Environment (getArgs)+import Control.Monad (replicateM_)++main :: IO ()+main = do+ n <- getArgs >>= \args -> return $ case args of+ arg : _ -> read arg+ _ -> 1000000++ print $ runParser (replicateM_ n $ return ()) () "test" ""
+ test/issue171.hs view
@@ -0,0 +1,29 @@+-- this should be fast+module Main (main) where++import Control.DeepSeq (NFData (..))+import System.CPUTime (getCPUTime)+import Text.Printf (printf)+import Test.Tasty (defaultMain)+import Test.Tasty.HUnit (testCaseSteps, assertBool)++import Text.Parsec+import Text.Parsec.String (Parser)++main :: IO ()+main = defaultMain $ testCaseSteps "issue-171" $ \info -> do+ time0 <- getCPUTime+ check $ concat $ replicate 100000 "a "+ time1 <- getCPUTime+ let diff = (time1 - time0) `div` 1000000000+ info $ printf "%d milliseconds\n" diff+ assertBool "" (diff < 200)++parser :: Parser [String]+parser = many (char 'a' <|> char 'b') `sepBy` char ' '++check :: String -> IO ()+check s = putStrLn $ either onError (const "") $ parse parser {- important: pass input as SourceName -} s s++onError :: ParseError -> String+onError err = rnf (show err) `seq` "error"
+ test/issue175.hs view
@@ -0,0 +1,26 @@+module Main (main) where++import Text.Parsec+import Text.Parsec.Error+import Text.Parsec.String (Parser)+import Text.Parsec.Pos (newPos)++import Test.Tasty (defaultMain)+import Test.Tasty.HUnit (assertFailure, testCaseSteps, (@?=))++main :: IO ()+main = defaultMain $ testCaseSteps "issue175" $ \info -> do+ case parse p "" "x" of+ Right _ -> assertFailure "Unexpected success"+ -- with setPosition the "longest match" is arbitrary+ -- megaparsec tracks consumed tokens separately, but we don't.+ -- so our position is arbitrary.+ Left err -> do+ info $ show err+ errorPos err @?= newPos "aaa" 9 1 -- can be arbitrary+ length (errorMessages err) @?= 2++p :: Parser Char+p = p1 <|> p2 where+ p1 = setPosition (newPos "aaa" 9 1) >> char 'a'+ p2 = setPosition (newPos "zzz" 1 1) >> char 'b'