From 83110e88203b991c9a638adbd44ed57b9bdd2092 Mon Sep 17 00:00:00 2001 From: Stephen Morgan Date: Wed, 30 Dec 2020 16:04:08 +1100 Subject: [PATCH] lib,cli: Extend AtThen valuation to all report types. Also adds a postingDate argument to amountApplyValuation, and re-orders the ValuationType and (Transaction/Posting) arguments to (transaction/posting)ApplyValuation, to be consistent with amountApplyValuation. --- hledger-lib/Hledger/Data/Posting.hs | 20 +- hledger-lib/Hledger/Data/Transaction.hs | 6 +- hledger-lib/Hledger/Data/Valuation.hs | 25 +-- .../Reports/AccountTransactionsReport.hs | 4 +- hledger-lib/Hledger/Reports/BudgetReport.hs | 2 +- hledger-lib/Hledger/Reports/EntriesReport.hs | 4 +- .../Hledger/Reports/MultiBalanceReport.hs | 193 +++++++++--------- hledger-lib/Hledger/Reports/PostingsReport.hs | 26 ++- hledger-ui/Hledger/UI/TransactionScreen.hs | 3 +- hledger/Hledger/Cli/Commands/Balance.hs | 2 +- hledger/Hledger/Cli/CompoundBalanceCommand.hs | 2 +- hledger/test/journal/valuation.test | 8 +- 12 files changed, 133 insertions(+), 162 deletions(-) diff --git a/hledger-lib/Hledger/Data/Posting.hs b/hledger-lib/Hledger/Data/Posting.hs index 6c459e715..581536790 100644 --- a/hledger-lib/Hledger/Data/Posting.hs +++ b/hledger-lib/Hledger/Data/Posting.hs @@ -334,28 +334,14 @@ aliasReplace (RegexAlias re repl) a = -- provided price oracle, commodity styles, reference dates, and -- whether this is for a multiperiod report or not. See -- amountApplyValuation. -postingApplyValuation :: PriceOracle -> M.Map CommoditySymbol AmountStyle -> Day -> Day -> Posting -> ValuationType -> Posting -postingApplyValuation priceoracle styles periodlast today p v = - case v of - AtCost Nothing -> postingToCost styles p - AtCost mc -> postingValueAtDate priceoracle styles mc periodlast $ postingToCost styles p - AtThen mc -> postingValueAtDate priceoracle styles mc (postingDate p) p - AtEnd mc -> postingValueAtDate priceoracle styles mc periodlast p - AtNow mc -> postingValueAtDate priceoracle styles mc today p - AtDate d mc -> postingValueAtDate priceoracle styles mc d p +postingApplyValuation :: PriceOracle -> M.Map CommoditySymbol AmountStyle -> Day -> Day -> ValuationType -> Posting -> Posting +postingApplyValuation priceoracle styles periodlast today v p = + postingTransformAmount (mixedAmountApplyValuation priceoracle styles periodlast today (postingDate p) v) p -- | Convert this posting's amount to cost, and apply the appropriate amount styles. postingToCost :: M.Map CommoditySymbol AmountStyle -> Posting -> Posting postingToCost styles p@Posting{pamount=a} = p{pamount=styleMixedAmount styles $ mixedAmountCost a} --- | Convert this posting's amount to market value in the given commodity, --- or the default valuation commodity, at the given valuation date, --- using the given market price oracle. --- When market prices available on that date are not sufficient to --- calculate the value, amounts are left unchanged. -postingValueAtDate :: PriceOracle -> M.Map CommoditySymbol AmountStyle -> Maybe CommoditySymbol -> Day -> Posting -> Posting -postingValueAtDate priceoracle styles mc d p = postingTransformAmount (mixedAmountValueAtDate priceoracle styles mc d) p - -- | Apply a transform function to this posting's amount. postingTransformAmount :: (MixedAmount -> MixedAmount) -> Posting -> Posting postingTransformAmount f p@Posting{pamount=a} = p{pamount=f a} diff --git a/hledger-lib/Hledger/Data/Transaction.hs b/hledger-lib/Hledger/Data/Transaction.hs index 0b0186904..5fc467fb7 100644 --- a/hledger-lib/Hledger/Data/Transaction.hs +++ b/hledger-lib/Hledger/Data/Transaction.hs @@ -594,9 +594,9 @@ transactionTransformPostings f t@Transaction{tpostings=ps} = t{tpostings=map f p -- the provided price oracle, commodity styles, reference dates, and -- whether this is for a multiperiod report or not. See -- amountApplyValuation. -transactionApplyValuation :: PriceOracle -> M.Map CommoditySymbol AmountStyle -> Day -> Day -> Transaction -> ValuationType -> Transaction -transactionApplyValuation priceoracle styles periodlast today t v = - transactionTransformPostings (\p -> postingApplyValuation priceoracle styles periodlast today p v) t +transactionApplyValuation :: PriceOracle -> M.Map CommoditySymbol AmountStyle -> Day -> Day -> ValuationType -> Transaction -> Transaction +transactionApplyValuation priceoracle styles periodlast today v = + transactionTransformPostings (postingApplyValuation priceoracle styles periodlast today v) -- | Convert this transaction's amounts to cost, and apply the appropriate amount styles. transactionToCost :: M.Map CommoditySymbol AmountStyle -> Transaction -> Transaction diff --git a/hledger-lib/Hledger/Data/Valuation.hs b/hledger-lib/Hledger/Data/Valuation.hs index 306d26dd6..51d2f8656 100644 --- a/hledger-lib/Hledger/Data/Valuation.hs +++ b/hledger-lib/Hledger/Data/Valuation.hs @@ -16,7 +16,6 @@ module Hledger.Data.Valuation ( ValuationType(..) ,PriceOracle ,journalPriceOracle - ,unsupportedValueThenError -- ,amountApplyValuation -- ,amountValueAtDate ,mixedAmountApplyValuation @@ -98,9 +97,9 @@ priceDirectiveToMarketPrice PriceDirective{..} = -- provided price oracle, commodity styles, reference dates, and -- whether this is for a multiperiod report or not. -- See amountApplyValuation. -mixedAmountApplyValuation :: PriceOracle -> M.Map CommoditySymbol AmountStyle -> Day -> Day -> ValuationType -> MixedAmount -> MixedAmount -mixedAmountApplyValuation priceoracle styles periodlast today v (Mixed as) = - Mixed $ map (amountApplyValuation priceoracle styles periodlast today v) as +mixedAmountApplyValuation :: PriceOracle -> M.Map CommoditySymbol AmountStyle -> Day -> Day -> Day -> ValuationType -> MixedAmount -> MixedAmount +mixedAmountApplyValuation priceoracle styles periodlast today postingdate v = + mapMixedAmount (amountApplyValuation priceoracle styles periodlast today postingdate v) -- | Apply a specified valuation to this amount, using the provided -- price oracle, reference dates, and whether this is for a @@ -126,35 +125,27 @@ mixedAmountApplyValuation priceoracle styles periodlast today v (Mixed as) = -- - the provided "today" date - (--value=now, or -V/X with no report -- end date). -- --- Note --value=then is not supported by this function, and will cause an error; --- use postingApplyValuation for that. --- -- This is all a bit complicated. See the reference doc at -- https://hledger.org/hledger.html#effect-of-valuation-on-reports -- (hledger_options.m4.md "Effect of valuation on reports"), and #1083. -- -amountApplyValuation :: PriceOracle -> M.Map CommoditySymbol AmountStyle -> Day -> Day -> ValuationType -> Amount -> Amount -amountApplyValuation priceoracle styles periodlast today v a = +amountApplyValuation :: PriceOracle -> M.Map CommoditySymbol AmountStyle -> Day -> Day -> Day -> ValuationType -> Amount -> Amount +amountApplyValuation priceoracle styles periodlast today postingdate v a = case v of AtCost Nothing -> styleAmount styles $ amountCost a - AtCost mc -> amountValueAtDate priceoracle styles mc periodlast $ styleAmount styles $ amountCost a - AtThen _mc -> error' unsupportedValueThenError -- PARTIAL: - -- amountValueAtDate priceoracle styles mc periodlast a -- posting date unknown, handle like AtEnd + AtCost mc -> amountValueAtDate priceoracle styles mc periodlast . styleAmount styles $ amountCost a + AtThen mc -> amountValueAtDate priceoracle styles mc postingdate a AtEnd mc -> amountValueAtDate priceoracle styles mc periodlast a AtNow mc -> amountValueAtDate priceoracle styles mc today a AtDate d mc -> amountValueAtDate priceoracle styles mc d a --- | Standard error message for a report not supporting --value=then. -unsupportedValueThenError :: String -unsupportedValueThenError = "Sorry, --value=then is not yet supported for this kind of report." - -- | Find the market value of each component amount in the given -- commodity, or its default valuation commodity, at the given -- valuation date, using the given market price oracle. -- When market prices available on that date are not sufficient to -- calculate the value, amounts are left unchanged. mixedAmountValueAtDate :: PriceOracle -> M.Map CommoditySymbol AmountStyle -> Maybe CommoditySymbol -> Day -> MixedAmount -> MixedAmount -mixedAmountValueAtDate priceoracle styles mc d (Mixed as) = Mixed $ map (amountValueAtDate priceoracle styles mc d) as +mixedAmountValueAtDate priceoracle styles mc d = mapMixedAmount (amountValueAtDate priceoracle styles mc d) -- | Find the market value of this amount in the given valuation -- commodity if any, otherwise the default valuation commodity, at the diff --git a/hledger-lib/Hledger/Reports/AccountTransactionsReport.hs b/hledger-lib/Hledger/Reports/AccountTransactionsReport.hs index 026bb7d7e..d2cf07235 100644 --- a/hledger-lib/Hledger/Reports/AccountTransactionsReport.hs +++ b/hledger-lib/Hledger/Reports/AccountTransactionsReport.hs @@ -111,9 +111,7 @@ accountTransactionsReport rspec@ReportSpec{rsOpts=ropts} j reportq thisacctq = i periodlast = fromMaybe (error' "journalApplyValuation: expected a non-empty journal") $ -- XXX shouldn't happen reportPeriodOrJournalLastDay rspec j - tval = case value_ ropts of - Just v -> \t -> transactionApplyValuation prices styles periodlast (rsToday rspec) t v - Nothing -> id + tval = maybe id (transactionApplyValuation prices styles periodlast (rsToday rspec)) $ value_ ropts ts4 = ptraceAtWith 5 (("ts4:\n"++).pshowTransactions) $ map tval ts3 diff --git a/hledger-lib/Hledger/Reports/BudgetReport.hs b/hledger-lib/Hledger/Reports/BudgetReport.hs index c9a7daafd..4a8b48a1a 100644 --- a/hledger-lib/Hledger/Reports/BudgetReport.hs +++ b/hledger-lib/Hledger/Reports/BudgetReport.hs @@ -228,7 +228,7 @@ budgetReportAsText ropts@ReportOpts{..} budgetr = TB.toLazyText $ title = "Budget performance in " <> showDateSpan (periodicReportSpan budgetr) <> (case value_ of Just (AtCost _mc) -> ", valued at cost" - Just (AtThen _mc) -> error' unsupportedValueThenError -- PARTIAL: + Just (AtThen _mc) -> ", valued at posting date" Just (AtEnd _mc) -> ", valued at period ends" Just (AtNow _mc) -> ", current value" Just (AtDate d _mc) -> ", valued at " <> showDate d diff --git a/hledger-lib/Hledger/Reports/EntriesReport.hs b/hledger-lib/Hledger/Reports/EntriesReport.hs index 545f9b607..ef2259502 100644 --- a/hledger-lib/Hledger/Reports/EntriesReport.hs +++ b/hledger-lib/Hledger/Reports/EntriesReport.hs @@ -40,8 +40,8 @@ entriesReport rspec@ReportSpec{rsOpts=ropts@ReportOpts{..}} j@Journal{..} = -- We may be converting posting amounts to value, per hledger_options.m4.md "Effect of --value on reports". tvalue t@Transaction{..} = t{tpostings=map pvalue tpostings} where - pvalue p = maybe p - (postingApplyValuation (journalPriceOracle infer_value_ j) (journalCommodityStyles j) periodlast (rsToday rspec) p) + pvalue = maybe id + (postingApplyValuation (journalPriceOracle infer_value_ j) (journalCommodityStyles j) periodlast (rsToday rspec)) value_ where periodlast = fromMaybe (rsToday rspec) $ reportPeriodOrJournalLastDay rspec j diff --git a/hledger-lib/Hledger/Reports/MultiBalanceReport.hs b/hledger-lib/Hledger/Reports/MultiBalanceReport.hs index ff915dd5f..9f42f2b1a 100644 --- a/hledger-lib/Hledger/Reports/MultiBalanceReport.hs +++ b/hledger-lib/Hledger/Reports/MultiBalanceReport.hs @@ -114,20 +114,17 @@ multiBalanceReportWith rspec' j priceoracle = report -- Queries, report/column dates. reportspan = dbg3 "reportspan" $ calculateReportSpan rspec' j rspec = dbg3 "reportopts" $ makeReportQuery rspec' reportspan - valuation = makeValuation rspec' j priceoracle -- Must use rspec' instead of rspec, - -- so the reportspan isn't used for valuation -- Group postings into their columns. colps = dbg5 "colps" $ getPostingsByColumn rspec j reportspan - colspans = dbg3 "colspans" $ M.keys colps -- The matched accounts with a starting balance. All of these should appear -- in the report, even if they have no postings during the report period. - startbals = dbg5 "startbals" $ startingBalances rspec j reportspan + startbals = dbg5 "startbals" $ startingBalances rspec j priceoracle reportspan -- Generate and postprocess the report, negating balances and taking percentages if needed report = dbg4 "multiBalanceReportWith" $ - generateMultiBalanceReport rspec j valuation colspans colps startbals + generateMultiBalanceReport rspec j priceoracle colps startbals -- | Generate a compound balance report from a list of CBCSubreportSpec. This -- shares postings between the subreports. @@ -145,16 +142,13 @@ compoundBalanceReportWith rspec' j priceoracle subreportspecs = cbr -- Queries, report/column dates. reportspan = dbg3 "reportspan" $ calculateReportSpan rspec' j rspec = dbg3 "reportopts" $ makeReportQuery rspec' reportspan - valuation = makeValuation rspec' j priceoracle -- Must use rspec' instead of rspec, - -- so the reportspan isn't used for valuation -- Group postings into their columns. colps = dbg5 "colps" $ getPostingsByColumn rspec j reportspan - colspans = dbg3 "colspans" $ M.keys colps -- The matched accounts with a starting balance. All of these should appear -- in the report, even if they have no postings during the report period. - startbals = dbg5 "startbals" $ startingBalances rspec j reportspan + startbals = dbg5 "startbals" $ startingBalances rspec j priceoracle reportspan subreports = map generateSubreport subreportspecs where @@ -162,7 +156,7 @@ compoundBalanceReportWith rspec' j priceoracle subreportspecs = cbr ( cbcsubreporttitle -- Postprocess the report, negating balances and taking percentages if needed , cbcsubreporttransform $ - generateMultiBalanceReport rspec{rsOpts=ropts} j valuation colspans colps' startbals' + generateMultiBalanceReport rspec{rsOpts=ropts} j priceoracle colps' startbals' , cbcsubreportincreasestotal ) where @@ -183,7 +177,7 @@ compoundBalanceReportWith rspec' j priceoracle subreportspecs = cbr subreportTotal (_, sr, increasestotal) = (if increasestotal then id else fmap negate) $ prTotals sr - cbr = CompoundPeriodicReport "" colspans subreports overalltotals + cbr = CompoundPeriodicReport "" (M.keys colps) subreports overalltotals -- | Calculate starting balances, if needed for -H @@ -193,14 +187,18 @@ compoundBalanceReportWith rspec' j priceoracle subreportspecs = cbr -- TODO: Do we want to check whether to bother calculating these? isHistorical -- and startDate is not nothing, otherwise mempty? This currently gives a -- failure with some totals which are supposed to be 0 being blank. -startingBalances :: ReportSpec -> Journal -> DateSpan -> HashMap AccountName Account -startingBalances rspec@ReportSpec{rsQuery=query,rsOpts=ropts} j reportspan = - acctChangesFromPostings rspec' . map fst $ getPostings rspec' j +startingBalances :: ReportSpec -> Journal -> PriceOracle -> DateSpan -> HashMap AccountName Account +startingBalances rspec@ReportSpec{rsQuery=query,rsOpts=ropts} j priceoracle reportspan = + fmap (M.findWithDefault nullacct precedingspan) acctmap where + acctmap = calculateReportMatrix rspec' j priceoracle mempty + . M.singleton precedingspan . map fst $ getPostings rspec' j + rspec' = rspec{rsQuery=startbalq,rsOpts=ropts'} - ropts' = case accountlistmode_ ropts of - ALTree -> ropts{period_=precedingperiod, no_elide_=True} - ALFlat -> ropts{period_=precedingperiod} + -- If we're re-valuing every period, we need to have the unvalued start + -- balance, so we can do it ourselves later. + ropts' = if changingValuation ropts then ropts''{value_=Nothing} else ropts'' + where ropts'' = ropts{period_=precedingperiod, no_elide_=accountlistmode_ ropts == ALTree} -- q projected back before the report start date. -- When there's no report start date, in case there are future txns (the hledger-ui case above), @@ -249,14 +247,6 @@ makeReportQuery rspec reportspan dateless = dbg3 "dateless" . filterQuery (not . queryIsDateOrDate2) dateqcons = if date2_ (rsOpts rspec) then Date2 else Date --- | Make a valuation function for valuating MixedAmounts and a given Day -makeValuation :: ReportSpec -> Journal -> PriceOracle -> (Day -> MixedAmount -> MixedAmount) -makeValuation rspec j priceoracle day = case value_ (rsOpts rspec) of - Nothing -> id - Just v -> mixedAmountApplyValuation priceoracle styles day (rsToday rspec) v - where - styles = journalCommodityStyles j - -- | Group postings, grouped by their column getPostingsByColumn :: ReportSpec -> Journal -> DateSpan -> Map DateSpan [Posting] getPostingsByColumn rspec j reportspan = columns @@ -265,7 +255,7 @@ getPostingsByColumn rspec j reportspan = columns ps :: [(Posting, Day)] = dbg5 "getPostingsByColumn" $ getPostings rspec j -- The date spans to be included as report columns. - colspans = dbg3 "displayspan" $ splitSpan (interval_ $ rsOpts rspec) reportspan + colspans = dbg3 "colspans" $ splitSpan (interval_ $ rsOpts rspec) reportspan addPosting (p, d) = maybe id (M.adjust (p:)) $ latestSpanContaining colspans d emptyMap = M.fromList . zip colspans $ repeat [] @@ -292,22 +282,6 @@ getPostings ReportSpec{rsQuery=query,rsOpts=ropts} = SecondaryDate -> postingDate2 --- | Gather the account balance changes into a regular matrix --- including the accounts from all columns. -calculateAccountChanges :: ReportSpec -> [DateSpan] -> Map DateSpan [Posting] - -> HashMap ClippedAccountName (Map DateSpan Account) -calculateAccountChanges rspec colspans colps - | queryDepth (rsQuery rspec) == Just 0 = acctchanges <> elided - | otherwise = acctchanges - where - -- Transpose to get each account's balance changes across all columns. - acctchanges = transposeMap colacctchanges - - colacctchanges :: Map DateSpan (HashMap ClippedAccountName Account) = - dbg5 "colacctchanges" $ fmap (acctChangesFromPostings rspec) colps - - elided = HM.singleton "..." $ M.fromList [(span, nullacct) | span <- colspans] - -- | Given a set of postings, eg for a single report column, gather -- the accounts that have postings and calculate the change amount for -- each. Accounts and amounts will be depth-clipped appropriately if @@ -323,16 +297,17 @@ acctChangesFromPostings ReportSpec{rsQuery=query,rsOpts=ropts} ps = filter ((0<) . anumpostings) depthq = dbg3 "depthq" $ filterQuery queryIsDepth query --- | Accumulate and value amounts, as specified by the report options. +-- | Gather the account balance changes into a regular matrix, then +-- accumulate and value amounts, as specified by the report options. -- -- Makes sure all report columns have an entry. -accumValueAmounts :: ReportOpts -> (Day -> MixedAmount -> MixedAmount) -> [DateSpan] - -> HashMap ClippedAccountName Account - -> HashMap ClippedAccountName (Map DateSpan Account) - -> HashMap ClippedAccountName (Map DateSpan Account) -accumValueAmounts ropts valuation colspans startbals acctchanges = -- PARTIAL: +calculateReportMatrix :: ReportSpec -> Journal -> PriceOracle + -> HashMap ClippedAccountName Account + -> Map DateSpan [Posting] + -> HashMap ClippedAccountName (Map DateSpan Account) +calculateReportMatrix rspec@ReportSpec{rsOpts=ropts} j priceoracle startbals colps = -- PARTIAL: -- Ensure all columns have entries, including those with starting balances - HM.mapWithKey rowbals $ ((<>zeros) <$> acctchanges) <> (zeros <$ startbals) + HM.mapWithKey rowbals allchanges where -- The valued row amounts to be displayed: per-period changes, -- zero-based cumulative totals, or @@ -342,71 +317,47 @@ accumValueAmounts ropts valuation colspans startbals acctchanges = -- PARTIAL: CumulativeChange -> cumulative HistoricalBalance -> historical where - historical = cumulativeSum startingBalance - cumulative | fixedValuationDate = cumulativeSum nullacct - | otherwise = fmap (`subtractAcct` valuedStart) historical - changeamts | fixedValuationDate = M.mapWithKey valueAcct changes - | otherwise = M.fromDistinctAscList . zip dates $ - zipWith subtractAcct histamts (valuedStart:histamts) - where (dates, histamts) = unzip $ M.toAscList historical - - cumulativeSum start = snd $ M.mapAccumWithKey accumValued start changes - where accumValued startAmt date newAmt = (s, valueAcct date s) - where s = sumAcct startAmt newAmt - - -- Whether the market price is measured at the same date for all report - -- periods, and we can therefore use the simpler calculations for - -- cumulative and change reports. - fixedValuationDate = case value_ ropts of - Just (AtCost (Just _)) -> singleperiod - Just (AtEnd _) -> singleperiod - _ -> True - where singleperiod = interval_ ropts == NoInterval + historical = cumulativeSum avalue startingBalance changes + cumulative | changingValuation ropts = fmap (`subtractAcct` valuedStart) historical + | otherwise = cumulativeSum avalue nullacct changes + changeamts | changingValuation ropts = periodChanges valuedStart historical + | otherwise = changes startingBalance = HM.lookupDefault nullacct name startbals - valuedStart = valueAcct (DateSpan Nothing historicalDate) startingBalance + valuedStart = avalue (DateSpan Nothing historicalDate) startingBalance - -- 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} + -- Transpose to get each account's balance changes across all columns, then + -- pad with zeros + allchanges = ((<>zeros) <$> acctchanges) <> (zeros <$ startbals) + acctchanges = dbg5 "acctchanges" . addElided $ transposeMap colacctchanges + colacctchanges = dbg5 "colacctchanges" $ fmap (acctChangesFromPostings rspec) valuedps + valuedps = M.mapWithKey (\colspan -> map (pvalue colspan)) colps - -- 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". - valueAcct (DateSpan _ (Just end)) acct = - acct{aibalance = value (aibalance acct), aebalance = value (aebalance acct)} - where value = valuation (addDays (-1) end) - valueAcct _ _ = error "multiBalanceReport: expected all spans to have an end date" -- XXX should not happen - - zeros = M.fromList [(span, nullacct) | span <- colspans] + (pvalue, avalue) = postingAndAccountValuations rspec j priceoracle + addElided = if queryDepth (rsQuery rspec) == Just 0 then HM.insert "..." zeros else id historicalDate = minimumMay $ mapMaybe spanStart colspans + zeros = M.fromList [(span, nullacct) | span <- colspans] + colspans = M.keys colps -- | Lay out a set of postings grouped by date span into a regular matrix with rows -- given by AccountName and columns by DateSpan, then generate a MultiBalanceReport -- from the columns. -generateMultiBalanceReport :: ReportSpec -> Journal -> (Day -> MixedAmount -> MixedAmount) -> [DateSpan] +generateMultiBalanceReport :: ReportSpec -> Journal -> PriceOracle -> Map DateSpan [Posting] -> HashMap AccountName Account -> MultiBalanceReport -generateMultiBalanceReport rspec@ReportSpec{rsOpts=ropts} j valuation colspans colps startbals = +generateMultiBalanceReport rspec@ReportSpec{rsOpts=ropts} j priceoracle colps startbals = report where - -- Each account's balance changes across all columns. - acctchanges = dbg5 "acctchanges" $ calculateAccountChanges rspec colspans colps - -- Process changes into normal, cumulative, or historical amounts, plus value them - accumvalued = accumValueAmounts ropts valuation colspans startbals acctchanges + matrix = calculateReportMatrix rspec j priceoracle startbals colps -- All account names that will be displayed, possibly depth-clipped. - displaynames = dbg5 "displaynames" $ displayedAccounts rspec accumvalued + displaynames = dbg5 "displaynames" $ displayedAccounts rspec matrix -- All the rows of the report. - rows = dbg5 "rows" - . (if invert_ ropts then map (fmap negate) else id) -- Negate amounts if applicable - $ buildReportRows ropts displaynames accumvalued + rows = dbg5 "rows" . (if invert_ ropts then map (fmap negate) else id) -- Negate amounts if applicable + $ buildReportRows ropts displaynames matrix -- Calculate column totals totalsrow = dbg5 "totalsrow" $ calculateTotalsRow ropts rows @@ -415,7 +366,7 @@ generateMultiBalanceReport rspec@ReportSpec{rsOpts=ropts} j valuation colspans c sortedrows = dbg5 "sortedrows" $ sortRows ropts j rows -- Take percentages if needed - report = reportPercent ropts $ PeriodicReport colspans sortedrows totalsrow + report = reportPercent ropts $ PeriodicReport (M.keys colps) sortedrows totalsrow -- | Build the report rows. -- One row per account, with account name info, row amounts, row total and row average. @@ -565,7 +516,7 @@ reportPercent ropts report@(PeriodicReport spans rows totalrow) -- 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 = M.foldrWithKey addSpan mempty where addSpan span acctmap seen = HM.foldrWithKey (addAcctSpan span) seen acctmap @@ -598,6 +549,54 @@ perdivide a b = fromMaybe (error' errmsg) $ do -- PARTIAL: return $ mixed [per $ if aquantity b' == 0 then 0 else aquantity a' / abs (aquantity b') * 100] where errmsg = "Cannot calculate percentages if accounts have different commodities (Hint: Try --cost, -V or similar flags.)" +-- 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 -> Account -> Account +sumAcct Account{aibalance=i1,aebalance=e1} a@Account{aibalance=i2,aebalance=e2} = + a{aibalance = i1 + i2, aebalance = e1 + e2} + +-- Subtract the values in one account from another. Should be left-biased. +subtractAcct :: Account -> Account -> Account +subtractAcct a@Account{aibalance=i1,aebalance=e1} Account{aibalance=i2,aebalance=e2} = + a{aibalance = i1 - i2, aebalance = e1 - e2} + +-- | Whether the market price for postings might change when reported in +-- different report periods. +changingValuation :: ReportOpts -> Bool +changingValuation ropts = case value_ ropts of + Just (AtCost (Just _)) -> multiperiod + Just (AtEnd _) -> multiperiod + _ -> False + where multiperiod = interval_ ropts /= NoInterval + +-- | Extract period changes from a cumulative list +periodChanges :: Account -> Map k Account -> Map k Account +periodChanges start amtmap = + M.fromDistinctAscList . zip dates $ zipWith subtractAcct amts (start:amts) + where (dates, amts) = unzip $ M.toAscList amtmap + +-- | Calculate a cumulative sum from a list of period changes and a valuation +-- function. +cumulativeSum :: (DateSpan -> Account -> Account) -> Account -> Map DateSpan Account -> Map DateSpan Account +cumulativeSum value start = snd . M.mapAccumWithKey accumValued start + where accumValued startAmt date newAmt = let s = sumAcct startAmt newAmt in (s, value date s) + +-- | Calculate the Posting and Account valuation functions required by this +-- MultiBalanceReport. +postingAndAccountValuations :: ReportSpec -> Journal -> PriceOracle + -> (DateSpan -> Posting -> Posting, DateSpan -> Account -> Account) +postingAndAccountValuations rspec@ReportSpec{rsOpts=ropts} j priceoracle = + case value_ ropts of + Nothing -> (const id, const id) + Just v -> if changingValuation ropts then (const id, avalue' v) else (pvalue' v, const id) + where + avalue' v span a = a{aibalance = value (aibalance a), aebalance = value (aebalance a)} + where value = mixedAmountApplyValuation priceoracle styles (end span) (rsToday rspec) (error "multiBalanceReport: did not expect amount valuation to be called ") v -- PARTIAL: should not happen + pvalue' v span = postingApplyValuation priceoracle styles (end span) (rsToday rspec) v + end = fromMaybe (error "multiBalanceReport: expected all spans to have an end date") -- XXX should not happen + . fmap (addDays (-1)) . spanEnd + styles = journalCommodityStyles j + -- tests tests_MultiBalanceReport = tests "MultiBalanceReport" [ diff --git a/hledger-lib/Hledger/Reports/PostingsReport.hs b/hledger-lib/Hledger/Reports/PostingsReport.hs index 26ec4d5a3..0abd31fc7 100644 --- a/hledger-lib/Hledger/Reports/PostingsReport.hs +++ b/hledger-lib/Hledger/Reports/PostingsReport.hs @@ -75,17 +75,18 @@ postingsReport rspec@ReportSpec{rsOpts=ropts@ReportOpts{..}} j = items -- postings to be included in the report, and similarly-matched postings before the report start date (precedingps, reportps) = matchedPostingsBeforeAndDuring rspec j reportspan + -- We may be converting posting amounts to value, per hledger_options.m4.md "Effect of --value on reports". + pvalue periodlast = maybe id (postingApplyValuation priceoracle styles periodlast (rsToday rspec)) value_ + -- Postings, or summary postings with their subperiod's end date, to be displayed. displayps :: [(Posting, Maybe Day)] | multiperiod = let summaryps = summarisePostingsByInterval interval_ whichdate mdepth showempty reportspan reportps - in [(pvalue p lastday, Just periodend) | (p, periodend) <- summaryps, let lastday = addDays (-1) periodend] + in [(pvalue lastday p, Just periodend) | (p, periodend) <- summaryps, let lastday = addDays (-1) periodend] | otherwise = - [(pvalue p reportorjournallast, Nothing) | p <- reportps] + [(pvalue reportorjournallast p, Nothing) | p <- reportps] where showempty = empty_ || average_ - -- We may be converting posting amounts to value, per hledger_options.m4.md "Effect of --value on reports". - pvalue p periodlast = maybe p (postingApplyValuation priceoracle styles periodlast (rsToday rspec) p) value_ reportorjournallast = fromMaybe (error' "postingsReport: expected a non-empty journal") $ -- PARTIAL: shouldn't happen reportPeriodOrJournalLastDay rspec j @@ -100,19 +101,16 @@ postingsReport rspec@ReportSpec{rsOpts=ropts@ReportOpts{..}} j = items -- of --value on reports". -- XXX balance report doesn't value starting balance.. should this ? historical = balancetype_ == HistoricalBalance - startbal | average_ = if historical then bvalue precedingavg else 0 - | otherwise = if historical then bvalue precedingsum else 0 + startbal | average_ = if historical then precedingavg else 0 + | otherwise = if historical then precedingsum else 0 where - precedingsum = sumPostings precedingps + precedingsum = sumPostings $ map (pvalue daybeforereportstart) precedingps precedingavg | null precedingps = 0 | otherwise = divideMixedAmount (fromIntegral $ length precedingps) precedingsum - bvalue = maybe id (mixedAmountApplyValuation priceoracle styles daybeforereportstart $ rsToday rspec) value_ - -- XXX constrain valuation type to AtDate daybeforereportstart here ? - where - daybeforereportstart = - maybe (error' "postingsReport: expected a non-empty journal") -- PARTIAL: shouldn't happen - (addDays (-1)) - $ reportPeriodOrJournalStart rspec j + daybeforereportstart = + maybe (error' "postingsReport: expected a non-empty journal") -- PARTIAL: shouldn't happen + (addDays (-1)) + $ reportPeriodOrJournalStart rspec j runningcalc = registerRunningCalculationFn ropts startnum = if historical then length precedingps + 1 else 1 diff --git a/hledger-ui/Hledger/UI/TransactionScreen.hs b/hledger-ui/Hledger/UI/TransactionScreen.hs index 60fc842b8..5e12ef8bf 100644 --- a/hledger-ui/Hledger/UI/TransactionScreen.hs +++ b/hledger-ui/Hledger/UI/TransactionScreen.hs @@ -81,8 +81,7 @@ tsDraw UIState{aopts=UIOpts{cliopts_=copts@CliOpts{reportspec_=rspec@ReportSpec{ render . defaultLayout toplabel bottomlabel . str . T.unpack . showTransactionOneLineAmounts - . maybe t (transactionApplyValuation prices styles periodlast (rsToday rspec) t) - $ value_ ropts + $ maybe id (transactionApplyValuation prices styles periodlast (rsToday rspec)) (value_ ropts) t -- (if real_ ropts then filterTransactionPostings (Real True) else id) -- filter postings by --real where toplabel = diff --git a/hledger/Hledger/Cli/Commands/Balance.hs b/hledger/Hledger/Cli/Commands/Balance.hs index 6c328ae17..11f86cf04 100644 --- a/hledger/Hledger/Cli/Commands/Balance.hs +++ b/hledger/Hledger/Cli/Commands/Balance.hs @@ -577,7 +577,7 @@ multiBalanceReportAsText ropts@ReportOpts{..} r = TB.toLazyText $ HistoricalBalance -> "Ending balances (historical)" valuationdesc = case value_ of Just (AtCost _mc) -> ", valued at cost" - Just (AtThen _mc) -> error' unsupportedValueThenError -- TODO -- ", valued at period ends" -- handled like AtEnd for now -- PARTIAL: + Just (AtThen _mc) -> ", valued at posting date" Just (AtEnd _mc) | changingValuation -> "" Just (AtEnd _mc) -> ", valued at period ends" Just (AtNow _mc) -> ", current value" diff --git a/hledger/Hledger/Cli/CompoundBalanceCommand.hs b/hledger/Hledger/Cli/CompoundBalanceCommand.hs index c1c5e7ac2..04b3950c4 100644 --- a/hledger/Hledger/Cli/CompoundBalanceCommand.hs +++ b/hledger/Hledger/Cli/CompoundBalanceCommand.hs @@ -141,7 +141,7 @@ compoundBalanceCommand CompoundBalanceCommandSpec{..} opts@CliOpts{reportspec_=r valuationdesc = case value_ of Just (AtCost _mc) -> ", valued at cost" - Just (AtThen _mc) -> error' unsupportedValueThenError -- TODO + Just (AtThen _mc) -> ", valued at posting date" Just (AtEnd _mc) | changingValuation -> "" Just (AtEnd _mc) -> ", valued at period ends" Just (AtNow _mc) -> ", current value" diff --git a/hledger/test/journal/valuation.test b/hledger/test/journal/valuation.test index ccb817ebe..fc9ee8a8a 100644 --- a/hledger/test/journal/valuation.test +++ b/hledger/test/journal/valuation.test @@ -569,8 +569,7 @@ Budget performance in 2000-01-01..2000-04-30, valued at 2000-01-15: ---++---------------------------------------------------------------------------------------------------------------- || 5 B [50% of 10 B] 5 B [50% of 10 B] 5 B [50% of 10 B] 0 [0% of 10 B] 15 B [38% of 40 B] 4 B [38% of 10 B] -# 50. --value=then with --historical. How is the starting total valued ? -# Currently not supported. +# 50. --value=then with --historical. The starting total is valued individually for each posting at its posting time. < P 2020-01-01 A 1 B P 2020-02-01 A 2 B @@ -590,8 +589,9 @@ P 2020-04-01 A 4 B (a) 1 A $ hledger -f- reg --value=then -b 2020-03 -H ->2 /not yet supported/ ->=1 +2020-03-01 (a) 3 B 6 B +2020-04-01 (a) 4 B 10 B +>=0 # 51. --value=then with a report interval. How are the summary amounts valued ? # Currently each interval's unvalued sum is valued on its first day.