diff --git a/megaparsec-tests.cabal b/megaparsec-tests.cabal --- a/megaparsec-tests.cabal +++ b/megaparsec-tests.cabal @@ -1,11 +1,11 @@ -cabal-version: 1.18 +cabal-version: 2.4 name: megaparsec-tests -version: 9.2.0 -license: BSD2 +version: 9.2.1 +license: BSD-2-Clause license-file: LICENSE.md maintainer: Mark Karpov author: Megaparsec contributors -tested-with: ghc ==8.8.4 ghc ==8.10.4 ghc ==9.0.1 +tested-with: ghc ==8.10.7 ghc ==9.0.2 ghc ==9.2.1 homepage: https://github.com/mrkkrp/megaparsec bug-reports: https://github.com/mrkkrp/megaparsec/issues synopsis: Test utilities and the test suite of Megaparsec @@ -31,10 +31,10 @@ hspec >=2.0 && <3.0, hspec-expectations >=0.8 && <0.9, hspec-megaparsec >=2.0 && <3.0, - megaparsec ==9.2.0, + megaparsec ==9.2.1, mtl >=2.2.2 && <3.0, text >=0.2 && <1.3, - transformers >=0.4 && <0.6 + transformers >=0.4 && <0.7 if flag(dev) ghc-options: @@ -47,7 +47,7 @@ test-suite tests type: exitcode-stdio-1.0 main-is: Spec.hs - build-tools: hspec-discover >=2.0 && <3.0 + build-tool-depends: hspec-discover:hspec-discover >=2.0 && <3.0 hs-source-dirs: tests other-modules: Text.Megaparsec.Byte.BinarySpec @@ -71,13 +71,13 @@ hspec >=2.0 && <3.0, hspec-expectations >=0.8 && <0.9, hspec-megaparsec >=2.0 && <3.0, - megaparsec ==9.2.0, + megaparsec ==9.2.1, megaparsec-tests, mtl >=2.2.2 && <3.0, parser-combinators >=1.0 && <2.0, scientific >=0.3.1 && <0.4, text >=0.2 && <1.3, - transformers >=0.4 && <0.6 + transformers >=0.4 && <0.7 if flag(dev) ghc-options: -O0 -Wall -Werror diff --git a/tests/Text/Megaparsec/Char/LexerSpec.hs b/tests/Text/Megaparsec/Char/LexerSpec.hs --- a/tests/Text/Megaparsec/Char/LexerSpec.hs +++ b/tests/Text/Megaparsec/Char/LexerSpec.hs @@ -120,13 +120,13 @@ sp = void (symbol sc sbla <* C.eol) if | col0 <= pos1 -> - prs p s `shouldFailWith` errFancy 0 (ii GT pos1 col0) + 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) + 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) + prs p s `shouldFailWith` errFancy (getIndent l2 + g 2) (ii GT col0 col2) | otherwise -> - prs p s `shouldParse` () + prs p s `shouldParse` () describe "nonIdented" $ it "works as intended" $ @@ -166,32 +166,32 @@ ib' = mkPos (fromIntegral ib) if | col1 <= col0 -> - prs p s - `shouldFailWith` err (getIndent l1 + g 1) (utok (head sblb) <> eeof) + 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) + 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) + 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) + 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) + 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) + 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) + 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) + prs p s + `shouldFailWith` errFancy (getIndent l4 + g 4) (ii GT col3 col4) | otherwise -> - prs p s - `shouldParse` (sbla, [(sblb, [sblc]), (sblb, [sblc])]) + 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 @@ -267,11 +267,11 @@ (end0, end1) = (getEnd l0, getEnd l1) if | end0 && col1 <= col0 -> - prs p s - `shouldFailWith` errFancy (getIndent l1 + g 1) (ii GT col0 col1) + 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) + prs p s + `shouldFailWith` errFancy (getIndent l2 + g 2) (ii GT col0 col2) | otherwise -> prs p s `shouldParse` (sbla, sblb, sblc) describe "charLiteral" $ do diff --git a/tests/Text/MegaparsecSpec.hs b/tests/Text/MegaparsecSpec.hs --- a/tests/Text/MegaparsecSpec.hs +++ b/tests/Text/MegaparsecSpec.hs @@ -11,14 +11,18 @@ module Text.MegaparsecSpec (spec) where -import Control.Monad.Cont -import Control.Monad.Except -import Control.Monad.Identity +import Control.Monad (ap, forM_, guard, unless, void, when) +import Control.Monad.Cont (Cont, callCC, runCont) +import Control.Monad.Except (catchError, throwError) +import Control.Monad.Fix (MonadFix) +import Control.Monad.IO.Class (liftIO) +import Control.Monad.Identity (runIdentity) import qualified Control.Monad.RWS.Lazy as L import qualified Control.Monad.RWS.Strict as S -import Control.Monad.Reader +import Control.Monad.Reader (Reader, ask, asks, local, runReader, runReaderT) import qualified Control.Monad.State.Lazy as L import qualified Control.Monad.State.Strict as S +import Control.Monad.Trans.Except (Except, runExcept) import qualified Control.Monad.Writer.Lazy as L import qualified Control.Monad.Writer.Strict as S import qualified Data.ByteString as BS @@ -26,7 +30,6 @@ import Data.Foldable (asum) import Data.List (isPrefixOf) import qualified Data.List as DL -import Data.List.NonEmpty (NonEmpty (..)) import qualified Data.List.NonEmpty as NE import Data.Semigroup import qualified Data.Set as E @@ -220,17 +223,15 @@ describe "many" $ do context "when stream begins with things argument of many parses" $ it "they are parsed" $ - property $ \a' b' c' -> do - let [a, b, c] = getNonNegative <$> [a', b', c'] - p = many (char 'a') + property $ \(NonNegative a) (NonNegative b) (NonNegative c) -> do + let p = many (char 'a') s = abcRow a b c prs p s `shouldParse` replicate a 'a' prs' p s `succeedsLeaving` drop a s context "when stream does not begin with thing argument of many parses" $ it "does nothing" $ - property $ \a' b' c' -> do - let [a, b, c] = getNonNegative <$> [a', b', c'] - p = many (char 'd') + property $ \(NonNegative a) (NonNegative b) (NonNegative c) -> do + let p = many (char 'd') s = abcRow a b c prs p s `shouldParse` "" prs' p s `succeedsLeaving` s @@ -249,9 +250,8 @@ (utok 'c' <> etok 'a' <> etok 'b' <> eeof) context "when the argument parser succeeds without consuming" $ it "is run nevertheless" $ - property $ \n' -> do - let n = getSmall (getNonNegative n') :: Integer - p = void . many $ do + property $ \(NonNegative (Small n)) -> do + let p = void . many $ do x <- S.get if x < n then S.modify (+ 1) else empty v :: S.State Integer (Either (ParseErrorBundle String Void) ()) @@ -261,18 +261,15 @@ describe "some" $ do context "when stream begins with things argument of some parses" $ it "they are parsed" $ - property $ \a' b' c' -> do - let a = getPositive a' - [b, c] = getNonNegative <$> [b', c'] - p = some (char 'a') + property $ \(Positive a) (NonNegative b) (NonNegative c) -> do + let p = some (char 'a') s = abcRow a b c prs p s `shouldParse` replicate a 'a' prs' p s `succeedsLeaving` drop a s context "when stream does not begin with thing argument of some parses" $ it "signals correct parse error" $ - property $ \a' b' c' -> do - let [a, b, c] = getNonNegative <$> [a', b', c'] - p = some (char 'd') + property $ \(NonNegative a) (NonNegative b) (NonNegative c) -> do + let p = some (char 'd') s = abcRow a b c ++ "g" prs p s `shouldFailWith` err 0 (utok (head s) <> etok 'd') prs' p s `failsLeaving` s @@ -801,7 +798,7 @@ grs p s (`shouldFailWith` err 0 mempty) grs' p s (`failsLeaving` s) it "works in complex situations too" $ - property $ \a' b' c' -> do + property $ \(NonNegative a) (NonNegative b) (NonNegative c) -> do let p :: MonadParsec Void String m => m (Either (ParseError String Void) String) p = let g = count' 1 3 . char @@ -811,7 +808,6 @@ v (Left m) _ = Left m ma = if a < 3 then etok 'a' else mempty s = abcRow a b c - [a, b, c] = getNonNegative <$> [a', b', c'] f = flip shouldFailWith z = flip shouldParse r @@ -1257,9 +1253,8 @@ describe "oneOf" $ do context "when stream begins with one of specified characters" $ it "parses the character" $ - property $ \chs' n s -> do - let chs = getNonEmpty chs' - ch = chs !! (getNonNegative n `rem` length chs) + property $ \(NonEmpty chs) (NonNegative n) s -> do + let ch = chs !! (n `rem` length chs) s' = ch : s grs (oneOf chs) s' (`shouldParse` ch) grs' (oneOf chs) s' (`succeedsLeaving` s) @@ -1285,9 +1280,8 @@ grs' (noneOf chs) s' (`succeedsLeaving` s) context "when stream begins with one of specified characters" $ it "signals correct parse error" $ - property $ \chs' n s -> do - let chs = getNonEmpty chs' - ch = chs !! (getNonNegative n `rem` length chs) + property $ \(NonEmpty chs) (NonNegative n) s -> do + let ch = chs !! (n `rem` length chs) s' = ch : s grs (noneOf chs) s' (`shouldFailWith` err 0 (utok ch)) grs' (noneOf chs) s' (`failsLeaving` s') @@ -1420,9 +1414,8 @@ describe "notFollowedBy" $ it "generally works" $ - property $ \a' b' c' -> do + property $ \(NonNegative a) (NonNegative b) (NonNegative c) -> do let p = many (char =<< ask) <* notFollowedBy eof <* many anySingle - [a, b, c] = getNonNegative <$> [a', b', c'] s = abcRow a b c if b > 0 || c > 0 then prs (runReaderT p 'a') s `shouldParse` replicate a 'a' @@ -1767,7 +1760,7 @@ mkBundle :: State s e -> - NonEmpty (ParseError s e) -> + NE.NonEmpty (ParseError s e) -> ParseErrorBundle s e mkBundle s es = ParseErrorBundle