hspec-megaparsec 2.1.0 → 2.2.1
raw patch · 6 files changed
Files
- CHANGELOG.md +8/−0
- README.md +2/−4
- Setup.hs +0/−6
- Test/Hspec/Megaparsec.hs +219/−187
- hspec-megaparsec.cabal +54/−50
- tests/Main.hs +2/−9
CHANGELOG.md view
@@ -1,3 +1,11 @@+## Hspec Megaparsec 2.2.1++* Maintenance release with more modern and minimal dependencies.++## Hspec Megaparsec 2.2.0++* Works with Megaparsec 9.+ ## Hspec Megaparsec 2.1.0 * Works with Megaparsec 8.
README.md view
@@ -4,13 +4,11 @@ [](https://hackage.haskell.org/package/hspec-megaparsec) [](http://stackage.org/nightly/package/hspec-megaparsec) [](http://stackage.org/lts/package/hspec-megaparsec)-[](https://travis-ci.org/mrkkrp/hspec-megaparsec)+ The package is the recommended library for testing [`Megaparsec`](https://hackage.haskell.org/package/megaparsec) parsers with-with [`Hspec`](https://hackage.haskell.org/package/hspec). As of Megaparsec-5.1.0, its test suite is re-written with Hspec and this package with a few-ad-hoc helpers.+with [`Hspec`](https://hackage.haskell.org/package/hspec). Consult the Haddocks for usage, which should be trivial. Also see test suite of this package or [Megaparsec test
− Setup.hs
@@ -1,6 +0,0 @@-module Main (main) where--import Distribution.Simple--main :: IO ()-main = defaultMain
Test/Hspec/Megaparsec.hs view
@@ -1,3 +1,9 @@+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies #-}+ -- | -- Module : Test.Hspec.Megaparsec -- Copyright : © 2016–present Mark Karpov@@ -8,38 +14,33 @@ -- Portability : portable -- -- Utility functions for testing Megaparsec parsers with Hspec.------ This version of the library should be used with Megaparsec 7.--{-# LANGUAGE ConstraintKinds #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE RankNTypes #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeFamilies #-}- module Test.Hspec.Megaparsec ( -- * Basic expectations- shouldParse- , parseSatisfies- , shouldSucceedOn- , shouldFailOn+ shouldParse,+ parseSatisfies,+ shouldSucceedOn,+ shouldFailOn,+ -- * Testing of error messages- , shouldFailWith- , shouldFailWithM+ shouldFailWith,+ shouldFailWithM,+ -- * Incremental parsing- , failsLeaving- , succeedsLeaving- , initialState- , initialPosState+ failsLeaving,+ succeedsLeaving,+ initialState,+ initialPosState,+ -- * Re-exports- , module Text.Megaparsec.Error.Builder )+ module Text.Megaparsec.Error.Builder,+ ) where import Control.Monad (unless)+import Data.List.NonEmpty qualified as NE import Test.Hspec.Expectations import Text.Megaparsec import Text.Megaparsec.Error.Builder-import qualified Data.List.NonEmpty as NE ---------------------------------------------------------------------------- -- Basic expectations@@ -47,72 +48,85 @@ -- | Create an expectation by saying what the result should be. -- -- > parse letterChar "" "x" `shouldParse` 'x'--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+shouldParse ::+ ( HasCallStack,+ ShowErrorComponent e,+ Stream s,+ VisualStream s,+ TraversableStream s,+ Show a,+ Eq a+ ) =>+ -- | Result of parsing as returned by function like 'parse'+ Either (ParseErrorBundle s e) a ->+ -- | Desired result+ a ->+ Expectation r `shouldParse` v = case r of- Left e -> expectationFailure $ "expected: " ++ show v ++- "\nbut parsing failed with error:\n" ++ showBundle e+ Left e ->+ expectationFailure $+ "expected: "+ ++ show v+ ++ "\nbut parsing failed with error:\n"+ ++ showBundle e Right x -> x `shouldBe` v -- | Create an expectation by saying that the parser should successfully -- parse a value and that the value should satisfy some predicate. -- -- > parse (many punctuationChar) "" "?!!" `parseSatisfies` ((== 3) . length)--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+parseSatisfies ::+ ( HasCallStack,+ ShowErrorComponent e,+ Stream s,+ VisualStream s,+ TraversableStream s,+ Show a,+ Eq a+ ) =>+ -- | Result of parsing as returned by function like 'parse'+ Either (ParseErrorBundle s e) a ->+ -- | Predicate+ (a -> Bool) ->+ 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" ++ showBundle e- Right x -> unless (p x) . expectationFailure $- "the value did not satisfy the predicate: " ++ show x+ Left e ->+ expectationFailure $+ "expected a parsed value to check against the predicate"+ ++ "\nbut parsing failed with error:\n"+ ++ showBundle e+ Right x ->+ unless (p x) . expectationFailure $+ "the value did not satisfy the predicate: " ++ show x -- | Check that a parser fails on a given input. -- -- > parse (char 'x') "" `shouldFailOn` "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+shouldFailOn ::+ (HasCallStack, Show a) =>+ -- | Parser that takes stream and produces result or error message+ (s -> Either (ParseErrorBundle s e) a) ->+ -- | Input that the parser should fail on+ s ->+ Expectation p `shouldFailOn` s = shouldFail (p s) -- | Check that a parser succeeds on a given input. -- -- > parse (char 'x') "" `shouldSucceedOn` "x"--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+shouldSucceedOn ::+ ( HasCallStack,+ ShowErrorComponent e,+ Stream s,+ VisualStream s,+ TraversableStream s,+ Show a+ ) =>+ -- | Parser that takes stream and produces result or error message+ (s -> Either (ParseErrorBundle s e) a) ->+ -- | Input that the parser should succeed on+ s ->+ Expectation p `shouldSucceedOn` s = shouldSucceed (p s) ----------------------------------------------------------------------------@@ -123,48 +137,56 @@ -- 'ParseError' to compare with. -- -- > parse (char 'x') "" "b" `shouldFailWith` err posI (utok 'b' <> etok 'x')--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+shouldFailWith ::+ ( HasCallStack,+ ShowErrorComponent e,+ Stream s,+ VisualStream s,+ TraversableStream s,+ Show a,+ Eq e+ ) =>+ -- | The result of parsing+ Either (ParseErrorBundle s e) a ->+ -- | Expected parse errors+ ParseError s e ->+ Expectation r `shouldFailWith` perr1 = r `shouldFailWithM` [perr1] --- | Similar to 'shouldFailWith', but allows to check parsers that can+-- | Similar to 'shouldFailWith', but allows us 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+shouldFailWithM ::+ ( HasCallStack,+ ShowErrorComponent e,+ Stream s,+ VisualStream s,+ TraversableStream s,+ Show a,+ Eq e+ ) =>+ -- | The result of parsing+ Either (ParseErrorBundle s e) a ->+ -- | 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+ [ParseError s e] ->+ Expectation r `shouldFailWithM` perrs1' = case r of Left e0 ->- let e1 = e0 { bundleErrors = perrs1 }+ 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+ 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 ---------------------------------------------------------------------------- -- Incremental parsing@@ -177,19 +199,19 @@ -- > `failsLeaving` "a" -- -- See also: 'initialState'.--failsLeaving- :: ( HasCallStack- , Show a- , Eq s- , Show s- )- => (State s e, 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 = do+failsLeaving ::+ ( HasCallStack,+ Show a,+ Eq s,+ Show s+ ) =>+ -- | Parser that takes stream and produces result along with actual+ -- state information+ (State s e, Either (ParseErrorBundle s e) a) ->+ -- | Part of input that should be left unconsumed+ s ->+ Expectation+(st, r) `failsLeaving` s = do shouldFail r checkUnconsumed s (stateInput st) @@ -201,102 +223,112 @@ -- > `succeedsLeaving` "a" -- -- See also: 'initialState'.--succeedsLeaving- :: ( HasCallStack- , Show a- , Eq s- , Show s- , ShowErrorComponent e- , Stream s- )- => (State s e, 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 = do+succeedsLeaving ::+ ( HasCallStack,+ Show a,+ Eq s,+ Show s,+ ShowErrorComponent e,+ Stream s,+ VisualStream s,+ TraversableStream s+ ) =>+ -- | Parser that takes stream and produces result along with actual+ -- state information+ (State s e, Either (ParseErrorBundle s e) a) ->+ -- | Part of input that should be left unconsumed+ s ->+ Expectation+(st, r) `succeedsLeaving` s = do shouldSucceed r checkUnconsumed s (stateInput st) -- | Given input for parsing, construct initial state for parser.- initialState :: s -> State s e-initialState s = State- { stateInput = s- , stateOffset = 0- , statePosState = initialPosState s- , stateParseErrors = []- }+initialState s =+ State+ { stateInput = s,+ stateOffset = 0,+ statePosState = initialPosState s,+ stateParseErrors = []+ } -- | 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 = ""- }+initialPosState s =+ PosState+ { pstateInput = s,+ pstateOffset = 0,+ pstateSourcePos = initialPos "",+ pstateTabWidth = defaultTabWidth,+ pstateLinePrefix = ""+ } ---------------------------------------------------------------------------- -- Helpers -- | Expect that the argument is a result of a failed parser.--shouldFail- :: (HasCallStack, Show a)- => Either (ParseErrorBundle s e) a- -> Expectation+shouldFail ::+ (HasCallStack, Show a) =>+ Either (ParseErrorBundle s e) a ->+ Expectation shouldFail r = case r of Left _ -> return ()- Right v -> expectationFailure $- "the parser is expected to fail, but it parsed: " ++ show v+ Right v ->+ expectationFailure $+ "the parser is expected to fail, but it parsed: " ++ show v -- | Expectation that argument is result of a succeeded parser.--shouldSucceed- :: ( HasCallStack- , ShowErrorComponent e- , Stream s- , Show a- )- => Either (ParseErrorBundle s e) a- -> Expectation+shouldSucceed ::+ ( HasCallStack,+ ShowErrorComponent e,+ Stream s,+ VisualStream s,+ TraversableStream 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" ++- showBundle e+ Left e ->+ expectationFailure $+ "the parser is expected to succeed, but it failed with:\n"+ ++ showBundle e Right _ -> return () -- | Compare two streams for equality and in the case of mismatch report it.--checkUnconsumed- :: ( HasCallStack- , Eq s- , Show s- )- => s -- ^ Expected unconsumed input- -> s -- ^ Actual unconsumed input- -> Expectation-checkUnconsumed e a = unless (e == a) . expectationFailure $- "the parser is expected to leave unconsumed input: " ++ show e ++- "\nbut it left this: " ++ show a+checkUnconsumed ::+ ( HasCallStack,+ Eq s,+ Show s+ ) =>+ -- | Expected unconsumed input+ s ->+ -- | Actual unconsumed input+ s ->+ Expectation+checkUnconsumed e a =+ unless (e == a) . expectationFailure $+ "the parser is expected to leave unconsumed input: "+ ++ show e+ ++ "\nbut it left this: "+ ++ show a -- | Render a parse error bundle in a way that is suitable for inserting it -- in a test suite report.--showBundle- :: ( ShowErrorComponent e- , Stream s- )- => ParseErrorBundle s e- -> String+showBundle ::+ ( ShowErrorComponent e,+ Stream s,+ VisualStream s,+ TraversableStream s+ ) =>+ ParseErrorBundle s e ->+ String showBundle = unlines . fmap indent . lines . errorBundlePretty where- indent x = if null x- then x- else " " ++ x+ indent x =+ if null x+ then x+ else " " ++ x
hspec-megaparsec.cabal view
@@ -1,57 +1,61 @@-name: hspec-megaparsec-version: 2.1.0-cabal-version: 1.18-tested-with: GHC==8.4.4, GHC==8.6.5, GHC==8.8.1-license: BSD3-license-file: LICENSE.md-author: Mark Karpov <markkarpov92@gmail.com>-maintainer: Mark Karpov <markkarpov92@gmail.com>-homepage: https://github.com/mrkkrp/hspec-megaparsec-bug-reports: https://github.com/mrkkrp/hspec-megaparsec/issues-category: Testing, Parsing-synopsis: Utility functions for testing Megaparsec parsers with Hspec-build-type: Simple-description: Utility functions for testing Megaparsec parsers with Hspec.-extra-doc-files: CHANGELOG.md- , README.md+cabal-version: 2.4+name: hspec-megaparsec+version: 2.2.1+license: BSD-3-Clause+license-file: LICENSE.md+maintainer: Mark Karpov <markkarpov92@gmail.com>+author: Mark Karpov <markkarpov92@gmail.com>+tested-with: ghc ==9.4.7 ghc ==9.6.3 ghc ==9.8.1+homepage: https://github.com/mrkkrp/hspec-megaparsec+bug-reports: https://github.com/mrkkrp/hspec-megaparsec/issues+synopsis: Utility functions for testing Megaparsec parsers with Hspec+description:+ Utility functions for testing Megaparsec parsers with Hspec. +category: Testing, Parsing+build-type: Simple+extra-doc-files:+ CHANGELOG.md+ README.md++source-repository head+ type: git+ location: https://github.com/mrkkrp/hspec-megaparsec.git+ flag dev- description: Turn on development settings.- manual: True- default: False+ description: Turn on development settings.+ default: False+ manual: True library- build-depends: base >= 4.11 && < 5.0- , containers >= 0.5 && < 0.7- , hspec-expectations >= 0.8 && < 0.9- , megaparsec >= 8.0 && < 9.0- exposed-modules: Test.Hspec.Megaparsec- if flag(dev)- ghc-options: -Wall -Werror- else- ghc-options: -Wall- if flag(dev)- ghc-options: -Wcompat- -Wincomplete-record-updates- -Wincomplete-uni-patterns- -Wnoncanonical-monad-instances- default-language: Haskell2010+ exposed-modules: Test.Hspec.Megaparsec+ default-language: GHC2021+ build-depends:+ base >=4.15 && <5,+ hspec-expectations >=0.8 && <0.9,+ megaparsec >=9 && <10 + if flag(dev)+ ghc-options: -Wall -Werror -Wpartial-fields -Wunused-packages++ else+ ghc-options: -Wall+ test-suite tests- main-is: Main.hs- hs-source-dirs: tests- type: exitcode-stdio-1.0- if flag(dev)- ghc-options: -Wall -Werror- else- ghc-options: -Wall- build-depends: base >= 4.11 && < 5.0- , hspec >= 2.0 && < 3.0- , hspec-expectations >= 0.8 && < 0.9- , hspec-megaparsec- , megaparsec >= 8.0 && < 9.0- default-language: Haskell2010+ type: exitcode-stdio-1.0+ main-is: Main.hs+ hs-source-dirs: tests+ default-language: GHC2021+ build-depends:+ base >=4.15 && <5,+ hspec >=2 && <3,+ hspec-megaparsec,+ megaparsec >=9 && <10 -source-repository head- type: git- location: https://github.com/mrkkrp/hspec-megaparsec.git+ if flag(dev)+ ghc-options:+ -Wall -Werror -Wredundant-constraints -Wpartial-fields+ -Wunused-packages++ else+ ghc-options: -Wall
tests/Main.hs view
@@ -1,5 +1,3 @@-{-# LANGUAGE CPP #-}- module Main (main) where import Data.Void@@ -8,14 +6,9 @@ import Text.Megaparsec import Text.Megaparsec.Char -#if !MIN_VERSION_base(4,13,0)-import Data.Semigroup ((<>))-#endif- type Parser = Parsec Void String -- | Toy tests, just an example of usage.- main :: IO () main = hspec $ do describe "shouldParse" $@@ -33,8 +26,8 @@ parse (char 'x' :: Parser Char) "" `shouldSucceedOn` "x" describe "shouldFailWith" $ it "works" $- parse (char 'x' :: Parser Char) "" "b" `shouldFailWith`- err 0 (utok 'b' <> etok 'x')+ parse (char 'x' :: Parser Char) "" "b"+ `shouldFailWith` err 0 (utok 'b' <> etok 'x') describe "failsLeaving" $ it "works" $ runParser' (many (char 'x') <* eof :: Parser String) (initialState "xxa")