megaparsec 6.2.0 → 6.3.0

raw patch · 7 files changed

+121/−20 lines, 7 filesdep ~criterionPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: criterion

API changes (from Hackage documentation)

Files

• CHANGELOG.md +11/−0
• Text/Megaparsec.hs +42/−4
• Text/Megaparsec/Char/Lexer.hs +10/−10
• megaparsec.cabal +2/−2
• tests/Test/Hspec/Megaparsec/AdHoc.hs +1/−1
• tests/Text/Megaparsec/Char/LexerSpec.hs +8/−2
• tests/Text/MegaparsecSpec.hs +47/−1

@@ -1,3 +1,14 @@+## Megaparsec 6.3.0++* Added an `IsString` instance for `ParsecT`. Now it is possible to+  write `"abc"` rather than `string "abc"`.++* Added the `customFailure` combinator, which is a special case of+  `fancyFailure`.++* Made implementation of `sconcat` and `mconcat` of `ParsecT` more+  efficient.+ ## Megaparsec 6.2.0  * `float` in `Text.Megaparsec.Char.Lexer` and `Text.Megaparsec.Byte.Lexer`

@@ -96,6 +96,7 @@     -- * Derivatives of primitive combinators   , (<?>)   , unexpected+  , customFailure   , match   , region   , takeRest@@ -133,6 +134,7 @@ import Data.Proxy import Data.Semigroup hiding (option) import Data.Set (Set)+import Data.String (IsString (..)) import Data.Typeable (Typeable) import Debug.Trace import GHC.Generics@@ -210,9 +212,10 @@   = OK a                   -- ^ Parser succeeded   | Error (ParseError t e) -- ^ Parser failed --- | 'Hints' represent collection of strings to be included into--- 'ParserError' 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 into+-- 'ParserError' (when it's a 'TrivialError') as “expected” message items+-- when a parser fails without consuming input right after successful parser+-- that produced the hints. -- -- For example, without hints you could get: --@@ -228,7 +231,8 @@ -- unexpected 'a' -- expecting 'r' or end of input -newtype Hints t = Hints [Set (ErrorItem t)] deriving (Semigroup, Monoid)+newtype Hints t = Hints [Set (ErrorItem t)]+  deriving (Semigroup, Monoid)  -- | Convert 'ParseError' record into 'Hints'. @@ -302,16 +306,34 @@       -> (ParseError (Token s) e -> State s -> m b) -- empty-error       -> m b } +-- | @since 5.3.0+ instance (Stream s, Semigroup a) => Semigroup (ParsecT e s m a) where   (<>) = A.liftA2 (<>)   {-# INLINE (<>) #-}+#if MIN_VERSION_base(4,8,0)+  sconcat = fmap sconcat . sequence+#else+  sconcat = fmap (sconcat . NE.fromList) . sequence . NE.toList+#endif+  {-# INLINE sconcat #-} +-- | @since 5.3.0+ instance (Stream s, Monoid a) => Monoid (ParsecT e s m a) where   mempty = pure mempty   {-# INLINE mempty #-}   mappend = A.liftA2 mappend   {-# INLINE mappend #-}+  mconcat = fmap mconcat . sequence+  {-# INLINE mconcat #-} +-- | @since 6.3.0++instance (a ~ Tokens s, IsString a, Eq a, Stream s, Ord e)+    => IsString (ParsecT e s m a) where+  fromString s = tokens (==) (fromString s)+ instance Functor (ParsecT e s m) where   fmap = pMap @@ -438,6 +460,8 @@   in unParser m s cok cerr eok meerr {-# INLINE pPlus #-} +-- | @since 6.0.0+ instance (Stream s, MonadFix m) => MonadFix (ParsecT e s m) where   mfix f = mkPT $ \s -> mfix $ \(~(Reply _ _ result)) -> do     let@@ -636,6 +660,7 @@     -> m a    -- | The most general way to stop parsing and report a fancy 'ParseError'.+  -- To report a single custom parse error, see 'customFailure'.   --   -- @since 6.0.0 @@ -1205,6 +1230,8 @@   getParserState              = lift getParserState   updateParserState f         = lift (updateParserState f) +-- | @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)@@ -1229,6 +1256,8 @@   getParserState              = lift getParserState   updateParserState f         = lift (updateParserState f) +-- | @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)@@ -1301,6 +1330,15 @@ unexpected :: MonadParsec e s m => ErrorItem (Token s) -> m a unexpected item = failure (pure item) E.empty {-# INLINE unexpected #-}++-- | Report a custom parse error. For a more general version, see+-- 'fancyFailure'.+--+-- @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

@@ -14,6 +14,14 @@ -- more elegant than others. Especially important theme is parsing of white -- space, comments, and indentation. --+-- Parsing of white space is an important part of any parser. We propose a+-- convention where __every lexeme parser assumes no spaces before the__+-- __lexeme and consumes all spaces after the lexeme__; this is what the+-- 'lexeme' combinator does, and so it's enough to wrap every lexeme parser+-- with 'lexeme' to achieve this. Note that you'll need to call 'space'+-- manually to consume any white space before the first lexeme (i.e. at the+-- beginning of the file).+-- -- This module is intended to be imported qualified: -- -- > import qualified Text.Megaparsec.Char.Lexer as L@@ -95,14 +103,6 @@ -- 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.------ Parsing of white space is an important part of any parser. We propose a--- convention where every lexeme parser assumes no spaces before the lexeme--- and consumes all spaces after the lexeme; this is what the 'lexeme'--- combinator does, and so it's enough to wrap every lexeme parser with--- 'lexeme' to achieve this. Note that you'll need to call 'space' manually--- to consume any white space before the first lexeme (i.e. at the beginning--- of the file).  space :: MonadParsec e s m   => m () -- ^ A parser for space characters which does not accept empty@@ -282,8 +282,8 @@   | IndentMany (Maybe Pos) ([b] -> m a) (m b)     -- ^ Parse many indented tokens (possibly zero), use given indentation     -- level (if 'Nothing', use level of the first indented token); the-    -- second argument tells how to get final result, and third argument-    -- describes how to parse an indented token+    -- second argument tells how to get the final result, and the third+    -- argument describes how to parse an indented token   | IndentSome (Maybe Pos) ([b] -> m a) (m b)     -- ^ Just like 'IndentMany', but requires at least one indented token to     -- be present

@@ -1,7 +1,7 @@ name:                 megaparsec-version:              6.2.0+version:              6.3.0 cabal-version:        >= 1.18-tested-with:          GHC==7.8.4, GHC==7.10.3, GHC==8.0.2, GHC==8.2.1+tested-with:          GHC==7.8.4, GHC==7.10.3, GHC==8.0.2, GHC==8.2.2 license:              BSD2 license-file:         LICENSE.md author:               Megaparsec contributors,

@@ -59,7 +59,7 @@   -> Either (ParseError Char Void) a -- ^ Result of parsing prs p = parse p "" --- | Just like 'prs', but allows to inspect final state of the parser.+-- | Just like 'prs', but allows to inspect the final state of the parser.  prs'   :: Parser a          -- ^ Parser to run

@@ -7,7 +7,7 @@ module Text.Megaparsec.Char.LexerSpec (spec) where  import Control.Applicative-import Control.Monad (void)+import Control.Monad import Data.Char hiding (ord) import Data.List (isInfixOf) import Data.Maybe@@ -45,8 +45,14 @@     context "when stream begins with the symbol" $       it "parses the symbol and trailing whitespace" $         property $ forAll mkSymbol $ \s -> do-          let p = symbol' scn (toUpper <$> y)+          let p = symbol' scn y'+              y' = toUpper <$> y               y = takeWhile (not . isSpace) s+          -- NOTE In some rare cases it's possible that y' will have a+          -- different length than y due to the craziness of Unicode. We+          -- cannot deal with those cases due to how the tokens primitive is+          -- implemented. This is a “feature”, not a bug.+          when (length y' /= length y) discard           prs  p s `shouldParse` y           prs' p s `succeedsLeaving` "" 

@@ -2,6 +2,7 @@ {-# LANGUAGE FlexibleContexts  #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiWayIf        #-}+{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE Rank2Types        #-} {-# LANGUAGE RecordWildCards   #-} {-# LANGUAGE RecursiveDo       #-}@@ -23,6 +24,7 @@ import Data.Maybe (fromMaybe, listToMaybe, isJust) import Data.Monoid import Data.Proxy+import Data.String import Data.Void import Prelude hiding (span, concat) import Test.Hspec@@ -41,6 +43,8 @@ import qualified Data.List.NonEmpty          as NE import qualified Data.Semigroup              as G import qualified Data.Set                    as E+import qualified Data.Text                   as T+import qualified Data.ByteString             as BS  #if !MIN_VERSION_QuickCheck(2,8,2) instance (Arbitrary a, Ord a) => Arbitrary (E.Set a) where@@ -212,6 +216,30 @@         let p = pure [a] `mappend` pure [b]         prs p "" `shouldParse` ([a,b] :: [Int]) +  describe "ParsecT IsString instance" $ do+    describe "equivalence to 'string'" $ do+      it "for String" $ property $ \s i ->+        eqParser+          (string s)+          (fromString s)+          (i :: String)+      it "for Text" $ property $ \s i ->+        eqParser+          (string (T.pack s))+          (fromString s)+          (i :: T.Text)+      it "for ByteString" $ property $ \s i ->+        eqParser+          (string (fromString s :: BS.ByteString))+          (fromString s)+          (i :: BS.ByteString)+    it "can handle Unicode" $ do+        let+          r = "פּאַרסער 解析器" :: BS.ByteString+          p :: Parsec Void BS.ByteString BS.ByteString+          p = BS.concat <$> sequence ["פּאַ", "רסער", " 解析器"]+        parse p "" r `shouldParse` r+   describe "ParsecT Functor instance" $ do     it "obeys identity law" $       property $ \n ->@@ -370,7 +398,7 @@                   x <- S.get                   if x < n then S.modify (+ 1) else empty                 v :: S.State Integer (Either (ParseError Char Void) ())-                v = runParserT p "" ""+                v = runParserT p "" ("" :: String)             S.execState v 0 `shouldBe` n      describe "some" $ do@@ -1191,6 +1219,15 @@               p = void (unexpected item)           grs p "" (`shouldFailWith` TrivialError posI (pure item) E.empty) +    describe "customFailure" $+      it "signals correct parse error" $+        property $ \n st -> do+          let p :: MonadParsec Int String m => m ()+              p = void (customFailure n)+              xs = E.singleton (ErrorCustom n)+          runParser  p "" (stateInput st) `shouldFailWith` FancyError posI xs+          runParser' p st `failsLeaving` stateInput st+     describe "match" $       it "return consumed tokens along with the result" $         property $ \str -> do@@ -1750,6 +1787,9 @@ instance ShowToken Span where   showTokens ts = concat (NE.toList . spanBody <$> ts) +instance ShowErrorComponent Int where+  showErrorComponent = show+ type CustomParser = Parsec Void [Span]  pSpan :: Span -> CustomParser Span@@ -1780,3 +1820,9 @@          , Left $ err (pos:|z) (etoks s <> utoks (take l i)) )   where     l = length s++eqParser :: (Eq a, Eq (Token i))+  => Parsec Void i a+  -> Parsec Void i a+  -> i -> Bool+eqParser p1 p2 i = runParser p1 "" i == runParser p2 "" i