hspec-megaparsec 1.0.0 → 2.2.1
raw patch · 7 files changed
Files
- CHANGELOG.md +34/−0
- LICENSE.md +1/−1
- README.md +14/−10
- Setup.hs +0/−6
- Test/Hspec/Megaparsec.hs +244/−124
- hspec-megaparsec.cabal +52/−55
- tests/Main.hs +2/−10
CHANGELOG.md view
@@ -1,3 +1,37 @@+## 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.++* Dropped support for GHC 8.2.++## Hspec Megaparsec 2.0.1++* Adjusted `shouldParse` to use `shouldBe` from `hspec` under the hood to+ take advantage of its pretty colorful error reporting.++* Dropped support for GHC 8.0 and older.++## 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+ locations where test failures happen.+ ## Hspec Megaparsec 1.0.0 * To be used with Megaparsec 6.
LICENSE.md view
@@ -1,4 +1,4 @@-Copyright © 2016–2017 Mark Karpov+Copyright © 2016–present Mark Karpov All rights reserved.
README.md view
@@ -4,21 +4,25 @@ [](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)-[](https://coveralls.io/github/mrkkrp/hspec-megaparsec?branch=master)+ -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.+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). Consult the Haddocks for usage, which should be trivial. Also see test suite-of this package or-[Megaparsec test suite](https://github.com/mrkkrp/megaparsec/tree/master/tests).+of this package or [Megaparsec test+suite](https://github.com/mrkkrp/megaparsec/tree/master/tests). +## Contribution++Issues, bugs, and questions may be reported in [the GitHub issue tracker for+this project](https://github.com/mrkkrp/hspec-megaparsec/issues).++Pull requests are also welcome.+ ## License -Copyright © 2016–2017 Mark Karpov+Copyright © 2016–present Mark Karpov Distributed under BSD 3 clause license.
− Setup.hs
@@ -1,6 +0,0 @@-module Main (main) where--import Distribution.Simple--main :: IO ()-main = defaultMain
Test/Hspec/Megaparsec.hs view
@@ -1,6 +1,12 @@+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies #-}+ -- | -- Module : Test.Hspec.Megaparsec--- Copyright : © 2016–2017 Mark Karpov+-- Copyright : © 2016–present Mark Karpov -- License : BSD 3 clause -- -- Maintainer : Mark Karpov <markkarpov92@gmail.com>@@ -8,31 +14,30 @@ -- Portability : portable -- -- Utility functions for testing Megaparsec parsers with Hspec.--{-# LANGUAGE CPP #-}-{-# 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+ shouldFailWith,+ shouldFailWithM,+ -- * Incremental parsing- , failsLeaving- , succeedsLeaving- , initialState+ 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 (NonEmpty (..))+import Data.List.NonEmpty qualified as NE import Test.Hspec.Expectations import Text.Megaparsec import Text.Megaparsec.Error.Builder@@ -43,55 +48,85 @@ -- | Create an expectation by saying what the result should be. -- -- > parse letterChar "" "x" `shouldParse` 'x'--shouldParse :: (Ord t, ShowToken t, ShowErrorComponent e, Eq a, Show a)- => Either (ParseError t 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" ++ showParseError e- Right x -> unless (x == v) . expectationFailure $- "expected: " ++ show v ++ "\nbut got: " ++ show x+ 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 :: (Ord t, ShowToken t, ShowErrorComponent e, Show a)- => Either (ParseError t 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" ++ showParseError 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 :: Show a- => (s -> Either (ParseError t 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 :: (Ord t, ShowToken t, ShowErrorComponent e, Show a)- => (s -> Either (ParseError t 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) ----------------------------------------------------------------------------@@ -102,17 +137,56 @@ -- 'ParseError' to compare with. -- -- > parse (char 'x') "" "b" `shouldFailWith` err posI (utok 'b' <> etok 'x')+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] -shouldFailWith :: (Ord t, ShowToken t, ShowErrorComponent e, Show a)- => Either (ParseError t e) a- -> ParseError t e- -> 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'- Right v -> expectationFailure $- "the parser is expected to fail, but it parsed: " ++ show v+-- | 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,+ 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}+ 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 ---------------------------------------------------------------------------- -- Incremental parsing@@ -125,15 +199,21 @@ -- > `failsLeaving` "a" -- -- See also: 'initialState'.--failsLeaving :: (Show a, Eq s, Show s, Stream s)- => (State s, Either (ParseError (Token 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)+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) -- | Check that a parser succeeds and leaves certain part of input -- unconsumed. Use it with functions like 'runParser'' and 'runParserT''@@ -143,72 +223,112 @@ -- > `succeedsLeaving` "a" -- -- See also: 'initialState'.--succeedsLeaving :: ( ShowToken (Token s)- , ShowErrorComponent e- , Show a- , Eq s- , Show s- , Stream s )- => (State s, Either (ParseError (Token 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)+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 (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 e+initialState s =+ State+ { stateInput = s,+ stateOffset = 0,+ statePosState = initialPosState s,+ stateParseErrors = []+ } -initialState :: s -> State s-initialState s = State- { stateInput = s- , statePos = initialPos "" :| []-#if MIN_VERSION_megaparsec(5,2,0)- , stateTokensProcessed = 0-#endif- , stateTabWidth = defaultTabWidth }+-- | 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.--shouldFail :: Show a- => Either (ParseError t e) a- -> Expectation+-- | Expect that the argument is a result of a failed parser.+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 :: (Ord t, ShowToken t, ShowErrorComponent e, Show a)- => Either (ParseError t 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" ++- showParseError 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 :: (Eq s, Show s, Stream 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---- | Render parse error in a way that is suitable for inserting it in a test--- suite report.+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 -showParseError :: (Ord t, ShowToken t, ShowErrorComponent e)- => ParseError t e- -> String-showParseError = unlines . fmap (" " ++) . lines . parseErrorPretty+-- | Render a parse error bundle in a way that is suitable for inserting it+-- in a test suite report.+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
hspec-megaparsec.cabal view
@@ -1,64 +1,61 @@-name: hspec-megaparsec-version: 1.0.0-cabal-version: >= 1.18-tested-with: GHC==7.8.4, GHC==7.10.3, GHC==8.0.2, GHC==8.2.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.7 && < 5.0- , containers >= 0.5 && < 0.6- , hspec-expectations >= 0.5 && < 0.9- , megaparsec >= 6.0 && < 7.0- if !impl(ghc >= 7.8)- build-depends: tagged == 0.8.*- if !impl(ghc >= 8.0)- build-depends: semigroups == 0.18.*+ exposed-modules: Test.Hspec.Megaparsec+ default-language: GHC2021+ build-depends:+ base >=4.15 && <5,+ hspec-expectations >=0.8 && <0.9,+ megaparsec >=9 && <10 - exposed-modules: Test.Hspec.Megaparsec- if flag(dev)- ghc-options: -Wall -Werror- else- ghc-options: -Wall- default-language: Haskell2010+ 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.7 && < 5.0- , hspec >= 2.0 && < 3.0- , hspec-expectations >= 0.5 && < 0.9- , hspec-megaparsec- , megaparsec >= 6.0 && < 7.0- if !impl(ghc >= 7.8)- build-depends: tagged == 0.8.*- if !impl(ghc >= 7.10)- build-depends: void == 0.7.*- if !impl(ghc >= 8.0)- build-depends: semigroups == 0.18.*+ 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 - default-language: Haskell2010+ if flag(dev)+ ghc-options:+ -Wall -Werror -Wredundant-constraints -Wpartial-fields+ -Wunused-packages -source-repository head- type: git- location: https://github.com/mrkkrp/hspec-megaparsec.git+ else+ ghc-options: -Wall
tests/Main.hs view
@@ -1,22 +1,14 @@-{-# LANGUAGE CPP #-}- module Main (main) where -import Data.Semigroup ((<>)) import Data.Void import Test.Hspec import Test.Hspec.Megaparsec import Text.Megaparsec import Text.Megaparsec.Char -#if !MIN_VERSION_base(4,8,0)-import Control.Applicative ((<*))-#endif- type Parser = Parsec Void String -- | Toy tests, just an example of usage.- main :: IO () main = hspec $ do describe "shouldParse" $@@ -34,8 +26,8 @@ parse (char 'x' :: Parser Char) "" `shouldSucceedOn` "x" describe "shouldFailWith" $ it "works" $- parse (char 'x' :: Parser Char) "" "b" `shouldFailWith`- err posI (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")