packages feed

megaparsec-tests 9.3.1 → 9.4.0

raw patch · 4 files changed

+114/−60 lines, 4 filesdep ~megaparsecPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: megaparsec

API changes (from Hackage documentation)

Files

megaparsec-tests.cabal view
@@ -1,6 +1,6 @@ cabal-version:   2.4 name:            megaparsec-tests-version:         9.3.1+version:         9.4.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.3.1,+        megaparsec ==9.4.0,         mtl >=2.2.2 && <3.0,         text >=0.2 && <2.1,         transformers >=0.4 && <0.7@@ -71,7 +71,7 @@         hspec >=2.0 && <3.0,         hspec-expectations >=0.8 && <0.9,         hspec-megaparsec >=2.0 && <3.0,-        megaparsec ==9.3.1,+        megaparsec ==9.4.0,         megaparsec-tests,         mtl >=2.2.2 && <3.0,         parser-combinators >=1.0 && <2.0,
tests/Text/Megaparsec/Char/LexerSpec.hs view
@@ -119,14 +119,14 @@               ip = indentGuard scn               sp = void (symbol sc sbla <* C.eol)           if-              | col0 <= pos1 ->-                  prs p s `shouldFailWith` errFancy 0 (ii GT pos1 col0)-              | col1 /= col0 ->-                  prs p s `shouldFailWith` errFancy (getIndent l1 + g 1) (ii EQ col0 col1)-              | col2 <= col0 ->-                  prs p s `shouldFailWith` errFancy (getIndent l2 + g 2) (ii GT col0 col2)-              | otherwise ->-                  prs p s `shouldParse` ()+            | col0 <= pos1 ->+                prs p s `shouldFailWith` errFancy 0 (ii GT pos1 col0)+            | col1 /= col0 ->+                prs p s `shouldFailWith` errFancy (getIndent l1 + g 1) (ii EQ col0 col1)+            | col2 <= col0 ->+                prs p s `shouldFailWith` errFancy (getIndent l2 + g 2) (ii GT col0 col2)+            | otherwise ->+                prs p s `shouldParse` ()    describe "nonIdented" $     it "works as intended" $@@ -165,33 +165,33 @@               l x = return . (x,)               ib' = mkPos (fromIntegral ib)           if-              | col1 <= col0 ->-                  prs p s-                    `shouldFailWith` err (getIndent l1 + g 1) (utok (head sblb) <> eeof)-              | isJust mn && col1 /= ib' ->-                  prs p s-                    `shouldFailWith` errFancy (getIndent l1 + g 1) (ii EQ ib' col1)-              | col2 <= col1 ->-                  prs p s-                    `shouldFailWith` errFancy (getIndent l2 + g 2) (ii GT col1 col2)-              | col3 == col2 ->-                  prs p s-                    `shouldFailWith` err (getIndent l3 + g 3) (utoks sblb <> etoks sblc <> eeof)-              | col3 <= col0 ->-                  prs p s-                    `shouldFailWith` err (getIndent l3 + g 3) (utok (head sblb) <> eeof)-              | col3 < col1 ->-                  prs p s-                    `shouldFailWith` errFancy (getIndent l3 + g 3) (ii EQ col1 col3)-              | col3 > col1 ->-                  prs p s-                    `shouldFailWith` errFancy (getIndent l3 + g 3) (ii EQ col2 col3)-              | col4 <= col3 ->-                  prs p s-                    `shouldFailWith` errFancy (getIndent l4 + g 4) (ii GT col3 col4)-              | otherwise ->-                  prs p s-                    `shouldParse` (sbla, [(sblb, [sblc]), (sblb, [sblc])])+            | col1 <= col0 ->+                prs p s+                  `shouldFailWith` err (getIndent l1 + g 1) (utok (head sblb) <> eeof)+            | isJust mn && col1 /= ib' ->+                prs p s+                  `shouldFailWith` errFancy (getIndent l1 + g 1) (ii EQ ib' col1)+            | col2 <= col1 ->+                prs p s+                  `shouldFailWith` errFancy (getIndent l2 + g 2) (ii GT col1 col2)+            | col3 == col2 ->+                prs p s+                  `shouldFailWith` err (getIndent l3 + g 3) (utoks sblb <> etoks sblc <> eeof)+            | col3 <= col0 ->+                prs p s+                  `shouldFailWith` err (getIndent l3 + g 3) (utok (head sblb) <> eeof)+            | col3 < col1 ->+                prs p s+                  `shouldFailWith` errFancy (getIndent l3 + g 3) (ii EQ col1 col3)+            | col3 > col1 ->+                prs p s+                  `shouldFailWith` errFancy (getIndent l3 + g 3) (ii EQ col2 col3)+            | col4 <= col3 ->+                prs p s+                  `shouldFailWith` errFancy (getIndent l4 + g 4) (ii GT col3 col4)+            | otherwise ->+                prs p s+                  `shouldParse` (sbla, [(sblb, [sblc]), (sblb, [sblc])])     it "IndentMany works as intended (newline at the end)" $       property $         forAll ((<>) <$> mkIndent sbla 0 <*> mkWhiteSpaceNl) $ \s -> do@@ -266,13 +266,13 @@               (col0, col1, col2) = (getCol l0, getCol l1, getCol l2)               (end0, end1) = (getEnd l0, getEnd l1)           if-              | end0 && col1 <= col0 ->-                  prs p s-                    `shouldFailWith` errFancy (getIndent l1 + g 1) (ii GT col0 col1)-              | end1 && col2 <= col0 ->-                  prs p s-                    `shouldFailWith` errFancy (getIndent l2 + g 2) (ii GT col0 col2)-              | otherwise -> prs p s `shouldParse` (sbla, sblb, sblc)+            | end0 && col1 <= col0 ->+                prs p s+                  `shouldFailWith` errFancy (getIndent l1 + g 1) (ii GT col0 col1)+            | end1 && col2 <= col0 ->+                prs p s+                  `shouldFailWith` errFancy (getIndent l2 + g 2) (ii GT col0 col2)+            | otherwise -> prs p s `shouldParse` (sbla, sblb, sblc)    describe "charLiteral" $ do     let p = charLiteral
tests/Text/Megaparsec/DebugSpec.hs view
@@ -33,16 +33,23 @@         let p :: (MonadParsecDbg Void String m) => m Char             p = dbg "char" (char 'a')             s = "ab"-        shouldStderr p s "char> IN: \"ab\"\nchar> MATCH (COK): 'a'\nchar> VALUE: 'a'\n\n"+        shouldStderr p s "char> IN: \"ab\"\nchar> MATCH (COK): 'a'\nchar> VALUE: 'a'\nchar> HINTS: []\n\n"         grs p s (`shouldParse` 'a')         grs' p s (`succeedsLeaving` "b")       it "its hints are preserved" $ do         let p :: (MonadParsecDbg Void String m) => m String             p = dbg "many chars" (many (char 'a')) <* empty             s = "abcd"-        shouldStderr p s "many chars> IN: \"abcd\"\nmany chars> MATCH (COK): 'a'\nmany chars> VALUE: \"a\"\n\n"+        shouldStderr p s "many chars> IN: \"abcd\"\nmany chars> MATCH (COK): 'a'\nmany chars> VALUE: \"a\"\nmany chars> HINTS: ['a']\n\n"         grs p s (`shouldFailWith` err 1 (etok 'a'))         grs' p s (`failsLeaving` "bcd")+      it "prints several hints correctly" $ do+        let p :: (MonadParsecDbg Void String m) => m (Maybe Char)+            p = dbg "a or b" (optional (char 'a' <|> char 'b')) <* empty+            s = ""+        shouldStderr p s "a or b> IN: <EMPTY>\na or b> MATCH (EOK): <EMPTY>\na or b> VALUE: Nothing\na or b> HINTS: ['a','b']\n\n"+        grs p s (`shouldFailWith` err 0 (etok 'a' <> etok 'b'))+        grs' p s (`failsLeaving` "")     context "when inner parser fails consuming input" $       it "has no effect on how parser works" $ do         let p :: (MonadParsecDbg Void String m) => m Char@@ -56,14 +63,14 @@         let p :: (MonadParsecDbg Void String m) => m Char             p = dbg "return" (return 'a')             s = "abc"-        shouldStderr p s "return> IN: \"abc\"\nreturn> MATCH (EOK): <EMPTY>\nreturn> VALUE: 'a'\n\n"+        shouldStderr p s "return> IN: \"abc\"\nreturn> MATCH (EOK): <EMPTY>\nreturn> VALUE: 'a'\nreturn> HINTS: []\n\n"         grs p s (`shouldParse` 'a')         grs' p s (`succeedsLeaving` s)       it "its hints are preserved" $ do         let p :: (MonadParsecDbg Void String m) => m String             p = dbg "many chars" (many (char 'a')) <* empty             s = "bcd"-        shouldStderr p s "many chars> IN: \"bcd\"\nmany chars> MATCH (EOK): <EMPTY>\nmany chars> VALUE: \"\"\n\n"+        shouldStderr p s "many chars> IN: \"bcd\"\nmany chars> MATCH (EOK): <EMPTY>\nmany chars> VALUE: \"\"\nmany chars> HINTS: ['a']\n\n"         grs p s (`shouldFailWith` err 0 (etok 'a'))         grs' p s (`failsLeaving` "bcd")     context "when inner parser fails without consuming" $@@ -87,8 +94,8 @@             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"+        stderr1 = "a> IN: 'a'\na> MATCH (COK): 'a'\na> VALUE: () (LOG: [1])\na> HINTS: []\n\n"+        stderr2 = "a> IN: \"abcd\"\na> MATCH (COK): 'a'\na> VALUE: 'a' (LOG: [])\na> HINTS: []\n\nb> IN: \"bcd\"\nb> MATCH (COK): 'b'\nb> VALUE: 'b' (LOG: [])\nb> HINTS: []\n\nc> IN: \"cd\"\nc> MATCH (COK): \"cd\"\nc> VALUE: () (LOG: [1,2])\nc> HINTS: []\n\n"         r1 = ((), [0, 1])         r2 = ((), [0, 1, 2])     context "Lazy WriterT instance of MonadParsecDbg" $ do@@ -118,8 +125,8 @@             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"+        stderr3 = "a> IN: 'a'\na> MATCH (COK): 'a'\na> VALUE: () (STATE: 2)\na> HINTS: []\n\n"+        stderr4 = "a> IN: \"abcd\"\na> MATCH (COK): 'a'\na> VALUE: 'a' (STATE: 0)\na> HINTS: []\n\nb> IN: \"bcd\"\nb> MATCH (COK): 'b'\nb> VALUE: 'b' (STATE: 1)\nb> HINTS: []\n\nc> IN: \"cd\"\nc> MATCH (COK): \"cd\"\nc> VALUE: () (STATE: 3)\nc> HINTS: []\n\n"         r3 = ((), 2)         r4 = ((), 3)     context "Lazy StateT instance of MonadParsecDbg" $ do@@ -142,8 +149,8 @@           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"+        stderr5 = "a> IN: 'a'\na> MATCH (COK): 'a'\na> VALUE: () (STATE: 2) (LOG: [1])\na> HINTS: []\n\n"+        stderr7 = "a> IN: 'a'\na> MATCH (COK): 'a'\na> VALUE: () (LOG: [1]) (STATE: 2)\na> HINTS: []\n\n"         r5 = ((), 2, [0, 1])         p6 :: (MonadParsecDbg Void String m, MonadWriter [Int] m, MonadState Int m) => m ()         p6 = do@@ -179,6 +186,7 @@ -- | Check that running the given parser on the input prints the expected -- string to the 'stderr'. shouldStderr ::+  (HasCallStack) =>   -- | The parser to test   Parser a ->   -- | Input for the parser
tests/Text/MegaparsecSpec.hs view
@@ -1,11 +1,11 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE LambdaCase #-}-{-# LANGUAGE MultiWayIf #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE Rank2Types #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE RecursiveDo #-}+{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-} {-# OPTIONS_GHC -fno-warn-orphans #-} @@ -42,6 +42,7 @@ import Test.QuickCheck hiding (label) import Text.Megaparsec import Text.Megaparsec.Char+import qualified Text.Megaparsec.Internal as Internal import Prelude hiding (concat, span)  spec :: Spec@@ -370,29 +371,54 @@             )    describe "ParsecT MonadReader instance" $ do-    describe "ask" $+    describe "ask" $ do       it "returns correct value of context" $         property $ \n -> do           let p = ask :: ParsecT Void String (Reader Integer) Integer           runReader (runParserT p "" "") n `shouldBe` Right n+      it "preserves hints" $+        property $ \a b (n :: Integer) ->+          a /= b ==> do+            let p :: ParsecT Void String (Reader Integer) Integer+                p = optional (char a) *> ask <* hidden eof+            runReader (runParserT p "" [b]) n `shouldFailWith` err 0 (utok b <> etok a) -    describe "local" $+    describe "local" $ do       it "modifies reader context correctly" $         property $ \n k -> do           let p = local (+ k) ask :: ParsecT Void String (Reader Integer) Integer           runReader (runParserT p "" "") n `shouldBe` Right (n + k)+      it "preserves hints" $+        property $ \a b (n :: Integer) ->+          a /= b ==> do+            let p :: ParsecT Void String (Reader Integer) (Maybe Char)+                p = local (+ 1) (optional (char a)) <* hidden eof+            runReader (runParserT p "" [b]) n `shouldFailWith` err 0 (utok b <> etok a)    describe "ParsecT MonadState instance" $ do-    describe "get" $+    describe "get" $ do       it "returns correct state value" $         property $ \n -> do           let p = L.get :: ParsecT Void String (L.State Integer) Integer           L.evalState (runParserT p "" "") n `shouldBe` Right n-    describe "put" $+      it "preserves hints" $+        property $ \a b (n :: Integer) ->+          a /= b ==> do+            let p :: ParsecT Void String (L.State Integer) Integer+                p = optional (char a) *> L.get <* hidden eof+            L.evalState (runParserT p "" [b]) n `shouldFailWith` err 0 (utok b <> etok a)++    describe "put" $ do       it "replaces state value" $         property $ \a b -> do           let p = L.put b :: ParsecT Void String (L.State Integer) ()           L.execState (runParserT p "" "") a `shouldBe` b+      it "preserves hints" $+        property $ \a b (n :: Integer) (n' :: Integer) ->+          a /= b ==> do+            let p :: ParsecT Void String (L.State Integer) ()+                p = optional (char a) *> L.put n' <* hidden eof+            L.evalState (runParserT p "" [b]) n `shouldFailWith` err 0 (utok b <> etok a)    describe "ParsecT MonadCont instance" $     describe "callCC" $@@ -1748,6 +1774,26 @@               let p = observing (S.put s1 <* empty)               prs (S.runRWST p (r :: Int) (s0 :: Int)) ""                 `shouldParse` (Left (err 0 mempty), s0, mempty :: [Int])++    describe "mkParsec" $+      it "enables defining new primitives" $ do+        -- This example lifts breakOn from text, although in order to re-use+        -- the machinery that we have here it parses String, hence+        -- conversions. The parser always succeeds.+        let breakOn end = mkParsec $ \s ->+              let (pre, post) = T.breakOn end (T.pack $ stateInput s)+               in Internal.Reply+                    ( s+                        { stateInput = T.unpack post,+                          stateOffset = stateOffset s + T.length pre+                        }+                    )+                    ( if T.null pre+                        then Internal.NotConsumed+                        else Internal.Consumed+                    )+                    (Internal.OK mempty (T.unpack pre))+        prs (breakOn "x") "abxcd" `shouldParse` "ab"  ---------------------------------------------------------------------------- -- Helpers