megaparsec-tests 9.2.2 → 9.3.0

raw patch · 4 files changed

+196/−27 lines, 4 filesdep +temporarydep ~megaparsecPVP ok

version bump matches the API change (PVP)

Dependencies added: temporary

Dependency ranges changed: megaparsec

API changes (from Hackage documentation)

Files

• megaparsec-tests.cabal +4/−3
• src/Test/Hspec/Megaparsec/AdHoc.hs +3/−2
• tests/Text/Megaparsec/DebugSpec.hs +166/−20
• tests/Text/MegaparsecSpec.hs +23/−2

@@ -1,6 +1,6 @@ cabal-version:   2.4 name:            megaparsec-tests-version:         9.2.2+version:         9.3.0 license:         BSD-2-Clause license-file:    LICENSE.md maintainer:      Mark Karpov <markkarpov92@gmail.com>@@ -31,7 +31,7 @@         hspec >=2.0 && <3.0,         hspec-expectations >=0.8 && <0.9,         hspec-megaparsec >=2.0 && <3.0,-        megaparsec ==9.2.2,+        megaparsec ==9.3.0,         mtl >=2.2.2 && <3.0,         text >=0.2 && <2.1,         transformers >=0.4 && <0.7@@ -71,11 +71,12 @@         hspec >=2.0 && <3.0,         hspec-expectations >=0.8 && <0.9,         hspec-megaparsec >=2.0 && <3.0,-        megaparsec ==9.2.2,+        megaparsec ==9.3.0,         megaparsec-tests,         mtl >=2.2.2 && <3.0,         parser-combinators >=1.0 && <2.0,         scientific >=0.3.1 && <0.4,+        temporary >=1.1 && <1.4,         text >=0.2 && <2.1,         transformers >=0.4 && <0.7 

@@ -71,6 +71,7 @@ import Test.Hspec.Megaparsec import Test.QuickCheck import Text.Megaparsec+import Text.Megaparsec.Debug (MonadParsecDbg)  ---------------------------------------------------------------------------- -- Types@@ -120,7 +121,7 @@ -- all supported monads transformers in turn). grs ::   -- | Parser to run-  (forall m. MonadParsec Void String m => m a) ->+  (forall m. MonadParsecDbg Void String m => m a) ->   -- | Input for the parser   String ->   -- | How to check result of parsing@@ -140,7 +141,7 @@ -- | 'grs'' to 'grs' is as 'prs'' to 'prs'. grs' ::   -- | Parser to run-  (forall m. MonadParsec Void String m => m a) ->+  (forall m. MonadParsecDbg Void String m => m a) ->   -- | Input for the parser   String ->   -- | How to check result of parsing

@@ -1,8 +1,23 @@+{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE OverloadedStrings #-}  module Text.Megaparsec.DebugSpec (spec) where +import Control.Exception (evaluate) import Control.Monad+import Control.Monad.RWS (MonadRWS)+import qualified Control.Monad.RWS.Lazy as L+import qualified Control.Monad.RWS.Strict as S+import Control.Monad.State (MonadState (..), modify)+import qualified Control.Monad.State.Lazy as L+import qualified Control.Monad.State.Strict as S+import Control.Monad.Writer (MonadWriter (..))+import qualified Control.Monad.Writer.Lazy as L+import qualified Control.Monad.Writer.Strict as S+import Data.Void+import GHC.IO.Handle+import System.IO (stderr)+import System.IO.Temp import Test.Hspec import Test.Hspec.Megaparsec import Test.Hspec.Megaparsec.AdHoc@@ -13,39 +28,170 @@ spec :: Spec spec = do   describe "dbg" $ do-    -- NOTE We don't test properties here to avoid a flood of debugging-    -- output when the test runs.     context "when inner parser succeeds consuming input" $ do       it "has no effect on how parser works" $ do-        let p = dbg "char" (char 'a')+        let p :: MonadParsecDbg Void String m => m Char+            p = dbg "char" (char 'a')             s = "ab"-        prs p s `shouldParse` 'a'-        prs' p s `succeedsLeaving` "b"+        shouldStderr p s "char> IN: \"ab\"\nchar> MATCH (COK): 'a'\nchar> VALUE: 'a'\n\n"+        grs p s (`shouldParse` 'a')+        grs' p s (`succeedsLeaving` "b")       it "its hints are preserved" $ do-        let p = dbg "many chars" (many (char 'a')) <* empty+        let p :: MonadParsecDbg Void String m => m String+            p = dbg "many chars" (many (char 'a')) <* empty             s = "abcd"-        prs p s `shouldFailWith` err 1 (etok 'a')-        prs' p s `failsLeaving` "bcd"+        shouldStderr p s "many chars> IN: \"abcd\"\nmany chars> MATCH (COK): 'a'\nmany chars> VALUE: \"a\"\n\n"+        grs p s (`shouldFailWith` err 1 (etok 'a'))+        grs' p s (`failsLeaving` "bcd")     context "when inner parser fails consuming input" $       it "has no effect on how parser works" $ do-        let p = dbg "chars" (char 'a' *> char 'c')+        let p :: MonadParsecDbg Void String m => m Char+            p = dbg "chars" (char 'a' *> char 'c')             s = "abc"-        prs p s `shouldFailWith` err 1 (utok 'b' <> etok 'c')-        prs' p s `failsLeaving` "bc"+        shouldStderr p s "chars> IN: \"abc\"\nchars> MATCH (CERR): 'a'\nchars> ERROR:\nchars> offset=1:\nchars> unexpected 'b'\nchars> expecting 'c'\n\n"+        grs p s (`shouldFailWith` err 1 (utok 'b' <> etok 'c'))+        grs' p s (`failsLeaving` "bc")     context "when inner parser succeeds without consuming" $ do       it "has no effect on how parser works" $ do-        let p = dbg "return" (return 'a')+        let p :: MonadParsecDbg Void String m => m Char+            p = dbg "return" (return 'a')             s = "abc"-        prs p s `shouldParse` 'a'-        prs' p s `succeedsLeaving` s+        shouldStderr p s "return> IN: \"abc\"\nreturn> MATCH (EOK): <EMPTY>\nreturn> VALUE: 'a'\n\n"+        grs p s (`shouldParse` 'a')+        grs' p s (`succeedsLeaving` s)       it "its hints are preserved" $ do-        let p = dbg "many chars" (many (char 'a')) <* empty+        let p :: MonadParsecDbg Void String m => m String+            p = dbg "many chars" (many (char 'a')) <* empty             s = "bcd"-        prs p s `shouldFailWith` err 0 (etok 'a')-        prs' p s `failsLeaving` "bcd"+        shouldStderr p s "many chars> IN: \"bcd\"\nmany chars> MATCH (EOK): <EMPTY>\nmany chars> VALUE: \"\"\n\n"+        grs p s (`shouldFailWith` err 0 (etok 'a'))+        grs' p s (`failsLeaving` "bcd")     context "when inner parser fails without consuming" $       it "has no effect on how parser works" $ do-        let p = dbg "empty" (void empty)+        let p :: MonadParsecDbg Void String m => m ()+            p = dbg "empty" (void empty)             s = "abc"-        prs p s `shouldFailWith` err 0 mempty-        prs' p s `failsLeaving` s+        shouldStderr p s "empty> IN: \"abc\"\nempty> MATCH (EERR): <EMPTY>\nempty> ERROR:\nempty> offset=0:\nempty> unknown parse error\n\n"+        grs p s (`shouldFailWith` err 0 mempty)+        grs' p s (`failsLeaving` s)+    let p1, p2 :: (MonadParsecDbg Void String m, MonadWriter [Int] m) => m ()+        p1 = tell [0] >> dbg "a" (single 'a' >> tell [1])+        p2 = do+          void $ dbg "a" (single 'a')+          tell [0]+          void $ dbg "b" (single 'b')+          dbg "c" $ do+            void (single 'c')+            tell [1]+            void (single 'd')+            tell [2]+        s1 = "a"+        s2 = "abcd"+        stderr1 = "a> IN: 'a'\na> MATCH (COK): 'a'\na> VALUE: () (LOG: [1])\n\n"+        stderr2 = "a> IN: \"abcd\"\na> MATCH (COK): 'a'\na> VALUE: 'a' (LOG: [])\n\nb> IN: \"bcd\"\nb> MATCH (COK): 'b'\nb> VALUE: 'b' (LOG: [])\n\nc> IN: \"cd\"\nc> MATCH (COK): \"cd\"\nc> VALUE: () (LOG: [1,2])\n\n"+        r1 = ((), [0, 1])+        r2 = ((), [0, 1, 2])+    context "Lazy WriterT instance of MonadParsecDbg" $ do+      it "example 1" $ do+        shouldStderr (L.runWriterT p1) s1 stderr1+        prs (L.runWriterT p1) s1 `shouldParse` r1+      it "example 2" $ do+        shouldStderr (L.runWriterT p2) s2 stderr2+        prs (L.runWriterT p2) s2 `shouldParse` r2+    context "Strict WriterT instance of MonadParsecDbg" $ do+      it "example 1" $ do+        shouldStderr (S.runWriterT p1) s1 stderr1+        prs (S.runWriterT p1) s1 `shouldParse` r1+      it "example 2" $ do+        shouldStderr (S.runWriterT p2) s2 stderr2+        prs (S.runWriterT p2) s2 `shouldParse` r2+    let p3, p4 :: (MonadParsecDbg Void String m, MonadState Int m) => m ()+        p3 = modify succ >> dbg "a" (single 'a' >> modify succ)+        p4 = do+          void $ dbg "a" (single 'a')+          modify succ+          void $ dbg "b" (single 'b')+          dbg "c" $ do+            void (single 'c')+            modify succ+            void (single 'd')+            modify succ+        s3 = "a"+        s4 = "abcd"+        stderr3 = "a> IN: 'a'\na> MATCH (COK): 'a'\na> VALUE: () (STATE: 2)\n\n"+        stderr4 = "a> IN: \"abcd\"\na> MATCH (COK): 'a'\na> VALUE: 'a' (STATE: 0)\n\nb> IN: \"bcd\"\nb> MATCH (COK): 'b'\nb> VALUE: 'b' (STATE: 1)\n\nc> IN: \"cd\"\nc> MATCH (COK): \"cd\"\nc> VALUE: () (STATE: 3)\n\n"+        r3 = ((), 2)+        r4 = ((), 3)+    context "Lazy StateT instance of MonadParsecDbg" $ do+      it "example 3" $ do+        shouldStderr (L.runStateT p3 0) s3 stderr3+        prs (L.runStateT p3 0) s3 `shouldParse` r3+      it "example 4" $ do+        shouldStderr (L.runStateT p4 0) s4 stderr4+        prs (L.runStateT p4 0) s4 `shouldParse` r4+    context "Strict StateT instance of MonadParsecDbg" $ do+      it "example 3" $ do+        shouldStderr (S.runStateT p3 0) s3 stderr3+        prs (S.runStateT p3 0) s3 `shouldParse` r3+      it "example 4" $ do+        shouldStderr (S.runStateT p4 0) s4 stderr4+        prs (S.runStateT p4 0) s4 `shouldParse` r4+    let p5 :: (MonadParsecDbg Void String m, MonadRWS () [Int] Int m) => m ()+        p5 = do+          tell [0]+          modify succ+          dbg "a" (single 'a' >> tell [1] >> modify succ)+        s5 = "a"+        stderr5 = "a> IN: 'a'\na> MATCH (COK): 'a'\na> VALUE: () (STATE: 2) (LOG: [1])\n\n"+        stderr7 = "a> IN: 'a'\na> MATCH (COK): 'a'\na> VALUE: () (LOG: [1]) (STATE: 2)\n\n"+        r5 = ((), 2, [0, 1])+        p6 :: (MonadParsecDbg Void String m, MonadWriter [Int] m, MonadState Int m) => m ()+        p6 = do+          tell [0]+          modify succ+          dbg "a" (single 'a' >> tell [1] >> modify succ)+        r6 = (((), 2), [0, 1])+        r7 = (((), [0, 1]), 2)+    context "Lazy RWST instance of MonadParsecDbg" $ do+      it "example 5" $ do+        shouldStderr (L.runRWST p5 () 0) s5 stderr5+        prs (L.runRWST p5 () 0) s5 `shouldParse` r5+      it "example 6" $ do+        shouldStderr (L.runWriterT (L.runStateT p6 0)) s5 stderr5+        prs (L.runWriterT (L.runStateT p6 0)) s5 `shouldParse` r6+      it "example 7" $ do+        shouldStderr (L.runStateT (L.runWriterT p6) 0) s5 stderr7+        prs (L.runStateT (L.runWriterT p6) 0) s5 `shouldParse` r7+    context "Strict RWST instance of MonadParsecDbg" $ do+      it "example 5" $ do+        shouldStderr (S.runRWST p5 () 0) s5 stderr5+        prs (S.runRWST p5 () 0) s5 `shouldParse` r5+      it "example 6" $ do+        shouldStderr (S.runWriterT (S.runStateT p6 0)) s5 stderr5+        prs (S.runWriterT (S.runStateT p6 0)) s5 `shouldParse` r6+      it "example 7" $ do+        shouldStderr (S.runStateT (S.runWriterT p6) 0) s5 stderr7+        prs (S.runStateT (S.runWriterT p6) 0) s5 `shouldParse` r7++----------------------------------------------------------------------------+-- Helpers++-- | Check that running the given parser on the input prints the expected+-- string to the 'stderr'.+shouldStderr ::+  -- | The parser to test+  Parser a ->+  -- | Input for the parser+  String ->+  -- | The expected 'stderr' output+  String ->+  Expectation+shouldStderr p s expectedStderr = do+  hFlush stderr+  withSystemTempFile "megaparsec-dbg-tests" $ \tempPath tempHandle -> do+    hDuplicateTo tempHandle stderr+    void (evaluate (parse p "" s))+    hFlush stderr+    hClose tempHandle+    capturedStderr <- readFile tempPath+    capturedStderr `shouldBe` expectedStderr

@@ -470,14 +470,20 @@                 let p :: MonadParsec Void String m => m String                     p = label lbl (many (char a)) <* empty                 grs p "" (`shouldFailWith` err 0 (elabel lbl))-      context "when inner parser fails without consuming" $+      context "when inner parser fails without consuming" $ do         it "is mentioned in parse error via its label" $           property $ \lbl ->             not (null lbl) ==> do               let p :: MonadParsec Void String m => m ()                   p = label lbl empty               grs p "" (`shouldFailWith` err 0 (elabel lbl))-+        context "when inner parser is composite with 2-hint sources" $+          it "both hint groups are replaced by the label" $+            property $ \lbl a b ->+              not (null lbl) && a /= b ==> do+                let p :: MonadParsec Void String m => m (Maybe Char)+                    p = label lbl (optional (char a) *> optional (char b)) <* empty+                grs p "" (`shouldFailWith` err 0 (elabel lbl))     describe "hidden" $ do       context "when inner parser succeeds consuming input" $ do         context "inner parser does not produce any hints" $@@ -1058,6 +1064,21 @@               not (null s) ==> do                 let p :: MonadParsec Void String m => m String                     p = takeP Nothing 0+                grs p s (`shouldParse` "")+                grs' p s (`succeedsLeaving` s)+      context "when taking <0 tokens" $ do+        context "when stream is empty" $+          it "succeeds returning zero-length chunk" $+            property $ \(Negative n) -> do+              let p :: MonadParsec Void String m => m String+                  p = takeP Nothing n+              grs p "" (`shouldParse` "")+        context "when stream is not empty" $+          it "succeeds returning zero-length chunk" $+            property $ \(Negative n) s ->+              not (null s) ==> do+                let p :: MonadParsec Void String m => m String+                    p = takeP Nothing n                 grs p s (`shouldParse` "")                 grs' p s (`succeedsLeaving` s)       context "when taking >0 tokens" $ do