megaparsec 4.1.1 → 4.2.0
raw patch · 30 files changed
+1152/−709 lines, 30 filesdep ~megaparsec
Dependency ranges changed: megaparsec
Files
- CHANGELOG.md +41/−0
- LICENSE.md +14/−13
- README.md +282/−0
- Text/Megaparsec.hs +7/−8
- Text/Megaparsec/ByteString.hs +6/−24
- Text/Megaparsec/ByteString/Lazy.hs +6/−24
- Text/Megaparsec/Char.hs +1/−1
- Text/Megaparsec/Combinator.hs +2/−64
- Text/Megaparsec/Error.hs +36/−23
- Text/Megaparsec/Expr.hs +16/−8
- Text/Megaparsec/Lexer.hs +26/−3
- Text/Megaparsec/Perm.hs +1/−1
- Text/Megaparsec/Pos.hs +46/−16
- Text/Megaparsec/Prim.hs +198/−120
- Text/Megaparsec/ShowToken.hs +1/−1
- Text/Megaparsec/String.hs +2/−19
- Text/Megaparsec/Text.hs +2/−20
- Text/Megaparsec/Text/Lazy.hs +2/−20
- benchmarks/Main.hs +15/−15
- megaparsec.cabal +21/−19
- tests/Char.hs +12/−14
- tests/Combinator.hs +12/−12
- tests/Error.hs +47/−38
- tests/Expr.hs +43/−27
- tests/Lexer.hs +43/−43
- tests/Main.hs +11/−11
- tests/Perm.hs +15/−23
- tests/Pos.hs +56/−47
- tests/Prim.hs +167/−84
- tests/Util.hs +21/−11
CHANGELOG.md view
@@ -1,3 +1,44 @@+## Megaparsec 4.2.0++* Made `newPos` constructor and other functions in `Text.Megaparsec.Pos`+ smarter. Now it's impossible to create `SourcePos` with non-positive line+ number or column number. Unfortunately we cannot use `Numeric.Natural`+ because we need to support older versions of `base`.++* `ParseError` is now a monoid. `mergeError` is used as `mappend`.++* Added functions `addErrorMessages` and `newErrorMessages` to add several+ messages to existing error and to construct error with several attached+ messages respectively.++* `parseFromFile` now lives in `Text.Megaparsec.Prim`. Previously we had 5+ nearly identical definitions of the function, varying only in+ type-specific `readFile` function. Now the problem is solved by+ introduction of `StorableStream` type class. All supported stream types+ are instances of the class out of box and thus we have polymorphic version+ of `parseFromFile`.++* `ParseError` is now instance of `Exception` (and `Typeable`).++* Introduced `runParser'` and `runParserT'` functions that take and return+ parser state. This makes it possible to partially parse input, resume+ parsing, specify non-standard initial textual position, etc.++* Introduced `failure` function that allows to fail with arbitrary+ collection of messages. `unexpected` is now defined in terms of+ `failure`. One consequence of this design decision is that `failure` is+ now method of `MonadParsec`, while `unexpected` is not.++* Removed deprecated combinators from `Text.Megaparsec.Combinator`:++ * `chainl`+ * `chainl1`+ * `chainr`+ * `chainr1`++* `number` parser in `Text.Megaparsec.Lexer` now can be used with `signed`+ combinator to parse either signed `Integer` or signed `Double`.+ ## Megaparsec 4.1.1 * Fixed bug in implementation of `sepEndBy` and `sepEndBy1` and removed
LICENSE.md view
@@ -9,17 +9,18 @@ * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer.-* Redistributions in binary form must reproduce the above copyright- notice, this list of conditions and the following disclaimer in the- documentation and/or other materials provided with the distribution. -This software is provided by the copyright holders "as is" and any express or-implied warranties, including, but not limited to, the implied warranties of-merchantability and fitness for a particular purpose are disclaimed. In no-event shall the copyright holders be liable for any direct, indirect,-incidental, special, exemplary, or consequential damages (including, but not-limited to, procurement of substitute goods or services; loss of use, data,-or profits; or business interruption) however caused and on any theory of-liability, whether in contract, strict liability, or tort (including-negligence or otherwise) arising in any way out of the use of this software,-even if advised of the possibility of such damage.+* Redistributions in binary form must reproduce the above copyright notice,+ this list of conditions and the following disclaimer in the documentation+ and/or other materials provided with the distribution.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS “AS IS” AND ANY EXPRESS+OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES+OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN+NO EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE FOR ANY DIRECT, INDIRECT,+INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA,+OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF+LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING+NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE,+EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,282 @@+# Megaparsec++[](http://opensource.org/licenses/BSD-2-Clause)+[](https://hackage.haskell.org/package/megaparsec)+[](http://stackage.org/nightly/package/megaparsec)+[](https://travis-ci.org/mrkkrp/megaparsec)+[](https://coveralls.io/github/mrkkrp/megaparsec?branch=master)++* [Features](#features)+ * [Core features](#core-features)+ * [Character parsing](#character-parsing)+ * [Permutation parsing](#permutation-parsing)+ * [Expression parsing](#expression-parsing)+ * [Lexer](#lexer)+* [Documentation](#documentation)+* [Tutorials](#tutorials)+* [Comparison with other solutions](#comparison-with-other-solutions)+ * [Megaparsec and Attoparsec](#megaparsec-and-attoparsec)+ * [Megaparsec and Parsec](#megaparsec-and-parsec)+ * [Megaparsec and Parsers](#megaparsec-and-parsers)+* [Authors](#authors)+* [Contribution](#contribution)+* [License](#license)++This is an industrial-strength monadic parser combinator library. Megaparsec+is a fork of [Parsec](https://github.com/aslatter/parsec) library originally+written by Daan Leijen.++## Features++This project provides flexible solutions to satisfy common parsing+needs. The section describes them shortly. If you're looking for+comprehensive documentation, see the+[section about documentation](#documentation).++### Core features++The package is built around `MonadParsec`, a MTL-style monad+transformer. All tools and features work with any instance of+`MonadParsec`. You can achieve various effects combining monad transformers,+i.e. building monad stack. Since most common monad transformers like+`WriterT`, `StateT`, `ReaderT` and others are instances of `MonadParsec`,+you can wrap `ParsecT` *in* these monads, achieving, for example,+backtracking state.++On the other hand `ParsecT` is instance of many type classes as well. The+most useful ones are `Monad`, `Applicative`, `Alternative`, and+`MonadParsec`.++The module+[`Text.Megaparsec.Combinator`](https://hackage.haskell.org/package/megaparsec/docs/Text-Megaparsec-Combinator.html)+(its functions are included in `Text.Megaparsec`) contains traditional,+general combinators that work with any instance of `Alternative` and some+even with instances of `Applicative`.++Role of `Monad`, `Applicative`, and `Alternative` should be obvious, so+let's enumerate methods of `MonadParsec` type class. The class represents+core, basic functions of Megaparsec parsing. The rest of library is built+via combination of these primitives:++* `failure` allows to fail with arbitrary collection of messages.++* `label` allows to add a “label” to any parser, so when it fails the user will+ see the label in the error message where “expected” items are enumerated.++* `hidden` hides any parser from error messages altogether, this is+ officially recommended way to hide things, prefer it to the `label ""`+ approach.++* `try` enables backtracking in parsing.++* `lookAhead` allows to parse something without consuming input.++* `notFollowedBy` succeeds when its argument fails, it does not consume+ input.++* `eof` only succeeds at the end of input.++* `token` is used to parse single token.++* `tokens` makes it easy to parse several tokens in a row.++* `getParserState` returns full parser state.++* `updateParserState` applies given function on parser state.++This list of core function is longer than in some other libraries. Our goal+was easy and readable implementation of functionality provided by every such+primitive, not minimal number of them. You can read the comprehensive+description of every primitive function in [Megaparsec documentation](https://hackage.haskell.org/package/megaparsec/docs/Text-Megaparsec-Prim.html).++Megaparsec can currently work with the following types of input stream:++* `String` = `[Char]`++* `ByteString` (strict and lazy)++* `Text` (strict and lazy)++### Character parsing++Megaparsec has decent support for Unicode-aware character parsing. Functions+for character parsing live in [`Text.Megaparsec.Char`](https://hackage.haskell.org/package/megaparsec/docs/Text-Megaparsec-Char.html) (they all are+included in `Text.Megaparsec`). The functions can be divided into several+categories:++* *Simple parsers* — parsers that parse certain character or several+ characters of the same kind. This includes `newline`, `crlf`, `eol`,+ `tab`, and `space`.++* *Parsers corresponding to categories of characters* parse single character+ that belongs to certain category of characters, for example:+ `controlChar`, `spaceChar`, `upperChar`, `lowerChar`, `printChar`,+ `digitChar`, and others.++* *General parsers* that allow you to parse a single character you specify+ or one of given characters, or any character except for given ones, or+ character satisfying given predicate. Case-insensitive versions of the+ parsers are available.++* *Parsers for sequences of characters* parse strings. These are more+ efficient and provide better error messages than other approaches most+ programmers can come up with. Case-sensitive `string` parser is available+ as well as case-insensitive `string'`.++### Permutation parsing++For those who are interested in parsing of permutation phrases, there is+[`Text.Megaparsec.Perm`](https://hackage.haskell.org/package/megaparsec/docs/Text-Megaparsec-Perm.html). You have to import the module explicitly, it's not+included in the `Text.Megaparsec` module.++### Expression parsing++Megaparsec has a solution for parsing of expressions. Take a look at+[`Text.Megaparsec.Expr`](https://hackage.haskell.org/package/megaparsec/docs/Text-Megaparsec-Expr.html). You have to import the module explicitly, it's not+included in the `Text.Megaparsec`.++Given a table of operators that describes their fixity and precedence, you+can construct a parser that will parse any expression involving the+operators. See documentation for comprehensive description of how it works.++### Lexer++[`Text.Megaparsec.Lexer`](https://hackage.haskell.org/package/megaparsec/docs/Text-Megaparsec-Lexer.html)+is a module that should help you write your lexer. If you have used `Parsec`+in the past, this module “fixes” its particularly inflexible+`Text.Parsec.Token`.++`Text.Megaparsec.Lexer` is intended to be imported qualified, it's not+included in `Text.Megaparsec`. The module doesn't impose how you should+write your parser, but certain approaches may be more elegant than+others. An especially important theme is parsing of white space, comments,+and indentation.++The design of the module allows you quickly solve simple tasks and doesn't+get in your way when you want to implemented something less standard.++## Documentation++Megaparsec is well-documented. All functions and data-types are thoroughly+described. We pay attention to avoid outdated info or unclear phrases in our+documentation. See the [current version of Megaparsec documentation on+Hackage](https://hackage.haskell.org/package/megaparsec) for yourself.++## Tutorials++You can visit [site of the project](https://mrkkrp.github.io/megaparsec/)+which has several tutorials that should help you to start with your parsing+tasks. The site also has instructions and tips for Parsec users who decide+to switch.++## Comparison with other solutions++There are quite a few libraries that can be used for parsing in Haskell,+let's compare Megaparsec with some of them.++### Megaparsec and Attoparsec++[Attoparsec](https://github.com/bos/attoparsec) is another prominent Haskell+library for parsing. Although the both libraries deal with parsing, it's+usually easy to decide which you will need in particular project:++* *Attoparsec* is much faster but not that feature-rich. It should be used+ when you want to process large amounts of data where performance matter+ more than quality of error messages.++* *Megaparsec* is good for parsing of source code or other human-readable+ texts. It has better error messages and it's implemented as monad+ transformer.++So, if you work with something human-readable where size of input data is+usually not huge, just go with Megaparsec, otherwise Attoparsec may be a+better choice.++### Megaparsec and Parsec++Since Megaparsec is a fork of Parsec, it's necessary to list main+differences between the two libraries:++* Better error messages. We test our error messages using dense QuickCheck+ tests. Good error messages are just as important for us as correct return+ values of our parsers. Megaparsec will be especially useful if you write+ compiler or interpreter for some language.++* Some quirks and “buggy features” (as well as plain bugs) of original+ Parsec are fixed. There is no undocumented surprising stuff in Megaparsec.++* Better support for Unicode parsing in `Text.Megaparsec.Char`.++* Megaparsec has more powerful combinators and can parse languages where+ indentation matters.++* Comprehensive QuickCheck test suite covering nearly 100% of our code.++* We have benchmarks to detect performance regressions.++* Better documentation, with 100% of functions covered, without typos and+ obsolete information, with working examples. Megaparsec's documentation is+ well-structured and doesn't contain things useless to end users.++* Megaparsec's code is clearer and doesn't contain “magic” found in original+ Parsec.++If you want to see a detailed change log, `CHANGELOG.md` may be helpful.++To be honest Parsec's development has seemingly stagnated. It has no test+suite (only three per-bug tests), and all its releases beginning from+version 3.1.2 (according or its change log) were about introducing and+fixing regressions. Parsec is old and somewhat famous in Haskell community,+so we understand there will be some kind of inertia, but we advise you use+Megaparsec from now on because it solves many problems of original Parsec+project. If you think you still have a reason to use original Parsec, open+an issue.++### Megaparsec and Parsers++There is [Parsers](https://hackage.haskell.org/package/parsers) package,+which is great. You can use it with Megaparsec or Parsec, but consider the+following:++* It depends on *both* Attoparsec and Parsec, which means you always grab+ useless code installing it. This is ridiculous, by the way, because this+ package is supposed to be useful for parser builders, so they can write+ basic core functionality and get the rest “for free”. But with these+ useful functions you get two more parsers as dependencies.++* It currently has a bug in definition of `lookAhead` for various monad+ transformers like `StateT`, etc. which is visible when you create+ backtracking state via monad stack, not via built-in features. See #27.++We intended to use Parsers library in Megaparsec at some point, but aside+from already mentioned flaws the library has different conventions for+naming of things, different set of “core” functions, etc., different+approach to lexer. So it didn't happen, Megaparsec has minimal dependencies,+it is feature-rich and self-contained.++## Authors++The project was started and is currently maintained by Mark Karpov. You can+find complete list of contributors in `AUTHORS.md` file in official+repository of the project. Thanks to all the people who propose features and+ideas, although they are not in `AUTHORS.md`, without them Megaparsec would+not be that good.++## Contribution++Issues (bugs, feature requests or otherwise feedback) may be reported in+[the GitHub issue tracker for this project](https://github.com/mrkkrp/megaparsec/issues).++Pull requests are also welcome (and yes, they will get attention and will be+merged quickly if they are good, we are progressive folks).++If you want to write a tutorial to be hosted on Megaparsec's site, open an+issue or pull request [here](https://github.com/mrkkrp/megaparsec-site).++## License++Copyright © 2015 Megaparsec contributors<br>+Copyright © 2007 Paolo Martini<br>+Copyright © 1999–2000 Daan Leijen++Distributed under FreeBSD license.
Text/Megaparsec.hs view
@@ -3,7 +3,7 @@ -- Copyright : © 2015 Megaparsec contributors -- © 2007 Paolo Martini -- © 1999–2001 Daan Leijen--- License : BSD3+-- License : FreeBSD -- -- Maintainer : Mark Karpov <markkarpov@opmbx.org> -- Stability : experimental@@ -31,8 +31,7 @@ -- > -- import Text.Megaparsec.Text.Lazy -- -- As you can see the second import depends on data type you want to use as--- input stream. It just defines useful type-synonym @Parser@ and--- @parseFromFile@ function.+-- input stream. It just defines useful type-synonym @Parser@. -- -- Megaparsec is capable of a lot. Apart from this standard functionality -- you can parse permutation phrases with "Text.Megaparsec.Perm" and even@@ -44,10 +43,13 @@ Parsec , ParsecT , runParser+ , runParser' , runParserT+ , runParserT' , parse , parseMaybe , parseTest+ , parseFromFile -- * Combinators , (A.<|>) -- $assocbo@@ -58,6 +60,7 @@ , A.optional -- $optional , unexpected+ , failure , (<?>) , label , hidden@@ -82,11 +85,6 @@ , sepEndBy1 , skipMany , skipSome- -- Deprecated combinators- , chainl- , chainl1- , chainr- , chainr1 -- * Character parsing , newline , crlf@@ -136,6 +134,7 @@ , sourceColumn -- * Low-level operations , Stream (..)+ , StorableStream (..) , State (..) , getInput , setInput
Text/Megaparsec/ByteString.hs view
@@ -2,40 +2,22 @@ -- Module : Text.Megaparsec.ByteString -- Copyright : © 2015 Megaparsec contributors -- © 2007 Paolo Martini--- License : BSD3+-- License : FreeBSD -- -- Maintainer : Mark Karpov <markkarpov@opmbx.org> -- Stability : experimental -- Portability : portable ----- Convenience definitions for working with 'C.ByteString'.+-- Convenience definitions for working with 'B.ByteString'. -module Text.Megaparsec.ByteString- ( Parser- , parseFromFile )-where+module Text.Megaparsec.ByteString (Parser) where -import Text.Megaparsec.Error import Text.Megaparsec.Prim--import qualified Data.ByteString.Char8 as C+import qualified Data.ByteString as B -- | Different modules corresponding to various types of streams (@String@, -- @Text@, @ByteString@) define it differently, so user can use “abstract” -- @Parser@ type and easily change it by importing different “type--- modules”. This one is for strict bytestrings.--type Parser = Parsec C.ByteString---- | @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)+-- modules”. This one is for strict byte-strings. -parseFromFile :: Parser a -> String -> IO (Either ParseError a)-parseFromFile p fname = runParser p fname `fmap` C.readFile fname+type Parser = Parsec B.ByteString
Text/Megaparsec/ByteString/Lazy.hs view
@@ -2,40 +2,22 @@ -- Module : Text.Megaparsec.ByteString.Lazy -- Copyright : © 2015 Megaparsec contributors -- © 2007 Paolo Martini--- License : BSD3+-- License : FreeBSD -- -- Maintainer : Mark Karpov <markkarpov@opmbx.org> -- Stability : experimental -- Portability : portable ----- Convenience definitions for working with lazy 'C.ByteString'.+-- Convenience definitions for working with lazy 'B.ByteString'. -module Text.Megaparsec.ByteString.Lazy- ( Parser- , parseFromFile )-where+module Text.Megaparsec.ByteString.Lazy (Parser) where -import Text.Megaparsec.Error import Text.Megaparsec.Prim--import qualified Data.ByteString.Lazy.Char8 as C+import qualified Data.ByteString.Lazy as B -- | Different modules corresponding to various types of streams (@String@, -- @Text@, @ByteString@) define it differently, so user can use “abstract” -- @Parser@ type and easily change it by importing different “type--- modules”. This one is for lazy bytestrings.--type Parser = Parsec C.ByteString---- | @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)+-- modules”. This one is for lazy byte-strings. -parseFromFile :: Parser a -> String -> IO (Either ParseError a)-parseFromFile p fname = runParser p fname `fmap` C.readFile fname+type Parser = Parsec B.ByteString
Text/Megaparsec/Char.hs view
@@ -3,7 +3,7 @@ -- Copyright : © 2015 Megaparsec contributors -- © 2007 Paolo Martini -- © 1999–2001 Daan Leijen--- License : BSD3+-- License : FreeBSD -- -- Maintainer : Mark Karpov <markkarpov@opmbx.org> -- Stability : experimental
Text/Megaparsec/Combinator.hs view
@@ -3,7 +3,7 @@ -- Copyright : © 2015 Megaparsec contributors -- © 2007 Paolo Martini -- © 1999–2001 Daan Leijen--- License : BSD3+-- License : FreeBSD -- -- Maintainer : Mark Karpov <markkarpov@opmbx.org> -- Stability : experimental@@ -27,12 +27,7 @@ , sepEndBy , sepEndBy1 , skipMany- , skipSome- -- Deprecated combinators- , chainl- , chainl1- , chainr- , chainr1 )+ , skipSome ) where import Control.Applicative@@ -179,60 +174,3 @@ skipSome :: Alternative m => m a -> m () skipSome p = void $ some p {-# INLINE skipSome #-}---- Deprecated combinators---- | @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.--{-# DEPRECATED chainl "Use \"Text.Megaparsec.Expr\" instead." #-}--chainl :: Alternative m => m a -> m (a -> a -> a) -> a -> m a-chainl p op x = chainl1 p op <|> pure x-{-# INLINE chainl #-}---- | @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.------ Consider using "Text.Megaparsec.Expr" instead.--{-# DEPRECATED chainl1 "Use \"Text.Megaparsec.Expr\" instead." #-}--chainl1 :: Alternative m => m a -> m (a -> a -> a) -> m a-chainl1 p op = scan- where scan = flip id <$> p <*> rst- rst = (\f y g x -> g (f x y)) <$> op <*> p <*> rst <|> pure id-{-# INLINE chainl1 #-}---- | @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.------ Consider using "Text.Megaparsec.Expr" instead.--{-# DEPRECATED chainr "Use \"Text.Megaparsec.Expr\" instead." #-}--chainr :: Alternative m => m a -> m (a -> a -> a) -> a -> m a-chainr p op x = chainr1 p op <|> pure x-{-# INLINE chainr #-}---- | @chainr1 p op@ parses /one/ or more occurrences of @p@,--- separated by @op@. Returns a value obtained by a /right/ associative--- application of all functions returned by @op@ to the values returned by--- @p@.------ Consider using "Text.Megaparsec.Expr" instead.--{-# DEPRECATED chainr1 "Use \"Text.Megaparsec.Expr\" instead." #-}--chainr1 :: Alternative m => m a -> m (a -> a -> a) -> m a-chainr1 p op = scan where- scan = flip id <$> p <*> rst- rst = (flip <$> op <*> scan) <|> pure id-{-# INLINE chainr1 #-}
Text/Megaparsec/Error.hs view
@@ -3,7 +3,7 @@ -- Copyright : © 2015 Megaparsec contributors -- © 2007 Paolo Martini -- © 1999–2001 Daan Leijen--- License : BSD3+-- License : FreeBSD -- -- Maintainer : Mark Karpov <markkarpov@opmbx.org> -- Stability : experimental@@ -20,30 +20,27 @@ , errorMessages , errorIsUnknown , newErrorMessage+ , newErrorMessages , newErrorUnknown , addErrorMessage+ , addErrorMessages , setErrorMessage , setErrorPos , mergeError , showMessages ) where -#if MIN_VERSION_base(4,7,0)-import Data.Bool (bool)-#endif+import Control.Exception (Exception) import Data.List (intercalate) import Data.Maybe (fromMaybe)+import Data.Typeable (Typeable) import Text.Megaparsec.Pos #if !MIN_VERSION_base(4,8,0) import Control.Applicative ((<$>)) import Data.Foldable (foldMap)-#endif-#if !MIN_VERSION_base(4,7,0)-bool :: a -> a -> Bool -> a-bool f _ False = f-bool _ t True = t+import Data.Monoid #endif -- | This data type represents parse error messages. There are three kinds@@ -98,42 +95,58 @@ errorPos :: !SourcePos -- | Extract the list of error messages from 'ParseError'. , errorMessages :: [Message] }- deriving Eq+ deriving (Eq, Typeable) instance Show ParseError where show e = show (errorPos e) ++ ":\n" ++ showMessages (errorMessages e) +instance Monoid ParseError where+ mempty = newErrorUnknown (initialPos "")+ mappend = mergeError++instance Exception ParseError+ -- | Test whether given 'ParseError' has associated collection of error -- messages. Return @True@ if it has none and @False@ otherwise. errorIsUnknown :: ParseError -> Bool errorIsUnknown (ParseError _ ms) = null ms --- Creation of parse errors+-- | @newErrorMessage m pos@ creates 'ParseError' with message @m@ and+-- associated position @pos@. If message @m@ has empty message string, it+-- won't be included. +newErrorMessage :: Message -> SourcePos -> ParseError+newErrorMessage m = newErrorMessages [m]++-- | @newErrorMessages ms pos@ creates 'ParseError' with messages @ms@ and+-- associated position @pos@.++newErrorMessages :: [Message] -> SourcePos -> ParseError+newErrorMessages ms pos = addErrorMessages ms $ newErrorUnknown pos+ -- | @newErrorUnknown pos@ creates 'ParseError' without any associated -- message but with specified position @pos@. newErrorUnknown :: SourcePos -> ParseError newErrorUnknown pos = ParseError pos [] --- | @newErrorMessage m pos@ creates 'ParseError' with message @m@ and--- associated position @pos@. If message @m@ has empty message string, it--- won't be included.--newErrorMessage :: Message -> SourcePos -> ParseError-newErrorMessage m pos = ParseError pos $ bool [m] [] (badMessage m)- -- | @addErrorMessage m err@ returns @err@ with message @m@ added. This -- function makes sure that list of messages is always sorted and doesn't -- contain duplicates or messages with empty message strings. addErrorMessage :: Message -> ParseError -> ParseError addErrorMessage m (ParseError pos ms) =- ParseError pos $ bool (pre ++ [m] ++ post) ms (badMessage m)+ ParseError pos $ if badMessage m then ms else pre ++ [m] ++ post where pre = filter (< m) ms post = filter (> m) ms +-- | @addErrorMessages ms err@ returns @err@ with messages @ms@ added. The+-- function is defined in terms of 'addErrorMessage'.++addErrorMessages :: [Message] -> ParseError -> ParseError+addErrorMessages ms err = foldr addErrorMessage err ms+ -- | @setErrorMessage m err@ returns @err@ with message @m@ added. This -- function also deletes all existing error messages that were created with -- the same constructor as @m@. If message @m@ has empty message string, the@@ -142,9 +155,9 @@ setErrorMessage :: Message -> ParseError -> ParseError setErrorMessage m (ParseError pos ms) =- bool (addErrorMessage m pe) pe (badMessage m)- where pe = ParseError pos xs- xs = filter ((/= fromEnum m) . fromEnum) ms+ if badMessage m then err else addErrorMessage m err+ where err = ParseError pos xs+ xs = filter ((/= fromEnum m) . fromEnum) ms -- | @setErrorPos pos err@ returns 'ParseError' identical to @err@, but with -- position @pos@.@@ -162,7 +175,7 @@ mergeError e1@(ParseError pos1 _) e2@(ParseError pos2 ms2) = case pos1 `compare` pos2 of LT -> e2- EQ -> foldr addErrorMessage e1 ms2+ EQ -> addErrorMessages ms2 e1 GT -> e1 -- | @showMessages ms@ transforms list of error messages @ms@ into
Text/Megaparsec/Expr.hs view
@@ -3,7 +3,7 @@ -- Copyright : © 2015 Megaparsec contributors -- © 2007 Paolo Martini -- © 1999–2001 Daan Leijen--- License : BSD3+-- License : FreeBSD -- -- Maintainer : Mark Karpov <markkarpov@opmbx.org> -- Stability : experimental@@ -37,15 +37,23 @@ -- @term@ with operators from @table@, taking the associativity and -- precedence specified in @table@ into account. ----- @table@ is a list of @[Operator s u m a]@ lists. The list is ordered in+-- @table@ is a list of @[Operator 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).+-- (but may have different associativity). ----- 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@).+-- Prefix and postfix operators of the same precedence associate to the left+-- (i.e. if @++@ is postfix increment, than @-2++@ equals @-1@, not @-3@). --+-- Unary operators of the same precedence can only occur once (i.e. @--2@ is+-- not allowed if @-@ is prefix negate). If you need to parse several prefix+-- or postfix operators in a row, (like C pointers — @**i@) you can use this+-- approach:+--+-- > manyUnaryOp = foldr1 (.) <$> some singleUnaryOp+--+-- This is not done by default because in some cases you don't want to allow+-- repeating prefix or postfix operators.+-- -- @makeExprParser@ takes care of all the complexity involved in building an -- expression parser. Here is an example of an expression parser that -- handles prefix signs, postfix increment and basic arithmetic:@@ -93,7 +101,7 @@ pre <- option id (hidden prefix) x <- term post <- option id (hidden postfix)- return $ post (pre x)+ return . post . pre $ x -- | @pInfixN op p x@ parses non-associative infix operator @op@, then term -- with parser @p@, then returns result of the operator application on @x@
Text/Megaparsec/Lexer.hs view
@@ -3,7 +3,7 @@ -- Copyright : © 2015 Megaparsec contributors -- © 2007 Paolo Martini -- © 1999–2001 Daan Leijen--- License : BSD3+-- License : FreeBSD -- -- Maintainer : Mark Karpov <markkarpov@opmbx.org> -- Stability : experimental@@ -30,6 +30,7 @@ -- * Character and string literals , charLiteral -- * Numbers+ , Signed (..) , integer , decimal , hexadecimal@@ -43,6 +44,8 @@ import Control.Monad (void) import Data.Char (readLitChar) import Data.Maybe (listToMaybe)+import Prelude hiding (negate)+import qualified Prelude import Text.Megaparsec.Combinator import Text.Megaparsec.Pos@@ -184,6 +187,26 @@ -- Numbers +-- | This type class abstracts the concept of signed number in context of+-- this module. This is especially useful when you want to compose 'signed'+-- and 'number'.++class Signed a where++ -- | Unary negation.++ negate :: a -> a++instance Signed Integer where+ negate = Prelude.negate++instance Signed Double where+ negate = Prelude.negate++instance (Signed l, Signed r) => Signed (Either l r) where+ negate (Left x) = Left $ negate x+ negate (Right x) = Right $ negate x+ -- | Parse an integer without sign in decimal representation (according to -- format of integer literals described in Haskell report). --@@ -275,11 +298,11 @@ -- > integer = lexeme L.integer -- > signedInteger = L.signed spaceConsumer integer -signed :: (MonadParsec s m Char, Num a) => m () -> m a -> m a+signed :: (MonadParsec s m Char, Signed a) => m () -> m a -> m a signed spc p = ($) <$> option id (lexeme spc sign) <*> p -- | Parse a sign and return either 'id' or 'negate' according to parsed -- sign. -sign :: (MonadParsec s m Char, Num a) => m (a -> a)+sign :: (MonadParsec s m Char, Signed a) => m (a -> a) sign = (C.char '+' *> return id) <|> (C.char '-' *> return negate)
Text/Megaparsec/Perm.hs view
@@ -3,7 +3,7 @@ -- Copyright : © 2015 Megaparsec contributors -- © 2007 Paolo Martini -- © 1999–2001 Daan Leijen--- License : BSD3+-- License : FreeBSD -- -- Maintainer : Mark Karpov <markkarpov@opmbx.org> -- Stability : experimental
Text/Megaparsec/Pos.hs view
@@ -3,7 +3,7 @@ -- Copyright : © 2015 Megaparsec contributors -- © 2007 Paolo Martini -- © 1999–2001 Daan Leijen--- License : BSD3+-- License : FreeBSD -- -- Maintainer : Mark Karpov <markkarpov@opmbx.org> -- Stability : experimental@@ -16,19 +16,20 @@ , sourceName , sourceLine , sourceColumn+ , InvalidTextualPosition (..)+ , newPos+ , initialPos , incSourceLine , incSourceColumn , setSourceName , setSourceLine , setSourceColumn- , newPos- , initialPos , updatePosChar , updatePosString , defaultTabWidth ) where -import Data.Data (Data)+import Control.Exception (Exception, throw) import Data.List (foldl') import Data.Typeable (Typeable) @@ -44,7 +45,7 @@ , sourceLine :: !Int -- | Extract the column number from a source position. , sourceColumn :: !Int }- deriving (Eq, Ord, Data, Typeable)+ deriving (Eq, Ord) instance Show SourcePos where show (SourcePos n l c)@@ -52,11 +53,36 @@ | otherwise = n ++ ":" ++ showLC where showLC = show l ++ ":" ++ show c +-- | This exception is thrown when some action on 'SourcePos' is performed+-- that would make column number or line number inside this data structure+-- non-positive.+--+-- The 'InvalidTextualPosition' structure includes in order:+--+-- * name of file+-- * line number (possibly non-positive value)+-- * column number (possibly non-positive value)++data InvalidTextualPosition =+ InvalidTextualPosition String Int Int+ deriving (Eq, Show, Typeable)++instance Exception InvalidTextualPosition+ -- | Create a new 'SourcePos' with the given source name, line number and -- column number.+--+-- If line number of column number is not positive, 'InvalidTextualPosition'+-- will be thrown. -newPos :: String -> Int -> Int -> SourcePos-newPos = SourcePos+newPos :: String -- ^ File name+ -> Int -- ^ Line number, minimum is 1+ -> Int -- ^ Column number, minimum is 1+ -> SourcePos+newPos n l c =+ if l < 1 || c < 1+ then throw $ InvalidTextualPosition n l c+ else SourcePos n l c -- | Create a new 'SourcePos' with the given source name, and line number -- and column number set to 1, the upper left.@@ -64,30 +90,34 @@ initialPos :: String -> SourcePos initialPos name = newPos name 1 1 --- | Increment the line number of a source position.+-- | Increment the line number of a source position. If resulting line+-- number is not positive, 'InvalidTextualPosition' will be thrown. incSourceLine :: SourcePos -> Int -> SourcePos-incSourceLine (SourcePos n l c) d = SourcePos n (l + d) c+incSourceLine (SourcePos n l c) d = newPos n (l + d) c --- | Increments the column number of a source position.+-- | Increment the column number of a source position. If resulting column+-- number is not positive, 'InvalidTextualPosition' will be thrown. incSourceColumn :: SourcePos -> Int -> SourcePos-incSourceColumn (SourcePos n l c) d = SourcePos n l (c + d)+incSourceColumn (SourcePos n l c) d = newPos n l (c + d) -- | Set the name of the source. setSourceName :: SourcePos -> String -> SourcePos-setSourceName (SourcePos _ l c) n = SourcePos n l c+setSourceName (SourcePos _ l c) n = newPos n l c --- | Set the line number of a source position.+-- | Set the line number of a source position. If the line number is not+-- positive, 'InvalidTextualPosition' will be thrown. setSourceLine :: SourcePos -> Int -> SourcePos-setSourceLine (SourcePos n _ c) l = SourcePos n l c+setSourceLine (SourcePos n _ c) l = newPos n l c --- | Set the column number of a source position.+-- | Set the column number of a source position. If the line number is not+-- positive, 'InvalidTextualPosition' will be thrown. setSourceColumn :: SourcePos -> Int -> SourcePos-setSourceColumn (SourcePos n l _) = SourcePos n l+setSourceColumn (SourcePos n l _) c = newPos n l c -- | Update a source position given a character. The first argument -- specifies tab width. If the character is a newline (\'\\n\') the line
Text/Megaparsec/Prim.hs view
@@ -3,7 +3,7 @@ -- Copyright : © 2015 Megaparsec contributors -- © 2007 Paolo Martini -- © 1999–2001 Daan Leijen--- License : BSD3+-- License : FreeBSD -- -- Maintainer : Mark Karpov <markkarpov@opmbx.org> -- Stability : experimental@@ -17,11 +17,13 @@ ( -- * Used data-types State (..) , Stream (..)+ , StorableStream (..) , Parsec , ParsecT -- * Primitive combinators , MonadParsec (..) , (<?>)+ , unexpected -- * Parser state combinators , getInput , setInput@@ -32,17 +34,15 @@ , setParserState -- * Running parser , runParser+ , runParser' , runParserT+ , runParserT' , parse , parseMaybe- , parseTest )+ , parseTest+ , parseFromFile ) where -#if MIN_VERSION_base(4,7,0)-import Data.Bool (bool)-#endif-import Data.Monoid- import Control.Monad import Control.Monad.Cont.Class import Control.Monad.Error.Class@@ -51,6 +51,7 @@ import Control.Monad.State.Class hiding (state) import Control.Monad.Trans import Control.Monad.Trans.Identity+import Data.Monoid import qualified Control.Applicative as A import qualified Control.Monad.Trans.Reader as L import qualified Control.Monad.Trans.State.Lazy as L@@ -61,19 +62,16 @@ import qualified Data.ByteString.Char8 as B import qualified Data.ByteString.Lazy.Char8 as BL import qualified Data.Text as T+import qualified Data.Text.IO as T import qualified Data.Text.Lazy as TL+import qualified Data.Text.Lazy.IO as TL import Text.Megaparsec.Error import Text.Megaparsec.Pos import Text.Megaparsec.ShowToken #if !MIN_VERSION_base(4,8,0)-import Control.Applicative ((<$>), (<*))-#endif-#if !MIN_VERSION_base(4,7,0)-bool :: a -> a -> Bool -> a-bool f _ False = f-bool _ t True = t+import Control.Applicative ((<$>), (<*), pure) #endif -- | This is Megaparsec state, it's parametrized over stream type @s@.@@ -84,53 +82,33 @@ , stateTabWidth :: !Int } deriving (Show, Eq) --- | An instance of @Stream s t@ has stream type @s@, and token type @t@--- determined by the stream.--class (ShowToken t, ShowToken [t]) => Stream s t | s -> t where- uncons :: s -> Maybe (t, s)--instance (ShowToken t, ShowToken [t]) => Stream [t] t where- uncons [] = Nothing- uncons (t:ts) = Just (t, ts)- {-# INLINE uncons #-}--instance Stream B.ByteString Char where- uncons = B.uncons- {-# INLINE uncons #-}--instance Stream BL.ByteString Char where- uncons = BL.uncons- {-# INLINE uncons #-}--instance Stream T.Text Char where- uncons = T.uncons- {-# INLINE uncons #-}+-- | All information available after parsing. This includes consumption of+-- input, success (with return value) or failure (with parse error), parser+-- state at the end of parsing.+--+-- See also: 'Consumption', 'Result'. -instance Stream TL.Text Char where- uncons = TL.uncons- {-# INLINE uncons #-}+data Reply s a = Reply !(State s) Consumption (Result a) -- | This data structure represents an aspect of result of parser's -- work. The two constructors have the following meaning: ----- * @Consumed@ is a wrapper for result when some part of input stream--- was consumed.--- * @Empty@ is a wrapper for result when no input was consumed.+-- * @Consumed@ means that some part of input stream was consumed.+-- * @Virgin@ means that no input was consumed. ----- See also: 'Reply'.+-- See also: 'Result', 'Reply'. -data Consumed a = Consumed a | Empty !a+data Consumption = Consumed | Virgin -- | This data structure represents an aspect of result of parser's -- work. The two constructors have the following meaning: ----- * @Ok@ for successfully run parser.--- * @Error@ for failed parser.+-- * @OK@ means that parser succeeded.+-- * @Error@ means that parser failed. ----- See also: 'Consumed'.+-- See also: 'Consumption', 'Reply'. -data Reply s a = Ok a !(State s) | Error ParseError+data Result a = OK a | Error ParseError -- | 'Hints' represent collection of strings to be included into 'ParserError' -- as “expected” messages when a parser fails without consuming input right@@ -162,8 +140,7 @@ -- | @withHints hs c@ makes “error” continuation @c@ use given hints @hs@. withHints :: Hints -> (ParseError -> m b) -> ParseError -> m b-withHints (Hints xs) c = c . addHints- where addHints err = foldr addErrorMessage err (Expected <$> concat xs)+withHints (Hints xs) c = c . addErrorMessages (Expected <$> concat xs) -- | @accHints hs c@ results in “OK” continuation that will add given hints -- @hs@ to third argument of original continuation @c@.@@ -180,6 +157,58 @@ refreshLastHint (Hints (_:xs)) "" = Hints xs refreshLastHint (Hints (_:xs)) l = Hints ([l]:xs) +-- | An instance of @Stream s t@ has stream type @s@, and token type @t@+-- determined by the stream.++class (ShowToken t, ShowToken [t]) => Stream s t | s -> t where+ uncons :: s -> Maybe (t, s)++instance (ShowToken t, ShowToken [t]) => Stream [t] t where+ uncons [] = Nothing+ uncons (t:ts) = Just (t, ts)+ {-# INLINE uncons #-}++instance Stream B.ByteString Char where+ uncons = B.uncons+ {-# INLINE uncons #-}++instance Stream BL.ByteString Char where+ uncons = BL.uncons+ {-# INLINE uncons #-}++instance Stream T.Text Char where+ uncons = T.uncons+ {-# INLINE uncons #-}++instance Stream TL.Text Char where+ uncons = TL.uncons+ {-# INLINE uncons #-}++-- | @StorableStream@ abstracts ability of some streams to be stored in a+-- file. This is used by polymorphic function 'readFromFile'.++class Stream s t => StorableStream s t where++ -- | @fromFile filename@ returns action that will try to read contents of+ -- file named @filename@.++ fromFile :: FilePath -> IO s++instance StorableStream String Char where+ fromFile = readFile++instance StorableStream B.ByteString Char where+ fromFile = B.readFile++instance StorableStream BL.ByteString Char where+ fromFile = BL.readFile++instance StorableStream T.Text Char where+ fromFile = T.readFile++instance StorableStream TL.Text Char where+ fromFile = TL.readFile+ -- If you're reading this, you may be interested in how Megaparsec works on -- lower level. That's quite simple. 'ParsecT' is a wrapper around function -- that takes five arguments:@@ -258,9 +287,9 @@ in unParser p s (walk []) cerr manyErr (errToHints $ eok [] s) manyErr :: a-manyErr = error- "Text.Megaparsec.Prim.many: combinator 'many' is applied to a parser \- \that accepts an empty string."+manyErr = error $ concat+ [ "Text.Megaparsec.Prim.many: combinator 'many' is applied to a parser"+ , " that accepts an empty string." ] instance Monad (ParsecT s m) where return = pReturn@@ -287,20 +316,18 @@ -- | Low-level creation of the ParsecT type. -mkPT :: Monad m => (State s -> m (Consumed (m (Reply s a)))) -> ParsecT s m a+mkPT :: Monad m => (State s -> m (Reply s a)) -> ParsecT s m a 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' -> cok x s' mempty- Error err -> cerr err- Empty mrep -> do- rep <- mrep- case rep of- Ok x s' -> eok x s' mempty- Error err -> eerr err+ (Reply s' consumption result) <- k s+ case consumption of+ Consumed -> do+ case result of+ OK x -> cok x s' mempty+ Error e -> cerr e+ Virgin -> do+ case result of+ OK x -> eok x s' mempty+ Error e -> eerr e instance MonadIO m => MonadIO (ParsecT s m) where liftIO = lift . liftIO@@ -315,15 +342,15 @@ instance MonadCont m => MonadCont (ParsecT s 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)+ callCC $ \c ->+ runParsecT (f (\a -> mkPT $ \s' -> c (pack s' a))) s+ where pack s a = Reply s Virgin (OK a) instance MonadError e m => MonadError e (ParsecT s m) where throwError = lift . throwError p `catchError` h = mkPT $ \s ->- runParsecT p s `catchError` \e ->- runParsecT (h e) s+ runParsecT p s `catchError` \e ->+ runParsecT (h e) s instance MonadPlus (ParsecT s m) where mzero = pZero@@ -335,9 +362,9 @@ pPlus :: ParsecT s m a -> ParsecT s m a -> ParsecT s m a pPlus m n = ParsecT $ \s cok cerr eok eerr -> let meerr err =- let ncerr err' = cerr (mergeError err' err)+ let ncerr err' = cerr (err' <> err) neok x s' hs = eok x s' (toHints err <> hs)- neerr err' = eerr (mergeError err' err)+ neerr err' = eerr (err' <> err) in unParser n s cok ncerr neok neerr in unParser m s cok cerr eok meerr {-# INLINE pPlus #-}@@ -352,13 +379,13 @@ class (A.Alternative m, Monad m, Stream s t) => MonadParsec s m t | m -> s t where - -- | The parser @unexpected msg@ always fails with an unexpected error- -- message @msg@ without consuming any input.+ -- | The most general way to stop parsing and report 'ParseError'. --- -- The parsers 'fail', ('<?>') and 'unexpected' are the three parsers used- -- to generate error messages. Of these, only ('<?>') is commonly used.+ -- 'unexpected' is defined in terms of the function:+ --+ -- > unexpected = failure . pure . Unexpected - unexpected :: String -> m a+ failure :: [Message] -> m a -- | The parser @label name p@ behaves as parser @p@, but whenever the -- parser @p@ fails /without consuming any input/, it replaces names of@@ -467,7 +494,7 @@ updateParserState :: (State s -> State s) -> m () instance Stream s t => MonadParsec s (ParsecT s m) t where- unexpected = pUnexpected+ failure = pFailure label = pLabel try = pTry lookAhead = pLookAhead@@ -478,9 +505,9 @@ getParserState = pGetParserState updateParserState = pUpdateParserState -pUnexpected :: String -> ParsecT s m a-pUnexpected msg = ParsecT $ \(State _ pos _) _ _ _ eerr ->- eerr $ newErrorMessage (Unexpected msg) pos+pFailure :: [Message] -> ParsecT s m a+pFailure msgs = ParsecT $ \(State _ pos _) _ _ _ eerr ->+ eerr $ newErrorMessages msgs pos pLabel :: String -> ParsecT s m a -> ParsecT s m a pLabel l p = ParsecT $ \s cok cerr eok eerr ->@@ -525,7 +552,7 @@ Nothing -> eerr $ unexpectedErr eoi pos Just (c,cs) -> case test c of- Left ms -> eerr $ foldr addErrorMessage (newErrorUnknown pos) ms+ Left ms -> eerr $ addErrorMessages ms (newErrorUnknown pos) Right x -> let newpos = nextpos w pos c newstate = State cs newpos w in seq newpos $ seq newstate $ cok x newstate mempty@@ -545,7 +572,7 @@ in cok (reverse is) s' mempty walk (t:ts) is rs = let errorCont = if null is then eerr else cerr- what = bool (showToken $ reverse is) eoi (null is)+ what = if null is then eoi else showToken $ reverse is in case uncons rs of Nothing -> errorCont . errExpect $ what Just (x,xs)@@ -569,6 +596,15 @@ (<?>) :: MonadParsec s m t => m a -> String -> m a (<?>) = flip label +-- | The parser @unexpected msg@ always fails with an unexpected error+-- message @msg@ without consuming any input.+--+-- The parsers 'fail', 'label' and 'unexpected' are the three parsers used+-- to generate error messages. Of these, only 'label' is commonly used.++unexpected :: MonadParsec s m t => String -> m a+unexpected = failure . pure . Unexpected+ unexpectedErr :: String -> SourcePos -> ParseError unexpectedErr msg = newErrorMessage (Unexpected msg) @@ -634,7 +670,7 @@ parse :: Stream s t => Parsec s a -- ^ Parser to run- -> String -- ^ Name of source file, included in error messages+ -> String -- ^ Name of source file -> s -- ^ Input for parser -> Either ParseError a parse = runParser@@ -661,61 +697,103 @@ parseTest :: (Stream s t, Show a) => Parsec s a -> s -> IO () parseTest p input = case parse p "" input of- Left err -> print err- Right x -> print x+ Left e -> print e+ Right x -> print x --- | The most general way to run a parser over the 'Identity' monad.--- @runParser p file input@ runs parser @p@ on the input list of tokens+-- | @runParser p file input@ runs parser @p@ on the input list of tokens -- @input@, obtained from source @file@. The @file@ is only used in error -- messages and may be the empty string. Returns either a 'ParseError' -- ('Left') or a value of type @a@ ('Right'). -- -- > parseFromFile p file = runParser p file <$> readFile file -runParser :: Stream s t => Parsec s a -> String -> s -> Either ParseError a-runParser p name s = runIdentity $ runParserT p name s+runParser :: Stream s t+ => Parsec s a -- ^ Parser to run+ -> String -- ^ Name of source file+ -> s -- ^ Input for parser+ -> Either ParseError a+runParser p name s = snd $ runParser' p (initialState name s) --- | The most general way to run a parser. @runParserT p file input@ runs--- parser @p@ on the input list of tokens @input@, obtained from source--- @file@. The @file@ is only used in error messages and may be the empty--- string. Returns a computation in the underlying monad @m@ that return--- either a 'ParseError' ('Left') or a value of type @a@ ('Right').+-- | The function is similar to 'runParser' with the difference that it+-- accepts and returns parser state. This allows to specify arbitrary+-- textual position at the beginning of parsing, for example. This is the+-- most general way to run a parser over the 'Identity' monad. +runParser' :: Stream s t+ => Parsec s a -- ^ Parser to run+ -> State s -- ^ Initial state+ -> (State s, Either ParseError a)+runParser' p = runIdentity . runParserT' p++-- | @runParserT p file input@ runs parser @p@ on the input list of tokens+-- @input@, obtained from source @file@. The @file@ is only used in error+-- messages and may be the empty string. Returns a computation in the+-- underlying monad @m@ that returns either a 'ParseError' ('Left') or a+-- value of type @a@ ('Right').+ runParserT :: (Monad m, Stream s t) => ParsecT s m a -> String -> s -> m (Either ParseError a)-runParserT p name s = do- res <- runParsecT p $ State s (initialPos name) defaultTabWidth- 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+runParserT p name s = snd `liftM` runParserT' p (initialState name s) +-- | This function is similar to 'runParserT', but like 'runParser'' it+-- accepts and returns parser state. This is thus the most general way to+-- run a parser.++runParserT' :: (Monad m, Stream s t)+ => ParsecT s m a -- ^ Parser to run+ -> State s -- ^ Initial state+ -> m (State s, Either ParseError a)+runParserT' p s = do+ (Reply s' _ result) <- runParsecT p s+ case result of+ OK x -> return $ (s', Right x)+ Error e -> return $ (s', Left e)++-- | Given name of source file and input construct initial state for parser.++initialState :: Stream s t => String -> s -> State s+initialState name s = State s (initialPos name) defaultTabWidth+ -- | Low-level unpacking of the 'ParsecT' type. 'runParserT' and 'runParser' -- are built upon this. runParsecT :: Monad m- => ParsecT s m a -> State s -> m (Consumed (m (Reply s a)))+ => ParsecT s m a -- ^ Parser to run+ -> State s -- ^ Initial state+ -> m (Reply s a) runParsecT p s = unParser p s cok cerr eok eerr- where cok a s' _ = return . Consumed . return $ Ok a s'- cerr err = return . Consumed . return $ Error err- eok a s' _ = return . Empty . return $ Ok a s'- eerr err = return . Empty . return $ Error err+ where cok a s' _ = return $ Reply s' Consumed (OK a)+ cerr err = return $ Reply s Consumed (Error err)+ eok a s' _ = return $ Reply s' Virgin (OK a)+ eerr err = return $ Reply s Virgin (Error err) +-- | @parseFromFile p filename@ runs parser @p@ on the input read from+-- @filename@. 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 :: StorableStream s t+ => Parsec s a -- ^ Parser to run+ -> FilePath -- ^ Name of file to parse+ -> IO (Either ParseError a)+parseFromFile p filename = runParser p filename <$> fromFile filename+ -- Instances of 'MonadParsec' instance (MonadPlus m, MonadParsec s m t) => MonadParsec s (L.StateT e m) t where- label n (L.StateT m) = L.StateT $ \s -> label n (m s)+ label n (L.StateT m) = L.StateT $ label n . m try (L.StateT m) = L.StateT $ try . m lookAhead (L.StateT m) = L.StateT $ \s -> (,s) . fst <$> lookAhead (m s) notFollowedBy (L.StateT m) = L.StateT $ \s -> notFollowedBy (fst <$> m s) >> return ((),s)- unexpected = lift . unexpected+ failure = lift . failure eof = lift eof token f e = lift $ token f e tokens f e ts = lift $ tokens f e ts@@ -724,13 +802,13 @@ instance (MonadPlus m, MonadParsec s m t) => MonadParsec s (S.StateT e m) t where- label n (S.StateT m) = S.StateT $ \s -> label n (m s)+ label n (S.StateT m) = S.StateT $ label n . m try (S.StateT m) = S.StateT $ try . m lookAhead (S.StateT m) = S.StateT $ \s -> (,s) . fst <$> lookAhead (m s) notFollowedBy (S.StateT m) = S.StateT $ \s -> notFollowedBy (fst <$> m s) >> return ((),s)- unexpected = lift . unexpected+ failure = lift . failure eof = lift eof token f e = lift $ token f e tokens f e ts = lift $ tokens f e ts@@ -739,11 +817,11 @@ instance (MonadPlus m, MonadParsec s m t) => MonadParsec s (L.ReaderT e m) t where- label n (L.ReaderT m) = L.ReaderT $ \s -> label n (m s)+ label n (L.ReaderT m) = L.ReaderT $ label n . m try (L.ReaderT m) = L.ReaderT $ try . m- lookAhead (L.ReaderT m) = L.ReaderT $ \s -> lookAhead (m s)+ lookAhead (L.ReaderT m) = L.ReaderT $ lookAhead . m notFollowedBy (L.ReaderT m) = L.ReaderT $ notFollowedBy . m- unexpected = lift . unexpected+ failure = lift . failure eof = lift eof token f e = lift $ token f e tokens f e ts = lift $ tokens f e ts@@ -758,7 +836,7 @@ (,mempty) . fst <$> lookAhead m notFollowedBy (L.WriterT m) = L.WriterT $ (,mempty) <$> notFollowedBy (fst <$> m)- unexpected = lift . unexpected+ failure = lift . failure eof = lift eof token f e = lift $ token f e tokens f e ts = lift $ tokens f e ts@@ -773,7 +851,7 @@ (,mempty) . fst <$> lookAhead m notFollowedBy (S.WriterT m) = S.WriterT $ (,mempty) <$> notFollowedBy (fst <$> m)- unexpected = lift . unexpected+ failure = lift . failure eof = lift eof token f e = lift $ token f e tokens f e ts = lift $ tokens f e ts@@ -786,7 +864,7 @@ try = IdentityT . try . runIdentityT lookAhead (IdentityT m) = IdentityT $ lookAhead m notFollowedBy (IdentityT m) = IdentityT $ notFollowedBy m- unexpected = lift . unexpected+ failure = lift . failure eof = lift eof token f e = lift $ token f e tokens f e ts = lift $ tokens f e ts
Text/Megaparsec/ShowToken.hs view
@@ -1,7 +1,7 @@ -- | -- Module : Text.Megaparsec.ShowToken -- Copyright : © 2015 Megaparsec contributors--- License : BSD3+-- License : FreeBSD -- -- Maintainer : Mark Karpov <markkarpov@opmbx.org> -- Stability : experimental
Text/Megaparsec/String.hs view
@@ -2,7 +2,7 @@ -- Module : Text.Megaparsec.String -- Copyright : © 2015 Megaparsec contributors -- © 2007 Paolo Martini--- License : BSD3+-- License : FreeBSD -- -- Maintainer : Mark Karpov <markkarpov@opmbx.org> -- Stability : experimental@@ -10,12 +10,8 @@ -- -- Make Strings an instance of 'Stream' with 'Char' token type. -module Text.Megaparsec.String- ( Parser- , parseFromFile )-where+module Text.Megaparsec.String (Parser) where -import Text.Megaparsec.Error import Text.Megaparsec.Prim -- | Different modules corresponding to various types of streams (@String@,@@ -24,16 +20,3 @@ -- modules”. This one is for strings. type Parser = Parsec String---- | @parseFromFile p filePath@ runs a string parser @p@ on the--- input read from @filePath@ using 'Prelude.readFile'. Returns either a--- 'ParseError' ('Left') or a value of type @a@ ('Right').------ > main = do--- > result <- parseFromFile numbers "digits.txt"--- > case result of--- > Left err -> print err--- > Right xs -> print (sum xs)--parseFromFile :: Parser a -> String -> IO (Either ParseError a)-parseFromFile p fname = runParser p fname `fmap` readFile fname
Text/Megaparsec/Text.hs view
@@ -2,7 +2,7 @@ -- Module : Text.Megaparsec.Text -- Copyright : © 2015 Megaparsec contributors -- © 2011 Antoine Latter--- License : BSD3+-- License : FreeBSD -- -- Maintainer : Mark Karpov <markkarpov@opmbx.org> -- Stability : experimental@@ -10,15 +10,10 @@ -- -- Convenience definitions for working with 'T.Text'. -module Text.Megaparsec.Text- ( Parser- , parseFromFile )-where+module Text.Megaparsec.Text (Parser) where -import Text.Megaparsec.Error import Text.Megaparsec.Prim import qualified Data.Text as T-import qualified Data.Text.IO as T -- | Different modules corresponding to various types of streams (@String@, -- @Text@, @ByteString@) define it differently, so user can use “abstract”@@ -26,16 +21,3 @@ -- modules”. This one is for strict text. type Parser = Parsec T.Text---- | @parseFromFile p filePath@ runs a lazy 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)--parseFromFile :: Parser a -> String -> IO (Either ParseError a)-parseFromFile p fname = runParser p fname `fmap` T.readFile fname
Text/Megaparsec/Text/Lazy.hs view
@@ -2,7 +2,7 @@ -- Module : Text.Megaparsec.Text.Lazy -- Copyright : © 2015 Megaparsec contributors -- © 2011 Antoine Latter--- License : BSD3+-- License : FreeBSD -- -- Maintainer : Mark Karpov <markkarpov@opmbx.org> -- Stability : experimental@@ -10,15 +10,10 @@ -- -- Convenience definitions for working with lazy 'T.Text'. -module Text.Megaparsec.Text.Lazy- ( Parser- , parseFromFile )-where+module Text.Megaparsec.Text.Lazy (Parser) where -import Text.Megaparsec.Error import Text.Megaparsec.Prim import qualified Data.Text.Lazy as T-import qualified Data.Text.Lazy.IO as T -- | Different modules corresponding to various types of streams (@String@, -- @Text@, @ByteString@) define it differently, so user can use “abstract”@@ -26,16 +21,3 @@ -- modules”. This one is for lazy text. type Parser = Parsec T.Text---- | @parseFromFile p filePath@ runs a lazy 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)--parseFromFile :: Parser a -> String -> IO (Either ParseError a)-parseFromFile p fname = runParser p fname `fmap` T.readFile fname
benchmarks/Main.hs view
@@ -1,6 +1,6 @@ -- -*- Mode: Haskell; -*- ----- Criterion benchmarks for Megaparsec, main module.+-- Criterion benchmarks for Megaparsec. -- -- Copyright © 2015 Megaparsec contributors --@@ -15,17 +15,17 @@ -- notice, this list of conditions and the following disclaimer in the -- documentation and/or other materials provided with the distribution. ----- This software is provided by the copyright holders "as is" and any--- express or implied warranties, including, but not limited to, the implied--- warranties of merchantability and fitness for a particular purpose are--- disclaimed. In no event shall the copyright holders be liable for any--- direct, indirect, incidental, special, exemplary, or consequential--- damages (including, but not limited to, procurement of substitute goods--- or services; loss of use, data, or profits; or business interruption)--- however caused and on any theory of liability, whether in contract,--- strict liability, or tort (including negligence or otherwise) arising in--- any way out of the use of this software, even if advised of the--- possibility of such damage.+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS “AS IS” AND ANY+-- EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED+-- WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+-- DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE FOR ANY+-- DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+-- DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS+-- OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)+-- HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,+-- STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN+-- ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE+-- POSSIBILITY OF SUCH DAMAGE. {-# LANGUAGE CPP #-} @@ -74,11 +74,12 @@ #endif -- benchSteps and benchSize control the benchmark test points+ benchSteps :: Int #if BENCHMARK_STEPS-benchSteps = BENCHMARK_STEPS+benchSteps = BENCHMARK_STEPS #else-benchSteps = 5+benchSteps = 5 #endif benchSize :: Int #if BENCHMARK_SIZE@@ -88,7 +89,6 @@ #endif -- End of configuration parameters- main :: IO () main = defaultMain benchmarks
megaparsec.cabal view
@@ -15,22 +15,22 @@ -- notice, this list of conditions and the following disclaimer in the -- documentation and/or other materials provided with the distribution. ----- This software is provided by the copyright holders "as is" and any--- express or implied warranties, including, but not limited to, the implied--- warranties of merchantability and fitness for a particular purpose are--- disclaimed. In no event shall the copyright holders be liable for any--- direct, indirect, incidental, special, exemplary, or consequential--- damages (including, but not limited to, procurement of substitute goods--- or services; loss of use, data, or profits; or business interruption)--- however caused and on any theory of liability, whether in contract,--- strict liability, or tort (including negligence or otherwise) arising in--- any way out of the use of this software, even if advised of the--- possibility of such damage.+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS “AS IS” AND ANY+-- EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED+-- WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+-- DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE FOR ANY+-- DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+-- DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS+-- OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)+-- HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,+-- STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN+-- ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE+-- POSSIBILITY OF SUCH DAMAGE. name: megaparsec-version: 4.1.1+version: 4.2.0 cabal-version: >= 1.10-license: BSD3+license: BSD2 license-file: LICENSE.md author: Megaparsec contributors, Paolo Martini <paolo@nemail.it>,@@ -47,7 +47,9 @@ This is industrial-strength monadic parser combinator library. Megaparsec is a fork of Parsec library originally written by Daan Leijen. -extra-source-files: AUTHORS.md, CHANGELOG.md+extra-source-files: AUTHORS.md+ , CHANGELOG.md+ , README.md library build-depends: base >= 4.6 && < 5@@ -97,7 +99,7 @@ , Bugs.Bug39 , Util build-depends: base >= 4.6 && < 5- , megaparsec >= 4.1.1+ , megaparsec >= 4.2 , HUnit >= 1.2 && < 1.4 , test-framework >= 0.6 && < 1 , test-framework-hunit >= 0.2 && < 0.4@@ -110,7 +112,7 @@ main-is: Main.hs hs-source-dirs: tests type: exitcode-stdio-1.0- ghc-options: -O2 -Wall -rtsopts+ ghc-options: -O2 -Wall other-modules: Char , Combinator , Error@@ -121,7 +123,7 @@ , Prim , Util build-depends: base >= 4.6 && < 5- , megaparsec >= 4.1.1+ , megaparsec >= 4.2 , mtl == 2.* , transformers == 0.4.* , QuickCheck >= 2.4 && < 3@@ -137,9 +139,9 @@ main-is: Main.hs hs-source-dirs: benchmarks type: exitcode-stdio-1.0- ghc-options: -O2 -Wall -rtsopts+ ghc-options: -O2 -Wall build-depends: base >= 4.6 && < 5- , megaparsec >= 4.1.1+ , megaparsec >= 4.2 , criterion >= 0.6.2.1 && < 1.2 , text >= 1.2 && < 2 , bytestring >= 0.10 && < 2
tests/Char.hs view
@@ -15,17 +15,17 @@ -- notice, this list of conditions and the following disclaimer in the -- documentation and/or other materials provided with the distribution. ----- This software is provided by the copyright holders "as is" and any--- express or implied warranties, including, but not limited to, the implied--- warranties of merchantability and fitness for a particular purpose are--- disclaimed. In no event shall the copyright holders be liable for any--- direct, indirect, incidental, special, exemplary, or consequential--- damages (including, but not limited to, procurement of substitute goods--- or services; loss of use, data, or profits; or business interruption)--- however caused and on any theory of liability, whether in contract,--- strict liability, or tort (including negligence or otherwise) arising in--- any way out of the use of this software, even if advised of the--- possibility of such damage.+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS “AS IS” AND ANY+-- EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED+-- WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+-- DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE FOR ANY+-- DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+-- DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS+-- OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)+-- HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,+-- STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN+-- ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE+-- POSSIBILITY OF SUCH DAMAGE. {-# OPTIONS -fno-warn-orphans #-} @@ -245,9 +245,7 @@ -- | Randomly change the case in the given string. fuzzyCase :: String -> Gen String-fuzzyCase s = do- b <- vector (length s)- return $ zipWith f s b+fuzzyCase s = zipWith f s <$> vector (length s) where f k True = if isLower k then toUpper k else toLower k f k False = k
tests/Combinator.hs view
@@ -15,17 +15,17 @@ -- notice, this list of conditions and the following disclaimer in the -- documentation and/or other materials provided with the distribution. ----- This software is provided by the copyright holders "as is" and any--- express or implied warranties, including, but not limited to, the implied--- warranties of merchantability and fitness for a particular purpose are--- disclaimed. In no event shall the copyright holders be liable for any--- direct, indirect, incidental, special, exemplary, or consequential--- damages (including, but not limited to, procurement of substitute goods--- or services; loss of use, data, or profits; or business interruption)--- however caused and on any theory of liability, whether in contract,--- strict liability, or tort (including negligence or otherwise) arising in--- any way out of the use of this software, even if advised of the--- possibility of such damage.+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS “AS IS” AND ANY+-- EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED+-- WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+-- DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE FOR ANY+-- DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+-- DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS+-- OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)+-- HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,+-- STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN+-- ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE+-- POSSIBILITY OF SUCH DAMAGE. module Combinator (tests) where @@ -67,7 +67,7 @@ b = length $ takeWhile (== c) post r | b > 0 = posErr (length pre + n + b) s $ exStr post : if length post == b- then [uneEof]+ then [uneEof, exCh c] else [uneCh (post !! b), exCh c] | otherwise = Right z z = replicate n c
tests/Error.hs view
@@ -15,26 +15,24 @@ -- notice, this list of conditions and the following disclaimer in the -- documentation and/or other materials provided with the distribution. ----- This software is provided by the copyright holders "as is" and any--- express or implied warranties, including, but not limited to, the implied--- warranties of merchantability and fitness for a particular purpose are--- disclaimed. In no event shall the copyright holders be liable for any--- direct, indirect, incidental, special, exemplary, or consequential--- damages (including, but not limited to, procurement of substitute goods--- or services; loss of use, data, or profits; or business interruption)--- however caused and on any theory of liability, whether in contract,--- strict liability, or tort (including negligence or otherwise) arising in--- any way out of the use of this software, even if advised of the--- possibility of such damage.+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS “AS IS” AND ANY+-- EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED+-- WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+-- DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE FOR ANY+-- DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+-- DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS+-- OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)+-- HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,+-- STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN+-- ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE+-- POSSIBILITY OF SUCH DAMAGE. {-# OPTIONS -fno-warn-orphans #-} module Error (tests) where -#if MIN_VERSION_base(4,7,0)-import Data.Bool (bool)-#endif import Data.List (isPrefixOf, isInfixOf)+import Data.Monoid ((<>)) import Test.Framework import Test.Framework.Providers.QuickCheck2 (testProperty)@@ -46,26 +44,25 @@ #if !MIN_VERSION_base(4,8,0) import Control.Applicative ((<$>), (<*>))-#endif-#if !MIN_VERSION_base(4,7,0)-bool :: a -> a -> Bool -> a-bool f _ False = f-bool _ t True = t+import Data.Monoid (mempty) #endif tests :: Test tests = testGroup "Parse errors"- [ testProperty "extracting message string" prop_messageString- , testProperty "creation of new error messages" prop_newErrorMessage+ [ testProperty "monoid left identity" prop_monoid_left_id+ , testProperty "monoid right identity" prop_monoid_right_id+ , testProperty "monoid associativity" prop_monoid_assoc+ , testProperty "extraction of message string" prop_messageString+ , testProperty "creation of new error messages" prop_newErrorMessage , testProperty "messages are always well-formed" prop_wellFormedMessages- , testProperty "copying of error positions" prop_parseErrorCopy- , testProperty "setting of error position" prop_setErrorPos- , testProperty "addition of error message" prop_addErrorMessage- , testProperty "setting of error message" prop_setErrorMessage- , testProperty "position of merged error" prop_mergeErrorPos- , testProperty "messages of merged error" prop_mergeErrorMsgs- , testProperty "position of error is visible" prop_visiblePos- , testProperty "message components are visible" prop_visibleMsgs ]+ , testProperty "copying of error positions" prop_parseErrorCopy+ , testProperty "setting of error position" prop_setErrorPos+ , testProperty "addition of error message" prop_addErrorMessage+ , testProperty "setting of error message" prop_setErrorMessage+ , testProperty "position of merged error" prop_mergeErrorPos+ , testProperty "messages of merged error" prop_mergeErrorMsgs+ , testProperty "position of error is visible" prop_visiblePos+ , testProperty "message components are visible" prop_visibleMsgs ] instance Arbitrary Message where arbitrary = ($) <$> elements constructors <*> arbitrary@@ -73,11 +70,20 @@ instance Arbitrary ParseError where arbitrary = do- ms <- listOf arbitrary- pe <- oneof [ newErrorUnknown <$> arbitrary- , newErrorMessage <$> arbitrary <*> arbitrary ]- return $ foldr addErrorMessage pe ms+ ms <- listOf arbitrary+ err <- oneof [ newErrorUnknown <$> arbitrary+ , newErrorMessage <$> arbitrary <*> arbitrary ]+ return $ addErrorMessages ms err +prop_monoid_left_id :: ParseError -> Bool+prop_monoid_left_id x = mempty <> x == x++prop_monoid_right_id :: ParseError -> Bool+prop_monoid_right_id x = x <> mempty == x++prop_monoid_assoc :: ParseError -> ParseError -> ParseError -> Bool+prop_monoid_assoc x y z = (x <> y) <> z == x <> (y <> z)+ prop_messageString :: Message -> Bool prop_messageString m@(Unexpected s) = s == messageString m prop_messageString m@(Expected s) = s == messageString m@@ -86,10 +92,10 @@ prop_newErrorMessage :: Message -> SourcePos -> Bool prop_newErrorMessage msg pos = added && errorPos new == pos where new = newErrorMessage msg pos- added = errorMessages new == bool [msg] [] (badMessage msg)+ added = errorMessages new == if badMessage msg then [] else [msg] prop_wellFormedMessages :: ParseError -> Bool-prop_wellFormedMessages err = wellFormed $ errorMessages err+prop_wellFormedMessages = wellFormed . errorMessages prop_parseErrorCopy :: ParseError -> Bool prop_parseErrorCopy err =@@ -131,13 +137,16 @@ prop_visiblePos err = show (errorPos err) `isPrefixOf` show err prop_visibleMsgs :: ParseError -> Bool-prop_visibleMsgs err = all (`isInfixOf` shown) (errorMessages err >>= f)+prop_visibleMsgs err = if null msgs+ then "unknown" `isInfixOf` shown+ else all (`isInfixOf` shown) (msgs >>= f) where shown = show err+ msgs = errorMessages err f (Unexpected s) = ["unexpected", s]- f (Expected s) = ["expecting", s]+ f (Expected s) = ["expecting", s] f (Message s) = [s] --- | @iwellFormed xs@ checks that list @xs@ is sorted and contains no+-- | @wellFormed xs@ checks that list @xs@ is sorted and contains no -- duplicates and no empty messages. wellFormed :: [Message] -> Bool
tests/Expr.hs view
@@ -15,24 +15,22 @@ -- notice, this list of conditions and the following disclaimer in the -- documentation and/or other materials provided with the distribution. ----- This software is provided by the copyright holders "as is" and any--- express or implied warranties, including, but not limited to, the implied--- warranties of merchantability and fitness for a particular purpose are--- disclaimed. In no event shall the copyright holders be liable for any--- direct, indirect, incidental, special, exemplary, or consequential--- damages (including, but not limited to, procurement of substitute goods--- or services; loss of use, data, or profits; or business interruption)--- however caused and on any theory of liability, whether in contract,--- strict liability, or tort (including negligence or otherwise) arising in--- any way out of the use of this software, even if advised of the--- possibility of such damage.+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS “AS IS” AND ANY+-- EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED+-- WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+-- DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE FOR ANY+-- DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+-- DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS+-- OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)+-- HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,+-- STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN+-- ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE+-- POSSIBILITY OF SUCH DAMAGE. module Expr (tests) where import Control.Applicative (some, (<|>))-#if MIN_VERSION_base(4,7,0)-import Data.Bool (bool)-#endif+import Data.Char (isDigit, digitToInt) import Test.Framework import Test.Framework.Providers.QuickCheck2 (testProperty)@@ -49,15 +47,12 @@ import Control.Applicative ((<$>), (<*), (<*>), (*>), pure) #endif -#if !MIN_VERSION_base(4,7,0)-bool :: a -> a -> Bool -> a-bool f _ False = f-bool _ t True = t-#endif- tests :: Test tests = testGroup "Expression parsers"- [ testProperty "correctness of expression parser" prop_correctness ]+ [ testProperty "correctness of expression parser" prop_correctness+ , testProperty "error message on empty input" prop_empty_error+ , testProperty "error message on missing term" prop_missing_term+ , testProperty "error message on missing op" prop_missing_op ] -- Algebraic structures to build abstract syntax tree of our expression. @@ -100,13 +95,13 @@ showNode n@(Exp x y) = showGE n x ++ " ^ " ++ showGT n y showGT :: Node -> Node -> String-showGT parent node = bool showNode showCmp (node > parent) node+showGT parent node = (if node > parent then showCmp else showNode) node showGE :: Node -> Node -> String-showGE parent node = bool showNode showCmp (node >= parent) node+showGE parent node = (if node >= parent then showCmp else showNode) node showCmp :: Node -> String-showCmp node = bool inParens showNode (fromEnum node == 0) node+showCmp node = (if fromEnum node == 0 then showNode else inParens) node inParens :: Node -> String inParens x = "(" ++ showNode x ++ ")"@@ -121,9 +116,9 @@ arbitraryN1 :: Int -> Gen Node arbitraryN1 n =- frequency [ (1, Neg <$> arbitraryN2 n)- , (1, Fac <$> arbitraryN2 n)- , (7, arbitraryN2 n)]+ frequency [ (1, Neg <$> arbitraryN2 n)+ , (1, Fac <$> arbitraryN2 n)+ , (7, arbitraryN2 n)] arbitraryN2 :: Int -> Gen Node arbitraryN2 0 = Val . getNonNegative <$> arbitrary@@ -168,3 +163,24 @@ prop_correctness :: Node -> Property prop_correctness node = checkParser expr (Right node) (showNode node)++prop_empty_error :: Property+prop_empty_error = checkParser expr r s+ where r = posErr 0 s [uneEof, exSpec "term"]+ s = ""++prop_missing_term :: Char -> Property+prop_missing_term c = checkParser expr r s+ where r | c `elem` "-(" = posErr 1 s [uneEof, exSpec "term"]+ | isDigit c = Right . Val . fromIntegral . digitToInt $ c+ | otherwise = posErr 0 s [uneCh c, exSpec "term"]+ s = pure c++prop_missing_op :: Node -> Node -> Property+prop_missing_op a b = checkParser expr r s+ where a' = inParens a+ c = s !! n+ n = succ $ length a'+ r | c == '-' = Right $ Sub a b+ | otherwise = posErr n s $ [uneCh c, exEof, exSpec "operator"]+ s = a' ++ " " ++ inParens b
tests/Lexer.hs view
@@ -15,25 +15,22 @@ -- notice, this list of conditions and the following disclaimer in the -- documentation and/or other materials provided with the distribution. ----- This software is provided by the copyright holders "as is" and any--- express or implied warranties, including, but not limited to, the implied--- warranties of merchantability and fitness for a particular purpose are--- disclaimed. In no event shall the copyright holders be liable for any--- direct, indirect, incidental, special, exemplary, or consequential--- damages (including, but not limited to, procurement of substitute goods--- or services; loss of use, data, or profits; or business interruption)--- however caused and on any theory of liability, whether in contract,--- strict liability, or tort (including negligence or otherwise) arising in--- any way out of the use of this software, even if advised of the--- possibility of such damage.+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS “AS IS” AND ANY+-- EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED+-- WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+-- DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE FOR ANY+-- DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+-- DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS+-- OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)+-- HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,+-- STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN+-- ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE+-- POSSIBILITY OF SUCH DAMAGE. module Lexer (tests) where import Control.Applicative (empty) import Control.Monad (void)-#if MIN_VERSION_base(4,7,0)-import Data.Bool (bool)-#endif import Data.Char ( readLitChar , showLitChar@@ -61,27 +58,24 @@ #if !MIN_VERSION_base(4,8,0) import Control.Applicative ((<$>), (<*), (<*>)) #endif-#if !MIN_VERSION_base(4,7,0)-bool :: a -> a -> Bool -> a-bool f _ False = f-bool _ t True = t-#endif tests :: Test tests = testGroup "Lexer"- [ testProperty "space combinator" prop_space- , testProperty "symbol combinator" prop_symbol- , testProperty "symbol' combinator" prop_symbol'- , testProperty "indentGuard combinator" prop_indentGuard- , testProperty "charLiteral" prop_charLiteral- , testProperty "integer" prop_integer- , testProperty "decimal" prop_decimal- , testProperty "hexadecimal" prop_hexadecimal- , testProperty "octal" prop_octal- , testProperty "float 0" prop_float_0- , testProperty "float 1" prop_float_1- , testProperty "number" prop_number- , testProperty "signed" prop_signed ]+ [ testProperty "space combinator" prop_space+ , testProperty "symbol combinator" prop_symbol+ , testProperty "symbol' combinator" prop_symbol'+ , testProperty "indentGuard combinator" prop_indentGuard+ , testProperty "charLiteral" prop_charLiteral+ , testProperty "integer" prop_integer+ , testProperty "decimal" prop_decimal+ , testProperty "hexadecimal" prop_hexadecimal+ , testProperty "octal" prop_octal+ , testProperty "float 0" prop_float_0+ , testProperty "float 1" prop_float_1+ , testProperty "number 0" prop_number_0+ , testProperty "number 1" prop_number_1+ , testProperty "number 2 (signed)" prop_number_2+ , testProperty "signed" prop_signed ] newtype WhiteSpace = WhiteSpace { getWhiteSpace :: String }@@ -211,26 +205,32 @@ , exCh 'e', exSpec "digit" ] s = maybe "" (show . getNonNegative) n' -prop_number :: Either (NonNegative Integer) (NonNegative Double)- -> Integer -> Property-prop_number n' i = checkParser number r s- where r | null s = posErr 0 s [uneEof, exSpec "number"]- | otherwise =- Right $ case n' of+prop_number_0 :: Either (NonNegative Integer) (NonNegative Double) -> Property+prop_number_0 n' = checkParser number r s+ where r = Right $ case n' of Left x -> Left $ getNonNegative x Right x -> Right $ getNonNegative x- s = if i < 5- then ""- else either (show . getNonNegative) (show . getNonNegative) n'+ s = either (show . getNonNegative) (show . getNonNegative) n' +prop_number_1 :: Property+prop_number_1 = checkParser number r s+ where r = posErr 0 s [uneEof, exSpec "number"]+ s = ""++prop_number_2 :: Either Integer Double -> Property+prop_number_2 n = checkParser p (Right n) s+ where p = signed (hidden C.space) number+ s = either show show n+ prop_signed :: Integer -> Int -> Bool -> Property prop_signed n i plus = checkParser p r s where p = signed (hidden C.space) integer r | i > length z = Right n | otherwise = posErr i s $ uneCh '?' : (if i <= 0 then [exCh '+', exCh '-'] else []) ++- [exSpec $ bool "rest of integer" "integer" $- isNothing . find isDigit $ take i s]+ [exSpec $ if isNothing . find isDigit $ take i s+ then "integer"+ else "rest of integer"] ++ [exEof | i > head (findIndices isDigit s)] z = let bar = showSigned showInt 0 n "" in if n < 0 || plus then bar else '+' : bar
tests/Main.hs view
@@ -15,17 +15,17 @@ -- notice, this list of conditions and the following disclaimer in the -- documentation and/or other materials provided with the distribution. ----- This software is provided by the copyright holders "as is" and any--- express or implied warranties, including, but not limited to, the implied--- warranties of merchantability and fitness for a particular purpose are--- disclaimed. In no event shall the copyright holders be liable for any--- direct, indirect, incidental, special, exemplary, or consequential--- damages (including, but not limited to, procurement of substitute goods--- or services; loss of use, data, or profits; or business interruption)--- however caused and on any theory of liability, whether in contract,--- strict liability, or tort (including negligence or otherwise) arising in--- any way out of the use of this software, even if advised of the--- possibility of such damage.+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS “AS IS” AND ANY+-- EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED+-- WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+-- DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE FOR ANY+-- DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+-- DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS+-- OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)+-- HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,+-- STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN+-- ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE+-- POSSIBILITY OF SUCH DAMAGE. module Main (main) where
tests/Perm.hs view
@@ -15,24 +15,21 @@ -- notice, this list of conditions and the following disclaimer in the -- documentation and/or other materials provided with the distribution. ----- This software is provided by the copyright holders "as is" and any--- express or implied warranties, including, but not limited to, the implied--- warranties of merchantability and fitness for a particular purpose are--- disclaimed. In no event shall the copyright holders be liable for any--- direct, indirect, incidental, special, exemplary, or consequential--- damages (including, but not limited to, procurement of substitute goods--- or services; loss of use, data, or profits; or business interruption)--- however caused and on any theory of liability, whether in contract,--- strict liability, or tort (including negligence or otherwise) arising in--- any way out of the use of this software, even if advised of the--- possibility of such damage.+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS “AS IS” AND ANY+-- EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED+-- WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+-- DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE FOR ANY+-- DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+-- DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS+-- OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)+-- HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,+-- STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN+-- ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE+-- POSSIBILITY OF SUCH DAMAGE. module Perm (tests) where import Control.Applicative-#if MIN_VERSION_base(4,7,0)-import Data.Bool (bool)-#endif import Data.List (nub, elemIndices) import Test.Framework@@ -43,16 +40,11 @@ import Text.Megaparsec.Perm import Util-#if !MIN_VERSION_base(4,7,0)-bool :: a -> a -> Bool -> a-bool f _ False = f-bool _ t True = t-#endif tests :: Test tests = testGroup "Permutation phrases parsers" [ testProperty "permutation parser pure" prop_pure- , testProperty "permutation test 0" prop_perm_0 ]+ , testProperty "permutation test 0" prop_perm_0 ] data CharRows = CharRows { getChars :: (Char, Char, Char)@@ -89,13 +81,13 @@ | length cis > 1 = posErr (cis !! 1) s $ [uneCh c] ++ [exCh a | a `notElem` prec] ++- [bool (exCh b) exEof (b `elem` prec)]+ [if b `elem` prec then exEof else exCh b] | b `notElem` s = posErr (length s) s $ [uneEof, exCh b] ++ [exCh a | a `notElem` s || last s == a] ++ [exCh c | c `notElem` s]- | otherwise = Right ( bool a' (filter (== a) s) (a `elem` s)+ | otherwise = Right ( if a `elem` s then filter (== a) s else a' , b- , bool c' c (c `elem` s) )+ , if c `elem` s then c else c' ) bis = elemIndices b s preb = take (bis !! 1) s cis = elemIndices c s
tests/Pos.hs view
@@ -15,22 +15,23 @@ -- notice, this list of conditions and the following disclaimer in the -- documentation and/or other materials provided with the distribution. ----- This software is provided by the copyright holders "as is" and any--- express or implied warranties, including, but not limited to, the implied--- warranties of merchantability and fitness for a particular purpose are--- disclaimed. In no event shall the copyright holders be liable for any--- direct, indirect, incidental, special, exemplary, or consequential--- damages (including, but not limited to, procurement of substitute goods--- or services; loss of use, data, or profits; or business interruption)--- however caused and on any theory of liability, whether in contract,--- strict liability, or tort (including negligence or otherwise) arising in--- any way out of the use of this software, even if advised of the--- possibility of such damage.+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS “AS IS” AND ANY+-- EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED+-- WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+-- DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE FOR ANY+-- DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+-- DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS+-- OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)+-- HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,+-- STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN+-- ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE+-- POSSIBILITY OF SUCH DAMAGE. {-# OPTIONS -fno-warn-orphans #-} module Pos (tests) where +import Control.Exception (try, evaluate) import Data.Char (isAlphaNum) import Data.List (intercalate, isInfixOf, elemIndices) @@ -46,20 +47,21 @@ tests :: Test tests = testGroup "Textual source positions"- [ testProperty "components" prop_components+ [ testProperty "components" prop_components+ , testProperty "exception on invalid position" prop_exception , testProperty "show file name in source positions" prop_showFileName- , testProperty "show line in source positions" prop_showLine- , testProperty "show column in source positions" prop_showColumn- , testProperty "initial position" prop_initialPos- , testProperty "increment source line" prop_incSourceLine- , testProperty "increment source column" prop_incSourceColumn- , testProperty "set source name" prop_setSourceName- , testProperty "set source line" prop_setSourceLine- , testProperty "set source column" prop_setSourceColumn- , testProperty "position updating" prop_updating ]+ , testProperty "show line in source positions" prop_showLine+ , testProperty "show column in source positions" prop_showColumn+ , testProperty "initial position" prop_initialPos+ , testProperty "increment source line" prop_incSourceLine+ , testProperty "increment source column" prop_incSourceColumn+ , testProperty "set source name" prop_setSourceName+ , testProperty "set source line" prop_setSourceLine+ , testProperty "set source column" prop_setSourceColumn+ , testProperty "position updating" prop_updating ] instance Arbitrary SourcePos where- arbitrary = newPos <$> fileName <*> choose (1, 1000) <*> choose (0, 100)+ arbitrary = newPos <$> fileName <*> choose (1, 1000) <*> choose (1, 100) fileName :: Gen String fileName = do@@ -74,6 +76,13 @@ prop_components pos = pos == copy where copy = newPos (sourceName pos) (sourceLine pos) (sourceColumn pos) +prop_exception :: String -> Int -> Int -> Property+prop_exception file l c = ioProperty $ do+ result <- try . evaluate $ newPos file l c+ return $ r === result+ where r | l < 1 || c < 1 = Left $ InvalidTextualPosition file l c+ | otherwise = Right $ newPos file l c+ prop_showFileName :: SourcePos -> Bool prop_showFileName pos = sourceName pos `isInfixOf` show pos @@ -91,20 +100,20 @@ where ipos = initialPos n prop_incSourceLine :: SourcePos -> NonNegative Int -> Bool-prop_incSourceLine pos l =- d sourceName id pos incp &&- d sourceLine (+ l') pos incp &&- d sourceColumn id pos incp- where l' = getNonNegative l- incp = incSourceLine pos l'+prop_incSourceLine pos l' =+ d sourceName id pos incp &&+ d sourceLine (+ l) pos incp &&+ d sourceColumn id pos incp+ where l = getNonNegative l'+ incp = incSourceLine pos l prop_incSourceColumn :: SourcePos -> NonNegative Int -> Bool-prop_incSourceColumn pos c =- d sourceName id pos incp &&- d sourceLine id pos incp &&- d sourceColumn (+ c') pos incp- where c' = getNonNegative c- incp = incSourceColumn pos c'+prop_incSourceColumn pos c' =+ d sourceName id pos incp &&+ d sourceLine id pos incp &&+ d sourceColumn (+ c) pos incp+ where c = getNonNegative c'+ incp = incSourceColumn pos c prop_setSourceName :: SourcePos -> String -> Bool prop_setSourceName pos n =@@ -114,20 +123,20 @@ where setp = setSourceName pos n prop_setSourceLine :: SourcePos -> Positive Int -> Bool-prop_setSourceLine pos l =- d sourceName id pos setp &&- d sourceLine (const l') pos setp &&- d sourceColumn id pos setp- where l' = getPositive l- setp = setSourceLine pos l'+prop_setSourceLine pos l' =+ d sourceName id pos setp &&+ d sourceLine (const l) pos setp &&+ d sourceColumn id pos setp+ where l = getPositive l'+ setp = setSourceLine pos l -prop_setSourceColumn :: SourcePos -> NonNegative Int -> Bool-prop_setSourceColumn pos c =- d sourceName id pos setp &&- d sourceLine id pos setp &&- d sourceColumn (const c') pos setp- where c' = getNonNegative c- setp = setSourceColumn pos c'+prop_setSourceColumn :: SourcePos -> Positive Int -> Bool+prop_setSourceColumn pos c' =+ d sourceName id pos setp &&+ d sourceLine id pos setp &&+ d sourceColumn (const c) pos setp+ where c = getPositive c'+ setp = setSourceColumn pos c prop_updating :: Int -> SourcePos -> String -> Bool prop_updating w pos "" = updatePosString w pos "" == pos
tests/Prim.hs view
@@ -15,31 +15,31 @@ -- notice, this list of conditions and the following disclaimer in the -- documentation and/or other materials provided with the distribution. ----- This software is provided by the copyright holders "as is" and any--- express or implied warranties, including, but not limited to, the implied--- warranties of merchantability and fitness for a particular purpose are--- disclaimed. In no event shall the copyright holders be liable for any--- direct, indirect, incidental, special, exemplary, or consequential--- damages (including, but not limited to, procurement of substitute goods--- or services; loss of use, data, or profits; or business interruption)--- however caused and on any theory of liability, whether in contract,--- strict liability, or tort (including negligence or otherwise) arising in--- any way out of the use of this software, even if advised of the--- possibility of such damage.+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS “AS IS” AND ANY+-- EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED+-- WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+-- DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE FOR ANY+-- DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+-- DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS+-- OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)+-- HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,+-- STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN+-- ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE+-- POSSIBILITY OF SUCH DAMAGE. {-# OPTIONS -fno-warn-orphans #-} module Prim (tests) where import Control.Applicative-#if MIN_VERSION_base(4,7,0)-import Data.Bool (bool)-#endif import Data.Char (isLetter, toUpper) import Data.Foldable (asum) import Data.List (isPrefixOf) import Data.Maybe (maybeToList, fromMaybe) +import Control.Monad.Cont+import Control.Monad.Except+import Control.Monad.Identity import Control.Monad.Reader import Control.Monad.Trans.Identity import qualified Control.Monad.State.Lazy as L@@ -52,64 +52,73 @@ import Test.QuickCheck hiding (label) import Text.Megaparsec.Char-import Text.Megaparsec.Error (Message (..))+import Text.Megaparsec.Error (Message (..), ParseError, newErrorMessages) import Text.Megaparsec.Pos import Text.Megaparsec.Prim import Text.Megaparsec.String import Pos ()+import Error () import Util-#if !MIN_VERSION_base(4,7,0)-bool :: a -> a -> Bool -> a-bool f _ False = f-bool _ t True = t-#endif tests :: Test tests = testGroup "Primitive parser combinators"- [ testProperty "ParsecT functor" prop_functor- , testProperty "ParsecT applicative (<*>)" prop_applicative_0- , testProperty "ParsecT applicative (*>)" prop_applicative_1- , testProperty "ParsecT applicative (<*)" prop_applicative_2+ [ testProperty "ParsecT functor" prop_functor+ , testProperty "ParsecT applicative (<*>)" prop_applicative_0+ , testProperty "ParsecT applicative (*>)" prop_applicative_1+ , testProperty "ParsecT applicative (<*)" prop_applicative_2 , testProperty "ParsecT alternative empty and (<|>)" prop_alternative_0- , testProperty "ParsecT alternative (<|>)" prop_alternative_1- , testProperty "ParsecT alternative (<|>) pos" prop_alternative_2- , testProperty "ParsecT alternative (<|>) hints" prop_alternative_3- , testProperty "ParsecT alternative many" prop_alternative_4- , testProperty "ParsecT alternative some" prop_alternative_5- , testProperty "ParsecT alternative optional" prop_alternative_6- , testProperty "ParsecT monad return" prop_monad_0- , testProperty "ParsecT monad (>>)" prop_monad_1- , testProperty "ParsecT monad (>>=)" prop_monad_2- , testProperty "ParsecT monad fail" prop_monad_3- , testProperty "combinator unexpected" prop_unexpected- , testProperty "combinator label" prop_label- , testProperty "combinator hidden hints" prop_hidden_0- , testProperty "combinator hidden error" prop_hidden_1- , testProperty "combinator try" prop_try- , testProperty "combinator lookAhead" prop_lookAhead_0- , testProperty "combinator lookAhead hints" prop_lookAhead_1- , testProperty "combinator lookAhead messages" prop_lookAhead_2- , testProperty "combinator notFollowedBy" prop_notFollowedBy_0+ , testProperty "ParsecT alternative (<|>)" prop_alternative_1+ , testProperty "ParsecT alternative (<|>) pos" prop_alternative_2+ , testProperty "ParsecT alternative (<|>) hints" prop_alternative_3+ , testProperty "ParsecT alternative many" prop_alternative_4+ , testProperty "ParsecT alternative some" prop_alternative_5+ , testProperty "ParsecT alternative optional" prop_alternative_6+ , testProperty "ParsecT monad return" prop_monad_0+ , testProperty "ParsecT monad (>>)" prop_monad_1+ , testProperty "ParsecT monad (>>=)" prop_monad_2+ , testProperty "ParsecT monad fail" prop_monad_3+ , testProperty "ParsecT monad laws: left identity" prop_monad_left_id+ , testProperty "ParsecT monad laws: right identity" prop_monad_right_id+ , testProperty "ParsecT monad laws: associativity" prop_monad_assoc+ , testProperty "ParsecT monad reader ask" prop_monad_reader_ask+ , testProperty "ParsecT monad reader local" prop_monad_reader_local+ , testProperty "ParsecT monad state get" prop_monad_state_get+ , testProperty "ParsecT monad state put" prop_monad_state_put+ , testProperty "ParsecT monad cont" prop_monad_cont+ , testProperty "ParsecT monad error: throw" prop_monad_error_throw+ , testProperty "ParsecT monad error: catch" prop_monad_error_catch+ , testProperty "combinator unexpected" prop_unexpected+ , testProperty "combinator failure" prop_failure+ , testProperty "combinator label" prop_label+ , testProperty "combinator hidden hints" prop_hidden_0+ , testProperty "combinator hidden error" prop_hidden_1+ , testProperty "combinator try" prop_try+ , testProperty "combinator lookAhead" prop_lookAhead_0+ , testProperty "combinator lookAhead hints" prop_lookAhead_1+ , testProperty "combinator lookAhead messages" prop_lookAhead_2+ , testProperty "combinator notFollowedBy" prop_notFollowedBy_0 , testProperty "combinator notFollowedBy twice" prop_notFollowedBy_1- , testProperty "combinator notFollowedBy eof" prop_notFollowedBy_2- , testProperty "combinator token" prop_token- , testProperty "combinator tokens" prop_tokens- , testProperty "parser state position" prop_state_pos- , testProperty "parser state input" prop_state_input- , testProperty "parser state tab width" prop_state_tab- , testProperty "parser state general" prop_state- , testProperty "IdentityT try" prop_IdentityT_try- , testProperty "IdentityT notFollowedBy" prop_IdentityT_notFollowedBy- , testProperty "ReaderT try" prop_ReaderT_try- , testProperty "ReaderT notFollowedBy" prop_ReaderT_notFollowedBy+ , testProperty "combinator notFollowedBy eof" prop_notFollowedBy_2+ , testProperty "combinator token" prop_token+ , testProperty "combinator tokens" prop_tokens+ , testProperty "parser state position" prop_state_pos+ , testProperty "parser state input" prop_state_input+ , testProperty "parser state tab width" prop_state_tab+ , testProperty "parser state general" prop_state+ , testProperty "custom state parsing" prop_runParser'+ , testProperty "custom state parsing (transformer)" prop_runParserT'+ , testProperty "IdentityT try" prop_IdentityT_try+ , testProperty "IdentityT notFollowedBy" prop_IdentityT_notFollowedBy+ , testProperty "ReaderT try" prop_ReaderT_try+ , testProperty "ReaderT notFollowedBy" prop_ReaderT_notFollowedBy , testProperty "StateT alternative (<|>)" prop_StateT_alternative- , testProperty "StateT lookAhead" prop_StateT_lookAhead- , testProperty "StateT notFollowedBy" prop_StateT_notFollowedBy- , testProperty "WriterT" prop_WriterT ]+ , testProperty "StateT lookAhead" prop_StateT_lookAhead+ , testProperty "StateT notFollowedBy" prop_StateT_notFollowedBy+ , testProperty "WriterT" prop_WriterT ] instance Arbitrary (State String) where- arbitrary = State <$> arbitrary <*> arbitrary <*> arbitrary+ arbitrary = State <$> arbitrary <*> arbitrary <*> choose (1, 20) -- Functor instance @@ -218,33 +227,82 @@ | otherwise = posErr 0 s [msg m] s = "" --- TODO MonadReader instance of ParsecT+prop_monad_left_id :: Integer -> Integer -> Property+prop_monad_left_id a b = (return a >>= f) !=! (f a)+ where f x = return $ x + b --- TODO MonadState instance of ParsecT+prop_monad_right_id :: Integer -> Property+prop_monad_right_id a = (m >>= return) !=! m+ where m = return a --- TODO MonadCont instance of ParsecT+prop_monad_assoc :: Integer -> Integer -> Integer -> Property+prop_monad_assoc a b c = ((m >>= f) >>= g) !=! (m >>= (\x -> f x >>= g))+ where m = return a+ f x = return $ x + b+ g x = return $ x + c --- TODO MonadError instance of ParsecT+-- MonadReader instance +prop_monad_reader_ask :: Integer -> Property+prop_monad_reader_ask a = runReader (runParserT ask "" "") a === Right a++prop_monad_reader_local :: Integer -> Integer -> Property+prop_monad_reader_local a b = runReader (runParserT p "" "") a === Right (a + b)+ where p = local (+ b) ask++-- MonadState instance++prop_monad_state_get :: Integer -> Property+prop_monad_state_get a = L.evalState (runParserT L.get "" "") a === Right a++prop_monad_state_put :: Integer -> Integer -> Property+prop_monad_state_put a b = L.execState (runParserT (L.put b) "" "") a === b++-- MonadCont instance++prop_monad_cont :: Integer -> Integer -> Property+prop_monad_cont a b = runCont (runParserT p "" "") id === Right (max a b)+ where p = do x <- callCC $ \e -> when (a > b) (e a) >> return b+ return x++-- MonadError instance++prop_monad_error_throw :: Integer -> Integer -> Property+prop_monad_error_throw a b = runExcept (runParserT p "" "") === Left a+ where p = throwError a >> return b++prop_monad_error_catch :: Integer -> Integer -> Property+prop_monad_error_catch a b =+ runExcept (runParserT p "" "") === Right (Right $ a + b)+ where p = (throwError a >> return b) `catchError` handler+ handler e = return $ e + b+ -- Primitive combinators prop_unexpected :: String -> Property-prop_unexpected m = conjoin [ checkParser p r s+prop_unexpected m = checkParser p r s+ where p = unexpected m :: Parser ()+ r | null m = posErr 0 s []+ | otherwise = posErr 0 s [uneSpec m]+ s = ""++prop_failure :: [Message] -> Property+prop_failure msgs = conjoin [ checkParser p r s , checkParser (runIdentityT p_IdentityT) r s , checkParser (runReaderT p_ReaderT ()) r s , checkParser (L.evalStateT p_lStateT ()) r s , checkParser (S.evalStateT p_sStateT ()) r s , checkParser (L.runWriterT p_lWriterT) r s , checkParser (S.runWriterT p_sWriterT) r s ]- where p = unexpected m :: Parser ()- p_IdentityT = unexpected m :: IdentityT Parser ()- p_ReaderT = unexpected m :: ReaderT () Parser ()- p_lStateT = unexpected m :: L.StateT () Parser ()- p_sStateT = unexpected m :: S.StateT () Parser ()- p_lWriterT = unexpected m :: L.WriterT [Integer] Parser ()- p_sWriterT = unexpected m :: S.WriterT [Integer] Parser ()- r | null m = posErr 0 s []- | otherwise = posErr 0 s [uneSpec m]+ where p = failure msgs :: Parser ()+ p_IdentityT = failure msgs :: IdentityT Parser ()+ p_ReaderT = failure msgs :: ReaderT () Parser ()+ p_lStateT = failure msgs :: L.StateT () Parser ()+ p_sStateT = failure msgs :: S.StateT () Parser ()+ p_lWriterT = failure msgs :: L.WriterT [Integer] Parser ()+ p_sWriterT = failure msgs :: S.WriterT [Integer] Parser ()+ r | null msgs = posErr 0 s []+ | otherwise = Left $ newErrorMessages msgs (initialPos "") s = "" prop_label :: NonNegative Int -> NonNegative Int@@ -287,8 +345,8 @@ s2 = pre ++ s2' p = try (string s1) <|> string s2 r | s == s1 || s == s2 = Right s- | otherwise = posErr 0 s $ bool [uneStr pre] [uneEof] (null s)- ++ [uneStr pre, exStr s1, exStr s2]+ | otherwise = posErr 0 s $ (if null s then uneEof else uneStr pre)+ : [uneStr pre, exStr s1, exStr s2] s = pre prop_lookAhead_0 :: Bool -> Bool -> Bool -> Property@@ -400,6 +458,28 @@ updateParserState (f s2) getParserState +-- Running a parser++prop_runParser' :: State String -> String -> Property+prop_runParser' st s = runParser' p st === r+ where p = string s+ r = emulateStrParsing st s++prop_runParserT' :: State String -> String -> Property+prop_runParserT' st s = runIdentity (runParserT' p st) === r+ where p = string s+ r = emulateStrParsing st s++emulateStrParsing :: State String+ -> String+ -> (State String, Either ParseError String)+emulateStrParsing st@(State i pos t) s =+ if l == length s+ then (State (drop l i) (updatePosString t pos s) t, Right s)+ else let uneStuff = if null i then uneEof else uneStr (take (l + 1) i)+ in (st, Left $ newErrorMessages (exStr s : [uneStuff]) pos)+ where l = length $ takeWhile id $ zipWith (==) s i+ -- IdentityT instance of MonadParsec prop_IdentityT_try :: String -> String -> String -> Property@@ -408,8 +488,8 @@ s2 = pre ++ s2' p = try (string s1) <|> string s2 r | s == s1 || s == s2 = Right s- | otherwise = posErr 0 s $ bool [uneStr pre] [uneEof] (null s)- ++ [uneStr pre, exStr s1, exStr s2]+ | otherwise = posErr 0 s $ (if null s then uneEof else uneStr pre)+ : [uneStr pre, exStr s1, exStr s2] s = pre prop_IdentityT_notFollowedBy :: NonNegative Int -> NonNegative Int@@ -431,8 +511,8 @@ getS2 = asks ((pre ++) . snd) p = try (string =<< getS1) <|> (string =<< getS2) r | s == s1 || s == s2 = Right s- | otherwise = posErr 0 s $ bool [uneStr pre] [uneEof] (null s)- ++ [uneStr pre, exStr s1, exStr s2]+ | otherwise = posErr 0 s $ (if null s then uneEof else uneStr pre)+ : [uneStr pre, exStr s1, exStr s2] s = pre prop_ReaderT_notFollowedBy :: NonNegative Int -> NonNegative Int@@ -447,16 +527,18 @@ -- StateT instance of MonadParsec prop_StateT_alternative :: Integer -> Property-prop_StateT_alternative n = checkParser (L.evalStateT p 0) (Right n) "" .&&.- checkParser (S.evalStateT p' 0) (Right n) ""+prop_StateT_alternative n =+ checkParser (L.evalStateT p 0) (Right n) "" .&&.+ checkParser (S.evalStateT p' 0) (Right n) "" where p = L.put n >> ((L.modify (* 2) >> void (string "xxx")) <|> return ()) >> L.get p' = S.put n >> ((S.modify (* 2) >> void (string "xxx")) <|> return ()) >> S.get prop_StateT_lookAhead :: Integer -> Property-prop_StateT_lookAhead n = checkParser (L.evalStateT p 0) (Right n) "" .&&.- checkParser (S.evalStateT p' 0) (Right n) ""+prop_StateT_lookAhead n =+ checkParser (L.evalStateT p 0) (Right n) "" .&&.+ checkParser (S.evalStateT p' 0) (Right n) "" where p = L.put n >> lookAhead (L.modify (* 2) >> eof) >> L.get p' = S.put n >> lookAhead (S.modify (* 2) >> eof) >> S.get @@ -476,8 +558,9 @@ -- WriterT instance of MonadParsec prop_WriterT :: String -> String -> Property-prop_WriterT pre post = checkParser (L.runWriterT p) r "abx" .&&.- checkParser (S.runWriterT p') r "abx"+prop_WriterT pre post =+ checkParser (L.runWriterT p) r "abx" .&&.+ checkParser (S.runWriterT p') r "abx" where logged_letter = letterChar >>= \x -> L.tell [x] >> return x logged_letter' = letterChar >>= \x -> L.tell [x] >> return x logged_eof = eof >> L.tell "EOF"
tests/Util.hs view
@@ -15,17 +15,17 @@ -- notice, this list of conditions and the following disclaimer in the -- documentation and/or other materials provided with the distribution. ----- This software is provided by the copyright holders "as is" and any--- express or implied warranties, including, but not limited to, the implied--- warranties of merchantability and fitness for a particular purpose are--- disclaimed. In no event shall the copyright holders be liable for any--- direct, indirect, incidental, special, exemplary, or consequential--- damages (including, but not limited to, procurement of substitute goods--- or services; loss of use, data, or profits; or business interruption)--- however caused and on any theory of liability, whether in contract,--- strict liability, or tort (including negligence or otherwise) arising in--- any way out of the use of this software, even if advised of the--- possibility of such damage.+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS “AS IS” AND ANY+-- EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED+-- WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+-- DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE FOR ANY+-- DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+-- DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS+-- OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)+-- HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,+-- STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN+-- ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE+-- POSSIBILITY OF SUCH DAMAGE. module Util ( checkParser@@ -33,6 +33,7 @@ , checkChar , checkString , (/=\)+ , (!=!) , abcRow , abcRow' , posErr@@ -118,6 +119,15 @@ (/=\) :: (Eq a, Show a) => Parser a -> a -> Property p /=\ x = simpleParse p "" === Right x++infix 4 !=!++-- | @n !=! m@ represents property that holds when results of running @n@+-- and @m@ parsers are identical. This is useful when checking monad laws+-- for example.++(!=!) :: (Eq a, Show a) => Parser a -> Parser a -> Property+n !=! m = simpleParse n "" === simpleParse m "" -- | @abcRow a b c@ generates string consisting of character “a” repeated -- @a@ times, character “b” repeated @b@ times, and finally character “c”