assists #21 -- stack test gives prettier error messages

mengwong/mp/src/Error.hs

@@ -21,6 +21,12 @@ import Data.Vector (imap, foldl')
 import qualified Data.Text.Lazy as Text
 import Control.Arrow ((>>>))
 
+data Custom = MyCustom String
+  deriving (Eq, Show, Ord)
+
+instance ShowErrorComponent Custom where
+  showErrorComponent (MyCustom str) = str
+
 -- custom version of https://hackage.haskell.org/package/megaparsec-9.2.0/docs/src/Text.Megaparsec.Error.html#errorBundlePretty
 errorBundlePrettyCustom ::
   forall e .

mengwong/mp/test/Spec.hs

@@ -3,16 +3,40 @@
 module Main where
 
 import Test.Hspec
-import Test.Hspec.Megaparsec
+import Test.Hspec.Megaparsec hiding (shouldParse)
 import Text.Megaparsec
 import Lib
 import AnyAll
 import Types
+import Error
 import qualified Data.ByteString.Lazy as BS
 import Control.Monad.Reader (ReaderT(runReaderT))
 import System.Environment (lookupEnv)
 
 
+
+-- | Create an expectation by saying what the result should be.
+--
+-- > parse letterChar "" "x" `shouldParse` 'x'
+shouldParse ::
+  ( HasCallStack,
+    ShowErrorComponent e,
+    Show a,
+    Eq a
+  ) =>
+  -- | Result of parsing as returned by function like 'parse'
+  Either (ParseErrorBundle MyStream e) a ->
+  -- | Desired result
+  a ->
+  Expectation
+r `shouldParse` v = case r of
+  Left e ->
+    expectationFailure $
+      "expected: " ++ show v
+        ++ "\nbut parsing failed with error:\n"
+        ++ errorBundlePrettyCustom e
+  Right x -> x `shouldBe` v
+
 main :: IO ()
 main = do
   mpd <- lookupEnv "MP_DEBUG"