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

lib: multiBalanceReport: Keep Account around longer so we can use both aibalance and aebalance.

Browse Source
This commit is contained in:
Stephen Morgan 2020-06-12 17:26:27 +10:00
parent 0e89a389d6
commit 1e7e80504f
1 changed files with 62 additions and 47 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -115,10 +115,10 @@ multiBalanceReportWith ropts@ReportOpts{..} q j priceoracle = report
acctchanges = dbg'' "acctchanges" $ calculateAccountChanges ropts q startbals colps acctchanges = dbg'' "acctchanges" $ calculateAccountChanges ropts q startbals colps
-- Process changes into normal, cumulative, or historical amounts, plus value them -- Process changes into normal, cumulative, or historical amounts, plus value them
accumvalued = dbg'' "accumvalued" $ accumValueAmounts ropts j priceoracle startbals acctchanges accumvalued = dbg'' "accumvalued" $ accumValueAmounts ropts j priceoracle colspans startbals acctchanges
-- All account names that will be displayed, possibly depth-clipped. -- All account names that will be displayed, possibly depth-clipped.
displayaccts = dbg'' "displayaccts" $ displayedAccounts ropts q startbals ps displayaccts = dbg'' "displayaccts" $ displayedAccounts ropts q startbals accumvalued
-- All the rows of the report. -- All the rows of the report.
rows = dbg'' "rows" $ buildReportRows ropts reportq accumvalued rows = dbg'' "rows" $ buildReportRows ropts reportq accumvalued
@ -171,7 +171,7 @@ makeReportQuery ropts reportspan q
-- --
-- Balances at report start date, from all earlier postings which otherwise match the query. -- Balances at report start date, from all earlier postings which otherwise match the query.
-- These balances are unvalued except maybe converted to cost. -- These balances are unvalued except maybe converted to cost.
startingBalances :: ReportOpts -> Query -> Journal -> DateSpan -> HashMap AccountName MixedAmount startingBalances :: ReportOpts -> Query -> Journal -> DateSpan -> HashMap AccountName Account
startingBalances ropts q j reportspan = acctchanges startingBalances ropts q j reportspan = acctchanges
where where
acctchanges = acctChangesFromPostings ropts'' startbalq . map fst $ acctchanges = acctChangesFromPostings ropts'' startbalq . map fst $
@ -233,56 +233,62 @@ calculateColumns colspans = foldr addPosting emptyMap
-- | Calculate account balance changes in each column. -- | Calculate account balance changes in each column.
-- --
-- In each column, gather the accounts that have postings and their change amount. -- In each column, gather the accounts that have postings and their change amount.
acctChangesFromPostings :: ReportOpts -> Query -> [Posting] -> HashMap ClippedAccountName MixedAmount acctChangesFromPostings :: ReportOpts -> Query -> [Posting] -> HashMap ClippedAccountName Account
acctChangesFromPostings ropts q ps = acctChangesFromPostings ropts q ps = HM.fromList [(aname a, a) | a <- as]
HM.fromList [(aname a, (if tree_ ropts then aibalance else aebalance) a) | a <- as]
where where
as = depthLimit $ as = filterAccounts . drop 1 $ accountsFromPostings ps
(if tree_ ropts then id else filter ((>0).anumpostings)) $ filterAccounts
drop 1 $ accountsFromPostings ps | tree_ ropts = filter ((depthq `matchesAccount`) . aname) -- exclude deeper balances
depthLimit | otherwise = clipAccountsAndAggregate (queryDepth depthq) . -- aggregate deeper balances at the depth limit.
| tree_ ropts = filter ((depthq `matchesAccount`) . aname) -- exclude deeper balances filter ((0<) . anumpostings)
| otherwise = clipAccountsAndAggregate $ queryDepth depthq -- aggregate deeper balances at the depth limit
depthq = dbg "depthq" $ filterQuery queryIsDepth q depthq = dbg "depthq" $ filterQuery queryIsDepth q
-- | Gather the account balance changes into a regular matrix including the accounts -- | Gather the account balance changes into a regular matrix including the accounts
-- from all columns -- from all columns
calculateAccountChanges :: ReportOpts -> Query calculateAccountChanges :: ReportOpts -> Query
-> HashMap ClippedAccountName MixedAmount -> HashMap ClippedAccountName Account
-> Map DateSpan [Posting] -> Map DateSpan [Posting]
-> HashMap ClippedAccountName (Map DateSpan MixedAmount) -> HashMap ClippedAccountName (Map DateSpan Account)
calculateAccountChanges ropts q startbals colps = acctchanges calculateAccountChanges ropts q startbals colps = acctchanges
where where
-- Transpose to get each account's balance changes across all columns. -- Transpose to get each account's balance changes across all columns.
acctchanges = transposeMap colacctchanges <> (zeros <$ startbals) acctchanges = transposeMap colacctchanges <> (mempty <$ startbals)
colacctchanges :: Map DateSpan (HashMap ClippedAccountName MixedAmount) = colacctchanges :: Map DateSpan (HashMap ClippedAccountName Account) =
dbg'' "colacctchanges" $ fmap (acctChangesFromPostings ropts q) colps dbg'' "colacctchanges" $ fmap (acctChangesFromPostings ropts q) colps
zeros = nullmixedamt <$ colacctchanges
-- | Accumulate and value amounts, as specified by the report options. -- | Accumulate and value amounts, as specified by the report options.
accumValueAmounts :: ReportOpts -> Journal -> PriceOracle --
-> HashMap ClippedAccountName MixedAmount -- Makes sure all report columns have an entry.
-> HashMap ClippedAccountName (Map DateSpan MixedAmount) accumValueAmounts :: ReportOpts -> Journal -> PriceOracle -> [DateSpan]
-> HashMap ClippedAccountName [MixedAmount] -> HashMap ClippedAccountName Account
accumValueAmounts ropts j priceoracle startbals = HM.mapWithKey processRow -> HashMap ClippedAccountName (Map DateSpan Account)
-> HashMap ClippedAccountName [Account]
accumValueAmounts ropts j priceoracle colspans startbals = HM.mapWithKey processRow
where where
-- Must accumulate before valuing, since valuation can change without any
-- postings
processRow name col = zipWith valueAcct spans $ rowbals name amts processRow name col = zipWith valueAcct spans $ rowbals name amts
where (spans, amts) = unzip $ M.toList col where (spans, amts) = unzip . M.toList $ col <> zeros
-- The row amounts to be displayed: per-period changes, -- The row amounts to be displayed: per-period changes,
-- zero-based cumulative totals, or -- zero-based cumulative totals, or
-- starting-balance-based historical balances. -- starting-balance-based historical balances.
rowbals name changes = dbg'' "rowbals" $ case balancetype_ ropts of rowbals name changes = dbg'' "rowbals" $ case balancetype_ ropts of
PeriodChange -> changes PeriodChange -> changes
CumulativeChange -> drop 1 $ scanl (+) 0 changes CumulativeChange -> drop 1 $ scanl sumAcct nullacct changes
HistoricalBalance -> drop 1 $ scanl (+) (startingBalanceFor name) changes HistoricalBalance -> drop 1 $ scanl sumAcct (startingBalanceFor name) changes
-- Add the values of two accounts. Should be right-biased, since it's used
-- in scanl, so other properties (such as anumpostings) stay in the right place
sumAcct Account{aibalance=i1,aebalance=e1} a@Account{aibalance=i2,aebalance=e2} =
a{aibalance = i1 + i2, aebalance = e1 + e2}
-- We may be converting amounts to value, per hledger_options.m4.md "Effect of --value on reports". -- We may be converting amounts to value, per hledger_options.m4.md "Effect of --value on reports".
valueAcct (DateSpan _ (Just end)) = avalue periodlast valueAcct (DateSpan _ (Just end)) acct =
where periodlast = addDays (-1) end acct{aibalance = value (aibalance acct), aebalance = value (aebalance acct)}
valueAcct _ = error' "multiBalanceReport: expected all spans to have an end date" -- XXX should not happen where value = avalue (addDays (-1) end)
valueAcct _ _ = error' "multiBalanceReport: expected all spans to have an end date" -- XXX should not happen
avalue periodlast = maybe id avalue periodlast = maybe id
(mixedAmountApplyValuation priceoracle styles periodlast mreportlast today multiperiod) $ (mixedAmountApplyValuation priceoracle styles periodlast mreportlast today multiperiod) $
@ -294,15 +300,20 @@ accumValueAmounts ropts j priceoracle startbals = HM.mapWithKey processRow
today = fromMaybe (error' "multiBalanceReport: could not pick a valuation date, ReportOpts today_ is unset") $ today_ ropts -- XXX shouldn't happen today = fromMaybe (error' "multiBalanceReport: could not pick a valuation date, ReportOpts today_ is unset") $ today_ ropts -- XXX shouldn't happen
multiperiod = interval_ ropts /= NoInterval multiperiod = interval_ ropts /= NoInterval
startingBalanceFor a = HM.lookupDefault nullmixedamt a startbals startingBalanceFor a = HM.lookupDefault nullacct a startbals
zeros = M.fromList [(span, nullacct) | span <- colspans]
-- | Build the report rows. -- | Build the report rows.
-- --
-- One row per account, with account name info, row amounts, row total and row average. -- One row per account, with account name info, row amounts, row total and row average.
buildReportRows :: ReportOpts -> Query -> HashMap AccountName [MixedAmount] -> [MultiBalanceReportRow] buildReportRows :: ReportOpts -> Query
-> HashMap AccountName [Account]
-> [MultiBalanceReportRow]
buildReportRows ropts q acctvalues = buildReportRows ropts q acctvalues =
[ PeriodicReportRow a (accountNameLevel a) rowbals rowtot rowavg [ PeriodicReportRow a (accountNameLevel a) rowbals rowtot rowavg
| (a,rowbals) <- HM.toList acctvalues | (a,accts) <- HM.toList acctvalues
, let rowbals = map balance accts
-- The total and average for the row. -- The total and average for the row.
-- These are always simply the sum/average of the displayed row amounts. -- These are always simply the sum/average of the displayed row amounts.
-- Total for a cumulative/historical report is always zero. -- Total for a cumulative/historical report is always zero.
@ -310,21 +321,24 @@ buildReportRows ropts q acctvalues =
, let rowavg = averageMixedAmounts rowbals , let rowavg = averageMixedAmounts rowbals
, empty_ ropts || queryDepth q == 0 || any (not . mixedAmountLooksZero) rowbals -- TODO: Remove this eventually, to be handled elswhere , empty_ ropts || queryDepth q == 0 || any (not . mixedAmountLooksZero) rowbals -- TODO: Remove this eventually, to be handled elswhere
] ]
where
balance = if tree_ ropts then aibalance else aebalance
-- | Calculate accounts which are to be displayed in the report -- | Calculate accounts which are to be displayed in the report, as well as
-- their name and depth
displayedAccounts :: ReportOpts -> Query displayedAccounts :: ReportOpts -> Query
-> HashMap AccountName MixedAmount -> HashMap AccountName Account
-> [(Posting, Day)] -> HashMap AccountName [Account]
-> [AccountName] -> HashMap AccountName (AccountName, Int)
displayedAccounts ropts q startbals ps = displayedAccounts ropts q startbals valuedaccts =
HM.fromList $ map (\a -> (a, (a, 0))) .
(if tree_ ropts then expandAccountNames else id) $ (if tree_ ropts then expandAccountNames else id) $
nub $ map (clipOrEllipsifyAccountName depth) $ nub $ map (clipOrEllipsifyAccountName depth) $
if empty_ ropts || balancetype_ ropts == HistoricalBalance if empty_ ropts || balancetype_ ropts == HistoricalBalance
then nubSort $ (HM.keys startbals) ++ allpostedaccts then nubSort $ (HM.keys startbals) ++ allpostedaccts
else allpostedaccts else allpostedaccts
where where
allpostedaccts :: [AccountName] = allpostedaccts = dbg'' "allpostedaccts" $ HM.keys valuedaccts
dbg'' "allpostedaccts" . sort . accountNamesFromPostings $ map fst ps
depth = queryDepth q depth = queryDepth q
-- | Sort the rows by amount or by account declaration order. This is a bit tricky. -- | Sort the rows by amount or by account declaration order. This is a bit tricky.
@ -368,15 +382,16 @@ sortRows ropts j
-- | Build the report totals row. -- | Build the report totals row.
-- --
-- Calculate the column totals. These are always the sum of column amounts. -- Calculate the column totals. These are always the sum of column amounts.
calculateTotalsRow :: ReportOpts -> [ClippedAccountName] calculateTotalsRow :: ReportOpts -> HashMap ClippedAccountName (ClippedAccountName, Int)
-> [MultiBalanceReportRow] -> PeriodicReportRow () MixedAmount -> [MultiBalanceReportRow] -> PeriodicReportRow () MixedAmount
calculateTotalsRow ropts displayaccts rows = calculateTotalsRow ropts displayaccts rows =
PeriodicReportRow () 0 coltotals grandtotal grandaverage PeriodicReportRow () 0 coltotals grandtotal grandaverage
where where
highestlevelaccts = [a | a <- displayaccts, not $ any (`elem` displayaccts) $ init $ expandAccountName a] highestlevelaccts = HM.filterWithKey (\a _ -> isHighest a) displayaccts
where isHighest = not . any (`HM.member` displayaccts) . init . expandAccountName
colamts = transpose . map prrAmounts $ filter isHighest rows colamts = transpose . map prrAmounts $ filter isHighest rows
where isHighest row = not (tree_ ropts) || prrName row `elem` highestlevelaccts where isHighest row = not (tree_ ropts) || prrName row `HM.member` highestlevelaccts
coltotals :: [MixedAmount] = dbg'' "coltotals" $ map sum colamts coltotals :: [MixedAmount] = dbg'' "coltotals" $ map sum colamts
@ -418,16 +433,16 @@ balanceReportFromMultiBalanceReport opts q j = (rows', total)
-- | Transpose a Map of HashMaps to a HashMap of Maps. -- | Transpose a Map of HashMaps to a HashMap of Maps.
transposeMap :: Map DateSpan (HashMap AccountName MixedAmount) --
-> HashMap AccountName (Map DateSpan MixedAmount) -- Makes sure that all DateSpans are present in all rows.
transposeMap :: Map DateSpan (HashMap AccountName a)
-> HashMap AccountName (Map DateSpan a)
transposeMap xs = M.foldrWithKey addSpan mempty xs transposeMap xs = M.foldrWithKey addSpan mempty xs
where where
addSpan span acctmap seen = HM.foldrWithKey (addAcctSpan span) seen acctmap addSpan span acctmap seen = HM.foldrWithKey (addAcctSpan span) seen acctmap
addAcctSpan span acct a = HM.alter f acct addAcctSpan span acct a = HM.alter f acct
where f = Just . M.insert span a . fromMaybe emptySpanMap where f = Just . M.insert span a . fromMaybe mempty
emptySpanMap = nullmixedamt <$ xs
-- | A sorting helper: sort a list of things (eg report rows) keyed by account name -- | A sorting helper: sort a list of things (eg report rows) keyed by account name
-- to match the provided ordering of those same account names. -- to match the provided ordering of those same account names.