simonmichael/hledger
1
1
Fork 0
mirror of https://github.com/simonmichael/hledger.git synced 2024-09-20 02:37:12 +03:00
Code Issues Projects Releases Wiki Activity

lib: improve expectParseEq (#812)

Browse Source 
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
1 changed files with 11 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
hledger-lib/Hledger/Utils/Test.hs
View File

@ -5,6 +5,8 @@ module Hledger.Utils.Test where
import Control.Exception
import Control.Monad
import Control.Monad.State.Strict (StateT)
--import Control.Monad.State.Strict (evalStateT)
import Data.Functor.Identity
import Data.List
import qualified Data.Text as T
@ -14,6 +16,7 @@ import System.Exit
import System.IO
import Test.HUnit as HUnit
import Text.Megaparsec
import Text.Megaparsec.Custom
import Hledger.Utils.Debug (pshow)
import Hledger.Utils.Parse (parseWithState)
@ -90,11 +93,16 @@ runEasyTests args easytests = (do
)
`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
let ep = runIdentity $ parseWithState mempty parser input
scope "parse-succeeded" $ expectRight ep
let Right p = ep
scope "parse-result" $ expectEq p expected
either (fail.("parse error at "++).parseErrorPretty) (flip expectEq expected) ep
-- | Run some hunit tests, returning True if there was a problem.
-- With arguments, runs only tests whose names contain the first argument