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.
This commit is contained in:
Simon Michael
parent
13a3542464
commit
b36f6df110
@ -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
|
||||
]
|
||||
|
||||
|
||||
@ -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
|
||||
,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]) `is` 3
|
||||
,asprecision (astyle $ sum [usd 1 `withPrecision` 3, usd 1 `withPrecision` 1]) `is` 3
|
||||
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
|
||||
,expect $ isZeroAmount (usd 1.23 - eur 1.23)
|
||||
]
|
||||
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
|
||||
])
|
||||
]
|
||||
|
||||
]
|
||||
|
||||
|
||||
@ -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 [
|
||||
|
||||
@ -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
|
||||
]
|
||||
|
||||
@ -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
|
||||
]
|
||||
|
||||
,tests "accountNameWithoutPostingType" [
|
||||
accountNameWithoutPostingType "(a)" `is` "a"
|
||||
]
|
||||
|
||||
,tests "accountNameWithPostingType" [
|
||||
accountNameWithPostingType VirtualPosting "[a]" `is` "(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"
|
||||
]
|
||||
|
||||
,tests "concatAccountNames" [
|
||||
concatAccountNames [] `is` ""
|
||||
,concatAccountNames ["a","(b)","[c:d]"] `is` "(a:b:c:d)"
|
||||
]
|
||||
|
||||
,tests "commentAddTag" [
|
||||
commentAddTag "" ("a","") `is` "a: "
|
||||
,commentAddTag "[1/2]" ("a","") `is` "[1/2], a: "
|
||||
]
|
||||
|
||||
,tests "commentAddTagNextLine" [
|
||||
commentAddTagNextLine "" ("a","") `is` "\na: "
|
||||
,commentAddTagNextLine "[1/2]" ("a","") `is` "[1/2]\na: "
|
||||
]
|
||||
testCase "accountNamePostingType" $ do
|
||||
accountNamePostingType "a" @?= RegularPosting
|
||||
accountNamePostingType "(a)" @?= VirtualPosting
|
||||
accountNamePostingType "[a]" @?= BalancedVirtualPosting
|
||||
|
||||
,testCase "accountNameWithoutPostingType" $ do
|
||||
accountNameWithoutPostingType "(a)" @?= "a"
|
||||
|
||||
,testCase "accountNameWithPostingType" $ do
|
||||
accountNameWithPostingType VirtualPosting "[a]" @?= "(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"
|
||||
|
||||
,testCase "concatAccountNames" $ do
|
||||
concatAccountNames [] @?= ""
|
||||
concatAccountNames ["a","(b)","[c:d]"] @?= "(a:b:c:d)"
|
||||
|
||||
,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: "
|
||||
|
||||
]
|
||||
|
||||
|
||||
@ -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"
|
||||
]
|
||||
]
|
||||
|
||||
@ -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,9 +582,10 @@ tests_Transaction =
|
||||
, " ; tag3: val3 "
|
||||
]
|
||||
]
|
||||
-- postingsAsLines
|
||||
|
||||
, let
|
||||
-- one implicit amount
|
||||
, let timp = nulltransaction {tpostings = ["a" `post` usd 1, "b" `post` missingamt]}
|
||||
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
|
||||
@ -597,62 +598,45 @@ tests_Transaction =
|
||||
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`
|
||||
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
|
||||
|
||||
@ -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
|
||||
]
|
||||
|
||||
@ -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","")]}]}
|
||||
|
||||
]
|
||||
|
||||
@ -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
|
||||
]
|
||||
|
||||
]
|
||||
|
||||
@ -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")]))
|
||||
]
|
||||
]
|
||||
|
||||
@ -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" [
|
||||
,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"
|
||||
,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
|
||||
]
|
||||
]
|
||||
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
|
||||
,testCase "parseAndFinaliseJournal" $ do
|
||||
ej <- runExceptT $ parseAndFinaliseJournal journalp definputopts "" "2019-1-1\n"
|
||||
let Right j = ej
|
||||
assertEq [""] $ journalFilePaths j
|
||||
]
|
||||
assertEqual "" [""] $ journalFilePaths j
|
||||
|
||||
]
|
||||
|
||||
@ -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")
|
||||
@ -278,7 +279,7 @@ tests_BalanceReport = tests "BalanceReport" [
|
||||
],
|
||||
Mixed [usd 0])
|
||||
|
||||
,test "balanceReport with --depth=N" $
|
||||
,testCase "with --depth=N" $
|
||||
(defreportopts{depth_=Just 1}, samplejournal) `gives`
|
||||
([
|
||||
("expenses", "expenses", 0, mamountp' "$2.00")
|
||||
@ -286,7 +287,7 @@ tests_BalanceReport = tests "BalanceReport" [
|
||||
],
|
||||
Mixed [usd 0])
|
||||
|
||||
,test "balanceReport with depth:N" $
|
||||
,testCase "with depth:N" $
|
||||
(defreportopts{query_="depth:1"}, samplejournal) `gives`
|
||||
([
|
||||
("expenses", "expenses", 0, mamountp' "$2.00")
|
||||
@ -294,19 +295,20 @@ tests_BalanceReport = tests "BalanceReport" [
|
||||
],
|
||||
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 [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")
|
||||
@ -314,7 +316,7 @@ tests_BalanceReport = tests "BalanceReport" [
|
||||
],
|
||||
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")
|
||||
@ -327,7 +329,7 @@ tests_BalanceReport = tests "BalanceReport" [
|
||||
],
|
||||
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`
|
||||
(
|
||||
[
|
||||
@ -336,7 +338,7 @@ tests_BalanceReport = tests "BalanceReport" [
|
||||
],
|
||||
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])
|
||||
|
||||
|
||||
@ -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
|
||||
]
|
||||
]
|
||||
|
||||
|
||||
@ -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])
|
||||
]
|
||||
|
||||
@ -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 [
|
||||
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
|
||||
(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
|
||||
|
||||
(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
|
||||
(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
|
||||
|
||||
@ -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"])
|
||||
]
|
||||
|
||||
,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 "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"]
|
||||
|
||||
,testCase "queryOptsFromOpts" $ do
|
||||
queryOptsFromOpts nulldate defreportopts @?= []
|
||||
queryOptsFromOpts nulldate defreportopts{query_="a"} @?= []
|
||||
queryOptsFromOpts nulldate defreportopts{period_=PeriodFrom (parsedate "2012/01/01")
|
||||
,query_="date:'to 2013'"} @?= []
|
||||
]
|
||||
|
||||
|
||||
@ -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
|
||||
|
||||
|
||||
@ -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\""
|
||||
]
|
||||
|
||||
@ -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,13 +282,15 @@ tests_Commands = tests "Commands" [
|
||||
|
||||
-- some more tests easiest to define here:
|
||||
|
||||
,test "apply account directive" $ let
|
||||
,tests "apply account directive" [
|
||||
testCase "works" $ do
|
||||
let
|
||||
ignoresourcepos j = j{jtxns=map (\t -> t{tsourcepos=nullsourcepos}) (jtxns j)}
|
||||
sameParse str1 str2 = testCaseSteps "sometest" $ \_step -> do
|
||||
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}
|
||||
in sameParse
|
||||
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" <>
|
||||
@ -302,17 +304,22 @@ tests_Commands = tests "Commands" [
|
||||
"2008/12/07 Five\n foo $-5\n bar $5\n"
|
||||
)
|
||||
|
||||
,testCaseSteps "apply account directive should preserve \"virtual\" posting type" $ \_step -> do
|
||||
,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"
|
||||
|
||||
@ -640,10 +640,11 @@ 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 расходы:покупки"
|
||||
|
||||
@ -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"]
|
||||
]
|
||||
|
||||
Loading…
Reference in New Issue
Block a user