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

This commit is contained in:
Stephen Morgan 2020-06-12 17:26:27 +10:00
parent 0e89a389d6
commit 1e7e80504f

View File

@ -115,10 +115,10 @@ multiBalanceReportWith ropts@ReportOpts{..} q j priceoracle = report
acctchanges = dbg'' "acctchanges" $ calculateAccountChanges ropts q startbals colps
-- 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.
displayaccts = dbg'' "displayaccts" $ displayedAccounts ropts q startbals ps
displayaccts = dbg'' "displayaccts" $ displayedAccounts ropts q startbals accumvalued
-- All the rows of the report.
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.
-- 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
where
acctchanges = acctChangesFromPostings ropts'' startbalq . map fst $
@ -233,56 +233,62 @@ calculateColumns colspans = foldr addPosting emptyMap
-- | Calculate account balance changes in each column.
--
-- In each column, gather the accounts that have postings and their change amount.
acctChangesFromPostings :: ReportOpts -> Query -> [Posting] -> HashMap ClippedAccountName MixedAmount
acctChangesFromPostings ropts q ps =
HM.fromList [(aname a, (if tree_ ropts then aibalance else aebalance) a) | a <- as]
acctChangesFromPostings :: ReportOpts -> Query -> [Posting] -> HashMap ClippedAccountName Account
acctChangesFromPostings ropts q ps = HM.fromList [(aname a, a) | a <- as]
where
as = depthLimit $
(if tree_ ropts then id else filter ((>0).anumpostings)) $
drop 1 $ accountsFromPostings ps
depthLimit
| tree_ ropts = filter ((depthq `matchesAccount`) . aname) -- exclude deeper balances
| otherwise = clipAccountsAndAggregate $ queryDepth depthq -- aggregate deeper balances at the depth limit
as = filterAccounts . drop 1 $ accountsFromPostings ps
filterAccounts
| tree_ ropts = filter ((depthq `matchesAccount`) . aname) -- exclude deeper balances
| otherwise = clipAccountsAndAggregate (queryDepth depthq) . -- aggregate deeper balances at the depth limit.
filter ((0<) . anumpostings)
depthq = dbg "depthq" $ filterQuery queryIsDepth q
-- | Gather the account balance changes into a regular matrix including the accounts
-- from all columns
calculateAccountChanges :: ReportOpts -> Query
-> HashMap ClippedAccountName MixedAmount
-> HashMap ClippedAccountName Account
-> Map DateSpan [Posting]
-> HashMap ClippedAccountName (Map DateSpan MixedAmount)
-> HashMap ClippedAccountName (Map DateSpan Account)
calculateAccountChanges ropts q startbals colps = acctchanges
where
-- 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
zeros = nullmixedamt <$ colacctchanges
-- | Accumulate and value amounts, as specified by the report options.
accumValueAmounts :: ReportOpts -> Journal -> PriceOracle
-> HashMap ClippedAccountName MixedAmount
-> HashMap ClippedAccountName (Map DateSpan MixedAmount)
-> HashMap ClippedAccountName [MixedAmount]
accumValueAmounts ropts j priceoracle startbals = HM.mapWithKey processRow
--
-- Makes sure all report columns have an entry.
accumValueAmounts :: ReportOpts -> Journal -> PriceOracle -> [DateSpan]
-> HashMap ClippedAccountName Account
-> HashMap ClippedAccountName (Map DateSpan Account)
-> HashMap ClippedAccountName [Account]
accumValueAmounts ropts j priceoracle colspans startbals = HM.mapWithKey processRow
where
-- Must accumulate before valuing, since valuation can change without any
-- postings
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,
-- zero-based cumulative totals, or
-- starting-balance-based historical balances.
rowbals name changes = dbg'' "rowbals" $ case balancetype_ ropts of
PeriodChange -> changes
CumulativeChange -> drop 1 $ scanl (+) 0 changes
HistoricalBalance -> drop 1 $ scanl (+) (startingBalanceFor name) changes
CumulativeChange -> drop 1 $ scanl sumAcct nullacct 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".
valueAcct (DateSpan _ (Just end)) = avalue periodlast
where periodlast = addDays (-1) end
valueAcct _ = error' "multiBalanceReport: expected all spans to have an end date" -- XXX should not happen
valueAcct (DateSpan _ (Just end)) acct =
acct{aibalance = value (aibalance acct), aebalance = value (aebalance acct)}
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
(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
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.
--
-- 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 =
[ 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.
-- These are always simply the sum/average of the displayed row amounts.
-- Total for a cumulative/historical report is always zero.
@ -310,21 +321,24 @@ buildReportRows ropts q acctvalues =
, let rowavg = averageMixedAmounts rowbals
, 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
-> HashMap AccountName MixedAmount
-> [(Posting, Day)]
-> [AccountName]
displayedAccounts ropts q startbals ps =
-> HashMap AccountName Account
-> HashMap AccountName [Account]
-> HashMap AccountName (AccountName, Int)
displayedAccounts ropts q startbals valuedaccts =
HM.fromList $ map (\a -> (a, (a, 0))) .
(if tree_ ropts then expandAccountNames else id) $
nub $ map (clipOrEllipsifyAccountName depth) $
if empty_ ropts || balancetype_ ropts == HistoricalBalance
then nubSort $ (HM.keys startbals) ++ allpostedaccts
else allpostedaccts
where
allpostedaccts :: [AccountName] =
dbg'' "allpostedaccts" . sort . accountNamesFromPostings $ map fst ps
allpostedaccts = dbg'' "allpostedaccts" $ HM.keys valuedaccts
depth = queryDepth q
-- | 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.
--
-- Calculate the column totals. These are always the sum of column amounts.
calculateTotalsRow :: ReportOpts -> [ClippedAccountName]
calculateTotalsRow :: ReportOpts -> HashMap ClippedAccountName (ClippedAccountName, Int)
-> [MultiBalanceReportRow] -> PeriodicReportRow () MixedAmount
calculateTotalsRow ropts displayaccts rows =
PeriodicReportRow () 0 coltotals grandtotal grandaverage
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
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
@ -418,16 +433,16 @@ balanceReportFromMultiBalanceReport opts q j = (rows', total)
-- | 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
where
addSpan span acctmap seen = HM.foldrWithKey (addAcctSpan span) seen acctmap
addAcctSpan span acct a = HM.alter f acct
where f = Just . M.insert span a . fromMaybe emptySpanMap
emptySpanMap = nullmixedamt <$ xs
where f = Just . M.insert span a . fromMaybe mempty
-- | 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.