diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,7 @@ +## Hspec Megaparsec 2.2.0 + +* Works with Megaparsec 9. + ## Hspec Megaparsec 2.1.0 * Works with Megaparsec 8. diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -4,7 +4,7 @@ [![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) +![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 diff --git a/Test/Hspec/Megaparsec.hs b/Test/Hspec/Megaparsec.hs --- a/Test/Hspec/Megaparsec.hs +++ b/Test/Hspec/Megaparsec.hs @@ -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 qualified Data.List.NonEmpty 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,84 @@ -- | 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 +136,55 @@ -- '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 -- 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 +197,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 +221,111 @@ -- > `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 diff --git a/hspec-megaparsec.cabal b/hspec-megaparsec.cabal --- a/hspec-megaparsec.cabal +++ b/hspec-megaparsec.cabal @@ -1,57 +1,66 @@ -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 -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: 1.18 +name: hspec-megaparsec +version: 2.2.0 +license: BSD3 +license-file: LICENSE.md +maintainer: Mark Karpov +author: Mark Karpov +tested-with: ghc ==8.6.5 ghc ==8.8.4 ghc ==8.10.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: Haskell2010 + build-depends: + base >=4.12 && <5.0, + containers >=0.5 && <0.7, + hspec-expectations >=0.8 && <0.9, + megaparsec >=9.0 && <10.0 + 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 + 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: Haskell2010 + build-depends: + base >=4.12 && <5.0, + hspec >=2.0 && <3.0, + hspec-expectations >=0.8 && <0.9, + hspec-megaparsec -any, + megaparsec >=9.0 && <10.0 -source-repository head - type: git - location: https://github.com/mrkkrp/hspec-megaparsec.git + if flag(dev) + ghc-options: -Wall -Werror + + else + ghc-options: -Wall diff --git a/tests/Main.hs b/tests/Main.hs --- a/tests/Main.hs +++ b/tests/Main.hs @@ -15,7 +15,6 @@ type Parser = Parsec Void String -- | Toy tests, just an example of usage. - main :: IO () main = hspec $ do describe "shouldParse" $ @@ -33,8 +32,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")