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.
This commit is contained in:
Stephen Morgan 2020-12-30 16:04:08 +11:00 committed by Simon Michael
parent 3d7d5c0db7
commit 83110e8820
12 changed files with 133 additions and 162 deletions

View File

@ -334,28 +334,14 @@ aliasReplace (RegexAlias re repl) a =
-- provided price oracle, commodity styles, reference dates, and -- provided price oracle, commodity styles, reference dates, and
-- whether this is for a multiperiod report or not. See -- whether this is for a multiperiod report or not. See
-- amountApplyValuation. -- amountApplyValuation.
postingApplyValuation :: PriceOracle -> M.Map CommoditySymbol AmountStyle -> Day -> Day -> Posting -> ValuationType -> Posting postingApplyValuation :: PriceOracle -> M.Map CommoditySymbol AmountStyle -> Day -> Day -> ValuationType -> Posting -> Posting
postingApplyValuation priceoracle styles periodlast today p v = postingApplyValuation priceoracle styles periodlast today v p =
case v of postingTransformAmount (mixedAmountApplyValuation priceoracle styles periodlast today (postingDate p) v) p
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
-- | Convert this posting's amount to cost, and apply the appropriate amount styles. -- | Convert this posting's amount to cost, and apply the appropriate amount styles.
postingToCost :: M.Map CommoditySymbol AmountStyle -> Posting -> Posting postingToCost :: M.Map CommoditySymbol AmountStyle -> Posting -> Posting
postingToCost styles p@Posting{pamount=a} = p{pamount=styleMixedAmount styles $ mixedAmountCost a} 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. -- | Apply a transform function to this posting's amount.
postingTransformAmount :: (MixedAmount -> MixedAmount) -> Posting -> Posting postingTransformAmount :: (MixedAmount -> MixedAmount) -> Posting -> Posting
postingTransformAmount f p@Posting{pamount=a} = p{pamount=f a} postingTransformAmount f p@Posting{pamount=a} = p{pamount=f a}

View File

@ -594,9 +594,9 @@ transactionTransformPostings f t@Transaction{tpostings=ps} = t{tpostings=map f p
-- the provided price oracle, commodity styles, reference dates, and -- the provided price oracle, commodity styles, reference dates, and
-- whether this is for a multiperiod report or not. See -- whether this is for a multiperiod report or not. See
-- amountApplyValuation. -- amountApplyValuation.
transactionApplyValuation :: PriceOracle -> M.Map CommoditySymbol AmountStyle -> Day -> Day -> Transaction -> ValuationType -> Transaction transactionApplyValuation :: PriceOracle -> M.Map CommoditySymbol AmountStyle -> Day -> Day -> ValuationType -> Transaction -> Transaction
transactionApplyValuation priceoracle styles periodlast today t v = transactionApplyValuation priceoracle styles periodlast today v =
transactionTransformPostings (\p -> postingApplyValuation priceoracle styles periodlast today p v) t transactionTransformPostings (postingApplyValuation priceoracle styles periodlast today v)
-- | Convert this transaction's amounts to cost, and apply the appropriate amount styles. -- | Convert this transaction's amounts to cost, and apply the appropriate amount styles.
transactionToCost :: M.Map CommoditySymbol AmountStyle -> Transaction -> Transaction transactionToCost :: M.Map CommoditySymbol AmountStyle -> Transaction -> Transaction

View File

@ -16,7 +16,6 @@ module Hledger.Data.Valuation (
ValuationType(..) ValuationType(..)
,PriceOracle ,PriceOracle
,journalPriceOracle ,journalPriceOracle
,unsupportedValueThenError
-- ,amountApplyValuation -- ,amountApplyValuation
-- ,amountValueAtDate -- ,amountValueAtDate
,mixedAmountApplyValuation ,mixedAmountApplyValuation
@ -98,9 +97,9 @@ priceDirectiveToMarketPrice PriceDirective{..} =
-- provided price oracle, commodity styles, reference dates, and -- provided price oracle, commodity styles, reference dates, and
-- whether this is for a multiperiod report or not. -- whether this is for a multiperiod report or not.
-- See amountApplyValuation. -- See amountApplyValuation.
mixedAmountApplyValuation :: PriceOracle -> M.Map CommoditySymbol AmountStyle -> Day -> Day -> ValuationType -> MixedAmount -> MixedAmount mixedAmountApplyValuation :: PriceOracle -> M.Map CommoditySymbol AmountStyle -> Day -> Day -> Day -> ValuationType -> MixedAmount -> MixedAmount
mixedAmountApplyValuation priceoracle styles periodlast today v (Mixed as) = mixedAmountApplyValuation priceoracle styles periodlast today postingdate v =
Mixed $ map (amountApplyValuation priceoracle styles periodlast today v) as mapMixedAmount (amountApplyValuation priceoracle styles periodlast today postingdate v)
-- | Apply a specified valuation to this amount, using the provided -- | Apply a specified valuation to this amount, using the provided
-- price oracle, reference dates, and whether this is for a -- 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 -- - the provided "today" date - (--value=now, or -V/X with no report
-- end date). -- 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 -- This is all a bit complicated. See the reference doc at
-- https://hledger.org/hledger.html#effect-of-valuation-on-reports -- https://hledger.org/hledger.html#effect-of-valuation-on-reports
-- (hledger_options.m4.md "Effect of valuation on reports"), and #1083. -- (hledger_options.m4.md "Effect of valuation on reports"), and #1083.
-- --
amountApplyValuation :: PriceOracle -> M.Map CommoditySymbol AmountStyle -> Day -> Day -> ValuationType -> Amount -> Amount amountApplyValuation :: PriceOracle -> M.Map CommoditySymbol AmountStyle -> Day -> Day -> Day -> ValuationType -> Amount -> Amount
amountApplyValuation priceoracle styles periodlast today v a = amountApplyValuation priceoracle styles periodlast today postingdate v a =
case v of case v of
AtCost Nothing -> styleAmount styles $ amountCost a AtCost Nothing -> styleAmount styles $ amountCost a
AtCost mc -> amountValueAtDate priceoracle styles mc periodlast $ styleAmount styles $ amountCost a AtCost mc -> amountValueAtDate priceoracle styles mc periodlast . styleAmount styles $ amountCost a
AtThen _mc -> error' unsupportedValueThenError -- PARTIAL: AtThen mc -> amountValueAtDate priceoracle styles mc postingdate a
-- amountValueAtDate priceoracle styles mc periodlast a -- posting date unknown, handle like AtEnd
AtEnd mc -> amountValueAtDate priceoracle styles mc periodlast a AtEnd mc -> amountValueAtDate priceoracle styles mc periodlast a
AtNow mc -> amountValueAtDate priceoracle styles mc today a AtNow mc -> amountValueAtDate priceoracle styles mc today a
AtDate d mc -> amountValueAtDate priceoracle styles mc d 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 -- | Find the market value of each component amount in the given
-- commodity, or its default valuation commodity, at the given -- commodity, or its default valuation commodity, at the given
-- valuation date, using the given market price oracle. -- valuation date, using the given market price oracle.
-- When market prices available on that date are not sufficient to -- When market prices available on that date are not sufficient to
-- calculate the value, amounts are left unchanged. -- calculate the value, amounts are left unchanged.
mixedAmountValueAtDate :: PriceOracle -> M.Map CommoditySymbol AmountStyle -> Maybe CommoditySymbol -> Day -> MixedAmount -> MixedAmount 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 -- | Find the market value of this amount in the given valuation
-- commodity if any, otherwise the default valuation commodity, at the -- commodity if any, otherwise the default valuation commodity, at the

View File

@ -111,9 +111,7 @@ accountTransactionsReport rspec@ReportSpec{rsOpts=ropts} j reportq thisacctq = i
periodlast = periodlast =
fromMaybe (error' "journalApplyValuation: expected a non-empty journal") $ -- XXX shouldn't happen fromMaybe (error' "journalApplyValuation: expected a non-empty journal") $ -- XXX shouldn't happen
reportPeriodOrJournalLastDay rspec j reportPeriodOrJournalLastDay rspec j
tval = case value_ ropts of tval = maybe id (transactionApplyValuation prices styles periodlast (rsToday rspec)) $ value_ ropts
Just v -> \t -> transactionApplyValuation prices styles periodlast (rsToday rspec) t v
Nothing -> id
ts4 = ts4 =
ptraceAtWith 5 (("ts4:\n"++).pshowTransactions) $ ptraceAtWith 5 (("ts4:\n"++).pshowTransactions) $
map tval ts3 map tval ts3

View File

@ -228,7 +228,7 @@ budgetReportAsText ropts@ReportOpts{..} budgetr = TB.toLazyText $
title = "Budget performance in " <> showDateSpan (periodicReportSpan budgetr) title = "Budget performance in " <> showDateSpan (periodicReportSpan budgetr)
<> (case value_ of <> (case value_ of
Just (AtCost _mc) -> ", valued at cost" 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 (AtEnd _mc) -> ", valued at period ends"
Just (AtNow _mc) -> ", current value" Just (AtNow _mc) -> ", current value"
Just (AtDate d _mc) -> ", valued at " <> showDate d Just (AtDate d _mc) -> ", valued at " <> showDate d

View File

@ -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". -- 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} tvalue t@Transaction{..} = t{tpostings=map pvalue tpostings}
where where
pvalue p = maybe p pvalue = maybe id
(postingApplyValuation (journalPriceOracle infer_value_ j) (journalCommodityStyles j) periodlast (rsToday rspec) p) (postingApplyValuation (journalPriceOracle infer_value_ j) (journalCommodityStyles j) periodlast (rsToday rspec))
value_ value_
where where
periodlast = fromMaybe (rsToday rspec) $ reportPeriodOrJournalLastDay rspec j periodlast = fromMaybe (rsToday rspec) $ reportPeriodOrJournalLastDay rspec j

View File

@ -114,20 +114,17 @@ multiBalanceReportWith rspec' j priceoracle = report
-- Queries, report/column dates. -- Queries, report/column dates.
reportspan = dbg3 "reportspan" $ calculateReportSpan rspec' j reportspan = dbg3 "reportspan" $ calculateReportSpan rspec' j
rspec = dbg3 "reportopts" $ makeReportQuery rspec' reportspan 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. -- Group postings into their columns.
colps = dbg5 "colps" $ getPostingsByColumn rspec j reportspan 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 -- 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. -- 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 -- Generate and postprocess the report, negating balances and taking percentages if needed
report = dbg4 "multiBalanceReportWith" $ 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 -- | Generate a compound balance report from a list of CBCSubreportSpec. This
-- shares postings between the subreports. -- shares postings between the subreports.
@ -145,16 +142,13 @@ compoundBalanceReportWith rspec' j priceoracle subreportspecs = cbr
-- Queries, report/column dates. -- Queries, report/column dates.
reportspan = dbg3 "reportspan" $ calculateReportSpan rspec' j reportspan = dbg3 "reportspan" $ calculateReportSpan rspec' j
rspec = dbg3 "reportopts" $ makeReportQuery rspec' reportspan 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. -- Group postings into their columns.
colps = dbg5 "colps" $ getPostingsByColumn rspec j reportspan 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 -- 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. -- 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 subreports = map generateSubreport subreportspecs
where where
@ -162,7 +156,7 @@ compoundBalanceReportWith rspec' j priceoracle subreportspecs = cbr
( cbcsubreporttitle ( cbcsubreporttitle
-- Postprocess the report, negating balances and taking percentages if needed -- Postprocess the report, negating balances and taking percentages if needed
, cbcsubreporttransform $ , cbcsubreporttransform $
generateMultiBalanceReport rspec{rsOpts=ropts} j valuation colspans colps' startbals' generateMultiBalanceReport rspec{rsOpts=ropts} j priceoracle colps' startbals'
, cbcsubreportincreasestotal , cbcsubreportincreasestotal
) )
where where
@ -183,7 +177,7 @@ compoundBalanceReportWith rspec' j priceoracle subreportspecs = cbr
subreportTotal (_, sr, increasestotal) = subreportTotal (_, sr, increasestotal) =
(if increasestotal then id else fmap negate) $ prTotals sr (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 -- | 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 -- TODO: Do we want to check whether to bother calculating these? isHistorical
-- and startDate is not nothing, otherwise mempty? This currently gives a -- and startDate is not nothing, otherwise mempty? This currently gives a
-- failure with some totals which are supposed to be 0 being blank. -- failure with some totals which are supposed to be 0 being blank.
startingBalances :: ReportSpec -> Journal -> DateSpan -> HashMap AccountName Account startingBalances :: ReportSpec -> Journal -> PriceOracle -> DateSpan -> HashMap AccountName Account
startingBalances rspec@ReportSpec{rsQuery=query,rsOpts=ropts} j reportspan = startingBalances rspec@ReportSpec{rsQuery=query,rsOpts=ropts} j priceoracle reportspan =
acctChangesFromPostings rspec' . map fst $ getPostings rspec' j fmap (M.findWithDefault nullacct precedingspan) acctmap
where where
acctmap = calculateReportMatrix rspec' j priceoracle mempty
. M.singleton precedingspan . map fst $ getPostings rspec' j
rspec' = rspec{rsQuery=startbalq,rsOpts=ropts'} rspec' = rspec{rsQuery=startbalq,rsOpts=ropts'}
ropts' = case accountlistmode_ ropts of -- If we're re-valuing every period, we need to have the unvalued start
ALTree -> ropts{period_=precedingperiod, no_elide_=True} -- balance, so we can do it ourselves later.
ALFlat -> ropts{period_=precedingperiod} 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. -- 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), -- 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) dateless = dbg3 "dateless" . filterQuery (not . queryIsDateOrDate2)
dateqcons = if date2_ (rsOpts rspec) then Date2 else Date 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 -- | Group postings, grouped by their column
getPostingsByColumn :: ReportSpec -> Journal -> DateSpan -> Map DateSpan [Posting] getPostingsByColumn :: ReportSpec -> Journal -> DateSpan -> Map DateSpan [Posting]
getPostingsByColumn rspec j reportspan = columns getPostingsByColumn rspec j reportspan = columns
@ -265,7 +255,7 @@ getPostingsByColumn rspec j reportspan = columns
ps :: [(Posting, Day)] = dbg5 "getPostingsByColumn" $ getPostings rspec j ps :: [(Posting, Day)] = dbg5 "getPostingsByColumn" $ getPostings rspec j
-- The date spans to be included as report columns. -- 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 addPosting (p, d) = maybe id (M.adjust (p:)) $ latestSpanContaining colspans d
emptyMap = M.fromList . zip colspans $ repeat [] emptyMap = M.fromList . zip colspans $ repeat []
@ -292,22 +282,6 @@ getPostings ReportSpec{rsQuery=query,rsOpts=ropts} =
SecondaryDate -> postingDate2 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 -- | Given a set of postings, eg for a single report column, gather
-- the accounts that have postings and calculate the change amount for -- the accounts that have postings and calculate the change amount for
-- each. Accounts and amounts will be depth-clipped appropriately if -- each. Accounts and amounts will be depth-clipped appropriately if
@ -323,16 +297,17 @@ acctChangesFromPostings ReportSpec{rsQuery=query,rsOpts=ropts} ps =
filter ((0<) . anumpostings) filter ((0<) . anumpostings)
depthq = dbg3 "depthq" $ filterQuery queryIsDepth query 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. -- Makes sure all report columns have an entry.
accumValueAmounts :: ReportOpts -> (Day -> MixedAmount -> MixedAmount) -> [DateSpan] calculateReportMatrix :: ReportSpec -> Journal -> PriceOracle
-> HashMap ClippedAccountName Account -> HashMap ClippedAccountName Account
-> Map DateSpan [Posting]
-> HashMap ClippedAccountName (Map DateSpan Account) -> HashMap ClippedAccountName (Map DateSpan Account)
-> HashMap ClippedAccountName (Map DateSpan Account) calculateReportMatrix rspec@ReportSpec{rsOpts=ropts} j priceoracle startbals colps = -- PARTIAL:
accumValueAmounts ropts valuation colspans startbals acctchanges = -- PARTIAL:
-- Ensure all columns have entries, including those with starting balances -- Ensure all columns have entries, including those with starting balances
HM.mapWithKey rowbals $ ((<>zeros) <$> acctchanges) <> (zeros <$ startbals) HM.mapWithKey rowbals allchanges
where where
-- The valued row amounts to be displayed: per-period changes, -- The valued row amounts to be displayed: per-period changes,
-- zero-based cumulative totals, or -- zero-based cumulative totals, or
@ -342,71 +317,47 @@ accumValueAmounts ropts valuation colspans startbals acctchanges = -- PARTIAL:
CumulativeChange -> cumulative CumulativeChange -> cumulative
HistoricalBalance -> historical HistoricalBalance -> historical
where where
historical = cumulativeSum startingBalance historical = cumulativeSum avalue startingBalance changes
cumulative | fixedValuationDate = cumulativeSum nullacct cumulative | changingValuation ropts = fmap (`subtractAcct` valuedStart) historical
| otherwise = fmap (`subtractAcct` valuedStart) historical | otherwise = cumulativeSum avalue nullacct changes
changeamts | fixedValuationDate = M.mapWithKey valueAcct changes changeamts | changingValuation ropts = periodChanges valuedStart historical
| otherwise = M.fromDistinctAscList . zip dates $ | otherwise = changes
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
startingBalance = HM.lookupDefault nullacct name startbals 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 -- Transpose to get each account's balance changes across all columns, then
-- in scanl, so other properties (such as anumpostings) stay in the right place -- pad with zeros
sumAcct Account{aibalance=i1,aebalance=e1} a@Account{aibalance=i2,aebalance=e2} = allchanges = ((<>zeros) <$> acctchanges) <> (zeros <$ startbals)
a{aibalance = i1 + i2, aebalance = e1 + e2} 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. (pvalue, avalue) = postingAndAccountValuations rspec j priceoracle
subtractAcct a@Account{aibalance=i1,aebalance=e1} Account{aibalance=i2,aebalance=e2} = addElided = if queryDepth (rsQuery rspec) == Just 0 then HM.insert "..." zeros else id
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]
historicalDate = minimumMay $ mapMaybe spanStart colspans 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 -- | 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 -- given by AccountName and columns by DateSpan, then generate a MultiBalanceReport
-- from the columns. -- from the columns.
generateMultiBalanceReport :: ReportSpec -> Journal -> (Day -> MixedAmount -> MixedAmount) -> [DateSpan] generateMultiBalanceReport :: ReportSpec -> Journal -> PriceOracle
-> Map DateSpan [Posting] -> HashMap AccountName Account -> Map DateSpan [Posting] -> HashMap AccountName Account
-> MultiBalanceReport -> MultiBalanceReport
generateMultiBalanceReport rspec@ReportSpec{rsOpts=ropts} j valuation colspans colps startbals = generateMultiBalanceReport rspec@ReportSpec{rsOpts=ropts} j priceoracle colps startbals =
report report
where 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 -- 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. -- 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. -- All the rows of the report.
rows = dbg5 "rows" rows = dbg5 "rows" . (if invert_ ropts then map (fmap negate) else id) -- Negate amounts if applicable
. (if invert_ ropts then map (fmap negate) else id) -- Negate amounts if applicable $ buildReportRows ropts displaynames matrix
$ buildReportRows ropts displaynames accumvalued
-- Calculate column totals -- Calculate column totals
totalsrow = dbg5 "totalsrow" $ calculateTotalsRow ropts rows 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 sortedrows = dbg5 "sortedrows" $ sortRows ropts j rows
-- Take percentages if needed -- Take percentages if needed
report = reportPercent ropts $ PeriodicReport colspans sortedrows totalsrow report = reportPercent ropts $ PeriodicReport (M.keys colps) sortedrows totalsrow
-- | 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.
@ -565,7 +516,7 @@ reportPercent ropts report@(PeriodicReport spans rows totalrow)
-- Makes sure that all DateSpans are present in all rows. -- Makes sure that all DateSpans are present in all rows.
transposeMap :: Map DateSpan (HashMap AccountName a) transposeMap :: Map DateSpan (HashMap AccountName a)
-> HashMap AccountName (Map DateSpan a) -> HashMap AccountName (Map DateSpan a)
transposeMap xs = M.foldrWithKey addSpan mempty xs transposeMap = M.foldrWithKey addSpan mempty
where where
addSpan span acctmap seen = HM.foldrWithKey (addAcctSpan span) seen acctmap 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] 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.)" 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
tests_MultiBalanceReport = tests "MultiBalanceReport" [ tests_MultiBalanceReport = tests "MultiBalanceReport" [

View File

@ -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 -- postings to be included in the report, and similarly-matched postings before the report start date
(precedingps, reportps) = matchedPostingsBeforeAndDuring rspec j reportspan (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. -- Postings, or summary postings with their subperiod's end date, to be displayed.
displayps :: [(Posting, Maybe Day)] displayps :: [(Posting, Maybe Day)]
| multiperiod = | multiperiod =
let summaryps = summarisePostingsByInterval interval_ whichdate mdepth showempty reportspan reportps 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 = | otherwise =
[(pvalue p reportorjournallast, Nothing) | p <- reportps] [(pvalue reportorjournallast p, Nothing) | p <- reportps]
where where
showempty = empty_ || average_ 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 = reportorjournallast =
fromMaybe (error' "postingsReport: expected a non-empty journal") $ -- PARTIAL: shouldn't happen fromMaybe (error' "postingsReport: expected a non-empty journal") $ -- PARTIAL: shouldn't happen
reportPeriodOrJournalLastDay rspec j reportPeriodOrJournalLastDay rspec j
@ -100,15 +101,12 @@ postingsReport rspec@ReportSpec{rsOpts=ropts@ReportOpts{..}} j = items
-- of --value on reports". -- of --value on reports".
-- XXX balance report doesn't value starting balance.. should this ? -- XXX balance report doesn't value starting balance.. should this ?
historical = balancetype_ == HistoricalBalance historical = balancetype_ == HistoricalBalance
startbal | average_ = if historical then bvalue precedingavg else 0 startbal | average_ = if historical then precedingavg else 0
| otherwise = if historical then bvalue precedingsum else 0 | otherwise = if historical then precedingsum else 0
where where
precedingsum = sumPostings precedingps precedingsum = sumPostings $ map (pvalue daybeforereportstart) precedingps
precedingavg | null precedingps = 0 precedingavg | null precedingps = 0
| otherwise = divideMixedAmount (fromIntegral $ length precedingps) precedingsum | 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 = daybeforereportstart =
maybe (error' "postingsReport: expected a non-empty journal") -- PARTIAL: shouldn't happen maybe (error' "postingsReport: expected a non-empty journal") -- PARTIAL: shouldn't happen
(addDays (-1)) (addDays (-1))

View File

@ -81,8 +81,7 @@ tsDraw UIState{aopts=UIOpts{cliopts_=copts@CliOpts{reportspec_=rspec@ReportSpec{
render . defaultLayout toplabel bottomlabel . str render . defaultLayout toplabel bottomlabel . str
. T.unpack . showTransactionOneLineAmounts . T.unpack . showTransactionOneLineAmounts
. maybe t (transactionApplyValuation prices styles periodlast (rsToday rspec) t) $ maybe id (transactionApplyValuation prices styles periodlast (rsToday rspec)) (value_ ropts) t
$ value_ ropts
-- (if real_ ropts then filterTransactionPostings (Real True) else id) -- filter postings by --real -- (if real_ ropts then filterTransactionPostings (Real True) else id) -- filter postings by --real
where where
toplabel = toplabel =

View File

@ -577,7 +577,7 @@ multiBalanceReportAsText ropts@ReportOpts{..} r = TB.toLazyText $
HistoricalBalance -> "Ending balances (historical)" HistoricalBalance -> "Ending balances (historical)"
valuationdesc = case value_ of valuationdesc = case value_ of
Just (AtCost _mc) -> ", valued at cost" 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) | changingValuation -> ""
Just (AtEnd _mc) -> ", valued at period ends" Just (AtEnd _mc) -> ", valued at period ends"
Just (AtNow _mc) -> ", current value" Just (AtNow _mc) -> ", current value"

View File

@ -141,7 +141,7 @@ compoundBalanceCommand CompoundBalanceCommandSpec{..} opts@CliOpts{reportspec_=r
valuationdesc = case value_ of valuationdesc = case value_ of
Just (AtCost _mc) -> ", valued at cost" 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) | changingValuation -> ""
Just (AtEnd _mc) -> ", valued at period ends" Just (AtEnd _mc) -> ", valued at period ends"
Just (AtNow _mc) -> ", current value" Just (AtNow _mc) -> ", current value"

View File

@ -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] || 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 ? # 50. --value=then with --historical. The starting total is valued individually for each posting at its posting time.
# Currently not supported.
< <
P 2020-01-01 A 1 B P 2020-01-01 A 1 B
P 2020-02-01 A 2 B P 2020-02-01 A 2 B
@ -590,8 +589,9 @@ P 2020-04-01 A 4 B
(a) 1 A (a) 1 A
$ hledger -f- reg --value=then -b 2020-03 -H $ hledger -f- reg --value=then -b 2020-03 -H
>2 /not yet supported/ 2020-03-01 (a) 3 B 6 B
>=1 2020-04-01 (a) 4 B 10 B
>=0
# 51. --value=then with a report interval. How are the summary amounts valued ? # 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. # Currently each interval's unvalued sum is valued on its first day.