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

better register summarising with --depth and -E support, datespan splitting bugfix

Browse Source
This commit is contained in:
Simon Michael 2008-12-04 19:29:29 +00:00
parent 5cdd124749
commit 5e9f9e530a
5 changed files with 148 additions and 59 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
Ledger/Dates.hs
View File

@ -69,10 +69,13 @@ splitSpan Yearly s = splitspan start next s where (start,next) = (startofyea
splitspan _ _ (DateSpan Nothing Nothing) = []
splitspan startof next (DateSpan Nothing (Just e)) = [DateSpan (Just $ startof e) (Just $ next $ startof e)]
splitspan startof next (DateSpan (Just b) Nothing) = [DateSpan (Just $ startof b) (Just $ next $ startof b)]
splitspan startof next (DateSpan (Just b) (Just e))
| b >= e = []
| otherwise = [DateSpan (Just $ startof b) (Just $ next $ startof b)]
++ splitspan startof next (DateSpan (Just $ next $ startof b) (Just e))
splitspan startof next s@(DateSpan (Just b) (Just e))
| b == e = [s]
| otherwise = splitspan' startof next s
where splitspan' startof next (DateSpan (Just b) (Just e))
| b >= e = []
| otherwise = [DateSpan (Just $ startof b) (Just $ next $ startof b)]
++ splitspan' startof next (DateSpan (Just $ next $ startof b) (Just e))
-- | Parse a period expression to an Interval and overall DateSpan using
-- the provided reference date.
@ -393,3 +396,7 @@ justdatespan rdate = do
optional (string "in" >> many spacenonewline)
d <- smartdate
return $ spanFromSmartDate rdate d
nulldatespan = DateSpan Nothing Nothing
mkdatespan b e = DateSpan (Just $ parsedate b) (Just $ parsedate e)

30
Ledger/Ledger.hs
View File

@ -30,23 +30,27 @@ instance Show Ledger where
-- | Convert a raw ledger to a more efficient cached type, described above.
cacheLedger :: [String] -> RawLedger -> Ledger
cacheLedger apats l = Ledger l ant amap
cacheLedger apats l = Ledger l ant acctmap
where
ts = filtertxns apats $ rawLedgerTransactions l
ant = rawLedgerAccountNameTree l
anames = flatten ant
ts = filtertxns apats $ rawLedgerTransactions l
txnmap = Map.union (transactionsByAccount ts) (Map.fromList [(a,[]) | a <- anames])
subacctsof a = filter (a `isAccountNamePrefixOf`) anames
subtxnsof a = concat [txnmap ! a | a <- [a] ++ subacctsof a]
balmap = Map.union
(Map.fromList [(a,sumTransactions $ subtxnsof a) | a <- anames])
(Map.fromList [(a,Mixed []) | a <- anames])
acctmap = Map.fromList [(a, mkacct a) | a <- anames]
mkacct a = Account a (txnmap ! a) (balmap ! a)
-- | Convert a list of transactions to a map from account name to the list
-- of all transactions in that account.
transactionsByAccount :: [Transaction] -> Map.Map AccountName [Transaction]
transactionsByAccount ts = Map.fromList [(account $ head g, g) | g <- groupedts]
where
sortedts = sortBy (comparing account) ts
groupedts = groupBy (\t1 t2 -> account t1 == account t2) sortedts
txnmap = Map.union
(Map.fromList [(account $ head g, g) | g <- groupedts])
(Map.fromList [(a,[]) | a <- anames])
txnsof = (txnmap !)
subacctsof a = filter (a `isAccountNamePrefixOf`) anames
subtxnsof a = concat [txnsof a | a <- [a] ++ subacctsof a]
balmap = Map.union
(Map.fromList [(a,(sumTransactions $ subtxnsof a)) | a <- anames])
(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
@ -92,6 +96,6 @@ ledgerAccountTreeAt l acct = subtreeat acct $ ledgerAccountTree 9999 l
-- or DateSpan Nothing Nothing if there are no transactions.
ledgerDateSpan l
| null ts = DateSpan Nothing Nothing
| otherwise = DateSpan (Just $ date $ head ts) (Just $ date $ last ts)
| otherwise = DateSpan (Just $ date $ head ts) (Just $ addDays 1 $ date $ last ts)
where
ts = sortBy (comparing date) $ ledgerTransactions l

1
NOTES
View File

@ -14,7 +14,6 @@ clever tricks like the plague." --Edsger Dijkstra
*** should accept - before currency symbol ?
*** can't parse comment line immediately after or within an entry
** features
*** show empty reporting intervals with the -E option, for clarity/consistency/graphing
*** actual/effective entry & txn dates, for completeness
*** speed
**** easy profiling

100
RegisterCommand.hs
View File

@ -40,15 +40,66 @@ showRegisterReport opts args l
matchdisplayopt (Just e) t = (fromparse $ parsewith datedisplayexpr e) t
dopt = displayFromOpts opts
empty = Empty `elem` opts
summaryts = concat $ map (\(n,s) -> summarise n s (filter (isTransactionInDateSpan s) ts)) $ zip [1..] spans
depth = depthFromOpts opts
summaryts = concatMap summarisespan (zip spans [1..])
summarisespan (s,n) = summariseTransactionsInDateSpan s n depth empty (transactionsinspan s)
transactionsinspan s = filter (isTransactionInDateSpan s) ts
spans = splitSpan interval (ledgerDateSpan l)
-- generate a grouped set of summary transactions for this date span
summarise :: Int -> DateSpan -> [Transaction] -> [Transaction]
summarise _ _ [] = []
summarise n (DateSpan b e) ts = summarytxns (b',e') n empty ts
where
b' = fromMaybe (date $ head ts) b
e' = fromMaybe (date $ last ts) e
-- | Convert a date span (representing a reporting interval) and a list of
-- transactions within it to a new list of transactions aggregated by
-- account, which showtxns will render as a summary for this interval.
--
-- As usual with date spans the end date is exclusive, but for display
-- purposes we show the previous day as end date, like ledger.
--
-- A unique entryno value is provided to that the new transactions will be
-- grouped as one entry.
--
-- When a depth argument is present, transactions to accounts of greater
-- depth are aggregated where possible.
--
-- The showempty flag forces the display of a zero-transaction span
-- and also zero-transaction accounts within the span.
summariseTransactionsInDateSpan :: DateSpan -> Int -> Maybe Int -> Bool -> [Transaction] -> [Transaction]
summariseTransactionsInDateSpan (DateSpan b e) entryno depth showempty ts
| null ts && showempty = [txn]
| null ts = []
| otherwise = summaryts'
where
txn = nulltxn{entryno=entryno, date=b', description="- "++(showDate $ addDays (-1) e')}
b' = fromMaybe (date $ head ts) b
e' = fromMaybe (date $ last ts) e
summaryts'
| showempty = summaryts
| otherwise = filter (not . isZeroMixedAmount . amount) summaryts
-- aggregate balances by account, like cacheLedger:
anames = sort $ nub $ map account ts
allnames = expandAccountNames anames
-- from cacheLedger:
txnmap = Map.union (transactionsByAccount ts) (Map.fromList [(a,[]) | a <- allnames])
txnsof = (txnmap !) -- a's txns
subacctsof a = filter (a `isAccountNamePrefixOf`) anames -- a plus any subaccounts
subtxnsof a = concat [txnsof a | a <- [a] ++ subacctsof a] -- a's and subaccounts' txns
inclusivebalmap = Map.union -- subaccount-including balances for all accounts
(Map.fromList [(a,(sumTransactions $ subtxnsof a)) | a <- allnames])
(Map.fromList [(a,Mixed []) | a <- anames])
--
-- then do depth-clipping
exclusivebalmap = Map.union -- subaccount-excluding balances for all accounts
(Map.fromList [(a,(sumTransactions $ txnsof a)) | a <- allnames])
(Map.fromList [(a,Mixed []) | a <- anames])
inclusivebalanceof = (inclusivebalmap !)
exclusivebalanceof = (exclusivebalmap !)
clippedanames = clipAccountNames depth anames
isclipped a = accountNameLevel a >= fromMaybe 9999 depth
balancetoshowfor a = (if isclipped a then inclusivebalanceof else exclusivebalanceof) a
summaryts = [txn{account=a,amount=balancetoshowfor a} | a <- clippedanames]
clipAccountNames :: Maybe Int -> [AccountName] -> [AccountName]
clipAccountNames Nothing as = as
clipAccountNames (Just d) as = nub $ map (clip d) as
where clip d = accountNameFromComponents . take d . accountNameComponents
-- | Does the given transaction fall within the given date span ?
isTransactionInDateSpan :: DateSpan -> Transaction -> Bool
@ -57,39 +108,6 @@ isTransactionInDateSpan (DateSpan Nothing (Just e)) (Transaction{date=d}) = d<e
isTransactionInDateSpan (DateSpan (Just b) Nothing) (Transaction{date=d}) = d>=b
isTransactionInDateSpan (DateSpan (Just b) (Just e)) (Transaction{date=d}) = d>=b && d<e
-- | Convert a date span and a list of transactions within that date span
-- to a new list of transactions aggregated by account, which when
-- rendered by showtxns will display a summary for the date span. Both
-- ends of the date span must be specified so we pass a tuple of dates.
-- As usual with date spans the second date is exclusive, but when
-- rendering we will show the previous (inclusive) date.
-- A unique entryno value is provided so that these dummy transactions
-- will be rendered as one entry. Also the showempty flag is provided to
-- control display of zero-balance accounts.
summarytxns :: (Day,Day) -> Int -> Bool -> [Transaction] -> [Transaction]
summarytxns (b,e) entryno showempty ts = summaryts'
where
summaryts'
| showempty = summaryts
| otherwise = filter (not . isZeroMixedAmount . amount) summaryts
summaryts = [templtxn{account=a,amount=balmap ! a} | a <- anames]
templtxn = nulltxn{entryno=entryno,date=b,description="- "++(showDate eprev)}
eprev = addDays (-1) e
anames = sort $ nub $ map account ts
-- from cacheLedger:
sortedts = sortBy (comparing account) ts
groupedts = groupBy (\t1 t2 -> account t1 == account t2) sortedts
txnmap = Map.union
(Map.fromList [(account $ head g, g) | g <- groupedts])
(Map.fromList [(a,[]) | a <- anames])
txnsof = (txnmap !)
subacctsof a = filter (a `isAccountNamePrefixOf`) anames
subtxnsof a = concat [txnsof a | a <- [a] ++ subacctsof a]
balmap = Map.union
(Map.fromList [(a,(sumTransactions $ subtxnsof a)) | a <- anames])
(Map.fromList [(a,Mixed []) | a <- anames])
--
-- | Show transactions one per line, with each date/description appearing
-- only once, and a running balance.
showtxns [] _ _ = ""

61
Tests.hs
View File

@ -156,6 +156,67 @@ misc_tests = TestList [
"every day from aug to oct" `gives` "(Daily,DateSpan (Just 2008-08-01) (Just 2008-10-01))"
"daily from aug" `gives` "(Daily,DateSpan (Just 2008-08-01) Nothing)"
"every week to 2009" `gives` "(Weekly,DateSpan Nothing (Just 2009-01-01))"
,
"splitSpan" ~: do
let (interval,span) `gives` spans = assertequal spans (splitSpan interval span)
(NoInterval,mkdatespan "2008/01/01" "2009/01/01") `gives`
[mkdatespan "2008/01/01" "2009/01/01"]
(Quarterly,mkdatespan "2008/01/01" "2009/01/01") `gives`
[mkdatespan "2008/01/01" "2008/04/01"
,mkdatespan "2008/04/01" "2008/07/01"
,mkdatespan "2008/07/01" "2008/10/01"
,mkdatespan "2008/10/01" "2009/01/01"
]
(Quarterly,nulldatespan) `gives`
[nulldatespan]
(Daily,mkdatespan "2008/01/01" "2008/01/01") `gives`
[mkdatespan "2008/01/01" "2008/01/01"]
(Quarterly,mkdatespan "2008/01/01" "2008/01/01") `gives`
[mkdatespan "2008/01/01" "2008/01/01"]
,
"summariseTransactionsInDateSpan" ~: do
let (b,e,entryno,depth,showempty,ts) `gives` summaryts = assertequal (summaryts) (summariseTransactionsInDateSpan (mkdatespan b e) entryno depth showempty ts)
("2008/01/01","2009/01/01",0,Nothing,False,[]) `gives`
[]
("2008/01/01","2009/01/01",0,Nothing,True,[]) `gives`
[
nulltxn{date=parsedate "2008/01/01",description="- 2008/12/31"}
]
("2008/01/01","2009/01/01",0,Nothing,False,[
nulltxn{description="desc",account="expenses:food:groceries",amount=Mixed [dollars 1]}
,nulltxn{description="desc",account="expenses:food:dining", amount=Mixed [dollars 2]}
,nulltxn{description="desc",account="expenses:food", amount=Mixed [dollars 4]}
,nulltxn{description="desc",account="expenses:food:dining", amount=Mixed [dollars 8]}
]) `gives`
[
nulltxn{date=parsedate "2008/01/01",description="- 2008/12/31",account="expenses:food", amount=Mixed [dollars 4]}
,nulltxn{date=parsedate "2008/01/01",description="- 2008/12/31",account="expenses:food:dining", amount=Mixed [dollars 10]}
,nulltxn{date=parsedate "2008/01/01",description="- 2008/12/31",account="expenses:food:groceries",amount=Mixed [dollars 1]}
]
("2008/01/01","2009/01/01",0,Just 2,False,[
nulltxn{description="desc",account="expenses:food:groceries",amount=Mixed [dollars 1]}
,nulltxn{description="desc",account="expenses:food:dining", amount=Mixed [dollars 2]}
,nulltxn{description="desc",account="expenses:food", amount=Mixed [dollars 4]}
,nulltxn{description="desc",account="expenses:food:dining", amount=Mixed [dollars 8]}
]) `gives`
[
nulltxn{date=parsedate "2008/01/01",description="- 2008/12/31",account="expenses:food", amount=Mixed [dollars 15]}
]
("2008/01/01","2009/01/01",0,Just 1,False,[
nulltxn{description="desc",account="expenses:food:groceries",amount=Mixed [dollars 1]}
,nulltxn{description="desc",account="expenses:food:dining", amount=Mixed [dollars 2]}
,nulltxn{description="desc",account="expenses:food", amount=Mixed [dollars 4]}
,nulltxn{description="desc",account="expenses:food:dining", amount=Mixed [dollars 8]}
]) `gives`
[
nulltxn{date=parsedate "2008/01/01",description="- 2008/12/31",account="expenses", amount=Mixed [dollars 15]}
]
]
balancereportacctnames_tests = TestList