diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,11 @@ +## Hspec Megaparsec 2.0.0 + +* To be used with Megaparsec 7. + +* Added functions: `shouldFailWithM` and `initialPosState`. + +* Dropped support for GHC 7.8. + ## Hspec Megaparsec 1.1.0 * Add `HasCallStack` constraint to combinators to improve detection of diff --git a/Test/Hspec/Megaparsec.hs b/Test/Hspec/Megaparsec.hs --- a/Test/Hspec/Megaparsec.hs +++ b/Test/Hspec/Megaparsec.hs @@ -8,13 +8,14 @@ -- Portability : portable -- -- Utility functions for testing Megaparsec parsers with Hspec. +-- +-- This version of the library should be used with Megaparsec 7. -{-# LANGUAGE CPP #-} +{-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE ConstraintKinds #-} module Test.Hspec.Megaparsec ( -- * Basic expectations @@ -24,19 +25,21 @@ , shouldFailOn -- * Testing of error messages , shouldFailWith + , shouldFailWithM -- * Incremental parsing , failsLeaving , succeedsLeaving , initialState + , initialPosState -- * Re-exports , module Text.Megaparsec.Error.Builder ) where import Control.Monad (unless) -import Data.List.NonEmpty (NonEmpty (..)) import Test.Hspec.Expectations import Text.Megaparsec import Text.Megaparsec.Error.Builder +import qualified Data.List.NonEmpty as NE ---------------------------------------------------------------------------- -- Basic expectations @@ -45,19 +48,20 @@ -- -- > parse letterChar "" "x" `shouldParse` 'x' -shouldParse :: ( HasCallStack - , Ord t - , ShowToken t - , ShowErrorComponent e - , Eq a - , Show a ) - => Either (ParseError t e) a +shouldParse + :: ( HasCallStack + , ShowErrorComponent e + , Stream s + , Show a + , Eq a + ) + => Either (ParseErrorBundle s e) a -- ^ Result of parsing as returned by function like 'parse' -> a -- ^ Desired result -> Expectation r `shouldParse` v = case r of Left e -> expectationFailure $ "expected: " ++ show v ++ - "\nbut parsing failed with error:\n" ++ showParseError e + "\nbut parsing failed with error:\n" ++ showBundle e Right x -> unless (x == v) . expectationFailure $ "expected: " ++ show v ++ "\nbut got: " ++ show x @@ -66,19 +70,21 @@ -- -- > parse (many punctuationChar) "" "?!!" `parseSatisfies` ((== 3) . length) -parseSatisfies :: ( HasCallStack - , Ord t - , ShowToken t - , ShowErrorComponent e - , Show a ) - => Either (ParseError t e) a +parseSatisfies + :: ( HasCallStack + , ShowErrorComponent e + , Stream s + , Show a + , Eq a + ) + => Either (ParseErrorBundle s e) a -- ^ Result of parsing as returned by function like 'parse' -> (a -> Bool) -- ^ Predicate -> Expectation r `parseSatisfies` p = case r of Left e -> expectationFailure $ "expected a parsed value to check against the predicate" ++ - "\nbut parsing failed with error:\n" ++ showParseError e + "\nbut parsing failed with error:\n" ++ showBundle e Right x -> unless (p x) . expectationFailure $ "the value did not satisfy the predicate: " ++ show x @@ -86,8 +92,9 @@ -- -- > parse (char 'x') "" `shouldFailOn` "a" -shouldFailOn :: (HasCallStack, Show a) - => (s -> Either (ParseError t e) a) +shouldFailOn + :: (HasCallStack, Show a) + => (s -> Either (ParseErrorBundle s e) a) -- ^ Parser that takes stream and produces result or error message -> s -- ^ Input that the parser should fail on -> Expectation @@ -97,12 +104,13 @@ -- -- > parse (char 'x') "" `shouldSucceedOn` "x" -shouldSucceedOn :: ( HasCallStack - , Ord t - , ShowToken t - , ShowErrorComponent e - , Show a ) - => (s -> Either (ParseError t e) a) +shouldSucceedOn + :: ( HasCallStack + , ShowErrorComponent e + , Stream s + , Show a + ) + => (s -> Either (ParseErrorBundle s e) a) -- ^ Parser that takes stream and produces result or error message -> s -- ^ Input that the parser should succeed on -> Expectation @@ -117,18 +125,45 @@ -- -- > parse (char 'x') "" "b" `shouldFailWith` err posI (utok 'b' <> etok 'x') -shouldFailWith :: ( HasCallStack - , Ord t - , ShowToken t - , ShowErrorComponent e - , Show a ) - => Either (ParseError t e) a - -> ParseError t e +shouldFailWith + :: ( HasCallStack + , ShowErrorComponent e + , Stream s + , Show a + , Eq e + ) + => Either (ParseErrorBundle s e) a -- ^ The result of parsing + -> ParseError s e -- ^ Expected parse errors -> Expectation -r `shouldFailWith` e = case r of - Left e' -> unless (e == e') . expectationFailure $ - "the parser is expected to fail with:\n" ++ showParseError e ++ - "but it failed with:\n" ++ showParseError e' +r `shouldFailWith` perr1 = r `shouldFailWithM` [perr1] + +-- | Similar to 'shouldFailWith', but allows to check parsers that can +-- report more than one parse error at a time. +-- +-- @since 2.0.0 + +shouldFailWithM + :: ( HasCallStack + , ShowErrorComponent e + , Stream s + , Show a + , Eq e + ) + => Either (ParseErrorBundle s e) a -- ^ The result of parsing + -> [ParseError s e] + -- ^ Expected parse errors, the argument is a normal linked list (as + -- opposed to the more correct 'NonEmpty' list) as a syntactical + -- convenience for the user, passing empty list here will result in an + -- error + -> Expectation +r `shouldFailWithM` perrs1' = case r of + Left e0 -> + let e1 = e0 { bundleErrors = perrs1 } + perrs0 = bundleErrors e0 + perrs1 = NE.fromList perrs1' + in unless (perrs0 == perrs1) . expectationFailure $ + "the parser is expected to fail with:\n" ++ showBundle e1 ++ + "but it failed with:\n" ++ showBundle e0 Right v -> expectationFailure $ "the parser is expected to fail, but it parsed: " ++ show v @@ -144,18 +179,20 @@ -- -- See also: 'initialState'. -failsLeaving :: ( HasCallStack - , Show a - , Eq s - , Show s - , Stream s ) - => (State s, Either (ParseError (Token s) e) a) +failsLeaving + :: ( HasCallStack + , Show a + , Eq s + , Show s + ) + => (State s, Either (ParseErrorBundle s e) a) -- ^ Parser that takes stream and produces result along with actual -- state information -> s -- ^ Part of input that should be left unconsumed -> Expectation -(st,r) `failsLeaving` s = - shouldFail r >> checkUnconsumed s (stateInput st) +(st,r) `failsLeaving` s = do + shouldFail r + checkUnconsumed s (stateInput st) -- | Check that a parser succeeds and leaves certain part of input -- unconsumed. Use it with functions like 'runParser'' and 'runParserT'' @@ -166,41 +203,53 @@ -- -- See also: 'initialState'. -succeedsLeaving :: ( HasCallStack - , ShowToken (Token s) - , ShowErrorComponent e - , Show a - , Eq s - , Show s - , Stream s ) - => (State s, Either (ParseError (Token s) e) a) +succeedsLeaving + :: ( HasCallStack + , Show a + , Eq s + , Show s + , ShowErrorComponent e + , Stream s + ) + => (State s, Either (ParseErrorBundle s e) a) -- ^ Parser that takes stream and produces result along with actual -- state information -> s -- ^ Part of input that should be left unconsumed -> Expectation -(st,r) `succeedsLeaving` s = - shouldSucceed r >> checkUnconsumed s (stateInput st) +(st,r) `succeedsLeaving` s = do + shouldSucceed r + checkUnconsumed s (stateInput st) --- | Given input for parsing, construct initial state for parser (that is, --- with empty file name, default tab width and position at 1 line and 1 --- column). +-- | Given input for parsing, construct initial state for parser. initialState :: s -> State s initialState s = State - { stateInput = s - , statePos = initialPos "" :| [] -#if MIN_VERSION_megaparsec(5,2,0) - , stateTokensProcessed = 0 -#endif - , stateTabWidth = defaultTabWidth } + { stateInput = s + , stateOffset = 0 + , statePosState = initialPosState s + } +-- | Given input for parsing, construct initial positional state. +-- +-- @since 2.0.0 + +initialPosState :: s -> PosState s +initialPosState s = PosState + { pstateInput = s + , pstateOffset = 0 + , pstateSourcePos = initialPos "" + , pstateTabWidth = defaultTabWidth + , pstateLinePrefix = "" + } + ---------------------------------------------------------------------------- -- Helpers --- | Expectation that argument is result of a failed parser. +-- | Expect that the argument is a result of a failed parser. -shouldFail :: (HasCallStack, Show a) - => Either (ParseError t e) a +shouldFail + :: (HasCallStack, Show a) + => Either (ParseErrorBundle s e) a -> Expectation shouldFail r = case r of Left _ -> return () @@ -209,22 +258,27 @@ -- | Expectation that argument is result of a succeeded parser. -shouldSucceed :: ( HasCallStack - , Ord t - , ShowToken t - , ShowErrorComponent e - , Show a ) - => Either (ParseError t e) a +shouldSucceed + :: ( HasCallStack + , ShowErrorComponent e + , Stream s + , Show a + ) + => Either (ParseErrorBundle s e) a -> Expectation shouldSucceed r = case r of Left e -> expectationFailure $ "the parser is expected to succeed, but it failed with:\n" ++ - showParseError e + showBundle e Right _ -> return () -- | Compare two streams for equality and in the case of mismatch report it. -checkUnconsumed :: (HasCallStack, Eq s, Show s, Stream s) +checkUnconsumed + :: ( HasCallStack + , Eq s + , Show s + ) => s -- ^ Expected unconsumed input -> s -- ^ Actual unconsumed input -> Expectation @@ -232,10 +286,17 @@ "the parser is expected to leave unconsumed input: " ++ show e ++ "\nbut it left this: " ++ show a --- | Render parse error in a way that is suitable for inserting it in a test --- suite report. +-- | Render a parse error bundle in a way that is suitable for inserting it +-- in a test suite report. -showParseError :: (Ord t, ShowToken t, ShowErrorComponent e) - => ParseError t e +showBundle + :: ( ShowErrorComponent e + , Stream s + ) + => ParseErrorBundle s e -> String -showParseError = unlines . fmap (" " ++) . lines . parseErrorPretty +showBundle = unlines . fmap indent . lines . errorBundlePretty + where + indent x = if null x + then x + else " " ++ x diff --git a/hspec-megaparsec.cabal b/hspec-megaparsec.cabal --- a/hspec-megaparsec.cabal +++ b/hspec-megaparsec.cabal @@ -1,7 +1,7 @@ name: hspec-megaparsec -version: 1.1.0 +version: 2.0.0 cabal-version: 1.18 -tested-with: GHC==7.8.4, 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.3 license: BSD3 license-file: LICENSE.md author: Mark Karpov @@ -21,12 +21,10 @@ default: False library - build-depends: base >= 4.7 && < 5.0 + build-depends: base >= 4.8 && < 5.0 , containers >= 0.5 && < 0.6 , hspec-expectations >= 0.8 && < 0.9 - , megaparsec >= 6.0 && < 7.0 - if !impl(ghc >= 7.8) - build-depends: tagged == 0.8.* + , megaparsec >= 7.0 && < 8.0 if !impl(ghc >= 8.0) build-depends: semigroups == 0.18.* exposed-modules: Test.Hspec.Megaparsec @@ -50,13 +48,11 @@ ghc-options: -Wall -Werror else ghc-options: -Wall - build-depends: base >= 4.7 && < 5.0 + build-depends: base >= 4.8 && < 5.0 , hspec >= 2.0 && < 3.0 , hspec-expectations >= 0.8 && < 0.9 , hspec-megaparsec - , megaparsec >= 6.0 && < 7.0 - if !impl(ghc >= 7.8) - build-depends: tagged == 0.8.* + , megaparsec >= 7.0 && < 8.0 if !impl(ghc >= 7.10) build-depends: void == 0.7.* if !impl(ghc >= 8.0) diff --git a/tests/Main.hs b/tests/Main.hs --- a/tests/Main.hs +++ b/tests/Main.hs @@ -35,7 +35,7 @@ describe "shouldFailWith" $ it "works" $ parse (char 'x' :: Parser Char) "" "b" `shouldFailWith` - err posI (utok 'b' <> etok 'x') + err 0 (utok 'b' <> etok 'x') describe "failsLeaving" $ it "works" $ runParser' (many (char 'x') <* eof :: Parser String) (initialState "xxa")