lib: improve expectParseEq (#812)

Show a pretty parse error, and avoid sequenced scopes
which are confusing (you can't run only the second).
This commit is contained in:
Simon Michael 2018-08-16 05:57:43 +01:00
parent 09d8e302db
commit 536eadb809

View File

@ -5,6 +5,8 @@ module Hledger.Utils.Test where
import Control.Exception import Control.Exception
import Control.Monad import Control.Monad
import Control.Monad.State.Strict (StateT)
--import Control.Monad.State.Strict (evalStateT)
import Data.Functor.Identity import Data.Functor.Identity
import Data.List import Data.List
import qualified Data.Text as T import qualified Data.Text as T
@ -14,6 +16,7 @@ import System.Exit
import System.IO import System.IO
import Test.HUnit as HUnit import Test.HUnit as HUnit
import Text.Megaparsec import Text.Megaparsec
import Text.Megaparsec.Custom
import Hledger.Utils.Debug (pshow) import Hledger.Utils.Debug (pshow)
import Hledger.Utils.Parse (parseWithState) import Hledger.Utils.Parse (parseWithState)
@ -90,11 +93,16 @@ runEasyTests args easytests = (do
) )
`catch` (\(_::ExitCode) -> return True) `catch` (\(_::ExitCode) -> return True)
-- ok to specify Identity here ?
--expectParseEq :: (Monad m, Monoid st, Eq a, Show a) => StateT st (ParsecT CustomErr T.Text m) a -> T.Text -> a -> EasyTest.Test ()
-- ep <- runParserT (evalStateT parser mempty) "" input
-- | Given a (stateful, identity-monadic) parser, input text, and expected parse result,
-- make an easytest Test that parses the text and compares the result,
-- showing a nice failure message if either step fails.
expectParseEq :: (Monoid st, Eq a, Show a) => StateT st (ParsecT CustomErr T.Text Identity) a -> T.Text -> a -> EasyTest.Test ()
expectParseEq parser input expected = do expectParseEq parser input expected = do
let ep = runIdentity $ parseWithState mempty parser input let ep = runIdentity $ parseWithState mempty parser input
scope "parse-succeeded" $ expectRight ep either (fail.("parse error at "++).parseErrorPretty) (flip expectEq expected) ep
let Right p = ep
scope "parse-result" $ expectEq p expected
-- | Run some hunit tests, returning True if there was a problem. -- | Run some hunit tests, returning True if there was a problem.
-- With arguments, runs only tests whose names contain the first argument -- With arguments, runs only tests whose names contain the first argument