diff --git a/AUTHORS.md b/AUTHORS.md deleted file mode 100644 --- a/AUTHORS.md +++ /dev/null @@ -1,54 +0,0 @@ -# Authors - -The following people have contributed to Megaparsec/Parsec library. Due to -the fact that original Parsec project has not been keeping this sort of -file, many contributors are missing from this list, if you've contributed to -Parsec project in the past, please open an issue or a pull request, so we -can add you to this list. - -Names below are sorted alphabetically. - -## Author of original Parsec library - -* Daan Leijen - -## Maintainer - -* Mark Karpov - -## Retired maintainers - -* Antoine Latter -* Derek Elkins - -## Contributors - -* Albert Netymk -* Alex Washburn (@recursion-ninja) -* Antoine Latter -* Artyom (@neongreen) -* Auke Booij -* Ben Pence -* Benjamin Kästner -* Björn Buckwalter -* Bryan O'Sullivan -* Cies Breijs -* Daniel Díaz -* Daniel Gorín -* Dennis Gosnell -* Derek Elkins -* Emil Sköldberg -* Herbert Valerio Riedel -* Joel Williamson -* Mark Karpov -* Paolo Martini -* redneb -* Reto Kramer -* Rogan Creswick -* Roman Cheplyaka -* Ryan Scott -* Simon Vandel -* Slava Shklyaev -* Tal Walter -* Tomáš Janoušek -* Vladislav Zavialov diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,35 @@ +## Megaparec 8.0.0 + +* The methods `failure` and `fancyFailure` of `MonadParsec` are now ordinary + functions and live in `Text.Megaparsec`. They are defined in terms of the + new `parseError` method of `MonadParsec`. This method allows us to signal + parse errors at a given offset without manipulating parser state manually. + +* Megaparsec now supports registration of “delayed” parse errors. On lower + level we added a new field called `stateParseErrors` to the `State` + record. The type also had to change from `State s` to `State s e`. This + field contains the list of registered `ParseErrors` that do not end + parsing immediately but still will cause failure in the end if the list is + not empty. Users are expected to register parse errors using the three + functions: `registerParseError`, `registerFailure`, and + `registerFancyFailure`. These functions are analogous to those without the + `register` prefix, except that they have “delayed” effect. + +* Added the `tokensLength` method to the `Stream` type class to improve + support for custom input streams. + +* Added the `setErrorOffset` function to set offset of `ParseError`s. + +* Changed type signatures of `reachOffset` and `reachOffsetNoLine` methods + of the `Stream` type class. Instead of three-tuple `reachOffset` now + returns two-tuple because `SourcePos` is already contained in the returned + `PosState` record. + +* Generalized `decimal`, `binary`, `octal`, and `hexadecimal` parsers in + lexer modules so that they `Num` instead of just `Integral`. + +* Dropped support for GHC 8.2.x and older. + ## Megaparsec 7.0.5 * Dropped support for GHC 7.10. diff --git a/LICENSE.md b/LICENSE.md --- a/LICENSE.md +++ b/LICENSE.md @@ -1,4 +1,4 @@ -Copyright © 2015–2019 Megaparsec contributors\ +Copyright © 2015–present Megaparsec contributors\ Copyright © 2007 Paolo Martini\ Copyright © 1999–2000 Daan Leijen diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -9,7 +9,7 @@ * [Features](#features) * [Core features](#core-features) * [Error messages](#error-messages) - * [Alex support](#alex-support) + * [External lexers](#external-lexers) * [Character and binary parsing](#character-and-binary-parsing) * [Lexer](#lexer) * [Documentation](#documentation) @@ -23,12 +23,11 @@ * [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) -* [Authors](#authors) * [Contribution](#contribution) * [License](#license) This is an industrial-strength monadic parser combinator library. Megaparsec -is a feature-rich package that strikes a nice balance between speed, +is a feature-rich package that tries to find a nice balance between speed, flexibility, and quality of parse errors. ## Features @@ -51,18 +50,14 @@ `MonadParsec`. Megaparsec includes all functionality that is typically available in -Parsec-like libraries and also features some combinators that are quite -unique to it: +Parsec-like libraries and also features some special combinators: -* `failure` allows us to report a parse error with unexpected and expected - items. -* `fancyFailure` provides a way to report custom parse errors. +* `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. * `observing` makes it possible to “observe” parse errors without ending - parsing (they are returned in `Left`, while normal results are wrapped in - `Right`). + parsing. In addition to that, Megaparsec features high-performance combinators similar to those found in [Attoparsec][attoparsec]: @@ -92,20 +87,23 @@ ### Error messages -Megaparsec has well-typed error messages and the ability to signal custom -parse errors to better work in user's domain of interest. +* Megaparsec has typed error messages and the ability to signal custom parse + errors that better suit user's domain of interest. -Megaparsec 7 introduced the `ParseErrorBundle` data type that helps to -manage multi-error messages and pretty-print them easily and efficiently. -That version of the library also made the practice of displaying offending -line the default, similar to how recent versions of GHC do it. +* Since version 8, 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. -### Alex support +* Instead of single parse error Megaparsec produces so-called + `ParseErrorBundle` data type that helps to manage multi-error messages and + pretty-print them easily and efficiently. Since version 8, reporting + multiple parse errors at once has become much easier. +### 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 -versions 6 and 7, but user can still work with custom streams of tokens -without problems. +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. ### Character and binary parsing @@ -139,16 +137,16 @@ ## Tutorials -You can find Megaparsec tutorials [here][tutorials]. They should provide -sufficient guidance to help you start with your parsing tasks. The site also -has instructions and tips for Parsec users who decide to migrate to -Megaparsec. +You can find the most complete Megaparsec tutorial [here][the-tutorial]. It +should provide sufficient guidance to help you start with your parsing +tasks. The site also has instructions and tips for Parsec users who decide +to migrate to Megaparsec. ## Performance Despite being flexible, Megaparsec is also fast. Here is how Megaparsec -7.0.0 compares to [Attoparsec][attoparsec] 0.13.2.2 (the fastest widely used -parsing library in the Haskell ecosystem): +compares to [Attoparsec][attoparsec] (the fastest widely used parsing +library in the Haskell ecosystem): Test case | Execution time | Allocated | Max residency ------------------|---------------:|----------:|-------------: @@ -159,12 +157,18 @@ JSON (Attoparsec) | 18.20 μs | 128,368 | 9,032 JSON (Megaparsec) | 25.45 μs | 203,824 | 9,176 -The benchmarks were created to guide development of Megaparsec 6 and can be -found [here][parsers-bench]. +You can run the benchmarks yourself by executing: -If you think your Megaparsec parser is not efficient enough, take a look at -[these instructions][fast-parser]. +``` +$ nix-bulid -A benches.parsers-bench +$ cd result/bench +$ ./bench-memory +$ ./bench-speed +``` +More information about benchmarking and development can be found +[here][hacking]. + ## Comparison with other solutions There are quite a few libraries that can be used for parsing in Haskell, @@ -193,15 +197,14 @@ 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 well-typed error messages and custom - error messages. +* Better error messages. Megaparsec has typed error messages and custom + error messages, 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. -* Some quirks and “buggy features” (as well as plain bugs) of original - Parsec are fixed. There is no undocumented surprising stuff in Megaparsec. +* Some quirks and bugs of Parsec are fixed. * Better support for Unicode parsing in [`Text.Megaparsec.Char`][tm-char]. @@ -217,10 +220,10 @@ parser* before parsing is finished. 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. This is not possible with Parsec. + foo”, “in expression x”, etc. -* Megaparsec is faster and supports efficient operations on top of `tokens`, - `takeWhileP`, `takeWhile1P`, `takeP` like Attoparsec. +* Megaparsec is faster and supports efficient operations `tokens`, + `takeWhileP`, `takeWhile1P`, `takeP`, like Attoparsec. If you want to see a detailed change log, `CHANGELOG.md` may be helpful. Also see [this original announcement][original-announcement] for another @@ -229,49 +232,38 @@ ### Megaparsec vs Trifecta [Trifecta][trifecta] is another Haskell library featuring good error -messages. Some reasons one may question choice of Trifecta is his/her -parsing library: +messages. These are the common reasons why Trifecta may be problematic to +use: * Complicated, doesn't have any tutorials available, and documentation doesn't help at all. * Trifecta can parse `String` and `ByteString` natively, but not `Text`. -* Trifecta's error messages may be different with their own features, but - certainly not as flexible as Megaparsec's error messages in the latest - versions. - -* Depends on `lens`. This means you'll pull in half of Hackage as transitive - dependencies. Also if you're not into `lens` and would like to keep your - code “vanilla”, you may not like the API. +* Depends on `lens`, which is a very heavy dependency. If you're not into + `lens` and would like to keep your code “vanilla”, you may not like the + API. -[Idris][idris] has recently switched from Trifecta to Megaparsec which -allowed it to [have better error messages and fewer -dependencies][idris-testimony]. +[Idris][idris] has 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 (it your code -compiles, then it probably works) parse context-free grammars (CFG). -Megaparsec is a lower-level library compared to Earley, but there are still -enough reasons to choose it: +[Earley][earley] is a newer library that allows us to safely parse +context-free grammars (CFG). 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 - something of this sort. Even if your grammar is context-free, state may - allow us to add some additional niceties. Earley does not support that. + 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 arbitrary data in them, return multiple error messages, mark regions that affect any error that happens in those regions, etc. -* The approach Earley uses differs from the conventional monadic parsing. If - you work not alone, people you work with, especially beginners, will be - much more productive with libraries taking more traditional path to - parsing like Megaparsec. - In other words, Megaparsec is less safe but also more powerful. ## Related packages @@ -282,6 +274,8 @@ * [`hspec-megaparsec`](https://hackage.haskell.org/package/hspec-megaparsec)—utilities for testing Megaparsec parsers with 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. * [`cassava-megaparsec`](https://hackage.haskell.org/package/cassava-megaparsec)—Megaparsec parser of CSV files that plays nicely with [Cassava](https://hackage.haskell.org/package/cassava). @@ -296,19 +290,20 @@ * [Idris](https://github.com/idris-lang/Idris-dev)—a general-purpose functional programming language with dependent types +* [Dhall](https://github.com/dhall-lang/dhall-haskell)—an advanced + configuration language +* [hnix](https://github.com/haskell-nix/hnix)—re-implementation of the Nix + language in Haskell * [Hledger](https://github.com/simonmichael/hledger)—an accounting tool * [MMark](https://github.com/mmark-md/mmark)—strict markdown processor for writers -* [Stache](https://github.com/stackbuilders/stache)—Mustache templates for - Haskell -* [Language Puppet](https://github.com/bartavelle/language-puppet)—library - for manipulating Puppet manifests ## 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: +* [Megaparsec 8](https://markkarpov.com/post/megaparsec-8.html) * [Megaparsec 7](https://markkarpov.com/post/megaparsec-7.html) * [Evolution of error messages](https://markkarpov.com/post/evolution-of-error-messages.html) * [A major upgrade to Megaparsec: more speed, more power](https://markkarpov.com/post/megaparsec-more-speed-more-power.html) @@ -317,31 +312,26 @@ * [Megaparsec 4 and 5](https://markkarpov.com/post/megaparsec-4-and-5.html) * [The original Megaparsec 4.0.0 announcement][original-announcement] -## Authors - -The project was started and is currently maintained by Mark Karpov. You can -find the complete list of contributors in the `AUTHORS.md` file in the -official repository of the project. Thanks to all the people who propose -features and ideas, although they are not in `AUTHORS.md`, without them -Megaparsec would not be so good. - ## Contribution Issues (bugs, feature requests or otherwise feedback) may be reported in -[the GitHub issue tracker for this project](https://github.com/mrkkrp/megaparsec/issues). +[the GitHub issue tracker for this +project](https://github.com/mrkkrp/megaparsec/issues). -Pull requests are also welcome. +Pull requests are also welcome. If you would like to contribute to the +project, you may find [this document][hacking] helpful. ## License -Copyright © 2015–2019 Megaparsec contributors\ +Copyright © 2015–present Megaparsec contributors\ Copyright © 2007 Paolo Martini\ Copyright © 1999–2000 Daan Leijen Distributed under FreeBSD license. [hackage]: https://hackage.haskell.org/package/megaparsec -[tutorials]: https://markkarpov.com/learn-haskell.html#megaparsec-tutorials +[the-tutorial]: https://markkarpov.com/megaparsec/megaparsec.html +[hacking]: ./HACKING.md [tm]: https://hackage.haskell.org/package/megaparsec/docs/Text-Megaparsec.html [tm-char]: https://hackage.haskell.org/package/megaparsec/docs/Text-Megaparsec-Char.html diff --git a/Setup.hs b/Setup.hs --- a/Setup.hs +++ b/Setup.hs @@ -1,6 +1,2 @@ -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 @@ -1,6 +1,6 @@ -- | -- Module : Text.Megaparsec --- Copyright : © 2015–2019 Megaparsec contributors +-- Copyright : © 2015–present Megaparsec contributors -- © 2007 Paolo Martini -- © 1999–2001 Daan Leijen -- License : FreeBSD @@ -75,6 +75,16 @@ , runParserT' -- * Primitive combinators , MonadParsec (..) + -- * Signaling parse errors + -- $parse-errors + , failure + , fancyFailure + , unexpected + , customFailure + , region + , registerParseError + , registerFailure + , registerFancyFailure -- * Derivatives of primitive combinators , single , satisfy @@ -84,10 +94,7 @@ , noneOf , chunk , () - , unexpected - , customFailure , match - , region , takeRest , atEnd -- * Parser state combinators @@ -103,12 +110,14 @@ import Control.Monad.Identity import Data.List.NonEmpty (NonEmpty (..)) import Data.Maybe (fromJust) +import Data.Set (Set) import Text.Megaparsec.Class import Text.Megaparsec.Error import Text.Megaparsec.Internal import Text.Megaparsec.Pos import Text.Megaparsec.State import Text.Megaparsec.Stream +import qualified Data.List.NonEmpty as NE import qualified Data.Set as E -- $reexports @@ -222,8 +231,8 @@ runParser' :: Parsec e s a -- ^ Parser to run - -> State s -- ^ Initial state - -> (State s, Either (ParseErrorBundle s e) a) + -> State s e -- ^ Initial state + -> (State s e, Either (ParseErrorBundle s e) a) runParser' p = runIdentity . runParserT' p -- | @'runParserT' p file input@ runs parser @p@ on the input list of tokens @@ -247,22 +256,26 @@ runParserT' :: Monad m => ParsecT e s m a -- ^ Parser to run - -> State s -- ^ Initial state - -> m (State s, Either (ParseErrorBundle s e) a) + -> State s e -- ^ Initial state + -> m (State s e, Either (ParseErrorBundle s e) a) runParserT' p s = do (Reply s' _ result) <- runParsecT p s + let toBundle es = ParseErrorBundle + { bundleErrors = + NE.sortWith errorOffset es + , bundlePosState = statePosState s + } return $ case result of - OK x -> (s', Right x) + OK x -> + case NE.nonEmpty (stateParseErrors s') of + Nothing -> (s', Right x) + Just de -> (s', Left (toBundle de)) Error e -> - let bundle = ParseErrorBundle - { bundleErrors = e :| [] - , bundlePosState = statePosState s - } - in (s', Left bundle) + (s', Left (toBundle (e :| stateParseErrors s'))) -- | Given name of source file and input construct initial state for parser. -initialState :: String -> s -> State s +initialState :: String -> s -> State s e initialState name s = State { stateInput = s , stateOffset = 0 @@ -273,9 +286,135 @@ , 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. + +-- | Stop parsing and report a trivial 'ParseError'. +-- +-- @since 6.0.0 + +failure + :: MonadParsec e s m + => Maybe (ErrorItem (Token s)) -- ^ Unexpected item (if any) + -> Set (ErrorItem (Token s)) -- ^ Expected items + -> m a +failure us ps = do + o <- getOffset + parseError (TrivialError o us ps) +{-# INLINE failure #-} + +-- | Stop parsing and report a fancy 'ParseError'. To report a single custom +-- parse error, see 'Text.Megaparsec.customFailure'. +-- +-- @since 6.0.0 + +fancyFailure + :: MonadParsec e s m + => Set (ErrorFancy e) -- ^ Fancy error components + -> m a +fancyFailure xs = do + o <- getOffset + parseError (FancyError o xs) +{-# INLINE fancyFailure #-} + +-- | The parser @'unexpected' item@ fails with an error message telling +-- about 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 item = failure (Just item) E.empty +{-# INLINE unexpected #-} + +-- | Report a custom parse error. For a more general version, see +-- 'fancyFailure'. +-- +-- > customFailure = fancyFailure . Set.singleton . ErrorCustom +-- +-- @since 6.3.0 + +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 +-- “restored” on the way out of 'region'. +-- +-- @since 5.3.0 + +region :: MonadParsec e s m + => (ParseError s e -> ParseError s e) + -- ^ How to process 'ParseError's + -> m a -- ^ The “region” that the processing applies to + -> m a +region f m = do + deSoFar <- stateParseErrors <$> getParserState + updateParserState $ \s -> + s { stateParseErrors = [] } + r <- observing m + updateParserState $ \s -> + s { stateParseErrors = (f <$> stateParseErrors s) ++ deSoFar } + case r of + Left err -> parseError (f err) + Right x -> return x +{-# INLINEABLE region #-} + +-- | 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 +-- parser will 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 e = updateParserState $ \s -> + s { stateParseErrors = e : stateParseErrors s } +{-# INLINE registerParseError #-} + +-- | Like 'failure', but for delayed 'ParseError's. +-- +-- @since 8.0.0 + +registerFailure + :: MonadParsec e s m + => Maybe (ErrorItem (Token s)) -- ^ Unexpected item (if any) + -> Set (ErrorItem (Token s)) -- ^ Expected items + -> m () +registerFailure us ps = do + o <- getOffset + registerParseError (TrivialError o us ps) +{-# INLINE registerFailure #-} + +-- | Like 'fancyFailure', but for delayed 'ParseError's. +-- +-- @since 8.0.0 + +registerFancyFailure + :: MonadParsec e s m + => Set (ErrorFancy e) -- ^ Fancy error components + -> m () +registerFancyFailure xs = do + o <- getOffset + registerParseError (FancyError o xs) +{-# INLINE registerFancyFailure #-} + +---------------------------------------------------------------------------- -- Derivatives of primitive combinators -- | @'single' t@ only matches the single token @t@. @@ -411,26 +550,6 @@ () = flip label {-# INLINE () #-} --- | The parser @'unexpected' item@ fails with an error message telling --- about 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 item = failure (Just item) E.empty -{-# INLINE unexpected #-} - --- | Report a custom parse error. For a more general version, see --- 'fancyFailure'. --- --- > customFailure = fancyFailure . E.singleton . ErrorCustom --- --- @since 6.3.0 - -customFailure :: MonadParsec e s m => e -> m a -customFailure = fancyFailure . E.singleton . ErrorCustom -{-# INLINE customFailure #-} - -- | Return both the result of a parse and a 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 @@ -452,34 +571,6 @@ return ((fst . fromJust) (takeN_ (o' - o) s), r) {-# INLINEABLE match #-} --- | Specify how to process 'ParseError's that happen inside of this --- wrapper. As a side effect of the current implementation changing --- 'errorOffset' with this combinator will also change the final --- 'stateOffset' in the parser state (try to avoid that because --- 'stateOffset' will go out of sync with factual position in the input --- stream and pretty-printing of parse errors afterwards will be incorrect). --- --- @since 5.3.0 - -region :: MonadParsec e s m - => (ParseError s e -> ParseError s e) - -- ^ How to process 'ParseError's - -> m a -- ^ The “region” that the processing applies to - -> m a -region f m = do - r <- observing m - case r of - Left err -> - case f err of - TrivialError o us ps -> do - updateParserState $ \st -> st { stateOffset = o } - failure us ps - FancyError o xs -> do - updateParserState $ \st -> st { stateOffset = o } - fancyFailure xs - Right x -> return x -{-# INLINEABLE region #-} - -- | Consume the rest of the input and return it as a chunk. This parser -- never fails, but may return the empty chunk. -- @@ -513,7 +604,7 @@ -- | @'setInput' input@ continues parsing with @input@. setInput :: MonadParsec e s m => s -> m () -setInput s = updateParserState (\(State _ o pst) -> State s o pst) +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 @@ -529,9 +620,9 @@ getSourcePos :: MonadParsec e s m => m SourcePos getSourcePos = do st <- getParserState - let (pos, pst) = reachOffsetNoLine (stateOffset st) (statePosState st) + let pst = reachOffsetNoLine (stateOffset st) (statePosState st) setParserState st { statePosState = pst } - return pos + return (pstateSourcePos pst) {-# INLINE getSourcePos #-} -- | Get the number of tokens processed so far. @@ -551,14 +642,14 @@ -- @since 7.0.0 setOffset :: MonadParsec e s m => Int -> m () -setOffset o = updateParserState $ \(State s _ pst) -> - State s o pst +setOffset o = updateParserState $ \(State s _ pst de) -> + State s o pst de {-# INLINE setOffset #-} -- | @'setParserState' st@ sets the parser state to @st@. -- -- See also: 'getParserState', 'updateParserState'. -setParserState :: MonadParsec e s m => State s -> 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 @@ -1,6 +1,6 @@ -- | -- Module : Text.Megaparsec.Byte --- Copyright : © 2015–2019 Megaparsec contributors +-- Copyright : © 2015–present Megaparsec contributors -- License : FreeBSD -- -- Maintainer : Mark Karpov 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 @@ -1,6 +1,6 @@ -- | -- Module : Text.Megaparsec.Byte.Lexer --- Copyright : © 2015–2019 Megaparsec contributors +-- Copyright : © 2015–present Megaparsec contributors -- License : FreeBSD -- -- Maintainer : Mark Karpov @@ -100,7 +100,7 @@ -- If you need to parse signed integers, see the 'signed' combinator. decimal - :: forall e s m a. (MonadParsec e s m, Token s ~ Word8, Integral a) + :: forall e s m a. (MonadParsec e s m, Token s ~ Word8, Num a) => m a decimal = decimal_ "integer" {-# INLINEABLE decimal #-} @@ -108,7 +108,7 @@ -- | A non-public helper to parse decimal integers. decimal_ - :: forall e s m a. (MonadParsec e s m, Token s ~ Word8, Integral a) + :: forall e s m a. (MonadParsec e s m, Token s ~ Word8, Num a) => m a decimal_ = mkNum <$> takeWhile1P (Just "digit") isDigit where @@ -126,7 +126,7 @@ -- @since 7.0.0 binary - :: forall e s m a. (MonadParsec e s m, Token s ~ Word8, Integral a) + :: forall e s m a. (MonadParsec e s m, Token s ~ Word8, Num a) => m a binary = mkNum <$> takeWhile1P Nothing isBinDigit @@ -148,7 +148,7 @@ -- > octal = char 48 >> char' 111 >> L.octal octal - :: forall e s m a. (MonadParsec e s m, Token s ~ Word8, Integral a) + :: forall e s m a. (MonadParsec e s m, Token s ~ Word8, Num a) => m a octal = mkNum <$> takeWhile1P Nothing isOctDigit @@ -170,7 +170,7 @@ -- > hexadecimal = char 48 >> char' 120 >> L.hexadecimal hexadecimal - :: forall e s m a. (MonadParsec e s m, Token s ~ Word8, Integral a) + :: forall e s m a. (MonadParsec e s m, Token s ~ Word8, Num a) => m a hexadecimal = mkNum <$> takeWhile1P Nothing isHexDigit diff --git a/Text/Megaparsec/Char.hs b/Text/Megaparsec/Char.hs --- a/Text/Megaparsec/Char.hs +++ b/Text/Megaparsec/Char.hs @@ -1,6 +1,6 @@ -- | -- Module : Text.Megaparsec.Char --- Copyright : © 2015–2019 Megaparsec contributors +-- Copyright : © 2015–present Megaparsec contributors -- © 2007 Paolo Martini -- © 1999–2001 Daan Leijen -- License : FreeBSD 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 @@ -1,6 +1,6 @@ -- | -- Module : Text.Megaparsec.Char.Lexer --- Copyright : © 2015–2019 Megaparsec contributors +-- Copyright : © 2015–present Megaparsec contributors -- © 2007 Paolo Martini -- © 1999–2001 Daan Leijen -- License : FreeBSD @@ -332,14 +332,14 @@ -- __Note__: before version 6.0.0 the function returned 'Integer', i.e. it -- wasn't polymorphic in its return type. -decimal :: (MonadParsec e s m, Token s ~ Char, Integral a) => m a +decimal :: (MonadParsec e s m, Token s ~ Char, Num a) => m a decimal = decimal_ "integer" {-# INLINEABLE decimal #-} -- | A non-public helper to parse decimal integers. decimal_ - :: forall e s m a. (MonadParsec e s m, Token s ~ Char, Integral a) + :: forall e s m a. (MonadParsec e s m, Token s ~ Char, Num a) => m a decimal_ = mkNum <$> takeWhile1P (Just "digit") Char.isDigit where @@ -357,7 +357,7 @@ -- @since 7.0.0 binary - :: forall e s m a. (MonadParsec e s m, Token s ~ Char, Integral a) + :: forall e s m a. (MonadParsec e s m, Token s ~ Char, Num a) => m a binary = mkNum <$> takeWhile1P Nothing isBinDigit @@ -382,7 +382,7 @@ -- wasn't polymorphic in its return type. octal - :: forall e s m a. (MonadParsec e s m, Token s ~ Char, Integral a) + :: forall e s m a. (MonadParsec e s m, Token s ~ Char, Num a) => m a octal = mkNum <$> takeWhile1P Nothing Char.isOctDigit @@ -406,7 +406,7 @@ -- wasn't polymorphic in its return type. hexadecimal - :: forall e s m a. (MonadParsec e s m, Token s ~ Char, Integral a) + :: forall e s m a. (MonadParsec e s m, Token s ~ Char, Num a) => m a hexadecimal = mkNum <$> takeWhile1P Nothing Char.isHexDigit diff --git a/Text/Megaparsec/Class.hs b/Text/Megaparsec/Class.hs --- a/Text/Megaparsec/Class.hs +++ b/Text/Megaparsec/Class.hs @@ -1,6 +1,6 @@ -- | -- Module : Text.Megaparsec.Class --- Copyright : © 2015–2019 Megaparsec contributors +-- Copyright : © 2015–present Megaparsec contributors -- © 2007 Paolo Martini -- © 1999–2001 Daan Leijen -- License : FreeBSD @@ -14,7 +14,6 @@ -- -- @since 6.5.0 -{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE MultiParamTypeClasses #-} @@ -40,38 +39,22 @@ import qualified Control.Monad.Trans.Writer.Lazy as L import qualified Control.Monad.Trans.Writer.Strict as S -#if !MIN_VERSION_mtl(2,2,2) -import Control.Monad.Trans.Identity -#endif - -- | Type class describing monads that implement the full set of primitive -- parsers. -- --- __Note carefully__ that the following primitives are “fast” and should be --- taken advantage of as much as possible if your aim is a fast parser: --- 'tokens', 'takeWhileP', 'takeWhile1P', and 'takeP'. +-- __Note__ that the following primitives are “fast” and should be taken +-- advantage of as much as possible if your aim is a fast parser: 'tokens', +-- 'takeWhileP', 'takeWhile1P', and 'takeP'. class (Stream s, MonadPlus m) => MonadParsec e s m | m -> e s where - -- | The most general way to stop parsing and report a trivial - -- 'ParseError'. - -- - -- @since 6.0.0 - - failure - :: Maybe (ErrorItem (Token s)) -- ^ Unexpected item (if any) - -> Set (ErrorItem (Token s)) -- ^ Expected items - -> m a - - -- | The most general way to stop parsing and report a fancy 'ParseError'. - -- To report a single custom parse error, see - -- 'Text.Megaparsec.customFailure'. + -- | Stop parsing and report the 'ParseError'. This is the only way to + -- control position of the error without manipulating parser state + -- manually. -- - -- @since 6.0.0 + -- @since 8.0.0 - fancyFailure - :: Set (ErrorFancy e) -- ^ Fancy error components - -> m a + parseError :: ParseError s e -> m a -- | The parser @'label' name p@ behaves as parser @p@, but whenever the -- parser @p@ fails /without consuming any input/, it replaces names of @@ -120,12 +103,11 @@ -- unexpected "le" -- expecting "let" or "lexical" -- - -- __Please note__ that as of Megaparsec 4.4.0, - -- 'Text.Megaparsec.Char.string' backtracks automatically (see 'tokens'), - -- so it does not need 'try'. However, the examples above demonstrate the - -- idea behind 'try' so well that it was decided to keep them. You still - -- need to use 'try' when your alternatives are complex, composite - -- parsers. + -- __Note__ that as of Megaparsec 4.4.0, 'Text.Megaparsec.Char.string' + -- backtracks automatically (see 'tokens'), so it does not need 'try'. + -- However, the examples above demonstrate the idea behind 'try' so well + -- that it was decided to keep them. You still need to use 'try' when your + -- alternatives are complex, composite parsers. try :: m a -> m a @@ -283,18 +265,17 @@ -- | Return the full parser state as a 'State' record. - getParserState :: m (State s) + getParserState :: m (State s e) -- | @'updateParserState' f@ applies the function @f@ to the parser state. - updateParserState :: (State s -> State s) -> m () + updateParserState :: (State s e -> State s e) -> m () ---------------------------------------------------------------------------- -- Lifting through MTL instance MonadParsec e s m => MonadParsec e s (L.StateT st m) where - failure us ps = lift (failure us ps) - fancyFailure xs = lift (fancyFailure xs) + parseError e = lift (parseError e) label n (L.StateT m) = L.StateT $ label n . m try (L.StateT m) = L.StateT $ try . m lookAhead (L.StateT m) = L.StateT $ \s -> @@ -315,8 +296,7 @@ updateParserState f = lift (updateParserState f) instance MonadParsec e s m => MonadParsec e s (S.StateT st m) where - failure us ps = lift (failure us ps) - fancyFailure xs = lift (fancyFailure xs) + parseError e = lift (parseError e) label n (S.StateT m) = S.StateT $ label n . m try (S.StateT m) = S.StateT $ try . m lookAhead (S.StateT m) = S.StateT $ \s -> @@ -337,8 +317,7 @@ updateParserState f = lift (updateParserState f) instance MonadParsec e s m => MonadParsec e s (L.ReaderT r m) where - failure us ps = lift (failure us ps) - fancyFailure xs = lift (fancyFailure xs) + parseError e = lift (parseError e) label n (L.ReaderT m) = L.ReaderT $ label n . m try (L.ReaderT m) = L.ReaderT $ try . m lookAhead (L.ReaderT m) = L.ReaderT $ lookAhead . m @@ -356,8 +335,7 @@ updateParserState f = lift (updateParserState f) instance (Monoid w, MonadParsec e s m) => MonadParsec e s (L.WriterT w m) where - failure us ps = lift (failure us ps) - fancyFailure xs = lift (fancyFailure xs) + parseError e = lift (parseError e) label n (L.WriterT m) = L.WriterT $ label n m try (L.WriterT m) = L.WriterT $ try m lookAhead (L.WriterT m) = L.WriterT $ @@ -378,8 +356,7 @@ updateParserState f = lift (updateParserState f) instance (Monoid w, MonadParsec e s m) => MonadParsec e s (S.WriterT w m) where - failure us ps = lift (failure us ps) - fancyFailure xs = lift (fancyFailure xs) + parseError e = lift (parseError e) label n (S.WriterT m) = S.WriterT $ label n m try (S.WriterT m) = S.WriterT $ try m lookAhead (S.WriterT m) = S.WriterT $ @@ -402,8 +379,7 @@ -- | @since 5.2.0 instance (Monoid w, MonadParsec e s m) => MonadParsec e s (L.RWST r w st m) where - failure us ps = lift (failure us ps) - fancyFailure xs = lift (fancyFailure xs) + parseError e = lift (parseError e) label n (L.RWST m) = L.RWST $ \r s -> label n (m r s) try (L.RWST m) = L.RWST $ \r s -> try (m r s) lookAhead (L.RWST m) = L.RWST $ \r s -> do @@ -428,8 +404,7 @@ -- | @since 5.2.0 instance (Monoid w, MonadParsec e s m) => MonadParsec e s (S.RWST r w st m) where - failure us ps = lift (failure us ps) - fancyFailure xs = lift (fancyFailure xs) + parseError e = lift (parseError e) label n (S.RWST m) = S.RWST $ \r s -> label n (m r s) try (S.RWST m) = S.RWST $ \r s -> try (m r s) lookAhead (S.RWST m) = S.RWST $ \r s -> do @@ -452,8 +427,7 @@ updateParserState f = lift (updateParserState f) instance MonadParsec e s m => MonadParsec e s (IdentityT m) where - failure us ps = lift (failure us ps) - fancyFailure xs = lift (fancyFailure xs) + parseError e = lift (parseError e) label n (IdentityT m) = IdentityT $ label n m try = IdentityT . try . runIdentityT lookAhead (IdentityT m) = IdentityT $ lookAhead m diff --git a/Text/Megaparsec/Common.hs b/Text/Megaparsec/Common.hs --- a/Text/Megaparsec/Common.hs +++ b/Text/Megaparsec/Common.hs @@ -1,6 +1,6 @@ -- | -- Module : Text.Megaparsec.Common --- Copyright : © 2018–2019 Megaparsec contributors +-- Copyright : © 2018–present Megaparsec contributors -- License : FreeBSD -- -- Maintainer : Mark Karpov diff --git a/Text/Megaparsec/Debug.hs b/Text/Megaparsec/Debug.hs --- a/Text/Megaparsec/Debug.hs +++ b/Text/Megaparsec/Debug.hs @@ -1,6 +1,6 @@ -- | -- Module : Text.Megaparsec.Debug --- Copyright : © 2015–2019 Megaparsec contributors +-- Copyright : © 2015–present Megaparsec contributors -- License : FreeBSD -- -- Maintainer : Mark Karpov @@ -125,8 +125,8 @@ -- after parsing. streamDelta - :: State s -- ^ State of parser before consumption - -> State s -- ^ State of parser after consumption + :: State s e -- ^ State of parser before consumption + -> State s e -- ^ State of parser after consumption -> Int -- ^ Number of consumed tokens streamDelta s0 s1 = stateOffset s1 - stateOffset s0 diff --git a/Text/Megaparsec/Error.hs b/Text/Megaparsec/Error.hs --- a/Text/Megaparsec/Error.hs +++ b/Text/Megaparsec/Error.hs @@ -1,6 +1,6 @@ -- | -- Module : Text.Megaparsec.Error --- Copyright : © 2015–2019 Megaparsec contributors +-- Copyright : © 2015–present Megaparsec contributors -- License : FreeBSD -- -- Maintainer : Mark Karpov @@ -15,18 +15,17 @@ -- You probably do not want to import this module directly because -- "Text.Megaparsec" re-exports it anyway. -{-# LANGUAGE BangPatterns #-} -{-# LANGUAGE CPP #-} -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE DeriveFunctor #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE StandaloneDeriving #-} -{-# LANGUAGE UndecidableInstances#-} +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveFunctor #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE UndecidableInstances #-} module Text.Megaparsec.Error ( -- * Parse error type @@ -35,6 +34,7 @@ , ParseError (..) , mapParseError , errorOffset + , setErrorOffset , ParseErrorBundle (..) , attachSourcePos -- * Pretty-printing @@ -62,10 +62,6 @@ import qualified Data.List.NonEmpty as NE import qualified Data.Set as E -#if !MIN_VERSION_base(4,11,0) -import Data.Semigroup -#endif - ---------------------------------------------------------------------------- -- Parse error type @@ -178,7 +174,7 @@ mapParseError _ (TrivialError o u p) = TrivialError o u p mapParseError f (FancyError o x) = FancyError o (E.map (fmap f) x) --- | Get offset of given 'ParseError'. +-- | Get offset of 'ParseError'. -- -- @since 7.0.0 @@ -186,6 +182,14 @@ errorOffset (TrivialError o _ _) = o errorOffset (FancyError o _) = o +-- | Set offset of 'ParseError'. +-- +-- @since 8.0.0 + +setErrorOffset :: Int -> ParseError s e -> ParseError s e +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 @@ -290,9 +294,9 @@ where f a = do pst <- get - let (spos, pst') = reachOffsetNoLine (projectOffset a) pst + let pst' = reachOffsetNoLine (projectOffset a) pst put pst' - return (a, spos) + return (a, pstateSourcePos pst') {-# INLINEABLE attachSourcePos #-} ---------------------------------------------------------------------------- @@ -341,7 +345,8 @@ -> (ShowS, PosState s) f (o, !pst) e = (o . (outChunk ++), pst') where - (epos, sline, pst') = reachOffset (errorOffset e) pst + (sline, pst') = reachOffset (errorOffset e) pst + epos = pstateSourcePos pst' outChunk = "\n" <> sourcePosPretty epos <> ":\n" <> padding <> "|\n" <> @@ -361,10 +366,11 @@ then slineLen - rpshift + 1 else elen slineLen = length sline + pxy = Proxy :: Proxy s elen = case e of TrivialError _ Nothing _ -> 1 - TrivialError _ (Just x) _ -> errorItemLength x + TrivialError _ (Just x) _ -> errorItemLength pxy x FancyError _ xs -> E.foldl' (\a b -> max a (errorFancyLength b)) 1 xs @@ -415,9 +421,9 @@ -- | Get length of the “pointer” to display under a given 'ErrorItem'. -errorItemLength :: ErrorItem t -> Int -errorItemLength = \case - Tokens ts -> NE.length ts +errorItemLength :: Stream s => Proxy s -> ErrorItem (Token s) -> Int +errorItemLength pxy = \case + Tokens ts -> tokensLength pxy ts _ -> 1 -- | Pretty-print an 'ErrorFancy'. diff --git a/Text/Megaparsec/Error.hs-boot b/Text/Megaparsec/Error.hs-boot new file mode 100644 --- /dev/null +++ b/Text/Megaparsec/Error.hs-boot @@ -0,0 +1,10 @@ +{-# LANGUAGE RoleAnnotations #-} + +module Text.Megaparsec.Error + ( ParseError + ) +where + +type role ParseError nominal nominal + +data ParseError s e 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 @@ -1,6 +1,6 @@ -- | -- Module : Text.Megaparsec.Error.Builder --- Copyright : © 2015–2019 Megaparsec contributors +-- Copyright : © 2015–present Megaparsec contributors -- License : FreeBSD -- -- Maintainer : Mark Karpov @@ -12,7 +12,6 @@ -- -- @since 6.0.0 -{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleContexts #-} @@ -49,10 +48,6 @@ import Text.Megaparsec.Stream import qualified Data.List.NonEmpty as NE import qualified Data.Set as E - -#if !MIN_VERSION_base(4,11,0) -import Data.Semigroup -#endif ---------------------------------------------------------------------------- -- Data types diff --git a/Text/Megaparsec/Internal.hs b/Text/Megaparsec/Internal.hs --- a/Text/Megaparsec/Internal.hs +++ b/Text/Megaparsec/Internal.hs @@ -1,6 +1,6 @@ -- | -- Module : Text.Megaparsec.Internal --- Copyright : © 2015–2019 Megaparsec contributors +-- Copyright : © 2015–present Megaparsec contributors -- © 2007 Paolo Martini -- © 1999–2001 Daan Leijen -- License : FreeBSD @@ -25,10 +25,6 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-} -#if !MIN_VERSION_base(4,11,0) -{-# OPTIONS -Wno-noncanonical-monoid-instances #-} -#endif - module Text.Megaparsec.Internal ( -- * Data types Hints (..) @@ -98,7 +94,7 @@ -- -- See also: 'Consumption', 'Result'. -data Reply e s a = Reply (State s) Consumption (Result s e a) +data Reply e s a = Reply (State s e) Consumption (Result s e a) -- | Whether the input has been consumed or not. -- @@ -122,11 +118,11 @@ newtype ParsecT e s m a = ParsecT { unParser - :: forall b. State s - -> (a -> State s -> Hints (Token s) -> m b) -- consumed-OK - -> (ParseError s e -> State s -> m b) -- consumed-error - -> (a -> State s -> Hints (Token s) -> m b) -- empty-OK - -> (ParseError s e -> State s -> m b) -- empty-error + :: forall b. State s e + -> (a -> State s e -> Hints (Token s) -> m b) -- consumed-OK + -> (ParseError s e -> State s e -> m b) -- consumed-error + -> (a -> State s e -> Hints (Token s) -> m b) -- empty-OK + -> (ParseError s e -> State s e -> m b) -- empty-error -> m b } -- | @since 5.3.0 @@ -142,11 +138,7 @@ instance (Stream s, Monoid a) => Monoid (ParsecT e s m a) where mempty = pure mempty {-# INLINE mempty #-} -#if MIN_VERSION_base(4,11,0) mappend = (<>) -#else - mappend = liftA2 mappend -#endif {-# INLINE mappend #-} mconcat = fmap mconcat . sequence {-# INLINE mconcat #-} @@ -220,7 +212,7 @@ fail = pFail pFail :: String -> ParsecT e s m a -pFail msg = ParsecT $ \s@(State _ o _) _ _ _ eerr -> +pFail msg = ParsecT $ \s@(State _ o _ _) _ _ _ eerr -> let d = E.singleton (ErrorFail msg) in eerr (FancyError o d) s {-# INLINE pFail #-} @@ -248,7 +240,7 @@ runParsecT p s `catchError` \e -> runParsecT (h e) s -mkPT :: Monad m => (State s -> m (Reply e s a)) -> ParsecT e s m a +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 (Reply s' consumption result) <- k s case consumption of @@ -268,7 +260,7 @@ mplus = pPlus pZero :: ParsecT e s m a -pZero = ParsecT $ \s@(State _ o _) _ _ _ eerr -> +pZero = ParsecT $ \s@(State _ o _ _) _ _ _ eerr -> eerr (TrivialError o Nothing E.empty) s {-# INLINE pZero #-} @@ -289,8 +281,8 @@ -- tokens. If the numbers of processed tokens are equal, prefer the second -- state. -longestMatch :: State s -> State s -> State s -longestMatch s1@(State _ o1 _) s2@(State _ o2 _) = +longestMatch :: State s e -> State s e -> State s e +longestMatch s1@(State _ o1 _ _) s2@(State _ o2 _ _) = case o1 `compare` o2 of LT -> s2 EQ -> s2 @@ -312,8 +304,7 @@ amb >>= \a -> eok a s mempty instance (Ord e, Stream s) => MonadParsec e s (ParsecT e s m) where - failure = pFailure - fancyFailure = pFancyFailure + parseError = pParseError label = pLabel try = pTry lookAhead = pLookAhead @@ -329,20 +320,11 @@ getParserState = pGetParserState updateParserState = pUpdateParserState -pFailure - :: Maybe (ErrorItem (Token s)) - -> Set (ErrorItem (Token s)) - -> ParsecT e s m a -pFailure us ps = ParsecT $ \s@(State _ o _) _ _ _ eerr -> - eerr (TrivialError o us ps) s -{-# INLINE pFailure #-} - -pFancyFailure - :: Set (ErrorFancy e) +pParseError + :: ParseError s e -> ParsecT e s m a -pFancyFailure xs = ParsecT $ \s@(State _ o _) _ _ _ eerr -> - eerr (FancyError o xs) s -{-# INLINE pFancyFailure #-} +pParseError e = ParsecT $ \s _ _ _ eerr -> eerr e s +{-# INLINE pParseError #-} pLabel :: String -> ParsecT e s m a -> ParsecT e s m a pLabel l p = ParsecT $ \s cok cerr eok eerr -> @@ -373,7 +355,7 @@ {-# INLINE pLookAhead #-} pNotFollowedBy :: Stream s => ParsecT e s m a -> ParsecT e s m () -pNotFollowedBy p = ParsecT $ \s@(State input o _) _ _ eok eerr -> +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 @@ -415,21 +397,21 @@ {-# INLINE pObserving #-} pEof :: forall e s m. Stream s => ParsecT e s m () -pEof = ParsecT $ \s@(State input o pst) _ _ eok eerr -> +pEof = ParsecT $ \s@(State input o pst de) _ _ eok eerr -> case take1_ input of Nothing -> eok () s mempty Just (x,_) -> let us = (pure . Tokens . nes) x ps = E.singleton EndOfInput in eerr (TrivialError o us ps) - (State input o pst) + (State input o pst de) {-# INLINE pEof #-} pToken :: forall e s m a. Stream s => (Token s -> Maybe a) -> Set (ErrorItem (Token s)) -> ParsecT e s m a -pToken test ps = ParsecT $ \s@(State input o pst) cok _ _ eerr -> +pToken test ps = ParsecT $ \s@(State input o pst de) cok _ _ eerr -> case take1_ input of Nothing -> let us = pure EndOfInput @@ -439,16 +421,16 @@ Nothing -> let us = (Just . Tokens . nes) c in eerr (TrivialError o us ps) - (State input o pst) + (State input o pst de) Just x -> - cok x (State cs (o + 1) pst) mempty + cok x (State cs (o + 1) pst de) mempty {-# INLINE pToken #-} pTokens :: forall e s m. Stream s => (Tokens s -> Tokens s -> Bool) -> Tokens s -> ParsecT e s m (Tokens s) -pTokens f tts = ParsecT $ \s@(State input o pst) cok _ eok eerr -> +pTokens f tts = ParsecT $ \s@(State input o pst de) cok _ eok eerr -> let pxy = Proxy :: Proxy s unexpect pos' u = let us = pure u @@ -460,19 +442,19 @@ eerr (unexpect o EndOfInput) s Just (tts', input') -> if f tts tts' - then let st = State input' (o + len) pst + then let st = State input' (o + len) pst de in if chunkEmpty pxy tts then eok tts' st mempty else cok tts' st mempty else let ps = (Tokens . NE.fromList . chunkToTokens pxy) tts' - in eerr (unexpect o ps) (State input o pst) + in eerr (unexpect o ps) (State input o pst de) {-# INLINE pTokens #-} pTakeWhileP :: forall e s m. Stream s => Maybe String -> (Token s -> Bool) -> ParsecT e s m (Tokens s) -pTakeWhileP ml f = ParsecT $ \(State input o pst) cok _ eok _ -> +pTakeWhileP ml f = ParsecT $ \(State input o pst de) cok _ eok _ -> let pxy = Proxy :: Proxy s (ts, input') = takeWhile_ f input len = chunkLength pxy ts @@ -481,15 +463,15 @@ Nothing -> mempty Just l -> (Hints . pure . E.singleton . Label) l in if chunkEmpty pxy ts - then eok ts (State input' (o + len) pst) hs - else cok ts (State input' (o + len) pst) hs + then eok ts (State input' (o + len) pst de) hs + else cok ts (State input' (o + len) pst de) hs {-# INLINE pTakeWhileP #-} pTakeWhile1P :: forall e s m. Stream s => Maybe String -> (Token s -> Bool) -> ParsecT e s m (Tokens s) -pTakeWhile1P ml f = ParsecT $ \(State input o pst) cok _ _ eerr -> +pTakeWhile1P ml f = ParsecT $ \(State input o pst de) cok _ _ eerr -> let pxy = Proxy :: Proxy s (ts, input') = takeWhile_ f input len = chunkLength pxy ts @@ -505,15 +487,15 @@ Just (t,_) -> Tokens (nes t) ps = maybe E.empty E.singleton el in eerr (TrivialError o us ps) - (State input o pst) - else cok ts (State input' (o + len) pst) hs + (State input o pst de) + else cok ts (State input' (o + len) pst de) hs {-# INLINE pTakeWhile1P #-} pTakeP :: forall e s m. Stream s => Maybe String -> Int -> ParsecT e s m (Tokens s) -pTakeP ml n = ParsecT $ \s@(State input o pst) cok _ _ eerr -> +pTakeP ml n = ParsecT $ \s@(State input o pst de) cok _ _ eerr -> let pxy = Proxy :: Proxy s el = Label <$> (ml >>= NE.nonEmpty) ps = maybe E.empty E.singleton el @@ -524,15 +506,15 @@ let len = chunkLength pxy ts in if len /= n then eerr (TrivialError (o + len) (pure EndOfInput) ps) - (State input o pst) - else cok ts (State input' (o + len) pst) mempty + (State input o pst de) + else cok ts (State input' (o + len) pst de) mempty {-# INLINE pTakeP #-} -pGetParserState :: ParsecT e s m (State s) +pGetParserState :: ParsecT e s m (State s e) pGetParserState = ParsecT $ \s _ _ eok _ -> eok s s mempty {-# INLINE pGetParserState #-} -pUpdateParserState :: (State s -> State s) -> ParsecT e s m () +pUpdateParserState :: (State s e -> State s e) -> ParsecT e s m () pUpdateParserState f = ParsecT $ \s _ _ eok _ -> eok () (f s) mempty {-# INLINE pUpdateParserState #-} @@ -570,9 +552,9 @@ withHints :: Stream s => Hints (Token s) -- ^ Hints to use - -> (ParseError s e -> State s -> m b) -- ^ Continuation to influence + -> (ParseError s e -> State s e -> m b) -- ^ Continuation to influence -> ParseError s e -- ^ First argument of resulting continuation - -> State s -- ^ Second argument of resulting continuation + -> State s e -- ^ Second argument of resulting continuation -> m b withHints (Hints ps') c e = case e of @@ -585,8 +567,8 @@ accHints :: Hints t -- ^ 'Hints' to add - -> (a -> State s -> Hints t -> m b) -- ^ An “OK” continuation to alter - -> (a -> State s -> Hints t -> m b) -- ^ Altered “OK” continuation + -> (a -> State s e -> Hints t -> m b) -- ^ An “OK” continuation to alter + -> (a -> State s e -> Hints t -> m b) -- ^ Altered “OK” continuation accHints hs1 c x s hs2 = c x s (hs1 <> hs2) {-# INLINE accHints #-} @@ -604,7 +586,7 @@ runParsecT :: Monad m => ParsecT e s m a -- ^ Parser to run - -> State s -- ^ Initial state + -> State s e -- ^ Initial state -> m (Reply e s a) runParsecT p s = unParser p s cok cerr eok eerr where @@ -616,13 +598,32 @@ -- | Transform any custom errors thrown by the parser using the given -- function. Similar in function and purpose to @withExceptT@. -- +-- __Note__ that the inner parser will start with empty collection of +-- “delayed” 'ParseError's. Any delayed 'ParseError's produced in the inner +-- parser will be lifted by applying the provided function and added to the +-- collection of delayed parse errors of the outer parser. +-- -- @since 7.0.0 -withParsecT :: (Monad m, Ord e') +withParsecT :: forall e e' s m a. (Monad m, Ord e') => (e -> e') - -> ParsecT e s m a - -> ParsecT e' s m a + -> ParsecT e s m a -- ^ Inner parser + -> ParsecT e' s m a -- ^ Outer parser withParsecT f p = ParsecT $ \s cok cerr eok eerr -> - unParser p s cok (cerr . mapParseError f) eok (eerr . mapParseError f) + let s' = s + { stateParseErrors = [] + } + adjustState :: State s e -> State s e' + adjustState st = st + { stateParseErrors = + (mapParseError f <$> stateParseErrors st) + ++ stateParseErrors s + } + cok' x st hs = cok x (adjustState st) hs + cerr' e st = cerr (mapParseError f e) (adjustState st) + eok' x st hs = eok x (adjustState st) hs + eerr' e st = eerr (mapParseError f e) (adjustState st) + in unParser p s' cok' cerr' eok' eerr' + where {-# INLINE withParsecT #-} diff --git a/Text/Megaparsec/Lexer.hs b/Text/Megaparsec/Lexer.hs --- a/Text/Megaparsec/Lexer.hs +++ b/Text/Megaparsec/Lexer.hs @@ -1,6 +1,6 @@ -- | -- Module : Text.Megaparsec.Common --- Copyright : © 2018–2019 Megaparsec contributors +-- Copyright : © 2018–present Megaparsec contributors -- License : FreeBSD -- -- Maintainer : Mark Karpov diff --git a/Text/Megaparsec/Pos.hs b/Text/Megaparsec/Pos.hs --- a/Text/Megaparsec/Pos.hs +++ b/Text/Megaparsec/Pos.hs @@ -1,6 +1,6 @@ -- | -- Module : Text.Megaparsec.Pos --- Copyright : © 2015–2019 Megaparsec contributors +-- Copyright : © 2015–present Megaparsec contributors -- License : FreeBSD -- -- Maintainer : Mark Karpov @@ -13,7 +13,6 @@ -- You probably do not want to import this module directly because -- "Text.Megaparsec" re-exports it anyway. -{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} @@ -37,10 +36,6 @@ import Data.Data (Data) import Data.Typeable (Typeable) import GHC.Generics - -#if !MIN_VERSION_base(4,11,0) -import Data.Semigroup -#endif ---------------------------------------------------------------------------- -- Abstract position diff --git a/Text/Megaparsec/State.hs b/Text/Megaparsec/State.hs --- a/Text/Megaparsec/State.hs +++ b/Text/Megaparsec/State.hs @@ -1,6 +1,6 @@ -- | -- Module : Text.Megaparsec.State --- Copyright : © 2015–2019 Megaparsec contributors +-- Copyright : © 2015–present Megaparsec contributors -- © 2007 Paolo Martini -- © 1999–2001 Daan Leijen -- License : FreeBSD @@ -13,8 +13,11 @@ -- -- @since 6.5.0 -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE UndecidableInstances #-} module Text.Megaparsec.State ( State (..) @@ -26,10 +29,12 @@ import Data.Typeable (Typeable) import GHC.Generics import Text.Megaparsec.Pos +import {-# SOURCE #-} Text.Megaparsec.Error (ParseError) --- | This is the Megaparsec's state parametrized over stream type @s@. +-- | This is the Megaparsec's state parametrized over stream type @s@ and +-- custom error component type @e@. -data State s = State +data State s e = State { stateInput :: s -- ^ The rest of input to process , stateOffset :: {-# UNPACK #-} !Int @@ -40,9 +45,27 @@ -- ^ State that is used for line\/column calculation -- -- @since 7.0.0 - } deriving (Show, Eq, Data, Typeable, Generic) + , stateParseErrors :: [ParseError s e] + -- ^ Collection of “delayed” 'ParseError's in reverse order. This means + -- that the last registered error is the first element of the list. + -- + -- @since 8.0.0 + } deriving (Typeable, Generic) -instance NFData s => NFData (State s) +deriving instance ( Show (ParseError s e) + , Show s + ) => Show (State s e) + +deriving instance ( Eq (ParseError s e) + , Eq s + ) => Eq (State s e) + +deriving instance ( Data e + , Data (ParseError s e) + , Data s + ) => Data (State s e) + +instance (NFData s, NFData (ParseError s e)) => NFData (State s e) -- | Special kind of state that is used to calculate line\/column positions -- on demand. diff --git a/Text/Megaparsec/Stream.hs b/Text/Megaparsec/Stream.hs --- a/Text/Megaparsec/Stream.hs +++ b/Text/Megaparsec/Stream.hs @@ -1,6 +1,6 @@ -- | -- Module : Text.Megaparsec.Stream --- Copyright : © 2015–2019 Megaparsec contributors +-- Copyright : © 2015–present Megaparsec contributors -- License : FreeBSD -- -- Maintainer : Mark Karpov @@ -14,7 +14,6 @@ -- -- @since 6.0.0 -{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE LambdaCase #-} @@ -30,6 +29,7 @@ import Data.Char (chr) import Data.Foldable (foldl') +import Data.Kind (Type) import Data.List.NonEmpty (NonEmpty (..)) import Data.Maybe (fromMaybe) import Data.Proxy @@ -44,21 +44,17 @@ import qualified Data.Text as T import qualified Data.Text.Lazy as TL -#if !MIN_VERSION_base(4,11,0) -import Data.Semigroup -#endif - -- | Type class for inputs that can be consumed by the library. class (Ord (Token s), Ord (Tokens s)) => Stream s where -- | Type of token in the stream. - type Token s :: * + type Token s :: Type -- | Type of “chunk” of the stream. - type Tokens s :: * + type Tokens s :: Type -- | Lift a single token to chunk of the stream. The default -- implementation is: @@ -136,12 +132,20 @@ showTokens :: Proxy s -> NonEmpty (Token s) -> String + -- | Return the number of characters that a non-empty stream of tokens + -- spans. The default implementation is sufficient if every token spans + -- exactly 1 character. + -- + -- @since 8.0.0 + + tokensLength :: Proxy s -> NonEmpty (Token s) -> Int + tokensLength Proxy = NE.length + -- | Given an offset @o@ and initial 'PosState', adjust the state in such -- a way that it starts at the offset. -- - -- Return three values (in order): + -- Return two values (in order): -- - -- * 'SourcePos' which the given offset @o@ points to. -- * 'String' representing the line on which the given offset @o@ is -- located. The line should satisfy a number of conditions that are -- described below. @@ -161,12 +165,15 @@ -- spaces, which is determined by the 'pstateTabWidth' field of -- 'PosState'. -- + -- __Note__: type signature of the function was changed in the version + -- /8.0.0/. + -- -- @since 7.0.0 reachOffset :: Int -- ^ Offset to reach -> PosState s -- ^ Initial 'PosState' to use - -> (SourcePos, String, PosState s) -- ^ (See below) + -> (String, PosState s) -- ^ See the description of the function -- | A version of 'reachOffset' that may be faster because it doesn't need -- to fetch the line at which the given offset in located. @@ -174,18 +181,19 @@ -- The default implementation is this: -- -- > reachOffsetNoLine o pst = - -- > let (spos, _, pst')= reachOffset o pst - -- > in (spos, pst') + -- > snd (reachOffset o pst) -- + -- __Note__: type signature of the function was changed in the version + -- /8.0.0/. + -- -- @since 7.0.0 reachOffsetNoLine :: Int -- ^ Offset to reach -> PosState s -- ^ Initial 'PosState' to use - -> (SourcePos, PosState s) -- ^ Reached source position and updated state + -> PosState s -- ^ Reached source position and updated state reachOffsetNoLine o pst = - let (spos, _, pst') = reachOffset o pst - in (spos, pst') + snd (reachOffset o pst) instance Stream String where type Token String = Char @@ -320,9 +328,8 @@ -- ^ Offset to reach -> PosState s -- ^ Initial 'PosState' to use - -> (SourcePos, String, PosState s) - -- ^ Reached 'SourcePos', line at which 'SourcePos' is located, updated - -- 'PosState' + -> (String, PosState s) + -- ^ Line at which 'SourcePos' is located, updated 'PosState' reachOffset' splitAt' foldl'' fromToks @@ -330,8 +337,7 @@ (newlineTok, tabTok) o PosState {..} = - ( spos - , case expandTab pstateTabWidth + ( case expandTab pstateTabWidth . addPrefix . f . fromToks @@ -391,15 +397,14 @@ -- ^ Offset to reach -> PosState s -- ^ Initial 'PosState' to use - -> (SourcePos, PosState s) - -- ^ Reached 'SourcePos' and updated 'PosState' + -> PosState s + -- ^ Updated 'PosState' reachOffsetNoLine' splitAt' foldl'' (newlineTok, tabTok) o PosState {..} = - ( spos - , PosState + ( PosState { pstateInput = post , pstateOffset = max pstateOffset o , pstateSourcePos = spos diff --git a/bench/memory/Main.hs b/bench/memory/Main.hs --- a/bench/memory/Main.hs +++ b/bench/memory/Main.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeFamilies #-} @@ -6,7 +7,6 @@ import Control.DeepSeq import Control.Monad import Data.List.NonEmpty (NonEmpty (..)) -import Data.Semigroup ((<>)) import Data.Text (Text) import Data.Void import Text.Megaparsec @@ -17,6 +17,10 @@ import qualified Data.Text as T import qualified Text.Megaparsec.Char.Lexer as L +#if !MIN_VERSION_base(4,13,0) +import Data.Semigroup ((<>)) +#endif + -- | The type of parser that consumes 'String's. type Parser = Parsec Void Text @@ -120,16 +124,15 @@ f (o0 * 80, o1 * 80) where - f :: (Int, Int) -> (SourcePos, PosState Text) + f :: (Int, Int) -> PosState Text f (startOffset, targetOffset) = - let (x, _, y) = reachOffset targetOffset PosState - { pstateInput = manyAs (targetOffset - startOffset) - , pstateOffset = startOffset - , pstateSourcePos = initialPos "" - , pstateTabWidth = defaultTabWidth - , pstateLinePrefix = "" - } - in (x, y) + snd $ reachOffset targetOffset PosState + { pstateInput = manyAs (targetOffset - startOffset) + , pstateOffset = startOffset + , pstateSourcePos = initialPos "" + , pstateTabWidth = defaultTabWidth + , pstateLinePrefix = "" + } -- | Bench the 'reachOffsetNoLine' function. @@ -142,7 +145,7 @@ f (o0 * 80, o1 * 80) where - f :: (Int, Int) -> (SourcePos, PosState Text) + f :: (Int, Int) -> PosState Text f (startOffset, targetOffset) = reachOffsetNoLine targetOffset PosState { pstateInput = manyAs (targetOffset - startOffset) diff --git a/bench/speed/Main.hs b/bench/speed/Main.hs --- a/bench/speed/Main.hs +++ b/bench/speed/Main.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeFamilies #-} @@ -6,7 +7,6 @@ import Control.DeepSeq import Criterion.Main import Data.List.NonEmpty (NonEmpty (..)) -import Data.Semigroup ((<>)) import Data.Text (Text) import Data.Void import Text.Megaparsec @@ -16,6 +16,10 @@ import qualified Data.Text as T import qualified Text.Megaparsec.Char.Lexer as L +#if !MIN_VERSION_base(4,13,0) +import Data.Semigroup ((<>)) +#endif + -- | The type of parser that consumes 'String's. type Parser = Parsec Void Text @@ -117,16 +121,15 @@ ("reachOffset-" ++ show o0 ++ "-" ++ show o1) (nf f (o0 * 80, o1 * 80)) where - f :: (Int, Int) -> (SourcePos, PosState Text) + f :: (Int, Int) -> PosState Text f (startOffset, targetOffset) = - let (x, _, y) = reachOffset targetOffset PosState - { pstateInput = manyAs (targetOffset - startOffset) - , pstateOffset = startOffset - , pstateSourcePos = initialPos "" - , pstateTabWidth = defaultTabWidth - , pstateLinePrefix = "" - } - in (x, y) + snd $ reachOffset targetOffset PosState + { pstateInput = manyAs (targetOffset - startOffset) + , pstateOffset = startOffset + , pstateSourcePos = initialPos "" + , pstateTabWidth = defaultTabWidth + , pstateLinePrefix = "" + } -- | Bench the 'reachOffsetNoLine' function. @@ -138,7 +141,7 @@ ("reachOffsetNoLine-" ++ show o0 ++ "-" ++ show o1) (nf f (o0 * 80, o1 * 80)) where - f :: (Int, Int) -> (SourcePos, PosState Text) + f :: (Int, Int) -> PosState Text f (startOffset, targetOffset) = reachOffsetNoLine targetOffset PosState { pstateInput = manyAs (targetOffset - startOffset) diff --git a/megaparsec.cabal b/megaparsec.cabal --- a/megaparsec.cabal +++ b/megaparsec.cabal @@ -1,7 +1,7 @@ name: megaparsec -version: 7.0.5 +version: 8.0.0 cabal-version: 1.18 -tested-with: GHC==8.0.2, GHC==8.2.2, GHC==8.4.4, GHC==8.6.5 +tested-with: GHC==8.4.4, GHC==8.6.5, GHC==8.8.1 license: BSD2 license-file: LICENSE.md author: Megaparsec contributors, @@ -17,11 +17,10 @@ description: This is an industrial-strength monadic parser combinator library. - Megaparsec is a feature-rich package that strikes a nice balance between - speed, flexibility, and quality of parse errors. + Megaparsec is a feature-rich package that tries to find a nice balance + between speed, flexibility, and quality of parse errors. -extra-doc-files: AUTHORS.md - , CHANGELOG.md +extra-doc-files: CHANGELOG.md , README.md source-repository head @@ -34,12 +33,12 @@ default: False library - build-depends: base >= 4.9 && < 5.0 + build-depends: base >= 4.11 && < 5.0 , bytestring >= 0.2 && < 0.11 , case-insensitive >= 1.2 && < 1.3 , containers >= 0.5 && < 0.7 , deepseq >= 1.3 && < 1.5 - , mtl >= 2.0 && < 3.0 + , mtl >= 2.2.2 && < 3.0 , parser-combinators >= 1.0 && < 2.0 , scientific >= 0.3.1 && < 0.4 , text >= 0.2 && < 1.3 @@ -68,14 +67,13 @@ -Wincomplete-record-updates -Wincomplete-uni-patterns -Wnoncanonical-monad-instances - -Wnoncanonical-monadfail-instances default-language: Haskell2010 benchmark bench-speed main-is: Main.hs hs-source-dirs: bench/speed type: exitcode-stdio-1.0 - build-depends: base >= 4.9 && < 5.0 + build-depends: base >= 4.11 && < 5.0 , containers >= 0.5 && < 0.7 , criterion >= 0.6.2.1 && < 1.6 , deepseq >= 1.3 && < 1.5 @@ -91,7 +89,7 @@ main-is: Main.hs hs-source-dirs: bench/memory type: exitcode-stdio-1.0 - build-depends: base >= 4.9 && < 5.0 + build-depends: base >= 4.11 && < 5.0 , containers >= 0.5 && < 0.7 , deepseq >= 1.3 && < 1.5 , megaparsec