hspec-megaparsec 1.1.0 → 2.0.0
raw patch · 4 files changed
+156/−91 lines, 4 filesdep −taggeddep ~basedep ~containersdep ~megaparsec
Dependencies removed: tagged
Dependency ranges changed: base, containers, megaparsec
Files
- CHANGELOG.md +8/−0
- Test/Hspec/Megaparsec.hs +141/−80
- hspec-megaparsec.cabal +6/−10
- tests/Main.hs +1/−1
CHANGELOG.md view
@@ -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
Test/Hspec/Megaparsec.hs view
@@ -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
hspec-megaparsec.cabal view
@@ -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 <markkarpov92@gmail.com>@@ -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)
tests/Main.hs view
@@ -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")