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

balance: merge/improve multicol report implementations

Browse Source 
Periodic, cumulative and historical multicolumn balance reports are now
generated by one code path, which helps with consistency and reducing
the bug/test surface. --tree now also works with --cumulative or
--historical.
This commit is contained in:
Simon Michael 2014-04-13 11:07:39 -07:00
parent cad37b7dce
commit 2af04ec2fc
3 changed files with 101 additions and 141 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

190
hledger-lib/Hledger/Reports/MultiBalanceReports.hs
View File

@ -8,8 +8,7 @@ Multi-column balance reports, used by the balance command.
module Hledger.Reports.MultiBalanceReports ( module Hledger.Reports.MultiBalanceReports (
MultiBalanceReport(..), MultiBalanceReport(..),
MultiBalanceReportRow, MultiBalanceReportRow,
periodBalanceReport, multiBalanceReport
cumulativeOrHistoricalBalanceReport,
-- -- * Tests -- -- * Tests
-- tests_Hledger_Reports_MultiBalanceReport -- tests_Hledger_Reports_MultiBalanceReport
@ -36,8 +35,9 @@ import Hledger.Reports.BalanceReport
-- --
-- 3. a list of each column's final total -- 3. a list of each column's final total
-- --
-- The meaning of the amounts depends on the type of balance report (see -- The meaning of the amounts depends on the type of multi balance
-- 'BalanceType' and "Hledger.Cli.Balance"). -- report, of which there are three: periodic, cumulative and historical
-- (see 'BalanceType' and "Hledger.Cli.Balance").
newtype MultiBalanceReport = MultiBalanceReport ([DateSpan] newtype MultiBalanceReport = MultiBalanceReport ([DateSpan]
,[MultiBalanceReportRow] ,[MultiBalanceReportRow]
,[MixedAmount] ,[MixedAmount]
@ -60,29 +60,19 @@ instance Show MultiBalanceReport where
-- type alias just to remind us which AccountNames might be depth-clipped, below. -- type alias just to remind us which AccountNames might be depth-clipped, below.
type ClippedAccountName = AccountName type ClippedAccountName = AccountName
-- | Generate a multi balance report for the matched accounts, showing -- | Generate a multicolumn balance report for the matched accounts,
-- their change of balance in each of the specified periods. -- showing the change of balance, accumulated balance, or historical balance
-- Currently has some limitations compared to the simple balance report, -- in each of the specified periods.
-- eg always displays accounts in --flat mode. multiBalanceReport :: ReportOpts -> Query -> Journal -> MultiBalanceReport
periodBalanceReport :: ReportOpts -> Query -> Journal -> MultiBalanceReport multiBalanceReport opts q j = MultiBalanceReport (spans, items, totals)
periodBalanceReport opts q j = MultiBalanceReport (spans, items, totals)
where where
-- dbg = const id -- exclude from debug output -- dbg = const id -- exclude from debug output
dbg s = let p = "periodBalanceReport" in Hledger.Utils.dbg (p++" "++s) -- add prefix in debug output -- dbg s = let p = "multiBalanceReport" in Hledger.Utils.dbg (p++" "++s) -- add prefix in debug output
-- Example data below is from
-- hledger -f data/balance-multicol.journal balance -p 'monthly2013' assets: --depth=1 --debug=1
-- with flatShowsExclusiveBalance=True. To see more, run other commands from
-- tests/balance-multicol.test with --debug=1.
nodepthq = dbg "nodepthq" $ filterQuery (not . queryIsDepth) q nodepthq = dbg "nodepthq" $ filterQuery (not . queryIsDepth) q
-- And ([Date (DateSpan (Just 2013-01-01) (Just 2014-01-01)),Acct "assets:"])
depthq = dbg "depthq" $ filterQuery queryIsDepth q depthq = dbg "depthq" $ filterQuery queryIsDepth q
-- Any
depth = queryDepth depthq depth = queryDepth depthq
-- Depth 1
symq = dbg "symq" $ filterQuery queryIsSym q symq = dbg "symq" $ filterQuery queryIsSym q
-- Any
ps :: [Posting] = ps :: [Posting] =
dbg "ps" $ dbg "ps" $
@ -90,12 +80,6 @@ periodBalanceReport opts q j = MultiBalanceReport (spans, items, totals)
filterJournalPostingAmounts symq $ -- exclude amount parts excluded by cur: filterJournalPostingAmounts symq $ -- exclude amount parts excluded by cur:
filterJournalPostings nodepthq $ -- exclude unmatched postings, but include all depths filterJournalPostings nodepthq $ -- exclude unmatched postings, but include all depths
journalSelectingAmountFromOpts opts j journalSelectingAmountFromOpts opts j
--
-- [(assets:checking) 1
-- ,(assets:checking) -1
-- ,(assets:cash) 1
-- ,(assets:checking) 1
-- ]
-- the report's span will be the requested span intersected with -- the report's span will be the requested span intersected with
-- the selected data's span; or with -E, the requested span -- the selected data's span; or with -E, the requested span
@ -106,41 +90,18 @@ periodBalanceReport opts q j = MultiBalanceReport (spans, items, totals)
requestedspan = queryDateSpan (date2_ opts) q -- based on -b/-e/-p opts and query args IIRC requestedspan = queryDateSpan (date2_ opts) q -- based on -b/-e/-p opts and query args IIRC
journalspan = journalDateSpan j journalspan = journalDateSpan j
matchedspan = postingsDateSpan ps matchedspan = postingsDateSpan ps
spans :: [DateSpan] = spans :: [DateSpan] =
dbg "spans" $ dbg "spans" $
splitSpan (intervalFromOpts opts) reportspan splitSpan (intervalFromOpts opts) reportspan
-- [DateSpan (Just 2013-01-01) (Just 2013-02-01) -- (reportspan, spans) = dbg "report spans" $ reportSpans opts q j
-- ,DateSpan (Just 2013-02-01) (Just 2013-03-01)
-- ,DateSpan (Just 2013-03-01) (Just 2013-04-01)
-- ]
psBySpan :: [[Posting]] = psPerSpan :: [[Posting]] =
dbg "psBySpan" $ dbg "psPerSpan" $
[filter (isPostingInDateSpan s) ps | s <- spans] [filter (isPostingInDateSpan s) ps | s <- spans]
-- [[(assets:checking) 1, (assets:checking) -1]
-- ,[(assets:cash) 1]
-- ,[(assets:checking) 1]
postedAccts :: [AccountName] = postedAcctBalChangesPerSpan :: [[(ClippedAccountName, MixedAmount)]] =
dbg "postedAccts" $ dbg "postedAcctBalChangesPerSpan" $
sort $ accountNamesFromPostings ps map postingAcctBals psPerSpan
-- [ "assets:cash" , "assets:checking" ]
displayedAccts :: [ClippedAccountName] =
dbg "displayedAccts" $
(if tree_ opts then expandAccountNames else id) $
nub $ map (clipAccountName depth) postedAccts
-- [ "assets" ]
zeroes :: [(ClippedAccountName, MixedAmount)] =
dbg "zeroes" $
[(a, nullmixedamt) | a <- displayedAccts]
-- [ ( "assets" , 0 ) ]
postedAcctBalsBySpan :: [[(ClippedAccountName, MixedAmount)]] =
dbg "postedAcctBalsBySpan" $
[postingAcctBals ps | ps <- psBySpan]
where where
postingAcctBals :: [Posting] -> [(ClippedAccountName, MixedAmount)] postingAcctBals :: [Posting] -> [(ClippedAccountName, MixedAmount)]
postingAcctBals ps = [(aname a, (if tree_ opts then aibalance else aebalance) a) | a <- as] postingAcctBals ps = [(aname a, (if tree_ opts then aibalance else aebalance) a) | a <- as]
@ -151,100 +112,53 @@ periodBalanceReport opts q j = MultiBalanceReport (spans, items, totals)
depthLimit depthLimit
| tree_ opts = filter ((depthq `matchesAccount`).aname) -- exclude deeper balances | tree_ opts = filter ((depthq `matchesAccount`).aname) -- exclude deeper balances
| otherwise = clipAccountsAndAggregate depth -- aggregate deeper balances at the depth limit | otherwise = clipAccountsAndAggregate depth -- aggregate deeper balances at the depth limit
-- [ [ ( "assets" , 0 ) ]
-- , [ ( "assets" , 1 ) ]
-- , [ ( "assets" , 1 ) ]
-- ]
displayedBalsBySpan :: [[(ClippedAccountName, MixedAmount)]] = postedAccts :: [AccountName] =
dbg "displayedBalsBySpan" $ dbg "postedAccts" $
sort $ accountNamesFromPostings ps
displayedAccts :: [ClippedAccountName] =
dbg "displayedAccts" $
(if tree_ opts then expandAccountNames else id) $
nub $ map (clipAccountName depth) postedAccts
acctBalChangesPerSpan :: [[(ClippedAccountName, MixedAmount)]] =
dbg "acctBalChangesPerSpan" $
[sortBy (comparing fst) $ unionBy (\(a,_) (a',_) -> a == a') postedacctbals zeroes [sortBy (comparing fst) $ unionBy (\(a,_) (a',_) -> a == a') postedacctbals zeroes
| postedacctbals <- postedAcctBalsBySpan] | postedacctbals <- postedAcctBalChangesPerSpan]
-- where zeroes = [(a, nullmixedamt) | a <- displayedAccts]
-- [ [ ( "assets" , 0 ) ]
-- , [ ( "assets" , 1 ) ]
-- , [ ( "assets" , 1 ) ]
-- ]
displayedBalsByAcct :: [[(ClippedAccountName, MixedAmount)]] = acctBalChanges :: [(ClippedAccountName, [MixedAmount])] =
dbg "displayedBalsByAcct" $ dbg "acctBalChanges" $
transpose displayedBalsBySpan [(a, map snd abs) | abs@((a,_):_) <- transpose acctBalChangesPerSpan] -- never null, or used when null...
-- [ [ ( "assets" , 0 ) , ( "assets" , 1 ) , ( "assets" , 1 ) ] ]
acctBalsAlist :: [(ClippedAccountName, [MixedAmount])] =
dbg "acctBalsAlist" $
zip displayedAccts (map (map snd) [bs | bs <- displayedBalsByAcct
-- , maybe False ((`elem` postedAccts).fst) $ headMay bs
])
-- [ ( "assets" , [ 0 , 1 , 1 ] ) ]
items :: [MultiBalanceReportRow] =
dbg "items" $
[((a, accountLeafName a, accountNameLevel a), bs) | (a,bs) <- acctBalsAlist, empty_ opts || any (not . isZeroMixedAmount) bs]
-- [ ( ( "assets" , "assets" , 1 ) , [ 0 , 1 , 1 ] ) ]
-- highestLevelBalsBySpan :: [[MixedAmount]] =
-- dbg "highestLevelBalsBySpan" $
-- [[b | (a,b) <- spanbals, not $ any (`elem` postedAccts) $ init $ expandAccountName a] | spanbals <- displayedBalsBySpan]
totals :: [MixedAmount] =
dbg "totals" $
if tree_ opts
then map (sum . map pamount) psBySpan
else map (sum . map snd) displayedBalsBySpan
-- else map sum highestLevelBalsBySpan
-- [ 0 , 1 , 1 ]
-- | Generate a multi balance report for the matched accounts, showing
-- their cumulative or (with -H) historical balance in each of the specified periods.
-- Has the same limitations as periodBalanceReport.
cumulativeOrHistoricalBalanceReport :: ReportOpts -> Query -> Journal -> MultiBalanceReport
cumulativeOrHistoricalBalanceReport opts q j = MultiBalanceReport (periodbalancespans, items, totals)
where
-- dbg = const id -- exclude from debug output
dbg s = let p = "cumulativeOrHistoricalBalanceReport" in Hledger.Utils.dbg (p++" "++s) -- add prefix in debug output
-- select/adjust basic report dates
(reportspan, _) = dbg "report spans" $ reportSpans opts q j
-- starting balances and accounts from transactions before the report start date -- starting balances and accounts from transactions before the report start date
startacctbals = dbg "startacctbals" $ map (\((a,_,_),b) -> (a,b)) $ startbalanceitems startacctbals = dbg "startacctbals" $ map (\((a,_,_),b) -> (a,b)) $ startbalanceitems
where where
dateless = filterQuery (not . queryIsDate) dateless = filterQuery (not . queryIsDate)
precedingq = dbg "precedingq" $ And [dateless q, Date $ DateSpan Nothing (spanStart reportspan)] precedingq = dbg "precedingq" $ And [dateless q, Date $ DateSpan Nothing (spanStart reportspan)]
(startbalanceitems,_) = dbg "starting balance report" $ balanceReport opts{flat_=True,empty_=True} precedingq j -- XXX (startbalanceitems,_) = dbg "starting balance report" $ balanceReport opts' precedingq j
-- acctsWithStartingBalance = map fst $ filter (not . isZeroMixedAmount . snd) startacctbals where
startingBalanceFor a opts' | tree_ opts = opts{no_elide_=True}
| balancetype_ opts == HistoricalBalance = fromMaybe nullmixedamt $ lookup a startacctbals | otherwise = opts{flat_=True}
| otherwise = nullmixedamt startingBalanceFor a = fromMaybe nullmixedamt $ lookup a startacctbals
-- balance changes in each period for each account items :: [MultiBalanceReportRow] =
MultiBalanceReport (periodbalancespans,periodbalanceitems,_) = dbg "balance changes report" $ periodBalanceReport opts q j dbg "items" $
balanceChangesByAcct = map (\((a,_,_),bs) -> (a,bs)) periodbalanceitems [((a, accountLeafName a, accountNameLevel a), displayedBals)
acctsWithBalanceChanges = map fst $ filter ((any (not . isZeroMixedAmount)) . snd) balanceChangesByAcct | (a,changes) <- acctBalChanges
balanceChangesFor a = fromMaybe (error $ "no data for account: a") $ -- XXX , let displayedBals = case balancetype_ opts of
lookup a balanceChangesByAcct HistoricalBalance -> drop 1 $ scanl (+) (startingBalanceFor a) changes
CumulativeBalance -> drop 1 $ scanl (+) nullmixedamt changes
_ -> changes
, empty_ opts || any (not . isZeroMixedAmount) displayedBals
]
-- accounts to report on totals :: [MixedAmount] =
reportaccts = dbg "reportaccts" dbg "totals" $
acctsWithBalanceChanges map sum balsbycol
-- (dbg' "acctsWithStartingBalance" acctsWithStartingBalance) `union` (dbg' "acctsWithBalanceChanges" acctsWithBalanceChanges)
-- ending balances in each period (starting balance plus balance changes) for an account
endingBalancesFor a =
dbg "ending balances" $ drop 1 $ scanl (+) (startingBalanceFor a) $
dbg ("balance changes for "++a) $ balanceChangesFor a
items = dbg "items" $ [((a,a,0), endingBalancesFor a) | a <- reportaccts]
totals = dbg "totals" $
if tree_ opts
then map sum highestlevelbalsbycol
else map sum balsbycol
where where
balsbycol = transpose $ map endingBalancesFor reportaccts balsbycol = transpose [bs | ((a,_,_),bs) <- items, not (tree_ opts) || a `elem` highestlevelaccts]
highestlevelbalsbycol = transpose $ map endingBalancesFor highestlevelaccts
highestlevelaccts = highestlevelaccts =
dbg "highestlevelaccts" $ dbg "highestlevelaccts" $
[a | a <- reportaccts, not $ any (`elem` reportaccts) $ init $ expandAccountName a] [a | a <- displayedAccts, not $ any (`elem` displayedAccts) $ init $ expandAccountName a]

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

@ -288,9 +288,9 @@ balance CliOpts{reportopts_=ropts} j = do
Right _ -> Right _ ->
case (intervalFromOpts ropts, balancetype_ ropts) of case (intervalFromOpts ropts, balancetype_ ropts) of
(NoInterval,_) -> balanceReportAsText ropts $ balanceReport ropts (queryFromOpts d ropts) j (NoInterval,_) -> balanceReportAsText ropts $ balanceReport ropts (queryFromOpts d ropts) j
(_,PeriodBalance) -> periodBalanceReportAsText ropts $ periodBalanceReport ropts (queryFromOpts d ropts) j (_,PeriodBalance) -> periodBalanceReportAsText ropts $ multiBalanceReport ropts (queryFromOpts d ropts) j
(_,CumulativeBalance) -> cumulativeBalanceReportAsText ropts $ cumulativeOrHistoricalBalanceReport ropts (queryFromOpts d ropts) j (_,CumulativeBalance) -> cumulativeBalanceReportAsText ropts $ multiBalanceReport ropts (queryFromOpts d ropts) j
(_,HistoricalBalance) -> historicalBalanceReportAsText ropts $ cumulativeOrHistoricalBalanceReport ropts (queryFromOpts d ropts) j (_,HistoricalBalance) -> historicalBalanceReportAsText ropts $ multiBalanceReport ropts (queryFromOpts d ropts) j
putStr $ unlines output putStr $ unlines output
-- | Render an old-style single-column balance report as plain text. -- | Render an old-style single-column balance report as plain text.

46
tests/balance-multicol.test
View File

@ -191,3 +191,49 @@ Ending balance (historical):
|| 10 12 13 || 10 12 13
>>>=0 >>>=0
# 14. The three multicol balance report types again, this time with --tree
hledgerdev -f data/balance-multicol.journal balance -p 'monthly in 2013' --tree
>>>
Change of balance (flow):
|| 2013/01/01-2013/01/31 2013/02/01-2013/02/28 2013/03/01-2013/03/31
============++======================================================================
assets || 0 2 1
cash || 0 1 0
checking || 0 0 1
------------++----------------------------------------------------------------------
|| 0 2 1
>>>=0
# 15.
hledgerdev -f data/balance-multicol.journal balance -p 'monthly in 2013' --cumulative --tree
>>>
Ending balance (cumulative):
|| 2013/01/31 2013/02/28 2013/03/31
============++=====================================
assets || 0 2 3
cash || 0 1 1
checking || 0 0 1
------------++-------------------------------------
|| 0 2 3
>>>=0
# 16.
hledgerdev -f data/balance-multicol.journal balance -p 'monthly in 2013' --historical --tree
>>>
Ending balance (historical):
|| 2013/01/31 2013/02/28 2013/03/31
============++=====================================
assets || 10 12 13
cash || 0 1 1
checking || 10 10 11
------------++-------------------------------------
|| 10 12 13
>>>=0