Use Megaparsec 6 (#2)

CHANGELOG.md

@@ -1,3 +1,7 @@
+## Hspec Megaparsec 1.0.0
+
+* To be used with Megaparsec 6.
+
 ## Hspec Megaparsec 0.3.1
 
 * Support for Megaparsec 5.2.0.

Test/Hspec/Megaparsec.hs

@@ -9,10 +9,7 @@
 --
 -- Utility functions for testing Megaparsec parsers with Hspec.
 
-{-# LANGUAGE BangPatterns        #-}
 {-# LANGUAGE CPP                 #-}
-{-# LANGUAGE DeriveDataTypeable  #-}
-{-# LANGUAGE DeriveGeneric       #-}
 {-# LANGUAGE FlexibleContexts    #-}
 {-# LANGUAGE RankNTypes          #-}
 {-# LANGUAGE ScopedTypeVariables #-}
@@ -26,40 +23,19 @@ module Test.Hspec.Megaparsec
   , 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
-  , initialState )
+  , initialState
+    -- * Re-exports
+  , module Text.Megaparsec.Error.Builder )
 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
+import Text.Megaparsec.Error.Builder
 
 ----------------------------------------------------------------------------
 -- Basic expectations
@@ -138,141 +114,6 @@ r `shouldFailWith` e = case r of
   Right v -> expectationFailure $
     "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 an “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 an “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 an “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 an “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 an “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 an “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 an “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 an “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 a custom error component.
---
--- @since 0.3.0
-
-cstm :: e -> EC t e
-cstm e = EC E.empty E.empty (E.singleton e)
-
 ----------------------------------------------------------------------------
 -- Incremental parsing
 
@@ -368,20 +209,6 @@ checkUnconsumed e a = unless (e == a) . expectationFailure $
 -- suite report.
 
 showParseError :: (Ord t, ShowToken t, ShowErrorComponent e)
-  => ParseError t e -> String
+  => 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

@@ -24,12 +24,11 @@ library
   build-depends:      base               >= 4.7 && < 5.0
                     , containers         >= 0.5 && < 0.6
                     , hspec-expectations >= 0.5 && < 0.9
-                    , megaparsec         >= 5.0 && < 6.0
-
-  if !impl(ghc >= 8.0)
-    build-depends:    semigroups         == 0.18.*
+                    , 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
   if flag(dev)
@@ -47,15 +46,16 @@ test-suite tests
   else
     ghc-options:      -Wall
   build-depends:      base               >= 4.7 && < 5.0
-                    , containers         >= 0.5 && < 0.6
                     , hspec              >= 2.0 && < 3.0
                     , hspec-expectations >= 0.5 && < 0.9
                     , hspec-megaparsec
-                    , megaparsec         >= 5.0 && < 6.0
-  if !impl(ghc >= 8.0)
-    build-depends:    semigroups         == 0.18.*
+                    , 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.*
 
   default-language:   Haskell2010
 

stack.yaml

@@ -1,3 +1,5 @@
-resolver: lts-8.15
+resolver: lts-9.0
 packages:
 - '.'
+extra-deps:
+- megaparsec-6.0.0

tests/Main.hs

@@ -2,17 +2,19 @@
 
 module Main (main) where
 
-import Data.List.NonEmpty (NonEmpty (..))
+import Data.Semigroup ((<>))
+import Data.Void
 import Test.Hspec
 import Test.Hspec.Megaparsec
 import Text.Megaparsec
-import Text.Megaparsec.String
-import qualified Data.Set as E
+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 ()
@@ -33,11 +35,7 @@ main = hspec $ do
   describe "shouldFailWith" $
     it "works" $
       parse (char 'x' :: Parser Char) "" "b" `shouldFailWith`
-        ParseError
-          { errorPos        = initialPos "" :| []
-          , errorUnexpected = E.singleton (Tokens $ 'b' :| [])
-          , errorExpected   = E.singleton (Tokens $ 'x' :| [])
-          , errorCustom     = E.empty }
+        err posI (utok 'b' <> etok 'x')
   describe "failsLeaving" $
     it "works" $
       runParser' (many (char 'x') <* eof :: Parser String) (initialState "xxa")