mirror of
https://github.com/simonmichael/hledger.git
synced 2024-11-07 21:15:19 +03:00
cln: tests: Remove test and tests, which are just aliases for testCase
and testGroup. Replacing these removes a layer of indirection, and reduces the need to depend on Hledger.Utils.Test.
This commit is contained in:
Stephen Morgan
Simon Michael
parent
83aa7324eb
commit
8274da81fc
@ -12,7 +12,7 @@ import Hledger.Reports as X
|
||||
import Hledger.Query as X
|
||||
import Hledger.Utils as X
|
||||
|
||||
tests_Hledger = tests "Hledger" [
|
||||
tests_Hledger = testGroup "Hledger" [
|
||||
tests_Data
|
||||
,tests_Query
|
||||
,tests_Read
|
||||
|
||||
@ -30,6 +30,7 @@ module Hledger.Data (
|
||||
)
|
||||
where
|
||||
|
||||
import Test.Tasty (testGroup)
|
||||
import Hledger.Data.Account
|
||||
import Hledger.Data.AccountName
|
||||
import Hledger.Data.Amount
|
||||
@ -47,9 +48,8 @@ import Hledger.Data.Transaction
|
||||
import Hledger.Data.TransactionModifier
|
||||
import Hledger.Data.Types hiding (MixedAmountKey, Mixed)
|
||||
import Hledger.Data.Valuation
|
||||
import Hledger.Utils.Test
|
||||
|
||||
tests_Data = tests "Data" [
|
||||
tests_Data = testGroup "Data" [
|
||||
tests_AccountName
|
||||
,tests_Amount
|
||||
,tests_Dates
|
||||
|
||||
@ -235,21 +235,21 @@ accountNameToAccountOnlyRegexCI a = toRegexCI' $ "^" <> escapeName a <> "$" -- P
|
||||
--isAccountRegex :: String -> Bool
|
||||
--isAccountRegex s = take 1 s == "^" && take 5 (reverse s) == ")$|:("
|
||||
|
||||
tests_AccountName = tests "AccountName" [
|
||||
test "accountNameTreeFrom" $ do
|
||||
tests_AccountName = testGroup "AccountName" [
|
||||
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" []]]]
|
||||
,test "expandAccountNames" $ do
|
||||
,testCase "expandAccountNames" $ do
|
||||
expandAccountNames ["assets:cash","assets:checking","expenses:vacation"] @?=
|
||||
["assets","assets:cash","assets:checking","expenses","expenses:vacation"]
|
||||
,test "isAccountNamePrefixOf" $ do
|
||||
,testCase "isAccountNamePrefixOf" $ do
|
||||
"assets" `isAccountNamePrefixOf` "assets" @?= False
|
||||
"assets" `isAccountNamePrefixOf` "assets:bank" @?= True
|
||||
"assets" `isAccountNamePrefixOf` "assets:bank:checking" @?= True
|
||||
"my assets" `isAccountNamePrefixOf` "assets:bank" @?= False
|
||||
,test "isSubAccountNameOf" $ do
|
||||
,testCase "isSubAccountNameOf" $ do
|
||||
"assets" `isSubAccountNameOf` "assets" @?= False
|
||||
"assets:bank" `isSubAccountNameOf` "assets" @?= True
|
||||
"assets:bank:checking" `isSubAccountNameOf` "assets" @?= False
|
||||
|
||||
@ -984,24 +984,24 @@ mixedAmountTotalPriceToUnitPrice = mapMixedAmount amountTotalPriceToUnitPrice
|
||||
-------------------------------------------------------------------------------
|
||||
-- tests
|
||||
|
||||
tests_Amount = tests "Amount" [
|
||||
tests "Amount" [
|
||||
tests_Amount = testGroup "Amount" [
|
||||
testGroup "Amount" [
|
||||
|
||||
test "amountCost" $ do
|
||||
testCase "amountCost" $ do
|
||||
amountCost (eur 1) @?= eur 1
|
||||
amountCost (eur 2){aprice=Just $ UnitPrice $ usd 2} @?= usd 4
|
||||
amountCost (eur 1){aprice=Just $ TotalPrice $ usd 2} @?= usd 2
|
||||
amountCost (eur (-1)){aprice=Just $ TotalPrice $ usd (-2)} @?= usd (-2)
|
||||
|
||||
,test "amountLooksZero" $ do
|
||||
,testCase "amountLooksZero" $ do
|
||||
assertBool "" $ amountLooksZero amount
|
||||
assertBool "" $ amountLooksZero $ usd 0
|
||||
|
||||
,test "negating amounts" $ do
|
||||
,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}
|
||||
|
||||
,test "adding amounts without prices" $ do
|
||||
,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)
|
||||
@ -1012,21 +1012,21 @@ tests_Amount = tests "Amount" [
|
||||
-- adding different commodities assumes conversion rate 1
|
||||
assertBool "" $ amountLooksZero (usd 1.23 - eur 1.23)
|
||||
|
||||
,test "showAmount" $ do
|
||||
,testCase "showAmount" $ do
|
||||
showAmount (usd 0 + gbp 0) @?= "0"
|
||||
|
||||
]
|
||||
|
||||
,tests "MixedAmount" [
|
||||
,testGroup "MixedAmount" [
|
||||
|
||||
test "comparing mixed amounts compares based on quantities" $ do
|
||||
testCase "comparing mixed amounts compares based on quantities" $ do
|
||||
let usdpos = mixed [usd 1]
|
||||
usdneg = mixed [usd (-1)]
|
||||
eurneg = mixed [eur (-12)]
|
||||
compare usdneg usdpos @?= LT
|
||||
compare eurneg usdpos @?= LT
|
||||
|
||||
,test "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" $
|
||||
maSum (map mixedAmount
|
||||
[usd 1.25
|
||||
,usd (-1) `withPrecision` Precision 3
|
||||
@ -1034,39 +1034,39 @@ tests_Amount = tests "Amount" [
|
||||
])
|
||||
@?= mixedAmount (usd 0 `withPrecision` Precision 3)
|
||||
|
||||
,test "adding mixed amounts with total prices" $ do
|
||||
,testCase "adding mixed amounts with total prices" $ do
|
||||
maSum (map mixedAmount
|
||||
[usd 1 @@ eur 1
|
||||
,usd (-2) @@ eur 1
|
||||
])
|
||||
@?= mixedAmount (usd (-1) @@ eur 2)
|
||||
|
||||
,test "showMixedAmount" $ do
|
||||
,testCase "showMixedAmount" $ do
|
||||
showMixedAmount (mixedAmount (usd 1)) @?= "$1.00"
|
||||
showMixedAmount (mixedAmount (usd 1 `at` eur 2)) @?= "$1.00 @ €2.00"
|
||||
showMixedAmount (mixedAmount (usd 0)) @?= "0"
|
||||
showMixedAmount nullmixedamt @?= "0"
|
||||
showMixedAmount missingmixedamt @?= ""
|
||||
|
||||
,test "showMixedAmountWithoutPrice" $ do
|
||||
,testCase "showMixedAmountWithoutPrice" $ do
|
||||
let a = usd 1 `at` eur 2
|
||||
showMixedAmountWithoutPrice False (mixedAmount (a)) @?= "$1.00"
|
||||
showMixedAmountWithoutPrice False (mixed [a, -a]) @?= "0"
|
||||
|
||||
,tests "amounts" [
|
||||
test "a missing amount overrides any other amounts" $
|
||||
,testGroup "amounts" [
|
||||
testCase "a missing amount overrides any other amounts" $
|
||||
amounts (mixed [usd 1, missingamt]) @?= [missingamt]
|
||||
,test "unpriced same-commodity amounts are combined" $
|
||||
,testCase "unpriced same-commodity amounts are combined" $
|
||||
amounts (mixed [usd 0, usd 2]) @?= [usd 2]
|
||||
,test "amounts with same unit price are combined" $
|
||||
,testCase "amounts with same unit price are combined" $
|
||||
amounts (mixed [usd 1 `at` eur 1, usd 1 `at` eur 1]) @?= [usd 2 `at` eur 1]
|
||||
,test "amounts with different unit prices are not combined" $
|
||||
,testCase "amounts with different unit prices are not combined" $
|
||||
amounts (mixed [usd 1 `at` eur 1, usd 1 `at` eur 2]) @?= [usd 1 `at` eur 1, usd 1 `at` eur 2]
|
||||
,test "amounts with total prices are combined" $
|
||||
,testCase "amounts with total prices are combined" $
|
||||
amounts (mixed [usd 1 @@ eur 1, usd 1 @@ eur 1]) @?= [usd 2 @@ eur 2]
|
||||
]
|
||||
|
||||
,test "mixedAmountStripPrices" $ do
|
||||
,testCase "mixedAmountStripPrices" $ do
|
||||
amounts (mixedAmountStripPrices nullmixedamt) @?= [nullamt]
|
||||
assertBool "" $ mixedAmountLooksZero $ mixedAmountStripPrices
|
||||
(mixed [usd 10
|
||||
|
||||
@ -1038,8 +1038,8 @@ nulldate = fromGregorian 0 1 1
|
||||
|
||||
-- tests
|
||||
|
||||
tests_Dates = tests "Dates"
|
||||
[ test "weekday" $ do
|
||||
tests_Dates = testGroup "Dates"
|
||||
[ testCase "weekday" $ do
|
||||
splitSpan (DaysOfWeek [1..5]) (DateSpan (Just $ fromGregorian 2021 07 01) (Just $ fromGregorian 2021 07 08))
|
||||
@?= [ (DateSpan (Just $ fromGregorian 2021 06 28) (Just $ fromGregorian 2021 06 29))
|
||||
, (DateSpan (Just $ fromGregorian 2021 06 29) (Just $ fromGregorian 2021 06 30))
|
||||
@ -1059,7 +1059,7 @@ tests_Dates = tests "Dates"
|
||||
, (DateSpan (Just $ fromGregorian 2021 07 05) (Just $ fromGregorian 2021 07 09))
|
||||
]
|
||||
|
||||
, test "match dayOfWeek" $ do
|
||||
, testCase "match dayOfWeek" $ do
|
||||
let dayofweek n s = splitspan (nthdayofweekcontaining n) (applyN (n-1) nextday . nextweek) s
|
||||
match ds day = dayofweek day ds == splitSpan (DaysOfWeek [day]) ds @?= True
|
||||
ys2021 = fromGregorian 2021 01 01
|
||||
|
||||
@ -1513,9 +1513,9 @@ Right samplejournal = journalBalanceTransactions defbalancingopts $
|
||||
]
|
||||
}
|
||||
|
||||
tests_Journal = tests "Journal" [
|
||||
tests_Journal = testGroup "Journal" [
|
||||
|
||||
test "journalDateSpan" $
|
||||
testCase "journalDateSpan" $
|
||||
journalDateSpan True nulljournal{
|
||||
jtxns = [nulltransaction{tdate = fromGregorian 2014 02 01
|
||||
,tpostings = [posting{pdate=Just (fromGregorian 2014 01 10)}]
|
||||
@ -1527,30 +1527,30 @@ tests_Journal = tests "Journal" [
|
||||
}
|
||||
@?= (DateSpan (Just $ fromGregorian 2014 1 10) (Just $ fromGregorian 2014 10 11))
|
||||
|
||||
,tests "standard account type queries" $
|
||||
,testGroup "standard account type queries" $
|
||||
let
|
||||
j = samplejournal
|
||||
journalAccountNamesMatching :: Query -> Journal -> [AccountName]
|
||||
journalAccountNamesMatching q = filter (q `matchesAccount`) . journalAccountNames
|
||||
namesfrom qfunc = journalAccountNamesMatching (qfunc j) j
|
||||
in [
|
||||
test "assets" $ assertEqual "" ["assets","assets:bank","assets:bank:checking","assets:bank:saving","assets:cash"]
|
||||
testCase "assets" $ assertEqual "" ["assets","assets:bank","assets:bank:checking","assets:bank:saving","assets:cash"]
|
||||
(namesfrom journalAssetAccountQuery)
|
||||
,test "cash" $ assertEqual "" ["assets","assets:bank","assets:bank:checking","assets:bank:saving","assets:cash"]
|
||||
,testCase "cash" $ assertEqual "" ["assets","assets:bank","assets:bank:checking","assets:bank:saving","assets:cash"]
|
||||
(namesfrom journalCashAccountQuery)
|
||||
,test "liabilities" $ assertEqual "" ["liabilities","liabilities:debts"]
|
||||
,testCase "liabilities" $ assertEqual "" ["liabilities","liabilities:debts"]
|
||||
(namesfrom journalLiabilityAccountQuery)
|
||||
,test "equity" $ assertEqual "" []
|
||||
,testCase "equity" $ assertEqual "" []
|
||||
(namesfrom journalEquityAccountQuery)
|
||||
,test "income" $ assertEqual "" ["income","income:gifts","income:salary"]
|
||||
,testCase "income" $ assertEqual "" ["income","income:gifts","income:salary"]
|
||||
(namesfrom journalRevenueAccountQuery)
|
||||
,test "expenses" $ assertEqual "" ["expenses","expenses:food","expenses:supplies"]
|
||||
,testCase "expenses" $ assertEqual "" ["expenses","expenses:food","expenses:supplies"]
|
||||
(namesfrom journalExpenseAccountQuery)
|
||||
]
|
||||
|
||||
,tests "journalBalanceTransactions" [
|
||||
,testGroup "journalBalanceTransactions" [
|
||||
|
||||
test "balance-assignment" $ do
|
||||
testCase "balance-assignment" $ do
|
||||
let ej = journalBalanceTransactions defbalancingopts $
|
||||
--2019/01/01
|
||||
-- (a) = 1
|
||||
@ -1561,7 +1561,7 @@ tests_Journal = tests "Journal" [
|
||||
let Right j = ej
|
||||
(jtxns j & head & tpostings & head & pamount & amountsRaw) @?= [num 1]
|
||||
|
||||
,test "same-day-1" $ do
|
||||
,testCase "same-day-1" $ do
|
||||
assertRight $ journalBalanceTransactions defbalancingopts $
|
||||
--2019/01/01
|
||||
-- (a) = 1
|
||||
@ -1572,7 +1572,7 @@ tests_Journal = tests "Journal" [
|
||||
,transaction (fromGregorian 2019 01 01) [ vpost' "a" (num 1) (balassert (num 2)) ]
|
||||
]}
|
||||
|
||||
,test "same-day-2" $ do
|
||||
,testCase "same-day-2" $ do
|
||||
assertRight $ journalBalanceTransactions defbalancingopts $
|
||||
--2019/01/01
|
||||
-- (a) 2 = 2
|
||||
@ -1590,7 +1590,7 @@ tests_Journal = tests "Journal" [
|
||||
,transaction (fromGregorian 2019 01 01) [ post' "a" (num 0) (balassert (num 1)) ]
|
||||
]}
|
||||
|
||||
,test "out-of-order" $ do
|
||||
,testCase "out-of-order" $ do
|
||||
assertRight $ journalBalanceTransactions defbalancingopts $
|
||||
--2019/1/2
|
||||
-- (a) 1 = 2
|
||||
@ -1603,7 +1603,7 @@ tests_Journal = tests "Journal" [
|
||||
|
||||
]
|
||||
|
||||
,tests "commodityStylesFromAmounts" $ [
|
||||
,testGroup "commodityStylesFromAmounts" $ [
|
||||
|
||||
-- Journal similar to the one on #1091:
|
||||
-- 2019/09/24
|
||||
@ -1612,7 +1612,7 @@ tests_Journal = tests "Journal" [
|
||||
-- 2019/09/26
|
||||
-- (a) 1000,000
|
||||
--
|
||||
test "1091a" $ do
|
||||
testCase "1091a" $ do
|
||||
commodityStylesFromAmounts [
|
||||
nullamt{aquantity=1000, astyle=AmountStyle L False (Precision 3) (Just ',') Nothing}
|
||||
,nullamt{aquantity=1000, astyle=AmountStyle L False (Precision 2) (Just '.') (Just (DigitGroups ',' [3]))}
|
||||
@ -1624,7 +1624,7 @@ tests_Journal = tests "Journal" [
|
||||
("", AmountStyle L False (Precision 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 (Precision 2) (Just '.') (Just (DigitGroups ',' [3]))}
|
||||
,nullamt{aquantity=1000, astyle=AmountStyle L False (Precision 3) (Just ',') Nothing}
|
||||
|
||||
@ -28,7 +28,8 @@ import qualified Data.Map as M
|
||||
import Safe (headDef)
|
||||
import Text.Printf
|
||||
|
||||
import Hledger.Utils.Test
|
||||
import Test.Tasty (testGroup)
|
||||
import Test.Tasty.HUnit ((@?=), testCase)
|
||||
import Hledger.Data.Types
|
||||
import Hledger.Data.Account
|
||||
import Hledger.Data.Journal
|
||||
@ -101,8 +102,8 @@ ledgerCommodities = M.keys . jinferredcommodities . ljournal
|
||||
-- tests
|
||||
|
||||
tests_Ledger =
|
||||
tests "Ledger" [
|
||||
test "ledgerFromJournal" $ do
|
||||
testGroup "Ledger" [
|
||||
testCase "ledgerFromJournal" $ do
|
||||
length (ledgerPostings $ ledgerFromJournal Any nulljournal) @?= 0
|
||||
length (ledgerPostings $ ledgerFromJournal Any samplejournal) @?= 13
|
||||
length (ledgerPostings $ ledgerFromJournal (Depth 2) samplejournal) @?= 7
|
||||
|
||||
@ -378,34 +378,34 @@ commentAddTagNextLine cmt (t,v) =
|
||||
|
||||
-- tests
|
||||
|
||||
tests_Posting = tests "Posting" [
|
||||
tests_Posting = testGroup "Posting" [
|
||||
|
||||
test "accountNamePostingType" $ do
|
||||
testCase "accountNamePostingType" $ do
|
||||
accountNamePostingType "a" @?= RegularPosting
|
||||
accountNamePostingType "(a)" @?= VirtualPosting
|
||||
accountNamePostingType "[a]" @?= BalancedVirtualPosting
|
||||
|
||||
,test "accountNameWithoutPostingType" $ do
|
||||
,testCase "accountNameWithoutPostingType" $ do
|
||||
accountNameWithoutPostingType "(a)" @?= "a"
|
||||
|
||||
,test "accountNameWithPostingType" $ do
|
||||
,testCase "accountNameWithPostingType" $ do
|
||||
accountNameWithPostingType VirtualPosting "[a]" @?= "(a)"
|
||||
|
||||
,test "joinAccountNames" $ do
|
||||
,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"
|
||||
|
||||
,test "concatAccountNames" $ do
|
||||
,testCase "concatAccountNames" $ do
|
||||
concatAccountNames [] @?= ""
|
||||
concatAccountNames ["a","(b)","[c:d]"] @?= "(a:b:c:d)"
|
||||
|
||||
,test "commentAddTag" $ do
|
||||
,testCase "commentAddTag" $ do
|
||||
commentAddTag "" ("a","") @?= "a: "
|
||||
commentAddTag "[1/2]" ("a","") @?= "[1/2], a: "
|
||||
|
||||
,test "commentAddTagNextLine" $ do
|
||||
,testCase "commentAddTagNextLine" $ do
|
||||
commentAddTagNextLine "" ("a","") @?= "\na: "
|
||||
commentAddTagNextLine "[1/2]" ("a","") @?= "[1/2]\na: "
|
||||
|
||||
|
||||
@ -159,9 +159,9 @@ formatStringTester fs value expected = actual @?= expected
|
||||
FormatLiteral l -> formatText False Nothing Nothing l
|
||||
FormatField leftJustify min max _ -> formatText leftJustify min max value
|
||||
|
||||
tests_StringFormat = tests "StringFormat" [
|
||||
tests_StringFormat = testGroup "StringFormat" [
|
||||
|
||||
test "formatStringHelper" $ do
|
||||
testCase "formatStringHelper" $ do
|
||||
formatStringTester (FormatLiteral " ") "" " "
|
||||
formatStringTester (FormatField False Nothing Nothing DescriptionField) "description" "description"
|
||||
formatStringTester (FormatField False (Just 20) Nothing DescriptionField) "description" " description"
|
||||
@ -171,8 +171,8 @@ tests_StringFormat = tests "StringFormat" [
|
||||
formatStringTester (FormatField True (Just 20) (Just 20) DescriptionField) "description" "description "
|
||||
formatStringTester (FormatField True Nothing (Just 3) DescriptionField) "description" "des"
|
||||
|
||||
,let s `gives` expected = test s $ parseStringFormat (T.pack s) @?= Right expected
|
||||
in tests "parseStringFormat" [
|
||||
,let s `gives` expected = testCase s $ parseStringFormat (T.pack s) @?= Right expected
|
||||
in testGroup "parseStringFormat" [
|
||||
"" `gives` (defaultStringFormatStyle [])
|
||||
, "D" `gives` (defaultStringFormatStyle [FormatLiteral "D"])
|
||||
, "%(date)" `gives` (defaultStringFormatStyle [FormatField False (Just 0) Nothing DescriptionField])
|
||||
@ -190,6 +190,6 @@ tests_StringFormat = tests "StringFormat" [
|
||||
,FormatLiteral " "
|
||||
,FormatField False (Just 0) (Just 10) TotalField
|
||||
])
|
||||
, test "newline not parsed" $ assertLeft $ parseStringFormat "\n"
|
||||
, testCase "newline not parsed" $ assertLeft $ parseStringFormat "\n"
|
||||
]
|
||||
]
|
||||
|
||||
@ -126,7 +126,7 @@ entryFromTimeclockInOut i o
|
||||
|
||||
-- tests
|
||||
|
||||
tests_Timeclock = tests "Timeclock" [
|
||||
tests_Timeclock = testGroup "Timeclock" [
|
||||
testCaseSteps "timeclockEntriesToTransactions tests" $ \step -> do
|
||||
step "gathering data"
|
||||
today <- getCurrentDay
|
||||
|
||||
@ -670,11 +670,11 @@ makeHledgerClassyLenses ''BalancingOpts
|
||||
|
||||
tests_Transaction :: TestTree
|
||||
tests_Transaction =
|
||||
tests "Transaction" [
|
||||
testGroup "Transaction" [
|
||||
|
||||
tests "showPostingLines" [
|
||||
test "null posting" $ showPostingLines nullposting @?= [" 0"]
|
||||
, test "non-null posting" $
|
||||
testGroup "showPostingLines" [
|
||||
testCase "null posting" $ showPostingLines nullposting @?= [" 0"]
|
||||
, testCase "non-null posting" $
|
||||
let p =
|
||||
posting
|
||||
{ pstatus = Cleared
|
||||
@ -709,45 +709,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" $ postingsAsLines False (tpostings nulltransaction) @?= []
|
||||
, test "implicit-amount" $ postingsAsLines False (tpostings timp) @?=
|
||||
in testGroup "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" $ postingsAsLines False (tpostings texp) @?=
|
||||
, testCase "explicit-amounts" $ postingsAsLines False (tpostings texp) @?=
|
||||
[ " a $1.00"
|
||||
, " b $-1.00"
|
||||
]
|
||||
, test "one-explicit-amount" $ postingsAsLines False (tpostings texp1) @?=
|
||||
, testCase "one-explicit-amount" $ postingsAsLines False (tpostings texp1) @?=
|
||||
[ " (a) $1.00"
|
||||
]
|
||||
, test "explicit-amounts-two-commodities" $ postingsAsLines False (tpostings texp2) @?=
|
||||
, testCase "explicit-amounts-two-commodities" $ postingsAsLines False (tpostings texp2) @?=
|
||||
[ " a $1.00"
|
||||
, " b -1.00h @ $1.00"
|
||||
]
|
||||
, test "explicit-amounts-not-explicitly-balanced" $ postingsAsLines False (tpostings texp2b) @?=
|
||||
, testCase "explicit-amounts-not-explicitly-balanced" $ postingsAsLines False (tpostings texp2b) @?=
|
||||
[ " a $1.00"
|
||||
, " b -1.00h"
|
||||
]
|
||||
, test "implicit-amount-not-last" $ postingsAsLines False (tpostings t3) @?=
|
||||
, testCase "implicit-amount-not-last" $ postingsAsLines False (tpostings t3) @?=
|
||||
[" a $1.00", " b", " c $-1.00"]
|
||||
-- , test "ensure-visibly-balanced" $
|
||||
-- , testCase "ensure-visibly-balanced" $
|
||||
-- in postingsAsLines False (tpostings t4) @?=
|
||||
-- [" a $-0.01", " b $0.005", " c $0.005"]
|
||||
|
||||
]
|
||||
|
||||
, test "inferBalancingAmount" $ do
|
||||
, 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]}) @?=
|
||||
Right nulltransaction{tpostings = ["a" `post` usd (-5), "b" `post` (eur 3 @@ usd 4), "c" `post` usd 1]}
|
||||
|
||||
, tests "showTransaction" [
|
||||
test "null transaction" $ showTransaction nulltransaction @?= "0000-01-01\n\n"
|
||||
, test "non-null transaction" $ showTransaction
|
||||
, testGroup "showTransaction" [
|
||||
testCase "null transaction" $ showTransaction nulltransaction @?= "0000-01-01\n\n"
|
||||
, testCase "non-null transaction" $ showTransaction
|
||||
nulltransaction
|
||||
{ tdate = fromGregorian 2012 05 14
|
||||
, tdate2 = Just $ fromGregorian 2012 05 15
|
||||
@ -776,7 +776,7 @@ tests_Transaction =
|
||||
, " ; pcomment2"
|
||||
, ""
|
||||
]
|
||||
, test "show a balanced transaction" $
|
||||
, testCase "show a balanced transaction" $
|
||||
(let t =
|
||||
Transaction
|
||||
0
|
||||
@ -799,7 +799,7 @@ tests_Transaction =
|
||||
, " assets:checking $-47.18"
|
||||
, ""
|
||||
])
|
||||
, test "show an unbalanced transaction, should not elide" $
|
||||
, testCase "show an unbalanced transaction, should not elide" $
|
||||
(showTransaction
|
||||
(txnTieKnot $
|
||||
Transaction
|
||||
@ -822,7 +822,7 @@ tests_Transaction =
|
||||
, " 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
|
||||
@ -838,7 +838,7 @@ tests_Transaction =
|
||||
[]
|
||||
[posting {paccount = "expenses:food:groceries", pamount = missingmixedamt}])) @?=
|
||||
(T.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
|
||||
@ -857,8 +857,8 @@ tests_Transaction =
|
||||
])) @?=
|
||||
(T.unlines ["2010-01-01 x", " a 1 @ $2", " b", ""])
|
||||
]
|
||||
, tests "balanceTransaction" [
|
||||
test "detect unbalanced entry, sign error" $
|
||||
, testGroup "balanceTransaction" [
|
||||
testCase "detect unbalanced entry, sign error" $
|
||||
assertLeft
|
||||
(balanceTransaction defbalancingopts
|
||||
(Transaction
|
||||
@ -873,7 +873,7 @@ tests_Transaction =
|
||||
""
|
||||
[]
|
||||
[posting {paccount = "a", pamount = mixedAmount (usd 1)}, posting {paccount = "b", pamount = mixedAmount (usd 1)}]))
|
||||
,test "detect unbalanced entry, multiple missing amounts" $
|
||||
,testCase "detect unbalanced entry, multiple missing amounts" $
|
||||
assertLeft $
|
||||
balanceTransaction defbalancingopts
|
||||
(Transaction
|
||||
@ -890,7 +890,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 defbalancingopts
|
||||
(Transaction
|
||||
@ -906,7 +906,7 @@ tests_Transaction =
|
||||
[]
|
||||
[posting {paccount = "a", pamount = mixedAmount (usd 1)}, posting {paccount = "b", pamount = missingmixedamt}])) @?=
|
||||
Right (mixedAmount $ usd (-1))
|
||||
,test "conversion price is inferred" $
|
||||
,testCase "conversion price is inferred" $
|
||||
(pamount . head . tpostings <$>
|
||||
balanceTransaction defbalancingopts
|
||||
(Transaction
|
||||
@ -924,7 +924,7 @@ tests_Transaction =
|
||||
, posting {paccount = "b", pamount = mixedAmount (eur (-1))}
|
||||
])) @?=
|
||||
Right (mixedAmount $ usd 1.35 @@ eur 1)
|
||||
,test "balanceTransaction balances based on cost if there are unit prices" $
|
||||
,testCase "balanceTransaction balances based on cost if there are unit prices" $
|
||||
assertRight $
|
||||
balanceTransaction defbalancingopts
|
||||
(Transaction
|
||||
@ -941,7 +941,7 @@ tests_Transaction =
|
||||
[ posting {paccount = "a", pamount = mixedAmount $ usd 1 `at` eur 2}
|
||||
, posting {paccount = "a", pamount = mixedAmount $ usd (-2) `at` eur 1}
|
||||
])
|
||||
,test "balanceTransaction balances based on cost if there are total prices" $
|
||||
,testCase "balanceTransaction balances based on cost if there are total prices" $
|
||||
assertRight $
|
||||
balanceTransaction defbalancingopts
|
||||
(Transaction
|
||||
@ -959,8 +959,8 @@ tests_Transaction =
|
||||
, posting {paccount = "a", pamount = mixedAmount $ usd (-2) @@ eur (-1)}
|
||||
])
|
||||
]
|
||||
, tests "isTransactionBalanced" [
|
||||
test "detect balanced" $
|
||||
, testGroup "isTransactionBalanced" [
|
||||
testCase "detect balanced" $
|
||||
assertBool "" $
|
||||
isTransactionBalanced defbalancingopts $
|
||||
Transaction
|
||||
@ -977,7 +977,7 @@ tests_Transaction =
|
||||
[ posting {paccount = "b", pamount = mixedAmount (usd 1.00)}
|
||||
, posting {paccount = "c", pamount = mixedAmount (usd (-1.00))}
|
||||
]
|
||||
,test "detect unbalanced" $
|
||||
,testCase "detect unbalanced" $
|
||||
assertBool "" $
|
||||
not $
|
||||
isTransactionBalanced defbalancingopts $
|
||||
@ -995,7 +995,7 @@ tests_Transaction =
|
||||
[ posting {paccount = "b", pamount = mixedAmount (usd 1.00)}
|
||||
, posting {paccount = "c", pamount = mixedAmount (usd (-1.01))}
|
||||
]
|
||||
,test "detect unbalanced, one posting" $
|
||||
,testCase "detect unbalanced, one posting" $
|
||||
assertBool "" $
|
||||
not $
|
||||
isTransactionBalanced defbalancingopts $
|
||||
@ -1011,7 +1011,7 @@ tests_Transaction =
|
||||
""
|
||||
[]
|
||||
[posting {paccount = "b", pamount = mixedAmount (usd 1.00)}]
|
||||
,test "one zero posting is considered balanced for now" $
|
||||
,testCase "one zero posting is considered balanced for now" $
|
||||
assertBool "" $
|
||||
isTransactionBalanced defbalancingopts $
|
||||
Transaction
|
||||
@ -1026,7 +1026,7 @@ tests_Transaction =
|
||||
""
|
||||
[]
|
||||
[posting {paccount = "b", pamount = mixedAmount (usd 0)}]
|
||||
,test "virtual postings don't need to balance" $
|
||||
,testCase "virtual postings don't need to balance" $
|
||||
assertBool "" $
|
||||
isTransactionBalanced defbalancingopts $
|
||||
Transaction
|
||||
@ -1044,7 +1044,7 @@ tests_Transaction =
|
||||
, posting {paccount = "c", pamount = mixedAmount (usd (-1.00))}
|
||||
, posting {paccount = "d", pamount = mixedAmount (usd 100), ptype = VirtualPosting}
|
||||
]
|
||||
,test "balanced virtual postings need to balance among themselves" $
|
||||
,testCase "balanced virtual postings need to balance among themselves" $
|
||||
assertBool "" $
|
||||
not $
|
||||
isTransactionBalanced defbalancingopts $
|
||||
@ -1063,7 +1063,7 @@ tests_Transaction =
|
||||
, posting {paccount = "c", pamount = mixedAmount (usd (-1.00))}
|
||||
, posting {paccount = "d", pamount = mixedAmount (usd 100), ptype = BalancedVirtualPosting}
|
||||
]
|
||||
,test "balanced virtual postings need to balance among themselves (2)" $
|
||||
,testCase "balanced virtual postings need to balance among themselves (2)" $
|
||||
assertBool "" $
|
||||
isTransactionBalanced defbalancingopts $
|
||||
Transaction
|
||||
|
||||
@ -260,7 +260,7 @@ tests_priceLookup =
|
||||
,p 2001 01 01 "A" 11 "B"
|
||||
]
|
||||
makepricegraph = makePriceGraph ps1 []
|
||||
in test "priceLookup" $ do
|
||||
in testCase "priceLookup" $ do
|
||||
priceLookup makepricegraph (fromGregorian 1999 01 01) "A" Nothing @?= Nothing
|
||||
priceLookup makepricegraph (fromGregorian 2000 01 01) "A" Nothing @?= Just ("B",10)
|
||||
priceLookup makepricegraph (fromGregorian 2000 01 01) "B" (Just "A") @?= Just ("A",0.1)
|
||||
@ -481,9 +481,9 @@ nullmarketprice = MarketPrice {
|
||||
|
||||
------------------------------------------------------------------------------
|
||||
|
||||
tests_Valuation = tests "Valuation" [
|
||||
tests_Valuation = testGroup "Valuation" [
|
||||
tests_priceLookup
|
||||
,test "marketPriceReverse" $ do
|
||||
,testCase "marketPriceReverse" $ do
|
||||
marketPriceReverse nullmarketprice{mprate=2} @?= nullmarketprice{mprate=0.5}
|
||||
marketPriceReverse nullmarketprice @?= nullmarketprice -- the reverse of a 0 price is a 0 price
|
||||
|
||||
|
||||
@ -688,8 +688,8 @@ matchesPriceDirective _ _ = True
|
||||
|
||||
-- tests
|
||||
|
||||
tests_Query = tests "Query" [
|
||||
test "simplifyQuery" $ do
|
||||
tests_Query = testGroup "Query" [
|
||||
testCase "simplifyQuery" $ do
|
||||
(simplifyQuery $ Or [Acct $ toRegex' "a"]) @?= (Acct $ toRegex' "a")
|
||||
(simplifyQuery $ Or [Any,None]) @?= (Any)
|
||||
(simplifyQuery $ And [Any,None]) @?= (None)
|
||||
@ -700,7 +700,7 @@ tests_Query = tests "Query" [
|
||||
@?= (Date (DateSpan (Just $ fromGregorian 2012 01 01) (Just $ fromGregorian 2013 01 01)))
|
||||
(simplifyQuery $ And [Or [],Or [Desc $ toRegex' "b b"]]) @?= (Desc $ toRegex' "b b")
|
||||
|
||||
,test "parseQuery" $ do
|
||||
,testCase "parseQuery" $ do
|
||||
(parseQuery nulldate "acct:'expenses:autres d\233penses' desc:b") @?= Right (And [Acct $ toRegexCI' "expenses:autres d\233penses", Desc $ toRegexCI' "b"], [])
|
||||
parseQuery nulldate "inacct:a desc:\"b b\"" @?= Right (Desc $ toRegexCI' "b b", [QueryOptInAcct "a"])
|
||||
parseQuery nulldate "inacct:a inacct:b" @?= Right (Any, [QueryOptInAcct "a", QueryOptInAcct "b"])
|
||||
@ -708,7 +708,7 @@ tests_Query = tests "Query" [
|
||||
parseQuery nulldate "'a a' 'b" @?= Right (Or [Acct $ toRegexCI' "a a",Acct $ toRegexCI' "'b"], [])
|
||||
parseQuery nulldate "\"" @?= Right (Acct $ toRegexCI' "\"", [])
|
||||
|
||||
,test "words''" $ do
|
||||
,testCase "words''" $ do
|
||||
(words'' [] "a b") @?= ["a","b"]
|
||||
(words'' [] "'a b'") @?= ["a b"]
|
||||
(words'' [] "not:a b") @?= ["not:a","b"]
|
||||
@ -718,13 +718,13 @@ tests_Query = tests "Query" [
|
||||
(words'' prefixes "\"acct:expenses:autres d\233penses\"") @?= ["acct:expenses:autres d\233penses"]
|
||||
(words'' prefixes "\"") @?= ["\""]
|
||||
|
||||
,test "filterQuery" $ do
|
||||
,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
|
||||
|
||||
,test "parseQueryTerm" $ do
|
||||
,testCase "parseQueryTerm" $ do
|
||||
parseQueryTerm nulldate "a" @?= Right (Left $ Acct $ toRegexCI' "a")
|
||||
parseQueryTerm nulldate "acct:expenses:autres d\233penses" @?= Right (Left $ Acct $ toRegexCI' "expenses:autres d\233penses")
|
||||
parseQueryTerm nulldate "not:desc:a b" @?= Right (Left $ Not $ Desc $ toRegexCI' "a b")
|
||||
@ -745,7 +745,7 @@ tests_Query = tests "Query" [
|
||||
parseQueryTerm nulldate "amt:<0" @?= Right (Left $ Amt Lt 0)
|
||||
parseQueryTerm nulldate "amt:>10000.10" @?= Right (Left $ Amt AbsGt 10000.1)
|
||||
|
||||
,test "parseAmountQueryTerm" $ do
|
||||
,testCase "parseAmountQueryTerm" $ do
|
||||
parseAmountQueryTerm "<0" @?= Right (Lt,0) -- special case for convenience, since AbsLt 0 would be always false
|
||||
parseAmountQueryTerm ">0" @?= Right (Gt,0) -- special case for convenience and consistency with above
|
||||
parseAmountQueryTerm " > - 0 " @?= Right (Gt,0) -- accept whitespace around the argument parts
|
||||
@ -757,7 +757,7 @@ tests_Query = tests "Query" [
|
||||
assertLeft $ parseAmountQueryTerm "-0,23"
|
||||
assertLeft $ parseAmountQueryTerm "=.23"
|
||||
|
||||
,test "queryStartDate" $ do
|
||||
,testCase "queryStartDate" $ do
|
||||
let small = Just $ fromGregorian 2000 01 01
|
||||
big = Just $ fromGregorian 2000 01 02
|
||||
queryStartDate False (And [Date $ DateSpan small Nothing, Date $ DateSpan big Nothing]) @?= big
|
||||
@ -765,7 +765,7 @@ tests_Query = tests "Query" [
|
||||
queryStartDate False (Or [Date $ DateSpan small Nothing, Date $ DateSpan big Nothing]) @?= small
|
||||
queryStartDate False (Or [Date $ DateSpan small Nothing, Date $ DateSpan Nothing Nothing]) @?= Nothing
|
||||
|
||||
,test "queryEndDate" $ do
|
||||
,testCase "queryEndDate" $ do
|
||||
let small = Just $ fromGregorian 2000 01 01
|
||||
big = Just $ fromGregorian 2000 01 02
|
||||
queryEndDate False (And [Date $ DateSpan Nothing small, Date $ DateSpan Nothing big]) @?= small
|
||||
@ -773,7 +773,7 @@ tests_Query = tests "Query" [
|
||||
queryEndDate False (Or [Date $ DateSpan Nothing small, Date $ DateSpan Nothing big]) @?= big
|
||||
queryEndDate False (Or [Date $ DateSpan Nothing small, Date $ DateSpan Nothing Nothing]) @?= Nothing
|
||||
|
||||
,test "matchesAccount" $ do
|
||||
,testCase "matchesAccount" $ do
|
||||
assertBool "" $ (Acct $ toRegex' "b:c") `matchesAccount` "a:bb:c:d"
|
||||
assertBool "" $ not $ (Acct $ toRegex' "^a:b") `matchesAccount` "c:a:b"
|
||||
assertBool "" $ Depth 2 `matchesAccount` "a"
|
||||
@ -783,22 +783,22 @@ tests_Query = tests "Query" [
|
||||
assertBool "" $ Date2 nulldatespan `matchesAccount` "a"
|
||||
assertBool "" $ not $ Tag (toRegex' "a") Nothing `matchesAccount` "a"
|
||||
|
||||
,tests "matchesPosting" [
|
||||
test "positive match on cleared posting status" $
|
||||
,testGroup "matchesPosting" [
|
||||
testCase "positive match on cleared posting status" $
|
||||
assertBool "" $ (StatusQ Cleared) `matchesPosting` nullposting{pstatus=Cleared}
|
||||
,test "negative match on cleared posting status" $
|
||||
,testCase "negative match on cleared posting status" $
|
||||
assertBool "" $ not $ (Not $ StatusQ Cleared) `matchesPosting` nullposting{pstatus=Cleared}
|
||||
,test "positive match on unmarked posting status" $
|
||||
,testCase "positive match on unmarked posting status" $
|
||||
assertBool "" $ (StatusQ Unmarked) `matchesPosting` nullposting{pstatus=Unmarked}
|
||||
,test "negative match on unmarked posting status" $
|
||||
,testCase "negative match on unmarked posting status" $
|
||||
assertBool "" $ not $ (Not $ StatusQ Unmarked) `matchesPosting` nullposting{pstatus=Unmarked}
|
||||
,test "positive match on true posting status acquired from transaction" $
|
||||
,testCase "positive match on true posting status acquired from transaction" $
|
||||
assertBool "" $ (StatusQ Cleared) `matchesPosting` nullposting{pstatus=Unmarked,ptransaction=Just nulltransaction{tstatus=Cleared}}
|
||||
,test "real:1 on real posting" $ assertBool "" $ (Real True) `matchesPosting` nullposting{ptype=RegularPosting}
|
||||
,test "real:1 on virtual posting fails" $ assertBool "" $ not $ (Real True) `matchesPosting` nullposting{ptype=VirtualPosting}
|
||||
,test "real:1 on balanced virtual posting fails" $ assertBool "" $ not $ (Real True) `matchesPosting` nullposting{ptype=BalancedVirtualPosting}
|
||||
,test "acct:" $ assertBool "" $ (Acct $ toRegex' "'b") `matchesPosting` nullposting{paccount="'b"}
|
||||
,test "tag:" $ do
|
||||
,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 $ toRegex' "'b") `matchesPosting` nullposting{paccount="'b"}
|
||||
,testCase "tag:" $ do
|
||||
assertBool "" $ not $ (Tag (toRegex' "a") (Just $ toRegex' "r$")) `matchesPosting` nullposting
|
||||
assertBool "" $ (Tag (toRegex' "foo") Nothing) `matchesPosting` nullposting{ptags=[("foo","")]}
|
||||
assertBool "" $ (Tag (toRegex' "foo") Nothing) `matchesPosting` nullposting{ptags=[("foo","baz")]}
|
||||
@ -806,8 +806,8 @@ tests_Query = tests "Query" [
|
||||
assertBool "" $ not $ (Tag (toRegex' "foo") (Just $ toRegex' "a$")) `matchesPosting` nullposting{ptags=[("foo","bar")]}
|
||||
assertBool "" $ not $ (Tag (toRegex' " foo ") (Just $ toRegex' "a")) `matchesPosting` nullposting{ptags=[("foo","bar")]}
|
||||
assertBool "" $ not $ (Tag (toRegex' "foo foo") (Just $ toRegex' " ar ba ")) `matchesPosting` nullposting{ptags=[("foo foo","bar bar")]}
|
||||
,test "a tag match on a posting also sees inherited tags" $ assertBool "" $ (Tag (toRegex' "txntag") Nothing) `matchesPosting` nullposting{ptransaction=Just nulltransaction{ttags=[("txntag","")]}}
|
||||
,test "cur:" $ do
|
||||
,testCase "a tag match on a posting also sees inherited tags" $ assertBool "" $ (Tag (toRegex' "txntag") Nothing) `matchesPosting` nullposting{ptransaction=Just nulltransaction{ttags=[("txntag","")]}}
|
||||
,testCase "cur:" $ do
|
||||
let toSym = fromLeft (error' "No query opts") . either error' id . parseQueryTerm (fromGregorian 2000 01 01) . ("cur:"<>)
|
||||
assertBool "" $ not $ toSym "$" `matchesPosting` nullposting{pamount=mixedAmount $ usd 1} -- becomes "^$$", ie testing for null symbol
|
||||
assertBool "" $ (toSym "\\$") `matchesPosting` nullposting{pamount=mixedAmount $ usd 1} -- have to quote $ for regexpr
|
||||
@ -815,7 +815,7 @@ tests_Query = tests "Query" [
|
||||
assertBool "" $ not $ (toSym "shek") `matchesPosting` nullposting{pamount=mixedAmount nullamt{acommodity="shekels"}}
|
||||
]
|
||||
|
||||
,test "matchesTransaction" $ do
|
||||
,testCase "matchesTransaction" $ do
|
||||
assertBool "" $ Any `matchesTransaction` nulltransaction
|
||||
assertBool "" $ not $ (Desc $ toRegex' "x x") `matchesTransaction` nulltransaction{tdescription="x"}
|
||||
assertBool "" $ (Desc $ toRegex' "x x") `matchesTransaction` nulltransaction{tdescription="x x"}
|
||||
|
||||
@ -283,7 +283,7 @@ journalFilterSinceLatestDates ds@(d:_) j = (j', ds')
|
||||
|
||||
--- ** tests
|
||||
|
||||
tests_Read = tests "Read" [
|
||||
tests_Read = testGroup "Read" [
|
||||
tests_Common
|
||||
,tests_CsvReader
|
||||
,tests_JournalReader
|
||||
|
||||
@ -1574,12 +1574,12 @@ regexaliasp = do
|
||||
|
||||
--- ** tests
|
||||
|
||||
tests_Common = tests "Common" [
|
||||
tests_Common = testGroup "Common" [
|
||||
|
||||
tests "amountp" [
|
||||
test "basic" $ assertParseEq amountp "$47.18" (usd 47.18)
|
||||
,test "ends with decimal mark" $ assertParseEq amountp "$1." (usd 1 `withPrecision` Precision 0)
|
||||
,test "unit price" $ assertParseEq amountp "$10 @ €0.5"
|
||||
testGroup "amountp" [
|
||||
testCase "basic" $ assertParseEq amountp "$47.18" (usd 47.18)
|
||||
,testCase "ends with decimal mark" $ assertParseEq amountp "$1." (usd 1 `withPrecision` Precision 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{
|
||||
@ -1593,7 +1593,7 @@ tests_Common = tests "Common" [
|
||||
,astyle=amountstyle{asprecision=Precision 1, asdecimalpoint=Just '.'}
|
||||
}
|
||||
}
|
||||
,test "total price" $ assertParseEq amountp "$10 @@ €5"
|
||||
,testCase "total price" $ assertParseEq amountp "$10 @@ €5"
|
||||
amount{
|
||||
acommodity="$"
|
||||
,aquantity=10
|
||||
@ -1605,12 +1605,12 @@ tests_Common = tests "Common" [
|
||||
,astyle=amountstyle{asprecision=Precision 0, asdecimalpoint=Nothing}
|
||||
}
|
||||
}
|
||||
,test "unit price, parenthesised" $ assertParse amountp "$10 (@) €0.5"
|
||||
,test "total price, parenthesised" $ assertParse amountp "$10 (@@) €0.5"
|
||||
,testCase "unit price, parenthesised" $ assertParse amountp "$10 (@) €0.5"
|
||||
,testCase "total price, parenthesised" $ assertParse amountp "$10 (@@) €0.5"
|
||||
]
|
||||
|
||||
,let p = lift (numberp Nothing) :: JournalParser IO (Quantity, Word8, Maybe Char, Maybe DigitGroupStyle) in
|
||||
test "numberp" $ do
|
||||
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)
|
||||
@ -1632,11 +1632,11 @@ tests_Common = tests "Common" [
|
||||
assertParseEq p "1.555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555" (1.555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555, 255, Just '.', Nothing)
|
||||
assertParseError p "1.5555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555" ""
|
||||
|
||||
,tests "spaceandamountormissingp" [
|
||||
test "space and amount" $ assertParseEq spaceandamountormissingp " $47.18" (mixedAmount $ usd 47.18)
|
||||
,test "empty string" $ assertParseEq spaceandamountormissingp "" missingmixedamt
|
||||
-- ,test "just space" $ assertParseEq spaceandamountormissingp " " missingmixedamt -- XXX should it ?
|
||||
-- ,test "just amount" $ assertParseError spaceandamountormissingp "$47.18" "" -- succeeds, consuming nothing
|
||||
,testGroup "spaceandamountormissingp" [
|
||||
testCase "space and amount" $ assertParseEq spaceandamountormissingp " $47.18" (mixedAmount $ 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
|
||||
]
|
||||
|
||||
]
|
||||
|
||||
@ -1288,77 +1288,77 @@ parseDateWithCustomOrDefaultFormats mformat s = asum $ map parsewith formats
|
||||
|
||||
--- ** tests
|
||||
|
||||
tests_CsvReader = tests "CsvReader" [
|
||||
tests "parseCsvRules" [
|
||||
test "empty file" $
|
||||
tests_CsvReader = testGroup "CsvReader" [
|
||||
testGroup "parseCsvRules" [
|
||||
testCase "empty file" $
|
||||
parseCsvRules "unknown" "" @?= Right (mkrules defrules)
|
||||
]
|
||||
,tests "rulesp" [
|
||||
test "trailing comments" $
|
||||
,testGroup "rulesp" [
|
||||
testCase "trailing comments" $
|
||||
parseWithState' defrules rulesp "skip\n# \n#\n" @?= Right (mkrules $ defrules{rdirectives = [("skip","")]})
|
||||
|
||||
,test "trailing blank lines" $
|
||||
,testCase "trailing blank lines" $
|
||||
parseWithState' defrules rulesp "skip\n\n \n" @?= (Right (mkrules $ defrules{rdirectives = [("skip","")]}))
|
||||
|
||||
,test "no final newline" $
|
||||
,testCase "no final newline" $
|
||||
parseWithState' defrules rulesp "skip" @?= (Right (mkrules $ defrules{rdirectives=[("skip","")]}))
|
||||
|
||||
,test "assignment with empty value" $
|
||||
,testCase "assignment with empty value" $
|
||||
parseWithState' defrules rulesp "account1 \nif foo\n account2 foo\n" @?=
|
||||
(Right (mkrules $ defrules{rassignments = [("account1","")], rconditionalblocks = [CB{cbMatchers=[RecordMatcher None (toRegex' "foo")],cbAssignments=[("account2","foo")]}]}))
|
||||
]
|
||||
,tests "conditionalblockp" [
|
||||
test "space after conditional" $ -- #1120
|
||||
,testGroup "conditionalblockp" [
|
||||
testCase "space after conditional" $ -- #1120
|
||||
parseWithState' defrules conditionalblockp "if a\n account2 b\n \n" @?=
|
||||
(Right $ CB{cbMatchers=[RecordMatcher None $ toRegexCI' "a"],cbAssignments=[("account2","b")]})
|
||||
|
||||
,tests "csvfieldreferencep" [
|
||||
test "number" $ parseWithState' defrules csvfieldreferencep "%1" @?= (Right "%1")
|
||||
,test "name" $ parseWithState' defrules csvfieldreferencep "%date" @?= (Right "%date")
|
||||
,test "quoted name" $ parseWithState' defrules csvfieldreferencep "%\"csv date\"" @?= (Right "%\"csv date\"")
|
||||
,testGroup "csvfieldreferencep" [
|
||||
testCase "number" $ parseWithState' defrules csvfieldreferencep "%1" @?= (Right "%1")
|
||||
,testCase "name" $ parseWithState' defrules csvfieldreferencep "%date" @?= (Right "%date")
|
||||
,testCase "quoted name" $ parseWithState' defrules csvfieldreferencep "%\"csv date\"" @?= (Right "%\"csv date\"")
|
||||
]
|
||||
|
||||
,tests "matcherp" [
|
||||
,testGroup "matcherp" [
|
||||
|
||||
test "recordmatcherp" $
|
||||
testCase "recordmatcherp" $
|
||||
parseWithState' defrules matcherp "A A\n" @?= (Right $ RecordMatcher None $ toRegexCI' "A A")
|
||||
|
||||
,test "recordmatcherp.starts-with-&" $
|
||||
,testCase "recordmatcherp.starts-with-&" $
|
||||
parseWithState' defrules matcherp "& A A\n" @?= (Right $ RecordMatcher And $ toRegexCI' "A A")
|
||||
|
||||
,test "fieldmatcherp.starts-with-%" $
|
||||
,testCase "fieldmatcherp.starts-with-%" $
|
||||
parseWithState' defrules matcherp "description A A\n" @?= (Right $ RecordMatcher None $ toRegexCI' "description A A")
|
||||
|
||||
,test "fieldmatcherp" $
|
||||
,testCase "fieldmatcherp" $
|
||||
parseWithState' defrules matcherp "%description A A\n" @?= (Right $ FieldMatcher None "%description" $ toRegexCI' "A A")
|
||||
|
||||
,test "fieldmatcherp.starts-with-&" $
|
||||
,testCase "fieldmatcherp.starts-with-&" $
|
||||
parseWithState' defrules matcherp "& %description A A\n" @?= (Right $ FieldMatcher And "%description" $ toRegexCI' "A A")
|
||||
|
||||
-- ,test "fieldmatcherp with operator" $
|
||||
-- ,testCase "fieldmatcherp with operator" $
|
||||
-- parseWithState' defrules matcherp "%description ~ A A\n" @?= (Right $ FieldMatcher "%description" "A A")
|
||||
|
||||
]
|
||||
|
||||
,tests "getEffectiveAssignment" [
|
||||
,testGroup "getEffectiveAssignment" [
|
||||
let rules = mkrules $ defrules {rcsvfieldindexes=[("csvdate",1)],rassignments=[("date","%csvdate")]}
|
||||
|
||||
in test "toplevel" $ getEffectiveAssignment rules ["a","b"] "date" @?= (Just "%csvdate")
|
||||
in testCase "toplevel" $ getEffectiveAssignment rules ["a","b"] "date" @?= (Just "%csvdate")
|
||||
|
||||
,let rules = mkrules $ defrules{rcsvfieldindexes=[("csvdate",1)], rconditionalblocks=[CB [FieldMatcher None "%csvdate" $ toRegex' "a"] [("date","%csvdate")]]}
|
||||
in test "conditional" $ getEffectiveAssignment rules ["a","b"] "date" @?= (Just "%csvdate")
|
||||
in testCase "conditional" $ getEffectiveAssignment rules ["a","b"] "date" @?= (Just "%csvdate")
|
||||
|
||||
,let rules = mkrules $ defrules{rcsvfieldindexes=[("csvdate",1),("description",2)], rconditionalblocks=[CB [FieldMatcher None "%csvdate" $ toRegex' "a", FieldMatcher None "%description" $ toRegex' "b"] [("date","%csvdate")]]}
|
||||
in test "conditional-with-or-a" $ getEffectiveAssignment rules ["a"] "date" @?= (Just "%csvdate")
|
||||
in testCase "conditional-with-or-a" $ getEffectiveAssignment rules ["a"] "date" @?= (Just "%csvdate")
|
||||
|
||||
,let rules = mkrules $ defrules{rcsvfieldindexes=[("csvdate",1),("description",2)], rconditionalblocks=[CB [FieldMatcher None "%csvdate" $ toRegex' "a", FieldMatcher None "%description" $ toRegex' "b"] [("date","%csvdate")]]}
|
||||
in test "conditional-with-or-b" $ getEffectiveAssignment rules ["_", "b"] "date" @?= (Just "%csvdate")
|
||||
in testCase "conditional-with-or-b" $ getEffectiveAssignment rules ["_", "b"] "date" @?= (Just "%csvdate")
|
||||
|
||||
,let rules = mkrules $ defrules{rcsvfieldindexes=[("csvdate",1),("description",2)], rconditionalblocks=[CB [FieldMatcher None "%csvdate" $ toRegex' "a", FieldMatcher And "%description" $ toRegex' "b"] [("date","%csvdate")]]}
|
||||
in test "conditional.with-and" $ getEffectiveAssignment rules ["a", "b"] "date" @?= (Just "%csvdate")
|
||||
in testCase "conditional.with-and" $ getEffectiveAssignment rules ["a", "b"] "date" @?= (Just "%csvdate")
|
||||
|
||||
,let rules = mkrules $ defrules{rcsvfieldindexes=[("csvdate",1),("description",2)], rconditionalblocks=[CB [FieldMatcher None "%csvdate" $ toRegex' "a", FieldMatcher And "%description" $ toRegex' "b", FieldMatcher None "%description" $ toRegex' "c"] [("date","%csvdate")]]}
|
||||
in test "conditional.with-and-or" $ getEffectiveAssignment rules ["_", "c"] "date" @?= (Just "%csvdate")
|
||||
in testCase "conditional.with-and-or" $ getEffectiveAssignment rules ["_", "c"] "date" @?= (Just "%csvdate")
|
||||
|
||||
]
|
||||
|
||||
|
||||
@ -738,32 +738,32 @@ postingphelper isPostingRule mTransactionYear = do
|
||||
|
||||
--- ** tests
|
||||
|
||||
tests_JournalReader = tests "JournalReader" [
|
||||
tests_JournalReader = testGroup "JournalReader" [
|
||||
|
||||
let p = lift accountnamep :: JournalParser IO AccountName in
|
||||
tests "accountnamep" [
|
||||
test "basic" $ assertParse p "a:b:c"
|
||||
-- ,test "empty inner component" $ assertParseError p "a::c" "" -- TODO
|
||||
-- ,test "empty leading component" $ assertParseError p ":b:c" "x"
|
||||
-- ,test "empty trailing component" $ assertParseError p "a:b:" "x"
|
||||
testGroup "accountnamep" [
|
||||
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.
|
||||
-- Hyphen (-) and period (.) are also allowed as separators.
|
||||
-- The year may be omitted if a default year has been set.
|
||||
-- Leading zeroes may be omitted."
|
||||
,tests "datep" [
|
||||
test "YYYY/MM/DD" $ assertParseEq datep "2018/01/01" (fromGregorian 2018 1 1)
|
||||
,test "YYYY-MM-DD" $ assertParse datep "2018-01-01"
|
||||
,test "YYYY.MM.DD" $ assertParse datep "2018.01.01"
|
||||
,test "yearless date with no default year" $ assertParseError datep "1/1" "current year is unknown"
|
||||
,test "yearless date with default year" $ do
|
||||
,testGroup "datep" [
|
||||
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 nulljournal{jparsedefaultyear=Just 2018} datep s
|
||||
either (assertFailure . ("parse error at "++) . customErrorBundlePretty) (const $ return ()) ep
|
||||
,test "no leading zero" $ assertParse datep "2018/1/1"
|
||||
,testCase "no leading zero" $ assertParse datep "2018/1/1"
|
||||
]
|
||||
,test "datetimep" $ do
|
||||
,testCase "datetimep" $ do
|
||||
let
|
||||
good = assertParse datetimep
|
||||
bad = (\t -> assertParseError datetimep t "")
|
||||
@ -779,9 +779,9 @@ tests_JournalReader = tests "JournalReader" [
|
||||
assertParseEq datetimep "2018/1/1 00:00-0800" t
|
||||
assertParseEq datetimep "2018/1/1 00:00+1234" t
|
||||
|
||||
,tests "periodictransactionp" [
|
||||
,testGroup "periodictransactionp" [
|
||||
|
||||
test "more period text in comment after one space" $ assertParseEq 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"
|
||||
@ -791,7 +791,7 @@ tests_JournalReader = tests "JournalReader" [
|
||||
,ptcomment = "In 2019 we will change this\n"
|
||||
}
|
||||
|
||||
,test "more period text in description after two spaces" $ assertParseEq 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"
|
||||
@ -801,7 +801,7 @@ tests_JournalReader = tests "JournalReader" [
|
||||
,ptcomment = ""
|
||||
}
|
||||
|
||||
,test "Next year in description" $ assertParseEq periodictransactionp
|
||||
,testCase "Next year in description" $ assertParseEq periodictransactionp
|
||||
"~ monthly Next year blah blah\n"
|
||||
nullperiodictransaction {
|
||||
ptperiodexpr = "monthly"
|
||||
@ -811,7 +811,7 @@ tests_JournalReader = tests "JournalReader" [
|
||||
,ptcomment = ""
|
||||
}
|
||||
|
||||
,test "Just date, no description" $ assertParseEq periodictransactionp
|
||||
,testCase "Just date, no description" $ assertParseEq periodictransactionp
|
||||
"~ 2019-01-04\n"
|
||||
nullperiodictransaction {
|
||||
ptperiodexpr = "2019-01-04"
|
||||
@ -821,13 +821,13 @@ tests_JournalReader = tests "JournalReader" [
|
||||
,ptcomment = ""
|
||||
}
|
||||
|
||||
,test "Just date, no description + empty transaction comment" $ assertParse 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" $ assertParseEq (postingp Nothing)
|
||||
,testGroup "postingp" [
|
||||
testCase "basic" $ assertParseEq (postingp Nothing)
|
||||
" expenses:food:dining $10.00 ; a: a a \n ; b: b b \n"
|
||||
posting{
|
||||
paccount="expenses:food:dining",
|
||||
@ -836,7 +836,7 @@ tests_JournalReader = tests "JournalReader" [
|
||||
ptags=[("a","a a"), ("b","b b")]
|
||||
}
|
||||
|
||||
,test "posting dates" $ assertParseEq (postingp Nothing)
|
||||
,testCase "posting dates" $ assertParseEq (postingp Nothing)
|
||||
" a 1. ; date:2012/11/28, date2=2012/11/29,b:b\n"
|
||||
nullposting{
|
||||
paccount="a"
|
||||
@ -847,7 +847,7 @@ tests_JournalReader = tests "JournalReader" [
|
||||
,pdate2=Nothing -- Just $ fromGregorian 2012 11 29
|
||||
}
|
||||
|
||||
,test "posting dates bracket syntax" $ assertParseEq (postingp Nothing)
|
||||
,testCase "posting dates bracket syntax" $ assertParseEq (postingp Nothing)
|
||||
" a 1. ; [2012/11/28=2012/11/29]\n"
|
||||
nullposting{
|
||||
paccount="a"
|
||||
@ -858,25 +858,25 @@ tests_JournalReader = tests "JournalReader" [
|
||||
,pdate2=Just $ fromGregorian 2012 11 29
|
||||
}
|
||||
|
||||
,test "quoted commodity symbol with digits" $ assertParse (postingp Nothing) " a 1 \"DE123\"\n"
|
||||
,testCase "quoted commodity symbol with digits" $ assertParse (postingp Nothing) " a 1 \"DE123\"\n"
|
||||
|
||||
,test "only lot price" $ assertParse (postingp Nothing) " a 1A {1B}\n"
|
||||
,test "fixed lot price" $ assertParse (postingp Nothing) " a 1A {=1B}\n"
|
||||
,test "total lot price" $ assertParse (postingp Nothing) " a 1A {{1B}}\n"
|
||||
,test "fixed total lot price, and spaces" $ assertParse (postingp Nothing) " a 1A {{ = 1B }}\n"
|
||||
,test "lot price before transaction price" $ assertParse (postingp Nothing) " a 1A {1B} @ 1B\n"
|
||||
,test "lot price after transaction price" $ assertParse (postingp Nothing) " a 1A @ 1B {1B}\n"
|
||||
,test "lot price after balance assertion not allowed" $ assertParseError (postingp Nothing) " a 1A @ 1B = 1A {1B}\n" "unexpected '{'"
|
||||
,test "only lot date" $ assertParse (postingp Nothing) " a 1A [2000-01-01]\n"
|
||||
,test "transaction price, lot price, lot date" $ assertParse (postingp Nothing) " a 1A @ 1B {1B} [2000-01-01]\n"
|
||||
,test "lot date, lot price, transaction price" $ assertParse (postingp Nothing) " a 1A [2000-01-01] {1B} @ 1B\n"
|
||||
,testCase "only lot price" $ assertParse (postingp Nothing) " a 1A {1B}\n"
|
||||
,testCase "fixed lot price" $ assertParse (postingp Nothing) " a 1A {=1B}\n"
|
||||
,testCase "total lot price" $ assertParse (postingp Nothing) " a 1A {{1B}}\n"
|
||||
,testCase "fixed total lot price, and spaces" $ assertParse (postingp Nothing) " a 1A {{ = 1B }}\n"
|
||||
,testCase "lot price before transaction price" $ assertParse (postingp Nothing) " a 1A {1B} @ 1B\n"
|
||||
,testCase "lot price after transaction price" $ assertParse (postingp Nothing) " a 1A @ 1B {1B}\n"
|
||||
,testCase "lot price after balance assertion not allowed" $ assertParseError (postingp Nothing) " a 1A @ 1B = 1A {1B}\n" "unexpected '{'"
|
||||
,testCase "only lot date" $ assertParse (postingp Nothing) " a 1A [2000-01-01]\n"
|
||||
,testCase "transaction price, lot price, lot date" $ assertParse (postingp Nothing) " a 1A @ 1B {1B} [2000-01-01]\n"
|
||||
,testCase "lot date, lot price, transaction price" $ assertParse (postingp Nothing) " a 1A [2000-01-01] {1B} @ 1B\n"
|
||||
|
||||
,test "balance assertion over entire contents of account" $ assertParse (postingp Nothing) " a $1 == $1\n"
|
||||
,testCase "balance assertion over entire contents of account" $ assertParse (postingp Nothing) " a $1 == $1\n"
|
||||
]
|
||||
|
||||
,tests "transactionmodifierp" [
|
||||
,testGroup "transactionmodifierp" [
|
||||
|
||||
test "basic" $ assertParseEq transactionmodifierp
|
||||
testCase "basic" $ assertParseEq transactionmodifierp
|
||||
"= (some value expr)\n some:postings 1.\n"
|
||||
nulltransactionmodifier {
|
||||
tmquerytxt = "(some value expr)"
|
||||
@ -884,11 +884,11 @@ tests_JournalReader = tests "JournalReader" [
|
||||
}
|
||||
]
|
||||
|
||||
,tests "transactionp" [
|
||||
,testGroup "transactionp" [
|
||||
|
||||
test "just a date" $ assertParseEq 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" $ assertParseEq transactionp
|
||||
,testCase "more complex" $ assertParseEq transactionp
|
||||
(T.unlines [
|
||||
"2012/05/14=2012/05/15 (code) desc ; tcomment1",
|
||||
" ; tcomment2",
|
||||
@ -922,7 +922,7 @@ tests_JournalReader = tests "JournalReader" [
|
||||
]
|
||||
}
|
||||
|
||||
,test "parses a well-formed transaction" $
|
||||
,testCase "parses a well-formed transaction" $
|
||||
assertBool "" $ isRight $ rjp transactionp $ T.unlines
|
||||
["2007/01/28 coopportunity"
|
||||
," expenses:food:groceries $47.18"
|
||||
@ -930,10 +930,10 @@ tests_JournalReader = tests "JournalReader" [
|
||||
,""
|
||||
]
|
||||
|
||||
,test "does not parse a following comment as part of the description" $
|
||||
,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 "parses a following whitespace line" $
|
||||
,testCase "parses a following whitespace line" $
|
||||
assertBool "" $ isRight $ rjp transactionp $ T.unlines
|
||||
["2012/1/1"
|
||||
," a 1"
|
||||
@ -941,7 +941,7 @@ tests_JournalReader = tests "JournalReader" [
|
||||
," "
|
||||
]
|
||||
|
||||
,test "parses an empty transaction comment following whitespace line" $
|
||||
,testCase "parses an empty transaction comment following whitespace line" $
|
||||
assertBool "" $ isRight $ rjp transactionp $ T.unlines
|
||||
["2012/1/1"
|
||||
," ;"
|
||||
@ -950,7 +950,7 @@ tests_JournalReader = tests "JournalReader" [
|
||||
," "
|
||||
]
|
||||
|
||||
,test "comments everywhere, two postings parsed" $
|
||||
,testCase "comments everywhere, two postings parsed" $
|
||||
assertParseEqOn transactionp
|
||||
(T.unlines
|
||||
["2009/1/1 x ; transaction comment"
|
||||
@ -966,17 +966,17 @@ tests_JournalReader = tests "JournalReader" [
|
||||
|
||||
-- directives
|
||||
|
||||
,tests "directivep" [
|
||||
test "supports !" $ do
|
||||
,testGroup "directivep" [
|
||||
testCase "supports !" $ do
|
||||
assertParseE directivep "!account a\n"
|
||||
assertParseE directivep "!D 1.0\n"
|
||||
]
|
||||
|
||||
,tests "accountdirectivep" [
|
||||
test "with-comment" $ assertParse accountdirectivep "account a:b ; a comment\n"
|
||||
,test "does-not-support-!" $ assertParseError accountdirectivep "!account a:b\n" ""
|
||||
,test "account-type-code" $ assertParse accountdirectivep "account a:b A\n"
|
||||
,test "account-type-tag" $ assertParseStateOn accountdirectivep "account a:b ; type:asset\n"
|
||||
,testGroup "accountdirectivep" [
|
||||
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")]
|
||||
@ -985,28 +985,28 @@ tests_JournalReader = tests "JournalReader" [
|
||||
]
|
||||
]
|
||||
|
||||
,test "commodityconversiondirectivep" $ do
|
||||
,testCase "commodityconversiondirectivep" $ do
|
||||
assertParse commodityconversiondirectivep "C 1h = $50.00\n"
|
||||
|
||||
,test "defaultcommoditydirectivep" $ do
|
||||
,testCase "defaultcommoditydirectivep" $ do
|
||||
assertParse defaultcommoditydirectivep "D $1,000.0\n"
|
||||
assertParseError defaultcommoditydirectivep "D $1000\n" "Please include a decimal point or decimal comma"
|
||||
|
||||
,tests "defaultyeardirectivep" [
|
||||
test "1000" $ assertParse defaultyeardirectivep "Y 1000" -- XXX no \n like the others
|
||||
-- ,test "999" $ assertParseError defaultyeardirectivep "Y 999" "bad year number"
|
||||
,test "12345" $ assertParse defaultyeardirectivep "Y 12345"
|
||||
,testGroup "defaultyeardirectivep" [
|
||||
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
|
||||
,testCase "ignoredpricecommoditydirectivep" $ do
|
||||
assertParse ignoredpricecommoditydirectivep "N $\n"
|
||||
|
||||
,tests "includedirectivep" [
|
||||
test "include" $ assertParseErrorE includedirectivep "include nosuchfile\n" "No existing files match pattern: nosuchfile"
|
||||
,test "glob" $ assertParseErrorE includedirectivep "include nosuchfile*\n" "No existing files match pattern: nosuchfile*"
|
||||
,testGroup "includedirectivep" [
|
||||
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" $ assertParseEq marketpricedirectivep
|
||||
,testCase "marketpricedirectivep" $ assertParseEq marketpricedirectivep
|
||||
"P 2017/01/30 BTC $922.83\n"
|
||||
PriceDirective{
|
||||
pddate = fromGregorian 2017 1 30,
|
||||
@ -1014,24 +1014,24 @@ tests_JournalReader = tests "JournalReader" [
|
||||
pdamount = usd 922.83
|
||||
}
|
||||
|
||||
,tests "payeedirectivep" [
|
||||
test "simple" $ assertParse payeedirectivep "payee foo\n"
|
||||
,test "with-comment" $ assertParse payeedirectivep "payee foo ; comment\n"
|
||||
,testGroup "payeedirectivep" [
|
||||
testCase "simple" $ assertParse payeedirectivep "payee foo\n"
|
||||
,testCase "with-comment" $ assertParse payeedirectivep "payee foo ; comment\n"
|
||||
]
|
||||
|
||||
,test "tagdirectivep" $ do
|
||||
,testCase "tagdirectivep" $ do
|
||||
assertParse tagdirectivep "tag foo \n"
|
||||
|
||||
,test "endtagdirectivep" $ do
|
||||
,testCase "endtagdirectivep" $ do
|
||||
assertParse endtagdirectivep "end tag \n"
|
||||
assertParse endtagdirectivep "pop \n"
|
||||
|
||||
,tests "journalp" [
|
||||
test "empty file" $ assertParseEqE journalp "" nulljournal
|
||||
,testGroup "journalp" [
|
||||
testCase "empty file" $ assertParseEqE journalp "" nulljournal
|
||||
]
|
||||
|
||||
-- these are defined here rather than in Common so they can use journalp
|
||||
,test "parseAndFinaliseJournal" $ do
|
||||
,testCase "parseAndFinaliseJournal" $ do
|
||||
ej <- runExceptT $ parseAndFinaliseJournal journalp definputopts "" "2019-1-1\n"
|
||||
let Right j = ej
|
||||
assertEqual "" [""] $ journalFilePaths j
|
||||
|
||||
@ -24,6 +24,7 @@ module Hledger.Reports (
|
||||
)
|
||||
where
|
||||
|
||||
import Test.Tasty (testGroup)
|
||||
import Hledger.Reports.ReportOptions
|
||||
import Hledger.Reports.ReportTypes
|
||||
import Hledger.Reports.AccountTransactionsReport
|
||||
@ -32,9 +33,8 @@ import Hledger.Reports.PostingsReport
|
||||
import Hledger.Reports.BalanceReport
|
||||
import Hledger.Reports.MultiBalanceReport
|
||||
import Hledger.Reports.BudgetReport
|
||||
import Hledger.Utils.Test
|
||||
|
||||
tests_Reports = tests "Reports" [
|
||||
tests_Reports = testGroup "Reports" [
|
||||
tests_BalanceReport
|
||||
,tests_BudgetReport
|
||||
,tests_AccountTransactionsReport
|
||||
|
||||
@ -255,5 +255,5 @@ filterAccountTransactionsReportByCommodity c =
|
||||
|
||||
-- tests
|
||||
|
||||
tests_AccountTransactionsReport = tests "AccountTransactionsReport" [
|
||||
tests_AccountTransactionsReport = testGroup "AccountTransactionsReport" [
|
||||
]
|
||||
|
||||
@ -100,7 +100,7 @@ Right samplejournal2 =
|
||||
]
|
||||
}
|
||||
|
||||
tests_BalanceReport = tests "BalanceReport" [
|
||||
tests_BalanceReport = testGroup "BalanceReport" [
|
||||
|
||||
let
|
||||
(rspec,journal) `gives` r = do
|
||||
@ -111,12 +111,12 @@ tests_BalanceReport = tests "BalanceReport" [
|
||||
(map showw aitems) @?= (map showw eitems)
|
||||
(showMixedAmountDebug atotal) @?= (showMixedAmountDebug etotal)
|
||||
in
|
||||
tests "balanceReport" [
|
||||
testGroup "balanceReport" [
|
||||
|
||||
test "no args, null journal" $
|
||||
testCase "no args, null journal" $
|
||||
(defreportspec, nulljournal) `gives` ([], nullmixedamt)
|
||||
|
||||
,test "no args, sample journal" $
|
||||
,testCase "no args, sample journal" $
|
||||
(defreportspec, samplejournal) `gives`
|
||||
([
|
||||
("assets:bank:checking","assets:bank:checking",0, mamountp' "$1.00")
|
||||
@ -129,7 +129,7 @@ tests_BalanceReport = tests "BalanceReport" [
|
||||
],
|
||||
mixedAmount (usd 0))
|
||||
|
||||
,test "with --tree" $
|
||||
,testCase "with --tree" $
|
||||
(defreportspec{_rsReportOpts=defreportopts{accountlistmode_=ALTree}}, samplejournal) `gives`
|
||||
([
|
||||
("assets","assets",0, mamountp' "$0.00")
|
||||
@ -146,7 +146,7 @@ tests_BalanceReport = tests "BalanceReport" [
|
||||
],
|
||||
mixedAmount (usd 0))
|
||||
|
||||
,test "with --depth=N" $
|
||||
,testCase "with --depth=N" $
|
||||
(defreportspec{_rsReportOpts=defreportopts{depth_=Just 1}}, samplejournal) `gives`
|
||||
([
|
||||
("expenses", "expenses", 0, mamountp' "$2.00")
|
||||
@ -154,7 +154,7 @@ tests_BalanceReport = tests "BalanceReport" [
|
||||
],
|
||||
mixedAmount (usd 0))
|
||||
|
||||
,test "with depth:N" $
|
||||
,testCase "with depth:N" $
|
||||
(defreportspec{_rsQuery=Depth 1}, samplejournal) `gives`
|
||||
([
|
||||
("expenses", "expenses", 0, mamountp' "$2.00")
|
||||
@ -162,11 +162,11 @@ tests_BalanceReport = tests "BalanceReport" [
|
||||
],
|
||||
mixedAmount (usd 0))
|
||||
|
||||
,test "with date:" $
|
||||
,testCase "with date:" $
|
||||
(defreportspec{_rsQuery=Date $ DateSpan (Just $ fromGregorian 2009 01 01) (Just $ fromGregorian 2010 01 01)}, samplejournal2) `gives`
|
||||
([], nullmixedamt)
|
||||
|
||||
,test "with date2:" $
|
||||
,testCase "with date2:" $
|
||||
(defreportspec{_rsQuery=Date2 $ DateSpan (Just $ fromGregorian 2009 01 01) (Just $ fromGregorian 2010 01 01)}, samplejournal2) `gives`
|
||||
([
|
||||
("assets:bank:checking","assets:bank:checking",0,mamountp' "$1.00")
|
||||
@ -174,7 +174,7 @@ tests_BalanceReport = tests "BalanceReport" [
|
||||
],
|
||||
mixedAmount (usd 0))
|
||||
|
||||
,test "with desc:" $
|
||||
,testCase "with desc:" $
|
||||
(defreportspec{_rsQuery=Desc $ toRegexCI' "income"}, samplejournal) `gives`
|
||||
([
|
||||
("assets:bank:checking","assets:bank:checking",0,mamountp' "$1.00")
|
||||
@ -182,7 +182,7 @@ tests_BalanceReport = tests "BalanceReport" [
|
||||
],
|
||||
mixedAmount (usd 0))
|
||||
|
||||
,test "with not:desc:" $
|
||||
,testCase "with not:desc:" $
|
||||
(defreportspec{_rsQuery=Not . Desc $ toRegexCI' "income"}, samplejournal) `gives`
|
||||
([
|
||||
("assets:bank:saving","assets:bank:saving",0, mamountp' "$1.00")
|
||||
@ -193,7 +193,7 @@ tests_BalanceReport = tests "BalanceReport" [
|
||||
],
|
||||
mixedAmount (usd 0))
|
||||
|
||||
,test "with period on a populated period" $
|
||||
,testCase "with period on a populated period" $
|
||||
(defreportspec{_rsReportOpts=defreportopts{period_= PeriodBetween (fromGregorian 2008 1 1) (fromGregorian 2008 1 2)}}, samplejournal) `gives`
|
||||
(
|
||||
[
|
||||
@ -202,14 +202,14 @@ tests_BalanceReport = tests "BalanceReport" [
|
||||
],
|
||||
mixedAmount (usd 0))
|
||||
|
||||
,test "with period on an unpopulated period" $
|
||||
,testCase "with period on an unpopulated period" $
|
||||
(defreportspec{_rsReportOpts=defreportopts{period_= PeriodBetween (fromGregorian 2008 1 2) (fromGregorian 2008 1 3)}}, samplejournal) `gives`
|
||||
([], nullmixedamt)
|
||||
|
||||
|
||||
|
||||
{-
|
||||
,test "accounts report with account pattern o" ~:
|
||||
,testCase "accounts report with account pattern o" ~:
|
||||
defreportopts{patterns_=["o"]} `gives`
|
||||
[" $1 expenses:food"
|
||||
," $-2 income"
|
||||
@ -219,7 +219,7 @@ tests_BalanceReport = tests "BalanceReport" [
|
||||
," $-1"
|
||||
]
|
||||
|
||||
,test "accounts report with account pattern o and --depth 1" ~:
|
||||
,testCase "accounts report with account pattern o and --depth 1" ~:
|
||||
defreportopts{patterns_=["o"],depth_=Just 1} `gives`
|
||||
[" $1 expenses"
|
||||
," $-2 income"
|
||||
@ -227,7 +227,7 @@ tests_BalanceReport = tests "BalanceReport" [
|
||||
," $-1"
|
||||
]
|
||||
|
||||
,test "accounts report with account pattern a" ~:
|
||||
,testCase "accounts report with account pattern a" ~:
|
||||
defreportopts{patterns_=["a"]} `gives`
|
||||
[" $-1 assets"
|
||||
," $1 bank:saving"
|
||||
@ -238,7 +238,7 @@ tests_BalanceReport = tests "BalanceReport" [
|
||||
," $-1"
|
||||
]
|
||||
|
||||
,test "accounts report with account pattern e" ~:
|
||||
,testCase "accounts report with account pattern e" ~:
|
||||
defreportopts{patterns_=["e"]} `gives`
|
||||
[" $-1 assets"
|
||||
," $1 bank:saving"
|
||||
@ -254,7 +254,7 @@ tests_BalanceReport = tests "BalanceReport" [
|
||||
," 0"
|
||||
]
|
||||
|
||||
,test "accounts report with unmatched parent of two matched subaccounts" ~:
|
||||
,testCase "accounts report with unmatched parent of two matched subaccounts" ~:
|
||||
defreportopts{patterns_=["cash","saving"]} `gives`
|
||||
[" $-1 assets"
|
||||
," $1 bank:saving"
|
||||
@ -263,14 +263,14 @@ tests_BalanceReport = tests "BalanceReport" [
|
||||
," $-1"
|
||||
]
|
||||
|
||||
,test "accounts report with multi-part account name" ~:
|
||||
,testCase "accounts report with multi-part account name" ~:
|
||||
defreportopts{patterns_=["expenses:food"]} `gives`
|
||||
[" $1 expenses:food"
|
||||
,"--------------------"
|
||||
," $1"
|
||||
]
|
||||
|
||||
,test "accounts report with negative account pattern" ~:
|
||||
,testCase "accounts report with negative account pattern" ~:
|
||||
defreportopts{patterns_=["not:assets"]} `gives`
|
||||
[" $2 expenses"
|
||||
," $1 food"
|
||||
@ -283,20 +283,20 @@ tests_BalanceReport = tests "BalanceReport" [
|
||||
," $1"
|
||||
]
|
||||
|
||||
,test "accounts report negative account pattern always matches full name" ~:
|
||||
,testCase "accounts report negative account pattern always matches full name" ~:
|
||||
defreportopts{patterns_=["not:e"]} `gives`
|
||||
["--------------------"
|
||||
," 0"
|
||||
]
|
||||
|
||||
,test "accounts report negative patterns affect totals" ~:
|
||||
,testCase "accounts report negative patterns affect totals" ~:
|
||||
defreportopts{patterns_=["expenses","not:food"]} `gives`
|
||||
[" $1 expenses:supplies"
|
||||
,"--------------------"
|
||||
," $1"
|
||||
]
|
||||
|
||||
,test "accounts report with -E shows zero-balance accounts" ~:
|
||||
,testCase "accounts report with -E shows zero-balance accounts" ~:
|
||||
defreportopts{patterns_=["assets"],empty_=True} `gives`
|
||||
[" $-1 assets"
|
||||
," $1 bank"
|
||||
@ -307,7 +307,7 @@ tests_BalanceReport = tests "BalanceReport" [
|
||||
," $-1"
|
||||
]
|
||||
|
||||
,test "accounts report with cost basis" $
|
||||
,testCase "accounts report with cost basis" $
|
||||
j <- (readJournal def Nothing $ unlines
|
||||
[""
|
||||
,"2008/1/1 test "
|
||||
|
||||
@ -446,5 +446,5 @@ budgetReportAsCsv
|
||||
|
||||
-- tests
|
||||
|
||||
tests_BudgetReport = tests "BudgetReport" [
|
||||
tests_BudgetReport = testGroup "BudgetReport" [
|
||||
]
|
||||
|
||||
@ -39,10 +39,10 @@ entriesReport rspec@ReportSpec{_rsReportOpts=ropts} =
|
||||
. journalApplyValuationFromOpts rspec{_rsReportOpts=ropts{show_costs_=True}}
|
||||
. filterJournalTransactions (_rsQuery rspec)
|
||||
|
||||
tests_EntriesReport = tests "EntriesReport" [
|
||||
tests "entriesReport" [
|
||||
test "not acct" $ (length $ entriesReport defreportspec{_rsQuery=Not . Acct $ toRegex' "bank"} samplejournal) @?= 1
|
||||
,test "date" $ (length $ entriesReport defreportspec{_rsQuery=Date $ DateSpan (Just $ fromGregorian 2008 06 01) (Just $ fromGregorian 2008 07 01)} samplejournal) @?= 3
|
||||
tests_EntriesReport = testGroup "EntriesReport" [
|
||||
testGroup "entriesReport" [
|
||||
testCase "not acct" $ (length $ entriesReport defreportspec{_rsQuery=Not . Acct $ toRegex' "bank"} samplejournal) @?= 1
|
||||
,testCase "date" $ (length $ entriesReport defreportspec{_rsQuery=Date $ DateSpan (Just $ fromGregorian 2008 06 01) (Just $ fromGregorian 2008 07 01)} samplejournal) @?= 3
|
||||
]
|
||||
]
|
||||
|
||||
|
||||
@ -582,7 +582,7 @@ balanceReportTableAsText ReportOpts{..} =
|
||||
|
||||
-- tests
|
||||
|
||||
tests_MultiBalanceReport = tests "MultiBalanceReport" [
|
||||
tests_MultiBalanceReport = testGroup "MultiBalanceReport" [
|
||||
|
||||
let
|
||||
amt0 = Amount {acommodity="$", aquantity=0, aprice=Nothing, astyle=AmountStyle {ascommodityside = L, ascommodityspaced = False, asprecision = Precision 2, asdecimalpoint = Just '.', asdigitgroups = Nothing}}
|
||||
@ -595,11 +595,11 @@ tests_MultiBalanceReport = tests "MultiBalanceReport" [
|
||||
(map showw aitems) @?= (map showw eitems)
|
||||
showMixedAmountDebug (prrTotal atotal) @?= showMixedAmountDebug etotal -- we only check the sum of the totals
|
||||
in
|
||||
tests "multiBalanceReport" [
|
||||
test "null journal" $
|
||||
testGroup "multiBalanceReport" [
|
||||
testCase "null journal" $
|
||||
(defreportspec, nulljournal) `gives` ([], nullmixedamt)
|
||||
|
||||
,test "with -H on a populated period" $
|
||||
,testCase "with -H on a populated period" $
|
||||
(defreportspec{_rsReportOpts=defreportopts{period_= PeriodBetween (fromGregorian 2008 1 1) (fromGregorian 2008 1 2), balanceaccum_=Historical}}, samplejournal) `gives`
|
||||
(
|
||||
[ PeriodicReportRow (flatDisplayName "assets:bank:checking") [mamountp' "$1.00"] (mamountp' "$1.00") (mixedAmount amt0{aquantity=1})
|
||||
@ -607,7 +607,7 @@ tests_MultiBalanceReport = tests "MultiBalanceReport" [
|
||||
],
|
||||
mamountp' "$0.00")
|
||||
|
||||
-- ,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), balanceaccum_=Historical}, samplejournal) `gives`
|
||||
-- (
|
||||
-- [
|
||||
@ -616,7 +616,7 @@ tests_MultiBalanceReport = tests "MultiBalanceReport" [
|
||||
-- ],
|
||||
-- mixedAmount 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), balanceaccum_=Historical}, samplejournal) `gives`
|
||||
-- (
|
||||
-- [
|
||||
|
||||
@ -218,9 +218,9 @@ negatePostingAmount = postingTransformAmount negate
|
||||
|
||||
-- tests
|
||||
|
||||
tests_PostingsReport = tests "PostingsReport" [
|
||||
tests_PostingsReport = testGroup "PostingsReport" [
|
||||
|
||||
test "postingsReport" $ do
|
||||
testCase "postingsReport" $ do
|
||||
let (query, journal) `gives` n = (length $ postingsReport defreportspec{_rsQuery=query} journal) @?= n
|
||||
-- with the query specified explicitly
|
||||
(Any, nulljournal) `gives` 0
|
||||
@ -381,7 +381,7 @@ tests_PostingsReport = tests "PostingsReport" [
|
||||
|
||||
-}
|
||||
|
||||
,test "summarisePostingsByInterval" $
|
||||
,testCase "summarisePostingsByInterval" $
|
||||
summarisePostingsByInterval (Quarters 1) PrimaryDate Nothing False (DateSpan Nothing Nothing) [] @?= []
|
||||
|
||||
-- ,tests_summarisePostingsInDateSpan = [
|
||||
|
||||
@ -320,6 +320,6 @@ makeHledgerClassyLenses x = flip makeLensesWith x $ classyRules
|
||||
-- Fields of ReportOpts which need to update the Query when they are updated.
|
||||
queryFields = Set.fromList ["period", "statuses", "depth", "date2", "real", "querystring"]
|
||||
|
||||
tests_Utils = tests "Utils" [
|
||||
tests_Utils = testGroup "Utils" [
|
||||
tests_Text
|
||||
]
|
||||
|
||||
@ -7,8 +7,6 @@ module Hledger.Utils.Test (
|
||||
,module Test.Tasty.HUnit
|
||||
-- ,module QC
|
||||
-- ,module SC
|
||||
,tests
|
||||
,test
|
||||
,assertLeft
|
||||
,assertRight
|
||||
,assertParse
|
||||
@ -46,15 +44,6 @@ import Hledger.Utils.Debug (pshow)
|
||||
|
||||
-- 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 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 ()
|
||||
|
||||
@ -59,7 +59,8 @@ import qualified Data.Text as T
|
||||
import qualified Data.Text.Lazy as TL
|
||||
import qualified Data.Text.Lazy.Builder as TB
|
||||
|
||||
import Hledger.Utils.Test ((@?=), test, tests)
|
||||
import Test.Tasty (testGroup)
|
||||
import Test.Tasty.HUnit ((@?=), testCase)
|
||||
import Text.Tabular.AsciiWide
|
||||
(Align(..), Header(..), Properties(..), TableOpts(..), renderRow, textCell)
|
||||
import Text.WideString (WideBuilder(..), wbToText, wbFromText, wbUnpack, charWidth, textWidth)
|
||||
@ -260,8 +261,8 @@ readDecimal = T.foldl' step 0
|
||||
where step a c = a * 10 + toInteger (digitToInt c)
|
||||
|
||||
|
||||
tests_Text = tests "Text" [
|
||||
test "quoteIfSpaced" $ do
|
||||
tests_Text = testGroup "Text" [
|
||||
testCase "quoteIfSpaced" $ do
|
||||
quoteIfSpaced "a'a" @?= "a'a"
|
||||
quoteIfSpaced "a\"a" @?= "a\"a"
|
||||
quoteIfSpaced "a a" @?= "\"a a\""
|
||||
|
||||
@ -13,7 +13,7 @@ import Yesod.Test
|
||||
import Hledger.Web.Application ( makeFoundationWith )
|
||||
import Hledger.Web.WebOptions ( WebOpts(cliopts_), defwebopts, prognameandversion )
|
||||
import Hledger.Web.Import hiding (get, j)
|
||||
import Hledger.Cli hiding (prognameandversion, tests)
|
||||
import Hledger.Cli hiding (prognameandversion)
|
||||
|
||||
|
||||
runHspecTestsWith :: AppConfig DefaultEnv Extra -> WebOpts -> Journal -> YesodSpec App -> IO ()
|
||||
|
||||
@ -268,27 +268,27 @@ testmode = hledgerCommandMode
|
||||
testcmd :: CliOpts -> Journal -> IO ()
|
||||
testcmd opts _undefined = do
|
||||
withArgs (listofstringopt "args" $ rawopts_ opts) $
|
||||
Test.Tasty.defaultMain $ tests "hledger" [
|
||||
Test.Tasty.defaultMain $ testGroup "hledger" [
|
||||
tests_Hledger
|
||||
,tests_Hledger_Cli
|
||||
]
|
||||
|
||||
-- All unit tests for Hledger.Cli, defined here rather than
|
||||
-- Hledger.Cli so testcmd can use them.
|
||||
tests_Hledger_Cli = tests "Hledger.Cli" [
|
||||
tests_Hledger_Cli = testGroup "Hledger.Cli" [
|
||||
tests_Cli_Utils
|
||||
,tests_Commands
|
||||
]
|
||||
|
||||
tests_Commands = tests "Commands" [
|
||||
tests_Commands = testGroup "Commands" [
|
||||
tests_Balance
|
||||
,tests_Register
|
||||
,tests_Aregister
|
||||
|
||||
-- some more tests easiest to define here:
|
||||
|
||||
,tests "apply account directive" [
|
||||
test "works" $ do
|
||||
,testGroup "apply account directive" [
|
||||
testCase "works" $ do
|
||||
let
|
||||
ignoresourcepos j = j{jtxns=map (\t -> t{tsourcepos=nullsourcepos}) (jtxns j)}
|
||||
sameParse str1 str2 = do
|
||||
@ -309,43 +309,43 @@ tests_Commands = tests "Commands" [
|
||||
"2008/12/07 Five\n foo $-5\n bar $5\n"
|
||||
)
|
||||
|
||||
,test "preserves \"virtual\" posting type" $ do
|
||||
,testCase "preserves \"virtual\" posting type" $ do
|
||||
j <- readJournal definputopts Nothing "apply account test\n2008/12/07 One\n (from) $-1\n (to) $1\n" >>= either error' return -- PARTIAL:
|
||||
let p = head $ tpostings $ head $ jtxns j
|
||||
paccount p @?= "test:from"
|
||||
ptype p @?= VirtualPosting
|
||||
]
|
||||
|
||||
,test "alias directive" $ do
|
||||
,testCase "alias directive" $ do
|
||||
j <- readJournal definputopts Nothing "!alias expenses = equity:draw:personal\n1/1\n (expenses:food) 1\n" >>= either error' return -- PARTIAL:
|
||||
let p = head $ tpostings $ head $ jtxns j
|
||||
paccount p @?= "equity:draw:personal:food"
|
||||
|
||||
,test "Y default year directive" $ do
|
||||
,testCase "Y default year directive" $ do
|
||||
j <- readJournal definputopts Nothing defaultyear_journal_txt >>= either error' return -- PARTIAL:
|
||||
tdate (head $ jtxns j) @?= fromGregorian 2009 1 1
|
||||
|
||||
,test "ledgerAccountNames" $
|
||||
,testCase "ledgerAccountNames" $
|
||||
(ledgerAccountNames ledger7)
|
||||
@?=
|
||||
["assets","assets:cash","assets:checking","assets:saving","equity","equity:opening balances",
|
||||
"expenses","expenses:food","expenses:food:dining","expenses:phone","expenses:vacation",
|
||||
"liabilities","liabilities:credit cards","liabilities:credit cards:discover"]
|
||||
|
||||
-- ,test "journalCanonicaliseAmounts" ~:
|
||||
-- ,testCase "journalCanonicaliseAmounts" ~:
|
||||
-- "use the greatest precision" ~:
|
||||
-- (map asprecision $ journalAmountAndPriceCommodities $ journalCanonicaliseAmounts $ journalWithAmounts ["1","2.00"]) @?= [2,2]
|
||||
|
||||
-- don't know what this should do
|
||||
-- ,test "elideAccountName" ~: do
|
||||
-- ,testCase "elideAccountName" ~: do
|
||||
-- (elideAccountName 50 "aaaaaaaaaaaaaaaaaaaa:aaaaaaaaaaaaaaaaaaaa:aaaaaaaaaaaaaaaaaaaa"
|
||||
-- @?= "aa:aaaaaaaaaaaaaaaaaaaa:aaaaaaaaaaaaaaaaaaaa")
|
||||
-- (elideAccountName 20 "aaaaaaaaaaaaaaaaaaaa:aaaaaaaaaaaaaaaaaaaa:aaaaaaaaaaaaaaaaaaaa"
|
||||
-- @?= "aa:aa:aaaaaaaaaaaaaa")
|
||||
|
||||
,test "show dollars" $ showAmount (usd 1) @?= "$1.00"
|
||||
,testCase "show dollars" $ showAmount (usd 1) @?= "$1.00"
|
||||
|
||||
,test "show hours" $ showAmount (hrs 1) @?= "1.00h"
|
||||
,testCase "show hours" $ showAmount (hrs 1) @?= "1.00h"
|
||||
|
||||
]
|
||||
|
||||
|
||||
@ -210,6 +210,6 @@ accountTransactionsReportItemAsText
|
||||
|
||||
-- tests
|
||||
|
||||
tests_Aregister = tests "Aregister" [
|
||||
tests_Aregister = testGroup "Aregister" [
|
||||
|
||||
]
|
||||
|
||||
@ -711,10 +711,10 @@ balanceOpts isTable ReportOpts{..} = oneLine
|
||||
, displayMaxWidth = if isTable && not no_elide_ then Just 32 else Nothing
|
||||
}
|
||||
|
||||
tests_Balance = tests "Balance" [
|
||||
tests_Balance = testGroup "Balance" [
|
||||
|
||||
tests "balanceReportAsText" [
|
||||
test "unicode in balance layout" $ do
|
||||
testGroup "balanceReportAsText" [
|
||||
testCase "unicode in balance layout" $ do
|
||||
j <- readJournal' "2009/01/01 * медвежья шкура\n расходы:покупки 100\n актив:наличные\n"
|
||||
let rspec = defreportspec{_rsReportOpts=defreportopts{no_total_=True}}
|
||||
TB.toLazyText (balanceReportAsText (_rsReportOpts rspec) (balanceReport rspec{_rsDay=fromGregorian 2008 11 26} j))
|
||||
|
||||
@ -184,10 +184,10 @@ postingsReportItemAsText opts preferredamtwidth preferredbalwidth (mdate, mperio
|
||||
|
||||
-- tests
|
||||
|
||||
tests_Register = tests "Register" [
|
||||
tests_Register = testGroup "Register" [
|
||||
|
||||
tests "postingsReportAsText" [
|
||||
test "unicode in register layout" $ do
|
||||
testGroup "postingsReportAsText" [
|
||||
testCase "unicode in register layout" $ do
|
||||
j <- readJournal' "2009/01/01 * медвежья шкура\n расходы:покупки 100\n актив:наличные\n"
|
||||
let rspec = defreportspec
|
||||
(TL.unpack . postingsReportAsText defcliopts $ postingsReport rspec j)
|
||||
|
||||
@ -256,14 +256,14 @@ journalSimilarTransaction cliopts j desc = mbestmatch
|
||||
journalTransactionsSimilarTo j q desc 10
|
||||
q = queryFromFlags $ _rsReportOpts $ reportspec_ cliopts
|
||||
|
||||
tests_Cli_Utils = tests "Utils" [
|
||||
tests_Cli_Utils = testGroup "Utils" [
|
||||
|
||||
-- tests "journalApplyValue" [
|
||||
-- testGroup "journalApplyValue" [
|
||||
-- -- Print the time required to convert one of the sample journals' amounts to value.
|
||||
-- -- Pretty clunky, but working.
|
||||
-- -- XXX sample.journal has no price records, but is always present.
|
||||
-- -- Change to eg examples/5000x1000x10.journal to make this useful.
|
||||
-- test "time" $ do
|
||||
-- testCase "time" $ do
|
||||
-- ej <- io $ readJournalFile definputopts "examples/3000x1000x10.journal"
|
||||
-- case ej of
|
||||
-- Left e -> crash $ T.pack e
|
||||
|
||||
Loading…
Reference in New Issue
Block a user