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
Simon Michael
parent
3d7d5c0db7
commit
83110e8820
@ -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}
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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" [
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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 =
|
||||
|
||||
@ -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"
|
||||
|
||||
@ -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"
|
||||
|
||||
@ -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.
|
||||
|
||||
Loading…
Reference in New Issue
Block a user