lib: For MultiBalanceReport, report change in valuation rather than valuation of change.
This commit is contained in:
		
							parent
							
								
									524e23bc37
								
							
						
					
					
						commit
						35a83fbd8c
					
				| @ -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 | ||||||
|  | |||||||
| @ -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 | ||||||
|  | |||||||
		Loading…
	
		Reference in New Issue
	
	Block a user