slaesvuo/hledger
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

refactor assertParse/assertParseEqual

Browse Source
This commit is contained in:
Simon Michael 2010-03-10 19:48:46 +00:00
parent d4965b87ff
commit 08607362b0
3 changed files with 13 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
Makefile
View File

@ -1,7 +1,7 @@
# hledger project makefile # hledger project makefile
# optional features described in MANUAL, comment out if you don't have the libs # optional features described in MANUAL, comment out if you don't have the libs
OPTFLAGS=-DCHART -DVTY -DWEB OPTFLAGS= #-DCHART -DVTY -DWEB
#OPTFLAGS=-DCHART -DVTY -DWEBHAPPSTACK #OPTFLAGS=-DCHART -DVTY -DWEBHAPPSTACK
# command to run during "make ci" # command to run during "make ci"

10
Tests.hs
View File

@ -437,10 +437,10 @@ tests = TestList [
assertBool "ledgerFile parsing an empty file should give an empty ledger" $ null $ jtxns r assertBool "ledgerFile parsing an empty file should give an empty ledger" $ null $ jtxns r
,"ledgerHistoricalPrice" ~: ,"ledgerHistoricalPrice" ~:
assertParse (parseWithCtx emptyCtx ledgerHistoricalPrice price1_str) price1 assertParseEqual (parseWithCtx emptyCtx ledgerHistoricalPrice price1_str) price1
,"ledgerTransaction" ~: do ,"ledgerTransaction" ~: do
assertParse (parseWithCtx emptyCtx ledgerTransaction entry1_str) entry1 assertParseEqual (parseWithCtx emptyCtx ledgerTransaction entry1_str) entry1
assertBool "ledgerTransaction should not parse just a date" assertBool "ledgerTransaction should not parse just a date"
$ isLeft $ parseWithCtx emptyCtx ledgerTransaction "2009/1/1\n" $ isLeft $ parseWithCtx emptyCtx ledgerTransaction "2009/1/1\n"
assertBool "ledgerTransaction should require some postings" assertBool "ledgerTransaction should require some postings"
@ -456,7 +456,7 @@ tests = TestList [
assertBool "ledgeraccountname rejects an empty trailing component" (isLeft $ parsewith ledgeraccountname "a:b:") assertBool "ledgeraccountname rejects an empty trailing component" (isLeft $ parsewith ledgeraccountname "a:b:")
,"ledgerposting" ~: ,"ledgerposting" ~:
assertParse (parseWithCtx emptyCtx ledgerposting rawposting1_str) rawposting1 assertParseEqual (parseWithCtx emptyCtx ledgerposting rawposting1_str) rawposting1
,"normaliseMixedAmount" ~: do ,"normaliseMixedAmount" ~: do
normaliseMixedAmount (Mixed []) ~?= Mixed [nullamt] normaliseMixedAmount (Mixed []) ~?= Mixed [nullamt]
@ -842,8 +842,8 @@ tests = TestList [
-- ] -- ]
,"postingamount" ~: do ,"postingamount" ~: do
assertParse (parseWithCtx emptyCtx postingamount " $47.18") (Mixed [dollars 47.18]) assertParseEqual (parseWithCtx emptyCtx postingamount " $47.18") (Mixed [dollars 47.18])
assertParse (parseWithCtx emptyCtx postingamount " $1.") assertParseEqual (parseWithCtx emptyCtx postingamount " $1.")
(Mixed [Amount Commodity {symbol="$",side=L,spaced=False,comma=False,precision=0} 1 Nothing]) (Mixed [Amount Commodity {symbol="$",side=L,spaced=False,comma=False,precision=0} 1 Nothing])
] ]

10
hledger-lib/Ledger/Utils.hs
View File

@ -290,9 +290,13 @@ tfilter _ t = t
is :: (Eq a, Show a) => a -> a -> Assertion is :: (Eq a, Show a) => a -> a -> Assertion
a `is` e = assertEqual "" e a a `is` e = assertEqual "" e a
-- | Assert a parse result is some expected value, or print a parse error. -- | Assert a parse result is successful, printing the parse error on failure.
assertParse :: (Show a, Eq a) => (Either ParseError a) -> a -> Assertion assertParse :: (Either ParseError a) -> Assertion
assertParse parse expected = either (assertFailure.show) (`is` expected) parse assertParse parse = either (assertFailure.show) (const (return ())) parse
-- | Assert a parse result is some expected value, printing the parse error on failure.
assertParseEqual :: (Show a, Eq a) => (Either ParseError a) -> a -> Assertion
assertParseEqual parse expected = either (assertFailure.show) (`is` expected) parse
printParseError :: (Show a) => a -> IO () printParseError :: (Show a) => a -> IO ()
printParseError e = do putStr "parse error at "; print e printParseError e = do putStr "parse error at "; print e