diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -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. diff --git a/LICENSE.md b/LICENSE.md --- a/LICENSE.md +++ b/LICENSE.md @@ -1,4 +1,4 @@ -Copyright © 2016–2017 Mark Karpov +Copyright © 2016–present Mark Karpov All rights reserved. diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -4,21 +4,25 @@ [![Hackage](https://img.shields.io/hackage/v/hspec-megaparsec.svg?style=flat)](https://hackage.haskell.org/package/hspec-megaparsec) [![Stackage Nightly](http://stackage.org/package/hspec-megaparsec/badge/nightly)](http://stackage.org/nightly/package/hspec-megaparsec) [![Stackage LTS](http://stackage.org/package/hspec-megaparsec/badge/lts)](http://stackage.org/lts/package/hspec-megaparsec) -[![Build Status](https://travis-ci.org/mrkkrp/hspec-megaparsec.svg?branch=master)](https://travis-ci.org/mrkkrp/hspec-megaparsec) -[![Coverage Status](https://coveralls.io/repos/mrkkrp/hspec-megaparsec/badge.svg?branch=master&service=github)](https://coveralls.io/github/mrkkrp/hspec-megaparsec?branch=master) +![CI](https://github.com/mrkkrp/hspec-megaparsec/workflows/CI/badge.svg?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. diff --git a/Setup.hs b/Setup.hs deleted file mode 100644 --- a/Setup.hs +++ /dev/null @@ -1,6 +0,0 @@ -module Main (main) where - -import Distribution.Simple - -main :: IO () -main = defaultMain diff --git a/Test/Hspec/Megaparsec.hs b/Test/Hspec/Megaparsec.hs --- a/Test/Hspec/Megaparsec.hs +++ b/Test/Hspec/Megaparsec.hs @@ -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 @@ -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 diff --git a/hspec-megaparsec.cabal b/hspec-megaparsec.cabal --- a/hspec-megaparsec.cabal +++ b/hspec-megaparsec.cabal @@ -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 -maintainer: Mark Karpov -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 +author: Mark Karpov +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 diff --git a/tests/Main.hs b/tests/Main.hs --- a/tests/Main.hs +++ b/tests/Main.hs @@ -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")