hspec-megaparsec 0.2.1 → 0.3.0
raw patch · 4 files changed
+201/−16 lines, 4 filesdep +taggeddep ~hspec-megaparsec
Dependencies added: tagged
Dependency ranges changed: hspec-megaparsec
Files
- CHANGELOG.md +6/−0
- README.md +6/−4
- Test/Hspec/Megaparsec.hs +182/−9
- hspec-megaparsec.cabal +7/−3
CHANGELOG.md view
@@ -1,3 +1,9 @@+## Hspec Megaparec 0.3.0++* Added helpers for parse error construction (useful with `shouldFailWith`):+ `err`, `posI`, `posN`, `utok`, `utoks`, `ulabel`, `ueof`, `etok`, `etoks`,+ `elabel`, `eeof`, `cstm`. Also added an auxiliary type `EC`.+ ## Hspec Megaparsec 0.2.1 * Refreshed obsolete documentation for `shouldFailWith` and how it reports
README.md view
@@ -7,12 +7,14 @@ [](https://travis-ci.org/mrkkrp/hspec-megaparsec) [](https://coveralls.io/github/mrkkrp/hspec-megaparsec?branch=master) -The package provides utilities for testing-[`Megaparsec`](https://hackage.haskell.org/package/megaparsec) parsers with with-[`Hspec`](https://hackage.haskell.org/package/hspec).+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. Consult Haddocks for usage, which should be trivial. Also see test suite of-this package.+this package or [Megaparsec test suite](https://github.com/mrkkrp/megaparsec/tree/master/tests). ## License
Test/Hspec/Megaparsec.hs view
@@ -9,7 +9,14 @@ -- -- Utility functions for testing Megaparsec parsers with Hspec. -{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies #-} module Test.Hspec.Megaparsec ( -- * Basic expectations@@ -19,6 +26,21 @@ , shouldFailOn -- * Testing of error messages , shouldFailWith+ -- * Error message construction+ -- $errmsg+ , err+ , posI+ , posN+ , EC+ , utok+ , utoks+ , ulabel+ , ueof+ , etok+ , etoks+ , elabel+ , eeof+ , cstm -- * Incremental parsing , failsLeaving , succeedsLeaving@@ -26,10 +48,18 @@ where import Control.Monad (unless)+import Data.Data (Data) import Data.List.NonEmpty (NonEmpty (..))+import Data.Proxy+import Data.Semigroup+import Data.Set (Set)+import Data.Typeable (Typeable)+import GHC.Generics import Test.Hspec.Expectations import Text.Megaparsec import Text.Megaparsec.Pos (defaultTabWidth)+import qualified Data.List.NonEmpty as NE+import qualified Data.Set as E ---------------------------------------------------------------------------- -- Basic expectations@@ -92,15 +122,10 @@ -- Testing of error messages -- | Create an expectation that parser should fail producing certain--- 'ParseError'. Use functions from "Text.Megaparsec.Error" to construct--- parse errors to check against. See "Text.Megaparsec.Pos" for functions to--- construct textual positions.+-- 'ParseError'. Use the 'err' function from this module to construct a+-- 'ParseError' to compare with. ----- > parse (char 'x') "" "b" `shouldFailWith` ParseError--- > { errorPos = initialPos "" :| []--- > , errorUnexpected = Set.singleton (Tokens $ 'b' :| [])--- > , errorExpected = Set.singleton (Tokens $ 'x' :| [])--- > , errorCustom = Set.empty }+-- > parse (char 'x') "" "b" `shouldFailWith` err posI (utok 'b' <> etok 'x') shouldFailWith :: (Ord t, ShowToken t, ShowErrorComponent e, Show a) => Either (ParseError t e) a@@ -114,6 +139,139 @@ "the parser is expected to fail, but it parsed: " ++ show v ----------------------------------------------------------------------------+-- Error message construction++-- $errmsg When you wish to test error message on failure, the need to+-- construct a error message for comparison arises. These helpers allow to+-- construct virtually any sort of error message easily.++-- | Assemble a 'ParseErorr' from source position and @'EC' t e@ value. To+-- create source position, two helpers are available: 'posI' and 'posN'.+-- @'EC' t e@ is a monoid and can be built from primitives provided by this+-- module, see below.+--+-- @since 0.3.0++err+ :: NonEmpty SourcePos -- ^ 'ParseError' position+ -> EC t e -- ^ Error components+ -> ParseError t e -- ^ Resulting 'ParseError'+err pos (EC u e c) = ParseError pos u e c++-- | Initial source position with empty file name.+--+-- @since 0.3.0++posI :: NonEmpty SourcePos+posI = initialPos "" :| []++-- | @posN n s@ returns source position achieved by applying 'updatePos'+-- method corresponding to type of stream @s@ @n@ times.+--+-- @since 0.3.0++posN :: forall s n. (Stream s, Integral n)+ => n+ -> s+ -> NonEmpty SourcePos+posN n see = f (initialPos "") see n :| []+ where+ f p s !i =+ if i > 0+ then case uncons s of+ Nothing -> p+ Just (t,s') ->+ let p' = snd $ updatePos (Proxy :: Proxy s) defaultTabWidth p t+ in f p' s' (i - 1)+ else p++-- | Auxiliary type for construction of 'ParseError's. Note that it's a+-- monoid.+--+-- @since 0.3.0++data EC t e = EC+ { ecUnexpected :: Set (ErrorItem t) -- ^ Unexpected items+ , ecExpected :: Set (ErrorItem t) -- ^ Expected items+ , _ecCustom :: Set e -- ^ Custom items+ } deriving (Eq, Data, Typeable, Generic)++instance (Ord t, Ord e) => Semigroup (EC t e) where+ (EC u0 e0 c0) <> (EC u1 e1 c1) =+ EC (E.union u0 u1) (E.union e0 e1) (E.union c0 c1)++instance (Ord t, Ord e) => Monoid (EC t e) where+ mempty = EC E.empty E.empty E.empty+ mappend = (<>)++-- | Construct “unexpected token” error component.+--+-- @since 0.3.0++utok :: (Ord t, Ord e) => t -> EC t e+utok t = mempty { ecUnexpected = (E.singleton . Tokens . nes) t }++-- | Construct “unexpected tokens” error component. Empty string produces+-- 'EndOfInput'.+--+-- @since 0.3.0++utoks :: (Ord t, Ord e) => [t] -> EC t e+utoks t = mempty { ecUnexpected = (E.singleton . canonicalizeTokens) t }++-- | Construct “unexpected label” error component. Do not use with empty+-- strings (for empty strings it's bottom).+--+-- @since 0.3.0++ulabel :: (Ord t, Ord e) => String -> EC t e+ulabel l = mempty { ecUnexpected = (E.singleton . Label . NE.fromList) l }++-- | Construct “unexpected end of input” error component.+--+-- @since 0.3.0++ueof :: (Ord t, Ord e) => EC t e+ueof = mempty { ecUnexpected = E.singleton EndOfInput }++-- | Construct “expected token” error component.+--+-- @since 0.3.0++etok :: (Ord t, Ord e) => t -> EC t e+etok t = mempty { ecExpected = (E.singleton . Tokens . nes) t }++-- | Construct “expected tokens” error component. Empty string produces+-- 'EndOfInput'.+--+-- @since 0.3.0++etoks :: (Ord t, Ord e) => [t] -> EC t e+etoks t = mempty { ecExpected = (E.singleton . canonicalizeTokens) t }++-- | Construct “expected label” error component. Do not use with empty+-- strings.+--+-- @since 0.3.0++elabel :: (Ord t, Ord e) => String -> EC t e+elabel l = mempty { ecExpected = (E.singleton . Label . NE.fromList) l }++-- | Construct “expected end of input” error component.+--+-- @since 0.3.0++eeof :: (Ord t, Ord e) => EC t e+eeof = mempty { ecExpected = E.singleton EndOfInput }++-- | Construct custom error component.+--+-- @since 0.3.0++cstm :: e -> EC t e+cstm e = EC E.empty E.empty (E.singleton e)++---------------------------------------------------------------------------- -- Incremental parsing -- | Check that a parser fails and leaves certain part of input@@ -201,3 +359,18 @@ showParseError :: (Ord t, ShowToken t, ShowErrorComponent e) => ParseError t e -> String showParseError = unlines . fmap (" " ++) . lines . parseErrorPretty++-- | Make a singleton non-empty list from a value.++nes :: a -> NonEmpty a+nes x = x :| []+{-# INLINE nes #-}++-- | Construct appropriate 'ErrorItem' representation for given token+-- stream. Empty string produces 'EndOfInput'.++canonicalizeTokens :: [t] -> ErrorItem t+canonicalizeTokens ts =+ case NE.nonEmpty ts of+ Nothing -> EndOfInput+ Just xs -> Tokens xs
hspec-megaparsec.cabal view
@@ -31,7 +31,7 @@ -- POSSIBILITY OF SUCH DAMAGE. name: hspec-megaparsec-version: 0.2.1+version: 0.3.0 cabal-version: >= 1.10 license: BSD3 license-file: LICENSE.md@@ -43,7 +43,7 @@ synopsis: Utility functions for testing Megaparsec parsers with Hspec build-type: Simple description: Utility functions for testing Megaparsec parsers with Hspec.-extra-source-files: CHANGELOG.md+extra-doc-files: CHANGELOG.md , README.md flag dev@@ -59,6 +59,8 @@ if !impl(ghc >= 8.0) build-depends: semigroups == 0.18.*+ if !impl(ghc >= 7.8)+ build-depends: tagged == 0.8.* exposed-modules: Test.Hspec.Megaparsec if flag(dev)@@ -79,10 +81,12 @@ , containers >= 0.5 && < 0.6 , hspec >= 2.0 && < 3.0 , hspec-expectations >= 0.5 && < 0.8- , hspec-megaparsec >= 0.2.1+ , hspec-megaparsec >= 0.3.0 , megaparsec >= 5.0 && < 6.0 if !impl(ghc >= 8.0) build-depends: semigroups == 0.18.*+ if !impl(ghc >= 7.8)+ build-depends: tagged == 0.8.* default-language: Haskell2010