diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,142 @@ *Megaparsec follows [SemVer](https://semver.org/).* +## Megaparsec 9.8.2 + +* Fixed tab expansion in the rendering of the offending line so that it + takes into account the display width of the preceding characters. + Previously a tab that followed a wide or zero-width character was expanded + to the wrong number of spaces, which made the position marker `^` + misaligned or missing. +* Fixed the regression introduced by the fix for the [issue + 412](https://github.com/mrkkrp/megaparsec/issues/412) which caused `(<|>)` + to report a parse error at the position where the alternation started even + when both of its branches had failed ahead of that position (which can + happen because of `try`). Such an error mentioned a position that did not + correspond to the unexpected item it reported and lost all expected items. + In that case the longest match is now preferred again. +* Fixed `takeP` reporting that it had consumed input when asked to take zero + (or a negative number of) tokens. Since it consumes nothing in that case, + it now signals that fact, so that e.g. the second branch of `(<|>)` is + still tried after it. +* Fixed column calculation for `ByteString` streams (strict and lazy) so + that it agrees with the way the offending line is rendered. Previously the + byte `0xad` was counted as one column even though it is displayed as a + zero-width soft hyphen, which could shift the position marker `^` or make + it disappear altogether. +* Updated the character width data used by `Text.Megaparsec.Unicode` to + Unicode 17.0.0. The previous data was extracted from Unicode 12.0.0 and + was moreover incomplete: it did not know about the CJK ideograph + extensions G through I, about any of the emoji added since, or about most + combining marks, including all of the variation selectors and everything + outside of the Latin, Cyrillic, Hebrew, and Arabic scripts. As a result + the position marker `^` did not line up with the offending line for input + containing such characters. +* `isWideChar` now returns `False` for the few characters that are Wide + according to their East Asian Width but are also combining marks, such as + `U+302A`. They occupy no columns of their own, which `charLength` and + `isZeroWidthChar` already reported. +* The position marker `^` is no longer omitted when the offending line turns + out to be shorter than the column of the parse error. + +## Megaparsec 9.8.1 + +* Fixed the regression introduced by the fix for the [issue + 572](https://github.com/mrkkrp/megaparsec/issues/572) which caused the + position marker `^` to be missing in certain cases. +* This release officially supports GHC 9.6. This is the oldest GHC version + we support at this time. + +## Megaparsec 9.8.0 + +* Fixed the associativity of the `(<|>)` operator. [Issue + 412](https://github.com/mrkkrp/megaparsec/issues/412). +* Fixed the loss of precision in `decimal`, `binary`, `octal`, and + `hexadecimal` functions in `Text.Megaparsec.Byte.Lexer` and + `Text.Megaparsec.Char.Lexer` when they are used to parse floating point + numbers. [Issue 479](https://github.com/mrkkrp/megaparsec/issues/479). +* Fixed handling of zero-width characters in error messages. To that end, + added `isZeroWidthChar` function in `Text.Megaparsec.Unicode`. [Issue + 572](https://github.com/mrkkrp/megaparsec/issues/572). + +## Megaparsec 9.7.1 + +* Typo fixes and compatibility with `QuickCheck >= 2.17` for + `megaparsec-tests`. + +## Megaparsec 9.7.0 + +* Implemented correct handling of wide Unicode characters in error messages. + To that end, a new module `Text.Megaparsec.Unicode` was introduced. [Issue + 370](https://github.com/mrkkrp/megaparsec/issues/370). +* Inlined `Applicative` operators `(<*)` and `(*>)`. [PR + 566](https://github.com/mrkkrp/megaparsec/pull/566). +* `many` and `some` of the `Alternative` instance of `ParsecT` are now more + efficient, since they use the monadic implementations under the hood. + [Issue 567](https://github.com/mrkkrp/megaparsec/issues/567). +* Added `Text.Megaparsec.Error.errorBundlePrettyForGhcPreProcessors`. [PR + 573](https://github.com/mrkkrp/megaparsec/pull/573). + +## Megaparsec 9.6.1 + +* Exposed `Text.Megaparsec.State`, so that the new functions (`initialState` + and `initialPosState`) can be actually imported from it. [PR + 549](https://github.com/mrkkrp/megaparsec/pull/549). + +## Megaparsec 9.6.0 + +* Added the functions `initialState` and `initialPosState` to + `Text.Megaparsec.State`. [Issue + 449](https://github.com/mrkkrp/megaparsec/issues/449). + +## Megaparsec 9.5.0 + +* Dropped a number of redundant constraints here and there. [PR + 523](https://github.com/mrkkrp/megaparsec/pull/523). + +* Added a `MonadWriter` instance for `ParsecT`. [PR + 534](https://github.com/mrkkrp/megaparsec/pull/534). + +## Megaparsec 9.4.1 + +* Removed `Monad m` constraints in several places where they were introduced + in 9.4.0. [Issue 532](https://github.com/mrkkrp/megaparsec/issues/532). + +## Megaparsec 9.4.0 + +* `dbg` now prints hints among other debug information. [PR + 530](https://github.com/mrkkrp/megaparsec/pull/530). + +* Hints are no longer lost in certain methods of MTL instances for + `ParsecT`. [Issue 528](https://github.com/mrkkrp/megaparsec/issues/528). + +* Added a new method to the `MonadParsec` type class—`mkParsec`. This can be + used to construct “new primitives” with arbitrary behavior at the expense + of having to dive into Megaparsec's internals. [PR + 514](https://github.com/mrkkrp/megaparsec/pull/514). + +## Megaparsec 9.3.1 + +* Fixed a bug related to processing of tabs when error messages are + rendered. [Issue 524](https://github.com/mrkkrp/megaparsec/issues/524). + +## Megaparsec 9.3.0 + +* Now `label` can override more than one group of hints in the parser it + wraps. [Issue 482](https://github.com/mrkkrp/megaparsec/issues/482). + +* `takeP n` now returns the empty chunk of the input stream when `n` is + negative, similar to when `n == 0`. [Issue + 497](https://github.com/mrkkrp/megaparsec/issues/497). + +* Added the `MonadParsecDbg` type class in `Text.Megaparsec.Debug`. The type + class allows us to use `dbg` in MTL monad transformers. [Issue + 488](https://github.com/mrkkrp/megaparsec/issues/488). + +* Introduced the `ShareInput` and `NoShareInput` newtype wrappers in + `Text.Megaparsec.Stream` in order to allow the user to choose how the + input should be sliced and shared during the parsing. [Issue + 492](https://github.com/mrkkrp/megaparsec/issues/492). + ## Megaparsec 9.2.2 * Fixed a space leak in the implementations of the `reachOffset` and diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -4,7 +4,7 @@ [![Hackage](https://img.shields.io/hackage/v/megaparsec.svg?style=flat)](https://hackage.haskell.org/package/megaparsec) [![Stackage Nightly](http://stackage.org/package/megaparsec/badge/nightly)](http://stackage.org/nightly/package/megaparsec) [![Stackage LTS](http://stackage.org/package/megaparsec/badge/lts)](http://stackage.org/lts/package/megaparsec) -![CI](https://github.com/mrkkrp/megaparsec/workflows/CI/badge.svg?branch=master) +[![CI](https://github.com/mrkkrp/megaparsec/actions/workflows/ci.yaml/badge.svg)](https://github.com/mrkkrp/megaparsec/actions/workflows/ci.yaml) * [Features](#features) * [Core features](#core-features) @@ -20,6 +20,7 @@ * [Megaparsec vs Parsec](#megaparsec-vs-parsec) * [Megaparsec vs Trifecta](#megaparsec-vs-trifecta) * [Megaparsec vs Earley](#megaparsec-vs-earley) + * [Megaparsec vs Flatparse](#megaparsec-vs-flatparse) * [Related packages](#related-packages) * [Prominent projects that use Megaparsec](#prominent-projects-that-use-megaparsec) * [Links to announcements and blog posts](#links-to-announcements-and-blog-posts) @@ -27,56 +28,55 @@ * [License](#license) This is an industrial-strength monadic parser combinator library. Megaparsec -is a feature-rich package that tries to find a nice balance between speed, -flexibility, and quality of parse errors. +is a feature-rich package that strikes a nice balance between speed, +flexibility, and the quality of parse errors. ## Features -The project provides flexible solutions to satisfy common parsing needs. The -section describes them shortly. If you're looking for comprehensive +The project provides flexible solutions for common parsing needs. This +section describes them briefly. If you're looking for comprehensive documentation, see the [section about documentation](#documentation). ### Core features -The package is built around `MonadParsec`, an MTL-style monad transformer. -Most features work with all instances of `MonadParsec`. One can achieve -various effects combining monad transformers, i.e. building a monadic stack. -Since the common monad transformers like `WriterT`, `StateT`, `ReaderT` and -others are instances of the `MonadParsec` type class, one can also wrap -`ParsecT` *in* these monads, achieving, for example, backtracking state. +The package is built around `MonadParsec`, an MTL-style type class. Most +features work with all instances of `MonadParsec`. You can achieve various +effects by combining monad transformers, i.e. by building a monadic stack. +Since the common monad transformers like `WriterT`, `StateT`, and `ReaderT` +are instances of the `MonadParsec` type class, you can also wrap `ParsecT` +*in* these monads, achieving, for example, backtracking state. -On the other hand `ParsecT` is an instance of many type classes as well. The -most useful ones are `Monad`, `Applicative`, `Alternative`, and -`MonadParsec`. +`ParsecT` is also an instance of many type classes itself. The most useful +ones are `Monad`, `Applicative`, `Alternative`, and `MonadParsec`. Megaparsec includes all functionality that is typically available in Parsec-like libraries and also features some special combinators: * `parseError` allows us to end parsing and report an arbitrary parse error. -* `withRecovery` can be used to recover from parse errors “on-the-fly” and - continue parsing. Once parsing is finished, several parse errors may be - reported or ignored altogether. +* `withRecovery` can be used to recover from parse errors “on the fly” and + continue parsing. Once parsing is finished, the collected parse errors may + be reported or ignored altogether. * `observing` makes it possible to “observe” parse errors without ending parsing. -In addition to that, Megaparsec features high-performance combinators -similar to those found in [Attoparsec][attoparsec]: +In addition, Megaparsec features high-performance combinators similar to +those found in [Attoparsec][attoparsec]: * `tokens` makes it easy to parse several tokens in a row (`string` and - `string'` are built on top of this primitive). This is about 100 times - faster than matching a string token by token. `tokens` returns “chunk” of - original input, meaning that if you parse `Text`, it'll return `Text` - without repacking. -* `takeWhile` and `takeWhile1` are about 150 times faster than approaches - involving `many`, `manyTill` and other similar combinators. -* `takeP` allows us to grab n tokens from the stream and returns them as a + `string'` are built on top of this primitive). It is about 100 times + faster than matching a string token by token. `tokens` returns a “chunk” + of the original input, meaning that if you parse `Text`, it'll return + `Text` without repacking. +* `takeWhileP` and `takeWhile1P` are about 150 times faster than approaches + involving `many`, `manyTill`, and other similar combinators. +* `takeP` allows us to grab `n` tokens from the stream and returns them as a “chunk” of the stream. Megaparsec is about as fast as Attoparsec if you write your parser carefully (see also [the section about performance](#performance)). The library can currently work with the following types of input stream -out-of-the-box: +out of the box: * `String = [Char]` * `ByteString` (strict and lazy) @@ -90,20 +90,19 @@ * Megaparsec has typed error messages and the ability to signal custom parse errors that better suit the user's domain of interest. -* Since version 8, the location of parse errors can independent of current - offset in the input stream. It is useful when you want a parse error to - point to a particular position after performing some checks. +* The location of a parse error can be independent of the current offset in + the input stream. This is useful when you want a parse error to point to a + particular position after performing some checks. -* Instead of a single parse error Megaparsec produces so-called - `ParseErrorBundle` data type that helps to manage multi-error messages and - pretty-print them. Since version 8, reporting multiple parse errors at - once has become easier. +* Instead of a single parse error, Megaparsec produces a `ParseErrorBundle` + data type that helps manage multi-error messages and pretty-print them, + making it easy to report multiple parse errors at once. ### External lexers Megaparsec works well with streams of tokens produced by tools like Alex. -The design of the `Stream` type class has been changed significantly in the -recent versions, but user can still work with custom streams of tokens. +The design of the `Stream` type class has changed significantly in recent +versions, but you can still work with custom streams of tokens. ### Character and binary parsing @@ -119,13 +118,13 @@ “fixes” its particularly inflexible `Text.Parsec.Token`. [`Text.Megaparsec.Char.Lexer`][tm-char-lexer] is intended to be imported -using a qualified import, it's not included in [`Text.Megaparsec`][tm]. 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. +qualified, and it's not included in [`Text.Megaparsec`][tm]. 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 the parsing of +white space, comments, and indentation. -The design of the module allows one quickly solve simple tasks and doesn't -get in the way when the need to implement something less standard arises. +The design of the module lets you solve simple tasks quickly and doesn't get +in the way when you need to implement something less standard. [`Text.Megaparsec.Byte.Lexer`][tm-byte-lexer] is also available for users who wish to parse binary data. @@ -138,8 +137,7 @@ ## Tutorials You can find the most complete Megaparsec tutorial [here][the-tutorial]. It -should provide sufficient guidance to help you start with your parsing -tasks. +should provide enough guidance to get you started with your parsing tasks. ## Performance @@ -170,38 +168,37 @@ ## 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. +There are quite a few libraries that can be used for parsing in Haskell. +Let's compare Megaparsec with some of them. ### Megaparsec vs Attoparsec [Attoparsec][attoparsec] is another prominent Haskell library for parsing. Although both libraries deal with parsing, it's usually easy to decide which -you will need in particular project: +one you need for a particular project: -* *Attoparsec* is sometimes faster but not that feature-rich. It should be - used when you want to process large amounts of data where performance - matters more than quality of error messages. +* *Attoparsec* is sometimes faster but not as feature-rich. It should be used + when you want to process large amounts of data and performance matters more + than the 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 a monad - transformer. +* *Megaparsec* is good for parsing source code or other human-readable text. + It has better error messages and is implemented as a monad transformer. -So, if you work with something human-readable where the size of input data -is moderate, it makes sense to go with Megaparsec, otherwise Attoparsec may -be a better choice. +In short, if you work with something human-readable where the size of the +input data is moderate, it makes sense to go with Megaparsec; otherwise +Attoparsec may be a better choice. ### Megaparsec vs Parsec Since Megaparsec is a fork of [Parsec][parsec], we are bound to list the main differences between the two libraries: -* Better error messages. Megaparsec has typed error messages and custom - error messages, it can also report multiple parse errors at once. +* Better error messages. Megaparsec has typed and custom error messages, and + it can also report multiple parse errors at once. -* Megaparsec can show the line on which parse error happened as part of - parse error. This makes it a lot easier to figure out where the error - happened. +* Megaparsec can include the line on which a parse error happened as part of + the parse error. This makes it a lot easier to figure out where the error + occurred. * Some quirks and bugs of Parsec are fixed. @@ -215,17 +212,16 @@ * Megaparsec can recover from parse errors “on the fly” and continue parsing. -* Megaparsec allows us to conditionally process parse errors inside a - running parser. In particular, it's possible to define regions in which - parse errors, should they happen, will get a “context tag”, e.g. we could - build a context stack like “in function definition foo”, “in expression - x”, etc. +* Megaparsec allows us to conditionally process parse errors inside a running + parser. In particular, it's possible to define regions in which parse + errors, should they happen, get a “context tag”. This lets us build a + context stack like “in function definition foo”, “in expression x”, etc. -* Megaparsec is faster and supports efficient operations `tokens`, - `takeWhileP`, `takeWhile1P`, `takeP`, like Attoparsec. +* Like Attoparsec, Megaparsec is faster and supports the efficient operations + `tokens`, `takeWhileP`, `takeWhile1P`, and `takeP`. -If you want to see a detailed change log, `CHANGELOG.md` may be helpful. -Also see [this original announcement][original-announcement] for another +If you want to see a detailed change log, `CHANGELOG.md` may be helpful. Also +see [this original announcement][original-announcement] for another comparison. ### Megaparsec vs Trifecta @@ -234,43 +230,67 @@ messages. These are the common reasons why Trifecta may be problematic to use: -* Complicated, doesn't have any tutorials available, and documentation +* It is complicated, has no tutorials available, and its documentation doesn't help much. * Trifecta can parse `String` and `ByteString` natively, but not `Text`. -* Depends on `lens`, which is a very heavy dependency. If you're not into +* It depends on `lens`, which is a very heavy dependency. If you're not into `lens`, you may not like the API. -[Idris][idris] has switched from Trifecta to Megaparsec which allowed it to +[Idris][idris] switched from Trifecta to Megaparsec, which allowed it to [have better error messages and fewer dependencies][idris-testimony]. ### Megaparsec vs Earley [Earley][earley] is a newer library that allows us to safely parse -context-free grammars (CFG). Megaparsec is a lower-level library compared to +context-free grammars (CFGs). Megaparsec is a lower-level library compared to Earley, but there are still enough reasons to choose it: * Megaparsec is faster. -* Your grammar may be not context-free or you may want introduce some sort - of state to the parsing process. Almost all non-trivial parsers require - state. Even if your grammar is context-free, state may allow for +* Your grammar may not be context-free, or you may want to introduce some + sort of state into the parsing process. Almost all non-trivial parsers + require state. Even if your grammar is context-free, state may allow for additional niceties. Earley does not support that. -* Megaparsec's error messages are more flexible allowing to include +* Megaparsec's error messages are more flexible, allowing you to include arbitrary data in them, return multiple error messages, mark regions that - affect any error that happens in those regions, etc. + affect any error that happens within them, etc. In other words, Megaparsec is less safe but also more powerful. +### Megaparsec vs Flatparse + +[Flatparse][flatparse] is a newer library that focuses squarely on raw +parsing speed. On microbenchmarks it can be several times faster than both +Megaparsec and Attoparsec, and it produces considerably smaller object code. +It achieves this by making a number of trade-offs: + +* Flatparse works only with strict `ByteString`. It does not support `Text`, + `String`, lazy input, or incremental parsing, whereas Megaparsec works with + all of these and with custom token streams via the `Stream` type class. + +* Flatparse provides only a low-level interface to error handling and source + positions. Megaparsec has typed, custom, and multi-error messages out of + the box, along with error recovery and context-tagged regions. + +* Flatparse distinguishes recoverable failures from unrecoverable errors and + leaves grammar and error propagation largely up to you, so it sits at a + lower level of abstraction than Megaparsec. + +In short, if you need the absolute best performance and are willing to work +at a lower level with `ByteString` only, Flatparse is worth a look. +Megaparsec is the better choice when you value error messages, flexibility, +and support for a variety of input streams. + ## Related packages The following packages are designed to be used with Megaparsec (open a PR if you want to add something to the list): * [`hspec-megaparsec`](https://hackage.haskell.org/package/hspec-megaparsec)—utilities - for testing Megaparsec parsers with with + for testing Megaparsec parsers with [Hspec](https://hackage.haskell.org/package/hspec). * [`replace-megaparsec`](https://hackage.haskell.org/package/replace-megaparsec)—Stream editing and find-and-replace with Megaparsec. @@ -281,12 +301,24 @@ library for easily using [TagSoup](https://hackage.haskell.org/package/tagsoup) as a token type in Megaparsec. +* [`parser-combinators`](https://hackage.haskell.org/package/parser-combinators)—provides permutation and expression parsers [previously bundled with Megaparsec](https://markkarpov.com/post/megaparsec-7.html#parsercombinators-grows-megaparsec-shrinks). +* [`faster-megaparsec`](https://hackage.haskell.org/package/faster-megaparsec)—speeds up parsing + by trying a simple `MonadParsec` instance and falling back to `ParsecT` to report errors. +* [`parsers-megaparsec`](https://hackage.haskell.org/package/parsers-megaparsec)—provides + instances of the [`parsers`](https://hackage.haskell.org/package/parsers) + type classes (`Parsing`, `CharParsing`, `LookAheadParsing`, and + `TokenParsing`) for Megaparsec. +* [`headed-megaparsec`](https://hackage.haskell.org/package/headed-megaparsec)—helps + produce more informative parsers by distinguishing a parser's “head” from + its “body”. +* [`htoml-megaparsec`](https://hackage.haskell.org/package/htoml-megaparsec)—a + parser for [TOML](https://toml.io) files built with Megaparsec. ## Prominent projects that use Megaparsec Some prominent projects that use Megaparsec: -* [Idris](https://github.com/idris-lang/Idris-dev)—a general-purpose +* [Idris](https://github.com/idris-lang/Idris2)—a general-purpose functional programming language with dependent types * [Dhall](https://github.com/dhall-lang/dhall-haskell)—an advanced configuration language @@ -298,8 +330,8 @@ ## Links to announcements and blog posts -Here are some blog posts mainly announcing new features of the project and -describing what sort of things are now possible: +Here are some blog posts, mainly announcing new features of the project and +describing what sort of things they make possible: * [Megaparsec 8](https://markkarpov.com/post/megaparsec-8.html) * [Megaparsec 7](https://markkarpov.com/post/megaparsec-7.html) @@ -312,8 +344,8 @@ ## Contribution -Issues (bugs, feature requests or otherwise feedback) may be reported in -[the GitHub issue tracker for this +Issues (bugs, feature requests, or other feedback) may be reported in [the +GitHub issue tracker for this project](https://github.com/mrkkrp/megaparsec/issues). Pull requests are also welcome. If you would like to contribute to the @@ -341,9 +373,8 @@ [parsec]: https://hackage.haskell.org/package/parsec [trifecta]: https://hackage.haskell.org/package/trifecta [earley]: https://hackage.haskell.org/package/Earley +[flatparse]: https://hackage.haskell.org/package/flatparse [idris]: https://www.idris-lang.org/ -[idris-testimony]: https://twitter.com/edwinbrady/status/950084043282010117?s=09 +[idris-testimony]: https://x.com/edwinbrady/status/950084043282010117 -[parsers-bench]: https://github.com/mrkkrp/parsers-bench -[fast-parser]: https://markkarpov.com/megaparsec/writing-a-fast-parser.html [original-announcement]: https://mail.haskell.org/pipermail/haskell-cafe/2015-September/121530.html diff --git a/Setup.hs b/Setup.hs deleted file mode 100644 --- a/Setup.hs +++ /dev/null @@ -1,6 +0,0 @@ -module Main (main) where - -import Distribution.Simple - -main :: IO () -main = defaultMain diff --git a/Text/Megaparsec.hs b/Text/Megaparsec.hs --- a/Text/Megaparsec.hs +++ b/Text/Megaparsec.hs @@ -23,8 +23,8 @@ -- at the tutorial . -- -- In addition to the "Text.Megaparsec" module, which exports and re-exports --- almost everything that you may need, we advise to import --- "Text.Megaparsec.Char" if you plan to work with a stream of 'Char' tokens +-- almost everything that you may need, we advise importing +-- "Text.Megaparsec.Char" if you plan to work with a stream of 'Char' tokens, -- or "Text.Megaparsec.Byte" if you intend to parse binary data. -- -- It is common to start working with the library by defining a type synonym @@ -36,9 +36,9 @@ -- > Custom error component Input stream type -- -- Then you can write type signatures like @Parser 'Int'@—for a parser that --- returns an 'Int' for example. +-- returns an 'Int', for example. -- --- Similarly (since it's known to cause confusion), you should use +-- Similarly (since it's known to cause confusion), you should use the -- 'ParseErrorBundle' type parametrized like this: -- -- > ParseErrorBundle Text Void @@ -47,7 +47,7 @@ -- > Input stream type Custom error component (the same you used in Parser) -- -- Megaparsec uses some type-level machinery to provide flexibility without --- compromising on type safety. Thus type signatures are sometimes necessary +-- compromising on type safety. Thus, type signatures are sometimes necessary -- to avoid ambiguous types. If you're seeing an error message that reads -- like “Type variable @e0@ is ambiguous …”, you need to give an explicit -- signature to your parser to resolve the ambiguity. It's a good idea to @@ -130,12 +130,16 @@ -- -- Note that we re-export monadic combinators from -- "Control.Monad.Combinators" because these are more efficient than --- 'Applicative'-based ones. Thus 'many' and 'some' may clash with the --- functions from "Control.Applicative". You need to hide the functions like +-- 'Applicative'-based ones (†). Thus 'many' and 'some' may clash with the +-- functions from "Control.Applicative". You need to hide those functions like -- this: -- -- > import Control.Applicative hiding (many, some) -- +-- † As of Megaparsec 9.7.0 'Control.Applicative.many' and +-- 'Control.Applicative.some' are as efficient as their monadic +-- counterparts. +-- -- Also note that you can import "Control.Monad.Combinators.NonEmpty" if you -- wish that combinators like 'some' return 'NonEmpty' lists. The module -- lives in the @parser-combinators@ package (you need at least version @@ -148,7 +152,7 @@ -- Other modules of interest are: -- -- * "Control.Monad.Combinators.Expr" for parsing of expressions. --- * "Control.Applicative.Permutations" for parsing of permutations +-- * "Control.Applicative.Permutations" for parsing of permutation -- phrases. ---------------------------------------------------------------------------- @@ -174,6 +178,8 @@ -- > Right xs -> print (sum xs) -- > -- > numbers = decimal `sepBy` char ',' +-- +-- 'parse' is the same as 'runParser'. parse :: -- | Parser to run Parsec e s a -> @@ -190,8 +196,8 @@ -- will fail. -- -- The function is supposed to be useful for lightweight parsing, where --- error messages (and thus file names) are not important and entire input --- should be consumed. For example, it can be used for parsing of a single +-- error messages (and thus file names) are not important and the entire +-- input should be consumed. For example, it can be used for parsing a single -- number according to a specification of its format. parseMaybe :: (Ord e, Stream s) => Parsec e s a -> s -> Maybe a parseMaybe p s = @@ -223,6 +229,8 @@ -- 'ParseErrorBundle' ('Left') or a value of type @a@ ('Right'). -- -- > parseFromFile p file = runParser p file <$> readFile file +-- +-- 'runParser' is the same as 'parse'. runParser :: -- | Parser to run Parsec e s a -> @@ -233,8 +241,8 @@ Either (ParseErrorBundle s e) a runParser p name s = snd $ runParser' p (initialState name s) --- | The function is similar to 'runParser' with the difference that it --- accepts and returns the parser state. This allows us e.g. to specify +-- | The function is similar to 'runParser', with the difference that it +-- accepts and returns the parser state. This allows us, e.g., to specify an -- arbitrary textual position at the beginning of parsing. This is the most -- general way to run a parser over the 'Identity' monad. -- @@ -253,7 +261,7 @@ -- underlying monad @m@ that returns either a 'ParseErrorBundle' ('Left') or -- a value of type @a@ ('Right'). runParserT :: - Monad m => + (Monad m) => -- | Parser to run ParsecT e s m a -> -- | Name of source file @@ -269,7 +277,7 @@ -- -- @since 4.2.0 runParserT' :: - Monad m => + (Monad m) => -- | Parser to run ParsecT e s m a -> -- | Initial state @@ -284,46 +292,28 @@ bundlePosState = statePosState s } return $ case result of - OK x -> + OK _ x -> case NE.nonEmpty (stateParseErrors s') of Nothing -> (s', Right x) Just de -> (s', Left (toBundle de)) Error e -> (s', Left (toBundle (e :| stateParseErrors s'))) --- | Given the name of source file and the input construct the initial state --- for a parser. -initialState :: String -> s -> State s e -initialState name s = - State - { stateInput = s, - stateOffset = 0, - statePosState = - PosState - { pstateInput = s, - pstateOffset = 0, - pstateSourcePos = initialPos name, - pstateTabWidth = defaultTabWidth, - pstateLinePrefix = "" - }, - stateParseErrors = [] - } - ---------------------------------------------------------------------------- -- Signaling parse errors -- $parse-errors -- --- The most general function to fail and end parsing is 'parseError'. These --- are built on top of it. The section also includes functions starting with --- the @register@ prefix which allow users to register “delayed” --- 'ParseError's. +-- The most general function to fail and end parsing is 'parseError'. The +-- others are built on top of it. This section also includes functions +-- starting with the @register@ prefix, which allow users to register +-- “delayed” 'ParseError's. -- | Stop parsing and report a trivial 'ParseError'. -- -- @since 6.0.0 failure :: - MonadParsec e s m => + (MonadParsec e s m) => -- | Unexpected item (if any) Maybe (ErrorItem (Token s)) -> -- | Expected items @@ -339,7 +329,7 @@ -- -- @since 6.0.0 fancyFailure :: - MonadParsec e s m => + (MonadParsec e s m) => -- | Fancy error components Set (ErrorFancy e) -> m a @@ -348,11 +338,11 @@ parseError (FancyError o xs) {-# INLINE fancyFailure #-} --- | The parser @'unexpected' item@ fails with an error message telling --- about unexpected item @item@ without consuming any input. +-- | The parser @'unexpected' item@ fails with an error message telling the +-- user about the unexpected item @item@ without consuming any input. -- -- > unexpected item = failure (Just item) Set.empty -unexpected :: MonadParsec e s m => ErrorItem (Token s) -> m a +unexpected :: (MonadParsec e s m) => ErrorItem (Token s) -> m a unexpected item = failure (Just item) E.empty {-# INLINE unexpected #-} @@ -362,20 +352,20 @@ -- > customFailure = fancyFailure . Set.singleton . ErrorCustom -- -- @since 6.3.0 -customFailure :: MonadParsec e s m => e -> m a +customFailure :: (MonadParsec e s m) => e -> m a customFailure = fancyFailure . E.singleton . ErrorCustom {-# INLINE customFailure #-} -- | Specify how to process 'ParseError's that happen inside of this -- wrapper. This applies to both normal and delayed 'ParseError's. -- --- As a side-effect of the implementation the inner computation will start --- with empty collection of delayed errors and they will be updated and +-- As a side effect of the implementation, the inner computation will start +-- with an empty collection of delayed errors, and they will be updated and -- “restored” on the way out of 'region'. -- -- @since 5.3.0 region :: - MonadParsec e s m => + (MonadParsec e s m) => -- | How to process 'ParseError's (ParseError s e -> ParseError s e) -> -- | The “region” that the processing applies to @@ -396,12 +386,12 @@ -- | Register a 'ParseError' for later reporting. This action does not end -- parsing and has no effect except for adding the given 'ParseError' to the -- collection of “delayed” 'ParseError's which will be taken into --- consideration at the end of parsing. Only if this collection is empty the --- parser will succeed. This is the main way to report several parse errors +-- consideration at the end of parsing. Only if this collection is empty will +-- the parser succeed. This is the main way to report several parse errors -- at once. -- -- @since 8.0.0 -registerParseError :: MonadParsec e s m => ParseError s e -> m () +registerParseError :: (MonadParsec e s m) => ParseError s e -> m () registerParseError e = updateParserState $ \s -> s {stateParseErrors = e : stateParseErrors s} {-# INLINE registerParseError #-} @@ -410,7 +400,7 @@ -- -- @since 8.0.0 registerFailure :: - MonadParsec e s m => + (MonadParsec e s m) => -- | Unexpected item (if any) Maybe (ErrorItem (Token s)) -> -- | Expected items @@ -425,7 +415,7 @@ -- -- @since 8.0.0 registerFancyFailure :: - MonadParsec e s m => + (MonadParsec e s m) => -- | Fancy error components Set (ErrorFancy e) -> m () @@ -446,7 +436,7 @@ -- -- @since 7.0.0 single :: - MonadParsec e s m => + (MonadParsec e s m) => -- | Token to match Token s -> m (Token s) @@ -470,7 +460,7 @@ -- -- @since 7.0.0 satisfy :: - MonadParsec e s m => + (MonadParsec e s m) => -- | Predicate to apply (Token s -> Bool) -> m (Token s) @@ -487,7 +477,7 @@ -- See also: 'satisfy', 'anySingleBut'. -- -- @since 7.0.0 -anySingle :: MonadParsec e s m => m (Token s) +anySingle :: (MonadParsec e s m) => m (Token s) anySingle = satisfy (const True) {-# INLINE anySingle #-} @@ -500,7 +490,7 @@ -- -- @since 7.0.0 anySingleBut :: - MonadParsec e s m => + (MonadParsec e s m) => -- | Token we should not match Token s -> m (Token s) @@ -530,10 +520,10 @@ -- | Collection of matching tokens f (Token s) -> m (Token s) -oneOf cs = satisfy (`elem` cs) +oneOf cs = satisfy (\x -> elem x cs) {-# INLINE oneOf #-} --- | As the dual of 'oneOf', @'noneOf' ts@ succeeds if the current token +-- | As the dual of 'oneOf', @'noneOf' ts@ succeeds if the current token is -- /not/ in the supplied list of tokens @ts@. Returns the parsed character. -- Note that this parser cannot automatically generate the “expected” -- component of error message, so usually you should label it manually with @@ -549,10 +539,10 @@ -- @since 7.0.0 noneOf :: (Foldable f, MonadParsec e s m) => - -- | Collection of taken we should not match + -- | Collection of tokens we should not match f (Token s) -> m (Token s) -noneOf cs = satisfy (`notElem` cs) +noneOf cs = satisfy (\x -> notElem x cs) {-# INLINE noneOf #-} -- | @'chunk' chk@ only matches the chunk @chk@. @@ -564,7 +554,7 @@ -- -- @since 7.0.0 chunk :: - MonadParsec e s m => + (MonadParsec e s m) => -- | Chunk to match Tokens s -> m (Tokens s) @@ -574,17 +564,17 @@ -- | A synonym for 'label' in the form of an operator. infix 0 -() :: MonadParsec e s m => m a -> String -> m a +() :: (MonadParsec e s m) => m a -> String -> m a () = flip label {-# INLINE () #-} --- | Return both the result of a parse and a chunk of input that was +-- | Return both the result of a parse and the chunk of input that was -- consumed during parsing. This relies on the change of the 'stateOffset' -- value to evaluate how many tokens were consumed. If you mess with it --- manually in the argument parser, prepare for troubles. +-- manually in the argument parser, prepare for trouble. -- -- @since 5.3.0 -match :: MonadParsec e s m => m a -> m (Tokens s, a) +match :: (MonadParsec e s m) => m a -> m (Tokens s, a) match p = do o <- getOffset s <- getInput @@ -604,7 +594,7 @@ -- > takeRest = takeWhileP Nothing (const True) -- -- @since 6.0.0 -takeRest :: MonadParsec e s m => m (Tokens s) +takeRest :: (MonadParsec e s m) => m (Tokens s) takeRest = takeWhileP Nothing (const True) {-# INLINE takeRest #-} @@ -613,7 +603,7 @@ -- > atEnd = option False (True <$ hidden eof) -- -- @since 6.0.0 -atEnd :: MonadParsec e s m => m Bool +atEnd :: (MonadParsec e s m) => m Bool atEnd = option False (True <$ hidden eof) {-# INLINE atEnd #-} @@ -621,18 +611,18 @@ -- Parser state combinators -- | Return the current input. -getInput :: MonadParsec e s m => m s +getInput :: (MonadParsec e s m) => m s getInput = stateInput <$> getParserState {-# INLINE getInput #-} -- | @'setInput' input@ continues parsing with @input@. -setInput :: MonadParsec e s m => s -> m () +setInput :: (MonadParsec e s m) => s -> m () setInput s = updateParserState (\(State _ o pst de) -> State s o pst de) {-# INLINE setInput #-} --- | Return the current source position. This function /is not cheap/, do --- not call it e.g. on matching of every token, that's a bad idea. Still you --- can use it to get 'SourcePos' to attach to things that you parse. +-- | Return the current source position. This function /is not cheap/, so do +-- not call it, e.g., on matching of every token—that's a bad idea. Still, +-- you can use it to get a 'SourcePos' to attach to things that you parse. -- -- The function works under the assumption that we move in the input stream -- only forwards and never backwards, which is always true unless the user @@ -652,7 +642,7 @@ -- See also: 'setOffset'. -- -- @since 7.0.0 -getOffset :: MonadParsec e s m => m Int +getOffset :: (MonadParsec e s m) => m Int getOffset = stateOffset <$> getParserState {-# INLINE getOffset #-} @@ -661,7 +651,7 @@ -- See also: 'getOffset'. -- -- @since 7.0.0 -setOffset :: MonadParsec e s m => Int -> m () +setOffset :: (MonadParsec e s m) => Int -> m () setOffset o = updateParserState $ \(State s _ pst de) -> State s o pst de {-# INLINE setOffset #-} @@ -669,6 +659,6 @@ -- | @'setParserState' st@ sets the parser state to @st@. -- -- See also: 'getParserState', 'updateParserState'. -setParserState :: MonadParsec e s m => State s e -> m () +setParserState :: (MonadParsec e s m) => State s e -> m () setParserState st = updateParserState (const st) {-# INLINE setParserState #-} diff --git a/Text/Megaparsec/Byte.hs b/Text/Megaparsec/Byte.hs --- a/Text/Megaparsec/Byte.hs +++ b/Text/Megaparsec/Byte.hs @@ -143,18 +143,18 @@ letterChar = satisfy (isLetter . toChar) "letter" {-# INLINE letterChar #-} --- | Parse an alphabetic or digit characters. +-- | Parse an alphabetic or digit character. alphaNumChar :: (MonadParsec e s m, Token s ~ Word8) => m (Token s) alphaNumChar = satisfy (isAlphaNum . toChar) "alphanumeric character" {-# INLINE alphaNumChar #-} --- | Parse a printable character: letter, number, mark, punctuation, symbol +-- | Parse a printable character: letter, number, mark, punctuation, symbol, -- or space. printChar :: (MonadParsec e s m, Token s ~ Word8) => m (Token s) printChar = satisfy (isPrint . toChar) "printable character" {-# INLINE printChar #-} --- | Parse an ASCII digit, i.e between “0” and “9”. +-- | Parse an ASCII digit, i.e. between “0” and “9”. digitChar :: (MonadParsec e s m, Token s ~ Word8) => m (Token s) digitChar = satisfy isDigit' "digit" where diff --git a/Text/Megaparsec/Byte/Binary.hs b/Text/Megaparsec/Byte/Binary.hs --- a/Text/Megaparsec/Byte/Binary.hs +++ b/Text/Megaparsec/Byte/Binary.hs @@ -50,7 +50,7 @@ import Data.Word import Text.Megaparsec --- | Data types that can be converted to little- or big- endian numbers. +-- | Data types that can be converted to little- or big-endian numbers. class BinaryChunk chunk where convertChunkBE :: (Bits a, Num a) => chunk -> a convertChunkLE :: (Bits a, Num a) => chunk -> a @@ -132,18 +132,18 @@ -- | Parse a little-endian 'Word64'. word64le :: (MonadParsec e s m, BinaryChunk (Tokens s)) => m Word64 -word64le = anyLE (Just "little-endian 64 word") +word64le = anyLE (Just "little-endian 64 bit word") {-# INLINE word64le #-} -- | Parse a big-endian 'Word64'. word64be :: (MonadParsec e s m, BinaryChunk (Tokens s)) => m Word64 -word64be = anyBE (Just "big-endian 64 word") +word64be = anyBE (Just "big-endian 64 bit word") {-# INLINE word64be #-} ---------------------------------------------------------------------------- -- Parsing signed values --- | Parse a 'Int8'. +-- | Parse an 'Int8'. int8 :: (MonadParsec e s m, BinaryChunk (Tokens s)) => m Int8 int8 = anyBE (Just "8 bit int") {-# INLINE int8 #-} @@ -170,12 +170,12 @@ -- | Parse a little-endian 'Int64'. int64le :: (MonadParsec e s m, BinaryChunk (Tokens s)) => m Int64 -int64le = anyLE (Just "little-endian 64 int") +int64le = anyLE (Just "little-endian 64 bit int") {-# INLINE int64le #-} -- | Parse a big-endian 'Int64'. int64be :: (MonadParsec e s m, BinaryChunk (Tokens s)) => m Int64 -int64be = anyBE (Just "big-endian 64 int") +int64be = anyBE (Just "big-endian 64 bit int") {-# INLINE int64be #-} -------------------------------------------------------------------------------- @@ -185,7 +185,7 @@ -- -- Performs ceiling division, so byte-unaligned types (bitsize not a -- multiple of 8) should work, but further usage is not tested. -finiteByteSize :: forall a. FiniteBits a => Int +finiteByteSize :: forall a. (FiniteBits a) => Int finiteByteSize = finiteBitSize @a undefined `ceilDiv` 8 where ceilDiv x y = (x + y - 1) `div` y diff --git a/Text/Megaparsec/Byte/Lexer.hs b/Text/Megaparsec/Byte/Lexer.hs --- a/Text/Megaparsec/Byte/Lexer.hs +++ b/Text/Megaparsec/Byte/Lexer.hs @@ -41,7 +41,7 @@ import Control.Applicative import Data.Functor (void) -import Data.List (foldl') +import qualified Data.List import Data.Proxy import Data.Scientific (Scientific) import qualified Data.Scientific as Sci @@ -53,10 +53,10 @@ ---------------------------------------------------------------------------- -- White space --- | Given a comment prefix this function returns a parser that skips line +-- | Given a comment prefix, this function returns a parser that skips line -- comments. Note that it stops just before the newline character but --- doesn't consume the newline. Newline is either supposed to be consumed by --- 'space' parser or picked up manually. +-- doesn't consume the newline. The newline is supposed to be either consumed +-- by the 'space' parser or picked up manually. skipLineComment :: (MonadParsec e s m, Token s ~ Word8) => -- | Line comment prefix @@ -66,10 +66,10 @@ B.string prefix *> void (takeWhileP (Just "character") (/= 10)) {-# INLINEABLE skipLineComment #-} --- | @'skipBlockComment' start end@ skips non-nested block comment starting +-- | @'skipBlockComment' start end@ skips a non-nested block comment starting -- with @start@ and ending with @end@. skipBlockComment :: - (MonadParsec e s m, Token s ~ Word8) => + (MonadParsec e s m) => -- | Start of block comment Tokens s -> -- | End of block comment @@ -81,7 +81,7 @@ n = B.string end {-# INLINEABLE skipBlockComment #-} --- | @'skipBlockCommentNested' start end@ skips possibly nested block +-- | @'skipBlockCommentNested' start end@ skips a possibly nested block -- comment starting with @start@ and ending with @end@. -- -- @since 5.0.0 @@ -122,14 +122,14 @@ m a decimal_ = mkNum <$> takeWhile1P (Just "digit") isDigit where - mkNum = foldl' step 0 . chunkToTokens (Proxy :: Proxy s) + mkNum = fromInteger . Data.List.foldl' step 0 . chunkToTokens (Proxy :: Proxy s) step a w = a * 10 + fromIntegral (w - 48) {-# INLINE decimal_ #-} -- | Parse an integer in the binary representation. The binary number is -- expected to be a non-empty sequence of zeroes “0” and ones “1”. -- --- You could of course parse some prefix before the actual number: +-- You could, of course, parse some prefix before the actual number: -- -- > binary = char 48 >> char' 98 >> L.binary -- @@ -145,18 +145,18 @@ <$> takeWhile1P Nothing isBinDigit "binary integer" where - mkNum = foldl' step 0 . chunkToTokens (Proxy :: Proxy s) + mkNum = fromInteger . Data.List.foldl' step 0 . chunkToTokens (Proxy :: Proxy s) step a w = a * 2 + fromIntegral (w - 48) isBinDigit w = w == 48 || w == 49 {-# INLINEABLE binary #-} -- | Parse an integer in the octal representation. The format of the octal --- number is expected to be according to the Haskell report except for the --- fact that this parser doesn't parse “0o” or “0O” prefix. It is a --- responsibility of the programmer to parse correct prefix before parsing --- the number itself. +-- number is expected to be according to the Haskell report, except for the +-- fact that this parser doesn't parse the “0o” or “0O” prefix. It is the +-- responsibility of the programmer to parse the correct prefix before +-- parsing the number itself. -- --- For example you can make it conform to the Haskell report like this: +-- For example, you can make it conform to the Haskell report like this: -- -- > octal = char 48 >> char' 111 >> L.octal -- @@ -170,18 +170,18 @@ <$> takeWhile1P Nothing isOctDigit "octal integer" where - mkNum = foldl' step 0 . chunkToTokens (Proxy :: Proxy s) + mkNum = fromInteger . Data.List.foldl' step 0 . chunkToTokens (Proxy :: Proxy s) step a w = a * 8 + fromIntegral (w - 48) isOctDigit w = w - 48 < 8 {-# INLINEABLE octal #-} -- | Parse an integer in the hexadecimal representation. The format of the --- hexadecimal number is expected to be according to the Haskell report --- except for the fact that this parser doesn't parse “0x” or “0X” prefix. --- It is a responsibility of the programmer to parse correct prefix before --- parsing the number itself. +-- hexadecimal number is expected to be according to the Haskell report, +-- except for the fact that this parser doesn't parse the “0x” or “0X” +-- prefix. It is the responsibility of the programmer to parse the correct +-- prefix before parsing the number itself. -- --- For example you can make it conform to the Haskell report like this: +-- For example, you can make it conform to the Haskell report like this: -- -- > hexadecimal = char 48 >> char' 120 >> L.hexadecimal -- @@ -195,7 +195,7 @@ <$> takeWhile1P Nothing isHexDigit "hexadecimal integer" where - mkNum = foldl' step 0 . chunkToTokens (Proxy :: Proxy s) + mkNum = fromInteger . Data.List.foldl' step 0 . chunkToTokens (Proxy :: Proxy s) step a w | w >= 48 && w <= 57 = a * 16 + fromIntegral (w - 48) | w >= 97 = a * 16 + fromIntegral (w - 87) @@ -207,14 +207,14 @@ {-# INLINEABLE hexadecimal #-} -- | Parse a floating point value as a 'Scientific' number. 'Scientific' is --- great for parsing of arbitrary precision numbers coming from an untrusted --- source. See documentation in "Data.Scientific" for more information. +-- great for parsing arbitrary-precision numbers coming from an untrusted +-- source. See the documentation in "Data.Scientific" for more information. -- -- The parser can be used to parse integers or floating point values. Use -- functions like 'Data.Scientific.floatingOrInteger' from "Data.Scientific" -- to test and extract integer or real values. -- --- This function does not parse sign, if you need to parse signed numbers, +-- This function does not parse a sign; if you need to parse signed numbers, -- see 'signed'. scientific :: forall e s m. @@ -232,7 +232,7 @@ -- | Parse a floating point number according to the syntax for floating -- point literals described in the Haskell report. -- --- This function does not parse sign, if you need to parse signed numbers, +-- This function does not parse a sign; if you need to parse signed numbers, -- see 'signed'. -- -- __Note__: in versions /6.0.0/–/6.1.1/ this function accepted plain integers. @@ -256,7 +256,7 @@ m SP dotDecimal_ pxy c' = do void (B.char 46) - let mkNum = foldl' step (SP c' 0) . chunkToTokens pxy + let mkNum = Data.List.foldl' step (SP c' 0) . chunkToTokens pxy step (SP a e') w = SP (a * 10 + fromIntegral (w - 48)) @@ -273,13 +273,13 @@ (+ e') <$> signed (return ()) decimal_ {-# INLINE exponent_ #-} --- | @'signed' space p@ parser parses an optional sign character (“+” or --- “-”), then if there is a sign it consumes optional white space (using --- @space@ parser), then it runs parser @p@ which should return a number. --- Sign of the number is changed according to the previously parsed sign +-- | @'signed' space p@ parses an optional sign character (“+” or “-”), then, +-- if there is a sign, it consumes optional white space (using the @space@ +-- parser), then it runs the parser @p@, which should return a number. The +-- sign of the number is changed according to the previously parsed sign -- character. -- --- For example, to parse signed integer you can write: +-- For example, to parse a signed integer you can write: -- -- > lexeme = L.lexeme spaceConsumer -- > integer = lexeme L.decimal diff --git a/Text/Megaparsec/Char.hs b/Text/Megaparsec/Char.hs --- a/Text/Megaparsec/Char.hs +++ b/Text/Megaparsec/Char.hs @@ -158,7 +158,7 @@ letterChar = satisfy isLetter "letter" {-# INLINE letterChar #-} --- | Parse an alphabetic or numeric digit Unicode characters. +-- | Parse an alphabetic or numeric digit Unicode character. -- -- Note that the numeric digits outside the ASCII range are parsed by this -- parser but not by 'digitChar'. Such digits may be part of identifiers but @@ -168,12 +168,12 @@ {-# INLINE alphaNumChar #-} -- | Parse a printable Unicode character: letter, number, mark, punctuation, --- symbol or space. +-- symbol, or space. printChar :: (MonadParsec e s m, Token s ~ Char) => m (Token s) printChar = satisfy isPrint "printable character" {-# INLINE printChar #-} --- | Parse an ASCII digit, i.e between “0” and “9”. +-- | Parse an ASCII digit, i.e. between “0” and “9”. digitChar :: (MonadParsec e s m, Token s ~ Char) => m (Token s) digitChar = satisfy isDigit "digit" {-# INLINE digitChar #-} @@ -211,18 +211,18 @@ {-# INLINE numberChar #-} -- | Parse a Unicode punctuation character, including various kinds of --- connectors, brackets and quotes. +-- connectors, brackets, and quotes. punctuationChar :: (MonadParsec e s m, Token s ~ Char) => m (Token s) punctuationChar = satisfy isPunctuation "punctuation" {-# INLINE punctuationChar #-} --- | Parse a Unicode symbol characters, including mathematical and currency +-- | Parse a Unicode symbol character, including mathematical and currency -- symbols. symbolChar :: (MonadParsec e s m, Token s ~ Char) => m (Token s) symbolChar = satisfy isSymbol "symbol" {-# INLINE symbolChar #-} --- | Parse a Unicode space and separator characters. +-- | Parse a Unicode space or separator character. separatorChar :: (MonadParsec e s m, Token s ~ Char) => m (Token s) separatorChar = satisfy isSeparator "separator" {-# INLINE separatorChar #-} @@ -239,8 +239,8 @@ latin1Char = satisfy isLatin1 "Latin-1 character" {-# INLINE latin1Char #-} --- | @'charCategory' cat@ parses character in Unicode General Category --- @cat@, see 'Data.Char.GeneralCategory'. +-- | @'charCategory' cat@ parses a character in the Unicode General Category +-- @cat@; see 'Data.Char.GeneralCategory'. charCategory :: (MonadParsec e s m, Token s ~ Char) => GeneralCategory -> @@ -248,7 +248,7 @@ charCategory cat = satisfy ((== cat) . generalCategory) categoryName cat {-# INLINE charCategory #-} --- | Return the human-readable name of Unicode General Category. +-- | Return the human-readable name of a Unicode General Category. categoryName :: GeneralCategory -> String categoryName = \case UppercaseLetter -> "uppercase letter" diff --git a/Text/Megaparsec/Char/Lexer.hs b/Text/Megaparsec/Char/Lexer.hs --- a/Text/Megaparsec/Char/Lexer.hs +++ b/Text/Megaparsec/Char/Lexer.hs @@ -69,7 +69,7 @@ import Control.Applicative import Control.Monad (void) import qualified Data.Char as Char -import Data.List (foldl') +import qualified Data.List import Data.List.NonEmpty (NonEmpty (..)) import Data.Maybe (fromMaybe, isJust, listToMaybe) import Data.Proxy @@ -83,10 +83,10 @@ ---------------------------------------------------------------------------- -- White space --- | Given a comment prefix this function returns a parser that skips line +-- | Given a comment prefix, this function returns a parser that skips line -- comments. Note that it stops just before the newline character but --- doesn't consume the newline. Newline is either supposed to be consumed by --- 'space' parser or picked up manually. +-- doesn't consume the newline. The newline is supposed to be either consumed +-- by the 'space' parser or picked up manually. skipLineComment :: (MonadParsec e s m, Token s ~ Char) => -- | Line comment prefix @@ -96,10 +96,10 @@ C.string prefix *> void (takeWhileP (Just "character") (/= '\n')) {-# INLINEABLE skipLineComment #-} --- | @'skipBlockComment' start end@ skips non-nested block comment starting +-- | @'skipBlockComment' start end@ skips a non-nested block comment starting -- with @start@ and ending with @end@. skipBlockComment :: - (MonadParsec e s m, Token s ~ Char) => + (MonadParsec e s m) => -- | Start of block comment Tokens s -> -- | End of block comment @@ -111,7 +111,7 @@ n = C.string end {-# INLINEABLE skipBlockComment #-} --- | @'skipBlockCommentNested' start end@ skips possibly nested block +-- | @'skipBlockCommentNested' start end@ skips a possibly nested block -- comment starting with @start@ and ending with @end@. -- -- @since 5.0.0 @@ -143,8 +143,8 @@ indentLevel = sourceColumn <$> getSourcePos {-# INLINE indentLevel #-} --- | Fail reporting incorrect indentation error. The error has attached --- information: +-- | Fail, reporting an incorrect indentation error. The error has the +-- following attached information: -- -- * Desired ordering between reference level and actual level -- * Reference indentation level @@ -152,7 +152,7 @@ -- -- @since 5.0.0 incorrectIndent :: - MonadParsec e s m => + (MonadParsec e s m) => -- | Desired ordering between reference level and actual level Ordering -> -- | Reference indentation level @@ -166,15 +166,16 @@ {-# INLINEABLE incorrectIndent #-} -- | @'indentGuard' spaceConsumer ord ref@ first consumes all white space --- (indentation) with @spaceConsumer@ parser, then it checks the column --- position. Ordering between current indentation level and the reference --- indentation level @ref@ should be @ord@, otherwise the parser fails. On --- success the current column position is returned. +-- (indentation) with the @spaceConsumer@ parser, then it checks the column +-- position. The ordering between the current indentation level and the +-- reference indentation level @ref@ should be @ord@, otherwise the parser +-- fails. On success the current column position is returned. -- -- When you want to parse a block of indentation, first run this parser with -- arguments like @'indentGuard' spaceConsumer 'GT' 'pos1'@—this will make --- sure you have some indentation. Use returned value to check indentation --- on every subsequent line according to syntax of your language. +-- sure you have some indentation. Use the returned value to check +-- indentation on every subsequent line according to the syntax of your +-- language. indentGuard :: (TraversableStream s, MonadParsec e s m) => -- | How to consume indentation (white space) @@ -194,7 +195,7 @@ {-# INLINEABLE indentGuard #-} -- | Parse a non-indented construction. This ensures that there is no --- indentation before actual data. Useful, for example, as a wrapper for +-- indentation before the actual data. Useful, for example, as a wrapper for -- top-level function definitions. -- -- @since 4.3.0 @@ -208,8 +209,7 @@ nonIndented sc p = indentGuard sc EQ pos1 *> p {-# INLINEABLE nonIndented #-} --- | Behaviors for parsing of indented tokens. This is used in --- 'indentBlock', which see. +-- | Behaviors for parsing of indented tokens. This is used in 'indentBlock'. -- -- @since 4.3.0 data IndentOpt m a b @@ -226,12 +226,11 @@ -- | Parse a “reference” token and a number of other tokens that have a -- greater (but the same for all of them) level of indentation than that of --- the “reference” token. The reference token can influence parsing, see +-- the “reference” token. The reference token can influence parsing; see -- 'IndentOpt' for more information. -- --- Tokens /must not/ consume newlines after them. On the other hand, the --- first argument of this function /must/ consume newlines among other white --- space characters. +-- __Note__: the first argument of this function /must/ consume newlines +-- among other white space characters. -- -- @since 4.3.0 indentBlock :: @@ -259,14 +258,14 @@ let lvl = fromMaybe pos indent x <- if - | pos <= ref -> incorrectIndent GT ref pos - | pos == lvl -> p - | otherwise -> incorrectIndent EQ lvl pos + | pos <= ref -> incorrectIndent GT ref pos + | pos == lvl -> p + | otherwise -> incorrectIndent EQ lvl pos xs <- indentedItems ref lvl sc p f (x : xs) {-# INLINEABLE indentBlock #-} --- | Grab indented items. This is a helper for 'indentBlock', it's not a +-- | Grab indented items. This is a helper for 'indentBlock'; it's not a -- part of the public API. indentedItems :: (TraversableStream s, MonadParsec e s m) => @@ -289,15 +288,15 @@ then return [] else if - | pos <= ref -> return [] - | pos == lvl -> (:) <$> p <*> go - | otherwise -> incorrectIndent EQ lvl pos + | pos <= ref -> return [] + | pos == lvl -> (:) <$> p <*> go + | otherwise -> incorrectIndent EQ lvl pos -- | Create a parser that supports line-folding. The first argument is used --- to consume white space between components of line fold, thus it /must/ +-- to consume white space between components of a line fold, thus it /must/ -- consume newlines in order to work properly. The second argument is a -- callback that receives a custom space-consuming parser as an argument. --- This parser should be used after separate components of line fold that +-- This parser should be used after separate components of the line fold that -- can be put on different lines. -- -- An example should clarify the usage pattern: @@ -358,8 +357,8 @@ -- -- If you need to parse signed integers, see the 'signed' combinator. -- --- __Note__: before the version /6.0.0/ the function returned 'Integer', --- i.e. it wasn't polymorphic in its return type. +-- __Note__: before version /6.0.0/ the function returned 'Integer', i.e. it +-- wasn't polymorphic in its return type. -- -- __Warning__: this function does not perform range checks. decimal :: (MonadParsec e s m, Token s ~ Char, Num a) => m a @@ -373,14 +372,14 @@ m a decimal_ = mkNum <$> takeWhile1P (Just "digit") Char.isDigit where - mkNum = foldl' step 0 . chunkToTokens (Proxy :: Proxy s) + mkNum = fromInteger . Data.List.foldl' step 0 . chunkToTokens (Proxy :: Proxy s) step a c = a * 10 + fromIntegral (Char.digitToInt c) {-# INLINE decimal_ #-} -- | Parse an integer in binary representation. The binary number is -- expected to be a non-empty sequence of zeroes “0” and ones “1”. -- --- You could of course parse some prefix before the actual number: +-- You could, of course, parse some prefix before the actual number: -- -- > binary = char '0' >> char' 'b' >> L.binary -- @@ -396,18 +395,18 @@ <$> takeWhile1P Nothing isBinDigit "binary integer" where - mkNum = foldl' step 0 . chunkToTokens (Proxy :: Proxy s) + mkNum = fromInteger . Data.List.foldl' step 0 . chunkToTokens (Proxy :: Proxy s) step a c = a * 2 + fromIntegral (Char.digitToInt c) isBinDigit x = x == '0' || x == '1' {-# INLINEABLE binary #-} -- | Parse an integer in the octal representation. The format of the octal --- number is expected to be according to the Haskell report except for the --- fact that this parser doesn't parse “0o” or “0O” prefix. It is a --- responsibility of the programmer to parse correct prefix before parsing --- the number itself. +-- number is expected to be according to the Haskell report, except for the +-- fact that this parser doesn't parse the “0o” or “0O” prefix. It is the +-- responsibility of the programmer to parse the correct prefix before +-- parsing the number itself. -- --- For example you can make it conform to the Haskell report like this: +-- For example, you can make it conform to the Haskell report like this: -- -- > octal = char '0' >> char' 'o' >> L.octal -- @@ -424,17 +423,17 @@ <$> takeWhile1P Nothing Char.isOctDigit "octal integer" where - mkNum = foldl' step 0 . chunkToTokens (Proxy :: Proxy s) + mkNum = fromInteger . Data.List.foldl' step 0 . chunkToTokens (Proxy :: Proxy s) step a c = a * 8 + fromIntegral (Char.digitToInt c) {-# INLINEABLE octal #-} -- | Parse an integer in the hexadecimal representation. The format of the --- hexadecimal number is expected to be according to the Haskell report --- except for the fact that this parser doesn't parse “0x” or “0X” prefix. --- It is a responsibility of the programmer to parse correct prefix before --- parsing the number itself. +-- hexadecimal number is expected to be according to the Haskell report, +-- except for the fact that this parser doesn't parse the “0x” or “0X” +-- prefix. It is the responsibility of the programmer to parse the correct +-- prefix before parsing the number itself. -- --- For example you can make it conform to the Haskell report like this: +-- For example, you can make it conform to the Haskell report like this: -- -- > hexadecimal = char '0' >> char' 'x' >> L.hexadecimal -- @@ -451,19 +450,19 @@ <$> takeWhile1P Nothing Char.isHexDigit "hexadecimal integer" where - mkNum = foldl' step 0 . chunkToTokens (Proxy :: Proxy s) + mkNum = fromInteger . Data.List.foldl' step 0 . chunkToTokens (Proxy :: Proxy s) step a c = a * 16 + fromIntegral (Char.digitToInt c) {-# INLINEABLE hexadecimal #-} -- | Parse a floating point value as a 'Scientific' number. 'Scientific' is --- great for parsing of arbitrary precision numbers coming from an untrusted --- source. See documentation in "Data.Scientific" for more information. +-- great for parsing arbitrary-precision numbers coming from an untrusted +-- source. See the documentation in "Data.Scientific" for more information. -- -- The parser can be used to parse integers or floating point values. Use -- functions like 'Data.Scientific.floatingOrInteger' from "Data.Scientific" -- to test and extract integer or real values. -- --- This function does not parse sign, if you need to parse signed numbers, +-- This function does not parse a sign; if you need to parse signed numbers, -- see 'signed'. -- -- @since 5.0.0 @@ -483,7 +482,7 @@ -- | Parse a floating point number according to the syntax for floating -- point literals described in the Haskell report. -- --- This function does not parse sign, if you need to parse signed numbers, +-- This function does not parse a sign; if you need to parse signed numbers, -- see 'signed'. -- -- __Note__: before version /6.0.0/ the function returned 'Double', i.e. it @@ -511,7 +510,7 @@ m SP dotDecimal_ pxy c' = do void (C.char '.') - let mkNum = foldl' step (SP c' 0) . chunkToTokens pxy + let mkNum = Data.List.foldl' step (SP c' 0) . chunkToTokens pxy step (SP a e') c = SP (a * 10 + fromIntegral (Char.digitToInt c)) @@ -528,13 +527,13 @@ (+ e') <$> signed (return ()) decimal_ {-# INLINE exponent_ #-} --- | @'signed' space p@ parses an optional sign character (“+” or “-”), then --- if there is a sign it consumes optional white space (using the @space@ --- parser), then it runs the parser @p@ which should return a number. Sign --- of the number is changed according to the previously parsed sign +-- | @'signed' space p@ parses an optional sign character (“+” or “-”), then, +-- if there is a sign, it consumes optional white space (using the @space@ +-- parser), then it runs the parser @p@, which should return a number. The +-- sign of the number is changed according to the previously parsed sign -- character. -- --- For example, to parse signed integer you can write: +-- For example, to parse a signed integer you can write: -- -- > lexeme = L.lexeme spaceConsumer -- > integer = lexeme L.decimal diff --git a/Text/Megaparsec/Class.hs b/Text/Megaparsec/Class.hs --- a/Text/Megaparsec/Class.hs +++ b/Text/Megaparsec/Class.hs @@ -16,8 +16,8 @@ -- Stability : experimental -- Portability : portable -- --- Definition of 'MonadParsec'—type class describing monads that implement --- the full set of primitive parsers. +-- Definition of 'MonadParsec'—the type class describing monads that +-- implement the full set of primitive parsers. -- -- @since 6.5.0 module Text.Megaparsec.Class @@ -37,6 +37,7 @@ import qualified Control.Monad.Trans.Writer.Strict as S import Data.Set (Set) import Text.Megaparsec.Error +import {-# SOURCE #-} Text.Megaparsec.Internal (Reply) import Text.Megaparsec.State import Text.Megaparsec.Stream @@ -60,7 +61,7 @@ label :: String -> m a -> m a -- | @'hidden' p@ behaves just like parser @p@, but it doesn't show any - -- “expected” tokens in error message when @p@ fails. + -- “expected” tokens in the error message when @p@ fails. -- -- Please use 'hidden' instead of the old @'label' ""@ idiom. hidden :: m a -> m a @@ -70,7 +71,7 @@ -- backtracks the parser state when @p@ fails (either consuming input or -- not). -- - -- This combinator is used whenever arbitrary look ahead is needed. Since + -- This combinator is used whenever arbitrary lookahead is needed. Since -- it pretends that it hasn't consumed any input when @p@ fails, the -- ('A.<|>') combinator will try its second alternative even if the first -- parser failed while consuming input. @@ -106,11 +107,11 @@ -- alternatives are complex, composite parsers. try :: m a -> m a - -- | If @p@ in @'lookAhead' p@ succeeds (either consuming input or not) - -- the whole parser behaves like @p@ succeeded without consuming anything - -- (parser state is not updated as well). If @p@ fails, 'lookAhead' has no - -- effect, i.e. it will fail consuming input if @p@ fails consuming input. - -- Combine with 'try' if this is undesirable. + -- | If @p@ in @'lookAhead' p@ succeeds (either consuming input or not), + -- the whole parser behaves as if @p@ succeeded without consuming anything + -- (the parser state is not updated either). If @p@ fails, 'lookAhead' has + -- no effect, i.e. it will fail consuming input if @p@ fails consuming + -- input. Combine with 'try' if this is undesirable. lookAhead :: m a -> m a -- | @'notFollowedBy' p@ only succeeds when the parser @p@ fails. This @@ -125,8 +126,8 @@ -- to the point where the next object starts. -- -- Note that if @r@ fails, the original error message is reported as if - -- without 'withRecovery'. In no way recovering parser @r@ can influence - -- error messages. + -- 'withRecovery' had not been used. In no way can the recovering parser @r@ + -- influence error messages. -- -- @since 4.4.0 withRecovery :: @@ -138,10 +139,10 @@ m a -- | @'observing' p@ allows us to “observe” failure of the @p@ parser, - -- should it happen, without actually ending parsing but instead getting - -- the 'ParseError' in 'Left'. On success parsed value is returned in + -- should it happen, without actually ending parsing, but instead getting + -- the 'ParseError' in 'Left'. On success, the parsed value is returned in -- 'Right' as usual. Note that this primitive just allows you to observe - -- parse errors as they happen, it does not backtrack or change how the + -- parse errors as they happen; it does not backtrack or change how the -- @p@ parser works in any way. -- -- @since 5.1.0 @@ -155,7 +156,7 @@ -- | The parser @'token' test expected@ accepts tokens for which the -- matching function @test@ returns 'Just' results. If 'Nothing' is - -- returned the @expected@ set is used to report the items that were + -- returned, the @expected@ set is used to report the items that were -- expected. -- -- For example, the 'Text.Megaparsec.satisfy' parser is implemented as: @@ -164,7 +165,7 @@ -- > where -- > testToken x = if f x then Just x else Nothing -- - -- __Note__: type signature of this primitive was changed in the version + -- __Note__: the type signature of this primitive was changed in version -- /7.0.0/. token :: -- | Matching function for the token to parse @@ -178,15 +179,15 @@ -- given and parsed chunks after a candidate chunk of correct length is -- fetched from the stream. -- - -- This can be used for example to write 'Text.Megaparsec.chunk': + -- This can be used, for example, to write 'Text.Megaparsec.chunk': -- -- > chunk = tokens (==) -- - -- Note that beginning from Megaparsec 4.4.0, this is an auto-backtracking + -- Note that beginning with Megaparsec 4.4.0, this is an auto-backtracking -- primitive, which means that if it fails, it never consumes any input. -- This is done to make its consumption model match how error messages for - -- this primitive are reported (which becomes an important thing as user - -- gets more control with primitives like 'withRecovery'): + -- this primitive are reported (which becomes important as the user gets + -- more control with primitives like 'withRecovery'): -- -- >>> parseTest (string "abc") "abd" -- 1:1: @@ -216,7 +217,7 @@ -- -- @since 6.0.0 takeWhileP :: - -- | Name for a single token in the row + -- | Name for a single token in the resulting chunk Maybe String -> -- | Predicate to use to test tokens (Token s -> Bool) -> @@ -236,7 +237,7 @@ -- -- @since 6.0.0 takeWhile1P :: - -- | Name for a single token in the row + -- | Name for a single token in the resulting chunk Maybe String -> -- | Predicate to use to test tokens (Token s -> Bool) -> @@ -244,22 +245,23 @@ m (Tokens s) -- | Extract the specified number of tokens from the input stream and - -- return them packed as a chunk of stream. If there is not enough tokens - -- in the stream, a parse error will be signaled. It's guaranteed that if - -- the parser succeeds, the requested number of tokens will be returned. + -- return them packed as a chunk of the stream. If there are not enough + -- tokens in the stream, a parse error will be signaled. It's guaranteed + -- that if the parser succeeds, the requested number of tokens will be + -- returned. -- -- The parser is roughly equivalent to: -- -- > takeP (Just "foo") n = count n (anySingle "foo") -- > takeP Nothing n = count n anySingle -- - -- Note that if the combinator fails due to insufficient number of tokens - -- in the input stream, it backtracks automatically. No 'try' is necessary - -- with 'takeP'. + -- Note that if the combinator fails due to an insufficient number of + -- tokens in the input stream, it backtracks automatically. No 'try' is + -- necessary with 'takeP'. -- -- @since 6.0.0 takeP :: - -- | Name for a single token in the row + -- | Name for a single token in the resulting chunk Maybe String -> -- | How many tokens to extract Int -> @@ -272,10 +274,17 @@ -- | @'updateParserState' f@ applies the function @f@ to the parser state. updateParserState :: (State s e -> State s e) -> m () + -- | An escape hatch for defining custom 'MonadParsec' primitives. You + -- will need to import "Text.Megaparsec.Internal" in order to construct + -- 'Reply'. + -- + -- @since 9.4.0 + mkParsec :: (State s e -> Reply e s a) -> m a + ---------------------------------------------------------------------------- -- Lifting through MTL -instance MonadParsec e s m => MonadParsec e s (L.StateT st m) where +instance (MonadParsec e s m) => MonadParsec e s (L.StateT st m) where parseError e = lift (parseError e) label n (L.StateT m) = L.StateT $ label n . m try (L.StateT m) = L.StateT $ try . m @@ -295,8 +304,9 @@ takeP l n = lift (takeP l n) getParserState = lift getParserState updateParserState f = lift (updateParserState f) + mkParsec f = lift (mkParsec f) -instance MonadParsec e s m => MonadParsec e s (S.StateT st m) where +instance (MonadParsec e s m) => MonadParsec e s (S.StateT st m) where parseError e = lift (parseError e) label n (S.StateT m) = S.StateT $ label n . m try (S.StateT m) = S.StateT $ try . m @@ -316,8 +326,9 @@ takeP l n = lift (takeP l n) getParserState = lift getParserState updateParserState f = lift (updateParserState f) + mkParsec f = lift (mkParsec f) -instance MonadParsec e s m => MonadParsec e s (L.ReaderT r m) where +instance (MonadParsec e s m) => MonadParsec e s (L.ReaderT r m) where parseError e = lift (parseError e) label n (L.ReaderT m) = L.ReaderT $ label n . m try (L.ReaderT m) = L.ReaderT $ try . m @@ -334,6 +345,7 @@ takeP l n = lift (takeP l n) getParserState = lift getParserState updateParserState f = lift (updateParserState f) + mkParsec f = lift (mkParsec f) instance (Monoid w, MonadParsec e s m) => MonadParsec e s (L.WriterT w m) where parseError e = lift (parseError e) @@ -359,6 +371,7 @@ takeP l n = lift (takeP l n) getParserState = lift getParserState updateParserState f = lift (updateParserState f) + mkParsec f = lift (mkParsec f) instance (Monoid w, MonadParsec e s m) => MonadParsec e s (S.WriterT w m) where parseError e = lift (parseError e) @@ -384,6 +397,7 @@ takeP l n = lift (takeP l n) getParserState = lift getParserState updateParserState f = lift (updateParserState f) + mkParsec f = lift (mkParsec f) -- | @since 5.2.0 instance (Monoid w, MonadParsec e s m) => MonadParsec e s (L.RWST r w st m) where @@ -408,6 +422,7 @@ takeP l n = lift (takeP l n) getParserState = lift getParserState updateParserState f = lift (updateParserState f) + mkParsec f = lift (mkParsec f) -- | @since 5.2.0 instance (Monoid w, MonadParsec e s m) => MonadParsec e s (S.RWST r w st m) where @@ -432,8 +447,9 @@ takeP l n = lift (takeP l n) getParserState = lift getParserState updateParserState f = lift (updateParserState f) + mkParsec f = lift (mkParsec f) -instance MonadParsec e s m => MonadParsec e s (IdentityT m) where +instance (MonadParsec e s m) => MonadParsec e s (IdentityT m) where parseError e = lift (parseError e) label n (IdentityT m) = IdentityT $ label n m try = IdentityT . try . runIdentityT @@ -451,13 +467,14 @@ takeP l n = lift (takeP l n) getParserState = lift getParserState updateParserState f = lift $ updateParserState f + mkParsec f = lift (mkParsec f) fixs :: s -> Either a (b, s) -> (Either a b, s) fixs s (Left a) = (Left a, s) fixs _ (Right (b, s)) = (Right b, s) {-# INLINE fixs #-} -fixs' :: Monoid w => s -> Either a (b, s, w) -> (Either a b, s, w) +fixs' :: (Monoid w) => s -> Either a (b, s, w) -> (Either a b, s, w) fixs' s (Left a) = (Left a, s, mempty) fixs' _ (Right (b, s, w)) = (Right b, s, w) {-# INLINE fixs' #-} diff --git a/Text/Megaparsec/Common.hs b/Text/Megaparsec/Common.hs --- a/Text/Megaparsec/Common.hs +++ b/Text/Megaparsec/Common.hs @@ -10,7 +10,7 @@ -- Stability : experimental -- Portability : portable -- --- Common token combinators. This module is not public, the functions from +-- Common token combinators. This module is not public; the functions from -- it are re-exported in "Text.Megaparsec.Byte" and "Text.Megaparsec.Char". -- -- @since 7.0.0 @@ -25,12 +25,12 @@ import Text.Megaparsec -- | A synonym for 'chunk'. -string :: MonadParsec e s m => Tokens s -> m (Tokens s) +string :: (MonadParsec e s m) => Tokens s -> m (Tokens s) string = chunk {-# INLINE string #-} --- | The same as 'string', but case-insensitive. On success returns string --- cased as the parsed input. +-- | The same as 'string', but case-insensitive. On success returns the +-- string cased as the parsed input. -- -- >>> parseTest (string' "foobar") "foObAr" -- "foObAr" diff --git a/Text/Megaparsec/Debug.hs b/Text/Megaparsec/Debug.hs --- a/Text/Megaparsec/Debug.hs +++ b/Text/Megaparsec/Debug.hs @@ -1,4 +1,6 @@ {-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE Unsafe #-} @@ -15,109 +17,235 @@ -- -- @since 7.0.0 module Text.Megaparsec.Debug - ( dbg, + ( MonadParsecDbg (..), dbg', ) where +import Control.Monad.Identity (IdentityT, mapIdentityT) +import qualified Control.Monad.Trans.RWS.Lazy as L +import qualified Control.Monad.Trans.RWS.Strict as S +import qualified Control.Monad.Trans.Reader as L +import qualified Control.Monad.Trans.State.Lazy as L +import qualified Control.Monad.Trans.State.Strict as S +import qualified Control.Monad.Trans.Writer.Lazy as L +import qualified Control.Monad.Trans.Writer.Strict as S +import Data.Bifunctor (Bifunctor (first)) +import qualified Data.List as List import qualified Data.List.NonEmpty as NE import Data.Proxy +import qualified Data.Set as E import Debug.Trace +import Text.Megaparsec.Class (MonadParsec) import Text.Megaparsec.Error import Text.Megaparsec.Internal import Text.Megaparsec.State import Text.Megaparsec.Stream --- | @'dbg' label p@ parser works exactly like @p@, but when it's evaluated --- it prints information useful for debugging. The @label@ is only used to --- refer to this parser in the debugging output. This combinator uses the --- 'trace' function from "Debug.Trace" under the hood. +-- | Type class describing parser monads that can trace during evaluation. -- --- Typical usage is to wrap every sub-parser in misbehaving parser with --- 'dbg' assigning meaningful labels. Then give it a shot and go through the --- print-out. As of current version, this combinator prints all available --- information except for /hints/, which are probably only interesting to --- the maintainer of Megaparsec itself and may be quite verbose to output in --- general. Let me know if you would like to be able to see hints in the --- debugging output. +-- @since 9.3.0 +class (MonadParsec e s m) => MonadParsecDbg e s m where + -- | The @'dbg' label p@ parser works exactly like @p@, but when it's + -- evaluated it prints information useful for debugging. The @label@ is only + -- used to refer to this parser in the debugging output. This combinator + -- uses the 'trace' function from "Debug.Trace" under the hood. + -- + -- Typical usage is to wrap every sub-parser of a misbehaving parser with + -- 'dbg', assigning meaningful labels. Then give it a shot and go through + -- the print-out. As of the current version, this combinator prints all + -- available information except for /hints/, which are probably only + -- interesting to the maintainer of Megaparsec itself and may be quite + -- verbose to output in general. Let me know if you would like to be able to + -- see hints in the debugging output. + -- + -- The output itself is pretty self-explanatory, although the following + -- abbreviations should be clarified (they are derived from the low-level + -- source code): + -- + -- * @COK@—“consumed OK”. The parser consumed input and succeeded. + -- * @CERR@—“consumed error”. The parser consumed input and failed. + -- * @EOK@—“empty OK”. The parser succeeded without consuming input. + -- * @EERR@—“empty error”. The parser failed without consuming input. + -- + -- __Note__: up until version /9.3.0/ this was a non-polymorphic function + -- that worked only in 'ParsecT'. It was first introduced in version + -- /7.0.0/. + dbg :: + (Show a) => + -- | Debugging label + String -> + -- | Parser to debug + m a -> + -- | Parser that prints debugging messages + m a + +-- | @dbg (p :: StateT st m)@ prints state __after__ running @p@: -- --- The output itself is pretty self-explanatory, although the following --- abbreviations should be clarified (they are derived from the low-level --- source code): +-- >>> p = modify succ >> dbg "a" (single 'a' >> modify succ) +-- >>> parseTest (runStateT p 0) "a" +-- a> IN: 'a' +-- a> MATCH (COK): 'a' +-- a> VALUE: () (STATE: 2) +-- ((),2) +instance + (Show st, MonadParsecDbg e s m) => + MonadParsecDbg e s (L.StateT st m) + where + dbg str sma = L.StateT $ \s -> + dbgWithComment "STATE" str $ L.runStateT sma s + +-- | @dbg (p :: StateT st m)@ prints state __after__ running @p@: -- --- * @COK@—“consumed OK”. The parser consumed input and succeeded. --- * @CERR@—“consumed error”. The parser consumed input and failed. --- * @EOK@—“empty OK”. The parser succeeded without consuming input. --- * @EERR@—“empty error”. The parser failed without consuming input. +-- >>> p = modify succ >> dbg "a" (single 'a' >> modify succ) +-- >>> parseTest (runStateT p 0) "a" +-- a> IN: 'a' +-- a> MATCH (COK): 'a' +-- a> VALUE: () (STATE: 2) +-- ((),2) +instance + (Show st, MonadParsecDbg e s m) => + MonadParsecDbg e s (S.StateT st m) + where + dbg str sma = S.StateT $ \s -> + dbgWithComment "STATE" str $ S.runStateT sma s + +instance + (MonadParsecDbg e s m) => + MonadParsecDbg e s (L.ReaderT r m) + where + dbg = L.mapReaderT . dbg + +-- | @dbg (p :: WriterT st m)@ prints __only__ log produced by @p@: -- --- Finally, it's not possible to lift this function into some monad --- transformers without introducing surprising behavior (e.g. unexpected --- state backtracking) or adding otherwise redundant constraints (e.g. --- 'Show' instance for state), so this helper is only available for --- 'ParsecT' monad, not any instance of 'Text.Megaparsec.MonadParsec' in --- general. -dbg :: - forall e s m a. - ( VisualStream s, - ShowErrorComponent e, - Show a - ) => - -- | Debugging label - String -> - -- | Parser to debug - ParsecT e s m a -> - -- | Parser that prints debugging messages - ParsecT e s m a -dbg lbl p = ParsecT $ \s cok cerr eok eerr -> - let l = dbgLog lbl :: DbgItem s e a -> String - unfold = streamTake 40 - cok' x s' hs = - flip trace (cok x s' hs) $ - l (DbgIn (unfold (stateInput s))) - ++ l (DbgCOK (streamTake (streamDelta s s') (stateInput s)) x) - cerr' err s' = - flip trace (cerr err s') $ - l (DbgIn (unfold (stateInput s))) - ++ l (DbgCERR (streamTake (streamDelta s s') (stateInput s)) err) - eok' x s' hs = - flip trace (eok x s' hs) $ - l (DbgIn (unfold (stateInput s))) - ++ l (DbgEOK (streamTake (streamDelta s s') (stateInput s)) x) - eerr' err s' = - flip trace (eerr err s') $ - l (DbgIn (unfold (stateInput s))) - ++ l (DbgEERR (streamTake (streamDelta s s') (stateInput s)) err) - in unParser p s cok' cerr' eok' eerr' +-- >>> p = tell [0] >> dbg "a" (single 'a' >> tell [1]) +-- >>> parseTest (runWriterT p) "a" +-- a> IN: 'a' +-- a> MATCH (COK): 'a' +-- a> VALUE: () (LOG: [1]) +-- ((),[0,1]) +instance + (Monoid w, Show w, MonadParsecDbg e s m) => + MonadParsecDbg e s (L.WriterT w m) + where + dbg str wma = L.WriterT $ dbgWithComment "LOG" str $ L.runWriterT wma --- | Just like 'dbg', but doesn't require the return value of the parser to --- be 'Show'-able. +-- | @dbg (p :: WriterT st m)@ prints __only__ log produced by @p@: -- --- @since 9.1.0 -dbg' :: - forall e s m a. - ( VisualStream s, - ShowErrorComponent e - ) => - -- | Debugging label +-- >>> p = tell [0] >> dbg "a" (single 'a' >> tell [1]) +-- >>> parseTest (runWriterT p) "a" +-- a> IN: 'a' +-- a> MATCH (COK): 'a' +-- a> VALUE: () (LOG: [1]) +-- ((),[0,1]) +instance + (Monoid w, Show w, MonadParsecDbg e s m) => + MonadParsecDbg e s (S.WriterT w m) + where + dbg str wma = S.WriterT $ dbgWithComment "LOG" str $ S.runWriterT wma + +-- | @RWST@ works like @StateT@ inside a @WriterT@: the subparser's log and +-- its final state are printed: +-- +-- >>> p = tell [0] >> modify succ >> dbg "a" (single 'a' >> tell [1] >> modify succ) +-- >>> parseTest (runRWST p () 0) "a" +-- a> IN: 'a' +-- a> MATCH (COK): 'a' +-- a> VALUE: () (STATE: 2) (LOG: [1]) +-- ((),2,[0,1]) +instance + (Monoid w, Show w, Show st, MonadParsecDbg e s m) => + MonadParsecDbg e s (L.RWST r w st m) + where + dbg str sma = L.RWST $ \r s -> do + let smth = + (\(a, st, w) -> ShowComment "LOG" (ShowComment "STATE" (a, st), w)) + <$> L.runRWST sma r s + ((a, st), w) <- first unComment . unComment <$> dbg str smth + pure (a, st, w) + +-- | @RWST@ works like @StateT@ inside a @WriterT@: the subparser's log and +-- its final state are printed: +-- +-- >>> p = tell [0] >> modify succ >> dbg "a" (single 'a' >> tell [1] >> modify succ) +-- >>> parseTest (runRWST p () 0) "a" +-- a> IN: 'a' +-- a> MATCH (COK): 'a' +-- a> VALUE: () (STATE: 2) (LOG: [1]) +-- ((),2,[0,1]) +instance + (Monoid w, Show w, Show st, MonadParsecDbg e s m) => + MonadParsecDbg e s (S.RWST r w st m) + where + dbg str sma = S.RWST $ \r s -> do + let smth = + (\(a, st, w) -> ShowComment "LOG" (ShowComment "STATE" (a, st), w)) + <$> S.runRWST sma r s + ((a, st), w) <- first unComment . unComment <$> dbg str smth + pure (a, st, w) + +instance (MonadParsecDbg e s m) => MonadParsecDbg e s (IdentityT m) where + dbg = mapIdentityT . dbg + +-- | @'dbgWithComment' label_a label_c m@ traces the first component of the +-- result produced by @m@ with @label_a@ and the second component with +-- @label_c@. +dbgWithComment :: + (MonadParsecDbg e s m, Show a, Show c) => + -- | Debugging label (for @a@) String -> + -- | Extra component label (for @c@) + String -> -- | Parser to debug - ParsecT e s m a -> + m (a, c) -> -- | Parser that prints debugging messages - ParsecT e s m a -dbg' lbl p = unBlind <$> dbg lbl (Blind <$> p) + m (a, c) +dbgWithComment lbl str ma = + unComment <$> dbg str (ShowComment lbl <$> ma) --- | A wrapper type with a dummy 'Show' instance. -newtype Blind x = Blind {unBlind :: x} +-- | A wrapper with a special show instance: +-- +-- >>> show (ShowComment "STATE" ("Hello, world!", 42)) +-- Hello, world! (STATE: 42) +data ShowComment c a = ShowComment String (a, c) -instance Show (Blind x) where - show _ = "NOT SHOWN" +unComment :: ShowComment c a -> (a, c) +unComment (ShowComment _ val) = val +instance (Show c, Show a) => Show (ShowComment c a) where + show (ShowComment lbl (a, c)) = show a ++ " (" ++ lbl ++ ": " ++ show c ++ ")" + +instance + (VisualStream s, ShowErrorComponent e) => + MonadParsecDbg e s (ParsecT e s m) + where + dbg lbl p = ParsecT $ \s cok cerr eok eerr -> + let l = dbgLog lbl + unfold = streamTake 40 + cok' x s' hs = + flip trace (cok x s' hs) $ + l (DbgIn (unfold (stateInput s))) + ++ l (DbgCOK (streamTake (streamDelta s s') (stateInput s)) x hs) + cerr' err s' = + flip trace (cerr err s') $ + l (DbgIn (unfold (stateInput s))) + ++ l (DbgCERR (streamTake (streamDelta s s') (stateInput s)) err) + eok' x s' hs = + flip trace (eok x s' hs) $ + l (DbgIn (unfold (stateInput s))) + ++ l (DbgEOK (streamTake (streamDelta s s') (stateInput s)) x hs) + eerr' err s' = + flip trace (eerr err s') $ + l (DbgIn (unfold (stateInput s))) + ++ l (DbgEERR (streamTake (streamDelta s s') (stateInput s)) err) + in unParser p s cok' cerr' eok' eerr' + -- | A single piece of info to be rendered with 'dbgLog'. data DbgItem s e a = DbgIn [Token s] - | DbgCOK [Token s] a + | DbgCOK [Token s] a (Hints (Token s)) | DbgCERR [Token s] (ParseError s e) - | DbgEOK [Token s] a + | DbgEOK [Token s] a (Hints (Token s)) | DbgEERR [Token s] (ParseError s e) -- | Render a single piece of debugging info. @@ -134,20 +262,31 @@ where prefix = unlines . fmap ((lbl ++ "> ") ++) . lines pxy = Proxy :: Proxy s + showHints hs = "[" ++ List.intercalate "," (showErrorItem pxy <$> E.toAscList hs) ++ "]" msg = case item of DbgIn ts -> "IN: " ++ showStream pxy ts - DbgCOK ts a -> - "MATCH (COK): " ++ showStream pxy ts ++ "\nVALUE: " ++ show a + DbgCOK ts a (Hints hs) -> + "MATCH (COK): " + ++ showStream pxy ts + ++ "\nVALUE: " + ++ show a + ++ "\nHINTS: " + ++ showHints hs DbgCERR ts e -> "MATCH (CERR): " ++ showStream pxy ts ++ "\nERROR:\n" ++ parseErrorPretty e - DbgEOK ts a -> - "MATCH (EOK): " ++ showStream pxy ts ++ "\nVALUE: " ++ show a + DbgEOK ts a (Hints hs) -> + "MATCH (EOK): " + ++ showStream pxy ts + ++ "\nVALUE: " + ++ show a + ++ "\nHINTS: " + ++ showHints hs DbgEERR ts e -> "MATCH (EERR): " ++ showStream pxy ts ++ "\nERROR:\n" ++ parseErrorPretty e -- | Pretty-print a list of tokens. -showStream :: VisualStream s => Proxy s -> [Token s] -> String +showStream :: (VisualStream s) => Proxy s -> [Token s] -> String showStream pxy ts = case NE.nonEmpty ts of Nothing -> "" @@ -155,20 +294,40 @@ let (h, r) = splitAt 40 (showTokens pxy ne) in if null r then h else h ++ " <…>" --- | Calculate number of consumed tokens given 'State' of parser before and --- after parsing. +-- | Calculate the number of consumed tokens given the 'State' of the parser +-- before and after parsing. streamDelta :: - -- | State of parser before consumption + -- | State of the parser before consumption State s e -> - -- | State of parser after consumption + -- | State of the parser after consumption State s e -> -- | Number of consumed tokens Int streamDelta s0 s1 = stateOffset s1 - stateOffset s0 -- | Extract a given number of tokens from the stream. -streamTake :: forall s. Stream s => Int -> s -> [Token s] +streamTake :: forall s. (Stream s) => Int -> s -> [Token s] streamTake n s = case fst <$> takeN_ n s of Nothing -> [] Just chk -> chunkToTokens (Proxy :: Proxy s) chk + +-- | Just like 'dbg', but doesn't require the return value of the parser to +-- be 'Show'-able. +-- +-- @since 9.1.0 +dbg' :: + (MonadParsecDbg e s m) => + -- | Debugging label + String -> + -- | Parser to debug + m a -> + -- | Parser that prints debugging messages + m a +dbg' lbl p = unBlind <$> dbg lbl (Blind <$> p) + +-- | A wrapper type with a dummy 'Show' instance. +newtype Blind x = Blind {unBlind :: x} + +instance Show (Blind x) where + show _ = "NOT SHOWN" diff --git a/Text/Megaparsec/Error.hs b/Text/Megaparsec/Error.hs --- a/Text/Megaparsec/Error.hs +++ b/Text/Megaparsec/Error.hs @@ -41,11 +41,15 @@ -- * Pretty-printing ShowErrorComponent (..), errorBundlePretty, + errorBundlePrettyForGhcPreProcessors, + errorBundlePrettyWith, parseErrorPretty, parseErrorTextPretty, + showErrorItem, ) where +import Control.Arrow ((>>>)) import Control.DeepSeq import Control.Exception import Control.Monad.State.Strict @@ -63,11 +67,12 @@ import Text.Megaparsec.Pos import Text.Megaparsec.State import Text.Megaparsec.Stream +import qualified Text.Megaparsec.Unicode as Unicode ---------------------------------------------------------------------------- -- Parse error type --- | A data type that is used to represent “unexpected\/expected” items in +-- | A data type that is used to represent “unexpected\/expected” items in a -- 'ParseError'. It is parametrized over the token type @t@. -- -- @since 5.0.0 @@ -78,17 +83,17 @@ Label (NonEmpty Char) | -- | End of input EndOfInput - deriving (Show, Read, Eq, Ord, Data, Typeable, Generic, Functor) + deriving (Show, Read, Eq, Ord, Data, Generic, Functor) -instance NFData t => NFData (ErrorItem t) +instance (NFData t) => NFData (ErrorItem t) --- | Additional error data, extendable by user. When no custom data is +-- | Additional error data, extendable by the user. When no custom data is -- necessary, the type is typically indexed by 'Void' to “cancel” the -- 'ErrorCustom' constructor. -- -- @since 6.0.0 data ErrorFancy e - = -- | 'fail' has been used in parser monad + = -- | 'fail' has been used in the parser monad ErrorFail String | -- | Incorrect indentation error: desired ordering between reference -- level and actual level, reference indentation level, actual @@ -96,9 +101,9 @@ ErrorIndentation Ordering Pos Pos | -- | Custom error data ErrorCustom e - deriving (Show, Read, Eq, Ord, Data, Typeable, Generic, Functor) + deriving (Show, Read, Eq, Ord, Data, Generic, Functor) -instance NFData a => NFData (ErrorFancy a) where +instance (NFData a) => NFData (ErrorFancy a) where rnf (ErrorFail str) = rnf str rnf (ErrorIndentation ord ref act) = ord `seq` rnf ref `seq` rnf act rnf (ErrorCustom a) = rnf a @@ -118,13 +123,13 @@ -- constructor includes the offset of error, unexpected token (if any), -- and expected tokens. -- - -- Type of the first argument was changed in the version /7.0.0/. + -- The type of the first argument was changed in version /7.0.0/. TrivialError Int (Maybe (ErrorItem (Token s))) (Set (ErrorItem (Token s))) | -- | Fancy, custom errors. -- - -- Type of the first argument was changed in the version /7.0.0/. + -- The type of the first argument was changed in version /7.0.0/. FancyError Int (Set (ErrorFancy e)) - deriving (Typeable, Generic) + deriving (Generic) deriving instance ( Show (Token s), @@ -163,8 +168,7 @@ {-# INLINE mappend #-} instance - ( Show s, - Show (Token s), + ( Show (Token s), Show e, ShowErrorComponent e, VisualStream s, @@ -180,7 +184,7 @@ -- -- @since 7.0.0 mapParseError :: - Ord e' => + (Ord e') => (e -> e') -> ParseError s e -> ParseError s e' @@ -201,11 +205,11 @@ setErrorOffset o (TrivialError _ u p) = TrivialError o u p setErrorOffset o (FancyError _ x) = FancyError o x --- | Merge two error data structures into one joining their collections of --- message items and preferring the longest match. In other words, earlier --- error message is discarded. This may seem counter-intuitive, but +-- | Merge two error data structures into one, joining their collections of +-- message items and preferring the longest match. In other words, the +-- earlier error message is discarded. This may seem counter-intuitive, but -- 'mergeError' is only used to merge error messages of alternative branches --- of parsing and in this case longest match should be preferred. +-- of parsing, and in this case the longest match should be preferred. mergeError :: (Stream s, Ord e) => ParseError s e -> @@ -238,7 +242,7 @@ n (Just x) (Just y) = Just (max x y) {-# INLINE mergeError #-} --- | A non-empty collection of 'ParseError's equipped with 'PosState' that +-- | A non-empty collection of 'ParseError's equipped with a 'PosState' that -- allows us to pretty-print the errors efficiently and correctly. -- -- @since 7.0.0 @@ -265,13 +269,6 @@ Eq (ParseErrorBundle s e) deriving instance - ( Typeable s, - Typeable (Token s), - Typeable e - ) => - Typeable (ParseErrorBundle s e) - -deriving instance ( Data s, Data (Token s), Ord (Token s), @@ -332,12 +329,12 @@ -- | The type class defines how to print a custom component of 'ParseError'. -- -- @since 5.0.0 -class Ord a => ShowErrorComponent a where +class (Ord a) => ShowErrorComponent a where -- | Pretty-print a component of 'ParseError'. showErrorComponent :: a -> String - -- | Length of the error component in characters, used for highlighting of - -- parse errors in input string. + -- | Length of the error component in characters, used for highlighting + -- parse errors in the input string. -- -- @since 7.0.0 errorComponentLen :: a -> Int @@ -347,24 +344,24 @@ showErrorComponent = absurd -- | Pretty-print a 'ParseErrorBundle'. All 'ParseError's in the bundle will --- be pretty-printed in order together with the corresponding offending --- lines by doing a single pass over the input stream. The rendered 'String' --- always ends with a newline. +-- be pretty-printed in order, by applying a provided format function, with +-- a single pass over the input stream. -- --- @since 7.0.0 -errorBundlePretty :: +-- @since 9.7.0 +errorBundlePrettyWith :: forall s e. ( VisualStream s, - TraversableStream s, - ShowErrorComponent e + TraversableStream s ) => + -- | Format function for a single 'ParseError' + (Maybe String -> SourcePos -> ParseError s e -> String) -> -- | Parse error bundle to display ParseErrorBundle s e -> -- | Textual rendition of the bundle String -errorBundlePretty ParseErrorBundle {..} = +errorBundlePrettyWith format ParseErrorBundle {..} = let (r, _) = foldl f (id, bundlePosState) bundleErrors - in drop 1 (r "") + in r "" where f :: (ShowS, PosState s) -> @@ -374,6 +371,33 @@ where (msline, pst') = reachOffset (errorOffset e) pst epos = pstateSourcePos pst' + outChunk = format msline epos e + +-- | Pretty-print a 'ParseErrorBundle'. All 'ParseError's in the bundle will +-- be pretty-printed in order together with the corresponding offending +-- lines by doing a single pass over the input stream. The rendered 'String' +-- always ends with a newline. +-- +-- @since 7.0.0 +errorBundlePretty :: + forall s e. + ( VisualStream s, + TraversableStream s, + ShowErrorComponent e + ) => + -- | Parse error bundle to display + ParseErrorBundle s e -> + -- | Textual rendition of the bundle + String +errorBundlePretty = drop 1 . errorBundlePrettyWith format + where + format :: + Maybe String -> + SourcePos -> + ParseError s e -> + String + format msline epos e = outChunk + where outChunk = "\n" <> sourcePosPretty epos @@ -384,19 +408,17 @@ case msline of Nothing -> "" Just sline -> - let rpadding = - if pointerLen > 0 - then replicate rpshift ' ' - else "" + let rpadding = replicate rpshift ' ' pointerLen = - if rpshift + elen > slineLen - then slineLen - rpshift + 1 - else elen + max 1 $ + if rpshift + elen > slineLen + then slineLen - rpshift + 1 + else elen pointer = replicate pointerLen '^' lineNumber = (show . unPos . sourceLine) epos padding = replicate (length lineNumber + 1) ' ' rpshift = unPos (sourceColumn epos) - 1 - slineLen = length sline + slineLen = Unicode.stringLength sline in padding <> "|\n" <> lineNumber @@ -416,6 +438,41 @@ FancyError _ xs -> E.foldl' (\a b -> max a (errorFancyLength b)) 1 xs +-- | Pretty-print a 'ParseErrorBundle'. All 'ParseError's in the bundle will +-- be pretty-printed in order by doing a single pass over the input stream. +-- +-- The rendered format is suitable for custom GHC pre-processors (as can be +-- specified with -F -pgmF). +-- +-- @since 9.7.0 +errorBundlePrettyForGhcPreProcessors :: + forall s e. + ( VisualStream s, + TraversableStream s, + ShowErrorComponent e + ) => + -- | Parse error bundle to display + ParseErrorBundle s e -> + -- | Textual rendition of the bundle + String +errorBundlePrettyForGhcPreProcessors = errorBundlePrettyWith format + where + format :: + Maybe String -> + SourcePos -> + ParseError s e -> + String + format _msline epos e = + sourcePosPretty epos + <> ":" + <> indent (parseErrorTextPretty e) + + indent :: String -> String + indent = + lines >>> \case + [err] -> err + err -> intercalate "\n" $ map (" " <>) err + -- | Pretty-print a 'ParseError'. The rendered 'String' always ends with a -- newline. -- @@ -458,20 +515,22 @@ -- Helpers -- | Pretty-print an 'ErrorItem'. -showErrorItem :: VisualStream s => Proxy s -> ErrorItem (Token s) -> String +-- +-- @since 9.4.0 +showErrorItem :: (VisualStream s) => Proxy s -> ErrorItem (Token s) -> String showErrorItem pxy = \case Tokens ts -> showTokens pxy ts Label label -> NE.toList label EndOfInput -> "end of input" -- | Get length of the “pointer” to display under a given 'ErrorItem'. -errorItemLength :: VisualStream s => Proxy s -> ErrorItem (Token s) -> Int +errorItemLength :: (VisualStream s) => Proxy s -> ErrorItem (Token s) -> Int errorItemLength pxy = \case Tokens ts -> tokensLength pxy ts _ -> 1 -- | Pretty-print an 'ErrorFancy'. -showErrorFancy :: ShowErrorComponent e => ErrorFancy e -> String +showErrorFancy :: (ShowErrorComponent e) => ErrorFancy e -> String showErrorFancy = \case ErrorFail msg -> msg ErrorIndentation ord ref actual -> @@ -489,7 +548,7 @@ ErrorCustom a -> showErrorComponent a -- | Get length of the “pointer” to display under a given 'ErrorFancy'. -errorFancyLength :: ShowErrorComponent e => ErrorFancy e -> Int +errorFancyLength :: (ShowErrorComponent e) => ErrorFancy e -> Int errorFancyLength = \case ErrorCustom a -> errorComponentLen a _ -> 1 diff --git a/Text/Megaparsec/Error/Builder.hs b/Text/Megaparsec/Error/Builder.hs --- a/Text/Megaparsec/Error/Builder.hs +++ b/Text/Megaparsec/Error/Builder.hs @@ -47,7 +47,6 @@ import Data.Proxy import Data.Set (Set) import qualified Data.Set as E -import Data.Typeable (Typeable) import GHC.Generics import Text.Megaparsec.Error import Text.Megaparsec.Stream @@ -57,11 +56,11 @@ -- | Auxiliary type for construction of trivial parse errors. data ET s = ET (Maybe (ErrorItem (Token s))) (Set (ErrorItem (Token s))) - deriving (Typeable, Generic) + deriving (Generic) -deriving instance Eq (Token s) => Eq (ET s) +deriving instance (Eq (Token s)) => Eq (ET s) -deriving instance Ord (Token s) => Ord (ET s) +deriving instance (Ord (Token s)) => Ord (ET s) deriving instance ( Data s, @@ -70,7 +69,7 @@ ) => Data (ET s) -instance Stream s => Semigroup (ET s) where +instance (Stream s) => Semigroup (ET s) where ET us0 ps0 <> ET us1 ps1 = ET (n us0 us1) (E.union ps0 ps1) where n Nothing Nothing = Nothing @@ -78,18 +77,18 @@ n Nothing (Just y) = Just y n (Just x) (Just y) = Just (max x y) -instance Stream s => Monoid (ET s) where +instance (Stream s) => Monoid (ET s) where mempty = ET Nothing E.empty mappend = (<>) -- | Auxiliary type for construction of fancy parse errors. newtype EF e = EF (Set (ErrorFancy e)) - deriving (Eq, Ord, Data, Typeable, Generic) + deriving (Eq, Ord, Data, Generic) -instance Ord e => Semigroup (EF e) where +instance (Ord e) => Semigroup (EF e) where EF xs0 <> EF xs1 = EF (E.union xs0 xs1) -instance Ord e => Monoid (EF e) where +instance (Ord e) => Monoid (EF e) where mempty = EF E.empty mappend = (<>) @@ -122,43 +121,43 @@ -- Error components -- | Construct an “unexpected token” error component. -utok :: Stream s => Token s -> ET s +utok :: Token s -> ET s utok = unexp . Tokens . nes --- | Construct an “unexpected tokens” error component. Empty chunk produces --- 'EndOfInput'. -utoks :: forall s. Stream s => Tokens s -> ET s +-- | Construct an “unexpected tokens” error component. An empty chunk +-- produces 'EndOfInput'. +utoks :: forall s. (Stream s) => Tokens s -> ET s utoks = unexp . canonicalizeTokens (Proxy :: Proxy s) -- | Construct an “unexpected label” error component. Do not use with empty -- strings (for empty strings it's bottom). -ulabel :: Stream s => String -> ET s +ulabel :: String -> ET s ulabel label | label == "" = error "Text.Megaparsec.Error.Builder.ulabel: empty label" | otherwise = unexp . Label . NE.fromList $ label -- | Construct an “unexpected end of input” error component. -ueof :: Stream s => ET s +ueof :: ET s ueof = unexp EndOfInput -- | Construct an “expected token” error component. -etok :: Stream s => Token s -> ET s +etok :: Token s -> ET s etok = expe . Tokens . nes --- | Construct an “expected tokens” error component. Empty chunk produces +-- | Construct an “expected tokens” error component. An empty chunk produces -- 'EndOfInput'. -etoks :: forall s. Stream s => Tokens s -> ET s +etoks :: forall s. (Stream s) => Tokens s -> ET s etoks = expe . canonicalizeTokens (Proxy :: Proxy s) -- | Construct an “expected label” error component. Do not use with empty -- strings. -elabel :: Stream s => String -> ET s +elabel :: String -> ET s elabel label | label == "" = error "Text.Megaparsec.Error.Builder.elabel: empty label" | otherwise = expe . Label . NE.fromList $ label -- | Construct an “expected end of input” error component. -eeof :: Stream s => ET s +eeof :: ET s eeof = expe EndOfInput -- | Construct a custom error component. @@ -171,7 +170,7 @@ -- | Construct the appropriate 'ErrorItem' representation for the given -- token stream. The empty string produces 'EndOfInput'. canonicalizeTokens :: - Stream s => + (Stream s) => Proxy s -> Tokens s -> ErrorItem (Token s) @@ -181,11 +180,11 @@ Just xs -> Tokens xs -- | Lift an unexpected item into 'ET'. -unexp :: Stream s => ErrorItem (Token s) -> ET s +unexp :: ErrorItem (Token s) -> ET s unexp u = ET (pure u) E.empty -- | Lift an expected item into 'ET'. -expe :: Stream s => ErrorItem (Token s) -> ET s +expe :: ErrorItem (Token s) -> ET s expe p = ET Nothing (E.singleton p) -- | Make a singleton non-empty list from a value. diff --git a/Text/Megaparsec/Internal.hs b/Text/Megaparsec/Internal.hs --- a/Text/Megaparsec/Internal.hs +++ b/Text/Megaparsec/Internal.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE LambdaCase #-} @@ -5,6 +6,7 @@ {-# LANGUAGE RankNTypes #-} {-# LANGUAGE Safe #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TupleSections #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} @@ -36,7 +38,7 @@ toHints, withHints, accHints, - refreshLastHint, + refreshHints, runParsecT, withParsecT, ) @@ -44,6 +46,7 @@ import Control.Applicative import Control.Monad +import qualified Control.Monad.Combinators import Control.Monad.Cont.Class import Control.Monad.Error.Class import qualified Control.Monad.Fail as Fail @@ -52,6 +55,7 @@ import Control.Monad.Reader.Class import Control.Monad.State.Class import Control.Monad.Trans +import Control.Monad.Writer.Class import Data.List.NonEmpty (NonEmpty (..)) import qualified Data.List.NonEmpty as NE import Data.Proxy @@ -67,10 +71,10 @@ ---------------------------------------------------------------------------- -- Data types --- | 'Hints' represent a collection of 'ErrorItem's to be included into --- 'ParseError' (when it's a 'TrivialError') as “expected” message items --- when a parser fails without consuming input right after successful parser --- that produced the hints. +-- | 'Hints' represent a collection of 'ErrorItem's to be included in a +-- 'ParseError' (when it's a 'TrivialError') as “expected” message items when +-- a parser fails without consuming input right after a successful parser that +-- produced the hints. -- -- For example, without hints you could get: -- @@ -85,42 +89,45 @@ -- 1:2: -- unexpected 'a' -- expecting 'r' or end of input -newtype Hints t = Hints [Set (ErrorItem t)] +newtype Hints t = Hints (Set (ErrorItem t)) -instance Semigroup (Hints t) where +instance (Ord t) => Semigroup (Hints t) where Hints xs <> Hints ys = Hints $ xs <> ys -instance Monoid (Hints t) where +instance (Ord t) => Monoid (Hints t) where mempty = Hints mempty -- | All information available after parsing. This includes consumption of -- input, success (with the returned value) or failure (with the parse --- error), and parser state at the end of parsing. +-- error), and the parser state at the end of parsing. 'Reply' can also be +-- used to resume parsing. -- -- See also: 'Consumption', 'Result'. data Reply e s a = Reply (State s e) Consumption (Result s e a) + deriving (Functor) -- | Whether the input has been consumed or not. -- -- See also: 'Result', 'Reply'. data Consumption - = -- | Some part of input stream was consumed + = -- | Some part of the input stream was consumed Consumed | -- | No input was consumed - Virgin + NotConsumed -- | Whether the parser has failed or not. On success we include the -- resulting value, on failure we include a 'ParseError'. -- -- See also: 'Consumption', 'Reply'. data Result s e a - = -- | Parser succeeded - OK a + = -- | Parser succeeded (includes hints) + OK (Hints (Token s)) a | -- | Parser failed Error (ParseError s e) + deriving (Functor) --- | @'ParsecT' e s m a@ is a parser with custom data component of error --- @e@, stream type @s@, underlying monad @m@ and return type @a@. +-- | @'ParsecT' e s m a@ is a parser with custom error data component @e@, +-- stream type @s@, underlying monad @m@, and return type @a@. newtype ParsecT e s m a = ParsecT { unParser :: forall b. @@ -164,18 +171,20 @@ {-# INLINE pMap #-} -- | 'pure' returns a parser that __succeeds__ without consuming input. -instance Stream s => Applicative (ParsecT e s m) where +instance (Stream s) => Applicative (ParsecT e s m) where pure = pPure (<*>) = pAp p1 *> p2 = p1 `pBind` const p2 + {-# INLINE (*>) #-} p1 <* p2 = do x1 <- p1; void p2; return x1 + {-# INLINE (<*) #-} -pPure :: a -> ParsecT e s m a +pPure :: (Stream s) => a -> ParsecT e s m a pPure x = ParsecT $ \s _ _ eok _ -> eok x s mempty {-# INLINE pPure #-} pAp :: - Stream s => + (Stream s) => ParsecT e s m (a -> b) -> ParsecT e s m a -> ParsecT e s m b @@ -203,14 +212,16 @@ instance (Ord e, Stream s) => Alternative (ParsecT e s m) where empty = mzero (<|>) = mplus + many = Control.Monad.Combinators.many + some = Control.Monad.Combinators.some -- | 'return' returns a parser that __succeeds__ without consuming input. -instance Stream s => Monad (ParsecT e s m) where +instance (Stream s) => Monad (ParsecT e s m) where return = pure (>>=) = pBind pBind :: - Stream s => + (Stream s) => ParsecT e s m a -> (a -> ParsecT e s m b) -> ParsecT e s m b @@ -234,7 +245,7 @@ in unParser m s mcok cerr meok eerr {-# INLINE pBind #-} -instance Stream s => Fail.MonadFail (ParsecT e s m) where +instance (Stream s) => Fail.MonadFail (ParsecT e s m) where fail = pFail pFail :: String -> ParsecT e s m a @@ -248,46 +259,84 @@ instance (Stream s, MonadReader r m) => MonadReader r (ParsecT e s m) where ask = lift ask - local f p = mkPT $ \s -> local f (runParsecT p s) + local f = hoistP (local f) instance (Stream s, MonadState st m) => MonadState st (ParsecT e s m) where get = lift get put = lift . put +hoistP :: + (Monad m) => + (m (Reply e s a) -> m (Reply e s b)) -> + ParsecT e s m a -> + ParsecT e s m b +hoistP h p = mkParsecT (h . runParsecT p) + +-- | @since 9.5.0 +instance (Stream s, MonadWriter w m) => MonadWriter w (ParsecT e s m) where + tell w = lift (tell w) + listen = hoistP (fmap (\(repl, w) -> fmap (,w) repl) . listen) + pass = hoistP $ \m -> pass $ do + Reply st consumption r <- m + let (r', ww') = case r of + OK hs (x, ww) -> (OK hs x, ww) + Error e -> (Error e, id) + return (Reply st consumption r', ww') + instance (Stream s, MonadCont m) => MonadCont (ParsecT e s m) where - callCC f = mkPT $ \s -> + callCC f = mkParsecT $ \s -> callCC $ \c -> - runParsecT (f (\a -> mkPT $ \s' -> c (pack s' a))) s + runParsecT (f (\a -> mkParsecT $ \s' -> c (pack s' a))) s where - pack s a = Reply s Virgin (OK a) + pack s a = Reply s NotConsumed (OK mempty a) instance (Stream s, MonadError e' m) => MonadError e' (ParsecT e s m) where throwError = lift . throwError - p `catchError` h = mkPT $ \s -> + p `catchError` h = mkParsecT $ \s -> runParsecT p s `catchError` \e -> runParsecT (h e) s -mkPT :: Monad m => (State s e -> m (Reply e s a)) -> ParsecT e s m a -mkPT k = ParsecT $ \s cok cerr eok eerr -> do +mkParsecT :: + (Monad m) => + (State s e -> m (Reply e s a)) -> + ParsecT e s m a +mkParsecT k = ParsecT $ \s cok cerr eok eerr -> do (Reply s' consumption result) <- k s case consumption of Consumed -> case result of - OK x -> cok x s' mempty + OK hs x -> cok x s' hs Error e -> cerr e s' - Virgin -> + NotConsumed -> case result of - OK x -> eok x s' mempty + OK hs x -> eok x s' hs Error e -> eerr e s' +{-# INLINE mkParsecT #-} +pmkParsec :: + (State s e -> Reply e s a) -> + ParsecT e s m a +pmkParsec k = ParsecT $ \s cok cerr eok eerr -> + let (Reply s' consumption result) = k s + in case consumption of + Consumed -> + case result of + OK hs x -> cok x s' hs + Error e -> cerr e s' + NotConsumed -> + case result of + OK hs x -> eok x s' hs + Error e -> eerr e s' +{-# INLINE pmkParsec #-} + -- | 'mzero' is a parser that __fails__ without consuming input. -- -- __Note__: strictly speaking, this instance is unlawful. The right -- identity law does not hold, e.g. in general this is not true: -- --- > v >> mzero = mero +-- > v >> mzero = mzero -- --- However the following holds: +-- However, the following holds: -- -- > try v >> mzero = mzero instance (Ord e, Stream s) => MonadPlus (ParsecT e s m) where @@ -308,9 +357,20 @@ let meerr err ms = let ncerr err' s' = cerr (err' <> err) (longestMatch ms s') neok x s' hs = eok x s' (toHints (stateOffset s') err <> hs) - neerr err' s' = eerr (err' <> err) (longestMatch ms s') + neerr err' s' = + let combinedErr = combineErrors (stateOffset s) err err' + in eerr combinedErr (longestMatch ms s') in unParser n s cok ncerr neok neerr in unParser m s cok cerr eok meerr + where + combineErrors altOffset e1 e2 = case (e1, e2) of + (TrivialError o1 u1 p1, TrivialError o2 _ _) + | o1 == altOffset && o2 > altOffset -> + TrivialError altOffset u1 p1 + (TrivialError o1 _ _, TrivialError o2 u2 p2) + | o2 == altOffset && o1 > altOffset -> + TrivialError altOffset u2 p2 + _ -> e2 <> e1 {-# INLINE pPlus #-} -- | From two states, return the one with the greater number of processed @@ -326,13 +386,13 @@ -- | @since 6.0.0 instance (Stream s, MonadFix m) => MonadFix (ParsecT e s m) where - mfix f = mkPT $ \s -> mfix $ \(~(Reply _ _ result)) -> do + mfix f = mkParsecT $ \s -> mfix $ \(~(Reply _ _ result)) -> do let a = case result of - OK a' -> a' + OK _ a' -> a' Error _ -> error "mfix ParsecT" runParsecT (f a) s -instance Stream s => MonadTrans (ParsecT e s) where +instance (Stream s) => MonadTrans (ParsecT e s) where lift amb = ParsecT $ \s _ _ eok _ -> amb >>= \a -> eok a s mempty @@ -352,6 +412,7 @@ takeP = pTakeP getParserState = pGetParserState updateParserState = pUpdateParserState + mkParsec = pmkParsec pParseError :: ParseError s e -> @@ -364,9 +425,9 @@ let el = Label <$> NE.nonEmpty l cok' x s' hs = case el of - Nothing -> cok x s' (refreshLastHint hs Nothing) + Nothing -> cok x s' (refreshHints hs Nothing) Just _ -> cok x s' hs - eok' x s' hs = eok x s' (refreshLastHint hs el) + eok' x s' hs = eok x s' (refreshHints hs el) eerr' err = eerr $ case err of (TrivialError pos us _) -> @@ -381,25 +442,25 @@ in unParser p s cok eerr' eok eerr' {-# INLINE pTry #-} -pLookAhead :: ParsecT e s m a -> ParsecT e s m a +pLookAhead :: (Stream s) => ParsecT e s m a -> ParsecT e s m a pLookAhead p = ParsecT $ \s _ cerr eok eerr -> let eok' a _ _ = eok a s mempty in unParser p s eok' cerr eok' eerr {-# INLINE pLookAhead #-} -pNotFollowedBy :: Stream s => ParsecT e s m a -> ParsecT e s m () +pNotFollowedBy :: (Stream s) => ParsecT e s m a -> ParsecT e s m () pNotFollowedBy p = ParsecT $ \s@(State input o _ _) _ _ eok eerr -> let what = maybe EndOfInput (Tokens . nes . fst) (take1_ input) - unexpect u = TrivialError o (pure u) E.empty - cok' _ _ _ = eerr (unexpect what) s + unexpected u = TrivialError o (pure u) E.empty + cok' _ _ _ = eerr (unexpected what) s cerr' _ _ = eok () s mempty - eok' _ _ _ = eerr (unexpect what) s + eok' _ _ _ = eerr (unexpected what) s eerr' _ _ = eok () s mempty in unParser p s cok' cerr' eok' eerr' {-# INLINE pNotFollowedBy #-} pWithRecovery :: - Stream s => + (Stream s) => (ParseError s e -> ParsecT e s m a) -> ParsecT e s m a -> ParsecT e s m a @@ -420,7 +481,7 @@ {-# INLINE pWithRecovery #-} pObserving :: - Stream s => + (Stream s) => ParsecT e s m a -> ParsecT e s m (Either (ParseError s e) a) pObserving p = ParsecT $ \s cok _ eok _ -> @@ -429,7 +490,7 @@ in unParser p s (cok . Right) cerr' (eok . Right) eerr' {-# INLINE pObserving #-} -pEof :: forall e s m. Stream s => ParsecT e s m () +pEof :: forall e s m. (Stream s) => ParsecT e s m () pEof = ParsecT $ \s@(State input o pst de) _ _ eok eerr -> case take1_ input of Nothing -> eok () s mempty @@ -443,7 +504,7 @@ pToken :: forall e s m a. - Stream s => + (Stream s) => (Token s -> Maybe a) -> Set (ErrorItem (Token s)) -> ParsecT e s m a @@ -465,20 +526,20 @@ pTokens :: forall e s m. - Stream s => + (Stream s) => (Tokens s -> Tokens s -> Bool) -> Tokens s -> ParsecT e s m (Tokens s) pTokens f tts = ParsecT $ \s@(State input o pst de) cok _ eok eerr -> let pxy = Proxy :: Proxy s - unexpect pos' u = + unexpected pos' u = let us = pure u ps = (E.singleton . Tokens . NE.fromList . chunkToTokens pxy) tts in TrivialError pos' us ps len = chunkLength pxy tts in case takeN_ len input of Nothing -> - eerr (unexpect o EndOfInput) s + eerr (unexpected o EndOfInput) s Just (tts', input') -> if f tts tts' then @@ -488,12 +549,12 @@ else cok tts' st mempty else let ps = (Tokens . NE.fromList . chunkToTokens pxy) tts' - in eerr (unexpect o ps) (State input o pst de) + in eerr (unexpected o ps) (State input o pst de) {-# INLINE pTokens #-} pTakeWhileP :: forall e s m. - Stream s => + (Stream s) => Maybe String -> (Token s -> Bool) -> ParsecT e s m (Tokens s) @@ -504,7 +565,7 @@ hs = case ml >>= NE.nonEmpty of Nothing -> mempty - Just l -> (Hints . pure . E.singleton . Label) l + Just l -> (Hints . E.singleton . Label) l in if chunkEmpty pxy ts then eok ts (State input' (o + len) pst de) hs else cok ts (State input' (o + len) pst de) hs @@ -512,7 +573,7 @@ pTakeWhile1P :: forall e s m. - Stream s => + (Stream s) => Maybe String -> (Token s -> Bool) -> ParsecT e s m (Tokens s) @@ -524,7 +585,7 @@ hs = case el of Nothing -> mempty - Just l -> (Hints . pure . E.singleton) l + Just l -> (Hints . E.singleton) l in if chunkEmpty pxy ts then let us = pure $ @@ -540,12 +601,13 @@ pTakeP :: forall e s m. - Stream s => + (Stream s) => Maybe String -> Int -> ParsecT e s m (Tokens s) -pTakeP ml n = ParsecT $ \s@(State input o pst de) cok _ _ eerr -> - let pxy = Proxy :: Proxy s +pTakeP ml n' = ParsecT $ \s@(State input o pst de) cok _ eok eerr -> + let n = max 0 n' + pxy = Proxy :: Proxy s el = Label <$> (ml >>= NE.nonEmpty) ps = maybe E.empty E.singleton el in case takeN_ n input of @@ -553,19 +615,26 @@ eerr (TrivialError o (pure EndOfInput) ps) s Just (ts, input') -> let len = chunkLength pxy ts + st = State input' (o + len) pst de in if len /= n then eerr (TrivialError (o + len) (pure EndOfInput) ps) (State input o pst de) - else cok ts (State input' (o + len) pst de) mempty + else + -- NOTE When nothing has been taken we must report that no + -- input has been consumed, otherwise e.g. ('<|>') would + -- not try its second branch after this parser. + if chunkEmpty pxy ts + then eok ts st mempty + else cok ts st mempty {-# INLINE pTakeP #-} -pGetParserState :: ParsecT e s m (State s e) +pGetParserState :: (Stream s) => ParsecT e s m (State s e) pGetParserState = ParsecT $ \s _ _ eok _ -> eok s s mempty {-# INLINE pGetParserState #-} -pUpdateParserState :: (State s e -> State s e) -> ParsecT e s m () +pUpdateParserState :: (Stream s) => (State s e -> State s e) -> ParsecT e s m () pUpdateParserState f = ParsecT $ \s _ _ eok _ -> eok () (f s) mempty {-# INLINE pUpdateParserState #-} @@ -578,8 +647,8 @@ -- | Convert a 'ParseError' record into 'Hints'. toHints :: - Stream s => - -- | Current offset in input stream + (Stream s) => + -- | Current offset in the input stream Int -> -- | Parse error to convert ParseError s e -> @@ -591,17 +660,18 @@ -- there might have been backtracking with 'try' and in that case we -- must not convert such a parse error to hints. if streamPos == errOffset - then Hints (if E.null ps then [] else [ps]) + then Hints (if E.null ps then E.empty else ps) else mempty FancyError _ _ -> mempty {-# INLINE toHints #-} --- | @'withHints' hs c@ makes “error” continuation @c@ use given hints @hs@. +-- | @'withHints' hs c@ makes the “error” continuation @c@ use the given +-- hints @hs@. -- --- __Note__ that if resulting continuation gets 'ParseError' that has custom --- data in it, hints are ignored. +-- __Note__ that if the resulting continuation gets a 'ParseError' that has +-- custom data in it, the hints are ignored. withHints :: - Stream s => + (Stream s) => -- | Hints to use Hints (Token s) -> -- | Continuation to influence @@ -613,34 +683,36 @@ m b withHints (Hints ps') c e = case e of - TrivialError pos us ps -> c (TrivialError pos us (E.unions (ps : ps'))) + TrivialError pos us ps -> c (TrivialError pos us (E.union ps ps')) _ -> c e {-# INLINE withHints #-} --- | @'accHints' hs c@ results in “OK” continuation that will add given --- hints @hs@ to third argument of original continuation @c@. +-- | @'accHints' hs c@ results in an “OK” continuation that will add the given +-- hints @hs@ to the third argument of the original continuation @c@. accHints :: + (Stream s) => -- | 'Hints' to add - Hints t -> + Hints (Token s) -> -- | An “OK” continuation to alter - (a -> State s e -> Hints t -> m b) -> + (a -> State s e -> Hints (Token s) -> m b) -> -- | Altered “OK” continuation - (a -> State s e -> Hints t -> m b) + (a -> State s e -> Hints (Token s) -> m b) accHints hs1 c x s hs2 = c x s (hs1 <> hs2) {-# INLINE accHints #-} --- | Replace the most recent group of hints (if any) with the given --- 'ErrorItem' (or delete it if 'Nothing' is given). This is used in the --- 'label' primitive. -refreshLastHint :: Hints t -> Maybe (ErrorItem t) -> Hints t -refreshLastHint (Hints []) _ = Hints [] -refreshLastHint (Hints (_ : xs)) Nothing = Hints xs -refreshLastHint (Hints (_ : xs)) (Just m) = Hints (E.singleton m : xs) -{-# INLINE refreshLastHint #-} +-- | Replace the hints with the given 'ErrorItem' (or delete it if 'Nothing' +-- is given). This is used in the 'label' primitive. +refreshHints :: Hints t -> Maybe (ErrorItem t) -> Hints t +refreshHints (Hints _) Nothing = Hints E.empty +refreshHints (Hints hs) (Just m) = + if E.null hs + then Hints hs + else Hints (E.singleton m) +{-# INLINE refreshHints #-} -- | Low-level unpacking of the 'ParsecT' type. runParsecT :: - Monad m => + (Monad m) => -- | Parser to run ParsecT e s m a -> -- | Initial state @@ -648,10 +720,10 @@ m (Reply e s a) runParsecT p s = unParser p s cok cerr eok eerr where - cok a s' _ = return $ Reply s' Consumed (OK a) + cok a s' hs = return $ Reply s' Consumed (OK hs a) cerr err s' = return $ Reply s' Consumed (Error err) - eok a s' _ = return $ Reply s' Virgin (OK a) - eerr err s' = return $ Reply s' Virgin (Error err) + eok a s' hs = return $ Reply s' NotConsumed (OK hs a) + eerr err s' = return $ Reply s' NotConsumed (Error err) -- | Transform any custom errors thrown by the parser using the given -- function. Similar in function and purpose to @withExceptT@. @@ -664,7 +736,7 @@ -- @since 7.0.0 withParsecT :: forall e e' s m a. - (Monad m, Ord e') => + (Ord e') => (e -> e') -> -- | Inner parser ParsecT e s m a -> diff --git a/Text/Megaparsec/Internal.hs-boot b/Text/Megaparsec/Internal.hs-boot new file mode 100644 --- /dev/null +++ b/Text/Megaparsec/Internal.hs-boot @@ -0,0 +1,10 @@ +{-# LANGUAGE RoleAnnotations #-} + +module Text.Megaparsec.Internal + ( Reply, + ) +where + +type role Reply nominal nominal representational + +data Reply e s a diff --git a/Text/Megaparsec/Lexer.hs b/Text/Megaparsec/Lexer.hs --- a/Text/Megaparsec/Lexer.hs +++ b/Text/Megaparsec/Lexer.hs @@ -2,7 +2,7 @@ {-# LANGUAGE Safe #-} -- | --- Module : Text.Megaparsec.Common +-- Module : Text.Megaparsec.Lexer -- Copyright : © 2018–present Megaparsec contributors -- License : FreeBSD -- @@ -10,7 +10,7 @@ -- Stability : experimental -- Portability : portable -- --- Common token combinators. This module is not public, the functions from +-- Common token combinators. This module is not public; the functions from -- it are re-exported in "Text.Megaparsec.Byte" and "Text.Megaparsec.Char". -- -- @since 7.0.0 @@ -38,9 +38,9 @@ -- -- @sc@ is used to parse blocks of space characters. You can use -- 'Text.Megaparsec.Char.space1' from "Text.Megaparsec.Char" for this --- purpose as well as your own parser (if you don't want to automatically +-- purpose, as well as your own parser (if you don't want to automatically -- consume newlines, for example). Make sure that the parser does not --- succeed on the empty input though. In an earlier version of the library +-- succeed on empty input though. In an earlier version of the library, -- 'Text.Megaparsec.Char.spaceChar' was recommended, but now parsers based -- on 'takeWhile1P' are preferred because of their speed. -- @@ -51,12 +51,12 @@ -- @skipBlockComment@ or @skipBlockCommentNested@ if you don't need anything -- special. -- --- If you don't want to allow a kind of comment, simply pass 'empty' which --- will fail instantly when parsing of that sort of comment is attempted and +-- If you don't want to allow a kind of comment, simply pass 'empty', which +-- will fail instantly when parsing of that sort of comment is attempted, and -- 'space' will just move on or finish depending on whether there is more -- white space for it to consume. space :: - MonadParsec e s m => + (MonadParsec e s m) => -- | A parser for space characters which does not accept empty -- input (e.g. 'Text.Megaparsec.Char.space1') m () -> @@ -78,10 +78,10 @@ -- > lexeme = L.lexeme spaceConsumer -- > integer = lexeme L.decimal lexeme :: - MonadParsec e s m => - -- | How to consume white space after lexeme + (MonadParsec e s m) => + -- | How to consume white space after the lexeme m () -> - -- | How to parse actual lexeme + -- | How to parse the actual lexeme m a -> m a lexeme spc p = p <* spc @@ -102,8 +102,8 @@ -- > colon = symbol ":" -- > dot = symbol "." symbol :: - MonadParsec e s m => - -- | How to consume white space after lexeme + (MonadParsec e s m) => + -- | How to consume white space after the lexeme m () -> -- | Symbol to parse Tokens s -> @@ -115,7 +115,7 @@ -- working with case-insensitive languages. symbol' :: (MonadParsec e s m, CI.FoldCase (Tokens s)) => - -- | How to consume white space after lexeme + -- | How to consume white space after the lexeme m () -> -- | Symbol to parse (case-insensitive) Tokens s -> diff --git a/Text/Megaparsec/Pos.hs b/Text/Megaparsec/Pos.hs --- a/Text/Megaparsec/Pos.hs +++ b/Text/Megaparsec/Pos.hs @@ -12,8 +12,8 @@ -- Stability : experimental -- Portability : portable -- --- Textual source position. The position includes name of file, line number, --- and column number. +-- Textual source position. The position includes the name of the file, the +-- line number, and the column number. -- -- You probably do not want to import this module directly because -- "Text.Megaparsec" re-exports it anyway. @@ -36,20 +36,19 @@ import Control.DeepSeq import Control.Exception import Data.Data (Data) -import Data.Typeable (Typeable) import GHC.Generics ---------------------------------------------------------------------------- -- Abstract position -- | 'Pos' is the type for positive integers. This is used to represent line --- number, column number, and similar things like indentation level. +-- number, column number, and similar things like indentation level. The -- 'Semigroup' instance can be used to safely and efficiently add 'Pos'es -- together. -- -- @since 5.0.0 newtype Pos = Pos Int - deriving (Show, Eq, Ord, Data, Generic, Typeable, NFData) + deriving (Show, Eq, Ord, Data, Generic, NFData) -- | Construction of 'Pos' from 'Int'. The function throws -- 'InvalidPosException' when given a non-positive argument. @@ -75,9 +74,9 @@ pos1 :: Pos pos1 = mkPos 1 --- | Value of tab width used by default. Always prefer this constant when --- you want to refer to the default tab width because actual value /may/ --- change in future. +-- | The value of the tab width used by default. Always prefer this constant +-- when you want to refer to the default tab width, because the actual value +-- /may/ change in the future. -- -- Currently: -- @@ -105,7 +104,7 @@ newtype InvalidPosException = -- | Contains the actual value that was passed to 'mkPos' InvalidPosException Int - deriving (Eq, Show, Data, Typeable, Generic) + deriving (Eq, Show, Data, Generic) instance Exception InvalidPosException @@ -126,12 +125,12 @@ -- | Column number sourceColumn :: !Pos } - deriving (Show, Read, Eq, Ord, Data, Typeable, Generic) + deriving (Show, Read, Eq, Ord, Data, Generic) instance NFData SourcePos --- | Construct initial position (line 1, column 1) given name of source --- file. +-- | Construct the initial position (line 1, column 1) given the name of the +-- source file. initialPos :: FilePath -> SourcePos initialPos n = SourcePos n pos1 pos1 diff --git a/Text/Megaparsec/State.hs b/Text/Megaparsec/State.hs --- a/Text/Megaparsec/State.hs +++ b/Text/Megaparsec/State.hs @@ -21,21 +21,22 @@ -- @since 6.5.0 module Text.Megaparsec.State ( State (..), + initialState, PosState (..), + initialPosState, ) where import Control.DeepSeq (NFData) import Data.Data (Data) -import Data.Typeable (Typeable) import GHC.Generics import {-# SOURCE #-} Text.Megaparsec.Error (ParseError) import Text.Megaparsec.Pos --- | This is the Megaparsec's state parametrized over stream type @s@ and --- custom error component type @e@. +-- | This is Megaparsec's state, parametrized over the stream type @s@ and +-- the custom error component type @e@. data State s e = State - { -- | The rest of input to process + { -- | The rest of the input to process stateInput :: s, -- | Number of processed tokens so far -- @@ -51,7 +52,7 @@ -- @since 8.0.0 stateParseErrors :: [ParseError s e] } - deriving (Typeable, Generic) + deriving (Generic) deriving instance ( Show (ParseError s e), @@ -74,22 +75,59 @@ instance (NFData s, NFData (ParseError s e)) => NFData (State s e) +-- | Given the name of the source file and the input, construct the initial +-- state for a parser. +-- +-- @since 9.6.0 +initialState :: + -- | Name of the file the input is coming from + FilePath -> + -- | Input + s -> + State s e +initialState name s = + State + { stateInput = s, + stateOffset = 0, + statePosState = initialPosState name s, + stateParseErrors = [] + } + -- | A special kind of state that is used to calculate line\/column -- positions on demand. -- -- @since 7.0.0 data PosState s = PosState - { -- | The rest of input to process + { -- | The rest of the input to process pstateInput :: s, - -- | Offset corresponding to beginning of 'pstateInput' + -- | Offset corresponding to the beginning of 'pstateInput' pstateOffset :: !Int, - -- | Source position corresponding to beginning of 'pstateInput' + -- | Source position corresponding to the beginning of 'pstateInput' pstateSourcePos :: !SourcePos, -- | Tab width to use for column calculation pstateTabWidth :: Pos, - -- | Prefix to prepend to offending line + -- | Prefix to prepend to the offending line pstateLinePrefix :: String } - deriving (Show, Eq, Data, Typeable, Generic) + deriving (Show, Eq, Data, Generic) -instance NFData s => NFData (PosState s) +instance (NFData s) => NFData (PosState s) + +-- | Given the name of the source file and the input, construct the initial +-- positional state. +-- +-- @since 9.6.0 +initialPosState :: + -- | Name of the file the input is coming from + FilePath -> + -- | Input + s -> + PosState s +initialPosState name s = + PosState + { pstateInput = s, + pstateOffset = 0, + pstateSourcePos = initialPos name, + pstateTabWidth = defaultTabWidth, + pstateLinePrefix = "" + } diff --git a/Text/Megaparsec/Stream.hs b/Text/Megaparsec/Stream.hs --- a/Text/Megaparsec/Stream.hs +++ b/Text/Megaparsec/Stream.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE BangPatterns #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE LambdaCase #-} @@ -7,6 +8,7 @@ {-# LANGUAGE Safe #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE UndecidableInstances #-} -- | -- Module : Text.Megaparsec.Stream @@ -25,18 +27,22 @@ -- @since 6.0.0 module Text.Megaparsec.Stream ( Stream (..), + ShareInput (..), + NoShareInput (..), VisualStream (..), TraversableStream (..), ) where +import Data.Bifunctor (second) import qualified Data.ByteString as B import qualified Data.ByteString.Char8 as B8 import qualified Data.ByteString.Lazy as BL import qualified Data.ByteString.Lazy.Char8 as BL8 import Data.Char (chr) -import Data.Foldable (foldl', toList) +import Data.Foldable (toList) import Data.Kind (Type) +import qualified Data.List import Data.List.NonEmpty (NonEmpty (..)) import qualified Data.List.NonEmpty as NE import Data.Maybe (fromMaybe) @@ -47,10 +53,17 @@ import Data.Word (Word8) import Text.Megaparsec.Pos import Text.Megaparsec.State +import qualified Text.Megaparsec.Unicode as Unicode -- | Type class for inputs that can be consumed by the library. -- --- __Note__: before the version /9.0.0/ the class included the methods from +-- Note that the 'Stream' instances for 'Text' and 'ByteString' (strict and +-- lazy) default to "input sharing" (see 'ShareInput', 'NoShareInput'). We plan +-- to move away from input sharing in a future major release; if you want to +-- retain the current behaviour and are concerned with maximum performance you +-- should consider using the 'ShareInput' wrapper explicitly. +-- +-- __Note__: before version /9.0.0/ the class included the methods from -- 'VisualStream' and 'TraversableStream'. class (Ord (Token s), Ord (Tokens s)) => Stream s where -- | Type of token in the stream. @@ -59,29 +72,29 @@ -- | Type of “chunk” of the stream. type Tokens s :: Type - -- | Lift a single token to chunk of the stream. The default + -- | Lift a single token to a chunk of the stream. The default -- implementation is: -- -- > tokenToChunk pxy = tokensToChunk pxy . pure -- - -- However for some types of stream there may be a more efficient way to + -- However, for some types of stream there may be a more efficient way to -- lift. tokenToChunk :: Proxy s -> Token s -> Tokens s tokenToChunk pxy = tokensToChunk pxy . pure - -- | The first method that establishes isomorphism between list of tokens - -- and chunk of the stream. Valid implementation should satisfy: + -- | The first method that establishes the isomorphism between a list of + -- tokens and a chunk of the stream. A valid implementation should satisfy: -- -- > chunkToTokens pxy (tokensToChunk pxy ts) == ts tokensToChunk :: Proxy s -> [Token s] -> Tokens s - -- | The second method that establishes isomorphism between list of tokens - -- and chunk of the stream. Valid implementation should satisfy: + -- | The second method that establishes the isomorphism between a list of + -- tokens and a chunk of the stream. A valid implementation should satisfy: -- -- > tokensToChunk pxy (chunkToTokens pxy chunk) == chunk chunkToTokens :: Proxy s -> Tokens s -> [Token s] - -- | Return length of a chunk of the stream. + -- | Return the length of a chunk of the stream. chunkLength :: Proxy s -> Tokens s -> Int -- | Check if a chunk of the stream is empty. The default implementation @@ -89,16 +102,16 @@ -- -- > chunkEmpty pxy ts = chunkLength pxy ts <= 0 -- - -- However for many streams there may be a more efficient implementation. + -- However, for many streams there may be a more efficient implementation. chunkEmpty :: Proxy s -> Tokens s -> Bool chunkEmpty pxy ts = chunkLength pxy ts <= 0 - -- | Extract a single token form the stream. Return 'Nothing' if the + -- | Extract a single token from the stream. Return 'Nothing' if the -- stream is empty. take1_ :: s -> Maybe (Token s, s) -- | @'takeN_' n s@ should try to extract a chunk of length @n@, or if the - -- stream is too short, the rest of the stream. Valid implementation + -- stream is too short, the rest of the stream. A valid implementation -- should follow the rules: -- -- * If the requested length @n@ is 0 (or less), 'Nothing' should @@ -107,21 +120,21 @@ -- stream (second argument). -- * If the requested length is greater than 0 and the stream is -- empty, 'Nothing' should be returned indicating end of input. - -- * In other cases, take chunk of length @n@ (or shorter if the + -- * In other cases, take a chunk of length @n@ (or shorter if the -- stream is not long enough) from the input stream and return the -- chunk along with the rest of the stream. takeN_ :: Int -> s -> Maybe (Tokens s, s) - -- | Extract chunk of the stream taking tokens while the supplied + -- | Extract a chunk of the stream, taking tokens while the supplied -- predicate returns 'True'. Return the chunk and the rest of the stream. -- - -- For many types of streams, the method allows for significant - -- performance improvements, although it is not strictly necessary from + -- For many types of streams, this method allows for significant + -- performance improvements, although it is not strictly necessary from a -- conceptual point of view. takeWhile_ :: (Token s -> Bool) -> s -> (Tokens s, s) -- | @since 9.0.0 -instance Ord a => Stream [a] where +instance (Ord a) => Stream [a] where type Token [a] = a type Tokens [a] = [a] tokenToChunk Proxy = pure @@ -138,7 +151,7 @@ takeWhile_ = span -- | @since 9.0.0 -instance Ord a => Stream (S.Seq a) where +instance (Ord a) => Stream (S.Seq a) where type Token (S.Seq a) = a type Tokens (S.Seq a) = S.Seq a tokenToChunk Proxy = pure @@ -154,71 +167,252 @@ | otherwise = Just (S.splitAt n s) takeWhile_ = S.spanl -instance Stream B.ByteString where - type Token B.ByteString = Word8 - type Tokens B.ByteString = B.ByteString +-- | This wrapper selects the input-sharing 'Stream' implementation for +-- 'T.Text' ('TL.Text') and 'B.ByteString' ('BL.ByteString'). By input +-- sharing we mean that our parsers will use slices whenever possible to +-- avoid having to copy parts of the input. See also the documentation of +-- 'T.split'. +-- +-- Note that using slices is in general faster than copying; on the other +-- hand, it also has the potential for causing surprising memory leaks: if +-- any slice of the input survives in the output, holding on to the output +-- will force the entire input 'T.Text'/'B.ByteString' to stay in memory! +-- Even when using lazy 'TL.Text'/'BL.ByteString' we will hold on to whole +-- chunks at a time, leading to significantly worse memory residency in +-- some cases. +-- +-- See 'NoShareInput' for a somewhat slower implementation that avoids this +-- memory leak scenario. +-- +-- @since 9.3.0 +newtype ShareInput a = ShareInput {unShareInput :: a} + +instance Stream (ShareInput B.ByteString) where + type Token (ShareInput B.ByteString) = Word8 + type Tokens (ShareInput B.ByteString) = B.ByteString tokenToChunk Proxy = B.singleton tokensToChunk Proxy = B.pack chunkToTokens Proxy = B.unpack chunkLength Proxy = B.length chunkEmpty Proxy = B.null - take1_ = B.uncons - takeN_ n s - | n <= 0 = Just (B.empty, s) + take1_ (ShareInput s) = second ShareInput <$> B.uncons s + takeN_ n (ShareInput s) + | n <= 0 = Just (B.empty, ShareInput s) | B.null s = Nothing - | otherwise = Just (B.splitAt n s) - takeWhile_ = B.span + | otherwise = Just . second ShareInput $ B.splitAt n s + takeWhile_ p (ShareInput s) = second ShareInput $ B.span p s -instance Stream BL.ByteString where - type Token BL.ByteString = Word8 - type Tokens BL.ByteString = BL.ByteString +instance Stream (ShareInput BL.ByteString) where + type Token (ShareInput BL.ByteString) = Word8 + type Tokens (ShareInput BL.ByteString) = BL.ByteString tokenToChunk Proxy = BL.singleton tokensToChunk Proxy = BL.pack chunkToTokens Proxy = BL.unpack chunkLength Proxy = fromIntegral . BL.length chunkEmpty Proxy = BL.null - take1_ = BL.uncons - takeN_ n s - | n <= 0 = Just (BL.empty, s) + take1_ (ShareInput s) = second ShareInput <$> BL.uncons s + takeN_ n (ShareInput s) + | n <= 0 = Just (BL.empty, ShareInput s) | BL.null s = Nothing - | otherwise = Just (BL.splitAt (fromIntegral n) s) - takeWhile_ = BL.span + | otherwise = Just . second ShareInput $ BL.splitAt (fromIntegral n) s + takeWhile_ p (ShareInput s) = second ShareInput $ BL.span p s -instance Stream T.Text where - type Token T.Text = Char - type Tokens T.Text = T.Text +instance Stream (ShareInput T.Text) where + type Token (ShareInput T.Text) = Char + type Tokens (ShareInput T.Text) = T.Text tokenToChunk Proxy = T.singleton tokensToChunk Proxy = T.pack chunkToTokens Proxy = T.unpack chunkLength Proxy = T.length chunkEmpty Proxy = T.null - take1_ = T.uncons - takeN_ n s - | n <= 0 = Just (T.empty, s) + take1_ (ShareInput s) = second ShareInput <$> T.uncons s + takeN_ n (ShareInput s) + | n <= 0 = Just (T.empty, ShareInput s) | T.null s = Nothing - | otherwise = Just (T.splitAt n s) - takeWhile_ = T.span + | otherwise = Just . second ShareInput $ T.splitAt n s + takeWhile_ p (ShareInput s) = second ShareInput $ T.span p s -instance Stream TL.Text where - type Token TL.Text = Char - type Tokens TL.Text = TL.Text +instance Stream (ShareInput TL.Text) where + type Token (ShareInput TL.Text) = Char + type Tokens (ShareInput TL.Text) = TL.Text tokenToChunk Proxy = TL.singleton tokensToChunk Proxy = TL.pack chunkToTokens Proxy = TL.unpack chunkLength Proxy = fromIntegral . TL.length chunkEmpty Proxy = TL.null - take1_ = TL.uncons - takeN_ n s - | n <= 0 = Just (TL.empty, s) + take1_ (ShareInput s) = second ShareInput <$> TL.uncons s + takeN_ n (ShareInput s) + | n <= 0 = Just (TL.empty, ShareInput s) | TL.null s = Nothing - | otherwise = Just (TL.splitAt (fromIntegral n) s) - takeWhile_ = TL.span + | otherwise = Just . second ShareInput $ TL.splitAt (fromIntegral n) s + takeWhile_ p (ShareInput s) = second ShareInput $ TL.span p s +-- | This wrapper selects the no-input-sharing 'Stream' implementation for +-- 'T.Text' ('TL.Text') and 'B.ByteString' ('BL.ByteString'). This means +-- that our parsers will create independent copies rather than using slices +-- of the input. See also the documentation of 'T.copy'. +-- +-- More importantly, any parser output will be independent of the input, and +-- holding on to parts of the output will never prevent the input from being +-- garbage collected. +-- +-- For maximum performance you might consider using 'ShareInput' instead, +-- but beware its pitfalls! +-- +-- @since 9.3.0 +newtype NoShareInput a = NoShareInput {unNoShareInput :: a} + +instance Stream (NoShareInput B.ByteString) where + type Token (NoShareInput B.ByteString) = Word8 + type Tokens (NoShareInput B.ByteString) = B.ByteString + tokenToChunk Proxy = B.singleton + tokensToChunk Proxy = B.pack + chunkToTokens Proxy = B.unpack + chunkLength Proxy = B.length + chunkEmpty Proxy = B.null + take1_ (NoShareInput s) = second NoShareInput <$> B.uncons s + takeN_ n (NoShareInput s) + | n <= 0 = Just (B.empty, NoShareInput s) + | B.null s = Nothing + | otherwise = + let (result, rest) = B.splitAt n s + -- To avoid sharing the entire input we create a clean copy of the result. + unSharedResult = B.copy result + in Just (unSharedResult, NoShareInput rest) + takeWhile_ p (NoShareInput s) = + let (result, rest) = B.span p s + -- Ditto. + unSharedResult = B.copy result + in (unSharedResult, NoShareInput rest) + +instance Stream (NoShareInput BL.ByteString) where + type Token (NoShareInput BL.ByteString) = Word8 + type Tokens (NoShareInput BL.ByteString) = BL.ByteString + tokenToChunk Proxy = BL.singleton + tokensToChunk Proxy = BL.pack + chunkToTokens Proxy = BL.unpack + chunkLength Proxy = fromIntegral . BL.length + chunkEmpty Proxy = BL.null + take1_ (NoShareInput s) = second NoShareInput <$> BL.uncons s + takeN_ n (NoShareInput s) + | n <= 0 = Just (BL.empty, NoShareInput s) + | BL.null s = Nothing + | otherwise = + let (result, rest) = BL.splitAt (fromIntegral n) s + -- To avoid sharing the entire input we create a clean copy of the result. + unSharedResult = BL.copy result + in Just (unSharedResult, NoShareInput rest) + takeWhile_ p (NoShareInput s) = + let (result, rest) = BL.span p s + -- Ditto. + unSharedResult = BL.copy result + in (unSharedResult, NoShareInput rest) + +instance Stream (NoShareInput T.Text) where + type Token (NoShareInput T.Text) = Char + type Tokens (NoShareInput T.Text) = T.Text + tokenToChunk Proxy = T.singleton + tokensToChunk Proxy = T.pack + chunkToTokens Proxy = T.unpack + chunkLength Proxy = T.length + chunkEmpty Proxy = T.null + take1_ (NoShareInput s) = second NoShareInput <$> T.uncons s + takeN_ n (NoShareInput s) + | n <= 0 = Just (T.empty, NoShareInput s) + | T.null s = Nothing + | otherwise = + let (result, rest) = T.splitAt n s + -- To avoid sharing the entire input we create a clean copy of the result. + unSharedResult = T.copy result + in Just (unSharedResult, NoShareInput rest) + takeWhile_ p (NoShareInput s) = + let (result, rest) = T.span p s + unSharedResult = T.copy result + in (unSharedResult, NoShareInput rest) + +instance Stream (NoShareInput TL.Text) where + type Token (NoShareInput TL.Text) = Char + type Tokens (NoShareInput TL.Text) = TL.Text + tokenToChunk Proxy = TL.singleton + tokensToChunk Proxy = TL.pack + chunkToTokens Proxy = TL.unpack + chunkLength Proxy = fromIntegral . TL.length + chunkEmpty Proxy = TL.null + take1_ (NoShareInput s) = second NoShareInput <$> TL.uncons s + takeN_ n (NoShareInput s) + | n <= 0 = Just (TL.empty, NoShareInput s) + | TL.null s = Nothing + | otherwise = + let (result, rest) = TL.splitAt (fromIntegral n) s + -- To avoid sharing the entire input we create a clean copy of the result. + unSharedResult = tlCopy result + in Just (unSharedResult, NoShareInput rest) + takeWhile_ p (NoShareInput s) = + let (result, rest) = TL.span p s + unSharedResult = tlCopy result + in (unSharedResult, NoShareInput rest) + +-- | Create an independent copy of a TL.Text, akin to BL.copy. +tlCopy :: TL.Text -> TL.Text +tlCopy = TL.fromStrict . T.copy . TL.toStrict +{-# INLINE tlCopy #-} + +-- Since we are using @{-# LANGUAGE Safe #-}@ we can't use deriving via in +-- these cases. + +instance Stream B.ByteString where + type Token B.ByteString = Token (ShareInput B.ByteString) + type Tokens B.ByteString = Tokens (ShareInput B.ByteString) + tokenToChunk Proxy = tokenToChunk (Proxy :: Proxy (ShareInput B.ByteString)) + tokensToChunk Proxy = tokensToChunk (Proxy :: Proxy (ShareInput B.ByteString)) + chunkToTokens Proxy = chunkToTokens (Proxy :: Proxy (ShareInput B.ByteString)) + chunkLength Proxy = chunkLength (Proxy :: Proxy (ShareInput B.ByteString)) + chunkEmpty Proxy = chunkEmpty (Proxy :: Proxy (ShareInput B.ByteString)) + take1_ s = second unShareInput <$> take1_ (ShareInput s) + takeN_ n s = second unShareInput <$> takeN_ n (ShareInput s) + takeWhile_ p s = second unShareInput $ takeWhile_ p (ShareInput s) + +instance Stream BL.ByteString where + type Token BL.ByteString = Token (ShareInput BL.ByteString) + type Tokens BL.ByteString = Tokens (ShareInput BL.ByteString) + tokenToChunk Proxy = tokenToChunk (Proxy :: Proxy (ShareInput BL.ByteString)) + tokensToChunk Proxy = tokensToChunk (Proxy :: Proxy (ShareInput BL.ByteString)) + chunkToTokens Proxy = chunkToTokens (Proxy :: Proxy (ShareInput BL.ByteString)) + chunkLength Proxy = chunkLength (Proxy :: Proxy (ShareInput BL.ByteString)) + chunkEmpty Proxy = chunkEmpty (Proxy :: Proxy (ShareInput BL.ByteString)) + take1_ s = second unShareInput <$> take1_ (ShareInput s) + takeN_ n s = second unShareInput <$> takeN_ n (ShareInput s) + takeWhile_ p s = second unShareInput $ takeWhile_ p (ShareInput s) + +instance Stream T.Text where + type Token T.Text = Token (ShareInput T.Text) + type Tokens T.Text = Tokens (ShareInput T.Text) + tokenToChunk Proxy = tokenToChunk (Proxy :: Proxy (ShareInput T.Text)) + tokensToChunk Proxy = tokensToChunk (Proxy :: Proxy (ShareInput T.Text)) + chunkToTokens Proxy = chunkToTokens (Proxy :: Proxy (ShareInput T.Text)) + chunkLength Proxy = chunkLength (Proxy :: Proxy (ShareInput T.Text)) + chunkEmpty Proxy = chunkEmpty (Proxy :: Proxy (ShareInput T.Text)) + take1_ s = second unShareInput <$> take1_ (ShareInput s) + takeN_ n s = second unShareInput <$> takeN_ n (ShareInput s) + takeWhile_ p s = second unShareInput $ takeWhile_ p (ShareInput s) + +instance Stream TL.Text where + type Token TL.Text = Token (ShareInput TL.Text) + type Tokens TL.Text = Tokens (ShareInput TL.Text) + tokenToChunk Proxy = tokenToChunk (Proxy :: Proxy (ShareInput TL.Text)) + tokensToChunk Proxy = tokensToChunk (Proxy :: Proxy (ShareInput TL.Text)) + chunkToTokens Proxy = chunkToTokens (Proxy :: Proxy (ShareInput TL.Text)) + chunkLength Proxy = chunkLength (Proxy :: Proxy (ShareInput TL.Text)) + chunkEmpty Proxy = chunkEmpty (Proxy :: Proxy (ShareInput TL.Text)) + take1_ s = second unShareInput <$> take1_ (ShareInput s) + takeN_ n s = second unShareInput <$> takeN_ n (ShareInput s) + takeWhile_ p s = second unShareInput $ takeWhile_ p (ShareInput s) + -- | Type class for inputs that can also be used for debugging. -- -- @since 9.0.0 -class Stream s => VisualStream s where - -- | Pretty-print non-empty stream of tokens. This function is also used +class (Stream s) => VisualStream s where + -- | Pretty-print a non-empty stream of tokens. This function is also used -- to print single tokens (represented as singleton lists). -- -- @since 7.0.0 @@ -234,6 +428,7 @@ instance VisualStream String where showTokens Proxy = stringPretty + tokensLength Proxy = Unicode.stringLength instance VisualStream B.ByteString where showTokens Proxy = stringPretty . fmap (chr . fromIntegral) @@ -243,17 +438,19 @@ instance VisualStream T.Text where showTokens Proxy = stringPretty + tokensLength Proxy = Unicode.stringLength instance VisualStream TL.Text where showTokens Proxy = stringPretty + tokensLength Proxy = Unicode.stringLength -- | Type class for inputs that can also be used for error reporting. -- -- @since 9.0.0 -class Stream s => TraversableStream s where +class (Stream s) => TraversableStream s where {-# MINIMAL reachOffset | reachOffsetNoLine #-} - -- | Given an offset @o@ and initial 'PosState', adjust the state in such + -- | Given an offset @o@ and an initial 'PosState', adjust the state in such -- a way that it starts at the offset. -- -- Return two values (in order): @@ -266,20 +463,21 @@ -- * The updated 'PosState' which can be in turn used to locate -- another offset @o'@ given that @o' >= o@. -- - -- The 'String' representing the offending line in input stream should + -- The 'String' representing the offending line in the input stream should -- satisfy the following: -- - -- * It should adequately represent location of token at the offset of - -- interest, that is, character at 'sourceColumn' of the returned - -- 'SourcePos' should correspond to the token at the offset @o@. + -- * It should adequately represent the location of the token at the + -- offset of interest, that is, the character at 'sourceColumn' of the + -- returned 'SourcePos' should correspond to the token at the offset + -- @o@. -- * It should not include the newline at the end. - -- * It should not be empty, if the line happens to be empty, it + -- * It should not be empty; if the line happens to be empty, it -- should be replaced with the string @\"\\"@. - -- * Tab characters should be replaced by appropriate number of + -- * Tab characters should be replaced by an appropriate number of -- spaces, which is determined by the 'pstateTabWidth' field of -- 'PosState'. -- - -- __Note__: type signature of the function was changed in the version + -- __Note__: the type signature of the function was changed in version -- /9.0.0/. -- -- @since 7.0.0 @@ -294,14 +492,14 @@ (Nothing, reachOffsetNoLine o pst) -- | A version of 'reachOffset' that may be faster because it doesn't need - -- to fetch the line at which the given offset in located. + -- to fetch the line at which the given offset is located. -- -- The default implementation is this: -- -- > reachOffsetNoLine o pst = -- > snd (reachOffset o pst) -- - -- __Note__: type signature of the function was changed in the version + -- __Note__: the type signature of the function was changed in version -- /8.0.0/. -- -- @since 7.0.0 @@ -318,37 +516,37 @@ instance TraversableStream String where -- NOTE Do not eta-reduce these (breaks inlining) reachOffset o pst = - reachOffset' splitAt foldl' id id ('\n', '\t') o pst + reachOffset' splitAt Data.List.foldl' id id ('\n', '\t') charInc o pst reachOffsetNoLine o pst = - reachOffsetNoLine' splitAt foldl' ('\n', '\t') o pst + reachOffsetNoLine' splitAt Data.List.foldl' ('\n', '\t') charInc o pst instance TraversableStream B.ByteString where -- NOTE Do not eta-reduce these (breaks inlining) reachOffset o pst = - reachOffset' B.splitAt B.foldl' B8.unpack (chr . fromIntegral) (10, 9) o pst + reachOffset' B.splitAt B.foldl' B8.unpack (chr . fromIntegral) (10, 9) byteInc o pst reachOffsetNoLine o pst = - reachOffsetNoLine' B.splitAt B.foldl' (10, 9) o pst + reachOffsetNoLine' B.splitAt B.foldl' (10, 9) byteInc o pst instance TraversableStream BL.ByteString where -- NOTE Do not eta-reduce these (breaks inlining) reachOffset o pst = - reachOffset' splitAtBL BL.foldl' BL8.unpack (chr . fromIntegral) (10, 9) o pst + reachOffset' splitAtBL BL.foldl' BL8.unpack (chr . fromIntegral) (10, 9) byteInc o pst reachOffsetNoLine o pst = - reachOffsetNoLine' splitAtBL BL.foldl' (10, 9) o pst + reachOffsetNoLine' splitAtBL BL.foldl' (10, 9) byteInc o pst instance TraversableStream T.Text where -- NOTE Do not eta-reduce (breaks inlining of reachOffset'). reachOffset o pst = - reachOffset' T.splitAt T.foldl' T.unpack id ('\n', '\t') o pst + reachOffset' T.splitAt T.foldl' T.unpack id ('\n', '\t') charInc o pst reachOffsetNoLine o pst = - reachOffsetNoLine' T.splitAt T.foldl' ('\n', '\t') o pst + reachOffsetNoLine' T.splitAt T.foldl' ('\n', '\t') charInc o pst instance TraversableStream TL.Text where -- NOTE Do not eta-reduce (breaks inlining of reachOffset'). reachOffset o pst = - reachOffset' splitAtTL TL.foldl' TL.unpack id ('\n', '\t') o pst + reachOffset' splitAtTL TL.foldl' TL.unpack id ('\n', '\t') charInc o pst reachOffsetNoLine o pst = - reachOffsetNoLine' splitAtTL TL.foldl' ('\n', '\t') o pst + reachOffsetNoLine' splitAtTL TL.foldl' ('\n', '\t') charInc o pst ---------------------------------------------------------------------------- -- Helpers @@ -361,17 +559,19 @@ -- stream types. reachOffset' :: forall s. - Stream s => - -- | How to split input stream at given offset + (Stream s) => + -- | How to split the input stream at a given offset (Int -> s -> (Tokens s, s)) -> - -- | How to fold over input stream + -- | How to fold over the input stream (forall b. (b -> Token s -> b) -> b -> Tokens s -> b) -> - -- | How to convert chunk of input stream into a 'String' + -- | How to convert a chunk of the input stream into a 'String' (Tokens s -> String) -> -- | How to convert a token into a 'Char' (Token s -> Char) -> -- | Newline token and tab token (Token s, Token s) -> + -- | Update column position for a token + (Token s -> Pos -> Pos) -> -- | Offset to reach Int -> -- | Initial 'PosState' to use @@ -384,6 +584,7 @@ fromToks fromTok (newlineTok, tabTok) + columnIncrement o PosState {..} = ( Just $ case expandTab pstateTabWidth @@ -422,30 +623,32 @@ c' = unPos c w = unPos pstateTabWidth in if - | ch == newlineTok -> - St - (SourcePos n (l <> pos1) pos1) - id - | ch == tabTok -> - St - (SourcePos n l (mkPos $ c' + w - ((c' - 1) `rem` w))) - (g . (fromTok ch :)) - | otherwise -> - St - (SourcePos n l (c <> pos1)) - (g . (fromTok ch :)) + | ch == newlineTok -> + St + (SourcePos n (l <> pos1) pos1) + id + | ch == tabTok -> + St + (SourcePos n l (mkPos $ c' + w - ((c' - 1) `rem` w))) + (g . (fromTok ch :)) + | otherwise -> + St + (SourcePos n l (columnIncrement ch c)) + (g . (fromTok ch :)) {-# INLINE reachOffset' #-} -- | Like 'reachOffset'' but for 'reachOffsetNoLine'. reachOffsetNoLine' :: forall s. - Stream s => - -- | How to split input stream at given offset + (Stream s) => + -- | How to split the input stream at a given offset (Int -> s -> (Tokens s, s)) -> - -- | How to fold over input stream + -- | How to fold over the input stream (forall b. (b -> Token s -> b) -> b -> Tokens s -> b) -> -- | Newline token and tab token (Token s, Token s) -> + -- | Update column position for a token + (Token s -> Pos -> Pos) -> -- | Offset to reach Int -> -- | Initial 'PosState' to use @@ -456,6 +659,7 @@ splitAt' foldl'' (newlineTok, tabTok) + columnIncrement o PosState {..} = ( PosState @@ -473,12 +677,12 @@ let c' = unPos c w = unPos pstateTabWidth in if - | ch == newlineTok -> - SourcePos n (l <> pos1) pos1 - | ch == tabTok -> - SourcePos n l (mkPos $ c' + w - ((c' - 1) `rem` w)) - | otherwise -> - SourcePos n l (c <> pos1) + | ch == newlineTok -> + SourcePos n (l <> pos1) pos1 + | ch == tabTok -> + SourcePos n l (mkPos $ c' + w - ((c' - 1) `rem` w)) + | otherwise -> + SourcePos n l (columnIncrement ch c) {-# INLINE reachOffsetNoLine' #-} -- | Like 'BL.splitAt' but accepts the index as an 'Int'. @@ -491,8 +695,8 @@ splitAtTL n = TL.splitAt (fromIntegral n) {-# INLINE splitAtTL #-} --- | @stringPretty s@ returns pretty representation of string @s@. This is --- used when printing string tokens in error messages. +-- | @stringPretty s@ returns a pretty representation of the string @s@. This +-- is used when printing string tokens in error messages. stringPretty :: NonEmpty Char -> String stringPretty (x :| []) = charPretty x stringPretty ('\r' :| "\n") = "crlf newline" @@ -503,8 +707,8 @@ Nothing -> [ch] Just pretty -> "<" <> pretty <> ">" --- | @charPretty ch@ returns user-friendly string representation of given --- character @ch@, suitable for using in error messages. +-- | @charPretty ch@ returns a user-friendly string representation of the +-- given character @ch@, suitable for use in error messages. charPretty :: Char -> String charPretty ' ' = "space" charPretty ch = fromMaybe ("'" <> [ch] <> "'") (charPretty' ch) @@ -549,15 +753,32 @@ '\160' -> Just "non-breaking space" _ -> Nothing --- | Replace tab characters with given number of spaces. +-- | Replace tab characters with the given number of spaces. expandTab :: Pos -> String -> String -expandTab w' = go 0 +expandTab w' = go 0 0 where - go 0 [] = [] - go 0 ('\t' : xs) = go w xs - go 0 (x : xs) = x : go 0 xs - go n xs = ' ' : go (n - 1) xs + go _ 0 [] = [] + go !i 0 ('\t' : xs) = go i (w - (i `rem` w)) xs + go !i 0 (x : xs) = x : go (i + Unicode.charLength x) 0 xs + go !i n xs = ' ' : go (i + 1) (n - 1) xs w = unPos w' + +-- | Return updated column position that corresponds to the given 'Char'. +charInc :: Char -> Pos -> Pos +charInc ch c = + case Unicode.charLength ch of + 0 -> c + 2 -> c <> pos1 <> pos1 + _ -> c <> pos1 + +-- | Return updated column position that corresponds to the given 'Word8'. +byteInc :: Word8 -> Pos -> Pos +byteInc w c + | w < 0x20 -- C0 control chars + || (w >= 0x7f && w < 0xa0) -- DEL and C1 control chars + || w == 0xad = -- soft hyphen + c + | otherwise = c <> pos1 diff --git a/Text/Megaparsec/Unicode.hs b/Text/Megaparsec/Unicode.hs new file mode 100644 --- /dev/null +++ b/Text/Megaparsec/Unicode.hs @@ -0,0 +1,94 @@ +{-# LANGUAGE Safe #-} + +-- | +-- Module : Text.Megaparsec.Unicode +-- Copyright : © 2024–present Megaparsec contributors +-- License : FreeBSD +-- +-- Maintainer : Mark Karpov +-- Stability : experimental +-- Portability : portable +-- +-- Utility functions for working with Unicode. +-- +-- @since 9.7.0 +module Text.Megaparsec.Unicode + ( stringLength, + charLength, + isWideChar, + isZeroWidthChar, + ) +where + +import Data.Array (Array, bounds, (!)) +import Data.Char (ord) +import Text.Megaparsec.Unicode.Tables + +-- | Calculate the length of a string, taking into account the fact that +-- certain 'Char's may span more than 1 column. +-- +-- @since 9.7.0 +stringLength :: (Traversable t) => t Char -> Int +stringLength = sum . fmap charLength + +-- | Return the length of an individual 'Char'. +-- +-- @since 9.7.0 +charLength :: Char -> Int +charLength ch + | n < simpleCharLimit = if isSimpleZeroWidth n then 0 else 1 + -- The two tables are disjoint, so the order of the lookups only affects + -- speed. Wide characters are looked up first because scripts that use + -- them use them for nearly every character, while combining marks are + -- interspersed with characters that are in neither table. + | inRanges wideCharRanges n = 2 + | inRanges zeroWidthCharRanges n = 0 + | otherwise = 1 + where + n = ord ch + +-- | Determine whether the given 'Char' is “wide”, that is, whether it spans +-- 2 columns instead of one. +-- +-- @since 9.7.0 +isWideChar :: Char -> Bool +isWideChar ch = n >= simpleCharLimit && inRanges wideCharRanges n + where + n = ord ch + +-- | Determine whether the given 'Char' is “zero-width”, that is, whether it +-- has no visible representation and does not advance the cursor position. +-- This includes control characters and certain Unicode zero-width +-- characters. +-- +-- @since 9.8.0 +isZeroWidthChar :: Char -> Bool +isZeroWidthChar ch + | n < simpleCharLimit = isSimpleZeroWidth n + | otherwise = inRanges zeroWidthCharRanges n + where + n = ord ch + +-- | Decide whether a code point below 'simpleCharLimit' is zero-width. Only +-- the control characters and the soft hyphen are; the generator checks that +-- this agrees with the data it produces. +isSimpleZeroWidth :: Int -> Bool +isSimpleZeroWidth n = + n < 0x20 -- C0 control chars + || (n >= 0x7f && n <= 0x9f) -- DEL and C1 control chars + || n == 0xad -- soft hyphen +{-# INLINE isSimpleZeroWidth #-} + +-- | Look up a code point in a sorted collection of ranges that neither +-- overlap nor touch. +inRanges :: Array Int (Int, Int) -> Int -> Bool +inRanges ranges n = go (bounds ranges) + where + go (lo, hi) + | hi < lo = False + | a <= n && n <= b = True + | n < a = go (lo, pred mid) + | otherwise = go (succ mid, hi) + where + mid = (lo + hi) `div` 2 + (a, b) = ranges ! mid diff --git a/Text/Megaparsec/Unicode/Tables.hs b/Text/Megaparsec/Unicode/Tables.hs new file mode 100644 --- /dev/null +++ b/Text/Megaparsec/Unicode/Tables.hs @@ -0,0 +1,560 @@ +{-# LANGUAGE Safe #-} + +-- | +-- Module : Text.Megaparsec.Unicode.Tables +-- Copyright : © 2026–present Megaparsec contributors +-- License : FreeBSD +-- +-- Maintainer : Mark Karpov +-- Stability : experimental +-- Portability : portable +-- +-- Character width data extracted from the Unicode Character +-- Database. +-- +-- __This module is generated by @script\/GenUnicodeTables.hs@, do not +-- edit it by hand.__ +module Text.Megaparsec.Unicode.Tables + ( unicodeVersion, + simpleCharLimit, + wideCharRanges, + zeroWidthCharRanges, + ) +where + +import Data.Array (Array, listArray) + +-- | The version of the Unicode Character Database that the tables in +-- this module were extracted from. +unicodeVersion :: String +unicodeVersion = "17.0.0" + +-- | Below this code point a character is neither wide nor zero-width, +-- with the exception of the C0 and C1 control characters and the soft +-- hyphen. This is what allows the common case to avoid a table lookup +-- altogether. +simpleCharLimit :: Int +simpleCharLimit = 0x000300 + +-- | Ranges of characters that span two columns, that is, those whose +-- East Asian Width is Wide or Fullwidth. Zero-width characters are +-- excluded, so the two tables are disjoint. +wideCharRanges :: Array Int (Int, Int) +wideCharRanges = + listArray + (0, 123) + [ (0x001100, 0x00115f), + (0x00231a, 0x00231b), + (0x002329, 0x00232a), + (0x0023e9, 0x0023ec), + (0x0023f0, 0x0023f0), + (0x0023f3, 0x0023f3), + (0x0025fd, 0x0025fe), + (0x002614, 0x002615), + (0x002630, 0x002637), + (0x002648, 0x002653), + (0x00267f, 0x00267f), + (0x00268a, 0x00268f), + (0x002693, 0x002693), + (0x0026a1, 0x0026a1), + (0x0026aa, 0x0026ab), + (0x0026bd, 0x0026be), + (0x0026c4, 0x0026c5), + (0x0026ce, 0x0026ce), + (0x0026d4, 0x0026d4), + (0x0026ea, 0x0026ea), + (0x0026f2, 0x0026f3), + (0x0026f5, 0x0026f5), + (0x0026fa, 0x0026fa), + (0x0026fd, 0x0026fd), + (0x002705, 0x002705), + (0x00270a, 0x00270b), + (0x002728, 0x002728), + (0x00274c, 0x00274c), + (0x00274e, 0x00274e), + (0x002753, 0x002755), + (0x002757, 0x002757), + (0x002795, 0x002797), + (0x0027b0, 0x0027b0), + (0x0027bf, 0x0027bf), + (0x002b1b, 0x002b1c), + (0x002b50, 0x002b50), + (0x002b55, 0x002b55), + (0x002e80, 0x002e99), + (0x002e9b, 0x002ef3), + (0x002f00, 0x002fd5), + (0x002ff0, 0x003029), + (0x00302e, 0x00303e), + (0x003041, 0x003096), + (0x00309b, 0x0030ff), + (0x003105, 0x00312f), + (0x003131, 0x00318e), + (0x003190, 0x0031e5), + (0x0031ef, 0x00321e), + (0x003220, 0x003247), + (0x003250, 0x00a48c), + (0x00a490, 0x00a4c6), + (0x00a960, 0x00a97c), + (0x00ac00, 0x00d7a3), + (0x00f900, 0x00faff), + (0x00fe10, 0x00fe19), + (0x00fe30, 0x00fe52), + (0x00fe54, 0x00fe66), + (0x00fe68, 0x00fe6b), + (0x00ff01, 0x00ff60), + (0x00ffe0, 0x00ffe6), + (0x016fe0, 0x016fe3), + (0x016ff0, 0x016ff6), + (0x017000, 0x018cd5), + (0x018cff, 0x018d1e), + (0x018d80, 0x018df2), + (0x01aff0, 0x01aff3), + (0x01aff5, 0x01affb), + (0x01affd, 0x01affe), + (0x01b000, 0x01b122), + (0x01b132, 0x01b132), + (0x01b150, 0x01b152), + (0x01b155, 0x01b155), + (0x01b164, 0x01b167), + (0x01b170, 0x01b2fb), + (0x01d300, 0x01d356), + (0x01d360, 0x01d376), + (0x01f004, 0x01f004), + (0x01f0cf, 0x01f0cf), + (0x01f18e, 0x01f18e), + (0x01f191, 0x01f19a), + (0x01f200, 0x01f202), + (0x01f210, 0x01f23b), + (0x01f240, 0x01f248), + (0x01f250, 0x01f251), + (0x01f260, 0x01f265), + (0x01f300, 0x01f320), + (0x01f32d, 0x01f335), + (0x01f337, 0x01f37c), + (0x01f37e, 0x01f393), + (0x01f3a0, 0x01f3ca), + (0x01f3cf, 0x01f3d3), + (0x01f3e0, 0x01f3f0), + (0x01f3f4, 0x01f3f4), + (0x01f3f8, 0x01f43e), + (0x01f440, 0x01f440), + (0x01f442, 0x01f4fc), + (0x01f4ff, 0x01f53d), + (0x01f54b, 0x01f54e), + (0x01f550, 0x01f567), + (0x01f57a, 0x01f57a), + (0x01f595, 0x01f596), + (0x01f5a4, 0x01f5a4), + (0x01f5fb, 0x01f64f), + (0x01f680, 0x01f6c5), + (0x01f6cc, 0x01f6cc), + (0x01f6d0, 0x01f6d2), + (0x01f6d5, 0x01f6d8), + (0x01f6dc, 0x01f6df), + (0x01f6eb, 0x01f6ec), + (0x01f6f4, 0x01f6fc), + (0x01f7e0, 0x01f7eb), + (0x01f7f0, 0x01f7f0), + (0x01f90c, 0x01f93a), + (0x01f93c, 0x01f945), + (0x01f947, 0x01f9ff), + (0x01fa70, 0x01fa7c), + (0x01fa80, 0x01fa8a), + (0x01fa8e, 0x01fac6), + (0x01fac8, 0x01fac8), + (0x01facd, 0x01fadc), + (0x01fadf, 0x01faea), + (0x01faef, 0x01faf8), + (0x020000, 0x02fffd), + (0x030000, 0x03fffd) + ] +{-# NOINLINE wideCharRanges #-} + +-- | Ranges of characters that take up no space at all: control +-- characters, non-spacing and enclosing marks, formatting characters, +-- and conjoining Hangul jamo of the medial and final kinds. +zeroWidthCharRanges :: Array Int (Int, Int) +zeroWidthCharRanges = + listArray + (0, 378) + [ (0x000000, 0x00001f), + (0x00007f, 0x00009f), + (0x0000ad, 0x0000ad), + (0x000300, 0x00036f), + (0x000483, 0x000489), + (0x000591, 0x0005bd), + (0x0005bf, 0x0005bf), + (0x0005c1, 0x0005c2), + (0x0005c4, 0x0005c5), + (0x0005c7, 0x0005c7), + (0x000600, 0x000605), + (0x000610, 0x00061a), + (0x00061c, 0x00061c), + (0x00064b, 0x00065f), + (0x000670, 0x000670), + (0x0006d6, 0x0006dd), + (0x0006df, 0x0006e4), + (0x0006e7, 0x0006e8), + (0x0006ea, 0x0006ed), + (0x00070f, 0x00070f), + (0x000711, 0x000711), + (0x000730, 0x00074a), + (0x0007a6, 0x0007b0), + (0x0007eb, 0x0007f3), + (0x0007fd, 0x0007fd), + (0x000816, 0x000819), + (0x00081b, 0x000823), + (0x000825, 0x000827), + (0x000829, 0x00082d), + (0x000859, 0x00085b), + (0x000890, 0x000891), + (0x000897, 0x00089f), + (0x0008ca, 0x000902), + (0x00093a, 0x00093a), + (0x00093c, 0x00093c), + (0x000941, 0x000948), + (0x00094d, 0x00094d), + (0x000951, 0x000957), + (0x000962, 0x000963), + (0x000981, 0x000981), + (0x0009bc, 0x0009bc), + (0x0009c1, 0x0009c4), + (0x0009cd, 0x0009cd), + (0x0009e2, 0x0009e3), + (0x0009fe, 0x0009fe), + (0x000a01, 0x000a02), + (0x000a3c, 0x000a3c), + (0x000a41, 0x000a42), + (0x000a47, 0x000a48), + (0x000a4b, 0x000a4d), + (0x000a51, 0x000a51), + (0x000a70, 0x000a71), + (0x000a75, 0x000a75), + (0x000a81, 0x000a82), + (0x000abc, 0x000abc), + (0x000ac1, 0x000ac5), + (0x000ac7, 0x000ac8), + (0x000acd, 0x000acd), + (0x000ae2, 0x000ae3), + (0x000afa, 0x000aff), + (0x000b01, 0x000b01), + (0x000b3c, 0x000b3c), + (0x000b3f, 0x000b3f), + (0x000b41, 0x000b44), + (0x000b4d, 0x000b4d), + (0x000b55, 0x000b56), + (0x000b62, 0x000b63), + (0x000b82, 0x000b82), + (0x000bc0, 0x000bc0), + (0x000bcd, 0x000bcd), + (0x000c00, 0x000c00), + (0x000c04, 0x000c04), + (0x000c3c, 0x000c3c), + (0x000c3e, 0x000c40), + (0x000c46, 0x000c48), + (0x000c4a, 0x000c4d), + (0x000c55, 0x000c56), + (0x000c62, 0x000c63), + (0x000c81, 0x000c81), + (0x000cbc, 0x000cbc), + (0x000cbf, 0x000cbf), + (0x000cc6, 0x000cc6), + (0x000ccc, 0x000ccd), + (0x000ce2, 0x000ce3), + (0x000d00, 0x000d01), + (0x000d3b, 0x000d3c), + (0x000d41, 0x000d44), + (0x000d4d, 0x000d4d), + (0x000d62, 0x000d63), + (0x000d81, 0x000d81), + (0x000dca, 0x000dca), + (0x000dd2, 0x000dd4), + (0x000dd6, 0x000dd6), + (0x000e31, 0x000e31), + (0x000e34, 0x000e3a), + (0x000e47, 0x000e4e), + (0x000eb1, 0x000eb1), + (0x000eb4, 0x000ebc), + (0x000ec8, 0x000ece), + (0x000f18, 0x000f19), + (0x000f35, 0x000f35), + (0x000f37, 0x000f37), + (0x000f39, 0x000f39), + (0x000f71, 0x000f7e), + (0x000f80, 0x000f84), + (0x000f86, 0x000f87), + (0x000f8d, 0x000f97), + (0x000f99, 0x000fbc), + (0x000fc6, 0x000fc6), + (0x00102d, 0x001030), + (0x001032, 0x001037), + (0x001039, 0x00103a), + (0x00103d, 0x00103e), + (0x001058, 0x001059), + (0x00105e, 0x001060), + (0x001071, 0x001074), + (0x001082, 0x001082), + (0x001085, 0x001086), + (0x00108d, 0x00108d), + (0x00109d, 0x00109d), + (0x001160, 0x0011ff), + (0x00135d, 0x00135f), + (0x001712, 0x001714), + (0x001732, 0x001733), + (0x001752, 0x001753), + (0x001772, 0x001773), + (0x0017b4, 0x0017b5), + (0x0017b7, 0x0017bd), + (0x0017c6, 0x0017c6), + (0x0017c9, 0x0017d3), + (0x0017dd, 0x0017dd), + (0x00180b, 0x00180f), + (0x001885, 0x001886), + (0x0018a9, 0x0018a9), + (0x001920, 0x001922), + (0x001927, 0x001928), + (0x001932, 0x001932), + (0x001939, 0x00193b), + (0x001a17, 0x001a18), + (0x001a1b, 0x001a1b), + (0x001a56, 0x001a56), + (0x001a58, 0x001a5e), + (0x001a60, 0x001a60), + (0x001a62, 0x001a62), + (0x001a65, 0x001a6c), + (0x001a73, 0x001a7c), + (0x001a7f, 0x001a7f), + (0x001ab0, 0x001add), + (0x001ae0, 0x001aeb), + (0x001b00, 0x001b03), + (0x001b34, 0x001b34), + (0x001b36, 0x001b3a), + (0x001b3c, 0x001b3c), + (0x001b42, 0x001b42), + (0x001b6b, 0x001b73), + (0x001b80, 0x001b81), + (0x001ba2, 0x001ba5), + (0x001ba8, 0x001ba9), + (0x001bab, 0x001bad), + (0x001be6, 0x001be6), + (0x001be8, 0x001be9), + (0x001bed, 0x001bed), + (0x001bef, 0x001bf1), + (0x001c2c, 0x001c33), + (0x001c36, 0x001c37), + (0x001cd0, 0x001cd2), + (0x001cd4, 0x001ce0), + (0x001ce2, 0x001ce8), + (0x001ced, 0x001ced), + (0x001cf4, 0x001cf4), + (0x001cf8, 0x001cf9), + (0x001dc0, 0x001dff), + (0x00200b, 0x00200f), + (0x00202a, 0x00202e), + (0x002060, 0x002064), + (0x002066, 0x00206f), + (0x0020d0, 0x0020f0), + (0x002cef, 0x002cf1), + (0x002d7f, 0x002d7f), + (0x002de0, 0x002dff), + (0x00302a, 0x00302d), + (0x003099, 0x00309a), + (0x00a66f, 0x00a672), + (0x00a674, 0x00a67d), + (0x00a69e, 0x00a69f), + (0x00a6f0, 0x00a6f1), + (0x00a802, 0x00a802), + (0x00a806, 0x00a806), + (0x00a80b, 0x00a80b), + (0x00a825, 0x00a826), + (0x00a82c, 0x00a82c), + (0x00a8c4, 0x00a8c5), + (0x00a8e0, 0x00a8f1), + (0x00a8ff, 0x00a8ff), + (0x00a926, 0x00a92d), + (0x00a947, 0x00a951), + (0x00a980, 0x00a982), + (0x00a9b3, 0x00a9b3), + (0x00a9b6, 0x00a9b9), + (0x00a9bc, 0x00a9bd), + (0x00a9e5, 0x00a9e5), + (0x00aa29, 0x00aa2e), + (0x00aa31, 0x00aa32), + (0x00aa35, 0x00aa36), + (0x00aa43, 0x00aa43), + (0x00aa4c, 0x00aa4c), + (0x00aa7c, 0x00aa7c), + (0x00aab0, 0x00aab0), + (0x00aab2, 0x00aab4), + (0x00aab7, 0x00aab8), + (0x00aabe, 0x00aabf), + (0x00aac1, 0x00aac1), + (0x00aaec, 0x00aaed), + (0x00aaf6, 0x00aaf6), + (0x00abe5, 0x00abe5), + (0x00abe8, 0x00abe8), + (0x00abed, 0x00abed), + (0x00fb1e, 0x00fb1e), + (0x00fe00, 0x00fe0f), + (0x00fe20, 0x00fe2f), + (0x00feff, 0x00feff), + (0x00fff9, 0x00fffb), + (0x0101fd, 0x0101fd), + (0x0102e0, 0x0102e0), + (0x010376, 0x01037a), + (0x010a01, 0x010a03), + (0x010a05, 0x010a06), + (0x010a0c, 0x010a0f), + (0x010a38, 0x010a3a), + (0x010a3f, 0x010a3f), + (0x010ae5, 0x010ae6), + (0x010d24, 0x010d27), + (0x010d69, 0x010d6d), + (0x010eab, 0x010eac), + (0x010efa, 0x010eff), + (0x010f46, 0x010f50), + (0x010f82, 0x010f85), + (0x011001, 0x011001), + (0x011038, 0x011046), + (0x011070, 0x011070), + (0x011073, 0x011074), + (0x01107f, 0x011081), + (0x0110b3, 0x0110b6), + (0x0110b9, 0x0110ba), + (0x0110bd, 0x0110bd), + (0x0110c2, 0x0110c2), + (0x0110cd, 0x0110cd), + (0x011100, 0x011102), + (0x011127, 0x01112b), + (0x01112d, 0x011134), + (0x011173, 0x011173), + (0x011180, 0x011181), + (0x0111b6, 0x0111be), + (0x0111c9, 0x0111cc), + (0x0111cf, 0x0111cf), + (0x01122f, 0x011231), + (0x011234, 0x011234), + (0x011236, 0x011237), + (0x01123e, 0x01123e), + (0x011241, 0x011241), + (0x0112df, 0x0112df), + (0x0112e3, 0x0112ea), + (0x011300, 0x011301), + (0x01133b, 0x01133c), + (0x011340, 0x011340), + (0x011366, 0x01136c), + (0x011370, 0x011374), + (0x0113bb, 0x0113c0), + (0x0113ce, 0x0113ce), + (0x0113d0, 0x0113d0), + (0x0113d2, 0x0113d2), + (0x0113e1, 0x0113e2), + (0x011438, 0x01143f), + (0x011442, 0x011444), + (0x011446, 0x011446), + (0x01145e, 0x01145e), + (0x0114b3, 0x0114b8), + (0x0114ba, 0x0114ba), + (0x0114bf, 0x0114c0), + (0x0114c2, 0x0114c3), + (0x0115b2, 0x0115b5), + (0x0115bc, 0x0115bd), + (0x0115bf, 0x0115c0), + (0x0115dc, 0x0115dd), + (0x011633, 0x01163a), + (0x01163d, 0x01163d), + (0x01163f, 0x011640), + (0x0116ab, 0x0116ab), + (0x0116ad, 0x0116ad), + (0x0116b0, 0x0116b5), + (0x0116b7, 0x0116b7), + (0x01171d, 0x01171d), + (0x01171f, 0x01171f), + (0x011722, 0x011725), + (0x011727, 0x01172b), + (0x01182f, 0x011837), + (0x011839, 0x01183a), + (0x01193b, 0x01193c), + (0x01193e, 0x01193e), + (0x011943, 0x011943), + (0x0119d4, 0x0119d7), + (0x0119da, 0x0119db), + (0x0119e0, 0x0119e0), + (0x011a01, 0x011a0a), + (0x011a33, 0x011a38), + (0x011a3b, 0x011a3e), + (0x011a47, 0x011a47), + (0x011a51, 0x011a56), + (0x011a59, 0x011a5b), + (0x011a8a, 0x011a96), + (0x011a98, 0x011a99), + (0x011b60, 0x011b60), + (0x011b62, 0x011b64), + (0x011b66, 0x011b66), + (0x011c30, 0x011c36), + (0x011c38, 0x011c3d), + (0x011c3f, 0x011c3f), + (0x011c92, 0x011ca7), + (0x011caa, 0x011cb0), + (0x011cb2, 0x011cb3), + (0x011cb5, 0x011cb6), + (0x011d31, 0x011d36), + (0x011d3a, 0x011d3a), + (0x011d3c, 0x011d3d), + (0x011d3f, 0x011d45), + (0x011d47, 0x011d47), + (0x011d90, 0x011d91), + (0x011d95, 0x011d95), + (0x011d97, 0x011d97), + (0x011ef3, 0x011ef4), + (0x011f00, 0x011f01), + (0x011f36, 0x011f3a), + (0x011f40, 0x011f40), + (0x011f42, 0x011f42), + (0x011f5a, 0x011f5a), + (0x013430, 0x013440), + (0x013447, 0x013455), + (0x01611e, 0x016129), + (0x01612d, 0x01612f), + (0x016af0, 0x016af4), + (0x016b30, 0x016b36), + (0x016f4f, 0x016f4f), + (0x016f8f, 0x016f92), + (0x016fe4, 0x016fe4), + (0x01bc9d, 0x01bc9e), + (0x01bca0, 0x01bca3), + (0x01cf00, 0x01cf2d), + (0x01cf30, 0x01cf46), + (0x01d167, 0x01d169), + (0x01d173, 0x01d182), + (0x01d185, 0x01d18b), + (0x01d1aa, 0x01d1ad), + (0x01d242, 0x01d244), + (0x01da00, 0x01da36), + (0x01da3b, 0x01da6c), + (0x01da75, 0x01da75), + (0x01da84, 0x01da84), + (0x01da9b, 0x01da9f), + (0x01daa1, 0x01daaf), + (0x01e000, 0x01e006), + (0x01e008, 0x01e018), + (0x01e01b, 0x01e021), + (0x01e023, 0x01e024), + (0x01e026, 0x01e02a), + (0x01e08f, 0x01e08f), + (0x01e130, 0x01e136), + (0x01e2ae, 0x01e2ae), + (0x01e2ec, 0x01e2ef), + (0x01e4ec, 0x01e4ef), + (0x01e5ee, 0x01e5ef), + (0x01e6e3, 0x01e6e3), + (0x01e6e6, 0x01e6e6), + (0x01e6ee, 0x01e6ef), + (0x01e6f5, 0x01e6f5), + (0x01e8d0, 0x01e8d6), + (0x01e944, 0x01e94a), + (0x0e0001, 0x0e0001), + (0x0e0020, 0x0e007f), + (0x0e0100, 0x0e01ef) + ] +{-# NOINLINE zeroWidthCharRanges #-} diff --git a/bench/memory/Main.hs b/bench/memory/Main.hs --- a/bench/memory/Main.hs +++ b/bench/memory/Main.hs @@ -76,7 +76,7 @@ -- | Perform a series of measurements with the same parser. bparser :: - NFData a => + (NFData a) => -- | Name of the benchmark group String -> -- | How to construct input @@ -91,7 +91,7 @@ -- | Perform a series of measurements with the same parser. bparserBs :: - NFData a => + (NFData a) => -- | Name of the benchmark group String -> -- | How to construct input diff --git a/bench/speed/Main.hs b/bench/speed/Main.hs --- a/bench/speed/Main.hs +++ b/bench/speed/Main.hs @@ -71,7 +71,7 @@ -- | Perform a series to measurements with the same parser. bparser :: - NFData a => + (NFData a) => -- | Name of the benchmark group String -> -- | How to construct input @@ -87,7 +87,7 @@ -- | Perform a series to measurements with the same parser. bparserBs :: - NFData a => + (NFData a) => -- | Name of the benchmark group String -> -- | How to construct input diff --git a/megaparsec.cabal b/megaparsec.cabal --- a/megaparsec.cabal +++ b/megaparsec.cabal @@ -1,6 +1,6 @@ cabal-version: 2.4 name: megaparsec -version: 9.2.2 +version: 9.8.2 license: BSD-2-Clause license-file: LICENSE.md maintainer: Mark Karpov @@ -9,7 +9,9 @@ Paolo Martini , Daan Leijen -tested-with: ghc ==9.0.2 ghc ==9.2.4 ghc ==9.4.1 +tested-with: + ghc ==9.6.7 ghc ==9.8.4 ghc ==9.10.3 ghc ==9.12.4 ghc ==9.14.1 + homepage: https://github.com/mrkkrp/megaparsec bug-reports: https://github.com/mrkkrp/megaparsec/issues synopsis: Monadic parser combinators @@ -46,37 +48,40 @@ Text.Megaparsec.Error.Builder Text.Megaparsec.Internal Text.Megaparsec.Pos + Text.Megaparsec.State Text.Megaparsec.Stream + Text.Megaparsec.Unicode other-modules: Text.Megaparsec.Class Text.Megaparsec.Common Text.Megaparsec.Lexer - Text.Megaparsec.State + Text.Megaparsec.Unicode.Tables default-language: Haskell2010 build-depends: - base >=4.15 && <5.0, - bytestring >=0.2 && <0.12, + array >=0.5.3 && <0.6, + base >=4.18 && <5, + bytestring >=0.2 && <0.13, case-insensitive >=1.2 && <1.3, - containers >=0.5 && <0.7, - deepseq >=1.3 && <1.5, - mtl >=2.2.2 && <3.0, - parser-combinators >=1.0 && <2.0, + containers >=0.5 && <0.9, + deepseq >=1.3 && <1.6, + mtl >=2.2.2 && <3, + parser-combinators >=1.0 && <2, scientific >=0.3.7 && <0.4, - text >=0.2 && <2.1, + text >=0.2 && <2.2, transformers >=0.4 && <0.7 if flag(dev) - ghc-options: -O0 -Wall -Werror + ghc-options: + -Wall -Werror -Wredundant-constraints -Wpartial-fields + -Wunused-packages -haddock -Winvalid-haddock else ghc-options: -O2 -Wall - if flag(dev) - ghc-options: - -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns - -Wnoncanonical-monad-instances -Wno-missing-home-modules + if impl(ghc >=9.8) + ghc-options: -Wno-x-partial benchmark bench-speed type: exitcode-stdio-1.0 @@ -84,16 +89,18 @@ hs-source-dirs: bench/speed default-language: Haskell2010 build-depends: - base >=4.15 && <5.0, - bytestring >=0.2 && <0.12, - containers >=0.5 && <0.7, + base >=4.18 && <5, + bytestring >=0.2 && <0.13, + containers >=0.5 && <0.9, criterion >=0.6.2.1 && <1.7, - deepseq >=1.3 && <1.5, + deepseq >=1.3 && <1.6, megaparsec, - text >=0.2 && <2.1 + text >=0.2 && <2.2 if flag(dev) - ghc-options: -O2 -Wall -Werror + ghc-options: + -Wall -Werror -Wredundant-constraints -Wpartial-fields + -Wunused-packages -haddock -Winvalid-haddock else ghc-options: -O2 -Wall @@ -104,16 +111,18 @@ hs-source-dirs: bench/memory default-language: Haskell2010 build-depends: - base >=4.15 && <5.0, - bytestring >=0.2 && <0.12, - containers >=0.5 && <0.7, - deepseq >=1.3 && <1.5, + base >=4.18 && <5, + bytestring >=0.2 && <0.13, + containers >=0.5 && <0.9, + deepseq >=1.3 && <1.6, megaparsec, - text >=0.2 && <2.1, + text >=0.2 && <2.2, weigh >=0.0.4 if flag(dev) - ghc-options: -O2 -Wall -Werror + ghc-options: + -Wall -Werror -Wredundant-constraints -Wpartial-fields + -Wunused-packages -haddock -Winvalid-haddock else ghc-options: -O2 -Wall