diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,13 @@ +## Megaparsec 7.0.2 + +* Fixed the property test for `char'` which was failing in the case when + there is a character with different upper and title cases. + +* More descriptive error messages when `elabel` or `ulabel` from + `Text.Megaparsec.Error.Builder` are used with empty strings. + +* Typos fixes in the docs. + ## Megaparsec 7.0.1 * Fixed a bug in `errorBundlePretty`. Previously the question sign `?` was diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -181,9 +181,10 @@ ### Megaparsec vs Attoparsec -[Attoparsec](https://github.com/bos/attoparsec) is another prominent Haskell -library for parsing. Although the both libraries deal with parsing, it's -usually easy to decide which you will need in particular project: +[Attoparsec](https://hackage.haskell.org/package/attoparsec) is another +prominent Haskell library for parsing. Although the both libraries deal with +parsing, it's usually easy to decide which you will need in particular +project: * *Attoparsec* is sometimes faster but not that feature-rich. It should be used when you want to process large amounts of data where performance @@ -204,8 +205,9 @@ ### Megaparsec vs Parsec -Since Megaparsec is a fork of Parsec, we are bound to list the main -differences between the two libraries: +Since Megaparsec is a fork of +[Parsec](https://hackage.haskell.org/package/parsec), we are bound to list +the main differences between the two libraries: * Better error messages. We test our error messages using numerous QuickCheck (generative) tests. Good error messages are just as important @@ -252,8 +254,9 @@ `takeWhileP`, `takeWhile1P`, `takeP` like Attoparsec. If you want to see a detailed change log, `CHANGELOG.md` may be helpful. -Also see [this original announcement](https://notehub.org/w7037) for another -comparison. +Also see [this original +announcement](https://mail.haskell.org/pipermail/haskell-cafe/2015-September/121530.html) +for another comparison. ### Megaparsec vs Trifecta @@ -346,7 +349,7 @@ * [Latest additions to Megaparsec](https://markkarpov.com/post/latest-additions-to-megaparsec.html) * [Announcing Megaparsec 5](https://markkarpov.com/post/announcing-megaparsec-5.html) * [Megaparsec 4 and 5](https://markkarpov.com/post/megaparsec-4-and-5.html) -* [The original Megaparsec 4.0.0 announcement](https://notehub.org/w7037) +* [The original Megaparsec 4.0.0 announcement](https://mail.haskell.org/pipermail/haskell-cafe/2015-September/121530.html) ## Authors diff --git a/Text/Megaparsec/Char.hs b/Text/Megaparsec/Char.hs --- a/Text/Megaparsec/Char.hs +++ b/Text/Megaparsec/Char.hs @@ -11,7 +11,6 @@ -- -- Commonly used character parsers. -{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE ScopedTypeVariables #-} 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 @@ -28,7 +28,6 @@ -- -- To do lexing of byte streams, see "Text.Megaparsec.Byte.Lexer". -{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE MultiWayIf #-} {-# LANGUAGE ScopedTypeVariables #-} diff --git a/Text/Megaparsec/Class.hs b/Text/Megaparsec/Class.hs --- a/Text/Megaparsec/Class.hs +++ b/Text/Megaparsec/Class.hs @@ -14,7 +14,6 @@ -- -- @since 6.5.0 -{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE MultiParamTypeClasses #-} @@ -39,10 +38,6 @@ 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 - -#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. diff --git a/Text/Megaparsec/Error.hs b/Text/Megaparsec/Error.hs --- a/Text/Megaparsec/Error.hs +++ b/Text/Megaparsec/Error.hs @@ -105,8 +105,8 @@ rnf (ErrorIndentation ord ref act) = ord `seq` rnf ref `seq` rnf act rnf (ErrorCustom a) = rnf a --- | @'ParseError' t e@ represents a parse error parametrized over the token --- type @t@ and the custom data @e@. +-- | @'ParseError' s e@ represents a parse error parametrized over the +-- stream type @s@ and the custom data @e@. -- -- 'Semigroup' and 'Monoid' instances of the data type allow to merge parse -- errors from different branches of parsing. When merging two @@ -119,8 +119,8 @@ data ParseError s e = TrivialError Int (Maybe (ErrorItem (Token s))) (Set (ErrorItem (Token s))) -- ^ Trivial errors, generated by Megaparsec's machinery. The data - -- constructor includes the source position of error, unexpected token - -- (if any), and expected tokens. + -- 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/. | FancyError Int (Set (ErrorFancy e)) @@ -382,7 +382,7 @@ "offset=" <> show (errorOffset e) <> ":\n" <> parseErrorTextPretty e -- | Pretty-print a textual part of a 'ParseError', that is, everything --- except stack of source positions. The rendered 'String' always ends with a +-- except for its position. The rendered 'String' always ends with a -- newline. -- -- @since 5.1.0 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 @@ -134,7 +134,9 @@ -- strings (for empty strings it's bottom). ulabel :: Stream s => String -> ET s -ulabel = unexp . Label . NE.fromList +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. @@ -156,7 +158,9 @@ -- strings. elabel :: Stream s => String -> ET s -elabel = expe . Label . NE.fromList +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. diff --git a/megaparsec.cabal b/megaparsec.cabal --- a/megaparsec.cabal +++ b/megaparsec.cabal @@ -1,7 +1,7 @@ name: megaparsec -version: 7.0.1 +version: 7.0.2 cabal-version: 1.18 -tested-with: GHC==7.10.3, GHC==8.0.2, GHC==8.2.2, GHC==8.4.3 +tested-with: GHC==7.10.3, GHC==8.0.2, GHC==8.2.2, GHC==8.4.4, GHC==8.6.1 license: BSD2 license-file: LICENSE.md author: Megaparsec contributors, diff --git a/tests/Test/Hspec/Megaparsec/AdHoc.hs b/tests/Test/Hspec/Megaparsec/AdHoc.hs --- a/tests/Test/Hspec/Megaparsec/AdHoc.hs +++ b/tests/Test/Hspec/Megaparsec/AdHoc.hs @@ -3,6 +3,7 @@ {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Test.Hspec.Megaparsec.AdHoc diff --git a/tests/Text/Megaparsec/CharSpec.hs b/tests/Text/Megaparsec/CharSpec.hs --- a/tests/Text/Megaparsec/CharSpec.hs +++ b/tests/Text/Megaparsec/CharSpec.hs @@ -5,7 +5,7 @@ import Control.Monad import Data.Char -import Data.List (partition, isPrefixOf) +import Data.List (nub, partition, isPrefixOf) import Data.Monoid ((<>)) import Test.Hspec import Test.Hspec.Megaparsec @@ -201,6 +201,9 @@ prs (char ch) "" `shouldFailWith` err 0 (ueof <> etok ch) describe "char'" $ do + -- a character with different lower, upper and title cases ('dz', + -- 'Dz' and 'DZ' respectively) + let distinctTitleCase = 'dz' context "when stream begins with the character specified as argument" $ do it "parses the character" $ property $ \ch s -> do @@ -220,6 +223,12 @@ s' = '\9412' : s prs (char' ch) s' `shouldParse` '\9412' prs' (char' ch) s' `succeedsLeaving` s + context "when character has different lower, upper and title cases" $ + it "parses the character in lower, upper or title case" $ do + let p = prs (char' distinctTitleCase) + p [distinctTitleCase] `shouldParse` distinctTitleCase + p [toUpper distinctTitleCase] `shouldParse` toUpper distinctTitleCase + p [toTitle distinctTitleCase] `shouldParse` toTitle distinctTitleCase context "when stream does not begin with the character specified as argument" $ do it "signals correct parse error" $ property $ \ch ch' s -> not (casei ch ch') ==> do @@ -233,11 +242,19 @@ let ms = utok ch <> etok '\9438' <> etok '\9412' s' = ch : s prs (char' '\9438') s' `shouldFailWith` err 0 ms - context "when stream is empty" $ + context "when stream is empty" $ do it "signals correct parse error" $ property $ \ch -> do - let ms = ueof <> etok (toLower ch) <> etok (toUpper ch) + let options = etok <$> [toLower ch, toTitle ch, toUpper ch] + ms = ueof <> mconcat (nub options) prs (char' ch) "" `shouldFailWith` err 0 ms + context "when character has different lower, upper and title cases" $ + it "signals correct parse error" $ do + let ms = mconcat [ ueof + , etok distinctTitleCase + , etok $ toUpper distinctTitleCase + , etok $ toTitle distinctTitleCase ] + prs (char' distinctTitleCase) "" `shouldFailWith` err 0 ms describe "string" $ do context "when stream is prefixed with given string" $