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

cln: tests: Remove test and tests, which are just aliases for testCase

Browse Source 
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 2021-08-30 15:23:23 +10:00 committed by Simon Michael
parent 83aa7324eb
commit 8274da81fc
33 changed files with 314 additions and 323 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
hledger-lib/Hledger.hs
View File

@ -12,7 +12,7 @@ import Hledger.Reports as X
import Hledger.Query as X import Hledger.Query as X
import Hledger.Utils as X import Hledger.Utils as X
tests_Hledger = tests "Hledger" [ tests_Hledger = testGroup "Hledger" [
tests_Data tests_Data
,tests_Query ,tests_Query
,tests_Read ,tests_Read

4
hledger-lib/Hledger/Data.hs
View File

@ -30,6 +30,7 @@ module Hledger.Data (
) )
where where
import Test.Tasty (testGroup)
import Hledger.Data.Account import Hledger.Data.Account
import Hledger.Data.AccountName import Hledger.Data.AccountName
import Hledger.Data.Amount import Hledger.Data.Amount
@ -47,9 +48,8 @@ import Hledger.Data.Transaction
import Hledger.Data.TransactionModifier import Hledger.Data.TransactionModifier
import Hledger.Data.Types hiding (MixedAmountKey, Mixed) import Hledger.Data.Types hiding (MixedAmountKey, Mixed)
import Hledger.Data.Valuation import Hledger.Data.Valuation
import Hledger.Utils.Test
tests_Data = tests "Data" [ tests_Data = testGroup "Data" [
tests_AccountName tests_AccountName
,tests_Amount ,tests_Amount
,tests_Dates ,tests_Dates

10
hledger-lib/Hledger/Data/AccountName.hs
View File

@ -235,21 +235,21 @@ accountNameToAccountOnlyRegexCI a = toRegexCI' $ "^" <> escapeName a <> "$" -- P
--isAccountRegex :: String -> Bool --isAccountRegex :: String -> Bool
--isAccountRegex s = take 1 s == "^" && take 5 (reverse s) == ")$|:(" --isAccountRegex s = take 1 s == "^" && take 5 (reverse s) == ")$|:("
tests_AccountName = tests "AccountName" [ tests_AccountName = testGroup "AccountName" [
test "accountNameTreeFrom" $ do testCase "accountNameTreeFrom" $ do
accountNameTreeFrom ["a"] @?= Node "root" [Node "a" []] accountNameTreeFrom ["a"] @?= Node "root" [Node "a" []]
accountNameTreeFrom ["a","b"] @?= Node "root" [Node "a" [], Node "b" []] accountNameTreeFrom ["a","b"] @?= Node "root" [Node "a" [], Node "b" []]
accountNameTreeFrom ["a","a:b"] @?= Node "root" [Node "a" [Node "a:b" []]] accountNameTreeFrom ["a","a:b"] @?= Node "root" [Node "a" [Node "a:b" []]]
accountNameTreeFrom ["a:b:c"] @?= Node "root" [Node "a" [Node "a:b" [Node "a:b:c" []]]] accountNameTreeFrom ["a:b:c"] @?= Node "root" [Node "a" [Node "a:b" [Node "a:b:c" []]]]
,test "expandAccountNames" $ do ,testCase "expandAccountNames" $ do
expandAccountNames ["assets:cash","assets:checking","expenses:vacation"] @?= expandAccountNames ["assets:cash","assets:checking","expenses:vacation"] @?=
["assets","assets:cash","assets:checking","expenses","expenses:vacation"] ["assets","assets:cash","assets:checking","expenses","expenses:vacation"]
,test "isAccountNamePrefixOf" $ do ,testCase "isAccountNamePrefixOf" $ do
"assets" `isAccountNamePrefixOf` "assets" @?= False "assets" `isAccountNamePrefixOf` "assets" @?= False
"assets" `isAccountNamePrefixOf` "assets:bank" @?= True "assets" `isAccountNamePrefixOf` "assets:bank" @?= True
"assets" `isAccountNamePrefixOf` "assets:bank:checking" @?= True "assets" `isAccountNamePrefixOf` "assets:bank:checking" @?= True
"my assets" `isAccountNamePrefixOf` "assets:bank" @?= False "my assets" `isAccountNamePrefixOf` "assets:bank" @?= False
,test "isSubAccountNameOf" $ do ,testCase "isSubAccountNameOf" $ do
"assets" `isSubAccountNameOf` "assets" @?= False "assets" `isSubAccountNameOf` "assets" @?= False
"assets:bank" `isSubAccountNameOf` "assets" @?= True "assets:bank" `isSubAccountNameOf` "assets" @?= True
"assets:bank:checking" `isSubAccountNameOf` "assets" @?= False "assets:bank:checking" `isSubAccountNameOf` "assets" @?= False

40
hledger-lib/Hledger/Data/Amount.hs
View File

@ -984,24 +984,24 @@ mixedAmountTotalPriceToUnitPrice = mapMixedAmount amountTotalPriceToUnitPrice
------------------------------------------------------------------------------- -------------------------------------------------------------------------------
-- tests -- tests
tests_Amount = tests "Amount" [ tests_Amount = testGroup "Amount" [
tests "Amount" [ testGroup "Amount" [
test "amountCost" $ do testCase "amountCost" $ do
amountCost (eur 1) @?= eur 1 amountCost (eur 1) @?= eur 1
amountCost (eur 2){aprice=Just $ UnitPrice $ usd 2} @?= usd 4 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
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 amount
assertBool "" $ amountLooksZero $ usd 0 assertBool "" $ amountLooksZero $ usd 0
,test "negating amounts" $ do ,testCase "negating amounts" $ do
negate (usd 1) @?= (usd 1){aquantity= -1} negate (usd 1) @?= (usd 1){aquantity= -1}
let b = (usd 1){aprice=Just $ UnitPrice $ eur 2} in negate b @?= b{aquantity= -1} let b = (usd 1){aprice=Just $ UnitPrice $ eur 2} in negate b @?= b{aquantity= -1}
,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 0 (usd 1.23 + usd (-1.23)) @?= usd 0
(usd (-1.23) + usd (-1.23)) @?= usd (-2.46) (usd (-1.23) + usd (-1.23)) @?= usd (-2.46)
@ -1012,21 +1012,21 @@ tests_Amount = tests "Amount" [
-- adding different commodities assumes conversion rate 1 -- adding different commodities assumes conversion rate 1
assertBool "" $ amountLooksZero (usd 1.23 - eur 1.23) assertBool "" $ amountLooksZero (usd 1.23 - eur 1.23)
,test "showAmount" $ do ,testCase "showAmount" $ do
showAmount (usd 0 + gbp 0) @?= "0" 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] let usdpos = mixed [usd 1]
usdneg = mixed [usd (-1)] usdneg = mixed [usd (-1)]
eurneg = mixed [eur (-12)] eurneg = mixed [eur (-12)]
compare usdneg usdpos @?= LT compare usdneg usdpos @?= LT
compare eurneg 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 maSum (map mixedAmount
[usd 1.25 [usd 1.25
,usd (-1) `withPrecision` Precision 3 ,usd (-1) `withPrecision` Precision 3
@ -1034,39 +1034,39 @@ tests_Amount = tests "Amount" [
]) ])
@?= mixedAmount (usd 0 `withPrecision` Precision 3) @?= 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 maSum (map mixedAmount
[usd 1 @@ eur 1 [usd 1 @@ eur 1
,usd (-2) @@ eur 1 ,usd (-2) @@ eur 1
]) ])
@?= mixedAmount (usd (-1) @@ eur 2) @?= mixedAmount (usd (-1) @@ eur 2)
,test "showMixedAmount" $ do ,testCase "showMixedAmount" $ do
showMixedAmount (mixedAmount (usd 1)) @?= "$1.00" showMixedAmount (mixedAmount (usd 1)) @?= "$1.00"
showMixedAmount (mixedAmount (usd 1 `at` eur 2)) @?= "$1.00 @ €2.00" showMixedAmount (mixedAmount (usd 1 `at` eur 2)) @?= "$1.00 @ €2.00"
showMixedAmount (mixedAmount (usd 0)) @?= "0" showMixedAmount (mixedAmount (usd 0)) @?= "0"
showMixedAmount nullmixedamt @?= "0" showMixedAmount nullmixedamt @?= "0"
showMixedAmount missingmixedamt @?= "" showMixedAmount missingmixedamt @?= ""
,test "showMixedAmountWithoutPrice" $ do ,testCase "showMixedAmountWithoutPrice" $ do
let a = usd 1 `at` eur 2 let a = usd 1 `at` eur 2
showMixedAmountWithoutPrice False (mixedAmount (a)) @?= "$1.00" showMixedAmountWithoutPrice False (mixedAmount (a)) @?= "$1.00"
showMixedAmountWithoutPrice False (mixed [a, -a]) @?= "0" showMixedAmountWithoutPrice False (mixed [a, -a]) @?= "0"
,tests "amounts" [ ,testGroup "amounts" [
test "a missing amount overrides any other amounts" $ testCase "a missing amount overrides any other amounts" $
amounts (mixed [usd 1, missingamt]) @?= [missingamt] 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] 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] 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] 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] amounts (mixed [usd 1 @@ eur 1, usd 1 @@ eur 1]) @?= [usd 2 @@ eur 2]
] ]
,test "mixedAmountStripPrices" $ do ,testCase "mixedAmountStripPrices" $ do
amounts (mixedAmountStripPrices nullmixedamt) @?= [nullamt] amounts (mixedAmountStripPrices nullmixedamt) @?= [nullamt]
assertBool "" $ mixedAmountLooksZero $ mixedAmountStripPrices assertBool "" $ mixedAmountLooksZero $ mixedAmountStripPrices
(mixed [usd 10 (mixed [usd 10

6
hledger-lib/Hledger/Data/Dates.hs
View File

@ -1038,8 +1038,8 @@ nulldate = fromGregorian 0 1 1
-- tests -- tests
tests_Dates = tests "Dates" tests_Dates = testGroup "Dates"
[ test "weekday" $ do [ testCase "weekday" $ do
splitSpan (DaysOfWeek [1..5]) (DateSpan (Just $ fromGregorian 2021 07 01) (Just $ fromGregorian 2021 07 08)) 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 28) (Just $ fromGregorian 2021 06 29))
, (DateSpan (Just $ fromGregorian 2021 06 29) (Just $ fromGregorian 2021 06 30)) , (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)) , (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 let dayofweek n s = splitspan (nthdayofweekcontaining n) (applyN (n-1) nextday . nextweek) s
match ds day = dayofweek day ds == splitSpan (DaysOfWeek [day]) ds @?= True match ds day = dayofweek day ds == splitSpan (DaysOfWeek [day]) ds @?= True
ys2021 = fromGregorian 2021 01 01 ys2021 = fromGregorian 2021 01 01

34
hledger-lib/Hledger/Data/Journal.hs
View File

@ -1513,9 +1513,9 @@ Right samplejournal = journalBalanceTransactions defbalancingopts $
] ]
} }
tests_Journal = tests "Journal" [ tests_Journal = testGroup "Journal" [
test "journalDateSpan" $ testCase "journalDateSpan" $
journalDateSpan True nulljournal{ journalDateSpan True nulljournal{
jtxns = [nulltransaction{tdate = fromGregorian 2014 02 01 jtxns = [nulltransaction{tdate = fromGregorian 2014 02 01
,tpostings = [posting{pdate=Just (fromGregorian 2014 01 10)}] ,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)) @?= (DateSpan (Just $ fromGregorian 2014 1 10) (Just $ fromGregorian 2014 10 11))
,tests "standard account type queries" $ ,testGroup "standard account type queries" $
let let
j = samplejournal j = samplejournal
journalAccountNamesMatching :: Query -> Journal -> [AccountName] journalAccountNamesMatching :: Query -> Journal -> [AccountName]
journalAccountNamesMatching q = filter (q `matchesAccount`) . journalAccountNames journalAccountNamesMatching q = filter (q `matchesAccount`) . journalAccountNames
namesfrom qfunc = journalAccountNamesMatching (qfunc j) j namesfrom qfunc = journalAccountNamesMatching (qfunc j) j
in [ in [
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) (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) (namesfrom journalCashAccountQuery)
,test "liabilities" $ assertEqual "" ["liabilities","liabilities:debts"] ,testCase "liabilities" $ assertEqual "" ["liabilities","liabilities:debts"]
(namesfrom journalLiabilityAccountQuery) (namesfrom journalLiabilityAccountQuery)
,test "equity" $ assertEqual "" [] ,testCase "equity" $ assertEqual "" []
(namesfrom journalEquityAccountQuery) (namesfrom journalEquityAccountQuery)
,test "income" $ assertEqual "" ["income","income:gifts","income:salary"] ,testCase "income" $ assertEqual "" ["income","income:gifts","income:salary"]
(namesfrom journalRevenueAccountQuery) (namesfrom journalRevenueAccountQuery)
,test "expenses" $ assertEqual "" ["expenses","expenses:food","expenses:supplies"] ,testCase "expenses" $ assertEqual "" ["expenses","expenses:food","expenses:supplies"]
(namesfrom journalExpenseAccountQuery) (namesfrom journalExpenseAccountQuery)
] ]
,tests "journalBalanceTransactions" [ ,testGroup "journalBalanceTransactions" [
test "balance-assignment" $ do testCase "balance-assignment" $ do
let ej = journalBalanceTransactions defbalancingopts $ let ej = journalBalanceTransactions defbalancingopts $
--2019/01/01 --2019/01/01
-- (a) = 1 -- (a) = 1
@ -1561,7 +1561,7 @@ tests_Journal = tests "Journal" [
let Right j = ej let Right j = ej
(jtxns j & head & tpostings & head & pamount & amountsRaw) @?= [num 1] (jtxns j & head & tpostings & head & pamount & amountsRaw) @?= [num 1]
,test "same-day-1" $ do ,testCase "same-day-1" $ do
assertRight $ journalBalanceTransactions defbalancingopts $ assertRight $ journalBalanceTransactions defbalancingopts $
--2019/01/01 --2019/01/01
-- (a) = 1 -- (a) = 1
@ -1572,7 +1572,7 @@ tests_Journal = tests "Journal" [
,transaction (fromGregorian 2019 01 01) [ vpost' "a" (num 1) (balassert (num 2)) ] ,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 $ assertRight $ journalBalanceTransactions defbalancingopts $
--2019/01/01 --2019/01/01
-- (a) 2 = 2 -- (a) 2 = 2
@ -1590,7 +1590,7 @@ tests_Journal = tests "Journal" [
,transaction (fromGregorian 2019 01 01) [ post' "a" (num 0) (balassert (num 1)) ] ,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 $ assertRight $ journalBalanceTransactions defbalancingopts $
--2019/1/2 --2019/1/2
-- (a) 1 = 2 -- (a) 1 = 2
@ -1603,7 +1603,7 @@ tests_Journal = tests "Journal" [
] ]
,tests "commodityStylesFromAmounts" $ [ ,testGroup "commodityStylesFromAmounts" $ [
-- Journal similar to the one on #1091: -- Journal similar to the one on #1091:
-- 2019/09/24 -- 2019/09/24
@ -1612,7 +1612,7 @@ tests_Journal = tests "Journal" [
-- 2019/09/26 -- 2019/09/26
-- (a) 1000,000 -- (a) 1000,000
-- --
test "1091a" $ do testCase "1091a" $ do
commodityStylesFromAmounts [ commodityStylesFromAmounts [
nullamt{aquantity=1000, astyle=AmountStyle L False (Precision 3) (Just ',') Nothing} nullamt{aquantity=1000, astyle=AmountStyle L False (Precision 3) (Just ',') Nothing}
,nullamt{aquantity=1000, astyle=AmountStyle L False (Precision 2) (Just '.') (Just (DigitGroups ',' [3]))} ,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]))) ("", AmountStyle L False (Precision 3) (Just '.') (Just (DigitGroups ',' [3])))
]) ])
-- same journal, entries in reverse order -- same journal, entries in reverse order
,test "1091b" $ do ,testCase "1091b" $ do
commodityStylesFromAmounts [ commodityStylesFromAmounts [
nullamt{aquantity=1000, astyle=AmountStyle L False (Precision 2) (Just '.') (Just (DigitGroups ',' [3]))} nullamt{aquantity=1000, astyle=AmountStyle L False (Precision 2) (Just '.') (Just (DigitGroups ',' [3]))}
,nullamt{aquantity=1000, astyle=AmountStyle L False (Precision 3) (Just ',') Nothing} ,nullamt{aquantity=1000, astyle=AmountStyle L False (Precision 3) (Just ',') Nothing}

7
hledger-lib/Hledger/Data/Ledger.hs
View File

@ -28,7 +28,8 @@ import qualified Data.Map as M
import Safe (headDef) import Safe (headDef)
import Text.Printf import Text.Printf
import Hledger.Utils.Test import Test.Tasty (testGroup)
import Test.Tasty.HUnit ((@?=), testCase)
import Hledger.Data.Types import Hledger.Data.Types
import Hledger.Data.Account import Hledger.Data.Account
import Hledger.Data.Journal import Hledger.Data.Journal
@ -101,8 +102,8 @@ ledgerCommodities = M.keys . jinferredcommodities . ljournal
-- tests -- tests
tests_Ledger = tests_Ledger =
tests "Ledger" [ testGroup "Ledger" [
test "ledgerFromJournal" $ do testCase "ledgerFromJournal" $ do
length (ledgerPostings $ ledgerFromJournal Any nulljournal) @?= 0 length (ledgerPostings $ ledgerFromJournal Any nulljournal) @?= 0
length (ledgerPostings $ ledgerFromJournal Any samplejournal) @?= 13 length (ledgerPostings $ ledgerFromJournal Any samplejournal) @?= 13
length (ledgerPostings $ ledgerFromJournal (Depth 2) samplejournal) @?= 7 length (ledgerPostings $ ledgerFromJournal (Depth 2) samplejournal) @?= 7

16
hledger-lib/Hledger/Data/Posting.hs
View File

@ -378,34 +378,34 @@ commentAddTagNextLine cmt (t,v) =
-- tests -- tests
tests_Posting = tests "Posting" [ tests_Posting = testGroup "Posting" [
test "accountNamePostingType" $ do testCase "accountNamePostingType" $ do
accountNamePostingType "a" @?= RegularPosting accountNamePostingType "a" @?= RegularPosting
accountNamePostingType "(a)" @?= VirtualPosting accountNamePostingType "(a)" @?= VirtualPosting
accountNamePostingType "[a]" @?= BalancedVirtualPosting accountNamePostingType "[a]" @?= BalancedVirtualPosting
,test "accountNameWithoutPostingType" $ do ,testCase "accountNameWithoutPostingType" $ do
accountNameWithoutPostingType "(a)" @?= "a" accountNameWithoutPostingType "(a)" @?= "a"
,test "accountNameWithPostingType" $ do ,testCase "accountNameWithPostingType" $ do
accountNameWithPostingType VirtualPosting "[a]" @?= "(a)" 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)" "a" `joinAccountNames` "(b:c)" @?= "(a:b:c)"
"[a]" `joinAccountNames` "(b:c)" @?= "[a:b:c]" "[a]" `joinAccountNames` "(b:c)" @?= "[a:b:c]"
"" `joinAccountNames` "a" @?= "a" "" `joinAccountNames` "a" @?= "a"
,test "concatAccountNames" $ do ,testCase "concatAccountNames" $ do
concatAccountNames [] @?= "" concatAccountNames [] @?= ""
concatAccountNames ["a","(b)","[c:d]"] @?= "(a:b:c:d)" concatAccountNames ["a","(b)","[c:d]"] @?= "(a:b:c:d)"
,test "commentAddTag" $ do ,testCase "commentAddTag" $ do
commentAddTag "" ("a","") @?= "a: " commentAddTag "" ("a","") @?= "a: "
commentAddTag "[1/2]" ("a","") @?= "[1/2], a: " commentAddTag "[1/2]" ("a","") @?= "[1/2], a: "
,test "commentAddTagNextLine" $ do ,testCase "commentAddTagNextLine" $ do
commentAddTagNextLine "" ("a","") @?= "\na: " commentAddTagNextLine "" ("a","") @?= "\na: "
commentAddTagNextLine "[1/2]" ("a","") @?= "[1/2]\na: " commentAddTagNextLine "[1/2]" ("a","") @?= "[1/2]\na: "

10
hledger-lib/Hledger/Data/StringFormat.hs
View File

@ -159,9 +159,9 @@ formatStringTester fs value expected = actual @?= expected
FormatLiteral l -> formatText False Nothing Nothing l FormatLiteral l -> formatText False Nothing Nothing l
FormatField leftJustify min max _ -> formatText leftJustify min max value 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 (FormatLiteral " ") "" " "
formatStringTester (FormatField False Nothing Nothing DescriptionField) "description" "description" formatStringTester (FormatField False Nothing Nothing DescriptionField) "description" "description"
formatStringTester (FormatField False (Just 20) Nothing DescriptionField) "description" " description" formatStringTester (FormatField False (Just 20) Nothing DescriptionField) "description" " description"
@ -171,8 +171,8 @@ tests_StringFormat = tests "StringFormat" [
formatStringTester (FormatField True (Just 20) (Just 20) DescriptionField) "description" "description " formatStringTester (FormatField True (Just 20) (Just 20) DescriptionField) "description" "description "
formatStringTester (FormatField True Nothing (Just 3) DescriptionField) "description" "des" formatStringTester (FormatField True Nothing (Just 3) DescriptionField) "description" "des"
,let s `gives` expected = test s $ parseStringFormat (T.pack s) @?= Right expected ,let s `gives` expected = testCase s $ parseStringFormat (T.pack s) @?= Right expected
in tests "parseStringFormat" [ in testGroup "parseStringFormat" [
"" `gives` (defaultStringFormatStyle []) "" `gives` (defaultStringFormatStyle [])
, "D" `gives` (defaultStringFormatStyle [FormatLiteral "D"]) , "D" `gives` (defaultStringFormatStyle [FormatLiteral "D"])
, "%(date)" `gives` (defaultStringFormatStyle [FormatField False (Just 0) Nothing DescriptionField]) , "%(date)" `gives` (defaultStringFormatStyle [FormatField False (Just 0) Nothing DescriptionField])
@ -190,6 +190,6 @@ tests_StringFormat = tests "StringFormat" [
,FormatLiteral " " ,FormatLiteral " "
,FormatField False (Just 0) (Just 10) TotalField ,FormatField False (Just 0) (Just 10) TotalField
]) ])
, test "newline not parsed" $ assertLeft $ parseStringFormat "\n" , testCase "newline not parsed" $ assertLeft $ parseStringFormat "\n"
] ]
] ]

2
hledger-lib/Hledger/Data/Timeclock.hs
View File

@ -126,7 +126,7 @@ entryFromTimeclockInOut i o
-- tests -- tests
tests_Timeclock = tests "Timeclock" [ tests_Timeclock = testGroup "Timeclock" [
testCaseSteps "timeclockEntriesToTransactions tests" $ \step -> do testCaseSteps "timeclockEntriesToTransactions tests" $ \step -> do
step "gathering data" step "gathering data"
today <- getCurrentDay today <- getCurrentDay

72
hledger-lib/Hledger/Data/Transaction.hs
View File

@ -670,11 +670,11 @@ makeHledgerClassyLenses ''BalancingOpts
tests_Transaction :: TestTree tests_Transaction :: TestTree
tests_Transaction = tests_Transaction =
tests "Transaction" [ testGroup "Transaction" [
tests "showPostingLines" [ testGroup "showPostingLines" [
test "null posting" $ showPostingLines nullposting @?= [" 0"] testCase "null posting" $ showPostingLines nullposting @?= [" 0"]
, test "non-null posting" $ , testCase "non-null posting" $
let p = let p =
posting posting
{ pstatus = Cleared { pstatus = Cleared
@ -709,45 +709,45 @@ tests_Transaction =
t3 = nulltransaction {tpostings = ["a" `post` usd 1, "b" `post` missingamt, "c" `post` usd (-1)]} t3 = nulltransaction {tpostings = ["a" `post` usd 1, "b" `post` missingamt, "c" `post` usd (-1)]}
-- unbalanced amounts when precision is limited (#931) -- unbalanced amounts when precision is limited (#931)
-- t4 = nulltransaction {tpostings = ["a" `post` usd (-0.01), "b" `post` usd (0.005), "c" `post` usd (0.005)]} -- t4 = nulltransaction {tpostings = ["a" `post` usd (-0.01), "b" `post` usd (0.005), "c" `post` usd (0.005)]}
in tests "postingsAsLines" [ in testGroup "postingsAsLines" [
test "null-transaction" $ postingsAsLines False (tpostings nulltransaction) @?= [] testCase "null-transaction" $ postingsAsLines False (tpostings nulltransaction) @?= []
, test "implicit-amount" $ postingsAsLines False (tpostings timp) @?= , testCase "implicit-amount" $ postingsAsLines False (tpostings timp) @?=
[ " a $1.00" [ " a $1.00"
, " b" -- implicit amount remains implicit , " b" -- implicit amount remains implicit
] ]
, test "explicit-amounts" $ postingsAsLines False (tpostings texp) @?= , testCase "explicit-amounts" $ postingsAsLines False (tpostings texp) @?=
[ " a $1.00" [ " a $1.00"
, " b $-1.00" , " b $-1.00"
] ]
, test "one-explicit-amount" $ postingsAsLines False (tpostings texp1) @?= , testCase "one-explicit-amount" $ postingsAsLines False (tpostings texp1) @?=
[ " (a) $1.00" [ " (a) $1.00"
] ]
, test "explicit-amounts-two-commodities" $ postingsAsLines False (tpostings texp2) @?= , testCase "explicit-amounts-two-commodities" $ postingsAsLines False (tpostings texp2) @?=
[ " a $1.00" [ " a $1.00"
, " b -1.00h @ $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" [ " a $1.00"
, " b -1.00h" , " 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"] [" a $1.00", " b", " c $-1.00"]
-- , test "ensure-visibly-balanced" $ -- , testCase "ensure-visibly-balanced" $
-- in postingsAsLines False (tpostings t4) @?= -- in postingsAsLines False (tpostings t4) @?=
-- [" a $-0.01", " b $0.005", " c $0.005"] -- [" a $-0.01", " b $0.005", " c $0.005"]
] ]
, test "inferBalancingAmount" $ do , testCase "inferBalancingAmount" $ do
(fst <$> inferBalancingAmount M.empty nulltransaction) @?= Right nulltransaction (fst <$> inferBalancingAmount M.empty nulltransaction) @?= Right nulltransaction
(fst <$> inferBalancingAmount M.empty nulltransaction{tpostings = ["a" `post` usd (-5), "b" `post` missingamt]}) @?= (fst <$> inferBalancingAmount M.empty nulltransaction{tpostings = ["a" `post` usd (-5), "b" `post` missingamt]}) @?=
Right nulltransaction{tpostings = ["a" `post` usd (-5), "b" `post` usd 5]} Right nulltransaction{tpostings = ["a" `post` usd (-5), "b" `post` usd 5]}
(fst <$> inferBalancingAmount M.empty nulltransaction{tpostings = ["a" `post` usd (-5), "b" `post` (eur 3 @@ usd 4), "c" `post` missingamt]}) @?= (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]} Right nulltransaction{tpostings = ["a" `post` usd (-5), "b" `post` (eur 3 @@ usd 4), "c" `post` usd 1]}
, tests "showTransaction" [ , testGroup "showTransaction" [
test "null transaction" $ showTransaction nulltransaction @?= "0000-01-01\n\n" testCase "null transaction" $ showTransaction nulltransaction @?= "0000-01-01\n\n"
, test "non-null transaction" $ showTransaction , testCase "non-null transaction" $ showTransaction
nulltransaction nulltransaction
{ tdate = fromGregorian 2012 05 14 { tdate = fromGregorian 2012 05 14
, tdate2 = Just $ fromGregorian 2012 05 15 , tdate2 = Just $ fromGregorian 2012 05 15
@ -776,7 +776,7 @@ tests_Transaction =
, " ; pcomment2" , " ; pcomment2"
, "" , ""
] ]
, test "show a balanced transaction" $ , testCase "show a balanced transaction" $
(let t = (let t =
Transaction Transaction
0 0
@ -799,7 +799,7 @@ tests_Transaction =
, " assets:checking $-47.18" , " assets:checking $-47.18"
, "" , ""
]) ])
, test "show an unbalanced transaction, should not elide" $ , testCase "show an unbalanced transaction, should not elide" $
(showTransaction (showTransaction
(txnTieKnot $ (txnTieKnot $
Transaction Transaction
@ -822,7 +822,7 @@ tests_Transaction =
, " assets:checking $-47.19" , " 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 (showTransaction
(txnTieKnot $ (txnTieKnot $
Transaction Transaction
@ -838,7 +838,7 @@ tests_Transaction =
[] []
[posting {paccount = "expenses:food:groceries", pamount = missingmixedamt}])) @?= [posting {paccount = "expenses:food:groceries", pamount = missingmixedamt}])) @?=
(T.unlines ["2007-01-28 coopportunity", " expenses:food:groceries", ""]) (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 (showTransaction
(txnTieKnot $ (txnTieKnot $
Transaction Transaction
@ -857,8 +857,8 @@ tests_Transaction =
])) @?= ])) @?=
(T.unlines ["2010-01-01 x", " a 1 @ $2", " b", ""]) (T.unlines ["2010-01-01 x", " a 1 @ $2", " b", ""])
] ]
, tests "balanceTransaction" [ , testGroup "balanceTransaction" [
test "detect unbalanced entry, sign error" $ testCase "detect unbalanced entry, sign error" $
assertLeft assertLeft
(balanceTransaction defbalancingopts (balanceTransaction defbalancingopts
(Transaction (Transaction
@ -873,7 +873,7 @@ tests_Transaction =
"" ""
[] []
[posting {paccount = "a", pamount = mixedAmount (usd 1)}, posting {paccount = "b", pamount = mixedAmount (usd 1)}])) [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 $ assertLeft $
balanceTransaction defbalancingopts balanceTransaction defbalancingopts
(Transaction (Transaction
@ -890,7 +890,7 @@ tests_Transaction =
[ posting {paccount = "a", pamount = missingmixedamt} [ posting {paccount = "a", pamount = missingmixedamt}
, posting {paccount = "b", pamount = missingmixedamt} , posting {paccount = "b", pamount = missingmixedamt}
]) ])
,test "one missing amount is inferred" $ ,testCase "one missing amount is inferred" $
(pamount . last . tpostings <$> (pamount . last . tpostings <$>
balanceTransaction defbalancingopts balanceTransaction defbalancingopts
(Transaction (Transaction
@ -906,7 +906,7 @@ tests_Transaction =
[] []
[posting {paccount = "a", pamount = mixedAmount (usd 1)}, posting {paccount = "b", pamount = missingmixedamt}])) @?= [posting {paccount = "a", pamount = mixedAmount (usd 1)}, posting {paccount = "b", pamount = missingmixedamt}])) @?=
Right (mixedAmount $ usd (-1)) Right (mixedAmount $ usd (-1))
,test "conversion price is inferred" $ ,testCase "conversion price is inferred" $
(pamount . head . tpostings <$> (pamount . head . tpostings <$>
balanceTransaction defbalancingopts balanceTransaction defbalancingopts
(Transaction (Transaction
@ -924,7 +924,7 @@ tests_Transaction =
, posting {paccount = "b", pamount = mixedAmount (eur (-1))} , posting {paccount = "b", pamount = mixedAmount (eur (-1))}
])) @?= ])) @?=
Right (mixedAmount $ usd 1.35 @@ 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 $ assertRight $
balanceTransaction defbalancingopts balanceTransaction defbalancingopts
(Transaction (Transaction
@ -941,7 +941,7 @@ tests_Transaction =
[ posting {paccount = "a", pamount = mixedAmount $ usd 1 `at` eur 2} [ posting {paccount = "a", pamount = mixedAmount $ usd 1 `at` eur 2}
, posting {paccount = "a", pamount = mixedAmount $ usd (-2) `at` eur 1} , 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 $ assertRight $
balanceTransaction defbalancingopts balanceTransaction defbalancingopts
(Transaction (Transaction
@ -959,8 +959,8 @@ tests_Transaction =
, posting {paccount = "a", pamount = mixedAmount $ usd (-2) @@ eur (-1)} , posting {paccount = "a", pamount = mixedAmount $ usd (-2) @@ eur (-1)}
]) ])
] ]
, tests "isTransactionBalanced" [ , testGroup "isTransactionBalanced" [
test "detect balanced" $ testCase "detect balanced" $
assertBool "" $ assertBool "" $
isTransactionBalanced defbalancingopts $ isTransactionBalanced defbalancingopts $
Transaction Transaction
@ -977,7 +977,7 @@ tests_Transaction =
[ posting {paccount = "b", pamount = mixedAmount (usd 1.00)} [ posting {paccount = "b", pamount = mixedAmount (usd 1.00)}
, posting {paccount = "c", pamount = mixedAmount (usd (-1.00))} , posting {paccount = "c", pamount = mixedAmount (usd (-1.00))}
] ]
,test "detect unbalanced" $ ,testCase "detect unbalanced" $
assertBool "" $ assertBool "" $
not $ not $
isTransactionBalanced defbalancingopts $ isTransactionBalanced defbalancingopts $
@ -995,7 +995,7 @@ tests_Transaction =
[ posting {paccount = "b", pamount = mixedAmount (usd 1.00)} [ posting {paccount = "b", pamount = mixedAmount (usd 1.00)}
, posting {paccount = "c", pamount = mixedAmount (usd (-1.01))} , posting {paccount = "c", pamount = mixedAmount (usd (-1.01))}
] ]
,test "detect unbalanced, one posting" $ ,testCase "detect unbalanced, one posting" $
assertBool "" $ assertBool "" $
not $ not $
isTransactionBalanced defbalancingopts $ isTransactionBalanced defbalancingopts $
@ -1011,7 +1011,7 @@ tests_Transaction =
"" ""
[] []
[posting {paccount = "b", pamount = mixedAmount (usd 1.00)}] [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 "" $ assertBool "" $
isTransactionBalanced defbalancingopts $ isTransactionBalanced defbalancingopts $
Transaction Transaction
@ -1026,7 +1026,7 @@ tests_Transaction =
"" ""
[] []
[posting {paccount = "b", pamount = mixedAmount (usd 0)}] [posting {paccount = "b", pamount = mixedAmount (usd 0)}]
,test "virtual postings don't need to balance" $ ,testCase "virtual postings don't need to balance" $
assertBool "" $ assertBool "" $
isTransactionBalanced defbalancingopts $ isTransactionBalanced defbalancingopts $
Transaction Transaction
@ -1044,7 +1044,7 @@ tests_Transaction =
, posting {paccount = "c", pamount = mixedAmount (usd (-1.00))} , posting {paccount = "c", pamount = mixedAmount (usd (-1.00))}
, posting {paccount = "d", pamount = mixedAmount (usd 100), ptype = VirtualPosting} , 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 "" $ assertBool "" $
not $ not $
isTransactionBalanced defbalancingopts $ isTransactionBalanced defbalancingopts $
@ -1063,7 +1063,7 @@ tests_Transaction =
, posting {paccount = "c", pamount = mixedAmount (usd (-1.00))} , posting {paccount = "c", pamount = mixedAmount (usd (-1.00))}
, posting {paccount = "d", pamount = mixedAmount (usd 100), ptype = BalancedVirtualPosting} , 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 "" $ assertBool "" $
isTransactionBalanced defbalancingopts $ isTransactionBalanced defbalancingopts $
Transaction Transaction

6
hledger-lib/Hledger/Data/Valuation.hs
View File

@ -260,7 +260,7 @@ tests_priceLookup =
,p 2001 01 01 "A" 11 "B" ,p 2001 01 01 "A" 11 "B"
] ]
makepricegraph = makePriceGraph ps1 [] makepricegraph = makePriceGraph ps1 []
in test "priceLookup" $ do in testCase "priceLookup" $ do
priceLookup makepricegraph (fromGregorian 1999 01 01) "A" Nothing @?= Nothing 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) "A" Nothing @?= Just ("B",10)
priceLookup makepricegraph (fromGregorian 2000 01 01) "B" (Just "A") @?= Just ("A",0.1) 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 tests_priceLookup
,test "marketPriceReverse" $ do ,testCase "marketPriceReverse" $ do
marketPriceReverse nullmarketprice{mprate=2} @?= nullmarketprice{mprate=0.5} marketPriceReverse nullmarketprice{mprate=2} @?= nullmarketprice{mprate=0.5}
marketPriceReverse nullmarketprice @?= nullmarketprice -- the reverse of a 0 price is a 0 price marketPriceReverse nullmarketprice @?= nullmarketprice -- the reverse of a 0 price is a 0 price

48
hledger-lib/Hledger/Query.hs
View File

@ -688,8 +688,8 @@ matchesPriceDirective _ _ = True
-- tests -- tests
tests_Query = tests "Query" [ tests_Query = testGroup "Query" [
test "simplifyQuery" $ do testCase "simplifyQuery" $ do
(simplifyQuery $ Or [Acct $ toRegex' "a"]) @?= (Acct $ toRegex' "a") (simplifyQuery $ Or [Acct $ toRegex' "a"]) @?= (Acct $ toRegex' "a")
(simplifyQuery $ Or [Any,None]) @?= (Any) (simplifyQuery $ Or [Any,None]) @?= (Any)
(simplifyQuery $ And [Any,None]) @?= (None) (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))) @?= (Date (DateSpan (Just $ fromGregorian 2012 01 01) (Just $ fromGregorian 2013 01 01)))
(simplifyQuery $ And [Or [],Or [Desc $ toRegex' "b b"]]) @?= (Desc $ toRegex' "b b") (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 "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 desc:\"b b\"" @?= Right (Desc $ toRegexCI' "b b", [QueryOptInAcct "a"])
parseQuery nulldate "inacct:a inacct:b" @?= Right (Any, [QueryOptInAcct "a", QueryOptInAcct "b"]) 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 "'a a' 'b" @?= Right (Or [Acct $ toRegexCI' "a a",Acct $ toRegexCI' "'b"], [])
parseQuery nulldate "\"" @?= Right (Acct $ toRegexCI' "\"", []) parseQuery nulldate "\"" @?= Right (Acct $ toRegexCI' "\"", [])
,test "words''" $ do ,testCase "words''" $ do
(words'' [] "a b") @?= ["a","b"] (words'' [] "a b") @?= ["a","b"]
(words'' [] "'a b'") @?= ["a b"] (words'' [] "'a b'") @?= ["a b"]
(words'' [] "not:a b") @?= ["not:a","b"] (words'' [] "not:a b") @?= ["not:a","b"]
@ -718,13 +718,13 @@ tests_Query = tests "Query" [
(words'' prefixes "\"acct:expenses:autres d\233penses\"") @?= ["acct:expenses:autres d\233penses"] (words'' prefixes "\"acct:expenses:autres d\233penses\"") @?= ["acct:expenses:autres d\233penses"]
(words'' prefixes "\"") @?= ["\""] (words'' prefixes "\"") @?= ["\""]
,test "filterQuery" $ do ,testCase "filterQuery" $ do
filterQuery queryIsDepth Any @?= Any filterQuery queryIsDepth Any @?= Any
filterQuery queryIsDepth (Depth 1) @?= Depth 1 filterQuery queryIsDepth (Depth 1) @?= Depth 1
filterQuery (not.queryIsDepth) (And [And [StatusQ Cleared,Depth 1]]) @?= StatusQ Cleared filterQuery (not.queryIsDepth) (And [And [StatusQ Cleared,Depth 1]]) @?= StatusQ Cleared
filterQuery queryIsDepth (And [Date nulldatespan, Not (Or [Any, Depth 1])]) @?= Any -- XXX unclear filterQuery queryIsDepth (And [Date nulldatespan, Not (Or [Any, Depth 1])]) @?= Any -- XXX unclear
,test "parseQueryTerm" $ do ,testCase "parseQueryTerm" $ do
parseQueryTerm nulldate "a" @?= Right (Left $ Acct $ toRegexCI' "a") 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 "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") 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:<0" @?= Right (Left $ Amt Lt 0)
parseQueryTerm nulldate "amt:>10000.10" @?= Right (Left $ Amt AbsGt 10000.1) 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 (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) -- special case for convenience and consistency with above
parseAmountQueryTerm " > - 0 " @?= Right (Gt,0) -- accept whitespace around the argument parts 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 "-0,23"
assertLeft $ parseAmountQueryTerm "=.23" assertLeft $ parseAmountQueryTerm "=.23"
,test "queryStartDate" $ do ,testCase "queryStartDate" $ do
let small = Just $ fromGregorian 2000 01 01 let small = Just $ fromGregorian 2000 01 01
big = Just $ fromGregorian 2000 01 02 big = Just $ fromGregorian 2000 01 02
queryStartDate False (And [Date $ DateSpan small Nothing, Date $ DateSpan big Nothing]) @?= big 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 big Nothing]) @?= small
queryStartDate False (Or [Date $ DateSpan small Nothing, Date $ DateSpan Nothing Nothing]) @?= Nothing 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 let small = Just $ fromGregorian 2000 01 01
big = Just $ fromGregorian 2000 01 02 big = Just $ fromGregorian 2000 01 02
queryEndDate False (And [Date $ DateSpan Nothing small, Date $ DateSpan Nothing big]) @?= small 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 big]) @?= big
queryEndDate False (Or [Date $ DateSpan Nothing small, Date $ DateSpan Nothing Nothing]) @?= Nothing 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 "" $ (Acct $ toRegex' "b:c") `matchesAccount` "a:bb:c:d"
assertBool "" $ not $ (Acct $ toRegex' "^a:b") `matchesAccount` "c:a:b" assertBool "" $ not $ (Acct $ toRegex' "^a:b") `matchesAccount` "c:a:b"
assertBool "" $ Depth 2 `matchesAccount` "a" assertBool "" $ Depth 2 `matchesAccount` "a"
@ -783,22 +783,22 @@ tests_Query = tests "Query" [
assertBool "" $ Date2 nulldatespan `matchesAccount` "a" assertBool "" $ Date2 nulldatespan `matchesAccount` "a"
assertBool "" $ not $ Tag (toRegex' "a") Nothing `matchesAccount` "a" assertBool "" $ not $ Tag (toRegex' "a") Nothing `matchesAccount` "a"
,tests "matchesPosting" [ ,testGroup "matchesPosting" [
test "positive match on cleared posting status" $ testCase "positive match on cleared posting status" $
assertBool "" $ (StatusQ Cleared) `matchesPosting` nullposting{pstatus=Cleared} 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} 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} 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} 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}} 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} ,testCase "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} ,testCase "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} ,testCase "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"} ,testCase "acct:" $ assertBool "" $ (Acct $ toRegex' "'b") `matchesPosting` nullposting{paccount="'b"}
,test "tag:" $ do ,testCase "tag:" $ do
assertBool "" $ not $ (Tag (toRegex' "a") (Just $ toRegex' "r$")) `matchesPosting` nullposting 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","")]}
assertBool "" $ (Tag (toRegex' "foo") Nothing) `matchesPosting` nullposting{ptags=[("foo","baz")]} 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 ") (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")]} 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","")]}} ,testCase "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 "cur:" $ do
let toSym = fromLeft (error' "No query opts") . either error' id . parseQueryTerm (fromGregorian 2000 01 01) . ("cur:"<>) 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 "" $ 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 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"}} assertBool "" $ not $ (toSym "shek") `matchesPosting` nullposting{pamount=mixedAmount nullamt{acommodity="shekels"}}
] ]
,test "matchesTransaction" $ do ,testCase "matchesTransaction" $ do
assertBool "" $ Any `matchesTransaction` nulltransaction assertBool "" $ Any `matchesTransaction` nulltransaction
assertBool "" $ not $ (Desc $ toRegex' "x x") `matchesTransaction` nulltransaction{tdescription="x"} assertBool "" $ not $ (Desc $ toRegex' "x x") `matchesTransaction` nulltransaction{tdescription="x"}
assertBool "" $ (Desc $ toRegex' "x x") `matchesTransaction` nulltransaction{tdescription="x x"} assertBool "" $ (Desc $ toRegex' "x x") `matchesTransaction` nulltransaction{tdescription="x x"}

2
hledger-lib/Hledger/Read.hs
View File

@ -283,7 +283,7 @@ journalFilterSinceLatestDates ds@(d:_) j = (j', ds')
--- ** tests --- ** tests
tests_Read = tests "Read" [ tests_Read = testGroup "Read" [
tests_Common tests_Common
,tests_CsvReader ,tests_CsvReader
,tests_JournalReader ,tests_JournalReader

28
hledger-lib/Hledger/Read/Common.hs
View File

@ -1574,12 +1574,12 @@ regexaliasp = do
--- ** tests --- ** tests
tests_Common = tests "Common" [ tests_Common = testGroup "Common" [
tests "amountp" [ testGroup "amountp" [
test "basic" $ assertParseEq amountp "$47.18" (usd 47.18) testCase "basic" $ assertParseEq amountp "$47.18" (usd 47.18)
,test "ends with decimal mark" $ assertParseEq amountp "$1." (usd 1 `withPrecision` Precision 0) ,testCase "ends with decimal mark" $ assertParseEq amountp "$1." (usd 1 `withPrecision` Precision 0)
,test "unit price" $ assertParseEq amountp "$10 @ €0.5" ,testCase "unit price" $ assertParseEq amountp "$10 @ €0.5"
-- not precise enough: -- not precise enough:
-- (usd 10 `withPrecision` 0 `at` (eur 0.5 `withPrecision` 1)) -- `withStyle` asdecimalpoint=Just '.' -- (usd 10 `withPrecision` 0 `at` (eur 0.5 `withPrecision` 1)) -- `withStyle` asdecimalpoint=Just '.'
amount{ amount{
@ -1593,7 +1593,7 @@ tests_Common = tests "Common" [
,astyle=amountstyle{asprecision=Precision 1, asdecimalpoint=Just '.'} ,astyle=amountstyle{asprecision=Precision 1, asdecimalpoint=Just '.'}
} }
} }
,test "total price" $ assertParseEq amountp "$10 @@ €5" ,testCase "total price" $ assertParseEq amountp "$10 @@ €5"
amount{ amount{
acommodity="$" acommodity="$"
,aquantity=10 ,aquantity=10
@ -1605,12 +1605,12 @@ tests_Common = tests "Common" [
,astyle=amountstyle{asprecision=Precision 0, asdecimalpoint=Nothing} ,astyle=amountstyle{asprecision=Precision 0, asdecimalpoint=Nothing}
} }
} }
,test "unit price, parenthesised" $ assertParse amountp "$10 (@) €0.5" ,testCase "unit price, parenthesised" $ assertParse amountp "$10 (@) €0.5"
,test "total 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 ,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 "0" (0, 0, Nothing, Nothing)
assertParseEq p "1" (1, 0, Nothing, Nothing) assertParseEq p "1" (1, 0, Nothing, Nothing)
assertParseEq p "1.1" (1.1, 1, Just '.', Nothing) assertParseEq p "1.1" (1.1, 1, Just '.', Nothing)
@ -1632,11 +1632,11 @@ tests_Common = tests "Common" [
assertParseEq p "1.555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555" (1.555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555, 255, Just '.', Nothing) assertParseEq p "1.555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555" (1.555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555, 255, Just '.', Nothing)
assertParseError p "1.5555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555" "" assertParseError p "1.5555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555555" ""
,tests "spaceandamountormissingp" [ ,testGroup "spaceandamountormissingp" [
test "space and amount" $ assertParseEq spaceandamountormissingp " $47.18" (mixedAmount $ usd 47.18) testCase "space and amount" $ assertParseEq spaceandamountormissingp " $47.18" (mixedAmount $ usd 47.18)
,test "empty string" $ assertParseEq spaceandamountormissingp "" missingmixedamt ,testCase "empty string" $ assertParseEq spaceandamountormissingp "" missingmixedamt
-- ,test "just space" $ assertParseEq spaceandamountormissingp " " missingmixedamt -- XXX should it ? -- ,testCase "just space" $ assertParseEq spaceandamountormissingp " " missingmixedamt -- XXX should it ?
-- ,test "just amount" $ assertParseError spaceandamountormissingp "$47.18" "" -- succeeds, consuming nothing -- ,testCase "just amount" $ assertParseError spaceandamountormissingp "$47.18" "" -- succeeds, consuming nothing
] ]
] ]

56
hledger-lib/Hledger/Read/CsvReader.hs
View File

@ -1288,77 +1288,77 @@ parseDateWithCustomOrDefaultFormats mformat s = asum $ map parsewith formats
--- ** tests --- ** tests
tests_CsvReader = tests "CsvReader" [ tests_CsvReader = testGroup "CsvReader" [
tests "parseCsvRules" [ testGroup "parseCsvRules" [
test "empty file" $ testCase "empty file" $
parseCsvRules "unknown" "" @?= Right (mkrules defrules) parseCsvRules "unknown" "" @?= Right (mkrules defrules)
] ]
,tests "rulesp" [ ,testGroup "rulesp" [
test "trailing comments" $ testCase "trailing comments" $
parseWithState' defrules rulesp "skip\n# \n#\n" @?= Right (mkrules $ defrules{rdirectives = [("skip","")]}) 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","")]})) 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","")]})) 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" @?= 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")]}]})) (Right (mkrules $ defrules{rassignments = [("account1","")], rconditionalblocks = [CB{cbMatchers=[RecordMatcher None (toRegex' "foo")],cbAssignments=[("account2","foo")]}]}))
] ]
,tests "conditionalblockp" [ ,testGroup "conditionalblockp" [
test "space after conditional" $ -- #1120 testCase "space after conditional" $ -- #1120
parseWithState' defrules conditionalblockp "if a\n account2 b\n \n" @?= parseWithState' defrules conditionalblockp "if a\n account2 b\n \n" @?=
(Right $ CB{cbMatchers=[RecordMatcher None $ toRegexCI' "a"],cbAssignments=[("account2","b")]}) (Right $ CB{cbMatchers=[RecordMatcher None $ toRegexCI' "a"],cbAssignments=[("account2","b")]})
,tests "csvfieldreferencep" [ ,testGroup "csvfieldreferencep" [
test "number" $ parseWithState' defrules csvfieldreferencep "%1" @?= (Right "%1") testCase "number" $ parseWithState' defrules csvfieldreferencep "%1" @?= (Right "%1")
,test "name" $ parseWithState' defrules csvfieldreferencep "%date" @?= (Right "%date") ,testCase "name" $ parseWithState' defrules csvfieldreferencep "%date" @?= (Right "%date")
,test "quoted name" $ parseWithState' defrules csvfieldreferencep "%\"csv date\"" @?= (Right "%\"csv 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") 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") 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") 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") 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") 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") -- 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")]} 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")]]} ,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")]]} ,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")]]} ,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")]]} ,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")]]} ,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")
] ]

144
hledger-lib/Hledger/Read/JournalReader.hs
View File

@ -738,32 +738,32 @@ postingphelper isPostingRule mTransactionYear = do
--- ** tests --- ** tests
tests_JournalReader = tests "JournalReader" [ tests_JournalReader = testGroup "JournalReader" [
let p = lift accountnamep :: JournalParser IO AccountName in let p = lift accountnamep :: JournalParser IO AccountName in
tests "accountnamep" [ testGroup "accountnamep" [
test "basic" $ assertParse p "a:b:c" testCase "basic" $ assertParse p "a:b:c"
-- ,test "empty inner component" $ assertParseError p "a::c" "" -- TODO -- ,testCase "empty inner component" $ assertParseError p "a::c" "" -- TODO
-- ,test "empty leading component" $ assertParseError p ":b:c" "x" -- ,testCase "empty leading component" $ assertParseError p ":b:c" "x"
-- ,test "empty trailing component" $ assertParseError p "a:b:" "x" -- ,testCase "empty trailing component" $ assertParseError p "a:b:" "x"
] ]
-- "Parse a date in YYYY/MM/DD format. -- "Parse a date in YYYY/MM/DD format.
-- Hyphen (-) and period (.) are also allowed as separators. -- Hyphen (-) and period (.) are also allowed as separators.
-- The year may be omitted if a default year has been set. -- The year may be omitted if a default year has been set.
-- Leading zeroes may be omitted." -- Leading zeroes may be omitted."
,tests "datep" [ ,testGroup "datep" [
test "YYYY/MM/DD" $ assertParseEq datep "2018/01/01" (fromGregorian 2018 1 1) testCase "YYYY/MM/DD" $ assertParseEq datep "2018/01/01" (fromGregorian 2018 1 1)
,test "YYYY-MM-DD" $ assertParse datep "2018-01-01" ,testCase "YYYY-MM-DD" $ assertParse datep "2018-01-01"
,test "YYYY.MM.DD" $ assertParse datep "2018.01.01" ,testCase "YYYY.MM.DD" $ assertParse datep "2018.01.01"
,test "yearless date with no default year" $ assertParseError datep "1/1" "current year is unknown" ,testCase "yearless date with no default year" $ assertParseError datep "1/1" "current year is unknown"
,test "yearless date with default year" $ do ,testCase "yearless date with default year" $ do
let s = "1/1" let s = "1/1"
ep <- parseWithState nulljournal{jparsedefaultyear=Just 2018} datep s ep <- parseWithState nulljournal{jparsedefaultyear=Just 2018} datep s
either (assertFailure . ("parse error at "++) . customErrorBundlePretty) (const $ return ()) ep 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 let
good = assertParse datetimep good = assertParse datetimep
bad = (\t -> assertParseError datetimep t "") 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-0800" t
assertParseEq datetimep "2018/1/1 00:00+1234" 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" "~ monthly from 2018/6 ;In 2019 we will change this\n"
nullperiodictransaction { nullperiodictransaction {
ptperiodexpr = "monthly from 2018/6" ptperiodexpr = "monthly from 2018/6"
@ -791,7 +791,7 @@ tests_JournalReader = tests "JournalReader" [
,ptcomment = "In 2019 we will change this\n" ,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" "~ monthly from 2018/6 In 2019 we will change this\n"
nullperiodictransaction { nullperiodictransaction {
ptperiodexpr = "monthly from 2018/6" ptperiodexpr = "monthly from 2018/6"
@ -801,7 +801,7 @@ tests_JournalReader = tests "JournalReader" [
,ptcomment = "" ,ptcomment = ""
} }
,test "Next year in description" $ assertParseEq periodictransactionp ,testCase "Next year in description" $ assertParseEq periodictransactionp
"~ monthly Next year blah blah\n" "~ monthly Next year blah blah\n"
nullperiodictransaction { nullperiodictransaction {
ptperiodexpr = "monthly" ptperiodexpr = "monthly"
@ -811,7 +811,7 @@ tests_JournalReader = tests "JournalReader" [
,ptcomment = "" ,ptcomment = ""
} }
,test "Just date, no description" $ assertParseEq periodictransactionp ,testCase "Just date, no description" $ assertParseEq periodictransactionp
"~ 2019-01-04\n" "~ 2019-01-04\n"
nullperiodictransaction { nullperiodictransaction {
ptperiodexpr = "2019-01-04" ptperiodexpr = "2019-01-04"
@ -821,13 +821,13 @@ tests_JournalReader = tests "JournalReader" [
,ptcomment = "" ,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" "~ 2019-01-04\n ;\n a 1\n b\n"
] ]
,tests "postingp" [ ,testGroup "postingp" [
test "basic" $ assertParseEq (postingp Nothing) testCase "basic" $ assertParseEq (postingp Nothing)
" expenses:food:dining $10.00 ; a: a a \n ; b: b b \n" " expenses:food:dining $10.00 ; a: a a \n ; b: b b \n"
posting{ posting{
paccount="expenses:food:dining", paccount="expenses:food:dining",
@ -836,7 +836,7 @@ tests_JournalReader = tests "JournalReader" [
ptags=[("a","a a"), ("b","b b")] 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" " a 1. ; date:2012/11/28, date2=2012/11/29,b:b\n"
nullposting{ nullposting{
paccount="a" paccount="a"
@ -847,7 +847,7 @@ tests_JournalReader = tests "JournalReader" [
,pdate2=Nothing -- Just $ fromGregorian 2012 11 29 ,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" " a 1. ; [2012/11/28=2012/11/29]\n"
nullposting{ nullposting{
paccount="a" paccount="a"
@ -858,25 +858,25 @@ tests_JournalReader = tests "JournalReader" [
,pdate2=Just $ fromGregorian 2012 11 29 ,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" ,testCase "only lot price" $ assertParse (postingp Nothing) " a 1A {1B}\n"
,test "fixed lot price" $ assertParse (postingp Nothing) " a 1A {=1B}\n" ,testCase "fixed lot price" $ assertParse (postingp Nothing) " a 1A {=1B}\n"
,test "total lot price" $ assertParse (postingp Nothing) " a 1A {{1B}}\n" ,testCase "total lot price" $ assertParse (postingp Nothing) " a 1A {{1B}}\n"
,test "fixed total lot price, and spaces" $ assertParse (postingp Nothing) " a 1A {{ = 1B }}\n" ,testCase "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" ,testCase "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" ,testCase "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 '{'" ,testCase "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" ,testCase "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" ,testCase "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 "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" "= (some value expr)\n some:postings 1.\n"
nulltransactionmodifier { nulltransactionmodifier {
tmquerytxt = "(some value expr)" 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 [ (T.unlines [
"2012/05/14=2012/05/15 (code) desc ; tcomment1", "2012/05/14=2012/05/15 (code) desc ; tcomment1",
" ; tcomment2", " ; 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 assertBool "" $ isRight $ rjp transactionp $ T.unlines
["2007/01/28 coopportunity" ["2007/01/28 coopportunity"
," expenses:food:groceries $47.18" ," 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" 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 assertBool "" $ isRight $ rjp transactionp $ T.unlines
["2012/1/1" ["2012/1/1"
," a 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 assertBool "" $ isRight $ rjp transactionp $ T.unlines
["2012/1/1" ["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 assertParseEqOn transactionp
(T.unlines (T.unlines
["2009/1/1 x ; transaction comment" ["2009/1/1 x ; transaction comment"
@ -966,17 +966,17 @@ tests_JournalReader = tests "JournalReader" [
-- directives -- directives
,tests "directivep" [ ,testGroup "directivep" [
test "supports !" $ do testCase "supports !" $ do
assertParseE directivep "!account a\n" assertParseE directivep "!account a\n"
assertParseE directivep "!D 1.0\n" assertParseE directivep "!D 1.0\n"
] ]
,tests "accountdirectivep" [ ,testGroup "accountdirectivep" [
test "with-comment" $ assertParse accountdirectivep "account a:b ; a comment\n" testCase "with-comment" $ assertParse accountdirectivep "account a:b ; a comment\n"
,test "does-not-support-!" $ assertParseError accountdirectivep "!account a:b\n" "" ,testCase "does-not-support-!" $ assertParseError accountdirectivep "!account a:b\n" ""
,test "account-type-code" $ assertParse accountdirectivep "account a:b A\n" ,testCase "account-type-code" $ assertParse accountdirectivep "account a:b A\n"
,test "account-type-tag" $ assertParseStateOn accountdirectivep "account a:b ; type:asset\n" ,testCase "account-type-tag" $ assertParseStateOn accountdirectivep "account a:b ; type:asset\n"
jdeclaredaccounts jdeclaredaccounts
[("a:b", AccountDeclarationInfo{adicomment = "type:asset\n" [("a:b", AccountDeclarationInfo{adicomment = "type:asset\n"
,aditags = [("type","asset")] ,aditags = [("type","asset")]
@ -985,28 +985,28 @@ tests_JournalReader = tests "JournalReader" [
] ]
] ]
,test "commodityconversiondirectivep" $ do ,testCase "commodityconversiondirectivep" $ do
assertParse commodityconversiondirectivep "C 1h = $50.00\n" assertParse commodityconversiondirectivep "C 1h = $50.00\n"
,test "defaultcommoditydirectivep" $ do ,testCase "defaultcommoditydirectivep" $ do
assertParse defaultcommoditydirectivep "D $1,000.0\n" assertParse defaultcommoditydirectivep "D $1,000.0\n"
assertParseError defaultcommoditydirectivep "D $1000\n" "Please include a decimal point or decimal comma" assertParseError defaultcommoditydirectivep "D $1000\n" "Please include a decimal point or decimal comma"
,tests "defaultyeardirectivep" [ ,testGroup "defaultyeardirectivep" [
test "1000" $ assertParse defaultyeardirectivep "Y 1000" -- XXX no \n like the others testCase "1000" $ assertParse defaultyeardirectivep "Y 1000" -- XXX no \n like the others
-- ,test "999" $ assertParseError defaultyeardirectivep "Y 999" "bad year number" -- ,testCase "999" $ assertParseError defaultyeardirectivep "Y 999" "bad year number"
,test "12345" $ assertParse defaultyeardirectivep "Y 12345" ,testCase "12345" $ assertParse defaultyeardirectivep "Y 12345"
] ]
,test "ignoredpricecommoditydirectivep" $ do ,testCase "ignoredpricecommoditydirectivep" $ do
assertParse ignoredpricecommoditydirectivep "N $\n" assertParse ignoredpricecommoditydirectivep "N $\n"
,tests "includedirectivep" [ ,testGroup "includedirectivep" [
test "include" $ assertParseErrorE includedirectivep "include nosuchfile\n" "No existing files match pattern: nosuchfile" testCase "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*" ,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" "P 2017/01/30 BTC $922.83\n"
PriceDirective{ PriceDirective{
pddate = fromGregorian 2017 1 30, pddate = fromGregorian 2017 1 30,
@ -1014,24 +1014,24 @@ tests_JournalReader = tests "JournalReader" [
pdamount = usd 922.83 pdamount = usd 922.83
} }
,tests "payeedirectivep" [ ,testGroup "payeedirectivep" [
test "simple" $ assertParse payeedirectivep "payee foo\n" testCase "simple" $ assertParse payeedirectivep "payee foo\n"
,test "with-comment" $ assertParse payeedirectivep "payee foo ; comment\n" ,testCase "with-comment" $ assertParse payeedirectivep "payee foo ; comment\n"
] ]
,test "tagdirectivep" $ do ,testCase "tagdirectivep" $ do
assertParse tagdirectivep "tag foo \n" assertParse tagdirectivep "tag foo \n"
,test "endtagdirectivep" $ do ,testCase "endtagdirectivep" $ do
assertParse endtagdirectivep "end tag \n" assertParse endtagdirectivep "end tag \n"
assertParse endtagdirectivep "pop \n" assertParse endtagdirectivep "pop \n"
,tests "journalp" [ ,testGroup "journalp" [
test "empty file" $ assertParseEqE journalp "" nulljournal testCase "empty file" $ assertParseEqE journalp "" nulljournal
] ]
-- these are defined here rather than in Common so they can use journalp -- these are defined here rather than in Common so they can use journalp
,test "parseAndFinaliseJournal" $ do ,testCase "parseAndFinaliseJournal" $ do
ej <- runExceptT $ parseAndFinaliseJournal journalp definputopts "" "2019-1-1\n" ej <- runExceptT $ parseAndFinaliseJournal journalp definputopts "" "2019-1-1\n"
let Right j = ej let Right j = ej
assertEqual "" [""] $ journalFilePaths j assertEqual "" [""] $ journalFilePaths j

4
hledger-lib/Hledger/Reports.hs
View File

@ -24,6 +24,7 @@ module Hledger.Reports (
) )
where where
import Test.Tasty (testGroup)
import Hledger.Reports.ReportOptions import Hledger.Reports.ReportOptions
import Hledger.Reports.ReportTypes import Hledger.Reports.ReportTypes
import Hledger.Reports.AccountTransactionsReport import Hledger.Reports.AccountTransactionsReport
@ -32,9 +33,8 @@ import Hledger.Reports.PostingsReport
import Hledger.Reports.BalanceReport import Hledger.Reports.BalanceReport
import Hledger.Reports.MultiBalanceReport import Hledger.Reports.MultiBalanceReport
import Hledger.Reports.BudgetReport import Hledger.Reports.BudgetReport
import Hledger.Utils.Test
tests_Reports = tests "Reports" [ tests_Reports = testGroup "Reports" [
tests_BalanceReport tests_BalanceReport
,tests_BudgetReport ,tests_BudgetReport
,tests_AccountTransactionsReport ,tests_AccountTransactionsReport

2
hledger-lib/Hledger/Reports/AccountTransactionsReport.hs
View File

@ -255,5 +255,5 @@ filterAccountTransactionsReportByCommodity c =
-- tests -- tests
tests_AccountTransactionsReport = tests "AccountTransactionsReport" [ tests_AccountTransactionsReport = testGroup "AccountTransactionsReport" [
] ]

48
hledger-lib/Hledger/Reports/BalanceReport.hs
View File

@ -100,7 +100,7 @@ Right samplejournal2 =
] ]
} }
tests_BalanceReport = tests "BalanceReport" [ tests_BalanceReport = testGroup "BalanceReport" [
let let
(rspec,journal) `gives` r = do (rspec,journal) `gives` r = do
@ -111,12 +111,12 @@ tests_BalanceReport = tests "BalanceReport" [
(map showw aitems) @?= (map showw eitems) (map showw aitems) @?= (map showw eitems)
(showMixedAmountDebug atotal) @?= (showMixedAmountDebug etotal) (showMixedAmountDebug atotal) @?= (showMixedAmountDebug etotal)
in in
tests "balanceReport" [ testGroup "balanceReport" [
test "no args, null journal" $ testCase "no args, null journal" $
(defreportspec, nulljournal) `gives` ([], nullmixedamt) (defreportspec, nulljournal) `gives` ([], nullmixedamt)
,test "no args, sample journal" $ ,testCase "no args, sample journal" $
(defreportspec, samplejournal) `gives` (defreportspec, samplejournal) `gives`
([ ([
("assets:bank:checking","assets:bank:checking",0, mamountp' "$1.00") ("assets:bank:checking","assets:bank:checking",0, mamountp' "$1.00")
@ -129,7 +129,7 @@ tests_BalanceReport = tests "BalanceReport" [
], ],
mixedAmount (usd 0)) mixedAmount (usd 0))
,test "with --tree" $ ,testCase "with --tree" $
(defreportspec{_rsReportOpts=defreportopts{accountlistmode_=ALTree}}, samplejournal) `gives` (defreportspec{_rsReportOpts=defreportopts{accountlistmode_=ALTree}}, samplejournal) `gives`
([ ([
("assets","assets",0, mamountp' "$0.00") ("assets","assets",0, mamountp' "$0.00")
@ -146,7 +146,7 @@ tests_BalanceReport = tests "BalanceReport" [
], ],
mixedAmount (usd 0)) mixedAmount (usd 0))
,test "with --depth=N" $ ,testCase "with --depth=N" $
(defreportspec{_rsReportOpts=defreportopts{depth_=Just 1}}, samplejournal) `gives` (defreportspec{_rsReportOpts=defreportopts{depth_=Just 1}}, samplejournal) `gives`
([ ([
("expenses", "expenses", 0, mamountp' "$2.00") ("expenses", "expenses", 0, mamountp' "$2.00")
@ -154,7 +154,7 @@ tests_BalanceReport = tests "BalanceReport" [
], ],
mixedAmount (usd 0)) mixedAmount (usd 0))
,test "with depth:N" $ ,testCase "with depth:N" $
(defreportspec{_rsQuery=Depth 1}, samplejournal) `gives` (defreportspec{_rsQuery=Depth 1}, samplejournal) `gives`
([ ([
("expenses", "expenses", 0, mamountp' "$2.00") ("expenses", "expenses", 0, mamountp' "$2.00")
@ -162,11 +162,11 @@ tests_BalanceReport = tests "BalanceReport" [
], ],
mixedAmount (usd 0)) 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` (defreportspec{_rsQuery=Date $ DateSpan (Just $ fromGregorian 2009 01 01) (Just $ fromGregorian 2010 01 01)}, samplejournal2) `gives`
([], nullmixedamt) ([], nullmixedamt)
,test "with date2:" $ ,testCase "with date2:" $
(defreportspec{_rsQuery=Date2 $ DateSpan (Just $ fromGregorian 2009 01 01) (Just $ fromGregorian 2010 01 01)}, samplejournal2) `gives` (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") ("assets:bank:checking","assets:bank:checking",0,mamountp' "$1.00")
@ -174,7 +174,7 @@ tests_BalanceReport = tests "BalanceReport" [
], ],
mixedAmount (usd 0)) mixedAmount (usd 0))
,test "with desc:" $ ,testCase "with desc:" $
(defreportspec{_rsQuery=Desc $ toRegexCI' "income"}, samplejournal) `gives` (defreportspec{_rsQuery=Desc $ toRegexCI' "income"}, samplejournal) `gives`
([ ([
("assets:bank:checking","assets:bank:checking",0,mamountp' "$1.00") ("assets:bank:checking","assets:bank:checking",0,mamountp' "$1.00")
@ -182,7 +182,7 @@ tests_BalanceReport = tests "BalanceReport" [
], ],
mixedAmount (usd 0)) mixedAmount (usd 0))
,test "with not:desc:" $ ,testCase "with not:desc:" $
(defreportspec{_rsQuery=Not . Desc $ toRegexCI' "income"}, samplejournal) `gives` (defreportspec{_rsQuery=Not . Desc $ toRegexCI' "income"}, samplejournal) `gives`
([ ([
("assets:bank:saving","assets:bank:saving",0, mamountp' "$1.00") ("assets:bank:saving","assets:bank:saving",0, mamountp' "$1.00")
@ -193,7 +193,7 @@ tests_BalanceReport = tests "BalanceReport" [
], ],
mixedAmount (usd 0)) 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` (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)) 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` (defreportspec{_rsReportOpts=defreportopts{period_= PeriodBetween (fromGregorian 2008 1 2) (fromGregorian 2008 1 3)}}, samplejournal) `gives`
([], nullmixedamt) ([], nullmixedamt)
{- {-
,test "accounts report with account pattern o" ~: ,testCase "accounts report with account pattern o" ~:
defreportopts{patterns_=["o"]} `gives` defreportopts{patterns_=["o"]} `gives`
[" $1 expenses:food" [" $1 expenses:food"
," $-2 income" ," $-2 income"
@ -219,7 +219,7 @@ tests_BalanceReport = tests "BalanceReport" [
," $-1" ," $-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` defreportopts{patterns_=["o"],depth_=Just 1} `gives`
[" $1 expenses" [" $1 expenses"
," $-2 income" ," $-2 income"
@ -227,7 +227,7 @@ tests_BalanceReport = tests "BalanceReport" [
," $-1" ," $-1"
] ]
,test "accounts report with account pattern a" ~: ,testCase "accounts report with account pattern a" ~:
defreportopts{patterns_=["a"]} `gives` defreportopts{patterns_=["a"]} `gives`
[" $-1 assets" [" $-1 assets"
," $1 bank:saving" ," $1 bank:saving"
@ -238,7 +238,7 @@ tests_BalanceReport = tests "BalanceReport" [
," $-1" ," $-1"
] ]
,test "accounts report with account pattern e" ~: ,testCase "accounts report with account pattern e" ~:
defreportopts{patterns_=["e"]} `gives` defreportopts{patterns_=["e"]} `gives`
[" $-1 assets" [" $-1 assets"
," $1 bank:saving" ," $1 bank:saving"
@ -254,7 +254,7 @@ tests_BalanceReport = tests "BalanceReport" [
," 0" ," 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` defreportopts{patterns_=["cash","saving"]} `gives`
[" $-1 assets" [" $-1 assets"
," $1 bank:saving" ," $1 bank:saving"
@ -263,14 +263,14 @@ tests_BalanceReport = tests "BalanceReport" [
," $-1" ," $-1"
] ]
,test "accounts report with multi-part account name" ~: ,testCase "accounts report with multi-part account name" ~:
defreportopts{patterns_=["expenses:food"]} `gives` defreportopts{patterns_=["expenses:food"]} `gives`
[" $1 expenses:food" [" $1 expenses:food"
,"--------------------" ,"--------------------"
," $1" ," $1"
] ]
,test "accounts report with negative account pattern" ~: ,testCase "accounts report with negative account pattern" ~:
defreportopts{patterns_=["not:assets"]} `gives` defreportopts{patterns_=["not:assets"]} `gives`
[" $2 expenses" [" $2 expenses"
," $1 food" ," $1 food"
@ -283,20 +283,20 @@ tests_BalanceReport = tests "BalanceReport" [
," $1" ," $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` defreportopts{patterns_=["not:e"]} `gives`
["--------------------" ["--------------------"
," 0" ," 0"
] ]
,test "accounts report negative patterns affect totals" ~: ,testCase "accounts report negative patterns affect totals" ~:
defreportopts{patterns_=["expenses","not:food"]} `gives` defreportopts{patterns_=["expenses","not:food"]} `gives`
[" $1 expenses:supplies" [" $1 expenses:supplies"
,"--------------------" ,"--------------------"
," $1" ," $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` defreportopts{patterns_=["assets"],empty_=True} `gives`
[" $-1 assets" [" $-1 assets"
," $1 bank" ," $1 bank"
@ -307,7 +307,7 @@ tests_BalanceReport = tests "BalanceReport" [
," $-1" ," $-1"
] ]
,test "accounts report with cost basis" $ ,testCase "accounts report with cost basis" $
j <- (readJournal def Nothing $ unlines j <- (readJournal def Nothing $ unlines
["" [""
,"2008/1/1 test " ,"2008/1/1 test "

2
hledger-lib/Hledger/Reports/BudgetReport.hs
View File

@ -446,5 +446,5 @@ budgetReportAsCsv
-- tests -- tests
tests_BudgetReport = tests "BudgetReport" [ tests_BudgetReport = testGroup "BudgetReport" [
] ]

8
hledger-lib/Hledger/Reports/EntriesReport.hs
View File

@ -39,10 +39,10 @@ entriesReport rspec@ReportSpec{_rsReportOpts=ropts} =
. journalApplyValuationFromOpts rspec{_rsReportOpts=ropts{show_costs_=True}} . journalApplyValuationFromOpts rspec{_rsReportOpts=ropts{show_costs_=True}}
. filterJournalTransactions (_rsQuery rspec) . filterJournalTransactions (_rsQuery rspec)
tests_EntriesReport = tests "EntriesReport" [ tests_EntriesReport = testGroup "EntriesReport" [
tests "entriesReport" [ testGroup "entriesReport" [
test "not acct" $ (length $ entriesReport defreportspec{_rsQuery=Not . Acct $ toRegex' "bank"} samplejournal) @?= 1 testCase "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 ,testCase "date" $ (length $ entriesReport defreportspec{_rsQuery=Date $ DateSpan (Just $ fromGregorian 2008 06 01) (Just $ fromGregorian 2008 07 01)} samplejournal) @?= 3
] ]
] ]

12
hledger-lib/Hledger/Reports/MultiBalanceReport.hs
View File

@ -582,7 +582,7 @@ balanceReportTableAsText ReportOpts{..} =
-- tests -- tests
tests_MultiBalanceReport = tests "MultiBalanceReport" [ tests_MultiBalanceReport = testGroup "MultiBalanceReport" [
let let
amt0 = Amount {acommodity="$", aquantity=0, aprice=Nothing, astyle=AmountStyle {ascommodityside = L, ascommodityspaced = False, asprecision = Precision 2, asdecimalpoint = Just '.', asdigitgroups = Nothing}} 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) (map showw aitems) @?= (map showw eitems)
showMixedAmountDebug (prrTotal atotal) @?= showMixedAmountDebug etotal -- we only check the sum of the totals showMixedAmountDebug (prrTotal atotal) @?= showMixedAmountDebug etotal -- we only check the sum of the totals
in in
tests "multiBalanceReport" [ testGroup "multiBalanceReport" [
test "null journal" $ testCase "null journal" $
(defreportspec, nulljournal) `gives` ([], nullmixedamt) (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` (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}) [ 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") 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` -- (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) -- 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` -- (defreportopts{period_= PeriodBetween (fromGregorian 2009 1 1) (fromGregorian 2009 1 2), balanceaccum_=Historical}, samplejournal) `gives`
-- ( -- (
-- [ -- [

6
hledger-lib/Hledger/Reports/PostingsReport.hs
View File

@ -218,9 +218,9 @@ negatePostingAmount = postingTransformAmount negate
-- tests -- 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 let (query, journal) `gives` n = (length $ postingsReport defreportspec{_rsQuery=query} journal) @?= n
-- with the query specified explicitly -- with the query specified explicitly
(Any, nulljournal) `gives` 0 (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) [] @?= [] summarisePostingsByInterval (Quarters 1) PrimaryDate Nothing False (DateSpan Nothing Nothing) [] @?= []
-- ,tests_summarisePostingsInDateSpan = [ -- ,tests_summarisePostingsInDateSpan = [

2
hledger-lib/Hledger/Utils.hs
View File

@ -320,6 +320,6 @@ makeHledgerClassyLenses x = flip makeLensesWith x $ classyRules
-- Fields of ReportOpts which need to update the Query when they are updated. -- Fields of ReportOpts which need to update the Query when they are updated.
queryFields = Set.fromList ["period", "statuses", "depth", "date2", "real", "querystring"] queryFields = Set.fromList ["period", "statuses", "depth", "date2", "real", "querystring"]
tests_Utils = tests "Utils" [ tests_Utils = testGroup "Utils" [
tests_Text tests_Text
] ]

11
hledger-lib/Hledger/Utils/Test.hs
View File

@ -7,8 +7,6 @@ module Hledger.Utils.Test (
,module Test.Tasty.HUnit ,module Test.Tasty.HUnit
-- ,module QC -- ,module QC
-- ,module SC -- ,module SC
,tests
,test
,assertLeft ,assertLeft
,assertRight ,assertRight
,assertParse ,assertParse
@ -46,15 +44,6 @@ import Hledger.Utils.Debug (pshow)
-- TODO: pretty-print values in failure messages -- 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. -- | Assert any Left value.
assertLeft :: (HasCallStack, Eq b, Show b) => Either a b -> Assertion assertLeft :: (HasCallStack, Eq b, Show b) => Either a b -> Assertion
assertLeft (Left _) = return () assertLeft (Left _) = return ()

7
hledger-lib/Hledger/Utils/Text.hs
View File

@ -59,7 +59,8 @@ import qualified Data.Text as T
import qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy as TL
import qualified Data.Text.Lazy.Builder as TB 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 import Text.Tabular.AsciiWide
(Align(..), Header(..), Properties(..), TableOpts(..), renderRow, textCell) (Align(..), Header(..), Properties(..), TableOpts(..), renderRow, textCell)
import Text.WideString (WideBuilder(..), wbToText, wbFromText, wbUnpack, charWidth, textWidth) 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) where step a c = a * 10 + toInteger (digitToInt c)
tests_Text = tests "Text" [ tests_Text = testGroup "Text" [
test "quoteIfSpaced" $ do testCase "quoteIfSpaced" $ do
quoteIfSpaced "a'a" @?= "a'a" quoteIfSpaced "a'a" @?= "a'a"
quoteIfSpaced "a\"a" @?= "a\"a" quoteIfSpaced "a\"a" @?= "a\"a"
quoteIfSpaced "a a" @?= "\"a a\"" quoteIfSpaced "a a" @?= "\"a a\""

2
hledger-web/Hledger/Web/Test.hs
View File

@ -13,7 +13,7 @@ import Yesod.Test
import Hledger.Web.Application ( makeFoundationWith ) import Hledger.Web.Application ( makeFoundationWith )
import Hledger.Web.WebOptions ( WebOpts(cliopts_), defwebopts, prognameandversion ) import Hledger.Web.WebOptions ( WebOpts(cliopts_), defwebopts, prognameandversion )
import Hledger.Web.Import hiding (get, j) 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 () runHspecTestsWith :: AppConfig DefaultEnv Extra -> WebOpts -> Journal -> YesodSpec App -> IO ()

26
hledger/Hledger/Cli/Commands.hs
View File

@ -268,27 +268,27 @@ testmode = hledgerCommandMode
testcmd :: CliOpts -> Journal -> IO () testcmd :: CliOpts -> Journal -> IO ()
testcmd opts _undefined = do testcmd opts _undefined = do
withArgs (listofstringopt "args" $ rawopts_ opts) $ withArgs (listofstringopt "args" $ rawopts_ opts) $
Test.Tasty.defaultMain $ tests "hledger" [ Test.Tasty.defaultMain $ testGroup "hledger" [
tests_Hledger tests_Hledger
,tests_Hledger_Cli ,tests_Hledger_Cli
] ]
-- All unit tests for Hledger.Cli, defined here rather than -- All unit tests for Hledger.Cli, defined here rather than
-- Hledger.Cli so testcmd can use them. -- Hledger.Cli so testcmd can use them.
tests_Hledger_Cli = tests "Hledger.Cli" [ tests_Hledger_Cli = testGroup "Hledger.Cli" [
tests_Cli_Utils tests_Cli_Utils
,tests_Commands ,tests_Commands
] ]
tests_Commands = tests "Commands" [ tests_Commands = testGroup "Commands" [
tests_Balance tests_Balance
,tests_Register ,tests_Register
,tests_Aregister ,tests_Aregister
-- some more tests easiest to define here: -- some more tests easiest to define here:
,tests "apply account directive" [ ,testGroup "apply account directive" [
test "works" $ do testCase "works" $ do
let let
ignoresourcepos j = j{jtxns=map (\t -> t{tsourcepos=nullsourcepos}) (jtxns j)} ignoresourcepos j = j{jtxns=map (\t -> t{tsourcepos=nullsourcepos}) (jtxns j)}
sameParse str1 str2 = do sameParse str1 str2 = do
@ -309,43 +309,43 @@ tests_Commands = tests "Commands" [
"2008/12/07 Five\n foo $-5\n bar $5\n" "2008/12/07 Five\n foo $-5\n bar $5\n"
) )
,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: 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 let p = head $ tpostings $ head $ jtxns j
paccount p @?= "test:from" paccount p @?= "test:from"
ptype p @?= VirtualPosting 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: 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 let p = head $ tpostings $ head $ jtxns j
paccount p @?= "equity:draw:personal:food" 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: j <- readJournal definputopts Nothing defaultyear_journal_txt >>= either error' return -- PARTIAL:
tdate (head $ jtxns j) @?= fromGregorian 2009 1 1 tdate (head $ jtxns j) @?= fromGregorian 2009 1 1
,test "ledgerAccountNames" $ ,testCase "ledgerAccountNames" $
(ledgerAccountNames ledger7) (ledgerAccountNames ledger7)
@?= @?=
["assets","assets:cash","assets:checking","assets:saving","equity","equity:opening balances", ["assets","assets:cash","assets:checking","assets:saving","equity","equity:opening balances",
"expenses","expenses:food","expenses:food:dining","expenses:phone","expenses:vacation", "expenses","expenses:food","expenses:food:dining","expenses:phone","expenses:vacation",
"liabilities","liabilities:credit cards","liabilities:credit cards:discover"] "liabilities","liabilities:credit cards","liabilities:credit cards:discover"]
-- ,test "journalCanonicaliseAmounts" ~: -- ,testCase "journalCanonicaliseAmounts" ~:
-- "use the greatest precision" ~: -- "use the greatest precision" ~:
-- (map asprecision $ journalAmountAndPriceCommodities $ journalCanonicaliseAmounts $ journalWithAmounts ["1","2.00"]) @?= [2,2] -- (map asprecision $ journalAmountAndPriceCommodities $ journalCanonicaliseAmounts $ journalWithAmounts ["1","2.00"]) @?= [2,2]
-- don't know what this should do -- don't know what this should do
-- ,test "elideAccountName" ~: do -- ,testCase "elideAccountName" ~: do
-- (elideAccountName 50 "aaaaaaaaaaaaaaaaaaaa:aaaaaaaaaaaaaaaaaaaa:aaaaaaaaaaaaaaaaaaaa" -- (elideAccountName 50 "aaaaaaaaaaaaaaaaaaaa:aaaaaaaaaaaaaaaaaaaa:aaaaaaaaaaaaaaaaaaaa"
-- @?= "aa:aaaaaaaaaaaaaaaaaaaa:aaaaaaaaaaaaaaaaaaaa") -- @?= "aa:aaaaaaaaaaaaaaaaaaaa:aaaaaaaaaaaaaaaaaaaa")
-- (elideAccountName 20 "aaaaaaaaaaaaaaaaaaaa:aaaaaaaaaaaaaaaaaaaa:aaaaaaaaaaaaaaaaaaaa" -- (elideAccountName 20 "aaaaaaaaaaaaaaaaaaaa:aaaaaaaaaaaaaaaaaaaa:aaaaaaaaaaaaaaaaaaaa"
-- @?= "aa:aa:aaaaaaaaaaaaaa") -- @?= "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"
] ]

2
hledger/Hledger/Cli/Commands/Aregister.hs
View File

@ -210,6 +210,6 @@ accountTransactionsReportItemAsText
-- tests -- tests
tests_Aregister = tests "Aregister" [ tests_Aregister = testGroup "Aregister" [
] ]

6
hledger/Hledger/Cli/Commands/Balance.hs
View File

@ -711,10 +711,10 @@ balanceOpts isTable ReportOpts{..} = oneLine
, displayMaxWidth = if isTable && not no_elide_ then Just 32 else Nothing , displayMaxWidth = if isTable && not no_elide_ then Just 32 else Nothing
} }
tests_Balance = tests "Balance" [ tests_Balance = testGroup "Balance" [
tests "balanceReportAsText" [ testGroup "balanceReportAsText" [
test "unicode in balance layout" $ do testCase "unicode in balance layout" $ do
j <- readJournal' "2009/01/01 * медвежья шкура\n расходы:покупки 100\n актив:наличные\n" j <- readJournal' "2009/01/01 * медвежья шкура\n расходы:покупки 100\n актив:наличные\n"
let rspec = defreportspec{_rsReportOpts=defreportopts{no_total_=True}} let rspec = defreportspec{_rsReportOpts=defreportopts{no_total_=True}}
TB.toLazyText (balanceReportAsText (_rsReportOpts rspec) (balanceReport rspec{_rsDay=fromGregorian 2008 11 26} j)) TB.toLazyText (balanceReportAsText (_rsReportOpts rspec) (balanceReport rspec{_rsDay=fromGregorian 2008 11 26} j))

6
hledger/Hledger/Cli/Commands/Register.hs
View File

@ -184,10 +184,10 @@ postingsReportItemAsText opts preferredamtwidth preferredbalwidth (mdate, mperio
-- tests -- tests
tests_Register = tests "Register" [ tests_Register = testGroup "Register" [
tests "postingsReportAsText" [ testGroup "postingsReportAsText" [
test "unicode in register layout" $ do testCase "unicode in register layout" $ do
j <- readJournal' "2009/01/01 * медвежья шкура\n расходы:покупки 100\n актив:наличные\n" j <- readJournal' "2009/01/01 * медвежья шкура\n расходы:покупки 100\n актив:наличные\n"
let rspec = defreportspec let rspec = defreportspec
(TL.unpack . postingsReportAsText defcliopts $ postingsReport rspec j) (TL.unpack . postingsReportAsText defcliopts $ postingsReport rspec j)

6
hledger/Hledger/Cli/Utils.hs
View File

@ -256,14 +256,14 @@ journalSimilarTransaction cliopts j desc = mbestmatch
journalTransactionsSimilarTo j q desc 10 journalTransactionsSimilarTo j q desc 10
q = queryFromFlags $ _rsReportOpts $ reportspec_ cliopts 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. -- -- Print the time required to convert one of the sample journals' amounts to value.
-- -- Pretty clunky, but working. -- -- Pretty clunky, but working.
-- -- XXX sample.journal has no price records, but is always present. -- -- XXX sample.journal has no price records, but is always present.
-- -- Change to eg examples/5000x1000x10.journal to make this useful. -- -- Change to eg examples/5000x1000x10.journal to make this useful.
-- test "time" $ do -- testCase "time" $ do
-- ej <- io $ readJournalFile definputopts "examples/3000x1000x10.journal" -- ej <- io $ readJournalFile definputopts "examples/3000x1000x10.journal"
-- case ej of -- case ej of
-- Left e -> crash $ T.pack e -- Left e -> crash $ T.pack e