;tests: use "test" alias for testCase everywhere

Easier to type and read, and a little clearer to my eyes;
"testCase" implies a single case, but it can contain many assertions.
This commit is contained in:
Simon Michael 2019-11-28 15:29:03 -08:00
parent 030b633cd6
commit 2b2a0b3cf8
22 changed files with 197 additions and 191 deletions

View File

@ -698,10 +698,16 @@ About testing in the hledger project, as of 201809.
tests. These are mostly in hledger-lib, with a few in hledger. tests. These are mostly in hledger-lib, with a few in hledger.
Our unit tests use the Our unit tests use the
[tasty](http://hackage.haskell.org/package/tasty) test runner [tasty](http://hackage.haskell.org/package/tasty) test runner,
[tasty-hunit](http://hackage.haskell.org/package/tasty-hunit) HUnit-style tests,
and some helpers from and some helpers from
[Hledger.Utils.Test](https://github.com/simonmichael/hledger/blob/master/hledger-lib/Hledger/Utils/Test.hs). [Hledger.Utils.Test](https://github.com/simonmichael/hledger/blob/master/hledger-lib/Hledger/Utils/Test.hs),
We would like them to be: such as:
- `tests` and `test` aliases for `testGroup` and `testCase`
- `assert*` helpers for constructing various kinds of assertions
We would like our unit tests to be:
- easy to read (clear, concise) - easy to read (clear, concise)
- easy to write (low boilerplate, low cognitive load) - easy to write (low boilerplate, low cognitive load)

View File

@ -227,20 +227,20 @@ accountRegexToAccountName = T.pack . regexReplace "^\\^(.*?)\\(:\\|\\$\\)$" "\\1
--isAccountRegex s = take 1 s == "^" && take 5 (reverse s) == ")$|:(" --isAccountRegex s = take 1 s == "^" && take 5 (reverse s) == ")$|:("
tests_AccountName = tests "AccountName" [ tests_AccountName = tests "AccountName" [
testCase "accountNameTreeFrom" $ do test "accountNameTreeFrom" $ do
accountNameTreeFrom ["a"] @?= Node "root" [Node "a" []] accountNameTreeFrom ["a"] @?= Node "root" [Node "a" []]
accountNameTreeFrom ["a","b"] @?= Node "root" [Node "a" [], Node "b" []] accountNameTreeFrom ["a","b"] @?= Node "root" [Node "a" [], Node "b" []]
accountNameTreeFrom ["a","a:b"] @?= Node "root" [Node "a" [Node "a: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" []]]] accountNameTreeFrom ["a:b:c"] @?= Node "root" [Node "a" [Node "a:b" [Node "a:b:c" []]]]
,testCase "expandAccountNames" $ do ,test "expandAccountNames" $ do
expandAccountNames ["assets:cash","assets:checking","expenses:vacation"] @?= expandAccountNames ["assets:cash","assets:checking","expenses:vacation"] @?=
["assets","assets:cash","assets:checking","expenses","expenses:vacation"] ["assets","assets:cash","assets:checking","expenses","expenses:vacation"]
,testCase "isAccountNamePrefixOf" $ do ,test "isAccountNamePrefixOf" $ do
"assets" `isAccountNamePrefixOf` "assets" @?= False "assets" `isAccountNamePrefixOf` "assets" @?= False
"assets" `isAccountNamePrefixOf` "assets:bank" @?= True "assets" `isAccountNamePrefixOf` "assets:bank" @?= True
"assets" `isAccountNamePrefixOf` "assets:bank:checking" @?= True "assets" `isAccountNamePrefixOf` "assets:bank:checking" @?= True
"my assets" `isAccountNamePrefixOf` "assets:bank" @?= False "my assets" `isAccountNamePrefixOf` "assets:bank" @?= False
,testCase "isSubAccountNameOf" $ do ,test "isSubAccountNameOf" $ do
"assets" `isSubAccountNameOf` "assets" @?= False "assets" `isSubAccountNameOf` "assets" @?= False
"assets:bank" `isSubAccountNameOf` "assets" @?= True "assets:bank" `isSubAccountNameOf` "assets" @?= True
"assets:bank:checking" `isSubAccountNameOf` "assets" @?= False "assets:bank:checking" `isSubAccountNameOf` "assets" @?= False

View File

@ -735,21 +735,21 @@ mixedAmountTotalPriceToUnitPrice (Mixed as) = Mixed $ map amountTotalPriceToUnit
tests_Amount = tests "Amount" [ tests_Amount = tests "Amount" [
tests "Amount" [ tests "Amount" [
testCase "costOfAmount" $ do test "costOfAmount" $ do
costOfAmount (eur 1) @?= eur 1 costOfAmount (eur 1) @?= eur 1
costOfAmount (eur 2){aprice=Just $ UnitPrice $ usd 2} @?= usd 4 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
costOfAmount (eur (-1)){aprice=Just $ TotalPrice $ usd 2} @?= usd (-2) costOfAmount (eur (-1)){aprice=Just $ TotalPrice $ usd 2} @?= usd (-2)
,testCase "isZeroAmount" $ do ,test "isZeroAmount" $ do
assertBool "" $ isZeroAmount amount assertBool "" $ isZeroAmount amount
assertBool "" $ isZeroAmount $ usd 0 assertBool "" $ isZeroAmount $ usd 0
,testCase "negating amounts" $ do ,test "negating amounts" $ do
negate (usd 1) @?= (usd 1){aquantity= -1} negate (usd 1) @?= (usd 1){aquantity= -1}
let b = (usd 1){aprice=Just $ UnitPrice $ eur 2} in negate b @?= b{aquantity= -1} let b = (usd 1){aprice=Just $ UnitPrice $ eur 2} in negate b @?= b{aquantity= -1}
,testCase "adding amounts without prices" $ do ,test "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 0 (usd 1.23 + usd (-1.23)) @?= usd 0
(usd (-1.23) + usd (-1.23)) @?= usd (-2.46) (usd (-1.23) + usd (-1.23)) @?= usd (-2.46)
@ -760,14 +760,14 @@ tests_Amount = tests "Amount" [
-- adding different commodities assumes conversion rate 1 -- adding different commodities assumes conversion rate 1
assertBool "" $ isZeroAmount (usd 1.23 - eur 1.23) assertBool "" $ isZeroAmount (usd 1.23 - eur 1.23)
,testCase "showAmount" $ do ,test "showAmount" $ do
showAmount (usd 0 + gbp 0) @?= "0" showAmount (usd 0 + gbp 0) @?= "0"
] ]
,tests "MixedAmount" [ ,tests "MixedAmount" [
testCase "adding mixed amounts to zero, the commodity and amount style are preserved" $ test "adding mixed amounts to zero, the commodity and amount style are preserved" $
sum (map (Mixed . (:[])) sum (map (Mixed . (:[]))
[usd 1.25 [usd 1.25
,usd (-1) `withPrecision` 3 ,usd (-1) `withPrecision` 3
@ -775,7 +775,7 @@ tests_Amount = tests "Amount" [
]) ])
@?= Mixed [usd 0 `withPrecision` 3] @?= Mixed [usd 0 `withPrecision` 3]
,testCase "adding mixed amounts with total prices" $ do ,test "adding mixed amounts with total prices" $ do
sum (map (Mixed . (:[])) sum (map (Mixed . (:[]))
[usd 1 @@ eur 1 [usd 1 @@ eur 1
,usd (-2) @@ eur 1 ,usd (-2) @@ eur 1
@ -784,32 +784,32 @@ tests_Amount = tests "Amount" [
,usd (-2) @@ eur 1 ,usd (-2) @@ eur 1
] ]
,testCase "showMixedAmount" $ do ,test "showMixedAmount" $ do
showMixedAmount (Mixed [usd 1]) @?= "$1.00" showMixedAmount (Mixed [usd 1]) @?= "$1.00"
showMixedAmount (Mixed [usd 1 `at` eur 2]) @?= "$1.00 @ €2.00" showMixedAmount (Mixed [usd 1 `at` eur 2]) @?= "$1.00 @ €2.00"
showMixedAmount (Mixed [usd 0]) @?= "0" showMixedAmount (Mixed [usd 0]) @?= "0"
showMixedAmount (Mixed []) @?= "0" showMixedAmount (Mixed []) @?= "0"
showMixedAmount missingmixedamt @?= "" showMixedAmount missingmixedamt @?= ""
,testCase "showMixedAmountWithoutPrice" $ do ,test "showMixedAmountWithoutPrice" $ do
let a = usd 1 `at` eur 2 let a = usd 1 `at` eur 2
showMixedAmountWithoutPrice (Mixed [a]) @?= "$1.00" showMixedAmountWithoutPrice (Mixed [a]) @?= "$1.00"
showMixedAmountWithoutPrice (Mixed [a, -a]) @?= "0" showMixedAmountWithoutPrice (Mixed [a, -a]) @?= "0"
,tests "normaliseMixedAmount" [ ,tests "normaliseMixedAmount" [
testCase "a missing amount overrides any other amounts" $ test "a missing amount overrides any other amounts" $
normaliseMixedAmount (Mixed [usd 1, missingamt]) @?= missingmixedamt normaliseMixedAmount (Mixed [usd 1, missingamt]) @?= missingmixedamt
,testCase "unpriced same-commodity amounts are combined" $ ,test "unpriced same-commodity amounts are combined" $
normaliseMixedAmount (Mixed [usd 0, usd 2]) @?= Mixed [usd 2] normaliseMixedAmount (Mixed [usd 0, usd 2]) @?= Mixed [usd 2]
,testCase "amounts with same unit price are combined" $ ,test "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] 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" $ ,test "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] 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" $ ,test "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] normaliseMixedAmount (Mixed [usd 1 @@ eur 1, usd 1 @@ eur 1]) @?= Mixed [usd 1 @@ eur 1, usd 1 @@ eur 1]
] ]
,testCase "normaliseMixedAmountSquashPricesForDisplay" $ do ,test "normaliseMixedAmountSquashPricesForDisplay" $ do
normaliseMixedAmountSquashPricesForDisplay (Mixed []) @?= Mixed [nullamt] normaliseMixedAmountSquashPricesForDisplay (Mixed []) @?= Mixed [nullamt]
assertBool "" $ isZeroMixedAmount $ normaliseMixedAmountSquashPricesForDisplay assertBool "" $ isZeroMixedAmount $ normaliseMixedAmountSquashPricesForDisplay
(Mixed [usd 10 (Mixed [usd 10

View File

@ -1296,7 +1296,7 @@ Right samplejournal = journalBalanceTransactions False $
tests_Journal = tests "Journal" [ tests_Journal = tests "Journal" [
testCase "journalDateSpan" $ test "journalDateSpan" $
journalDateSpan True nulljournal{ journalDateSpan True nulljournal{
jtxns = [nulltransaction{tdate = parsedate "2014/02/01" jtxns = [nulltransaction{tdate = parsedate "2014/02/01"
,tpostings = [posting{pdate=Just (parsedate "2014/01/10")}] ,tpostings = [posting{pdate=Just (parsedate "2014/01/10")}]
@ -1315,16 +1315,16 @@ tests_Journal = tests "Journal" [
journalAccountNamesMatching q = filter (q `matchesAccount`) . journalAccountNames journalAccountNamesMatching q = filter (q `matchesAccount`) . journalAccountNames
namesfrom qfunc = journalAccountNamesMatching (qfunc j) j namesfrom qfunc = journalAccountNamesMatching (qfunc j) j
in [ in [
testCase "assets" $ assertEqual "" (namesfrom journalAssetAccountQuery) ["assets","assets:bank","assets:bank:checking","assets:bank:saving","assets:cash"] test "assets" $ assertEqual "" (namesfrom journalAssetAccountQuery) ["assets","assets:bank","assets:bank:checking","assets:bank:saving","assets:cash"]
,testCase "liabilities" $ assertEqual "" (namesfrom journalLiabilityAccountQuery) ["liabilities","liabilities:debts"] ,test "liabilities" $ assertEqual "" (namesfrom journalLiabilityAccountQuery) ["liabilities","liabilities:debts"]
,testCase "equity" $ assertEqual "" (namesfrom journalEquityAccountQuery) [] ,test "equity" $ assertEqual "" (namesfrom journalEquityAccountQuery) []
,testCase "income" $ assertEqual "" (namesfrom journalRevenueAccountQuery) ["income","income:gifts","income:salary"] ,test "income" $ assertEqual "" (namesfrom journalRevenueAccountQuery) ["income","income:gifts","income:salary"]
,testCase "expenses" $ assertEqual "" (namesfrom journalExpenseAccountQuery) ["expenses","expenses:food","expenses:supplies"] ,test "expenses" $ assertEqual "" (namesfrom journalExpenseAccountQuery) ["expenses","expenses:food","expenses:supplies"]
] ]
,tests "journalBalanceTransactions" [ ,tests "journalBalanceTransactions" [
testCase "balance-assignment" $ do test "balance-assignment" $ do
let ej = journalBalanceTransactions True $ let ej = journalBalanceTransactions True $
--2019/01/01 --2019/01/01
-- (a) = 1 -- (a) = 1
@ -1335,7 +1335,7 @@ tests_Journal = tests "Journal" [
let Right j = ej let Right j = ej
(jtxns j & head & tpostings & head & pamount) @?= Mixed [num 1] (jtxns j & head & tpostings & head & pamount) @?= Mixed [num 1]
,testCase "same-day-1" $ do ,test "same-day-1" $ do
assertRight $ journalBalanceTransactions True $ assertRight $ journalBalanceTransactions True $
--2019/01/01 --2019/01/01
-- (a) = 1 -- (a) = 1
@ -1346,7 +1346,7 @@ tests_Journal = tests "Journal" [
,transaction "2019/01/01" [ vpost' "a" (num 1) (balassert (num 2)) ] ,transaction "2019/01/01" [ vpost' "a" (num 1) (balassert (num 2)) ]
]} ]}
,testCase "same-day-2" $ do ,test "same-day-2" $ do
assertRight $ journalBalanceTransactions True $ assertRight $ journalBalanceTransactions True $
--2019/01/01 --2019/01/01
-- (a) 2 = 2 -- (a) 2 = 2
@ -1364,7 +1364,7 @@ tests_Journal = tests "Journal" [
,transaction "2019/01/01" [ post' "a" (num 0) (balassert (num 1)) ] ,transaction "2019/01/01" [ post' "a" (num 0) (balassert (num 1)) ]
]} ]}
,testCase "out-of-order" $ do ,test "out-of-order" $ do
assertRight $ journalBalanceTransactions True $ assertRight $ journalBalanceTransactions True $
--2019/1/2 --2019/1/2
-- (a) 1 = 2 -- (a) 1 = 2
@ -1386,7 +1386,7 @@ tests_Journal = tests "Journal" [
-- 2019/09/26 -- 2019/09/26
-- (a) 1000,000 -- (a) 1000,000
-- --
testCase "1091a" $ do test "1091a" $ do
commodityStylesFromAmounts [ commodityStylesFromAmounts [
nullamt{aquantity=1000, astyle=AmountStyle L False 3 (Just ',') Nothing} nullamt{aquantity=1000, astyle=AmountStyle L False 3 (Just ',') Nothing}
,nullamt{aquantity=1000, astyle=AmountStyle L False 2 (Just '.') (Just (DigitGroups ',' [3]))} ,nullamt{aquantity=1000, astyle=AmountStyle L False 2 (Just '.') (Just (DigitGroups ',' [3]))}
@ -1398,7 +1398,7 @@ tests_Journal = tests "Journal" [
("", AmountStyle L False 3 (Just '.') (Just (DigitGroups ',' [3]))) ("", AmountStyle L False 3 (Just '.') (Just (DigitGroups ',' [3])))
]) ])
-- same journal, entries in reverse order -- same journal, entries in reverse order
,testCase "1091b" $ do ,test "1091b" $ do
commodityStylesFromAmounts [ commodityStylesFromAmounts [
nullamt{aquantity=1000, astyle=AmountStyle L False 2 (Just '.') (Just (DigitGroups ',' [3]))} nullamt{aquantity=1000, astyle=AmountStyle L False 2 (Just '.') (Just (DigitGroups ',' [3]))}
,nullamt{aquantity=1000, astyle=AmountStyle L False 3 (Just ',') Nothing} ,nullamt{aquantity=1000, astyle=AmountStyle L False 3 (Just ',') Nothing}

View File

@ -110,7 +110,7 @@ ledgerCommodities = M.keys . jinferredcommodities . ljournal
tests_Ledger = tests_Ledger =
tests "Ledger" [ tests "Ledger" [
testCase "ledgerFromJournal" $ do test "ledgerFromJournal" $ do
length (ledgerPostings $ ledgerFromJournal Any nulljournal) @?= 0 length (ledgerPostings $ ledgerFromJournal Any nulljournal) @?= 0
length (ledgerPostings $ ledgerFromJournal Any samplejournal) @?= 13 length (ledgerPostings $ ledgerFromJournal Any samplejournal) @?= 13
length (ledgerPostings $ ledgerFromJournal (Depth 2) samplejournal) @?= 7 length (ledgerPostings $ ledgerFromJournal (Depth 2) samplejournal) @?= 7

View File

@ -392,32 +392,32 @@ commentAddTagNextLine cmt (t,v) =
tests_Posting = tests "Posting" [ tests_Posting = tests "Posting" [
testCase "accountNamePostingType" $ do test "accountNamePostingType" $ do
accountNamePostingType "a" @?= RegularPosting accountNamePostingType "a" @?= RegularPosting
accountNamePostingType "(a)" @?= VirtualPosting accountNamePostingType "(a)" @?= VirtualPosting
accountNamePostingType "[a]" @?= BalancedVirtualPosting accountNamePostingType "[a]" @?= BalancedVirtualPosting
,testCase "accountNameWithoutPostingType" $ do ,test "accountNameWithoutPostingType" $ do
accountNameWithoutPostingType "(a)" @?= "a" accountNameWithoutPostingType "(a)" @?= "a"
,testCase "accountNameWithPostingType" $ do ,test "accountNameWithPostingType" $ do
accountNameWithPostingType VirtualPosting "[a]" @?= "(a)" accountNameWithPostingType VirtualPosting "[a]" @?= "(a)"
,testCase "joinAccountNames" $ do ,test "joinAccountNames" $ do
"a" `joinAccountNames` "b:c" @?= "a:b:c" "a" `joinAccountNames` "b:c" @?= "a:b:c"
"a" `joinAccountNames` "(b:c)" @?= "(a:b:c)" "a" `joinAccountNames` "(b:c)" @?= "(a:b:c)"
"[a]" `joinAccountNames` "(b:c)" @?= "[a:b:c]" "[a]" `joinAccountNames` "(b:c)" @?= "[a:b:c]"
"" `joinAccountNames` "a" @?= "a" "" `joinAccountNames` "a" @?= "a"
,testCase "concatAccountNames" $ do ,test "concatAccountNames" $ do
concatAccountNames [] @?= "" concatAccountNames [] @?= ""
concatAccountNames ["a","(b)","[c:d]"] @?= "(a:b:c:d)" concatAccountNames ["a","(b)","[c:d]"] @?= "(a:b:c:d)"
,testCase "commentAddTag" $ do ,test "commentAddTag" $ do
commentAddTag "" ("a","") @?= "a: " commentAddTag "" ("a","") @?= "a: "
commentAddTag "[1/2]" ("a","") @?= "[1/2], a: " commentAddTag "[1/2]" ("a","") @?= "[1/2], a: "
,testCase "commentAddTagNextLine" $ do ,test "commentAddTagNextLine" $ do
commentAddTagNextLine "" ("a","") @?= "\na: " commentAddTagNextLine "" ("a","") @?= "\na: "
commentAddTagNextLine "[1/2]" ("a","") @?= "[1/2]\na: " commentAddTagNextLine "[1/2]" ("a","") @?= "[1/2]\na: "

View File

@ -145,7 +145,7 @@ formatStringTester fs value expected = actual @?= expected
tests_StringFormat = tests "StringFormat" [ tests_StringFormat = tests "StringFormat" [
testCase "formatStringHelper" $ do test "formatStringHelper" $ do
formatStringTester (FormatLiteral " ") "" " " formatStringTester (FormatLiteral " ") "" " "
formatStringTester (FormatField False Nothing Nothing DescriptionField) "description" "description" formatStringTester (FormatField False Nothing Nothing DescriptionField) "description" "description"
formatStringTester (FormatField False (Just 20) Nothing DescriptionField) "description" " description" formatStringTester (FormatField False (Just 20) Nothing DescriptionField) "description" " description"
@ -155,7 +155,7 @@ tests_StringFormat = tests "StringFormat" [
formatStringTester (FormatField True (Just 20) (Just 20) DescriptionField) "description" "description " formatStringTester (FormatField True (Just 20) (Just 20) DescriptionField) "description" "description "
formatStringTester (FormatField True Nothing (Just 3) DescriptionField) "description" "des" formatStringTester (FormatField True Nothing (Just 3) DescriptionField) "description" "des"
,let s `gives` expected = testCase s $ parseStringFormat s @?= Right expected ,let s `gives` expected = test s $ parseStringFormat s @?= Right expected
in tests "parseStringFormat" [ in tests "parseStringFormat" [
"" `gives` (defaultStringFormatStyle []) "" `gives` (defaultStringFormatStyle [])
, "D" `gives` (defaultStringFormatStyle [FormatLiteral "D"]) , "D" `gives` (defaultStringFormatStyle [FormatLiteral "D"])
@ -174,6 +174,6 @@ tests_StringFormat = tests "StringFormat" [
,FormatLiteral " " ,FormatLiteral " "
,FormatField False Nothing (Just 10) TotalField ,FormatField False Nothing (Just 10) TotalField
]) ])
, testCase "newline not parsed" $ assertLeft $ parseStringFormat "\n" , test "newline not parsed" $ assertLeft $ parseStringFormat "\n"
] ]
] ]

View File

@ -562,8 +562,8 @@ tests_Transaction =
tests "Transaction" [ tests "Transaction" [
tests "postingAsLines" [ tests "postingAsLines" [
testCase "null posting" $ postingAsLines False False [posting] posting @?= [""] test "null posting" $ postingAsLines False False [posting] posting @?= [""]
, testCase "non-null posting" $ , test "non-null posting" $
let p = let p =
posting posting
{ pstatus = Cleared { pstatus = Cleared
@ -599,35 +599,35 @@ tests_Transaction =
-- unbalanced amounts when precision is limited (#931) -- 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)]} -- t4 = nulltransaction {tpostings = ["a" `post` usd (-0.01), "b" `post` usd (0.005), "c" `post` usd (0.005)]}
in tests "postingsAsLines" [ in tests "postingsAsLines" [
testCase "null-transaction" $ postingsAsLines False (tpostings nulltransaction) @?= [] test "null-transaction" $ postingsAsLines False (tpostings nulltransaction) @?= []
, testCase "implicit-amount" $ postingsAsLines False (tpostings timp) @?= , test "implicit-amount" $ postingsAsLines False (tpostings timp) @?=
[ " a $1.00" [ " a $1.00"
, " b" -- implicit amount remains implicit , " b" -- implicit amount remains implicit
] ]
, testCase "explicit-amounts" $ postingsAsLines False (tpostings texp) @?= , test "explicit-amounts" $ postingsAsLines False (tpostings texp) @?=
[ " a $1.00" [ " a $1.00"
, " b $-1.00" , " b $-1.00"
] ]
, testCase "one-explicit-amount" $ postingsAsLines False (tpostings texp1) @?= , test "one-explicit-amount" $ postingsAsLines False (tpostings texp1) @?=
[ " (a) $1.00" [ " (a) $1.00"
] ]
, testCase "explicit-amounts-two-commodities" $ postingsAsLines False (tpostings texp2) @?= , test "explicit-amounts-two-commodities" $ postingsAsLines False (tpostings texp2) @?=
[ " a $1.00" [ " a $1.00"
, " b -1.00h @ $1.00" , " b -1.00h @ $1.00"
] ]
, testCase "explicit-amounts-not-explicitly-balanced" $ postingsAsLines False (tpostings texp2b) @?= , test "explicit-amounts-not-explicitly-balanced" $ postingsAsLines False (tpostings texp2b) @?=
[ " a $1.00" [ " a $1.00"
, " b -1.00h" , " b -1.00h"
] ]
, testCase "implicit-amount-not-last" $ postingsAsLines False (tpostings t3) @?= , test "implicit-amount-not-last" $ postingsAsLines False (tpostings t3) @?=
[" a $1.00", " b", " c $-1.00"] [" a $1.00", " b", " c $-1.00"]
-- , _testCase "ensure-visibly-balanced" $ -- , test "ensure-visibly-balanced" $
-- in postingsAsLines False (tpostings t4) @?= -- in postingsAsLines False (tpostings t4) @?=
-- [" a $-0.01", " b $0.005", " c $0.005"] -- [" a $-0.01", " b $0.005", " c $0.005"]
] ]
, testCase "inferBalancingAmount" $ do , test "inferBalancingAmount" $ do
(fst <$> inferBalancingAmount M.empty nulltransaction) @?= Right nulltransaction (fst <$> inferBalancingAmount M.empty nulltransaction) @?= Right nulltransaction
(fst <$> inferBalancingAmount M.empty nulltransaction{tpostings = ["a" `post` usd (-5), "b" `post` missingamt]}) @?= (fst <$> inferBalancingAmount M.empty nulltransaction{tpostings = ["a" `post` usd (-5), "b" `post` missingamt]}) @?=
Right nulltransaction{tpostings = ["a" `post` usd (-5), "b" `post` usd 5]} Right nulltransaction{tpostings = ["a" `post` usd (-5), "b" `post` usd 5]}
@ -635,8 +635,8 @@ tests_Transaction =
Right nulltransaction{tpostings = ["a" `post` usd (-5), "b" `post` (eur 3 @@ usd 4), "c" `post` usd 1]} Right nulltransaction{tpostings = ["a" `post` usd (-5), "b" `post` (eur 3 @@ usd 4), "c" `post` usd 1]}
, tests "showTransaction" [ , tests "showTransaction" [
testCase "null transaction" $ showTransaction nulltransaction @?= "0000/01/01\n\n" test "null transaction" $ showTransaction nulltransaction @?= "0000/01/01\n\n"
, testCase "non-null transaction" $ showTransaction , test "non-null transaction" $ showTransaction
nulltransaction nulltransaction
{ tdate = parsedate "2012/05/14" { tdate = parsedate "2012/05/14"
, tdate2 = Just $ parsedate "2012/05/15" , tdate2 = Just $ parsedate "2012/05/15"
@ -665,7 +665,7 @@ tests_Transaction =
, " ; pcomment2" , " ; pcomment2"
, "" , ""
] ]
, testCase "show a balanced transaction" $ , test "show a balanced transaction" $
(let t = (let t =
Transaction Transaction
0 0
@ -688,7 +688,7 @@ tests_Transaction =
, " assets:checking $-47.18" , " assets:checking $-47.18"
, "" , ""
]) ])
, testCase "show an unbalanced transaction, should not elide" $ , test "show an unbalanced transaction, should not elide" $
(showTransaction (showTransaction
(txnTieKnot $ (txnTieKnot $
Transaction Transaction
@ -711,7 +711,7 @@ tests_Transaction =
, " assets:checking $-47.19" , " assets:checking $-47.19"
, "" , ""
]) ])
, testCase "show a transaction with one posting and a missing amount" $ , test "show a transaction with one posting and a missing amount" $
(showTransaction (showTransaction
(txnTieKnot $ (txnTieKnot $
Transaction Transaction
@ -727,7 +727,7 @@ tests_Transaction =
[] []
[posting {paccount = "expenses:food:groceries", pamount = missingmixedamt}])) @?= [posting {paccount = "expenses:food:groceries", pamount = missingmixedamt}])) @?=
(unlines ["2007/01/28 coopportunity", " expenses:food:groceries", ""]) (unlines ["2007/01/28 coopportunity", " expenses:food:groceries", ""])
, testCase "show a transaction with a priced commodityless amount" $ , test "show a transaction with a priced commodityless amount" $
(showTransaction (showTransaction
(txnTieKnot $ (txnTieKnot $
Transaction Transaction
@ -747,7 +747,7 @@ tests_Transaction =
(unlines ["2010/01/01 x", " a 1 @ $2", " b", ""]) (unlines ["2010/01/01 x", " a 1 @ $2", " b", ""])
] ]
, tests "balanceTransaction" [ , tests "balanceTransaction" [
testCase "detect unbalanced entry, sign error" $ test "detect unbalanced entry, sign error" $
assertLeft assertLeft
(balanceTransaction (balanceTransaction
Nothing Nothing
@ -763,7 +763,7 @@ tests_Transaction =
"" ""
[] []
[posting {paccount = "a", pamount = Mixed [usd 1]}, posting {paccount = "b", pamount = Mixed [usd 1]}])) [posting {paccount = "a", pamount = Mixed [usd 1]}, posting {paccount = "b", pamount = Mixed [usd 1]}]))
,testCase "detect unbalanced entry, multiple missing amounts" $ ,test "detect unbalanced entry, multiple missing amounts" $
assertLeft $ assertLeft $
balanceTransaction balanceTransaction
Nothing Nothing
@ -781,7 +781,7 @@ tests_Transaction =
[ posting {paccount = "a", pamount = missingmixedamt} [ posting {paccount = "a", pamount = missingmixedamt}
, posting {paccount = "b", pamount = missingmixedamt} , posting {paccount = "b", pamount = missingmixedamt}
]) ])
,testCase "one missing amount is inferred" $ ,test "one missing amount is inferred" $
(pamount . last . tpostings <$> (pamount . last . tpostings <$>
balanceTransaction balanceTransaction
Nothing Nothing
@ -798,7 +798,7 @@ tests_Transaction =
[] []
[posting {paccount = "a", pamount = Mixed [usd 1]}, posting {paccount = "b", pamount = missingmixedamt}])) @?= [posting {paccount = "a", pamount = Mixed [usd 1]}, posting {paccount = "b", pamount = missingmixedamt}])) @?=
Right (Mixed [usd (-1)]) Right (Mixed [usd (-1)])
,testCase "conversion price is inferred" $ ,test "conversion price is inferred" $
(pamount . head . tpostings <$> (pamount . head . tpostings <$>
balanceTransaction balanceTransaction
Nothing Nothing
@ -817,7 +817,7 @@ tests_Transaction =
, posting {paccount = "b", pamount = Mixed [eur (-1)]} , posting {paccount = "b", pamount = Mixed [eur (-1)]}
])) @?= ])) @?=
Right (Mixed [usd 1.35 @@ (eur 1 `withPrecision` maxprecision)]) Right (Mixed [usd 1.35 @@ (eur 1 `withPrecision` maxprecision)])
,testCase "balanceTransaction balances based on cost if there are unit prices" $ ,test "balanceTransaction balances based on cost if there are unit prices" $
assertRight $ assertRight $
balanceTransaction balanceTransaction
Nothing Nothing
@ -835,7 +835,7 @@ tests_Transaction =
[ posting {paccount = "a", pamount = Mixed [usd 1 `at` eur 2]} [ posting {paccount = "a", pamount = Mixed [usd 1 `at` eur 2]}
, posting {paccount = "a", pamount = Mixed [usd (-2) `at` eur 1]} , posting {paccount = "a", pamount = Mixed [usd (-2) `at` eur 1]}
]) ])
,testCase "balanceTransaction balances based on cost if there are total prices" $ ,test "balanceTransaction balances based on cost if there are total prices" $
assertRight $ assertRight $
balanceTransaction balanceTransaction
Nothing Nothing
@ -855,7 +855,7 @@ tests_Transaction =
]) ])
] ]
, tests "isTransactionBalanced" [ , tests "isTransactionBalanced" [
testCase "detect balanced" $ test "detect balanced" $
assertBool "" $ assertBool "" $
isTransactionBalanced Nothing $ isTransactionBalanced Nothing $
Transaction Transaction
@ -872,7 +872,7 @@ tests_Transaction =
[ posting {paccount = "b", pamount = Mixed [usd 1.00]} [ posting {paccount = "b", pamount = Mixed [usd 1.00]}
, posting {paccount = "c", pamount = Mixed [usd (-1.00)]} , posting {paccount = "c", pamount = Mixed [usd (-1.00)]}
] ]
,testCase "detect unbalanced" $ ,test "detect unbalanced" $
assertBool "" $ assertBool "" $
not $ not $
isTransactionBalanced Nothing $ isTransactionBalanced Nothing $
@ -890,7 +890,7 @@ tests_Transaction =
[ posting {paccount = "b", pamount = Mixed [usd 1.00]} [ posting {paccount = "b", pamount = Mixed [usd 1.00]}
, posting {paccount = "c", pamount = Mixed [usd (-1.01)]} , posting {paccount = "c", pamount = Mixed [usd (-1.01)]}
] ]
,testCase "detect unbalanced, one posting" $ ,test "detect unbalanced, one posting" $
assertBool "" $ assertBool "" $
not $ not $
isTransactionBalanced Nothing $ isTransactionBalanced Nothing $
@ -906,7 +906,7 @@ tests_Transaction =
"" ""
[] []
[posting {paccount = "b", pamount = Mixed [usd 1.00]}] [posting {paccount = "b", pamount = Mixed [usd 1.00]}]
,testCase "one zero posting is considered balanced for now" $ ,test "one zero posting is considered balanced for now" $
assertBool "" $ assertBool "" $
isTransactionBalanced Nothing $ isTransactionBalanced Nothing $
Transaction Transaction
@ -921,7 +921,7 @@ tests_Transaction =
"" ""
[] []
[posting {paccount = "b", pamount = Mixed [usd 0]}] [posting {paccount = "b", pamount = Mixed [usd 0]}]
,testCase "virtual postings don't need to balance" $ ,test "virtual postings don't need to balance" $
assertBool "" $ assertBool "" $
isTransactionBalanced Nothing $ isTransactionBalanced Nothing $
Transaction Transaction
@ -939,7 +939,7 @@ tests_Transaction =
, posting {paccount = "c", pamount = Mixed [usd (-1.00)]} , posting {paccount = "c", pamount = Mixed [usd (-1.00)]}
, posting {paccount = "d", pamount = Mixed [usd 100], ptype = VirtualPosting} , posting {paccount = "d", pamount = Mixed [usd 100], ptype = VirtualPosting}
] ]
,testCase "balanced virtual postings need to balance among themselves" $ ,test "balanced virtual postings need to balance among themselves" $
assertBool "" $ assertBool "" $
not $ not $
isTransactionBalanced Nothing $ isTransactionBalanced Nothing $
@ -958,7 +958,7 @@ tests_Transaction =
, posting {paccount = "c", pamount = Mixed [usd (-1.00)]} , posting {paccount = "c", pamount = Mixed [usd (-1.00)]}
, posting {paccount = "d", pamount = Mixed [usd 100], ptype = BalancedVirtualPosting} , posting {paccount = "d", pamount = Mixed [usd 100], ptype = BalancedVirtualPosting}
] ]
,testCase "balanced virtual postings need to balance among themselves (2)" $ ,test "balanced virtual postings need to balance among themselves (2)" $
assertBool "" $ assertBool "" $
isTransactionBalanced Nothing $ isTransactionBalanced Nothing $
Transaction Transaction

View File

@ -273,7 +273,7 @@ tests_priceLookup =
,p "2001/01/01" "A" 11 "B" ,p "2001/01/01" "A" 11 "B"
] ]
pricesatdate = pricesAtDate ps1 pricesatdate = pricesAtDate ps1
in testCase "priceLookup" $ do in test "priceLookup" $ do
priceLookup pricesatdate (d "1999/01/01") "A" Nothing @?= Nothing 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") "A" Nothing @?= Just ("B",10)
priceLookup pricesatdate (d "2000/01/01") "B" (Just "A") @?= Just ("A",0.1) priceLookup pricesatdate (d "2000/01/01") "B" (Just "A") @?= Just ("A",0.1)

View File

@ -653,7 +653,7 @@ matchesPriceDirective _ _ = True
-- tests -- tests
tests_Query = tests "Query" [ tests_Query = tests "Query" [
testCase "simplifyQuery" $ do test "simplifyQuery" $ do
(simplifyQuery $ Or [Acct "a"]) @?= (Acct "a") (simplifyQuery $ Or [Acct "a"]) @?= (Acct "a")
(simplifyQuery $ Or [Any,None]) @?= (Any) (simplifyQuery $ Or [Any,None]) @?= (Any)
(simplifyQuery $ And [Any,None]) @?= (None) (simplifyQuery $ And [Any,None]) @?= (None)
@ -664,7 +664,7 @@ tests_Query = tests "Query" [
@?= (Date (DateSpan (Just $ parsedate "2012-01-01") (Just $ parsedate "2013-01-01"))) @?= (Date (DateSpan (Just $ parsedate "2012-01-01") (Just $ parsedate "2013-01-01")))
(simplifyQuery $ And [Or [],Or [Desc "b b"]]) @?= (Desc "b b") (simplifyQuery $ And [Or [],Or [Desc "b b"]]) @?= (Desc "b b")
,testCase "parseQuery" $ do ,test "parseQuery" $ do
(parseQuery nulldate "acct:'expenses:autres d\233penses' desc:b") @?= (And [Acct "expenses:autres d\233penses", Desc "b"], []) (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 desc:\"b b\"" @?= (Desc "b b", [QueryOptInAcct "a"])
parseQuery nulldate "inacct:a inacct:b" @?= (Any, [QueryOptInAcct "a", QueryOptInAcct "b"]) parseQuery nulldate "inacct:a inacct:b" @?= (Any, [QueryOptInAcct "a", QueryOptInAcct "b"])
@ -672,7 +672,7 @@ tests_Query = tests "Query" [
parseQuery nulldate "'a a' 'b" @?= (Or [Acct "a a",Acct "'b"], []) parseQuery nulldate "'a a' 'b" @?= (Or [Acct "a a",Acct "'b"], [])
parseQuery nulldate "\"" @?= (Acct "\"", []) parseQuery nulldate "\"" @?= (Acct "\"", [])
,testCase "words''" $ do ,test "words''" $ do
(words'' [] "a b") @?= ["a","b"] (words'' [] "a b") @?= ["a","b"]
(words'' [] "'a b'") @?= ["a b"] (words'' [] "'a b'") @?= ["a b"]
(words'' [] "not:a b") @?= ["not:a","b"] (words'' [] "not:a b") @?= ["not:a","b"]
@ -682,13 +682,13 @@ tests_Query = tests "Query" [
(words'' prefixes "\"acct:expenses:autres d\233penses\"") @?= ["acct:expenses:autres d\233penses"] (words'' prefixes "\"acct:expenses:autres d\233penses\"") @?= ["acct:expenses:autres d\233penses"]
(words'' prefixes "\"") @?= ["\""] (words'' prefixes "\"") @?= ["\""]
,testCase "filterQuery" $ do ,test "filterQuery" $ do
filterQuery queryIsDepth Any @?= Any filterQuery queryIsDepth Any @?= Any
filterQuery queryIsDepth (Depth 1) @?= Depth 1 filterQuery queryIsDepth (Depth 1) @?= Depth 1
filterQuery (not.queryIsDepth) (And [And [StatusQ Cleared,Depth 1]]) @?= StatusQ Cleared filterQuery (not.queryIsDepth) (And [And [StatusQ Cleared,Depth 1]]) @?= StatusQ Cleared
filterQuery queryIsDepth (And [Date nulldatespan, Not (Or [Any, Depth 1])]) @?= Any -- XXX unclear filterQuery queryIsDepth (And [Date nulldatespan, Not (Or [Any, Depth 1])]) @?= Any -- XXX unclear
,testCase "parseQueryTerm" $ do ,test "parseQueryTerm" $ do
parseQueryTerm nulldate "a" @?= (Left $ Acct "a") parseQueryTerm nulldate "a" @?= (Left $ Acct "a")
parseQueryTerm nulldate "acct:expenses:autres d\233penses" @?= (Left $ Acct "expenses:autres d\233penses") 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 "not:desc:a b" @?= (Left $ Not $ Desc "a b")
@ -709,7 +709,7 @@ tests_Query = tests "Query" [
parseQueryTerm nulldate "amt:<0" @?= (Left $ Amt Lt 0) parseQueryTerm nulldate "amt:<0" @?= (Left $ Amt Lt 0)
parseQueryTerm nulldate "amt:>10000.10" @?= (Left $ Amt AbsGt 10000.1) parseQueryTerm nulldate "amt:>10000.10" @?= (Left $ Amt AbsGt 10000.1)
,testCase "parseAmountQueryTerm" $ do ,test "parseAmountQueryTerm" $ do
parseAmountQueryTerm "<0" @?= (Lt,0) -- special case for convenience, since AbsLt 0 would be always false 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 ">0" @?= (Gt,0) -- special case for convenience and consistency with above
parseAmountQueryTerm ">10000.10" @?= (AbsGt,10000.1) parseAmountQueryTerm ">10000.10" @?= (AbsGt,10000.1)
@ -717,9 +717,9 @@ tests_Query = tests "Query" [
parseAmountQueryTerm "0.23" @?= (AbsEq,0.23) parseAmountQueryTerm "0.23" @?= (AbsEq,0.23)
parseAmountQueryTerm "<=+0.23" @?= (LtEq,0.23) parseAmountQueryTerm "<=+0.23" @?= (LtEq,0.23)
parseAmountQueryTerm "-0.23" @?= (Eq,(-0.23)) parseAmountQueryTerm "-0.23" @?= (Eq,(-0.23))
-- ,_test "number beginning with decimal mark" $ parseAmountQueryTerm "=.23" @?= (AbsEq,0.23) -- XXX -- ,test "number beginning with decimal mark" $ parseAmountQueryTerm "=.23" @?= (AbsEq,0.23) -- XXX
,testCase "matchesAccount" $ do ,test "matchesAccount" $ do
assertBool "" $ (Acct "b:c") `matchesAccount` "a:bb:c:d" assertBool "" $ (Acct "b:c") `matchesAccount` "a:bb:c:d"
assertBool "" $ not $ (Acct "^a:b") `matchesAccount` "c:a:b" assertBool "" $ not $ (Acct "^a:b") `matchesAccount` "c:a:b"
assertBool "" $ Depth 2 `matchesAccount` "a" assertBool "" $ Depth 2 `matchesAccount` "a"
@ -730,21 +730,21 @@ tests_Query = tests "Query" [
assertBool "" $ not $ (Tag "a" Nothing) `matchesAccount` "a" assertBool "" $ not $ (Tag "a" Nothing) `matchesAccount` "a"
,tests "matchesPosting" [ ,tests "matchesPosting" [
testCase "positive match on cleared posting status" $ test "positive match on cleared posting status" $
assertBool "" $ (StatusQ Cleared) `matchesPosting` nullposting{pstatus=Cleared} assertBool "" $ (StatusQ Cleared) `matchesPosting` nullposting{pstatus=Cleared}
,testCase "negative match on cleared posting status" $ ,test "negative match on cleared posting status" $
assertBool "" $ not $ (Not $ StatusQ Cleared) `matchesPosting` nullposting{pstatus=Cleared} assertBool "" $ not $ (Not $ StatusQ Cleared) `matchesPosting` nullposting{pstatus=Cleared}
,testCase "positive match on unmarked posting status" $ ,test "positive match on unmarked posting status" $
assertBool "" $ (StatusQ Unmarked) `matchesPosting` nullposting{pstatus=Unmarked} assertBool "" $ (StatusQ Unmarked) `matchesPosting` nullposting{pstatus=Unmarked}
,testCase "negative match on unmarked posting status" $ ,test "negative match on unmarked posting status" $
assertBool "" $ not $ (Not $ StatusQ Unmarked) `matchesPosting` nullposting{pstatus=Unmarked} assertBool "" $ not $ (Not $ StatusQ Unmarked) `matchesPosting` nullposting{pstatus=Unmarked}
,testCase "positive match on true posting status acquired from transaction" $ ,test "positive match on true posting status acquired from transaction" $
assertBool "" $ (StatusQ Cleared) `matchesPosting` nullposting{pstatus=Unmarked,ptransaction=Just nulltransaction{tstatus=Cleared}} 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} ,test "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} ,test "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} ,test "real:1 on balanced virtual posting fails" $ assertBool "" $ not $ (Real True) `matchesPosting` nullposting{ptype=BalancedVirtualPosting}
,testCase "acct:" $ assertBool "" $ (Acct "'b") `matchesPosting` nullposting{paccount="'b"} ,test "acct:" $ assertBool "" $ (Acct "'b") `matchesPosting` nullposting{paccount="'b"}
,testCase "tag:" $ do ,test "tag:" $ do
assertBool "" $ not $ (Tag "a" (Just "r$")) `matchesPosting` nullposting assertBool "" $ not $ (Tag "a" (Just "r$")) `matchesPosting` nullposting
assertBool "" $ (Tag "foo" Nothing) `matchesPosting` nullposting{ptags=[("foo","")]} assertBool "" $ (Tag "foo" Nothing) `matchesPosting` nullposting{ptags=[("foo","")]}
assertBool "" $ (Tag "foo" Nothing) `matchesPosting` nullposting{ptags=[("foo","baz")]} assertBool "" $ (Tag "foo" Nothing) `matchesPosting` nullposting{ptags=[("foo","baz")]}
@ -752,15 +752,15 @@ tests_Query = tests "Query" [
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 " (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")]} 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","")]}} ,test "a tag match on a posting also sees inherited tags" $ assertBool "" $ (Tag "txntag" Nothing) `matchesPosting` nullposting{ptransaction=Just nulltransaction{ttags=[("txntag","")]}}
,testCase "cur:" $ do ,test "cur:" $ do
assertBool "" $ not $ (Sym "$") `matchesPosting` nullposting{pamount=Mixed [usd 1]} -- becomes "^$$", ie testing for null symbol 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 "\\$") `matchesPosting` nullposting{pamount=Mixed [usd 1]} -- have to quote $ for regexpr
assertBool "" $ (Sym "shekels") `matchesPosting` nullposting{pamount=Mixed [nullamt{acommodity="shekels"}]} assertBool "" $ (Sym "shekels") `matchesPosting` nullposting{pamount=Mixed [nullamt{acommodity="shekels"}]}
assertBool "" $ not $ (Sym "shek") `matchesPosting` nullposting{pamount=Mixed [nullamt{acommodity="shekels"}]} assertBool "" $ not $ (Sym "shek") `matchesPosting` nullposting{pamount=Mixed [nullamt{acommodity="shekels"}]}
] ]
,testCase "matchesTransaction" $ do ,test "matchesTransaction" $ do
assertBool "" $ Any `matchesTransaction` nulltransaction assertBool "" $ Any `matchesTransaction` nulltransaction
assertBool "" $ not $ (Desc "x x") `matchesTransaction` nulltransaction{tdescription="x"} assertBool "" $ not $ (Desc "x x") `matchesTransaction` nulltransaction{tdescription="x"}
assertBool "" $ (Desc "x x") `matchesTransaction` nulltransaction{tdescription="x x"} assertBool "" $ (Desc "x x") `matchesTransaction` nulltransaction{tdescription="x x"}

View File

@ -1308,14 +1308,14 @@ match' p = do
tests_Common = tests "Common" [ tests_Common = tests "Common" [
tests "amountp" [ tests "amountp" [
testCase "basic" $ assertParseEq amountp "$47.18" (usd 47.18) test "basic" $ assertParseEq amountp "$47.18" (usd 47.18)
,testCase "ends with decimal mark" $ assertParseEq amountp "$1." (usd 1 `withPrecision` 0) ,test "ends with decimal mark" $ assertParseEq amountp "$1." (usd 1 `withPrecision` 0)
,testCase "unit price" $ assertParseEq amountp "$10 @ €0.5" ,test "unit price" $ assertParseEq amountp "$10 @ €0.5"
-- not precise enough: -- not precise enough:
-- (usd 10 `withPrecision` 0 `at` (eur 0.5 `withPrecision` 1)) -- `withStyle` asdecimalpoint=Just '.' -- (usd 10 `withPrecision` 0 `at` (eur 0.5 `withPrecision` 1)) -- `withStyle` asdecimalpoint=Just '.'
amount{ amount{
acommodity="$" acommodity="$"
,aquantity=10 -- need to testCase internal precision with roundTo ? I think not ,aquantity=10 -- need to test internal precision with roundTo ? I think not
,astyle=amountstyle{asprecision=0, asdecimalpoint=Nothing} ,astyle=amountstyle{asprecision=0, asdecimalpoint=Nothing}
,aprice=Just $ UnitPrice $ ,aprice=Just $ UnitPrice $
amount{ amount{
@ -1324,7 +1324,7 @@ tests_Common = tests "Common" [
,astyle=amountstyle{asprecision=1, asdecimalpoint=Just '.'} ,astyle=amountstyle{asprecision=1, asdecimalpoint=Just '.'}
} }
} }
,testCase "total price" $ assertParseEq amountp "$10 @@ €5" ,test "total price" $ assertParseEq amountp "$10 @@ €5"
amount{ amount{
acommodity="$" acommodity="$"
,aquantity=10 ,aquantity=10
@ -1339,7 +1339,7 @@ tests_Common = tests "Common" [
] ]
,let p = lift (numberp Nothing) :: JournalParser IO (Quantity, Int, Maybe Char, Maybe DigitGroupStyle) in ,let p = lift (numberp Nothing) :: JournalParser IO (Quantity, Int, Maybe Char, Maybe DigitGroupStyle) in
testCase "numberp" $ do test "numberp" $ do
assertParseEq p "0" (0, 0, Nothing, Nothing) assertParseEq p "0" (0, 0, Nothing, Nothing)
assertParseEq p "1" (1, 0, Nothing, Nothing) assertParseEq p "1" (1, 0, Nothing, Nothing)
assertParseEq p "1.1" (1.1, 1, Just '.', Nothing) assertParseEq p "1.1" (1.1, 1, Just '.', Nothing)
@ -1360,10 +1360,10 @@ tests_Common = tests "Common" [
assertParseError p ",1." "" assertParseError p ",1." ""
,tests "spaceandamountormissingp" [ ,tests "spaceandamountormissingp" [
testCase "space and amount" $ assertParseEq spaceandamountormissingp " $47.18" (Mixed [usd 47.18]) test "space and amount" $ assertParseEq spaceandamountormissingp " $47.18" (Mixed [usd 47.18])
,testCase "empty string" $ assertParseEq spaceandamountormissingp "" missingmixedamt ,test "empty string" $ assertParseEq spaceandamountormissingp "" missingmixedamt
-- ,_testCase "just space" $ assertParseEq spaceandamountormissingp " " missingmixedamt -- XXX should it ? -- ,test "just space" $ assertParseEq spaceandamountormissingp " " missingmixedamt -- XXX should it ?
-- ,testCase "just amount" $ assertParseError spaceandamountormissingp "$47.18" "" -- succeeds, consuming nothing -- ,test "just amount" $ assertParseError spaceandamountormissingp "$47.18" "" -- succeeds, consuming nothing
] ]
] ]

View File

@ -987,25 +987,25 @@ parseDateWithFormatOrDefaultFormats mformat s = firstJust $ map parsewith format
tests_CsvReader = tests "CsvReader" [ tests_CsvReader = tests "CsvReader" [
tests "parseCsvRules" [ tests "parseCsvRules" [
testCase"empty file" $ test"empty file" $
parseCsvRules "unknown" "" @?= Right defrules parseCsvRules "unknown" "" @?= Right defrules
] ]
,tests "rulesp" [ ,tests "rulesp" [
testCase"trailing comments" $ test"trailing comments" $
parseWithState' defrules rulesp "skip\n# \n#\n" @?= Right defrules{rdirectives = [("skip","")]} parseWithState' defrules rulesp "skip\n# \n#\n" @?= Right defrules{rdirectives = [("skip","")]}
,testCase"trailing blank lines" $ ,test"trailing blank lines" $
parseWithState' defrules rulesp "skip\n\n \n" @?= (Right defrules{rdirectives = [("skip","")]}) parseWithState' defrules rulesp "skip\n\n \n" @?= (Right defrules{rdirectives = [("skip","")]})
,testCase"no final newline" $ ,test"no final newline" $
parseWithState' defrules rulesp "skip" @?= (Right defrules{rdirectives=[("skip","")]}) parseWithState' defrules rulesp "skip" @?= (Right defrules{rdirectives=[("skip","")]})
,testCase"assignment with empty value" $ ,test"assignment with empty value" $
parseWithState' defrules rulesp "account1 \nif foo\n account2 foo\n" @?= parseWithState' defrules rulesp "account1 \nif foo\n account2 foo\n" @?=
(Right defrules{rassignments = [("account1","")], rconditionalblocks = [([["foo"]],[("account2","foo")])]}) (Right defrules{rassignments = [("account1","")], rconditionalblocks = [([["foo"]],[("account2","foo")])]})
] ]
,tests "conditionalblockp" [ ,tests "conditionalblockp" [
testCase"space after conditional" $ -- #1120 test"space after conditional" $ -- #1120
parseWithState' defrules conditionalblockp "if a\n account2 b\n \n" @?= parseWithState' defrules conditionalblockp "if a\n account2 b\n \n" @?=
(Right ([["a"]],[("account2","b")])) (Right ([["a"]],[("account2","b")]))
] ]

View File

@ -670,10 +670,10 @@ tests_JournalReader = tests "JournalReader" [
let p = lift accountnamep :: JournalParser IO AccountName in let p = lift accountnamep :: JournalParser IO AccountName in
tests "accountnamep" [ tests "accountnamep" [
testCase "basic" $ assertParse p "a:b:c" test "basic" $ assertParse p "a:b:c"
-- ,_testCase "empty inner component" $ assertParseError p "a::c" "" -- TODO -- ,test "empty inner component" $ assertParseError p "a::c" "" -- TODO
-- ,_testCase "empty leading component" $ assertParseError p ":b:c" "x" -- ,test "empty leading component" $ assertParseError p ":b:c" "x"
-- ,_testCase "empty trailing component" $ assertParseError p "a:b:" "x" -- ,test "empty trailing component" $ assertParseError p "a:b:" "x"
] ]
-- "Parse a date in YYYY/MM/DD format. -- "Parse a date in YYYY/MM/DD format.
@ -681,17 +681,17 @@ tests_JournalReader = tests "JournalReader" [
-- The year may be omitted if a default year has been set. -- The year may be omitted if a default year has been set.
-- Leading zeroes may be omitted." -- Leading zeroes may be omitted."
,tests "datep" [ ,tests "datep" [
testCase "YYYY/MM/DD" $ assertParseEq datep "2018/01/01" (fromGregorian 2018 1 1) test "YYYY/MM/DD" $ assertParseEq datep "2018/01/01" (fromGregorian 2018 1 1)
,testCase "YYYY-MM-DD" $ assertParse datep "2018-01-01" ,test "YYYY-MM-DD" $ assertParse datep "2018-01-01"
,testCase "YYYY.MM.DD" $ assertParse datep "2018.01.01" ,test "YYYY.MM.DD" $ assertParse datep "2018.01.01"
,testCase "yearless date with no default year" $ assertParseError datep "1/1" "current year is unknown" ,test "yearless date with no default year" $ assertParseError datep "1/1" "current year is unknown"
,testCase "yearless date with default year" $ do ,test "yearless date with default year" $ do
let s = "1/1" let s = "1/1"
ep <- parseWithState mempty{jparsedefaultyear=Just 2018} datep s ep <- parseWithState mempty{jparsedefaultyear=Just 2018} datep s
either (assertFailure . ("parse error at "++) . customErrorBundlePretty) (const $ return ()) ep either (assertFailure . ("parse error at "++) . customErrorBundlePretty) (const $ return ()) ep
,testCase "no leading zero" $ assertParse datep "2018/1/1" ,test "no leading zero" $ assertParse datep "2018/1/1"
] ]
,testCase "datetimep" $ do ,test "datetimep" $ do
let let
good = assertParse datetimep good = assertParse datetimep
bad = (\t -> assertParseError datetimep t "") bad = (\t -> assertParseError datetimep t "")
@ -709,7 +709,7 @@ tests_JournalReader = tests "JournalReader" [
,tests "periodictransactionp" [ ,tests "periodictransactionp" [
testCase "more period text in comment after one space" $ assertParseEq periodictransactionp test "more period text in comment after one space" $ assertParseEq periodictransactionp
"~ monthly from 2018/6 ;In 2019 we will change this\n" "~ monthly from 2018/6 ;In 2019 we will change this\n"
nullperiodictransaction { nullperiodictransaction {
ptperiodexpr = "monthly from 2018/6" ptperiodexpr = "monthly from 2018/6"
@ -719,7 +719,7 @@ tests_JournalReader = tests "JournalReader" [
,ptcomment = "In 2019 we will change this\n" ,ptcomment = "In 2019 we will change this\n"
} }
,testCase "more period text in description after two spaces" $ assertParseEq periodictransactionp ,test "more period text in description after two spaces" $ assertParseEq periodictransactionp
"~ monthly from 2018/6 In 2019 we will change this\n" "~ monthly from 2018/6 In 2019 we will change this\n"
nullperiodictransaction { nullperiodictransaction {
ptperiodexpr = "monthly from 2018/6" ptperiodexpr = "monthly from 2018/6"
@ -729,7 +729,7 @@ tests_JournalReader = tests "JournalReader" [
,ptcomment = "" ,ptcomment = ""
} }
,testCase "Next year in description" $ assertParseEq periodictransactionp ,test "Next year in description" $ assertParseEq periodictransactionp
"~ monthly Next year blah blah\n" "~ monthly Next year blah blah\n"
nullperiodictransaction { nullperiodictransaction {
ptperiodexpr = "monthly" ptperiodexpr = "monthly"
@ -739,7 +739,7 @@ tests_JournalReader = tests "JournalReader" [
,ptcomment = "" ,ptcomment = ""
} }
,testCase "Just date, no description" $ assertParseEq periodictransactionp ,test "Just date, no description" $ assertParseEq periodictransactionp
"~ 2019-01-04\n" "~ 2019-01-04\n"
nullperiodictransaction { nullperiodictransaction {
ptperiodexpr = "2019-01-04" ptperiodexpr = "2019-01-04"
@ -749,13 +749,13 @@ tests_JournalReader = tests "JournalReader" [
,ptcomment = "" ,ptcomment = ""
} }
,testCase "Just date, no description + empty transaction comment" $ assertParse periodictransactionp ,test "Just date, no description + empty transaction comment" $ assertParse periodictransactionp
"~ 2019-01-04\n ;\n a 1\n b\n" "~ 2019-01-04\n ;\n a 1\n b\n"
] ]
,tests "postingp" [ ,tests "postingp" [
testCase "basic" $ assertParseEq (postingp Nothing) test "basic" $ assertParseEq (postingp Nothing)
" expenses:food:dining $10.00 ; a: a a \n ; b: b b \n" " expenses:food:dining $10.00 ; a: a a \n ; b: b b \n"
posting{ posting{
paccount="expenses:food:dining", paccount="expenses:food:dining",
@ -764,7 +764,7 @@ tests_JournalReader = tests "JournalReader" [
ptags=[("a","a a"), ("b","b b")] ptags=[("a","a a"), ("b","b b")]
} }
,testCase "posting dates" $ assertParseEq (postingp Nothing) ,test "posting dates" $ assertParseEq (postingp Nothing)
" a 1. ; date:2012/11/28, date2=2012/11/29,b:b\n" " a 1. ; date:2012/11/28, date2=2012/11/29,b:b\n"
nullposting{ nullposting{
paccount="a" paccount="a"
@ -775,7 +775,7 @@ tests_JournalReader = tests "JournalReader" [
,pdate2=Nothing -- Just $ fromGregorian 2012 11 29 ,pdate2=Nothing -- Just $ fromGregorian 2012 11 29
} }
,testCase "posting dates bracket syntax" $ assertParseEq (postingp Nothing) ,test "posting dates bracket syntax" $ assertParseEq (postingp Nothing)
" a 1. ; [2012/11/28=2012/11/29]\n" " a 1. ; [2012/11/28=2012/11/29]\n"
nullposting{ nullposting{
paccount="a" paccount="a"
@ -786,16 +786,16 @@ tests_JournalReader = tests "JournalReader" [
,pdate2=Just $ fromGregorian 2012 11 29 ,pdate2=Just $ fromGregorian 2012 11 29
} }
,testCase "quoted commodity symbol with digits" $ assertParse (postingp Nothing) " a 1 \"DE123\"\n" ,test "quoted commodity symbol with digits" $ assertParse (postingp Nothing) " a 1 \"DE123\"\n"
,testCase "balance assertion and fixed lot price" $ assertParse (postingp Nothing) " a 1 \"DE123\" =$1 { =2.2 EUR} \n" ,test "balance assertion and fixed lot price" $ assertParse (postingp Nothing) " a 1 \"DE123\" =$1 { =2.2 EUR} \n"
,testCase "balance assertion over entire contents of account" $ assertParse (postingp Nothing) " a $1 == $1\n" ,test "balance assertion over entire contents of account" $ assertParse (postingp Nothing) " a $1 == $1\n"
] ]
,tests "transactionmodifierp" [ ,tests "transactionmodifierp" [
testCase "basic" $ assertParseEq transactionmodifierp test "basic" $ assertParseEq transactionmodifierp
"= (some value expr)\n some:postings 1.\n" "= (some value expr)\n some:postings 1.\n"
nulltransactionmodifier { nulltransactionmodifier {
tmquerytxt = "(some value expr)" tmquerytxt = "(some value expr)"
@ -805,9 +805,9 @@ tests_JournalReader = tests "JournalReader" [
,tests "transactionp" [ ,tests "transactionp" [
testCase "just a date" $ assertParseEq transactionp "2015/1/1\n" nulltransaction{tdate=fromGregorian 2015 1 1} test "just a date" $ assertParseEq transactionp "2015/1/1\n" nulltransaction{tdate=fromGregorian 2015 1 1}
,testCase "more complex" $ assertParseEq transactionp ,test "more complex" $ assertParseEq transactionp
(T.unlines [ (T.unlines [
"2012/05/14=2012/05/15 (code) desc ; tcomment1", "2012/05/14=2012/05/15 (code) desc ; tcomment1",
" ; tcomment2", " ; tcomment2",
@ -841,7 +841,7 @@ tests_JournalReader = tests "JournalReader" [
] ]
} }
,testCase "parses a well-formed transaction" $ ,test "parses a well-formed transaction" $
assertBool "" $ isRight $ rjp transactionp $ T.unlines assertBool "" $ isRight $ rjp transactionp $ T.unlines
["2007/01/28 coopportunity" ["2007/01/28 coopportunity"
," expenses:food:groceries $47.18" ," expenses:food:groceries $47.18"
@ -849,10 +849,10 @@ tests_JournalReader = tests "JournalReader" [
,"" ,""
] ]
,testCase "does not parse a following comment as part of the description" $ ,test "does not parse a following comment as part of the description" $
assertParseEqOn transactionp "2009/1/1 a ;comment\n b 1\n" tdescription "a" assertParseEqOn transactionp "2009/1/1 a ;comment\n b 1\n" tdescription "a"
,testCase "parses a following whitespace line" $ ,test "parses a following whitespace line" $
assertBool "" $ isRight $ rjp transactionp $ T.unlines assertBool "" $ isRight $ rjp transactionp $ T.unlines
["2012/1/1" ["2012/1/1"
," a 1" ," a 1"
@ -860,7 +860,7 @@ tests_JournalReader = tests "JournalReader" [
," " ," "
] ]
,testCase "parses an empty transaction comment following whitespace line" $ ,test "parses an empty transaction comment following whitespace line" $
assertBool "" $ isRight $ rjp transactionp $ T.unlines assertBool "" $ isRight $ rjp transactionp $ T.unlines
["2012/1/1" ["2012/1/1"
," ;" ," ;"
@ -869,7 +869,7 @@ tests_JournalReader = tests "JournalReader" [
," " ," "
] ]
,testCase "comments everywhere, two postings parsed" $ ,test "comments everywhere, two postings parsed" $
assertParseEqOn transactionp assertParseEqOn transactionp
(T.unlines (T.unlines
["2009/1/1 x ; transaction comment" ["2009/1/1 x ; transaction comment"
@ -886,16 +886,16 @@ tests_JournalReader = tests "JournalReader" [
-- directives -- directives
,tests "directivep" [ ,tests "directivep" [
testCase "supports !" $ do test "supports !" $ do
assertParseE directivep "!account a\n" assertParseE directivep "!account a\n"
assertParseE directivep "!D 1.0\n" assertParseE directivep "!D 1.0\n"
] ]
,tests "accountdirectivep" [ ,tests "accountdirectivep" [
testCase "with-comment" $ assertParse accountdirectivep "account a:b ; a comment\n" test "with-comment" $ assertParse accountdirectivep "account a:b ; a comment\n"
,testCase "does-not-support-!" $ assertParseError accountdirectivep "!account a:b\n" "" ,test "does-not-support-!" $ assertParseError accountdirectivep "!account a:b\n" ""
,testCase "account-type-code" $ assertParse accountdirectivep "account a:b A\n" ,test "account-type-code" $ assertParse accountdirectivep "account a:b A\n"
,testCase "account-type-tag" $ assertParseStateOn accountdirectivep "account a:b ; type:asset\n" ,test "account-type-tag" $ assertParseStateOn accountdirectivep "account a:b ; type:asset\n"
jdeclaredaccounts jdeclaredaccounts
[("a:b", AccountDeclarationInfo{adicomment = "type:asset\n" [("a:b", AccountDeclarationInfo{adicomment = "type:asset\n"
,aditags = [("type","asset")] ,aditags = [("type","asset")]
@ -904,28 +904,28 @@ tests_JournalReader = tests "JournalReader" [
] ]
] ]
,testCase "commodityconversiondirectivep" $ do ,test "commodityconversiondirectivep" $ do
assertParse commodityconversiondirectivep "C 1h = $50.00\n" assertParse commodityconversiondirectivep "C 1h = $50.00\n"
,testCase "defaultcommoditydirectivep" $ do ,test "defaultcommoditydirectivep" $ do
assertParse defaultcommoditydirectivep "D $1,000.0\n" assertParse defaultcommoditydirectivep "D $1,000.0\n"
assertParseError defaultcommoditydirectivep "D $1000\n" "please include a decimal separator" assertParseError defaultcommoditydirectivep "D $1000\n" "please include a decimal separator"
,tests "defaultyeardirectivep" [ ,tests "defaultyeardirectivep" [
testCase "1000" $ assertParse defaultyeardirectivep "Y 1000" -- XXX no \n like the others test "1000" $ assertParse defaultyeardirectivep "Y 1000" -- XXX no \n like the others
,testCase "999" $ assertParseError defaultyeardirectivep "Y 999" "bad year number" ,test "999" $ assertParseError defaultyeardirectivep "Y 999" "bad year number"
,testCase "12345" $ assertParse defaultyeardirectivep "Y 12345" ,test "12345" $ assertParse defaultyeardirectivep "Y 12345"
] ]
,testCase "ignoredpricecommoditydirectivep" $ do ,test "ignoredpricecommoditydirectivep" $ do
assertParse ignoredpricecommoditydirectivep "N $\n" assertParse ignoredpricecommoditydirectivep "N $\n"
,tests "includedirectivep" [ ,tests "includedirectivep" [
testCase "include" $ assertParseErrorE includedirectivep "include nosuchfile\n" "No existing files match pattern: nosuchfile" test "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 "glob" $ assertParseErrorE includedirectivep "include nosuchfile*\n" "No existing files match pattern: nosuchfile*"
] ]
,testCase "marketpricedirectivep" $ assertParseEq marketpricedirectivep ,test "marketpricedirectivep" $ assertParseEq marketpricedirectivep
"P 2017/01/30 BTC $922.83\n" "P 2017/01/30 BTC $922.83\n"
PriceDirective{ PriceDirective{
pddate = fromGregorian 2017 1 30, pddate = fromGregorian 2017 1 30,
@ -933,19 +933,19 @@ tests_JournalReader = tests "JournalReader" [
pdamount = usd 922.83 pdamount = usd 922.83
} }
,testCase "tagdirectivep" $ do ,test "tagdirectivep" $ do
assertParse tagdirectivep "tag foo \n" assertParse tagdirectivep "tag foo \n"
,testCase "endtagdirectivep" $ do ,test "endtagdirectivep" $ do
assertParse endtagdirectivep "end tag \n" assertParse endtagdirectivep "end tag \n"
assertParse endtagdirectivep "pop \n" assertParse endtagdirectivep "pop \n"
,tests "journalp" [ ,tests "journalp" [
testCase "empty file" $ assertParseEqE journalp "" nulljournal test "empty file" $ assertParseEqE journalp "" nulljournal
] ]
-- these are defined here rather than in Common so they can use journalp -- these are defined here rather than in Common so they can use journalp
,testCase "parseAndFinaliseJournal" $ do ,test "parseAndFinaliseJournal" $ do
ej <- runExceptT $ parseAndFinaliseJournal journalp definputopts "" "2019-1-1\n" ej <- runExceptT $ parseAndFinaliseJournal journalp definputopts "" "2019-1-1\n"
let Right j = ej let Right j = ej
assertEqual "" [""] $ journalFilePaths j assertEqual "" [""] $ journalFilePaths j

View File

@ -259,10 +259,10 @@ tests_BalanceReport = tests "BalanceReport" [
in in
tests "balanceReport" [ tests "balanceReport" [
testCase "no args, null journal" $ test "no args, null journal" $
(defreportopts, nulljournal) `gives` ([], Mixed [nullamt]) (defreportopts, nulljournal) `gives` ([], Mixed [nullamt])
,testCase "no args, sample journal" $ ,test "no args, sample journal" $
(defreportopts, samplejournal) `gives` (defreportopts, samplejournal) `gives`
([ ([
("assets","assets",0, mamountp' "$0.00") ("assets","assets",0, mamountp' "$0.00")
@ -279,7 +279,7 @@ tests_BalanceReport = tests "BalanceReport" [
], ],
Mixed [usd 0]) Mixed [usd 0])
,testCase "with --depth=N" $ ,test "with --depth=N" $
(defreportopts{depth_=Just 1}, samplejournal) `gives` (defreportopts{depth_=Just 1}, samplejournal) `gives`
([ ([
("expenses", "expenses", 0, mamountp' "$2.00") ("expenses", "expenses", 0, mamountp' "$2.00")
@ -287,7 +287,7 @@ tests_BalanceReport = tests "BalanceReport" [
], ],
Mixed [usd 0]) Mixed [usd 0])
,testCase "with depth:N" $ ,test "with depth:N" $
(defreportopts{query_="depth:1"}, samplejournal) `gives` (defreportopts{query_="depth:1"}, samplejournal) `gives`
([ ([
("expenses", "expenses", 0, mamountp' "$2.00") ("expenses", "expenses", 0, mamountp' "$2.00")
@ -295,12 +295,12 @@ tests_BalanceReport = tests "BalanceReport" [
], ],
Mixed [usd 0]) Mixed [usd 0])
,testCase "with date:" $ ,test "with date:" $
(defreportopts{query_="date:'in 2009'"}, samplejournal2) `gives` (defreportopts{query_="date:'in 2009'"}, samplejournal2) `gives`
([], ([],
Mixed [nullamt]) Mixed [nullamt])
,testCase "with date2:" $ ,test "with date2:" $
(defreportopts{query_="date2:'in 2009'"}, samplejournal2) `gives` (defreportopts{query_="date2:'in 2009'"}, samplejournal2) `gives`
([ ([
("assets:bank:checking","assets:bank:checking",0,mamountp' "$1.00") ("assets:bank:checking","assets:bank:checking",0,mamountp' "$1.00")
@ -308,7 +308,7 @@ tests_BalanceReport = tests "BalanceReport" [
], ],
Mixed [usd 0]) Mixed [usd 0])
,testCase "with desc:" $ ,test "with desc:" $
(defreportopts{query_="desc:income"}, samplejournal) `gives` (defreportopts{query_="desc:income"}, samplejournal) `gives`
([ ([
("assets:bank:checking","assets:bank:checking",0,mamountp' "$1.00") ("assets:bank:checking","assets:bank:checking",0,mamountp' "$1.00")
@ -316,7 +316,7 @@ tests_BalanceReport = tests "BalanceReport" [
], ],
Mixed [usd 0]) Mixed [usd 0])
,testCase "with not:desc:" $ ,test "with not:desc:" $
(defreportopts{query_="not:desc:income"}, samplejournal) `gives` (defreportopts{query_="not:desc:income"}, samplejournal) `gives`
([ ([
("assets","assets",0, mamountp' "$-1.00") ("assets","assets",0, mamountp' "$-1.00")
@ -329,7 +329,7 @@ tests_BalanceReport = tests "BalanceReport" [
], ],
Mixed [usd 0]) Mixed [usd 0])
,testCase "with period on a populated period" $ ,test "with period on a populated period" $
(defreportopts{period_= PeriodBetween (fromGregorian 2008 1 1) (fromGregorian 2008 1 2)}, samplejournal) `gives` (defreportopts{period_= PeriodBetween (fromGregorian 2008 1 1) (fromGregorian 2008 1 2)}, samplejournal) `gives`
( (
[ [
@ -338,7 +338,7 @@ tests_BalanceReport = tests "BalanceReport" [
], ],
Mixed [usd 0]) Mixed [usd 0])
,testCase "with period on an unpopulated period" $ ,test "with period on an unpopulated period" $
(defreportopts{period_= PeriodBetween (fromGregorian 2008 1 2) (fromGregorian 2008 1 3)}, samplejournal) `gives` (defreportopts{period_= PeriodBetween (fromGregorian 2008 1 2) (fromGregorian 2008 1 3)}, samplejournal) `gives`
([],Mixed [nullamt]) ([],Mixed [nullamt])

View File

@ -49,8 +49,8 @@ entriesReport ropts@ReportOpts{..} q j@Journal{..} =
tests_EntriesReport = tests "EntriesReport" [ tests_EntriesReport = tests "EntriesReport" [
tests "entriesReport" [ tests "entriesReport" [
testCase "not acct" $ (length $ entriesReport defreportopts (Not $ Acct "bank") samplejournal) @?= 1 test "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 ,test "date" $ (length $ entriesReport defreportopts (Date $ mkdatespan "2008/06/01" "2008/07/01") samplejournal) @?= 3
] ]
] ]

View File

@ -427,10 +427,10 @@ tests_MultiBalanceReport = tests "MultiBalanceReport" [
((\(_, b, _) -> showMixedAmountDebug b) atotal) @?= (showMixedAmountDebug etotal) -- we only check the sum of the totals ((\(_, b, _) -> showMixedAmountDebug b) atotal) @?= (showMixedAmountDebug etotal) -- we only check the sum of the totals
in in
tests "multiBalanceReport" [ tests "multiBalanceReport" [
testCase "null journal" $ test "null journal" $
(defreportopts, nulljournal) `gives` ([], Mixed [nullamt]) (defreportopts, nulljournal) `gives` ([], Mixed [nullamt])
,testCase "with -H on a populated period" $ ,test "with -H on a populated period" $
(defreportopts{period_= PeriodBetween (fromGregorian 2008 1 1) (fromGregorian 2008 1 2), balancetype_=HistoricalBalance}, samplejournal) `gives` (defreportopts{period_= PeriodBetween (fromGregorian 2008 1 1) (fromGregorian 2008 1 2), balancetype_=HistoricalBalance}, samplejournal) `gives`
( (
[ [
@ -439,7 +439,7 @@ tests_MultiBalanceReport = tests "MultiBalanceReport" [
], ],
Mixed [nullamt]) Mixed [nullamt])
-- ,testCase "a valid history on an empty period" $ -- ,test "a valid history on an empty period" $
-- (defreportopts{period_= PeriodBetween (fromGregorian 2008 1 2) (fromGregorian 2008 1 3), balancetype_=HistoricalBalance}, samplejournal) `gives` -- (defreportopts{period_= PeriodBetween (fromGregorian 2008 1 2) (fromGregorian 2008 1 3), balancetype_=HistoricalBalance}, samplejournal) `gives`
-- ( -- (
-- [ -- [
@ -448,7 +448,7 @@ tests_MultiBalanceReport = tests "MultiBalanceReport" [
-- ], -- ],
-- Mixed [usd0]) -- Mixed [usd0])
-- ,testCase "a valid history on an empty period (more complex)" $ -- ,test "a valid history on an empty period (more complex)" $
-- (defreportopts{period_= PeriodBetween (fromGregorian 2009 1 1) (fromGregorian 2009 1 2), balancetype_=HistoricalBalance}, samplejournal) `gives` -- (defreportopts{period_= PeriodBetween (fromGregorian 2009 1 1) (fromGregorian 2009 1 2), balancetype_=HistoricalBalance}, samplejournal) `gives`
-- ( -- (
-- [ -- [

View File

@ -270,7 +270,7 @@ negatePostingAmount p = p { pamount = negate $ pamount p }
tests_PostingsReport = tests "PostingsReport" [ tests_PostingsReport = tests "PostingsReport" [
testCase "postingsReport" $ do test "postingsReport" $ do
let (query, journal) `gives` n = (length $ snd $ postingsReport defreportopts query journal) @?= n let (query, journal) `gives` n = (length $ snd $ postingsReport defreportopts query journal) @?= n
-- with the query specified explicitly -- with the query specified explicitly
(Any, nulljournal) `gives` 0 (Any, nulljournal) `gives` 0
@ -431,7 +431,7 @@ tests_PostingsReport = tests "PostingsReport" [
-} -}
,testCase "summarisePostingsByInterval" $ ,test "summarisePostingsByInterval" $
summarisePostingsByInterval (Quarters 1) PrimaryDate 99999 False (DateSpan Nothing Nothing) [] @?= [] summarisePostingsByInterval (Quarters 1) PrimaryDate 99999 False (DateSpan Nothing Nothing) [] @?= []
-- ,tests_summarisePostingsInDateSpan = [ -- ,tests_summarisePostingsInDateSpan = [

View File

@ -539,7 +539,7 @@ reportPeriodOrJournalLastDay ropts@ReportOpts{..} j =
-- tests -- tests
tests_ReportOptions = tests "ReportOptions" [ tests_ReportOptions = tests "ReportOptions" [
testCase "queryFromOpts" $ do test "queryFromOpts" $ do
queryFromOpts nulldate defreportopts @?= Any queryFromOpts nulldate defreportopts @?= Any
queryFromOpts nulldate defreportopts{query_="a"} @?= Acct "a" queryFromOpts nulldate defreportopts{query_="a"} @?= Acct "a"
queryFromOpts nulldate defreportopts{query_="desc:'a a'"} @?= Desc "a a" queryFromOpts nulldate defreportopts{query_="desc:'a a'"} @?= Desc "a a"
@ -548,7 +548,7 @@ tests_ReportOptions = tests "ReportOptions" [
queryFromOpts nulldate defreportopts{query_="date2:'in 2012'"} @?= (Date2 $ 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"] queryFromOpts nulldate defreportopts{query_="'a a' 'b"} @?= Or [Acct "a a", Acct "'b"]
,testCase "queryOptsFromOpts" $ do ,test "queryOptsFromOpts" $ do
queryOptsFromOpts nulldate defreportopts @?= [] queryOptsFromOpts nulldate defreportopts @?= []
queryOptsFromOpts nulldate defreportopts{query_="a"} @?= [] queryOptsFromOpts nulldate defreportopts{query_="a"} @?= []
queryOptsFromOpts nulldate defreportopts{period_=PeriodFrom (parsedate "2012/01/01") queryOptsFromOpts nulldate defreportopts{period_=PeriodFrom (parsedate "2012/01/01")

View File

@ -421,7 +421,7 @@ textWidth s = maximum $ map (T.foldr (\a b -> charWidth a + b) 0) $ T.lines s
tests_Text = tests "Text" [ tests_Text = tests "Text" [
testCase "quoteIfSpaced" $ do test "quoteIfSpaced" $ do
quoteIfSpaced "a'a" @?= "a'a" quoteIfSpaced "a'a" @?= "a'a"
quoteIfSpaced "a\"a" @?= "a\"a" quoteIfSpaced "a\"a" @?= "a\"a"
quoteIfSpaced "a a" @?= "\"a a\"" quoteIfSpaced "a a" @?= "\"a a\""

View File

@ -288,7 +288,7 @@ tests_Commands = tests "Commands" [
-- some more tests easiest to define here: -- some more tests easiest to define here:
,tests "apply account directive" [ ,tests "apply account directive" [
testCase "works" $ do test "works" $ do
let let
ignoresourcepos j = j{jtxns=map (\t -> t{tsourcepos=nullsourcepos}) (jtxns j)} ignoresourcepos j = j{jtxns=map (\t -> t{tsourcepos=nullsourcepos}) (jtxns j)}
sameParse str1 str2 = do sameParse str1 str2 = do
@ -309,23 +309,23 @@ tests_Commands = tests "Commands" [
"2008/12/07 Five\n foo $-5\n bar $5\n" "2008/12/07 Five\n foo $-5\n bar $5\n"
) )
,testCase "preserves \"virtual\" posting type" $ do ,test "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 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 let p = head $ tpostings $ head $ jtxns j
paccount p @?= "test:from" paccount p @?= "test:from"
ptype p @?= VirtualPosting ptype p @?= VirtualPosting
] ]
,testCase "alias directive" $ do ,test "alias directive" $ do
j <- readJournal def Nothing "!alias expenses = equity:draw:personal\n1/1\n (expenses:food) 1\n" >>= either error' return 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 let p = head $ tpostings $ head $ jtxns j
paccount p @?= "equity:draw:personal:food" paccount p @?= "equity:draw:personal:food"
,testCase "Y default year directive" $ do ,test "Y default year directive" $ do
j <- readJournal def Nothing defaultyear_journal_txt >>= either error' return j <- readJournal def Nothing defaultyear_journal_txt >>= either error' return
tdate (head $ jtxns j) @?= fromGregorian 2009 1 1 tdate (head $ jtxns j) @?= fromGregorian 2009 1 1
,testCase "ledgerAccountNames" $ ,test "ledgerAccountNames" $
(ledgerAccountNames ledger7) (ledgerAccountNames ledger7)
@?= @?=
["assets","assets:cash","assets:checking","assets:saving","equity","equity:opening balances", ["assets","assets:cash","assets:checking","assets:saving","equity","equity:opening balances",
@ -343,9 +343,9 @@ tests_Commands = tests "Commands" [
-- (elideAccountName 20 "aaaaaaaaaaaaaaaaaaaa:aaaaaaaaaaaaaaaaaaaa:aaaaaaaaaaaaaaaaaaaa" -- (elideAccountName 20 "aaaaaaaaaaaaaaaaaaaa:aaaaaaaaaaaaaaaaaaaa:aaaaaaaaaaaaaaaaaaaa"
-- @?= "aa:aa:aaaaaaaaaaaaaa") -- @?= "aa:aa:aaaaaaaaaaaaaa")
,testCase "show dollars" $ showAmount (usd 1) @?= "$1.00" ,test "show dollars" $ showAmount (usd 1) @?= "$1.00"
,testCase "show hours" $ showAmount (hrs 1) @?= "1.00h" ,test "show hours" $ showAmount (hrs 1) @?= "1.00h"
] ]

View File

@ -640,7 +640,7 @@ balanceReportTableAsText ropts = tableAsText ropts showamt
tests_Balance = tests "Balance" [ tests_Balance = tests "Balance" [
tests "balanceReportAsText" [ tests "balanceReportAsText" [
testCase "unicode in balance layout" $ do test "unicode in balance layout" $ do
j <- readJournal' "2009/01/01 * медвежья шкура\n расходы:покупки 100\n актив:наличные\n" j <- readJournal' "2009/01/01 * медвежья шкура\n расходы:покупки 100\n актив:наличные\n"
let opts = defreportopts 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)

View File

@ -194,7 +194,7 @@ postingsReportItemAsText opts preferredamtwidth preferredbalwidth (mdate, mendda
tests_Register = tests "Register" [ tests_Register = tests "Register" [
tests "postingsReportAsText" [ tests "postingsReportAsText" [
testCase "unicode in register layout" $ do test "unicode in register layout" $ do
j <- readJournal' "2009/01/01 * медвежья шкура\n расходы:покупки 100\n актив:наличные\n" j <- readJournal' "2009/01/01 * медвежья шкура\n расходы:покупки 100\n актив:наличные\n"
let opts = defreportopts let opts = defreportopts
(postingsReportAsText defcliopts $ postingsReport opts (queryFromOpts (parsedate "2008/11/26") opts) j) (postingsReportAsText defcliopts $ postingsReport opts (queryFromOpts (parsedate "2008/11/26") opts) j)