lib: For MultiBalanceReport, report change in valuation rather than valuation of change.

This commit is contained in:
Stephen Morgan 2020-10-26 23:47:50 +11:00 committed by Simon Michael
parent 524e23bc37
commit 35a83fbd8c
2 changed files with 55 additions and 32 deletions

View File

@ -51,7 +51,7 @@ import Data.Semigroup ((<>))
#endif #endif
import Data.Semigroup (sconcat) import Data.Semigroup (sconcat)
import Data.Time.Calendar (Day, addDays, fromGregorian) import Data.Time.Calendar (Day, addDays, fromGregorian)
import Safe (headMay, lastDef, lastMay) import Safe (headMay, lastDef, lastMay, minimumMay)
import Hledger.Data import Hledger.Data
import Hledger.Query import Hledger.Query
@ -339,34 +339,57 @@ accumValueAmounts :: ReportOpts -> (Day -> MixedAmount -> MixedAmount) -> [DateS
-> HashMap ClippedAccountName (Map DateSpan Account) -> HashMap ClippedAccountName (Map DateSpan Account)
-> HashMap ClippedAccountName (Map DateSpan Account) -> HashMap ClippedAccountName (Map DateSpan Account)
accumValueAmounts ropts valuation colspans startbals acctchanges = -- PARTIAL: accumValueAmounts ropts valuation colspans startbals acctchanges = -- PARTIAL:
HM.mapWithKey processRow $ acctchanges <> (mempty <$ startbals) HM.mapWithKey rowbals $ acctchanges <> (mempty <$ startbals)
where where
-- Must accumulate before valuing, since valuation can change without any
-- postings. Make sure every column has an entry.
processRow name changes = M.mapWithKey valueAcct . rowbals name $ changes <> 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 HistoricalBalance -> historical
CumulativeChange -> snd $ M.mapAccum f nullacct changes CumulativeChange -> cumulative
HistoricalBalance -> snd $ M.mapAccum f (startingBalanceFor name) changes PeriodChange -> changeamts
where f a b = let s = sumAcct a b in (s, s) where
-- Calculate the valued historical balance in each column, ensuring every
-- columns has an entry.
historical = cumulativeSum startingBalance
-- If no valuation can sum the changes directly, otherwise need to
-- subtract the valued starting amount from the historical sum
cumulative = case value_ ropts of
Nothing -> cumulativeSum nullacct
Just _ -> fmap (`subtractAcct` valuedStart) historical
-- If no valuation can use the change list directly, otherwise need to
-- calculate the incremental differences in the historical sum
changeamts = case value_ ropts of
Nothing -> changes
Just _ -> let (dates, histamts) = unzip $ M.toAscList historical
in M.fromDistinctAscList . zip dates $
zipWith subtractAcct histamts (valuedStart:histamts)
cumulativeSum start = snd $ M.mapAccumWithKey accumValued start changes
where accumValued startAmt date newAmt = (s, valueAcct date s)
where s = sumAcct startAmt newAmt
changes = changes' <> zeros
startingBalance = HM.lookupDefault nullacct name startbals
valuedStart = valueAcct (DateSpan Nothing historicalDate) startingBalance
-- Add the values of two accounts. Should be right-biased, since it's used -- 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 -- 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} = sumAcct Account{aibalance=i1,aebalance=e1} a@Account{aibalance=i2,aebalance=e2} =
a{aibalance = i1 + i2, aebalance = e1 + e2} a{aibalance = i1 + i2, aebalance = e1 + e2}
-- Subtract the values in one account from another. Should be left-biased.
subtractAcct a@Account{aibalance=i1,aebalance=e1} 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)) acct = valueAcct (DateSpan _ (Just end)) acct =
acct{aibalance = value (aibalance acct), aebalance = value (aebalance acct)} acct{aibalance = value (aibalance acct), aebalance = value (aebalance acct)}
where value = valuation (addDays (-1) end) where value = valuation (addDays (-1) end)
valueAcct _ _ = error "multiBalanceReport: expected all spans to have an end date" -- XXX should not happen valueAcct _ _ = error "multiBalanceReport: expected all spans to have an end date" -- XXX should not happen
startingBalanceFor a = HM.lookupDefault nullacct a startbals
zeros = M.fromList [(span, nullacct) | span <- colspans] zeros = M.fromList [(span, nullacct) | span <- colspans]
historicalDate = minimumMay $ mapMaybe spanStart colspans
-- | Lay out a set of postings grouped by date span into a regular matrix with rows -- | Lay out a set of postings grouped by date span into a regular matrix with rows

View File

@ -380,20 +380,20 @@ $ hledger -f- bal -M --value=end
Balance changes in 2000Q1, valued at period ends: Balance changes in 2000Q1, valued at period ends:
|| Jan Feb Mar || Jan Feb Mar
===++=============== ===++================
a || 5 B 2 B 3 B a || 5 B -1 B 5 B
---++--------------- ---++----------------
|| 5 B 2 B 3 B || 5 B -1 B 5 B
# 36. multicolumn balance report valued at period end with -T or -A # 36. multicolumn balance report valued at period end with -T or -A
$ hledger -f- bal -MTA --value=end $ hledger -f- bal -MTA --value=end
Balance changes in 2000Q1, valued at period ends: Balance changes in 2000Q1, valued at period ends:
|| Jan Feb Mar Total Average || Jan Feb Mar Total Average
===++================================= ===++==================================
a || 5 B 2 B 3 B 10 B 3 B a || 5 B -1 B 5 B 9 B 3 B
---++--------------------------------- ---++----------------------------------
|| 5 B 2 B 3 B 10 B 3 B || 5 B -1 B 5 B 9 B 3 B
# 37. multicolumn balance report valued at other date # 37. multicolumn balance report valued at other date
$ hledger -f- bal -MTA --value=2000-01-15 $ hledger -f- bal -MTA --value=2000-01-15
@ -420,10 +420,10 @@ $ hledger -f- bal -M -V
Balance changes in 2000Q1, valued at period ends: Balance changes in 2000Q1, valued at period ends:
|| Jan Feb Mar || Jan Feb Mar
===++=============== ===++================
a || 5 B 2 B 3 B a || 5 B -1 B 5 B
---++--------------- ---++----------------
|| 5 B 2 B 3 B || 5 B -1 B 5 B
# balance, periodic, with -H (starting balance and accumulating across periods) # balance, periodic, with -H (starting balance and accumulating across periods)
@ -552,10 +552,10 @@ $ hledger -f- bal -MTA --budget --value=e
Budget performance in 2000Q1, valued at period ends: Budget performance in 2000Q1, valued at period ends:
|| Jan Feb Mar Total Average || Jan Feb Mar Total Average
===++============================================================================================= ===++===============================================================================================
a || 5 B [50% of 10 B] 2 B [50% of 4 B] 3 B [50% of 6 B] 10 B [50% of 20 B] 3 B [50% of 7 B] a || 5 B [50% of 10 B] -1 B [50% of -2 B] 5 B [50% of 10 B] 9 B [50% of 18 B] 3 B [50% of 6 B]
---++--------------------------------------------------------------------------------------------- ---++-----------------------------------------------------------------------------------------------
|| 5 B [50% of 10 B] 2 B [50% of 4 B] 3 B [50% of 6 B] 10 B [50% of 20 B] 3 B [50% of 7 B] || 5 B [50% of 10 B] -1 B [50% of -2 B] 5 B [50% of 10 B] 9 B [50% of 18 B] 3 B [50% of 6 B]
# 49. budget report, valued at other date. # 49. budget report, valued at other date.
$ hledger -f- bal -MTA --budget --value=2000-01-15 $ hledger -f- bal -MTA --budget --value=2000-01-15