filter by account patterns when caching a ledger, fix balance report totals
This commit is contained in:
Simon Michael
parent
ea5a87815b
commit
c46189a75b
@ -1,8 +1,8 @@
|
||||
{-|
|
||||
|
||||
A 'Ledger' stores, for efficiency, a 'RawLedger' plus its tree of account
|
||||
names, and a map from account names to 'Account's. Typically it also has
|
||||
had uninteresting 'Entry's filtered out.
|
||||
names, and a map from account names to 'Account's. It may also have had
|
||||
uninteresting 'Entry's and 'Transaction's filtered out.
|
||||
|
||||
-}
|
||||
|
||||
@ -29,12 +29,12 @@ instance Show Ledger where
|
||||
(showtree $ accountnametree l)
|
||||
|
||||
-- | Convert a raw ledger to a more efficient cached type, described above.
|
||||
cacheLedger :: RawLedger -> Ledger
|
||||
cacheLedger l = Ledger l ant amap
|
||||
cacheLedger :: [String] -> RawLedger -> Ledger
|
||||
cacheLedger apats l = Ledger l ant amap
|
||||
where
|
||||
ant = rawLedgerAccountNameTree l
|
||||
anames = flatten ant
|
||||
ts = rawLedgerTransactions l
|
||||
ts = filtertxns apats $ rawLedgerTransactions l
|
||||
sortedts = sortBy (comparing account) ts
|
||||
groupedts = groupBy (\t1 t2 -> account t1 == account t2) sortedts
|
||||
txnmap = Map.union
|
||||
@ -48,6 +48,9 @@ cacheLedger l = Ledger l ant amap
|
||||
(Map.fromList [(a,Mixed []) | a <- anames])
|
||||
amap = Map.fromList [(a, Account a (txnmap ! a) (balmap ! a)) | a <- anames]
|
||||
|
||||
filtertxns :: [String] -> [Transaction] -> [Transaction]
|
||||
filtertxns apats ts = filter (matchpats apats . account) ts
|
||||
|
||||
-- | List a ledger's account names.
|
||||
accountnames :: Ledger -> [AccountName]
|
||||
accountnames l = drop 1 $ flatten $ accountnametree l
|
||||
|
||||
36
Tests.hs
36
Tests.hs
@ -81,7 +81,7 @@ misc_tests = TestList [
|
||||
(accountnames ledger7)
|
||||
,
|
||||
"cacheLedger" ~: do
|
||||
assertequal 15 (length $ Map.keys $ accountmap $ cacheLedger rawledger7)
|
||||
assertequal 15 (length $ Map.keys $ accountmap $ cacheLedger [] rawledger7)
|
||||
,
|
||||
"transactionamount" ~: do
|
||||
assertparseequal (Mixed [dollars 47.18]) (parsewith transactionamount " $47.18")
|
||||
@ -115,13 +115,13 @@ balancereportacctnames_tests = TestList
|
||||
,"balancereportacctnames8" ~: ("-s",["-e"]) `gives` []
|
||||
] where
|
||||
gives (opt,pats) e = do
|
||||
l <- ledgerfromfile "sample.ledger"
|
||||
l <- ledgerfromfile pats "sample.ledger"
|
||||
let t = pruneZeroBalanceLeaves $ ledgerAccountTree 999 l
|
||||
assertequal e (balancereportacctnames l (opt=="-s") pats t)
|
||||
|
||||
balancecommand_tests = TestList [
|
||||
"simple balance report" ~: do
|
||||
l <- ledgerfromfile "sample.ledger"
|
||||
l <- ledgerfromfile [] "sample.ledger"
|
||||
assertequal
|
||||
" $-1 assets\n\
|
||||
\ $2 expenses\n\
|
||||
@ -131,7 +131,7 @@ balancecommand_tests = TestList [
|
||||
(showBalanceReport [] [] l)
|
||||
,
|
||||
"balance report with --subtotal" ~: do
|
||||
l <- ledgerfromfile "sample.ledger"
|
||||
l <- ledgerfromfile [] "sample.ledger"
|
||||
assertequal
|
||||
" $-1 assets\n\
|
||||
\ $-2 cash\n\
|
||||
@ -147,7 +147,7 @@ balancecommand_tests = TestList [
|
||||
(showBalanceReport [SubTotal] [] l)
|
||||
,
|
||||
"balance report with account pattern o" ~: do
|
||||
l <- ledgerfromfile "sample.ledger"
|
||||
l <- ledgerfromfile ["o"] "sample.ledger"
|
||||
assertequal
|
||||
" $1 expenses:food\n\
|
||||
\ $-2 income\n\
|
||||
@ -157,7 +157,7 @@ balancecommand_tests = TestList [
|
||||
(showBalanceReport [] ["o"] l)
|
||||
,
|
||||
"balance report with account pattern o and --subtotal" ~: do
|
||||
l <- ledgerfromfile "sample.ledger"
|
||||
l <- ledgerfromfile ["o"] "sample.ledger"
|
||||
assertequal
|
||||
" $1 expenses:food\n\
|
||||
\ $-2 income\n\
|
||||
@ -169,7 +169,7 @@ balancecommand_tests = TestList [
|
||||
(showBalanceReport [SubTotal] ["o"] l)
|
||||
,
|
||||
"balance report with account pattern a" ~: do
|
||||
l <- ledgerfromfile "sample.ledger"
|
||||
l <- ledgerfromfile ["a"] "sample.ledger"
|
||||
assertequal
|
||||
" $-1 assets\n\
|
||||
\ $-2 cash\n\
|
||||
@ -182,7 +182,7 @@ balancecommand_tests = TestList [
|
||||
(showBalanceReport [] ["a"] l)
|
||||
,
|
||||
"balance report with account pattern e" ~: do
|
||||
l <- ledgerfromfile "sample.ledger"
|
||||
l <- ledgerfromfile ["e"] "sample.ledger"
|
||||
assertequal
|
||||
" $-1 assets\n\
|
||||
\ $2 expenses\n\
|
||||
@ -194,7 +194,7 @@ balancecommand_tests = TestList [
|
||||
,
|
||||
"balance report with unmatched parent of two matched subaccounts" ~:
|
||||
do
|
||||
l <- ledgerfromfile "sample.ledger"
|
||||
l <- ledgerfromfile ["cash","saving"] "sample.ledger"
|
||||
assertequal
|
||||
" $-2 assets:cash\n\
|
||||
\ $1 assets:saving\n\
|
||||
@ -205,16 +205,17 @@ balancecommand_tests = TestList [
|
||||
,
|
||||
"balance report with multi-part account name" ~:
|
||||
do
|
||||
l <- ledgerfromfile "sample.ledger"
|
||||
let pats = ["expenses:food"]
|
||||
l <- ledgerfromfile pats "sample.ledger"
|
||||
assertequal
|
||||
" $1 expenses:food\n\
|
||||
\--------------------\n\
|
||||
\ $1\n\
|
||||
\" --"
|
||||
$ showBalanceReport [] ["expenses:food"] l
|
||||
$ showBalanceReport [] pats l
|
||||
,
|
||||
"balance report with negative account pattern" ~: do
|
||||
l <- ledgerfromfile "sample.ledger"
|
||||
l <- ledgerfromfile ["-assets"] "sample.ledger"
|
||||
assertequal (
|
||||
" $2 expenses\n" ++
|
||||
" $-2 income\n" ++
|
||||
@ -226,24 +227,25 @@ balancecommand_tests = TestList [
|
||||
,
|
||||
"balance report negative account pattern always matches full name" ~:
|
||||
do
|
||||
l <- ledgerfromfile "sample.ledger"
|
||||
l <- ledgerfromfile ["-e"] "sample.ledger"
|
||||
assertequal "" $ showBalanceReport [] ["-e"] l
|
||||
,
|
||||
"balance report negative patterns affect totals" ~:
|
||||
do
|
||||
l <- ledgerfromfile "sample.ledger"
|
||||
let pats = ["expenses","-food"]
|
||||
l <- ledgerfromfile pats "sample.ledger"
|
||||
assertequal (
|
||||
" $1 expenses\n" ++
|
||||
"--------------------\n" ++
|
||||
" $1\n" ++
|
||||
"")
|
||||
$ showBalanceReport [] ["expenses","-food"] l
|
||||
$ showBalanceReport [] pats l
|
||||
]
|
||||
|
||||
registercommand_tests = TestList [
|
||||
"register report" ~:
|
||||
do
|
||||
l <- ledgerfromfile "sample.ledger"
|
||||
l <- ledgerfromfile [] "sample.ledger"
|
||||
assertequal (
|
||||
"2007/01/01 income assets:checking $1 $1\n" ++
|
||||
" income:salary $-1 0\n" ++
|
||||
@ -551,7 +553,7 @@ rawledger7 = RawLedger
|
||||
]
|
||||
""
|
||||
|
||||
ledger7 = cacheLedger rawledger7
|
||||
ledger7 = cacheLedger [] rawledger7
|
||||
|
||||
timelogentry1_str = "i 2007/03/11 16:19:00 hledger\n"
|
||||
timelogentry1 = TimeLogEntry 'i' (parsedatetime "2007/03/11 16:19:00") "hledger"
|
||||
|
||||
12
Utils.hs
12
Utils.hs
@ -17,11 +17,13 @@ rawledgerfromfile f = do
|
||||
parsed <- parseLedgerFile f
|
||||
return $ either (\_ -> RawLedger [] [] [] "") id parsed
|
||||
|
||||
-- | get a cached Ledger from the given file path
|
||||
ledgerfromfile :: FilePath -> IO Ledger
|
||||
ledgerfromfile f = do
|
||||
-- | get a cached Ledger from the given file path, filtered by the patterns.
|
||||
ledgerfromfile :: [String] -> FilePath -> IO Ledger
|
||||
ledgerfromfile args f = do
|
||||
l <- rawledgerfromfile f
|
||||
return $ cacheLedger $ filterRawLedger Nothing Nothing [] False False l
|
||||
return $ cacheLedger apats $ filterRawLedger Nothing Nothing dpats False False l
|
||||
where
|
||||
(apats,dpats) = parseAccountDescriptionArgs args
|
||||
|
||||
-- | get a RawLedger from the file your LEDGER environment variable
|
||||
-- variable points to or (WARNING) an empty one if there was a problem.
|
||||
@ -35,7 +37,7 @@ myrawledger = do
|
||||
myledger :: IO Ledger
|
||||
myledger = do
|
||||
l <- myrawledger
|
||||
return $ cacheLedger $ filterRawLedger Nothing Nothing [] False False l
|
||||
return $ cacheLedger [] $ filterRawLedger Nothing Nothing [] False False l
|
||||
|
||||
-- | get a named account from your ledger file
|
||||
myaccount :: AccountName -> IO Account
|
||||
|
||||
@ -17,7 +17,7 @@ You can use the command line:
|
||||
or ghci:
|
||||
|
||||
> $ ghci hledger
|
||||
> > l <- ledgerfromfile "sample.ledger"
|
||||
> > l <- ledgerfromfile [] "sample.ledger"
|
||||
> > balance [] [] l
|
||||
> $-1 assets
|
||||
> $2 expenses
|
||||
@ -73,10 +73,10 @@ parseLedgerAndDo :: [Opt] -> [String] -> ([Opt] -> [String] -> Ledger -> IO ())
|
||||
parseLedgerAndDo opts args cmd =
|
||||
ledgerFilePathFromOpts opts >>= parseLedgerFile >>= either printParseError runcmd
|
||||
where
|
||||
runcmd = cmd opts args . cacheLedger . canonicaliseAmounts . filterRawLedger b e dpats c r
|
||||
runcmd = cmd opts args . cacheLedger apats . canonicaliseAmounts . filterRawLedger b e dpats c r
|
||||
b = parsemaybedate (beginDateFromOpts opts)
|
||||
e = parsemaybedate (endDateFromOpts opts)
|
||||
dpats = snd $ parseAccountDescriptionArgs args
|
||||
(apats,dpats) = parseAccountDescriptionArgs args
|
||||
c = Cleared `elem` opts
|
||||
r = Real `elem` opts
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user