From b36f6df11011594d208e42324a6d73bc213e9a82 Mon Sep 17 00:00:00 2001 From: Simon Michael Date: Wed, 27 Nov 2019 12:46:29 -0800 Subject: [PATCH] tests: port all unit tests to tasty, second pass (#1090) Hledger.Util.Tests helpers have been cleaned up, and test names are now shown. Tests have been cleaned up a bit. Some groups of unnamed tests have been collapsed into a single named test containing a sequence of assertions. The test command counts named tests, not assertions, so the reported unit test count has dropped from 199 to 188. --- hledger-lib/Hledger/Data/AccountName.hs | 38 ++- hledger-lib/Hledger/Data/Amount.hs | 111 ++++----- hledger-lib/Hledger/Data/Journal.hs | 36 +-- hledger-lib/Hledger/Data/Ledger.hs | 15 +- hledger-lib/Hledger/Data/Posting.hs | 52 ++--- hledger-lib/Hledger/Data/StringFormat.hs | 26 +-- hledger-lib/Hledger/Data/Transaction.hs | 176 +++++++------- hledger-lib/Hledger/Data/Valuation.hs | 20 +- hledger-lib/Hledger/Query.hs | 218 +++++++++--------- hledger-lib/Hledger/Read/Common.hs | 57 +++-- hledger-lib/Hledger/Read/CsvReader.hs | 24 +- hledger-lib/Hledger/Read/JournalReader.hs | 167 +++++++------- hledger-lib/Hledger/Reports/BalanceReport.hs | 46 ++-- hledger-lib/Hledger/Reports/EntriesReport.hs | 4 +- .../Hledger/Reports/MultiBalanceReport.hs | 36 +-- hledger-lib/Hledger/Reports/PostingsReport.hs | 38 ++- hledger-lib/Hledger/Reports/ReportOptions.hs | 30 ++- hledger-lib/Hledger/Utils/Test.hs | 175 ++++++-------- hledger-lib/Hledger/Utils/Text.hs | 17 +- hledger/Hledger/Cli/Commands.hs | 63 ++--- hledger/Hledger/Cli/Commands/Balance.hs | 9 +- hledger/Hledger/Cli/Commands/Register.hs | 6 +- 22 files changed, 633 insertions(+), 731 deletions(-) diff --git a/hledger-lib/Hledger/Data/AccountName.hs b/hledger-lib/Hledger/Data/AccountName.hs index c888a3551..4c98c7df7 100644 --- a/hledger-lib/Hledger/Data/AccountName.hs +++ b/hledger-lib/Hledger/Data/AccountName.hs @@ -227,27 +227,23 @@ accountRegexToAccountName = T.pack . regexReplace "^\\^(.*?)\\(:\\|\\$\\)$" "\\1 --isAccountRegex s = take 1 s == "^" && take 5 (reverse s) == ")$|:(" tests_AccountName = tests "AccountName" [ - tests "accountNameTreeFrom" [ - accountNameTreeFrom ["a"] `is` Node "root" [Node "a" []] - ,accountNameTreeFrom ["a","b"] `is` Node "root" [Node "a" [], Node "b" []] - ,accountNameTreeFrom ["a","a:b"] `is` Node "root" [Node "a" [Node "a:b" []]] - ,accountNameTreeFrom ["a:b:c"] `is` Node "root" [Node "a" [Node "a:b" [Node "a:b:c" []]]] - ] - ,tests "expandAccountNames" [ - expandAccountNames ["assets:cash","assets:checking","expenses:vacation"] `is` + testCase "accountNameTreeFrom" $ do + accountNameTreeFrom ["a"] @?= Node "root" [Node "a" []] + accountNameTreeFrom ["a","b"] @?= Node "root" [Node "a" [], Node "b" []] + accountNameTreeFrom ["a","a:b"] @?= Node "root" [Node "a" [Node "a:b" []]] + accountNameTreeFrom ["a:b:c"] @?= Node "root" [Node "a" [Node "a:b" [Node "a:b:c" []]]] + ,testCase "expandAccountNames" $ do + expandAccountNames ["assets:cash","assets:checking","expenses:vacation"] @?= ["assets","assets:cash","assets:checking","expenses","expenses:vacation"] - ] - ,tests "isAccountNamePrefixOf" [ - "assets" `isAccountNamePrefixOf` "assets" `is` False - ,"assets" `isAccountNamePrefixOf` "assets:bank" `is` True - ,"assets" `isAccountNamePrefixOf` "assets:bank:checking" `is` True - ,"my assets" `isAccountNamePrefixOf` "assets:bank" `is` False - ] - ,tests "isSubAccountNameOf" [ - "assets" `isSubAccountNameOf` "assets" `is` False - ,"assets:bank" `isSubAccountNameOf` "assets" `is` True - ,"assets:bank:checking" `isSubAccountNameOf` "assets" `is` False - ,"assets:bank" `isSubAccountNameOf` "my assets" `is` False - ] + ,testCase "isAccountNamePrefixOf" $ do + "assets" `isAccountNamePrefixOf` "assets" @?= False + "assets" `isAccountNamePrefixOf` "assets:bank" @?= True + "assets" `isAccountNamePrefixOf` "assets:bank:checking" @?= True + "my assets" `isAccountNamePrefixOf` "assets:bank" @?= False + ,testCase "isSubAccountNameOf" $ do + "assets" `isSubAccountNameOf` "assets" @?= False + "assets:bank" `isSubAccountNameOf` "assets" @?= True + "assets:bank:checking" `isSubAccountNameOf` "assets" @?= False + "assets:bank" `isSubAccountNameOf` "my assets" @?= False ] diff --git a/hledger-lib/Hledger/Data/Amount.hs b/hledger-lib/Hledger/Data/Amount.hs index b25bf120c..a62b65fe9 100644 --- a/hledger-lib/Hledger/Data/Amount.hs +++ b/hledger-lib/Hledger/Data/Amount.hs @@ -735,99 +735,88 @@ mixedAmountTotalPriceToUnitPrice (Mixed as) = Mixed $ map amountTotalPriceToUnit tests_Amount = tests "Amount" [ tests "Amount" [ - tests "costOfAmount" [ - costOfAmount (eur 1) `is` eur 1 - ,costOfAmount (eur 2){aprice=Just $ UnitPrice $ usd 2} `is` usd 4 - ,costOfAmount (eur 1){aprice=Just $ TotalPrice $ usd 2} `is` usd 2 - ,costOfAmount (eur (-1)){aprice=Just $ TotalPrice $ usd 2} `is` usd (-2) - ] + testCase "costOfAmount" $ do + costOfAmount (eur 1) @?= eur 1 + costOfAmount (eur 2){aprice=Just $ UnitPrice $ usd 2} @?= usd 4 + costOfAmount (eur 1){aprice=Just $ TotalPrice $ usd 2} @?= usd 2 + costOfAmount (eur (-1)){aprice=Just $ TotalPrice $ usd 2} @?= usd (-2) - ,tests "isZeroAmount" [ - expect $ isZeroAmount amount - ,expect $ isZeroAmount $ usd 0 - ] + ,testCase "isZeroAmount" $ do + assertBool "" $ isZeroAmount amount + assertBool "" $ isZeroAmount $ usd 0 - ,tests "negating amounts" [ - negate (usd 1) `is` (usd 1){aquantity= -1} - ,let b = (usd 1){aprice=Just $ UnitPrice $ eur 2} in negate b `is` b{aquantity= -1} - ] + ,testCase "negating amounts" $ do + negate (usd 1) @?= (usd 1){aquantity= -1} + let b = (usd 1){aprice=Just $ UnitPrice $ eur 2} in negate b @?= b{aquantity= -1} - ,tests "adding amounts without prices" [ - (usd 1.23 + usd (-1.23)) `is` usd 0 - ,(usd 1.23 + usd (-1.23)) `is` usd 0 - ,(usd (-1.23) + usd (-1.23)) `is` usd (-2.46) - ,sum [usd 1.23,usd (-1.23),usd (-1.23),-(usd (-1.23))] `is` usd 0 - -- highest precision is preserved - ,asprecision (astyle $ sum [usd 1 `withPrecision` 1, usd 1 `withPrecision` 3]) `is` 3 - ,asprecision (astyle $ sum [usd 1 `withPrecision` 3, usd 1 `withPrecision` 1]) `is` 3 - -- adding different commodities assumes conversion rate 1 - ,expect $ isZeroAmount (usd 1.23 - eur 1.23) - ] + ,testCase "adding amounts without prices" $ do + (usd 1.23 + usd (-1.23)) @?= usd 0 + (usd 1.23 + usd (-1.23)) @?= usd 0 + (usd (-1.23) + usd (-1.23)) @?= usd (-2.46) + sum [usd 1.23,usd (-1.23),usd (-1.23),-(usd (-1.23))] @?= usd 0 + -- highest precision is preserved + asprecision (astyle $ sum [usd 1 `withPrecision` 1, usd 1 `withPrecision` 3]) @?= 3 + asprecision (astyle $ sum [usd 1 `withPrecision` 3, usd 1 `withPrecision` 1]) @?= 3 + -- adding different commodities assumes conversion rate 1 + assertBool "" $ isZeroAmount (usd 1.23 - eur 1.23) - ,tests "showAmount" [ - showAmount (usd 0 + gbp 0) `is` "0" - ] + ,testCase "showAmount" $ do + showAmount (usd 0 + gbp 0) @?= "0" ] ,tests "MixedAmount" [ - tests "adding mixed amounts to zero, the commodity and amount style are preserved" [ + testCase "adding mixed amounts to zero, the commodity and amount style are preserved" $ sum (map (Mixed . (:[])) [usd 1.25 ,usd (-1) `withPrecision` 3 ,usd (-0.25) ]) - `is` Mixed [usd 0 `withPrecision` 3] - ] + @?= Mixed [usd 0 `withPrecision` 3] - ,tests "adding mixed amounts with total prices" [ + ,testCase "adding mixed amounts with total prices" $ do sum (map (Mixed . (:[])) [usd 1 @@ eur 1 ,usd (-2) @@ eur 1 ]) - `is` Mixed [usd 1 @@ eur 1 + @?= Mixed [usd 1 @@ eur 1 ,usd (-2) @@ eur 1 ] - ] - ,tests "showMixedAmount" [ - showMixedAmount (Mixed [usd 1]) `is` "$1.00" - ,showMixedAmount (Mixed [usd 1 `at` eur 2]) `is` "$1.00 @ €2.00" - ,showMixedAmount (Mixed [usd 0]) `is` "0" - ,showMixedAmount (Mixed []) `is` "0" - ,showMixedAmount missingmixedamt `is` "" - ] + ,testCase "showMixedAmount" $ do + showMixedAmount (Mixed [usd 1]) @?= "$1.00" + showMixedAmount (Mixed [usd 1 `at` eur 2]) @?= "$1.00 @ €2.00" + showMixedAmount (Mixed [usd 0]) @?= "0" + showMixedAmount (Mixed []) @?= "0" + showMixedAmount missingmixedamt @?= "" - ,tests "showMixedAmountWithoutPrice" $ - let a = usd 1 `at` eur 2 in - [ - showMixedAmountWithoutPrice (Mixed [a]) `is` "$1.00" - ,showMixedAmountWithoutPrice (Mixed [a, -a]) `is` "0" - ] + ,testCase "showMixedAmountWithoutPrice" $ do + let a = usd 1 `at` eur 2 + showMixedAmountWithoutPrice (Mixed [a]) @?= "$1.00" + showMixedAmountWithoutPrice (Mixed [a, -a]) @?= "0" ,tests "normaliseMixedAmount" [ - test "a missing amount overrides any other amounts" $ - normaliseMixedAmount (Mixed [usd 1, missingamt]) `is` missingmixedamt - ,test "unpriced same-commodity amounts are combined" $ - normaliseMixedAmount (Mixed [usd 0, usd 2]) `is` Mixed [usd 2] - ,test "amounts with same unit price are combined" $ - normaliseMixedAmount (Mixed [usd 1 `at` eur 1, usd 1 `at` eur 1]) `is` Mixed [usd 2 `at` eur 1] - ,test "amounts with different unit prices are not combined" $ - normaliseMixedAmount (Mixed [usd 1 `at` eur 1, usd 1 `at` eur 2]) `is` Mixed [usd 1 `at` eur 1, usd 1 `at` eur 2] - ,test "amounts with total prices are not combined" $ - normaliseMixedAmount (Mixed [usd 1 @@ eur 1, usd 1 @@ eur 1]) `is` Mixed [usd 1 @@ eur 1, usd 1 @@ eur 1] + testCase "a missing amount overrides any other amounts" $ + normaliseMixedAmount (Mixed [usd 1, missingamt]) @?= missingmixedamt + ,testCase "unpriced same-commodity amounts are combined" $ + normaliseMixedAmount (Mixed [usd 0, usd 2]) @?= Mixed [usd 2] + ,testCase "amounts with same unit price are combined" $ + normaliseMixedAmount (Mixed [usd 1 `at` eur 1, usd 1 `at` eur 1]) @?= Mixed [usd 2 `at` eur 1] + ,testCase "amounts with different unit prices are not combined" $ + normaliseMixedAmount (Mixed [usd 1 `at` eur 1, usd 1 `at` eur 2]) @?= Mixed [usd 1 `at` eur 1, usd 1 `at` eur 2] + ,testCase "amounts with total prices are not combined" $ + normaliseMixedAmount (Mixed [usd 1 @@ eur 1, usd 1 @@ eur 1]) @?= Mixed [usd 1 @@ eur 1, usd 1 @@ eur 1] ] - ,tests "normaliseMixedAmountSquashPricesForDisplay" [ - normaliseMixedAmountSquashPricesForDisplay (Mixed []) `is` Mixed [nullamt] - ,expect $ isZeroMixedAmount $ normaliseMixedAmountSquashPricesForDisplay + ,testCase "normaliseMixedAmountSquashPricesForDisplay" $ do + normaliseMixedAmountSquashPricesForDisplay (Mixed []) @?= Mixed [nullamt] + assertBool "" $ isZeroMixedAmount $ normaliseMixedAmountSquashPricesForDisplay (Mixed [usd 10 ,usd 10 @@ eur 7 ,usd (-10) ,usd (-10) @@ eur 7 ]) - ] ] diff --git a/hledger-lib/Hledger/Data/Journal.hs b/hledger-lib/Hledger/Data/Journal.hs index 990dd0230..dcb9e7f2f 100644 --- a/hledger-lib/Hledger/Data/Journal.hs +++ b/hledger-lib/Hledger/Data/Journal.hs @@ -1296,7 +1296,7 @@ Right samplejournal = journalBalanceTransactions False $ tests_Journal = tests "Journal" [ - test "journalDateSpan" $ + testCase "journalDateSpan" $ journalDateSpan True nulljournal{ jtxns = [nulltransaction{tdate = parsedate "2014/02/01" ,tpostings = [posting{pdate=Just (parsedate "2014/01/10")}] @@ -1306,7 +1306,7 @@ tests_Journal = tests "Journal" [ } ] } - `is` (DateSpan (Just $ fromGregorian 2014 1 10) (Just $ fromGregorian 2014 10 11)) + @?= (DateSpan (Just $ fromGregorian 2014 1 10) (Just $ fromGregorian 2014 10 11)) ,tests "standard account type queries" $ let @@ -1315,16 +1315,16 @@ tests_Journal = tests "Journal" [ journalAccountNamesMatching q = filter (q `matchesAccount`) . journalAccountNames namesfrom qfunc = journalAccountNamesMatching (qfunc j) j in [ - test "assets" $ expectEq (namesfrom journalAssetAccountQuery) ["assets","assets:bank","assets:bank:checking","assets:bank:saving","assets:cash"] - ,test "liabilities" $ expectEq (namesfrom journalLiabilityAccountQuery) ["liabilities","liabilities:debts"] - ,test "equity" $ expectEq (namesfrom journalEquityAccountQuery) [] - ,test "income" $ expectEq (namesfrom journalRevenueAccountQuery) ["income","income:gifts","income:salary"] - ,test "expenses" $ expectEq (namesfrom journalExpenseAccountQuery) ["expenses","expenses:food","expenses:supplies"] + testCase "assets" $ assertEqual "" (namesfrom journalAssetAccountQuery) ["assets","assets:bank","assets:bank:checking","assets:bank:saving","assets:cash"] + ,testCase "liabilities" $ assertEqual "" (namesfrom journalLiabilityAccountQuery) ["liabilities","liabilities:debts"] + ,testCase "equity" $ assertEqual "" (namesfrom journalEquityAccountQuery) [] + ,testCase "income" $ assertEqual "" (namesfrom journalRevenueAccountQuery) ["income","income:gifts","income:salary"] + ,testCase "expenses" $ assertEqual "" (namesfrom journalExpenseAccountQuery) ["expenses","expenses:food","expenses:supplies"] ] ,tests "journalBalanceTransactions" [ - test "balance-assignment" $ testCaseSteps "sometests" $ \_step -> do + testCase "balance-assignment" $ do let ej = journalBalanceTransactions True $ --2019/01/01 -- (a) = 1 @@ -1335,8 +1335,8 @@ tests_Journal = tests "Journal" [ let Right j = ej (jtxns j & head & tpostings & head & pamount) @?= Mixed [num 1] - ,test "same-day-1" $ do - expectRight $ journalBalanceTransactions True $ + ,testCase "same-day-1" $ do + assertRight $ journalBalanceTransactions True $ --2019/01/01 -- (a) = 1 --2019/01/01 @@ -1346,8 +1346,8 @@ tests_Journal = tests "Journal" [ ,transaction "2019/01/01" [ vpost' "a" (num 1) (balassert (num 2)) ] ]} - ,test "same-day-2" $ do - expectRight $ journalBalanceTransactions True $ + ,testCase "same-day-2" $ do + assertRight $ journalBalanceTransactions True $ --2019/01/01 -- (a) 2 = 2 --2019/01/01 @@ -1364,8 +1364,8 @@ tests_Journal = tests "Journal" [ ,transaction "2019/01/01" [ post' "a" (num 0) (balassert (num 1)) ] ]} - ,test "out-of-order" $ do - expectRight $ journalBalanceTransactions True $ + ,testCase "out-of-order" $ do + assertRight $ journalBalanceTransactions True $ --2019/1/2 -- (a) 1 = 2 --2019/1/1 @@ -1386,24 +1386,24 @@ tests_Journal = tests "Journal" [ -- 2019/09/26 -- (a) 1000,000 -- - test "1091a" $ do + testCase "1091a" $ do commodityStylesFromAmounts [ nullamt{aquantity=1000, astyle=AmountStyle L False 3 (Just ',') Nothing} ,nullamt{aquantity=1000, astyle=AmountStyle L False 2 (Just '.') (Just (DigitGroups ',' [3]))} ] - `is` + @?= -- The commodity style should have period as decimal mark -- and comma as digit group mark. Right (M.fromList [ ("", AmountStyle L False 3 (Just '.') (Just (DigitGroups ',' [3]))) ]) -- same journal, entries in reverse order - ,test "1091b" $ do + ,testCase "1091b" $ do commodityStylesFromAmounts [ nullamt{aquantity=1000, astyle=AmountStyle L False 2 (Just '.') (Just (DigitGroups ',' [3]))} ,nullamt{aquantity=1000, astyle=AmountStyle L False 3 (Just ',') Nothing} ] - `is` + @?= -- The commodity style should have period as decimal mark -- and comma as digit group mark. Right (M.fromList [ diff --git a/hledger-lib/Hledger/Data/Ledger.hs b/hledger-lib/Hledger/Data/Ledger.hs index 2ae0a6fdf..125e1c904 100644 --- a/hledger-lib/Hledger/Data/Ledger.hs +++ b/hledger-lib/Hledger/Data/Ledger.hs @@ -109,12 +109,9 @@ ledgerCommodities = M.keys . jinferredcommodities . ljournal -- tests tests_Ledger = - tests - "Ledger" - [ tests - "ledgerFromJournal" - [ length (ledgerPostings $ ledgerFromJournal Any nulljournal) `is` 0 - , length (ledgerPostings $ ledgerFromJournal Any samplejournal) `is` 13 - , length (ledgerPostings $ ledgerFromJournal (Depth 2) samplejournal) `is` 7 - ] - ] + tests "Ledger" [ + testCase "ledgerFromJournal" $ do + length (ledgerPostings $ ledgerFromJournal Any nulljournal) @?= 0 + length (ledgerPostings $ ledgerFromJournal Any samplejournal) @?= 13 + length (ledgerPostings $ ledgerFromJournal (Depth 2) samplejournal) @?= 7 + ] diff --git a/hledger-lib/Hledger/Data/Posting.hs b/hledger-lib/Hledger/Data/Posting.hs index 7679bd7de..f81806bc8 100644 --- a/hledger-lib/Hledger/Data/Posting.hs +++ b/hledger-lib/Hledger/Data/Posting.hs @@ -392,40 +392,34 @@ commentAddTagNextLine cmt (t,v) = tests_Posting = tests "Posting" [ - tests "accountNamePostingType" [ - accountNamePostingType "a" `is` RegularPosting - ,accountNamePostingType "(a)" `is` VirtualPosting - ,accountNamePostingType "[a]" `is` BalancedVirtualPosting - ] + testCase "accountNamePostingType" $ do + accountNamePostingType "a" @?= RegularPosting + accountNamePostingType "(a)" @?= VirtualPosting + accountNamePostingType "[a]" @?= BalancedVirtualPosting - ,tests "accountNameWithoutPostingType" [ - accountNameWithoutPostingType "(a)" `is` "a" - ] + ,testCase "accountNameWithoutPostingType" $ do + accountNameWithoutPostingType "(a)" @?= "a" - ,tests "accountNameWithPostingType" [ - accountNameWithPostingType VirtualPosting "[a]" `is` "(a)" - ] + ,testCase "accountNameWithPostingType" $ do + accountNameWithPostingType VirtualPosting "[a]" @?= "(a)" - ,tests "joinAccountNames" [ - "a" `joinAccountNames` "b:c" `is` "a:b:c" - ,"a" `joinAccountNames` "(b:c)" `is` "(a:b:c)" - ,"[a]" `joinAccountNames` "(b:c)" `is` "[a:b:c]" - ,"" `joinAccountNames` "a" `is` "a" - ] + ,testCase "joinAccountNames" $ do + "a" `joinAccountNames` "b:c" @?= "a:b:c" + "a" `joinAccountNames` "(b:c)" @?= "(a:b:c)" + "[a]" `joinAccountNames` "(b:c)" @?= "[a:b:c]" + "" `joinAccountNames` "a" @?= "a" - ,tests "concatAccountNames" [ - concatAccountNames [] `is` "" - ,concatAccountNames ["a","(b)","[c:d]"] `is` "(a:b:c:d)" - ] + ,testCase "concatAccountNames" $ do + concatAccountNames [] @?= "" + concatAccountNames ["a","(b)","[c:d]"] @?= "(a:b:c:d)" - ,tests "commentAddTag" [ - commentAddTag "" ("a","") `is` "a: " - ,commentAddTag "[1/2]" ("a","") `is` "[1/2], a: " - ] + ,testCase "commentAddTag" $ do + commentAddTag "" ("a","") @?= "a: " + commentAddTag "[1/2]" ("a","") @?= "[1/2], a: " + + ,testCase "commentAddTagNextLine" $ do + commentAddTagNextLine "" ("a","") @?= "\na: " + commentAddTagNextLine "[1/2]" ("a","") @?= "[1/2]\na: " - ,tests "commentAddTagNextLine" [ - commentAddTagNextLine "" ("a","") `is` "\na: " - ,commentAddTagNextLine "[1/2]" ("a","") `is` "[1/2]\na: " - ] ] diff --git a/hledger-lib/Hledger/Data/StringFormat.hs b/hledger-lib/Hledger/Data/StringFormat.hs index 094c08d7c..007ba9f23 100644 --- a/hledger-lib/Hledger/Data/StringFormat.hs +++ b/hledger-lib/Hledger/Data/StringFormat.hs @@ -137,7 +137,7 @@ fieldp = do ---------------------------------------------------------------------- -formatStringTester fs value expected = actual `is` expected +formatStringTester fs value expected = actual @?= expected where actual = case fs of FormatLiteral l -> formatString False Nothing Nothing l @@ -145,20 +145,18 @@ formatStringTester fs value expected = actual `is` expected tests_StringFormat = tests "StringFormat" [ - tests "formatStringHelper" [ + testCase "formatStringHelper" $ do formatStringTester (FormatLiteral " ") "" " " - , formatStringTester (FormatField False Nothing Nothing DescriptionField) "description" "description" - , formatStringTester (FormatField False (Just 20) Nothing DescriptionField) "description" " description" - , formatStringTester (FormatField False Nothing (Just 20) DescriptionField) "description" "description" - , formatStringTester (FormatField True Nothing (Just 20) DescriptionField) "description" "description" - , formatStringTester (FormatField True (Just 20) Nothing DescriptionField) "description" "description " - , formatStringTester (FormatField True (Just 20) (Just 20) DescriptionField) "description" "description " - , formatStringTester (FormatField True Nothing (Just 3) DescriptionField) "description" "des" - ] + formatStringTester (FormatField False Nothing Nothing DescriptionField) "description" "description" + formatStringTester (FormatField False (Just 20) Nothing DescriptionField) "description" " description" + formatStringTester (FormatField False Nothing (Just 20) DescriptionField) "description" "description" + formatStringTester (FormatField True Nothing (Just 20) DescriptionField) "description" "description" + formatStringTester (FormatField True (Just 20) Nothing DescriptionField) "description" "description " + formatStringTester (FormatField True (Just 20) (Just 20) DescriptionField) "description" "description " + formatStringTester (FormatField True Nothing (Just 3) DescriptionField) "description" "des" - ,tests "parseStringFormat" $ - let s `gives` expected = test s $ parseStringFormat s `is` Right expected - in [ + ,let s `gives` expected = testCase s $ parseStringFormat s @?= Right expected + in tests "parseStringFormat" [ "" `gives` (defaultStringFormatStyle []) , "D" `gives` (defaultStringFormatStyle [FormatLiteral "D"]) , "%(date)" `gives` (defaultStringFormatStyle [FormatField False Nothing Nothing DescriptionField]) @@ -176,6 +174,6 @@ tests_StringFormat = tests "StringFormat" [ ,FormatLiteral " " ,FormatField False Nothing (Just 10) TotalField ]) - , test "newline not parsed" $ expectLeft $ parseStringFormat "\n" + , testCase "newline not parsed" $ assertLeft $ parseStringFormat "\n" ] ] diff --git a/hledger-lib/Hledger/Data/Transaction.hs b/hledger-lib/Hledger/Data/Transaction.hs index f693add57..8bbf751ec 100644 --- a/hledger-lib/Hledger/Data/Transaction.hs +++ b/hledger-lib/Hledger/Data/Transaction.hs @@ -559,12 +559,12 @@ transactionToCost styles t@Transaction{tpostings=ps} = t{tpostings=map (postingT -- tests tests_Transaction = - tests - "Transaction" - [ tests - "postingAsLines" - [ postingAsLines False False [posting] posting `is` [""] - , let p = + tests "Transaction" [ + + tests "postingAsLines" [ + testCase "null posting" $ postingAsLines False False [posting] posting @?= [""] + , testCase "non-null posting" $ + let p = posting { pstatus = Cleared , paccount = "a" @@ -573,7 +573,7 @@ tests_Transaction = , ptype = RegularPosting , ptags = [("ptag1", "val1"), ("ptag2", "val2")] } - in postingAsLines False False [p] p `is` + in postingAsLines False False [p] p @?= [ " * a $1.00 ; pcomment1" , " ; pcomment2" , " ; tag3: val3 " @@ -582,77 +582,61 @@ tests_Transaction = , " ; tag3: val3 " ] ] - -- postingsAsLines - -- one implicit amount - , let timp = nulltransaction {tpostings = ["a" `post` usd 1, "b" `post` missingamt]} - -- explicit amounts, balanced - texp = nulltransaction {tpostings = ["a" `post` usd 1, "b" `post` usd (-1)]} - -- explicit amount, only one posting - texp1 = nulltransaction {tpostings = ["(a)" `post` usd 1]} - -- explicit amounts, two commodities, explicit balancing price - texp2 = nulltransaction {tpostings = ["a" `post` usd 1, "b" `post` (hrs (-1) `at` usd 1)]} - -- explicit amounts, two commodities, implicit balancing price - texp2b = nulltransaction {tpostings = ["a" `post` usd 1, "b" `post` hrs (-1)]} - -- one missing amount, not the last one - t3 = nulltransaction {tpostings = ["a" `post` usd 1, "b" `post` missingamt, "c" `post` usd (-1)]} - -- unbalanced amounts when precision is limited (#931) - -- t4 = nulltransaction {tpostings = ["a" `post` usd (-0.01), "b" `post` usd (0.005), "c" `post` usd (0.005)]} - in tests - "postingsAsLines" - [ test "null-transaction" $ - let t = nulltransaction - in postingsAsLines False (tpostings t) `is` [] - , test "implicit-amount" $ - let t = timp - in postingsAsLines False (tpostings t) `is` + + , let + -- one implicit amount + timp = nulltransaction {tpostings = ["a" `post` usd 1, "b" `post` missingamt]} + -- explicit amounts, balanced + texp = nulltransaction {tpostings = ["a" `post` usd 1, "b" `post` usd (-1)]} + -- explicit amount, only one posting + texp1 = nulltransaction {tpostings = ["(a)" `post` usd 1]} + -- explicit amounts, two commodities, explicit balancing price + texp2 = nulltransaction {tpostings = ["a" `post` usd 1, "b" `post` (hrs (-1) `at` usd 1)]} + -- explicit amounts, two commodities, implicit balancing price + texp2b = nulltransaction {tpostings = ["a" `post` usd 1, "b" `post` hrs (-1)]} + -- one missing amount, not the last one + t3 = nulltransaction {tpostings = ["a" `post` usd 1, "b" `post` missingamt, "c" `post` usd (-1)]} + -- unbalanced amounts when precision is limited (#931) + -- t4 = nulltransaction {tpostings = ["a" `post` usd (-0.01), "b" `post` usd (0.005), "c" `post` usd (0.005)]} + in tests "postingsAsLines" [ + testCase "null-transaction" $ postingsAsLines False (tpostings nulltransaction) @?= [] + , testCase "implicit-amount" $ postingsAsLines False (tpostings timp) @?= [ " a $1.00" , " b" -- implicit amount remains implicit ] - , test "explicit-amounts" $ - let t = texp - in postingsAsLines False (tpostings t) `is` + , testCase "explicit-amounts" $ postingsAsLines False (tpostings texp) @?= [ " a $1.00" , " b $-1.00" ] - , test "one-explicit-amount" $ - let t = texp1 - in postingsAsLines False (tpostings t) `is` + , testCase "one-explicit-amount" $ postingsAsLines False (tpostings texp1) @?= [ " (a) $1.00" ] - , test "explicit-amounts-two-commodities" $ - let t = texp2 - in postingsAsLines False (tpostings t) `is` + , testCase "explicit-amounts-two-commodities" $ postingsAsLines False (tpostings texp2) @?= [ " a $1.00" , " b -1.00h @ $1.00" ] - , test "explicit-amounts-not-explicitly-balanced" $ - let t = texp2b - in postingsAsLines False (tpostings t) `is` + , testCase "explicit-amounts-not-explicitly-balanced" $ postingsAsLines False (tpostings texp2b) @?= [ " a $1.00" , " b -1.00h" ] - , test "implicit-amount-not-last" $ - let t = t3 - in postingsAsLines False (tpostings t) `is` + , testCase "implicit-amount-not-last" $ postingsAsLines False (tpostings t3) @?= [" a $1.00", " b", " c $-1.00"] - -- , _test "ensure-visibly-balanced" $ - -- let t = t4 - -- in postingsAsLines False (tpostings t) `is` + -- , _testCase "ensure-visibly-balanced" $ + -- in postingsAsLines False (tpostings t4) @?= -- [" a $-0.01", " b $0.005", " c $0.005"] ] - , tests - "inferBalancingAmount" - [ (fst <$> inferBalancingAmount M.empty nulltransaction) `is` Right nulltransaction - , (fst <$> inferBalancingAmount M.empty nulltransaction{tpostings = ["a" `post` usd (-5), "b" `post` missingamt]}) `is` + + , testCase "inferBalancingAmount" $ do + (fst <$> inferBalancingAmount M.empty nulltransaction) @?= Right nulltransaction + (fst <$> inferBalancingAmount M.empty nulltransaction{tpostings = ["a" `post` usd (-5), "b" `post` missingamt]}) @?= Right nulltransaction{tpostings = ["a" `post` usd (-5), "b" `post` usd 5]} - , (fst <$> inferBalancingAmount M.empty nulltransaction{tpostings = ["a" `post` usd (-5), "b" `post` (eur 3 @@ usd 4), "c" `post` missingamt]}) `is` + (fst <$> inferBalancingAmount M.empty nulltransaction{tpostings = ["a" `post` usd (-5), "b" `post` (eur 3 @@ usd 4), "c" `post` missingamt]}) @?= Right nulltransaction{tpostings = ["a" `post` usd (-5), "b" `post` (eur 3 @@ usd 4), "c" `post` usd 1]} - ] - , tests - "showTransaction" - [ showTransaction nulltransaction `is` "0000/01/01\n\n" - , showTransaction + + , tests "showTransaction" [ + testCase "null transaction" $ showTransaction nulltransaction @?= "0000/01/01\n\n" + , testCase "non-null transaction" $ showTransaction nulltransaction { tdate = parsedate "2012/05/14" , tdate2 = Just $ parsedate "2012/05/15" @@ -671,7 +655,7 @@ tests_Transaction = , ptags = [("ptag1", "val1"), ("ptag2", "val2")] } ] - } `is` + } @?= unlines [ "2012/05/14=2012/05/15 (code) desc ; tcomment1" , " ; tcomment2" @@ -681,7 +665,7 @@ tests_Transaction = , " ; pcomment2" , "" ] - , test "show a balanced transaction" $ + , testCase "show a balanced transaction" $ (let t = Transaction 0 @@ -697,14 +681,14 @@ tests_Transaction = [ posting {paccount = "expenses:food:groceries", pamount = Mixed [usd 47.18], ptransaction = Just t} , posting {paccount = "assets:checking", pamount = Mixed [usd (-47.18)], ptransaction = Just t} ] - in showTransaction t) `is` + in showTransaction t) @?= (unlines [ "2007/01/28 coopportunity" , " expenses:food:groceries $47.18" , " assets:checking $-47.18" , "" ]) - , test "show an unbalanced transaction, should not elide" $ + , testCase "show an unbalanced transaction, should not elide" $ (showTransaction (txnTieKnot $ Transaction @@ -720,14 +704,14 @@ tests_Transaction = [] [ posting {paccount = "expenses:food:groceries", pamount = Mixed [usd 47.18]} , posting {paccount = "assets:checking", pamount = Mixed [usd (-47.19)]} - ])) `is` + ])) @?= (unlines [ "2007/01/28 coopportunity" , " expenses:food:groceries $47.18" , " assets:checking $-47.19" , "" ]) - , test "show a transaction with one posting and a missing amount" $ + , testCase "show a transaction with one posting and a missing amount" $ (showTransaction (txnTieKnot $ Transaction @@ -741,9 +725,9 @@ tests_Transaction = "coopportunity" "" [] - [posting {paccount = "expenses:food:groceries", pamount = missingmixedamt}])) `is` + [posting {paccount = "expenses:food:groceries", pamount = missingmixedamt}])) @?= (unlines ["2007/01/28 coopportunity", " expenses:food:groceries", ""]) - , test "show a transaction with a priced commodityless amount" $ + , testCase "show a transaction with a priced commodityless amount" $ (showTransaction (txnTieKnot $ Transaction @@ -759,13 +743,12 @@ tests_Transaction = [] [ posting {paccount = "a", pamount = Mixed [num 1 `at` (usd 2 `withPrecision` 0)]} , posting {paccount = "b", pamount = missingmixedamt} - ])) `is` + ])) @?= (unlines ["2010/01/01 x", " a 1 @ $2", " b", ""]) ] - , tests - "balanceTransaction" - [ test "detect unbalanced entry, sign error" $ - expectLeft + , tests "balanceTransaction" [ + testCase "detect unbalanced entry, sign error" $ + assertLeft (balanceTransaction Nothing (Transaction @@ -780,8 +763,8 @@ tests_Transaction = "" [] [posting {paccount = "a", pamount = Mixed [usd 1]}, posting {paccount = "b", pamount = Mixed [usd 1]}])) - , test "detect unbalanced entry, multiple missing amounts" $ - expectLeft $ + ,testCase "detect unbalanced entry, multiple missing amounts" $ + assertLeft $ balanceTransaction Nothing (Transaction @@ -798,7 +781,7 @@ tests_Transaction = [ posting {paccount = "a", pamount = missingmixedamt} , posting {paccount = "b", pamount = missingmixedamt} ]) - , test "one missing amount is inferred" $ + ,testCase "one missing amount is inferred" $ (pamount . last . tpostings <$> balanceTransaction Nothing @@ -813,9 +796,9 @@ tests_Transaction = "" "" [] - [posting {paccount = "a", pamount = Mixed [usd 1]}, posting {paccount = "b", pamount = missingmixedamt}])) `is` + [posting {paccount = "a", pamount = Mixed [usd 1]}, posting {paccount = "b", pamount = missingmixedamt}])) @?= Right (Mixed [usd (-1)]) - , test "conversion price is inferred" $ + ,testCase "conversion price is inferred" $ (pamount . head . tpostings <$> balanceTransaction Nothing @@ -832,10 +815,10 @@ tests_Transaction = [] [ posting {paccount = "a", pamount = Mixed [usd 1.35]} , posting {paccount = "b", pamount = Mixed [eur (-1)]} - ])) `is` + ])) @?= Right (Mixed [usd 1.35 @@ (eur 1 `withPrecision` maxprecision)]) - , test "balanceTransaction balances based on cost if there are unit prices" $ - expectRight $ + ,testCase "balanceTransaction balances based on cost if there are unit prices" $ + assertRight $ balanceTransaction Nothing (Transaction @@ -852,8 +835,8 @@ tests_Transaction = [ posting {paccount = "a", pamount = Mixed [usd 1 `at` eur 2]} , posting {paccount = "a", pamount = Mixed [usd (-2) `at` eur 1]} ]) - , test "balanceTransaction balances based on cost if there are total prices" $ - expectRight $ + ,testCase "balanceTransaction balances based on cost if there are total prices" $ + assertRight $ balanceTransaction Nothing (Transaction @@ -871,10 +854,9 @@ tests_Transaction = , posting {paccount = "a", pamount = Mixed [usd (-2) @@ eur 1]} ]) ] - , tests - "isTransactionBalanced" - [ test "detect balanced" $ - expect $ + , tests "isTransactionBalanced" [ + testCase "detect balanced" $ + assertBool "" $ isTransactionBalanced Nothing $ Transaction 0 @@ -890,8 +872,8 @@ tests_Transaction = [ posting {paccount = "b", pamount = Mixed [usd 1.00]} , posting {paccount = "c", pamount = Mixed [usd (-1.00)]} ] - , test "detect unbalanced" $ - expect $ + ,testCase "detect unbalanced" $ + assertBool "" $ not $ isTransactionBalanced Nothing $ Transaction @@ -908,8 +890,8 @@ tests_Transaction = [ posting {paccount = "b", pamount = Mixed [usd 1.00]} , posting {paccount = "c", pamount = Mixed [usd (-1.01)]} ] - , test "detect unbalanced, one posting" $ - expect $ + ,testCase "detect unbalanced, one posting" $ + assertBool "" $ not $ isTransactionBalanced Nothing $ Transaction @@ -924,8 +906,8 @@ tests_Transaction = "" [] [posting {paccount = "b", pamount = Mixed [usd 1.00]}] - , test "one zero posting is considered balanced for now" $ - expect $ + ,testCase "one zero posting is considered balanced for now" $ + assertBool "" $ isTransactionBalanced Nothing $ Transaction 0 @@ -939,8 +921,8 @@ tests_Transaction = "" [] [posting {paccount = "b", pamount = Mixed [usd 0]}] - , test "virtual postings don't need to balance" $ - expect $ + ,testCase "virtual postings don't need to balance" $ + assertBool "" $ isTransactionBalanced Nothing $ Transaction 0 @@ -957,8 +939,8 @@ tests_Transaction = , posting {paccount = "c", pamount = Mixed [usd (-1.00)]} , posting {paccount = "d", pamount = Mixed [usd 100], ptype = VirtualPosting} ] - , test "balanced virtual postings need to balance among themselves" $ - expect $ + ,testCase "balanced virtual postings need to balance among themselves" $ + assertBool "" $ not $ isTransactionBalanced Nothing $ Transaction @@ -976,8 +958,8 @@ tests_Transaction = , posting {paccount = "c", pamount = Mixed [usd (-1.00)]} , posting {paccount = "d", pamount = Mixed [usd 100], ptype = BalancedVirtualPosting} ] - , test "balanced virtual postings need to balance among themselves (2)" $ - expect $ + ,testCase "balanced virtual postings need to balance among themselves (2)" $ + assertBool "" $ isTransactionBalanced Nothing $ Transaction 0 diff --git a/hledger-lib/Hledger/Data/Valuation.hs b/hledger-lib/Hledger/Data/Valuation.hs index 6598d81ae..99484e081 100644 --- a/hledger-lib/Hledger/Data/Valuation.hs +++ b/hledger-lib/Hledger/Data/Valuation.hs @@ -48,11 +48,6 @@ import Hledger.Data.Amount import Hledger.Data.Dates (parsedate) -tests_Valuation = tests "Valuation" [ - tests_priceLookup - ] - - ------------------------------------------------------------------------------ -- Types @@ -278,12 +273,11 @@ tests_priceLookup = ,p "2001/01/01" "A" 11 "B" ] pricesatdate = pricesAtDate ps1 - in tests "priceLookup" [ - priceLookup pricesatdate (d "1999/01/01") "A" Nothing `is` Nothing - ,priceLookup pricesatdate (d "2000/01/01") "A" Nothing `is` Just ("B",10) - ,priceLookup pricesatdate (d "2000/01/01") "B" (Just "A") `is` Just ("A",0.1) - ,priceLookup pricesatdate (d "2000/01/01") "A" (Just "E") `is` Just ("E",500) - ] + in testCase "priceLookup" $ do + priceLookup pricesatdate (d "1999/01/01") "A" Nothing @?= Nothing + priceLookup pricesatdate (d "2000/01/01") "A" Nothing @?= Just ("B",10) + priceLookup pricesatdate (d "2000/01/01") "B" (Just "A") @?= Just ("A",0.1) + priceLookup pricesatdate (d "2000/01/01") "A" (Just "E") @?= Just ("E",500) ------------------------------------------------------------------------------ -- Building the price graph (network of commodity conversions) on a given day. @@ -365,3 +359,7 @@ nodesEdgeLabel :: Ord b => Gr a b -> (Node, Node) -> Maybe b nodesEdgeLabel g (from,to) = headMay $ sort [l | (_,t,l) <- out g from, t==to] ------------------------------------------------------------------------------ + +tests_Valuation = tests "Valuation" [ + tests_priceLookup + ] diff --git a/hledger-lib/Hledger/Query.hs b/hledger-lib/Hledger/Query.hs index 68841e17a..6fb5ed817 100644 --- a/hledger-lib/Hledger/Query.hs +++ b/hledger-lib/Hledger/Query.hs @@ -653,130 +653,122 @@ matchesPriceDirective _ _ = True -- tests tests_Query = tests "Query" [ - tests "simplifyQuery" [ + testCase "simplifyQuery" $ do + (simplifyQuery $ Or [Acct "a"]) @?= (Acct "a") + (simplifyQuery $ Or [Any,None]) @?= (Any) + (simplifyQuery $ And [Any,None]) @?= (None) + (simplifyQuery $ And [Any,Any]) @?= (Any) + (simplifyQuery $ And [Acct "b",Any]) @?= (Acct "b") + (simplifyQuery $ And [Any,And [Date (DateSpan Nothing Nothing)]]) @?= (Any) + (simplifyQuery $ And [Date (DateSpan Nothing (Just $ parsedate "2013-01-01")), Date (DateSpan (Just $ parsedate "2012-01-01") Nothing)]) + @?= (Date (DateSpan (Just $ parsedate "2012-01-01") (Just $ parsedate "2013-01-01"))) + (simplifyQuery $ And [Or [],Or [Desc "b b"]]) @?= (Desc "b b") - (simplifyQuery $ Or [Acct "a"]) `is` (Acct "a") - ,(simplifyQuery $ Or [Any,None]) `is` (Any) - ,(simplifyQuery $ And [Any,None]) `is` (None) - ,(simplifyQuery $ And [Any,Any]) `is` (Any) - ,(simplifyQuery $ And [Acct "b",Any]) `is` (Acct "b") - ,(simplifyQuery $ And [Any,And [Date (DateSpan Nothing Nothing)]]) `is` (Any) - ,(simplifyQuery $ And [Date (DateSpan Nothing (Just $ parsedate "2013-01-01")), Date (DateSpan (Just $ parsedate "2012-01-01") Nothing)]) - `is` (Date (DateSpan (Just $ parsedate "2012-01-01") (Just $ parsedate "2013-01-01"))) - ,(simplifyQuery $ And [Or [],Or [Desc "b b"]]) `is` (Desc "b b") - ] + ,testCase "parseQuery" $ do + (parseQuery nulldate "acct:'expenses:autres d\233penses' desc:b") @?= (And [Acct "expenses:autres d\233penses", Desc "b"], []) + parseQuery nulldate "inacct:a desc:\"b b\"" @?= (Desc "b b", [QueryOptInAcct "a"]) + parseQuery nulldate "inacct:a inacct:b" @?= (Any, [QueryOptInAcct "a", QueryOptInAcct "b"]) + parseQuery nulldate "desc:'x x'" @?= (Desc "x x", []) + parseQuery nulldate "'a a' 'b" @?= (Or [Acct "a a",Acct "'b"], []) + parseQuery nulldate "\"" @?= (Acct "\"", []) - ,tests "parseQuery" [ - (parseQuery nulldate "acct:'expenses:autres d\233penses' desc:b") `is` (And [Acct "expenses:autres d\233penses", Desc "b"], []) - ,parseQuery nulldate "inacct:a desc:\"b b\"" `is` (Desc "b b", [QueryOptInAcct "a"]) - ,parseQuery nulldate "inacct:a inacct:b" `is` (Any, [QueryOptInAcct "a", QueryOptInAcct "b"]) - ,parseQuery nulldate "desc:'x x'" `is` (Desc "x x", []) - ,parseQuery nulldate "'a a' 'b" `is` (Or [Acct "a a",Acct "'b"], []) - ,parseQuery nulldate "\"" `is` (Acct "\"", []) - ] + ,testCase "words''" $ do + (words'' [] "a b") @?= ["a","b"] + (words'' [] "'a b'") @?= ["a b"] + (words'' [] "not:a b") @?= ["not:a","b"] + (words'' [] "not:'a b'") @?= ["not:a b"] + (words'' [] "'not:a b'") @?= ["not:a b"] + (words'' ["desc:"] "not:desc:'a b'") @?= ["not:desc:a b"] + (words'' prefixes "\"acct:expenses:autres d\233penses\"") @?= ["acct:expenses:autres d\233penses"] + (words'' prefixes "\"") @?= ["\""] - ,tests "words''" [ - (words'' [] "a b") `is` ["a","b"] - , (words'' [] "'a b'") `is` ["a b"] - , (words'' [] "not:a b") `is` ["not:a","b"] - , (words'' [] "not:'a b'") `is` ["not:a b"] - , (words'' [] "'not:a b'") `is` ["not:a b"] - , (words'' ["desc:"] "not:desc:'a b'") `is` ["not:desc:a b"] - , (words'' prefixes "\"acct:expenses:autres d\233penses\"") `is` ["acct:expenses:autres d\233penses"] - , (words'' prefixes "\"") `is` ["\""] - ] + ,testCase "filterQuery" $ do + filterQuery queryIsDepth Any @?= Any + filterQuery queryIsDepth (Depth 1) @?= Depth 1 + filterQuery (not.queryIsDepth) (And [And [StatusQ Cleared,Depth 1]]) @?= StatusQ Cleared + filterQuery queryIsDepth (And [Date nulldatespan, Not (Or [Any, Depth 1])]) @?= Any -- XXX unclear - ,tests "filterQuery" [ - filterQuery queryIsDepth Any `is` Any - ,filterQuery queryIsDepth (Depth 1) `is` Depth 1 - ,filterQuery (not.queryIsDepth) (And [And [StatusQ Cleared,Depth 1]]) `is` StatusQ Cleared - ,filterQuery queryIsDepth (And [Date nulldatespan, Not (Or [Any, Depth 1])]) `is` Any -- XXX unclear - ] + ,testCase "parseQueryTerm" $ do + parseQueryTerm nulldate "a" @?= (Left $ Acct "a") + parseQueryTerm nulldate "acct:expenses:autres d\233penses" @?= (Left $ Acct "expenses:autres d\233penses") + parseQueryTerm nulldate "not:desc:a b" @?= (Left $ Not $ Desc "a b") + parseQueryTerm nulldate "status:1" @?= (Left $ StatusQ Cleared) + parseQueryTerm nulldate "status:*" @?= (Left $ StatusQ Cleared) + parseQueryTerm nulldate "status:!" @?= (Left $ StatusQ Pending) + parseQueryTerm nulldate "status:0" @?= (Left $ StatusQ Unmarked) + parseQueryTerm nulldate "status:" @?= (Left $ StatusQ Unmarked) + parseQueryTerm nulldate "payee:x" @?= (Left $ Tag "payee" (Just "x")) + parseQueryTerm nulldate "note:x" @?= (Left $ Tag "note" (Just "x")) + parseQueryTerm nulldate "real:1" @?= (Left $ Real True) + parseQueryTerm nulldate "date:2008" @?= (Left $ Date $ DateSpan (Just $ parsedate "2008/01/01") (Just $ parsedate "2009/01/01")) + parseQueryTerm nulldate "date:from 2012/5/17" @?= (Left $ Date $ DateSpan (Just $ parsedate "2012/05/17") Nothing) + parseQueryTerm nulldate "date:20180101-201804" @?= (Left $ Date $ DateSpan (Just $ parsedate "2018/01/01") (Just $ parsedate "2018/04/01")) + parseQueryTerm nulldate "inacct:a" @?= (Right $ QueryOptInAcct "a") + parseQueryTerm nulldate "tag:a" @?= (Left $ Tag "a" Nothing) + parseQueryTerm nulldate "tag:a=some value" @?= (Left $ Tag "a" (Just "some value")) + parseQueryTerm nulldate "amt:<0" @?= (Left $ Amt Lt 0) + parseQueryTerm nulldate "amt:>10000.10" @?= (Left $ Amt AbsGt 10000.1) - ,tests "parseQueryTerm" [ - parseQueryTerm nulldate "a" `is` (Left $ Acct "a") - ,parseQueryTerm nulldate "acct:expenses:autres d\233penses" `is` (Left $ Acct "expenses:autres d\233penses") - ,parseQueryTerm nulldate "not:desc:a b" `is` (Left $ Not $ Desc "a b") - ,parseQueryTerm nulldate "status:1" `is` (Left $ StatusQ Cleared) - ,parseQueryTerm nulldate "status:*" `is` (Left $ StatusQ Cleared) - ,parseQueryTerm nulldate "status:!" `is` (Left $ StatusQ Pending) - ,parseQueryTerm nulldate "status:0" `is` (Left $ StatusQ Unmarked) - ,parseQueryTerm nulldate "status:" `is` (Left $ StatusQ Unmarked) - ,parseQueryTerm nulldate "payee:x" `is` (Left $ Tag "payee" (Just "x")) - ,parseQueryTerm nulldate "note:x" `is` (Left $ Tag "note" (Just "x")) - ,parseQueryTerm nulldate "real:1" `is` (Left $ Real True) - ,parseQueryTerm nulldate "date:2008" `is` (Left $ Date $ DateSpan (Just $ parsedate "2008/01/01") (Just $ parsedate "2009/01/01")) - ,parseQueryTerm nulldate "date:from 2012/5/17" `is` (Left $ Date $ DateSpan (Just $ parsedate "2012/05/17") Nothing) - ,parseQueryTerm nulldate "date:20180101-201804" `is` (Left $ Date $ DateSpan (Just $ parsedate "2018/01/01") (Just $ parsedate "2018/04/01")) - ,parseQueryTerm nulldate "inacct:a" `is` (Right $ QueryOptInAcct "a") - ,parseQueryTerm nulldate "tag:a" `is` (Left $ Tag "a" Nothing) - ,parseQueryTerm nulldate "tag:a=some value" `is` (Left $ Tag "a" (Just "some value")) - ,parseQueryTerm nulldate "amt:<0" `is` (Left $ Amt Lt 0) - ,parseQueryTerm nulldate "amt:>10000.10" `is` (Left $ Amt AbsGt 10000.1) - ] + ,testCase "parseAmountQueryTerm" $ do + parseAmountQueryTerm "<0" @?= (Lt,0) -- special case for convenience, since AbsLt 0 would be always false + parseAmountQueryTerm ">0" @?= (Gt,0) -- special case for convenience and consistency with above + parseAmountQueryTerm ">10000.10" @?= (AbsGt,10000.1) + parseAmountQueryTerm "=0.23" @?= (AbsEq,0.23) + parseAmountQueryTerm "0.23" @?= (AbsEq,0.23) + parseAmountQueryTerm "<=+0.23" @?= (LtEq,0.23) + parseAmountQueryTerm "-0.23" @?= (Eq,(-0.23)) + -- ,_test "number beginning with decimal mark" $ parseAmountQueryTerm "=.23" @?= (AbsEq,0.23) -- XXX - ,tests "parseAmountQueryTerm" [ - parseAmountQueryTerm "<0" `is` (Lt,0) -- special case for convenience, since AbsLt 0 would be always false - ,parseAmountQueryTerm ">0" `is` (Gt,0) -- special case for convenience and consistency with above - ,parseAmountQueryTerm ">10000.10" `is` (AbsGt,10000.1) - ,parseAmountQueryTerm "=0.23" `is` (AbsEq,0.23) - ,parseAmountQueryTerm "0.23" `is` (AbsEq,0.23) - ,parseAmountQueryTerm "<=+0.23" `is` (LtEq,0.23) - ,parseAmountQueryTerm "-0.23" `is` (Eq,(-0.23)) - -- ,_test "number beginning with decimal mark" $ parseAmountQueryTerm "=.23" `is` (AbsEq,0.23) -- XXX - ] - - ,tests "matchesAccount" [ - expect $ (Acct "b:c") `matchesAccount` "a:bb:c:d" - ,expect $ not $ (Acct "^a:b") `matchesAccount` "c:a:b" - ,expect $ Depth 2 `matchesAccount` "a" - ,expect $ Depth 2 `matchesAccount` "a:b" - ,expect $ not $ Depth 2 `matchesAccount` "a:b:c" - ,expect $ Date nulldatespan `matchesAccount` "a" - ,expect $ Date2 nulldatespan `matchesAccount` "a" - ,expect $ not $ (Tag "a" Nothing) `matchesAccount` "a" - ] + ,testCase "matchesAccount" $ do + assertBool "" $ (Acct "b:c") `matchesAccount` "a:bb:c:d" + assertBool "" $ not $ (Acct "^a:b") `matchesAccount` "c:a:b" + assertBool "" $ Depth 2 `matchesAccount` "a" + assertBool "" $ Depth 2 `matchesAccount` "a:b" + assertBool "" $ not $ Depth 2 `matchesAccount` "a:b:c" + assertBool "" $ Date nulldatespan `matchesAccount` "a" + assertBool "" $ Date2 nulldatespan `matchesAccount` "a" + assertBool "" $ not $ (Tag "a" Nothing) `matchesAccount` "a" ,tests "matchesPosting" [ - test "positive match on cleared posting status" $ - expect $ (StatusQ Cleared) `matchesPosting` nullposting{pstatus=Cleared} - ,test "negative match on cleared posting status" $ - expect $ not $ (Not $ StatusQ Cleared) `matchesPosting` nullposting{pstatus=Cleared} - ,test "positive match on unmarked posting status" $ - expect $ (StatusQ Unmarked) `matchesPosting` nullposting{pstatus=Unmarked} - ,test "negative match on unmarked posting status" $ - expect $ not $ (Not $ StatusQ Unmarked) `matchesPosting` nullposting{pstatus=Unmarked} - ,test "positive match on true posting status acquired from transaction" $ - expect $ (StatusQ Cleared) `matchesPosting` nullposting{pstatus=Unmarked,ptransaction=Just nulltransaction{tstatus=Cleared}} - ,test "real:1 on real posting" $ expect $ (Real True) `matchesPosting` nullposting{ptype=RegularPosting} - ,test "real:1 on virtual posting fails" $ expect $ not $ (Real True) `matchesPosting` nullposting{ptype=VirtualPosting} - ,test "real:1 on balanced virtual posting fails" $ expect $ not $ (Real True) `matchesPosting` nullposting{ptype=BalancedVirtualPosting} - ,test "a" $ expect $ (Acct "'b") `matchesPosting` nullposting{paccount="'b"} - ,test "b" $ expect $ not $ (Tag "a" (Just "r$")) `matchesPosting` nullposting - ,test "c" $ expect $ (Tag "foo" Nothing) `matchesPosting` nullposting{ptags=[("foo","")]} - ,test "d" $ expect $ (Tag "foo" Nothing) `matchesPosting` nullposting{ptags=[("foo","baz")]} - ,test "e" $ expect $ (Tag "foo" (Just "a")) `matchesPosting` nullposting{ptags=[("foo","bar")]} - ,test "f" $ expect $ not $ (Tag "foo" (Just "a$")) `matchesPosting` nullposting{ptags=[("foo","bar")]} - ,test "g" $ expect $ not $ (Tag " foo " (Just "a")) `matchesPosting` nullposting{ptags=[("foo","bar")]} - ,test "h" $ expect $ not $ (Tag "foo foo" (Just " ar ba ")) `matchesPosting` nullposting{ptags=[("foo foo","bar bar")]} - -- a tag match on a posting also sees inherited tags - ,test "i" $ expect $ (Tag "txntag" Nothing) `matchesPosting` nullposting{ptransaction=Just nulltransaction{ttags=[("txntag","")]}} - ,test "j" $ expect $ not $ (Sym "$") `matchesPosting` nullposting{pamount=Mixed [usd 1]} -- becomes "^$$", ie testing for null symbol - ,test "k" $ expect $ (Sym "\\$") `matchesPosting` nullposting{pamount=Mixed [usd 1]} -- have to quote $ for regexpr - ,test "l" $ expect $ (Sym "shekels") `matchesPosting` nullposting{pamount=Mixed [nullamt{acommodity="shekels"}]} - ,test "m" $ expect $ not $ (Sym "shek") `matchesPosting` nullposting{pamount=Mixed [nullamt{acommodity="shekels"}]} + testCase "positive match on cleared posting status" $ + assertBool "" $ (StatusQ Cleared) `matchesPosting` nullposting{pstatus=Cleared} + ,testCase "negative match on cleared posting status" $ + assertBool "" $ not $ (Not $ StatusQ Cleared) `matchesPosting` nullposting{pstatus=Cleared} + ,testCase "positive match on unmarked posting status" $ + assertBool "" $ (StatusQ Unmarked) `matchesPosting` nullposting{pstatus=Unmarked} + ,testCase "negative match on unmarked posting status" $ + assertBool "" $ not $ (Not $ StatusQ Unmarked) `matchesPosting` nullposting{pstatus=Unmarked} + ,testCase "positive match on true posting status acquired from transaction" $ + assertBool "" $ (StatusQ Cleared) `matchesPosting` nullposting{pstatus=Unmarked,ptransaction=Just nulltransaction{tstatus=Cleared}} + ,testCase "real:1 on real posting" $ assertBool "" $ (Real True) `matchesPosting` nullposting{ptype=RegularPosting} + ,testCase "real:1 on virtual posting fails" $ assertBool "" $ not $ (Real True) `matchesPosting` nullposting{ptype=VirtualPosting} + ,testCase "real:1 on balanced virtual posting fails" $ assertBool "" $ not $ (Real True) `matchesPosting` nullposting{ptype=BalancedVirtualPosting} + ,testCase "acct:" $ assertBool "" $ (Acct "'b") `matchesPosting` nullposting{paccount="'b"} + ,testCase "tag:" $ do + assertBool "" $ not $ (Tag "a" (Just "r$")) `matchesPosting` nullposting + assertBool "" $ (Tag "foo" Nothing) `matchesPosting` nullposting{ptags=[("foo","")]} + assertBool "" $ (Tag "foo" Nothing) `matchesPosting` nullposting{ptags=[("foo","baz")]} + assertBool "" $ (Tag "foo" (Just "a")) `matchesPosting` nullposting{ptags=[("foo","bar")]} + assertBool "" $ not $ (Tag "foo" (Just "a$")) `matchesPosting` nullposting{ptags=[("foo","bar")]} + assertBool "" $ not $ (Tag " foo " (Just "a")) `matchesPosting` nullposting{ptags=[("foo","bar")]} + assertBool "" $ not $ (Tag "foo foo" (Just " ar ba ")) `matchesPosting` nullposting{ptags=[("foo foo","bar bar")]} + ,testCase "a tag match on a posting also sees inherited tags" $ assertBool "" $ (Tag "txntag" Nothing) `matchesPosting` nullposting{ptransaction=Just nulltransaction{ttags=[("txntag","")]}} + ,testCase "cur:" $ do + assertBool "" $ not $ (Sym "$") `matchesPosting` nullposting{pamount=Mixed [usd 1]} -- becomes "^$$", ie testing for null symbol + assertBool "" $ (Sym "\\$") `matchesPosting` nullposting{pamount=Mixed [usd 1]} -- have to quote $ for regexpr + assertBool "" $ (Sym "shekels") `matchesPosting` nullposting{pamount=Mixed [nullamt{acommodity="shekels"}]} + assertBool "" $ not $ (Sym "shek") `matchesPosting` nullposting{pamount=Mixed [nullamt{acommodity="shekels"}]} ] - ,tests "matchesTransaction" [ - expect $ Any `matchesTransaction` nulltransaction - ,expect $ not $ (Desc "x x") `matchesTransaction` nulltransaction{tdescription="x"} - ,expect $ (Desc "x x") `matchesTransaction` nulltransaction{tdescription="x x"} + ,testCase "matchesTransaction" $ do + assertBool "" $ Any `matchesTransaction` nulltransaction + assertBool "" $ not $ (Desc "x x") `matchesTransaction` nulltransaction{tdescription="x"} + assertBool "" $ (Desc "x x") `matchesTransaction` nulltransaction{tdescription="x x"} -- see posting for more tag tests - ,expect $ (Tag "foo" (Just "a")) `matchesTransaction` nulltransaction{ttags=[("foo","bar")]} - ,expect $ (Tag "payee" (Just "payee")) `matchesTransaction` nulltransaction{tdescription="payee|note"} - ,expect $ (Tag "note" (Just "note")) `matchesTransaction` nulltransaction{tdescription="payee|note"} + assertBool "" $ (Tag "foo" (Just "a")) `matchesTransaction` nulltransaction{ttags=[("foo","bar")]} + assertBool "" $ (Tag "payee" (Just "payee")) `matchesTransaction` nulltransaction{tdescription="payee|note"} + assertBool "" $ (Tag "note" (Just "note")) `matchesTransaction` nulltransaction{tdescription="payee|note"} -- a tag match on a transaction also matches posting tags - ,expect $ (Tag "postingtag" Nothing) `matchesTransaction` nulltransaction{tpostings=[nullposting{ptags=[("postingtag","")]}]} - ] + assertBool "" $ (Tag "postingtag" Nothing) `matchesTransaction` nulltransaction{tpostings=[nullposting{ptags=[("postingtag","")]}]} ] diff --git a/hledger-lib/Hledger/Read/Common.hs b/hledger-lib/Hledger/Read/Common.hs index ef522a62e..1a9e13835 100644 --- a/hledger-lib/Hledger/Read/Common.hs +++ b/hledger-lib/Hledger/Read/Common.hs @@ -1308,14 +1308,14 @@ match' p = do tests_Common = tests "Common" [ tests "amountp" [ - test "basic" $ expectParseEq amountp "$47.18" (usd 47.18) - ,test "ends with decimal mark" $ expectParseEq amountp "$1." (usd 1 `withPrecision` 0) - ,test "unit price" $ expectParseEq amountp "$10 @ €0.5" + testCase "basic" $ assertParseEq amountp "$47.18" (usd 47.18) + ,testCase "ends with decimal mark" $ assertParseEq amountp "$1." (usd 1 `withPrecision` 0) + ,testCase "unit price" $ assertParseEq amountp "$10 @ €0.5" -- not precise enough: -- (usd 10 `withPrecision` 0 `at` (eur 0.5 `withPrecision` 1)) -- `withStyle` asdecimalpoint=Just '.' amount{ acommodity="$" - ,aquantity=10 -- need to test internal precision with roundTo ? I think not + ,aquantity=10 -- need to testCase internal precision with roundTo ? I think not ,astyle=amountstyle{asprecision=0, asdecimalpoint=Nothing} ,aprice=Just $ UnitPrice $ amount{ @@ -1324,7 +1324,7 @@ tests_Common = tests "Common" [ ,astyle=amountstyle{asprecision=1, asdecimalpoint=Just '.'} } } - ,test "total price" $ expectParseEq amountp "$10 @@ €5" + ,testCase "total price" $ assertParseEq amountp "$10 @@ €5" amount{ acommodity="$" ,aquantity=10 @@ -1339,32 +1339,31 @@ tests_Common = tests "Common" [ ] ,let p = lift (numberp Nothing) :: JournalParser IO (Quantity, Int, Maybe Char, Maybe DigitGroupStyle) in - tests "numberp" [ - test "." $ expectParseEq p "0" (0, 0, Nothing, Nothing) - ,test "." $ expectParseEq p "1" (1, 0, Nothing, Nothing) - ,test "." $ expectParseEq p "1.1" (1.1, 1, Just '.', Nothing) - ,test "." $ expectParseEq p "1,000.1" (1000.1, 1, Just '.', Just $ DigitGroups ',' [3]) - ,test "." $ expectParseEq p "1.00.000,1" (100000.1, 1, Just ',', Just $ DigitGroups '.' [3,2]) - ,test "." $ expectParseEq p "1,000,000" (1000000, 0, Nothing, Just $ DigitGroups ',' [3,3]) -- could be simplified to [3] - ,test "." $ expectParseEq p "1." (1, 0, Just '.', Nothing) - ,test "." $ expectParseEq p "1," (1, 0, Just ',', Nothing) - ,test "." $ expectParseEq p ".1" (0.1, 1, Just '.', Nothing) - ,test "." $ expectParseEq p ",1" (0.1, 1, Just ',', Nothing) - ,test "." $ expectParseError p "" "" - ,test "." $ expectParseError p "1,000.000,1" "" - ,test "." $ expectParseError p "1.000,000.1" "" - ,test "." $ expectParseError p "1,000.000.1" "" - ,test "." $ expectParseError p "1,,1" "" - ,test "." $ expectParseError p "1..1" "" - ,test "." $ expectParseError p ".1," "" - ,test "." $ expectParseError p ",1." "" - ] + testCase "numberp" $ do + assertParseEq p "0" (0, 0, Nothing, Nothing) + assertParseEq p "1" (1, 0, Nothing, Nothing) + assertParseEq p "1.1" (1.1, 1, Just '.', Nothing) + assertParseEq p "1,000.1" (1000.1, 1, Just '.', Just $ DigitGroups ',' [3]) + assertParseEq p "1.00.000,1" (100000.1, 1, Just ',', Just $ DigitGroups '.' [3,2]) + assertParseEq p "1,000,000" (1000000, 0, Nothing, Just $ DigitGroups ',' [3,3]) -- could be simplified to [3] + assertParseEq p "1." (1, 0, Just '.', Nothing) + assertParseEq p "1," (1, 0, Just ',', Nothing) + assertParseEq p ".1" (0.1, 1, Just '.', Nothing) + assertParseEq p ",1" (0.1, 1, Just ',', Nothing) + assertParseError p "" "" + assertParseError p "1,000.000,1" "" + assertParseError p "1.000,000.1" "" + assertParseError p "1,000.000.1" "" + assertParseError p "1,,1" "" + assertParseError p "1..1" "" + assertParseError p ".1," "" + assertParseError p ",1." "" ,tests "spaceandamountormissingp" [ - test "space and amount" $ expectParseEq spaceandamountormissingp " $47.18" (Mixed [usd 47.18]) - ,test "empty string" $ expectParseEq spaceandamountormissingp "" missingmixedamt - -- ,_test "just space" $ expectParseEq spaceandamountormissingp " " missingmixedamt -- XXX should it ? - -- ,test "just amount" $ expectParseError spaceandamountormissingp "$47.18" "" -- succeeds, consuming nothing + testCase "space and amount" $ assertParseEq spaceandamountormissingp " $47.18" (Mixed [usd 47.18]) + ,testCase "empty string" $ assertParseEq spaceandamountormissingp "" missingmixedamt + -- ,_testCase "just space" $ assertParseEq spaceandamountormissingp " " missingmixedamt -- XXX should it ? + -- ,testCase "just amount" $ assertParseError spaceandamountormissingp "$47.18" "" -- succeeds, consuming nothing ] ] diff --git a/hledger-lib/Hledger/Read/CsvReader.hs b/hledger-lib/Hledger/Read/CsvReader.hs index e526bfcb5..3fb67440e 100644 --- a/hledger-lib/Hledger/Read/CsvReader.hs +++ b/hledger-lib/Hledger/Read/CsvReader.hs @@ -987,26 +987,26 @@ parseDateWithFormatOrDefaultFormats mformat s = firstJust $ map parsewith format tests_CsvReader = tests "CsvReader" [ tests "parseCsvRules" [ - test "empty file" $ - parseCsvRules "unknown" "" `is` Right defrules + testCase"empty file" $ + parseCsvRules "unknown" "" @?= Right defrules ] ,tests "rulesp" [ - test "trailing comments" $ - parseWithState' defrules rulesp "skip\n# \n#\n" `is` Right defrules{rdirectives = [("skip","")]} + testCase"trailing comments" $ + parseWithState' defrules rulesp "skip\n# \n#\n" @?= Right defrules{rdirectives = [("skip","")]} - ,test "trailing blank lines" $ - parseWithState' defrules rulesp "skip\n\n \n" `is` (Right defrules{rdirectives = [("skip","")]}) + ,testCase"trailing blank lines" $ + parseWithState' defrules rulesp "skip\n\n \n" @?= (Right defrules{rdirectives = [("skip","")]}) - ,test "no final newline" $ - parseWithState' defrules rulesp "skip" `is` (Right defrules{rdirectives=[("skip","")]}) + ,testCase"no final newline" $ + parseWithState' defrules rulesp "skip" @?= (Right defrules{rdirectives=[("skip","")]}) - ,test "assignment with empty value" $ - parseWithState' defrules rulesp "account1 \nif foo\n account2 foo\n" `is` + ,testCase"assignment with empty value" $ + parseWithState' defrules rulesp "account1 \nif foo\n account2 foo\n" @?= (Right defrules{rassignments = [("account1","")], rconditionalblocks = [([["foo"]],[("account2","foo")])]}) ] ,tests "conditionalblockp" [ - test "space after conditional" $ -- #1120 - parseWithState' defrules conditionalblockp "if a\n account2 b\n \n" `is` + testCase"space after conditional" $ -- #1120 + parseWithState' defrules conditionalblockp "if a\n account2 b\n \n" @?= (Right ([["a"]],[("account2","b")])) ] ] diff --git a/hledger-lib/Hledger/Read/JournalReader.hs b/hledger-lib/Hledger/Read/JournalReader.hs index 48036d248..760acd58d 100644 --- a/hledger-lib/Hledger/Read/JournalReader.hs +++ b/hledger-lib/Hledger/Read/JournalReader.hs @@ -667,10 +667,10 @@ tests_JournalReader = tests "JournalReader" [ let p = lift accountnamep :: JournalParser IO AccountName in tests "accountnamep" [ - test "basic" $ expectParse p "a:b:c" - -- ,_test "empty inner component" $ expectParseError p "a::c" "" -- TODO - -- ,_test "empty leading component" $ expectParseError p ":b:c" "x" - -- ,_test "empty trailing component" $ expectParseError p "a:b:" "x" + testCase "basic" $ assertParse p "a:b:c" + -- ,_testCase "empty inner component" $ assertParseError p "a::c" "" -- TODO + -- ,_testCase "empty leading component" $ assertParseError p ":b:c" "x" + -- ,_testCase "empty trailing component" $ assertParseError p "a:b:" "x" ] -- "Parse a date in YYYY/MM/DD format. @@ -678,37 +678,35 @@ tests_JournalReader = tests "JournalReader" [ -- The year may be omitted if a default year has been set. -- Leading zeroes may be omitted." ,tests "datep" [ - test "YYYY/MM/DD" $ expectParseEq datep "2018/01/01" (fromGregorian 2018 1 1) - ,test "YYYY-MM-DD" $ expectParse datep "2018-01-01" - ,test "YYYY.MM.DD" $ expectParse datep "2018.01.01" - ,test "yearless date with no default year" $ expectParseError datep "1/1" "current year is unknown" - ,testCaseSteps "yearless date with default year" $ \_step -> do + testCase "YYYY/MM/DD" $ assertParseEq datep "2018/01/01" (fromGregorian 2018 1 1) + ,testCase "YYYY-MM-DD" $ assertParse datep "2018-01-01" + ,testCase "YYYY.MM.DD" $ assertParse datep "2018.01.01" + ,testCase "yearless date with no default year" $ assertParseError datep "1/1" "current year is unknown" + ,testCase "yearless date with default year" $ do let s = "1/1" ep <- parseWithState mempty{jparsedefaultyear=Just 2018} datep s either (assertFailure . ("parse error at "++) . customErrorBundlePretty) (const $ return ()) ep - ,test "no leading zero" $ expectParse datep "2018/1/1" + ,testCase "no leading zero" $ assertParse datep "2018/1/1" ] - ,let - good = expectParse datetimep - bad = (\t -> expectParseError datetimep t "") - in tests "datetimep" [ - good "2011/1/1 00:00" - ,good "2011/1/1 23:59:59" - ,bad "2011/1/1" - ,bad "2011/1/1 24:00:00" - ,bad "2011/1/1 00:60:00" - ,bad "2011/1/1 00:00:60" - ,bad "2011/1/1 3:5:7" - ,let t = LocalTime (fromGregorian 2018 1 1) (TimeOfDay 0 0 (fromIntegral 0)) - in tests "timezone is parsed but ignored" [ - expectParseEq datetimep "2018/1/1 00:00-0800" t - ,expectParseEq datetimep "2018/1/1 00:00+1234" t - ] - ] + ,testCase "datetimep" $ do + let + good = assertParse datetimep + bad = (\t -> assertParseError datetimep t "") + good "2011/1/1 00:00" + good "2011/1/1 23:59:59" + bad "2011/1/1" + bad "2011/1/1 24:00:00" + bad "2011/1/1 00:60:00" + bad "2011/1/1 00:00:60" + bad "2011/1/1 3:5:7" + -- timezone is parsed but ignored + let t = LocalTime (fromGregorian 2018 1 1) (TimeOfDay 0 0 (fromIntegral 0)) + assertParseEq datetimep "2018/1/1 00:00-0800" t + assertParseEq datetimep "2018/1/1 00:00+1234" t ,tests "periodictransactionp" [ - test "more period text in comment after one space" $ expectParseEq periodictransactionp + testCase "more period text in comment after one space" $ assertParseEq periodictransactionp "~ monthly from 2018/6 ;In 2019 we will change this\n" nullperiodictransaction { ptperiodexpr = "monthly from 2018/6" @@ -718,7 +716,7 @@ tests_JournalReader = tests "JournalReader" [ ,ptcomment = "In 2019 we will change this\n" } - ,test "more period text in description after two spaces" $ expectParseEq periodictransactionp + ,testCase "more period text in description after two spaces" $ assertParseEq periodictransactionp "~ monthly from 2018/6 In 2019 we will change this\n" nullperiodictransaction { ptperiodexpr = "monthly from 2018/6" @@ -728,7 +726,7 @@ tests_JournalReader = tests "JournalReader" [ ,ptcomment = "" } - ,test "Next year in description" $ expectParseEq periodictransactionp + ,testCase "Next year in description" $ assertParseEq periodictransactionp "~ monthly Next year blah blah\n" nullperiodictransaction { ptperiodexpr = "monthly" @@ -738,7 +736,7 @@ tests_JournalReader = tests "JournalReader" [ ,ptcomment = "" } - ,test "Just date, no description" $ expectParseEq periodictransactionp + ,testCase "Just date, no description" $ assertParseEq periodictransactionp "~ 2019-01-04\n" nullperiodictransaction { ptperiodexpr = "2019-01-04" @@ -748,13 +746,13 @@ tests_JournalReader = tests "JournalReader" [ ,ptcomment = "" } - ,test "Just date, no description + empty transaction comment" $ expectParse periodictransactionp + ,testCase "Just date, no description + empty transaction comment" $ assertParse periodictransactionp "~ 2019-01-04\n ;\n a 1\n b\n" ] ,tests "postingp" [ - test "basic" $ expectParseEq (postingp Nothing) + testCase "basic" $ assertParseEq (postingp Nothing) " expenses:food:dining $10.00 ; a: a a \n ; b: b b \n" posting{ paccount="expenses:food:dining", @@ -763,7 +761,7 @@ tests_JournalReader = tests "JournalReader" [ ptags=[("a","a a"), ("b","b b")] } - ,test "posting dates" $ expectParseEq (postingp Nothing) + ,testCase "posting dates" $ assertParseEq (postingp Nothing) " a 1. ; date:2012/11/28, date2=2012/11/29,b:b\n" nullposting{ paccount="a" @@ -774,7 +772,7 @@ tests_JournalReader = tests "JournalReader" [ ,pdate2=Nothing -- Just $ fromGregorian 2012 11 29 } - ,test "posting dates bracket syntax" $ expectParseEq (postingp Nothing) + ,testCase "posting dates bracket syntax" $ assertParseEq (postingp Nothing) " a 1. ; [2012/11/28=2012/11/29]\n" nullposting{ paccount="a" @@ -785,16 +783,16 @@ tests_JournalReader = tests "JournalReader" [ ,pdate2=Just $ fromGregorian 2012 11 29 } - ,test "quoted commodity symbol with digits" $ expectParse (postingp Nothing) " a 1 \"DE123\"\n" + ,testCase "quoted commodity symbol with digits" $ assertParse (postingp Nothing) " a 1 \"DE123\"\n" - ,test "balance assertion and fixed lot price" $ expectParse (postingp Nothing) " a 1 \"DE123\" =$1 { =2.2 EUR} \n" + ,testCase "balance assertion and fixed lot price" $ assertParse (postingp Nothing) " a 1 \"DE123\" =$1 { =2.2 EUR} \n" - ,test "balance assertion over entire contents of account" $ expectParse (postingp Nothing) " a $1 == $1\n" + ,testCase "balance assertion over entire contents of account" $ assertParse (postingp Nothing) " a $1 == $1\n" ] ,tests "transactionmodifierp" [ - test "basic" $ expectParseEq transactionmodifierp + testCase "basic" $ assertParseEq transactionmodifierp "= (some value expr)\n some:postings 1.\n" nulltransactionmodifier { tmquerytxt = "(some value expr)" @@ -804,9 +802,9 @@ tests_JournalReader = tests "JournalReader" [ ,tests "transactionp" [ - test "just a date" $ expectParseEq transactionp "2015/1/1\n" nulltransaction{tdate=fromGregorian 2015 1 1} + testCase "just a date" $ assertParseEq transactionp "2015/1/1\n" nulltransaction{tdate=fromGregorian 2015 1 1} - ,test "more complex" $ expectParseEq transactionp + ,testCase "more complex" $ assertParseEq transactionp (T.unlines [ "2012/05/14=2012/05/15 (code) desc ; tcomment1", " ; tcomment2", @@ -840,27 +838,27 @@ tests_JournalReader = tests "JournalReader" [ ] } - ,test "parses a well-formed transaction" $ - expect $ isRight $ rjp transactionp $ T.unlines + ,testCase "parses a well-formed transaction" $ + assertBool "" $ isRight $ rjp transactionp $ T.unlines ["2007/01/28 coopportunity" ," expenses:food:groceries $47.18" ," assets:checking $-47.18" ,"" ] - ,test "does not parse a following comment as part of the description" $ - expectParseEqOn transactionp "2009/1/1 a ;comment\n b 1\n" tdescription "a" + ,testCase "does not parse a following comment as part of the description" $ + assertParseEqOn transactionp "2009/1/1 a ;comment\n b 1\n" tdescription "a" - ,test "transactionp parses a following whitespace line" $ - expect $ isRight $ rjp transactionp $ T.unlines + ,testCase "parses a following whitespace line" $ + assertBool "" $ isRight $ rjp transactionp $ T.unlines ["2012/1/1" ," a 1" ," b" ," " ] - ,test "transactionp parses an empty transaction comment following whitespace line" $ - expect $ isRight $ rjp transactionp $ T.unlines + ,testCase "parses an empty transaction comment following whitespace line" $ + assertBool "" $ isRight $ rjp transactionp $ T.unlines ["2012/1/1" ," ;" ," a 1" @@ -868,8 +866,8 @@ tests_JournalReader = tests "JournalReader" [ ," " ] - ,test "comments everywhere, two postings parsed" $ - expectParseEqOn transactionp + ,testCase "comments everywhere, two postings parsed" $ + assertParseEqOn transactionp (T.unlines ["2009/1/1 x ; transaction comment" ," a 1 ; posting 1 comment" @@ -885,17 +883,16 @@ tests_JournalReader = tests "JournalReader" [ -- directives ,tests "directivep" [ - tests "supports !" [ - expectParseE directivep "!account a\n" - ,expectParseE directivep "!D 1.0\n" - ] - ] + testCase "supports !" $ do + assertParseE directivep "!account a\n" + assertParseE directivep "!D 1.0\n" + ] ,tests "accountdirectivep" [ - test "with-comment" $ expectParse accountdirectivep "account a:b ; a comment\n" - ,test "does-not-support-!" $ expectParseError accountdirectivep "!account a:b\n" "" - ,test "account-type-code" $ expectParse accountdirectivep "account a:b A\n" - ,test "account-type-tag" $ expectParseStateOn accountdirectivep "account a:b ; type:asset\n" + testCase "with-comment" $ assertParse accountdirectivep "account a:b ; a comment\n" + ,testCase "does-not-support-!" $ assertParseError accountdirectivep "!account a:b\n" "" + ,testCase "account-type-code" $ assertParse accountdirectivep "account a:b A\n" + ,testCase "account-type-tag" $ assertParseStateOn accountdirectivep "account a:b ; type:asset\n" jdeclaredaccounts [("a:b", AccountDeclarationInfo{adicomment = "type:asset\n" ,aditags = [("type","asset")] @@ -904,29 +901,28 @@ tests_JournalReader = tests "JournalReader" [ ] ] - ,test "commodityconversiondirectivep" $ do - expectParse commodityconversiondirectivep "C 1h = $50.00\n" + ,testCase "commodityconversiondirectivep" $ do + assertParse commodityconversiondirectivep "C 1h = $50.00\n" - ,tests "defaultcommoditydirectivep" [ - expectParse defaultcommoditydirectivep "D $1,000.0\n" - ,expectParseError defaultcommoditydirectivep "D $1000\n" "please include a decimal separator" - ] + ,testCase "defaultcommoditydirectivep" $ do + assertParse defaultcommoditydirectivep "D $1,000.0\n" + assertParseError defaultcommoditydirectivep "D $1000\n" "please include a decimal separator" ,tests "defaultyeardirectivep" [ - test "1000" $ expectParse defaultyeardirectivep "Y 1000" -- XXX no \n like the others - ,test "999" $ expectParseError defaultyeardirectivep "Y 999" "bad year number" - ,test "12345" $ expectParse defaultyeardirectivep "Y 12345" + testCase "1000" $ assertParse defaultyeardirectivep "Y 1000" -- XXX no \n like the others + ,testCase "999" $ assertParseError defaultyeardirectivep "Y 999" "bad year number" + ,testCase "12345" $ assertParse defaultyeardirectivep "Y 12345" ] - ,test "ignoredpricecommoditydirectivep" $ do - expectParse ignoredpricecommoditydirectivep "N $\n" + ,testCase "ignoredpricecommoditydirectivep" $ do + assertParse ignoredpricecommoditydirectivep "N $\n" ,tests "includedirectivep" [ - test "include" $ expectParseErrorE includedirectivep "include nosuchfile\n" "No existing files match pattern: nosuchfile" - ,test "glob" $ expectParseErrorE includedirectivep "include nosuchfile*\n" "No existing files match pattern: nosuchfile*" + testCase "include" $ assertParseErrorE includedirectivep "include nosuchfile\n" "No existing files match pattern: nosuchfile" + ,testCase "glob" $ assertParseErrorE includedirectivep "include nosuchfile*\n" "No existing files match pattern: nosuchfile*" ] - ,test "marketpricedirectivep" $ expectParseEq marketpricedirectivep + ,testCase "marketpricedirectivep" $ assertParseEq marketpricedirectivep "P 2017/01/30 BTC $922.83\n" PriceDirective{ pddate = fromGregorian 2017 1 30, @@ -934,24 +930,21 @@ tests_JournalReader = tests "JournalReader" [ pdamount = usd 922.83 } - ,test "tagdirectivep" $ do - expectParse tagdirectivep "tag foo \n" + ,testCase "tagdirectivep" $ do + assertParse tagdirectivep "tag foo \n" - ,tests "endtagdirectivep" [ - expectParse endtagdirectivep "end tag \n" - ,expectParse endtagdirectivep "pop \n" - ] + ,testCase "endtagdirectivep" $ do + assertParse endtagdirectivep "end tag \n" + assertParse endtagdirectivep "pop \n" ,tests "journalp" [ - test "empty file" $ expectParseEqE journalp "" nulljournal + testCase "empty file" $ assertParseEqE journalp "" nulljournal ] -- these are defined here rather than in Common so they can use journalp - ,tests "parseAndFinaliseJournal" [ - testCaseSteps "basic" $ \_step -> do - ej <- runExceptT $ parseAndFinaliseJournal journalp definputopts "" "2019-1-1\n" - let Right j = ej - assertEq [""] $ journalFilePaths j - ] + ,testCase "parseAndFinaliseJournal" $ do + ej <- runExceptT $ parseAndFinaliseJournal journalp definputopts "" "2019-1-1\n" + let Right j = ej + assertEqual "" [""] $ journalFilePaths j ] diff --git a/hledger-lib/Hledger/Reports/BalanceReport.hs b/hledger-lib/Hledger/Reports/BalanceReport.hs index c297957e9..eb7af1a9c 100644 --- a/hledger-lib/Hledger/Reports/BalanceReport.hs +++ b/hledger-lib/Hledger/Reports/BalanceReport.hs @@ -248,20 +248,21 @@ Right samplejournal2 = } tests_BalanceReport = tests "BalanceReport" [ + let - (opts,journal) `gives` r = testCaseSteps "sometest" $ \_step -> do + (opts,journal) `gives` r = do let (eitems, etotal) = r (aitems, atotal) = balanceReport opts (queryFromOpts nulldate opts) journal showw (acct,acct',indent,amt) = (acct, acct', indent, showMixedAmountDebug amt) (map showw eitems) @?= (map showw aitems) (showMixedAmountDebug etotal) @?= (showMixedAmountDebug atotal) - usd0 = usd 0 - in tests "balanceReport" [ + in + tests "balanceReport" [ - test "balanceReport with no args on null journal" $ + testCase "no args, null journal" $ (defreportopts, nulljournal) `gives` ([], Mixed [nullamt]) - ,test "balanceReport with no args on sample journal" $ + ,testCase "no args, sample journal" $ (defreportopts, samplejournal) `gives` ([ ("assets","assets",0, mamountp' "$0.00") @@ -276,45 +277,46 @@ tests_BalanceReport = tests "BalanceReport" [ ,("income:gifts","gifts",1, mamountp' "$-1.00") ,("income:salary","salary",1, mamountp' "$-1.00") ], - Mixed [usd0]) + Mixed [usd 0]) - ,test "balanceReport with --depth=N" $ + ,testCase "with --depth=N" $ (defreportopts{depth_=Just 1}, samplejournal) `gives` ([ ("expenses", "expenses", 0, mamountp' "$2.00") ,("income", "income", 0, mamountp' "$-2.00") ], - Mixed [usd0]) + Mixed [usd 0]) - ,test "balanceReport with depth:N" $ + ,testCase "with depth:N" $ (defreportopts{query_="depth:1"}, samplejournal) `gives` ([ ("expenses", "expenses", 0, mamountp' "$2.00") ,("income", "income", 0, mamountp' "$-2.00") ], - Mixed [usd0]) + Mixed [usd 0]) - ,tests "balanceReport with a date or secondary date span" [ + ,testCase "with date:" $ (defreportopts{query_="date:'in 2009'"}, samplejournal2) `gives` ([], Mixed [nullamt]) - ,(defreportopts{query_="date2:'in 2009'"}, samplejournal2) `gives` + + ,testCase "with date2:" $ + (defreportopts{query_="date2:'in 2009'"}, samplejournal2) `gives` ([ ("assets:bank:checking","assets:bank:checking",0,mamountp' "$1.00") ,("income:salary","income:salary",0,mamountp' "$-1.00") ], - Mixed [usd0]) - ] + Mixed [usd 0]) - ,test "balanceReport with desc:" $ + ,testCase "with desc:" $ (defreportopts{query_="desc:income"}, samplejournal) `gives` ([ ("assets:bank:checking","assets:bank:checking",0,mamountp' "$1.00") ,("income:salary","income:salary",0, mamountp' "$-1.00") ], - Mixed [usd0]) + Mixed [usd 0]) - ,test "balanceReport with not:desc:" $ + ,testCase "with not:desc:" $ (defreportopts{query_="not:desc:income"}, samplejournal) `gives` ([ ("assets","assets",0, mamountp' "$-1.00") @@ -325,18 +327,18 @@ tests_BalanceReport = tests "BalanceReport" [ ,("expenses:supplies","supplies",1, mamountp' "$1.00") ,("income:gifts","income:gifts",0, mamountp' "$-1.00") ], - Mixed [usd0]) + Mixed [usd 0]) - ,test "balanceReport with period on a populated period" $ + ,testCase "with period on a populated period" $ (defreportopts{period_= PeriodBetween (fromGregorian 2008 1 1) (fromGregorian 2008 1 2)}, samplejournal) `gives` ( [ ("assets:bank:checking","assets:bank:checking",0, mamountp' "$1.00") ,("income:salary","income:salary",0, mamountp' "$-1.00") ], - Mixed [usd0]) + Mixed [usd 0]) - ,test "balanceReport with period on an unpopulated period" $ + ,testCase "with period on an unpopulated period" $ (defreportopts{period_= PeriodBetween (fromGregorian 2008 1 2) (fromGregorian 2008 1 3)}, samplejournal) `gives` ([],Mixed [nullamt]) @@ -456,7 +458,7 @@ tests_BalanceReport = tests "BalanceReport" [ ," 0" ] -} - ] + ] ] diff --git a/hledger-lib/Hledger/Reports/EntriesReport.hs b/hledger-lib/Hledger/Reports/EntriesReport.hs index eba7a940e..df0378646 100644 --- a/hledger-lib/Hledger/Reports/EntriesReport.hs +++ b/hledger-lib/Hledger/Reports/EntriesReport.hs @@ -49,8 +49,8 @@ entriesReport ropts@ReportOpts{..} q j@Journal{..} = tests_EntriesReport = tests "EntriesReport" [ tests "entriesReport" [ - test "not acct" $ (length $ entriesReport defreportopts (Not $ Acct "bank") samplejournal) `is` 1 - ,test "date" $ (length $ entriesReport defreportopts (Date $ mkdatespan "2008/06/01" "2008/07/01") samplejournal) `is` 3 + testCase "not acct" $ (length $ entriesReport defreportopts (Not $ Acct "bank") samplejournal) @?= 1 + ,testCase "date" $ (length $ entriesReport defreportopts (Date $ mkdatespan "2008/06/01" "2008/07/01") samplejournal) @?= 3 ] ] diff --git a/hledger-lib/Hledger/Reports/MultiBalanceReport.hs b/hledger-lib/Hledger/Reports/MultiBalanceReport.hs index 5c1c09e43..a4e68f9f9 100644 --- a/hledger-lib/Hledger/Reports/MultiBalanceReport.hs +++ b/hledger-lib/Hledger/Reports/MultiBalanceReport.hs @@ -416,49 +416,49 @@ tableAsText (ReportOpts{pretty_tables_ = pretty}) showcell = -- tests tests_MultiBalanceReport = tests "MultiBalanceReport" [ + let - (opts,journal) `gives` r = testCaseSteps "sometest" $ \_step -> do + amt0 = Amount {acommodity="$", aquantity=0, aprice=Nothing, astyle=AmountStyle {ascommodityside = L, ascommodityspaced = False, asprecision = 2, asdecimalpoint = Just '.', asdigitgroups = Nothing}, aismultiplier=False} + (opts,journal) `gives` r = do let (eitems, etotal) = r (MultiBalanceReport (_, aitems, atotal)) = multiBalanceReport opts (queryFromOpts nulldate opts) journal showw (acct,acct',indent,lAmt,amt,amt') = (acct, acct', indent, map showMixedAmountDebug lAmt, showMixedAmountDebug amt, showMixedAmountDebug amt') (map showw aitems) @?= (map showw eitems) ((\(_, b, _) -> showMixedAmountDebug b) atotal) @?= (showMixedAmountDebug etotal) -- we only check the sum of the totals - -- usd0 = usd 0 - amount0 = Amount {acommodity="$", aquantity=0, aprice=Nothing, astyle=AmountStyle {ascommodityside = L, ascommodityspaced = False, asprecision = 2, asdecimalpoint = Just '.', asdigitgroups = Nothing}, aismultiplier=False} in tests "multiBalanceReport" [ - test "null journal" $ + testCase "null journal" $ (defreportopts, nulljournal) `gives` ([], Mixed [nullamt]) - ,test "with -H on a populated period" $ + ,testCase "with -H on a populated period" $ (defreportopts{period_= PeriodBetween (fromGregorian 2008 1 1) (fromGregorian 2008 1 2), balancetype_=HistoricalBalance}, samplejournal) `gives` ( [ - ("assets:bank:checking", "checking", 3, [mamountp' "$1.00"] , Mixed [nullamt], Mixed [amount0 {aquantity=1}]) - ,("income:salary" ,"salary" , 2, [mamountp' "$-1.00"], Mixed [nullamt], Mixed [amount0 {aquantity=(-1)}]) + ("assets:bank:checking", "checking", 3, [mamountp' "$1.00"] , Mixed [nullamt], Mixed [amt0 {aquantity=1}]) + ,("income:salary" ,"salary" , 2, [mamountp' "$-1.00"], Mixed [nullamt], Mixed [amt0 {aquantity=(-1)}]) ], Mixed [nullamt]) - -- ,_test "a valid history on an empty period" $ + -- ,testCase "a valid history on an empty period" $ -- (defreportopts{period_= PeriodBetween (fromGregorian 2008 1 2) (fromGregorian 2008 1 3), balancetype_=HistoricalBalance}, samplejournal) `gives` -- ( -- [ - -- ("assets:bank:checking","checking",3, [mamountp' "$1.00"], mamountp' "$1.00",Mixed [amount0 {aquantity=1}]) - -- ,("income:salary","salary",2, [mamountp' "$-1.00"], mamountp' "$-1.00",Mixed [amount0 {aquantity=(-1)}]) + -- ("assets:bank:checking","checking",3, [mamountp' "$1.00"], mamountp' "$1.00",Mixed [amt0 {aquantity=1}]) + -- ,("income:salary","salary",2, [mamountp' "$-1.00"], mamountp' "$-1.00",Mixed [amt0 {aquantity=(-1)}]) -- ], -- Mixed [usd0]) - -- ,_test "a valid history on an empty period (more complex)" $ + -- ,testCase "a valid history on an empty period (more complex)" $ -- (defreportopts{period_= PeriodBetween (fromGregorian 2009 1 1) (fromGregorian 2009 1 2), balancetype_=HistoricalBalance}, samplejournal) `gives` -- ( -- [ - -- ("assets:bank:checking","checking",3, [mamountp' "$1.00"], mamountp' "$1.00",Mixed [amount0 {aquantity=1}]) - -- ,("assets:bank:saving","saving",3, [mamountp' "$1.00"], mamountp' "$1.00",Mixed [amount0 {aquantity=1}]) - -- ,("assets:cash","cash",2, [mamountp' "$-2.00"], mamountp' "$-2.00",Mixed [amount0 {aquantity=(-2)}]) - -- ,("expenses:food","food",2, [mamountp' "$1.00"], mamountp' "$1.00",Mixed [amount0 {aquantity=(1)}]) - -- ,("expenses:supplies","supplies",2, [mamountp' "$1.00"], mamountp' "$1.00",Mixed [amount0 {aquantity=(1)}]) - -- ,("income:gifts","gifts",2, [mamountp' "$-1.00"], mamountp' "$-1.00",Mixed [amount0 {aquantity=(-1)}]) - -- ,("income:salary","salary",2, [mamountp' "$-1.00"], mamountp' "$-1.00",Mixed [amount0 {aquantity=(-1)}]) + -- ("assets:bank:checking","checking",3, [mamountp' "$1.00"], mamountp' "$1.00",Mixed [amt0 {aquantity=1}]) + -- ,("assets:bank:saving","saving",3, [mamountp' "$1.00"], mamountp' "$1.00",Mixed [amt0 {aquantity=1}]) + -- ,("assets:cash","cash",2, [mamountp' "$-2.00"], mamountp' "$-2.00",Mixed [amt0 {aquantity=(-2)}]) + -- ,("expenses:food","food",2, [mamountp' "$1.00"], mamountp' "$1.00",Mixed [amt0 {aquantity=(1)}]) + -- ,("expenses:supplies","supplies",2, [mamountp' "$1.00"], mamountp' "$1.00",Mixed [amt0 {aquantity=(1)}]) + -- ,("income:gifts","gifts",2, [mamountp' "$-1.00"], mamountp' "$-1.00",Mixed [amt0 {aquantity=(-1)}]) + -- ,("income:salary","salary",2, [mamountp' "$-1.00"], mamountp' "$-1.00",Mixed [amt0 {aquantity=(-1)}]) -- ], -- Mixed [usd0]) ] diff --git a/hledger-lib/Hledger/Reports/PostingsReport.hs b/hledger-lib/Hledger/Reports/PostingsReport.hs index 4207a29a2..79a74e58c 100644 --- a/hledger-lib/Hledger/Reports/PostingsReport.hs +++ b/hledger-lib/Hledger/Reports/PostingsReport.hs @@ -270,22 +270,20 @@ negatePostingAmount p = p { pamount = negate $ pamount p } tests_PostingsReport = tests "PostingsReport" [ - tests "postingsReport" $ - let (query, journal) `gives` n = (length $ snd $ postingsReport defreportopts query journal) `is` n - in [ - -- with the query specified explicitly - (Any, nulljournal) `gives` 0 - ,(Any, samplejournal) `gives` 13 - -- register --depth just clips account names - ,(Depth 2, samplejournal) `gives` 13 - ,(And [Depth 1, StatusQ Cleared, Acct "expenses"], samplejournal) `gives` 2 - ,(And [And [Depth 1, StatusQ Cleared], Acct "expenses"], samplejournal) `gives` 2 - - -- with query and/or command-line options - ,(length $ snd $ postingsReport defreportopts Any samplejournal) `is` 13 - ,(length $ snd $ postingsReport defreportopts{interval_=Months 1} Any samplejournal) `is` 11 - ,(length $ snd $ postingsReport defreportopts{interval_=Months 1, empty_=True} Any samplejournal) `is` 20 - ,(length $ snd $ postingsReport defreportopts (Acct "assets:bank:checking") samplejournal) `is` 5 + testCase "postingsReport" $ do + let (query, journal) `gives` n = (length $ snd $ postingsReport defreportopts query journal) @?= n + -- with the query specified explicitly + (Any, nulljournal) `gives` 0 + (Any, samplejournal) `gives` 13 + -- register --depth just clips account names + (Depth 2, samplejournal) `gives` 13 + (And [Depth 1, StatusQ Cleared, Acct "expenses"], samplejournal) `gives` 2 + (And [And [Depth 1, StatusQ Cleared], Acct "expenses"], samplejournal) `gives` 2 + -- with query and/or command-line options + (length $ snd $ postingsReport defreportopts Any samplejournal) @?= 13 + (length $ snd $ postingsReport defreportopts{interval_=Months 1} Any samplejournal) @?= 11 + (length $ snd $ postingsReport defreportopts{interval_=Months 1, empty_=True} Any samplejournal) @?= 20 + (length $ snd $ postingsReport defreportopts (Acct "assets:bank:checking") samplejournal) @?= 5 -- (defreportopts, And [Acct "a a", Acct "'b"], samplejournal2) `gives` 0 -- [(Just (parsedate "2008-01-01","income"),assets:bank:checking $1,$1) @@ -432,13 +430,9 @@ tests_PostingsReport = tests "PostingsReport" [ ] -} - ] - ,tests "summarisePostingsByInterval" [ - tests "summarisePostingsByInterval" [ - summarisePostingsByInterval (Quarters 1) PrimaryDate 99999 False (DateSpan Nothing Nothing) [] `is` [] - ] - ] + ,testCase "summarisePostingsByInterval" $ + summarisePostingsByInterval (Quarters 1) PrimaryDate 99999 False (DateSpan Nothing Nothing) [] @?= [] -- ,tests_summarisePostingsInDateSpan = [ -- "summarisePostingsInDateSpan" ~: do diff --git a/hledger-lib/Hledger/Reports/ReportOptions.hs b/hledger-lib/Hledger/Reports/ReportOptions.hs index e4f29a7c0..1f714e982 100644 --- a/hledger-lib/Hledger/Reports/ReportOptions.hs +++ b/hledger-lib/Hledger/Reports/ReportOptions.hs @@ -539,23 +539,19 @@ reportPeriodOrJournalLastDay ropts@ReportOpts{..} j = -- tests tests_ReportOptions = tests "ReportOptions" [ - tests "queryFromOpts" [ - (queryFromOpts nulldate defreportopts) `is` Any - ,(queryFromOpts nulldate defreportopts{query_="a"}) `is` (Acct "a") - ,(queryFromOpts nulldate defreportopts{query_="desc:'a a'"}) `is` (Desc "a a") - ,(queryFromOpts nulldate defreportopts{period_=PeriodFrom (parsedate "2012/01/01"),query_="date:'to 2013'" }) - `is` (Date $ mkdatespan "2012/01/01" "2013/01/01") - ,(queryFromOpts nulldate defreportopts{query_="date2:'in 2012'"}) `is` (Date2 $ mkdatespan "2012/01/01" "2013/01/01") - ,(queryFromOpts nulldate defreportopts{query_="'a a' 'b"}) `is` (Or [Acct "a a", Acct "'b"]) - ] + testCase "queryFromOpts" $ do + queryFromOpts nulldate defreportopts @?= Any + queryFromOpts nulldate defreportopts{query_="a"} @?= Acct "a" + queryFromOpts nulldate defreportopts{query_="desc:'a a'"} @?= Desc "a a" + queryFromOpts nulldate defreportopts{period_=PeriodFrom (parsedate "2012/01/01"),query_="date:'to 2013'" } + @?= (Date $ mkdatespan "2012/01/01" "2013/01/01") + queryFromOpts nulldate defreportopts{query_="date2:'in 2012'"} @?= (Date2 $ mkdatespan "2012/01/01" "2013/01/01") + queryFromOpts nulldate defreportopts{query_="'a a' 'b"} @?= Or [Acct "a a", Acct "'b"] - ,tests "queryOptsFromOpts" [ - (queryOptsFromOpts nulldate defreportopts) `is` [] - ,(queryOptsFromOpts nulldate defreportopts{query_="a"}) `is` [] - ,(queryOptsFromOpts nulldate defreportopts{period_=PeriodFrom (parsedate "2012/01/01") - ,query_="date:'to 2013'" - }) - `is` [] - ] + ,testCase "queryOptsFromOpts" $ do + queryOptsFromOpts nulldate defreportopts @?= [] + queryOptsFromOpts nulldate defreportopts{query_="a"} @?= [] + queryOptsFromOpts nulldate defreportopts{period_=PeriodFrom (parsedate "2012/01/01") + ,query_="date:'to 2013'"} @?= [] ] diff --git a/hledger-lib/Hledger/Utils/Test.hs b/hledger-lib/Hledger/Utils/Test.hs index 9944ba81d..d431a2f2d 100644 --- a/hledger-lib/Hledger/Utils/Test.hs +++ b/hledger-lib/Hledger/Utils/Test.hs @@ -10,30 +10,19 @@ module Hledger.Utils.Test ( -- ,module SC ,tests ,test - ,is - ,expect - ,assertEq - ,expectEq ,assertLeft - ,expectLeft ,assertRight - ,expectRight - ,expectParse - ,expectParseEq - ,expectParseEqOn - ,expectParseError - ,expectParseE - ,expectParseEqE - ,expectParseErrorE - ,expectParseStateOn + ,assertParse + ,assertParseEq + ,assertParseEqOn + ,assertParseError + ,assertParseE + ,assertParseEqE + ,assertParseErrorE + ,assertParseStateOn ) where -import Test.Tasty -import Test.Tasty.HUnit --- import Test.Tasty.QuickCheck as QC --- import Test.Tasty.SmallCheck as SC - import Control.Monad.Except (ExceptT, runExceptT) import Control.Monad.State.Strict (StateT, evalStateT, execStateT) -- #if !(MIN_VERSION_base(4,11,0)) @@ -42,97 +31,76 @@ import Control.Monad.State.Strict (StateT, evalStateT, execStateT) -- import Data.CallStack import Data.List (isInfixOf) import qualified Data.Text as T +import Test.Tasty +import Test.Tasty.HUnit +-- import Test.Tasty.QuickCheck as QC +-- import Test.Tasty.SmallCheck as SC import Text.Megaparsec import Text.Megaparsec.Custom + ( CustomErr, + FinalParseError, + attachSource, + customErrorBundlePretty, + finalErrorBundlePretty, + ) import Hledger.Utils.Debug (pshow) -- import Hledger.Utils.UTF8IOCompat (error') -- * tasty helpers --- | Name and group a list of tests. +-- TODO: pretty-print values in failure messages + + +-- | Name and group a list of tests. Shorter alias for Test.Tasty.HUnit.testGroup. tests :: String -> [TestTree] -> TestTree tests = testGroup --- | Name the given test(s). --- test :: T.Text -> E.Test a -> E.Test a --- test :: String -> Assertion -> TestTree -test :: String -> TestTree -> TestTree -test _name = id - --- | Skip the given test(s), with the same type signature as "test". --- If called in a monadic sequence of tests, also skips following tests. (?) --- _test :: T.Text -> E.Test a -> E.Test a --- _test _name = (E.skip >>) - --- | Short equality test constructor. Actual value on the left, expected on the right. -is :: (Eq a, Show a, HasCallStack) => a -> a -> TestTree -is actual expected = testCase "sometest" $ actual @?= expected - --- | Expect True. -expect :: HasCallStack => Bool -> TestTree -expect val = testCase "sometest" $ assertBool "was false" val - --- | Assert equality. Expected first, actual second. -assertEq :: (HasCallStack, Eq a, Show a) => a -> a -> Assertion -assertEq expected actual = assertEqual "was not equal" expected actual - --- | Test for equality. Expected first, actual second. -expectEq :: (HasCallStack, Eq a, Show a) => a -> a -> TestTree -expectEq a b = testCase "sometest" $ assertEq a b +-- | Name an assertion or sequence of assertions. Shorter alias for Test.Tasty.HUnit.testCase. +test :: String -> Assertion -> TestTree +test = testCase -- | Assert any Left value. assertLeft :: (HasCallStack, Eq b, Show b) => Either a b -> Assertion assertLeft (Left _) = return () assertLeft (Right b) = assertFailure $ "expected Left, got (Right " ++ show b ++ ")" --- | Test for any Left value. -expectLeft :: (HasCallStack, Eq a, Show a) => Either e a -> TestTree -expectLeft = testCase "sometest" . assertLeft - -- | Assert any Right value. assertRight :: (HasCallStack, Eq a, Show a) => Either a b -> Assertion assertRight (Right _) = return () assertRight (Left a) = assertFailure $ "expected Right, got (Left " ++ show a ++ ")" --- | Test for any Right value. -expectRight :: (HasCallStack, Eq a, Show a) => Either a b -> TestTree -expectRight = testCase "sometest" . assertRight - --- | Test that this stateful parser runnable in IO successfully parses +-- | Assert that this stateful parser runnable in IO successfully parses -- all of the given input text, showing the parse error if it fails. -- Suitable for hledger's JournalParser parsers. --- expectParse :: (Monoid st, Eq a, Show a, HasCallStack) => --- StateT st (ParsecT CustomErr T.Text IO) a -> T.Text -> E.Test () -expectParse :: (HasCallStack, Eq a, Show a, Monoid st) => - StateT st (ParsecT CustomErr T.Text IO) a -> T.Text -> TestTree -expectParse parser input = testCaseSteps "sometest" $ \_step -> do +assertParse :: (HasCallStack, Eq a, Show a, Monoid st) => + StateT st (ParsecT CustomErr T.Text IO) a -> T.Text -> Assertion +assertParse parser input = do ep <- runParserT (evalStateT (parser <* eof) mempty) "" input either (assertFailure.(++"\n").("\nparse error at "++).customErrorBundlePretty) (const $ return ()) ep --- -- pretty-printing both if it fails. --- | Like expectParse, but also test the parse result is an expected value. -expectParseEq :: (HasCallStack, Eq a, Show a, Monoid st) => - StateT st (ParsecT CustomErr T.Text IO) a -> T.Text -> a -> TestTree -expectParseEq parser input expected = expectParseEqOn parser input id expected +-- | Assert a parser produces an expected value. +assertParseEq :: (HasCallStack, Eq a, Show a, Monoid st) => + StateT st (ParsecT CustomErr T.Text IO) a -> T.Text -> a -> Assertion +assertParseEq parser input expected = assertParseEqOn parser input id expected --- | Like expectParseEq, but transform the parse result with the given function +-- | Like assertParseEq, but transform the parse result with the given function -- before comparing it. -expectParseEqOn :: (HasCallStack, Eq b, Show b, Monoid st) => - StateT st (ParsecT CustomErr T.Text IO) a -> T.Text -> (a -> b) -> b -> TestTree -expectParseEqOn parser input f expected = testCaseSteps "sometest" $ \_step -> do +assertParseEqOn :: (HasCallStack, Eq b, Show b, Monoid st) => + StateT st (ParsecT CustomErr T.Text IO) a -> T.Text -> (a -> b) -> b -> Assertion +assertParseEqOn parser input f expected = do ep <- runParserT (evalStateT (parser <* eof) mempty) "" input either (assertFailure . (++"\n") . ("\nparse error at "++) . customErrorBundlePretty) - (assertEq expected . f) + (assertEqual "" expected . f) ep --- | Test that this stateful parser runnable in IO fails to parse +-- | Assert that this stateful parser runnable in IO fails to parse -- the given input text, with a parse error containing the given string. -expectParseError :: (HasCallStack, Eq a, Show a, Monoid st) => - StateT st (ParsecT CustomErr T.Text IO) a -> String -> String -> TestTree -expectParseError parser input errstr = testCaseSteps "sometest" $ \_step -> do +assertParseError :: (HasCallStack, Eq a, Show a, Monoid st) => + StateT st (ParsecT CustomErr T.Text IO) a -> String -> String -> Assertion +assertParseError parser input errstr = do ep <- runParserT (evalStateT parser mempty) "" (T.pack input) case ep of Right v -> assertFailure $ "\nparse succeeded unexpectedly, producing:\n" ++ pshow v ++ "\n" @@ -142,13 +110,28 @@ expectParseError parser input errstr = testCaseSteps "sometest" $ \_step -> do then return () else assertFailure $ "\nparse error is not as expected:\n" ++ e' ++ "\n" --- Suitable for hledger's ErroringJournalParser parsers. -expectParseE +-- | Run a stateful parser in IO like assertParse, then assert that the +-- final state (the wrapped state, not megaparsec's internal state), +-- transformed by the given function, matches the given expected value. +assertParseStateOn :: (HasCallStack, Eq b, Show b, Monoid st) => + StateT st (ParsecT CustomErr T.Text IO) a + -> T.Text + -> (st -> b) + -> b + -> Assertion +assertParseStateOn parser input f expected = do + es <- runParserT (execStateT (parser <* eof) mempty) "" input + case es of + Left err -> assertFailure $ (++"\n") $ ("\nparse error at "++) $ customErrorBundlePretty err + Right s -> assertEqual "" expected $ f s + +-- | These "E" variants of the above are suitable for hledger's ErroringJournalParser parsers. +assertParseE :: (HasCallStack, Eq a, Show a, Monoid st) => StateT st (ParsecT CustomErr T.Text (ExceptT FinalParseError IO)) a -> T.Text - -> TestTree -expectParseE parser input = testCaseSteps "sometest" $ \_step -> do + -> Assertion +assertParseE parser input = do let filepath = "" eep <- runExceptT $ runParserT (evalStateT (parser <* eof) mempty) filepath input @@ -161,22 +144,22 @@ expectParseE parser input = testCaseSteps "sometest" $ \_step -> do (const $ return ()) ep -expectParseEqE +assertParseEqE :: (Monoid st, Eq a, Show a, HasCallStack) => StateT st (ParsecT CustomErr T.Text (ExceptT FinalParseError IO)) a -> T.Text -> a - -> TestTree -expectParseEqE parser input expected = expectParseEqOnE parser input id expected + -> Assertion +assertParseEqE parser input expected = assertParseEqOnE parser input id expected -expectParseEqOnE +assertParseEqOnE :: (HasCallStack, Eq b, Show b, Monoid st) => StateT st (ParsecT CustomErr T.Text (ExceptT FinalParseError IO)) a -> T.Text -> (a -> b) -> b - -> TestTree -expectParseEqOnE parser input f expected = testCaseSteps "sometest" $ \_step -> do + -> Assertion +assertParseEqOnE parser input f expected = do let filepath = "" eep <- runExceptT $ runParserT (evalStateT (parser <* eof) mempty) filepath input case eep of @@ -185,16 +168,16 @@ expectParseEqOnE parser input f expected = testCaseSteps "sometest" $ \_step -> in assertFailure $ "parse error at " <> prettyErr Right ep -> either (assertFailure . (++"\n") . ("\nparse error at "++) . customErrorBundlePretty) - (assertEq expected . f) + (assertEqual "" expected . f) ep -expectParseErrorE +assertParseErrorE :: (Monoid st, Eq a, Show a, HasCallStack) => StateT st (ParsecT CustomErr T.Text (ExceptT FinalParseError IO)) a -> T.Text -> String - -> TestTree -expectParseErrorE parser input errstr = testCaseSteps "sometest" $ \_step -> do + -> Assertion +assertParseErrorE parser input errstr = do let filepath = "" eep <- runExceptT $ runParserT (evalStateT parser mempty) filepath input case eep of @@ -210,19 +193,3 @@ expectParseErrorE parser input errstr = testCaseSteps "sometest" $ \_step -> do if errstr `isInfixOf` e' then return () else assertFailure $ "\nparse error is not as expected:\n" ++ e' ++ "\n" - --- | Run a stateful parser in IO like expectParse, then compare the --- final state (the wrapped state, not megaparsec's internal state), --- transformed by the given function, with the given expected value. -expectParseStateOn :: (HasCallStack, Eq b, Show b, Monoid st) => - StateT st (ParsecT CustomErr T.Text IO) a - -> T.Text - -> (st -> b) - -> b - -> TestTree -expectParseStateOn parser input f expected = testCaseSteps "sometest" $ \_step -> do - es <- runParserT (execStateT (parser <* eof) mempty) "" input - case es of - Left err -> assertFailure $ (++"\n") $ ("\nparse error at "++) $ customErrorBundlePretty err - Right s -> assertEq expected $ f s - diff --git a/hledger-lib/Hledger/Utils/Text.hs b/hledger-lib/Hledger/Utils/Text.hs index 9ab432ca1..28d6625dd 100644 --- a/hledger-lib/Hledger/Utils/Text.hs +++ b/hledger-lib/Hledger/Utils/Text.hs @@ -421,13 +421,12 @@ textWidth s = maximum $ map (T.foldr (\a b -> charWidth a + b) 0) $ T.lines s tests_Text = tests "Text" [ - tests "quoteIfSpaced" [ - quoteIfSpaced "a'a" `is` "a'a" - ,quoteIfSpaced "a\"a" `is` "a\"a" - ,quoteIfSpaced "a a" `is` "\"a a\"" - ,quoteIfSpaced "mimi's cafe" `is` "\"mimi's cafe\"" - ,quoteIfSpaced "\"alex\" cafe" `is` "\"\\\"alex\\\" cafe\"" - ,quoteIfSpaced "le'shan's cafe" `is` "\"le'shan's cafe\"" - ,quoteIfSpaced "\"be'any's\" cafe" `is` "\"\\\"be'any's\\\" cafe\"" - ] + testCase "quoteIfSpaced" $ do + quoteIfSpaced "a'a" @?= "a'a" + quoteIfSpaced "a\"a" @?= "a\"a" + quoteIfSpaced "a a" @?= "\"a a\"" + quoteIfSpaced "mimi's cafe" @?= "\"mimi's cafe\"" + quoteIfSpaced "\"alex\" cafe" @?= "\"\\\"alex\\\" cafe\"" + quoteIfSpaced "le'shan's cafe" @?= "\"le'shan's cafe\"" + quoteIfSpaced "\"be'any's\" cafe" @?= "\"\\\"be'any's\\\" cafe\"" ] diff --git a/hledger/Hledger/Cli/Commands.hs b/hledger/Hledger/Cli/Commands.hs index ec9fa0c48..57fb2ffd5 100644 --- a/hledger/Hledger/Cli/Commands.hs +++ b/hledger/Hledger/Cli/Commands.hs @@ -267,7 +267,7 @@ testmode = hledgerCommandMode testcmd :: CliOpts -> Journal -> IO () testcmd opts _undefined = do withArgs (words' $ query_ $ reportopts_ opts) $ - defaultMain $ tests "sometests" [ -- Test.Tasty.defaultMain from Hledger.Util.Tests + defaultMain $ tests "hledger" [ -- Test.Tasty.defaultMain from Hledger.Util.Tests tests_Hledger ,tests "Hledger.Cli" [ tests_Cli_Utils @@ -282,37 +282,44 @@ tests_Commands = tests "Commands" [ -- some more tests easiest to define here: - ,test "apply account directive" $ let - ignoresourcepos j = j{jtxns=map (\t -> t{tsourcepos=nullsourcepos}) (jtxns j)} - sameParse str1 str2 = testCaseSteps "sometest" $ \_step -> do - j1 <- readJournal def Nothing str1 >>= either error' (return . ignoresourcepos) - j2 <- readJournal def Nothing str2 >>= either error' (return . ignoresourcepos) - j1 @?= j2{jlastreadtime=jlastreadtime j1, jfiles=jfiles j1} --, jparsestate=jparsestate j1} - in sameParse - ("2008/12/07 One\n alpha $-1\n beta $1\n" <> - "apply account outer\n2008/12/07 Two\n aigh $-2\n bee $2\n" <> - "apply account inner\n2008/12/07 Three\n gamma $-3\n delta $3\n" <> - "end apply account\n2008/12/07 Four\n why $-4\n zed $4\n" <> - "end apply account\n2008/12/07 Five\n foo $-5\n bar $5\n" - ) - ("2008/12/07 One\n alpha $-1\n beta $1\n" <> - "2008/12/07 Two\n outer:aigh $-2\n outer:bee $2\n" <> - "2008/12/07 Three\n outer:inner:gamma $-3\n outer:inner:delta $3\n" <> - "2008/12/07 Four\n outer:why $-4\n outer:zed $4\n" <> - "2008/12/07 Five\n foo $-5\n bar $5\n" - ) + ,tests "apply account directive" [ + testCase "works" $ do + let + ignoresourcepos j = j{jtxns=map (\t -> t{tsourcepos=nullsourcepos}) (jtxns j)} + sameParse str1 str2 = do + j1 <- readJournal def Nothing str1 >>= either error' (return . ignoresourcepos) + j2 <- readJournal def Nothing str2 >>= either error' (return . ignoresourcepos) + j1 @?= j2{jlastreadtime=jlastreadtime j1, jfiles=jfiles j1} --, jparsestate=jparsestate j1} + sameParse + ("2008/12/07 One\n alpha $-1\n beta $1\n" <> + "apply account outer\n2008/12/07 Two\n aigh $-2\n bee $2\n" <> + "apply account inner\n2008/12/07 Three\n gamma $-3\n delta $3\n" <> + "end apply account\n2008/12/07 Four\n why $-4\n zed $4\n" <> + "end apply account\n2008/12/07 Five\n foo $-5\n bar $5\n" + ) + ("2008/12/07 One\n alpha $-1\n beta $1\n" <> + "2008/12/07 Two\n outer:aigh $-2\n outer:bee $2\n" <> + "2008/12/07 Three\n outer:inner:gamma $-3\n outer:inner:delta $3\n" <> + "2008/12/07 Four\n outer:why $-4\n outer:zed $4\n" <> + "2008/12/07 Five\n foo $-5\n bar $5\n" + ) - ,testCaseSteps "apply account directive should preserve \"virtual\" posting type" $ \_step -> do - j <- readJournal def Nothing "apply account test\n2008/12/07 One\n (from) $-1\n (to) $1\n" >>= either error' return - let p = head $ tpostings $ head $ jtxns j - paccount p @?= "test:from" - ptype p @?= VirtualPosting + ,testCase "preserves \"virtual\" posting type" $ do + j <- readJournal def Nothing "apply account test\n2008/12/07 One\n (from) $-1\n (to) $1\n" >>= either error' return + let p = head $ tpostings $ head $ jtxns j + paccount p @?= "test:from" + ptype p @?= VirtualPosting + ] - ,testCaseSteps "account aliases" $ \_step -> do + ,testCase "alias directive" $ do j <- readJournal def Nothing "!alias expenses = equity:draw:personal\n1/1\n (expenses:food) 1\n" >>= either error' return let p = head $ tpostings $ head $ jtxns j paccount p @?= "equity:draw:personal:food" + ,testCase "Y default year directive" $ do + j <- readJournal def Nothing defaultyear_journal_txt >>= either error' return + tdate (head $ jtxns j) @?= fromGregorian 2009 1 1 + ,testCase "ledgerAccountNames" $ (ledgerAccountNames ledger7) @?= @@ -331,10 +338,6 @@ tests_Commands = tests "Commands" [ -- (elideAccountName 20 "aaaaaaaaaaaaaaaaaaaa:aaaaaaaaaaaaaaaaaaaa:aaaaaaaaaaaaaaaaaaaa" -- @?= "aa:aa:aaaaaaaaaaaaaa") - ,testCaseSteps "default year" $ \_step -> do - j <- readJournal def Nothing defaultyear_journal_txt >>= either error' return - tdate (head $ jtxns j) @?= fromGregorian 2009 1 1 - ,testCase "show dollars" $ showAmount (usd 1) @?= "$1.00" ,testCase "show hours" $ showAmount (hrs 1) @?= "1.00h" diff --git a/hledger/Hledger/Cli/Commands/Balance.hs b/hledger/Hledger/Cli/Commands/Balance.hs index c4089c8f8..fa0738c03 100644 --- a/hledger/Hledger/Cli/Commands/Balance.hs +++ b/hledger/Hledger/Cli/Commands/Balance.hs @@ -640,16 +640,17 @@ balanceReportTableAsText ropts = tableAsText ropts showamt tests_Balance = tests "Balance" [ tests "balanceReportAsText" [ - testCaseSteps "unicode in balance layout" $ \_step -> do + testCase "unicode in balance layout" $ do j <- readJournal' "2009/01/01 * медвежья шкура\n расходы:покупки 100\n актив:наличные\n" let opts = defreportopts - balanceReportAsText opts (balanceReport opts (queryFromOpts (parsedate "2008/11/26") opts) j) @?= + balanceReportAsText opts (balanceReport opts (queryFromOpts (parsedate "2008/11/26") opts) j) + @?= unlines [" -100 актив:наличные" ," 100 расходы:покупки" ,"--------------------" ," 0" ] - ] + ] - ] + ] diff --git a/hledger/Hledger/Cli/Commands/Register.hs b/hledger/Hledger/Cli/Commands/Register.hs index 713d6cead..bd67c623f 100644 --- a/hledger/Hledger/Cli/Commands/Register.hs +++ b/hledger/Hledger/Cli/Commands/Register.hs @@ -194,10 +194,12 @@ postingsReportItemAsText opts preferredamtwidth preferredbalwidth (mdate, mendda tests_Register = tests "Register" [ tests "postingsReportAsText" [ - testCaseSteps "unicode in register layout" $ \_step -> do + testCase "unicode in register layout" $ do j <- readJournal' "2009/01/01 * медвежья шкура\n расходы:покупки 100\n актив:наличные\n" let opts = defreportopts - (postingsReportAsText defcliopts $ postingsReport opts (queryFromOpts (parsedate "2008/11/26") opts) j) @?= unlines + (postingsReportAsText defcliopts $ postingsReport opts (queryFromOpts (parsedate "2008/11/26") opts) j) + @?= + unlines ["2009/01/01 медвежья шкура расходы:покупки 100 100" ," актив:наличные -100 0"] ]