; refactor: centralise valuation logic #131

This commit is contained in:
Simon Michael 2019-05-28 11:42:32 -07:00
parent ad83919c6a
commit 42ce95aaef
8 changed files with 123 additions and 134 deletions

View File

@ -62,7 +62,8 @@ module Hledger.Data.Amount (
multiplyAmount,
divideAmountAndPrice,
multiplyAmountAndPrice,
amountValue,
amountValueAtDate,
amountApplyValuation,
amountTotalPriceToUnitPrice,
-- ** rendering
amountstyle,
@ -107,7 +108,8 @@ module Hledger.Data.Amount (
isZeroMixedAmount,
isReallyZeroMixedAmount,
isReallyZeroMixedAmountCost,
mixedAmountValue,
mixedAmountValueAtDate,
mixedAmountApplyValuation,
mixedAmountTotalPriceToUnitPrice,
-- ** rendering
styleMixedAmount,
@ -223,6 +225,35 @@ costOfAmount a@Amount{aquantity=q, aprice=price} =
amountToCost :: M.Map CommoditySymbol AmountStyle -> Amount -> Amount
amountToCost styles = styleAmount styles . costOfAmount
-- | Find the market value of this amount on the given valuation date
-- in its default valuation commodity (that of the latest applicable
-- market price before the valuation date).
-- The given market prices are expected to be in parse order.
-- If no default valuation commodity can be found, the amount is left
-- unchanged.
amountValueAtDate :: Prices -> Day -> Amount -> Amount
amountValueAtDate prices d a =
case priceLookup prices d (acommodity a) of
Just v -> v{aquantity=aquantity v * aquantity a}
Nothing -> a
-- | Alternate implementation.
-- Apply a specified valuation to this amount, using the provided
-- prices db, commodity styles, period-end/current dates,
-- and whether this is for a multiperiod report or not.
-- Currently ignores the specified valuation commodity and always uses
-- the default valuation commodity.
amountApplyValuation :: Prices -> M.Map CommoditySymbol AmountStyle -> Day -> Day -> Bool -> ValuationType -> Amount -> Amount
amountApplyValuation prices styles periodend today ismultiperiod v a =
-- will use _mc later
case v of
AtCost _mc -> amountToCost styles a
AtEnd _mc -> amountValueAtDate prices periodend a
AtNow _mc -> amountValueAtDate prices today a
AtDefault _mc | ismultiperiod -> amountValueAtDate prices periodend a
AtDefault _mc -> amountValueAtDate prices today a
AtDate d _mc -> amountValueAtDate prices d a
-- | Replace an amount's TotalPrice, if it has one, with an equivalent UnitPrice.
-- Has no effect on amounts without one.
-- Also increases the unit price's display precision to show one extra decimal place,
@ -451,18 +482,6 @@ canonicaliseAmount styles a@Amount{acommodity=c, astyle=s} = a{astyle=s'}
where
s' = findWithDefault s c styles
-- | Find the market value of this amount on the given valuation date
-- in its default valuation commodity (that of the latest applicable
-- market price before the valuation date).
-- The given market prices are expected to be in parse order.
-- If no default valuation commodity can be found, the amount is left
-- unchanged.
amountValue :: Prices -> Day -> Amount -> Amount
amountValue prices d a =
case priceLookup prices d (acommodity a) of
Just v -> v{aquantity=aquantity v * aquantity a}
Nothing -> a
-------------------------------------------------------------------------------
-- MixedAmount
@ -724,8 +743,17 @@ canonicaliseMixedAmount styles (Mixed as) = Mixed $ map (canonicaliseAmount styl
-- in its default valuation commodity, using the given market prices
-- which are expected to be in parse order. When no default valuation
-- commodity can be found, amounts are left unchanged.
mixedAmountValue :: Prices -> Day -> MixedAmount -> MixedAmount
mixedAmountValue prices d (Mixed as) = Mixed $ map (amountValue prices d) as
mixedAmountValueAtDate :: Prices -> Day -> MixedAmount -> MixedAmount
mixedAmountValueAtDate prices d (Mixed as) = Mixed $ map (amountValueAtDate prices d) as
-- Apply a specified valuation to this mixed amount, using the provided
-- prices db, commodity styles, period-end/current dates,
-- and whether this is for a multiperiod report or not.
-- Currently ignores the specified valuation commodity and always uses
-- the default valuation commodity.
mixedAmountApplyValuation :: Prices -> M.Map CommoditySymbol AmountStyle -> Day -> Day -> Bool -> ValuationType -> MixedAmount -> MixedAmount
mixedAmountApplyValuation prices styles periodend today ismultiperiod v (Mixed as) =
Mixed $ map (amountApplyValuation prices styles periodend today ismultiperiod v) as
-- | Replace each component amount's TotalPrice, if it has one, with an equivalent UnitPrice.
-- Has no effect on amounts without one.

View File

@ -65,7 +65,7 @@ module Hledger.Data.Posting (
-- * misc.
showComment,
postingTransformAmount,
postingValue,
postingApplyValuation,
postingToCost,
tests_Posting
)
@ -347,20 +347,36 @@ aliasReplace (BasicAlias old new) a
| otherwise = a
aliasReplace (RegexAlias re repl) a = T.pack $ regexReplaceCIMemo re repl $ T.unpack a -- XXX
-- | Apply a transform function to this posting's amount.
postingTransformAmount :: (MixedAmount -> MixedAmount) -> Posting -> Posting
postingTransformAmount f p@Posting{pamount=a} = p{pamount=f a}
-- Apply a specified valuation to this posting's amount, using the provided
-- prices db, commodity styles, period-end/current dates, and whether
-- this is for a multiperiod report or not.
-- Currently ignores the specified valuation commodity and always uses
-- the default valuation commodity.
postingApplyValuation :: Prices -> M.Map CommoditySymbol AmountStyle -> Day -> Day -> Bool -> Posting -> ValuationType -> Posting
postingApplyValuation prices styles periodend today ismultiperiod p v =
-- will use _mc later
case v of
AtCost _mc -> postingToCost styles p
AtEnd _mc -> postingValueAtDate prices periodend p
AtNow _mc -> postingValueAtDate prices today p
AtDefault _mc | ismultiperiod -> postingValueAtDate prices periodend p
AtDefault _mc -> postingValueAtDate prices today p
AtDate d _mc -> postingValueAtDate prices d 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=mixedAmountToCost styles a}
-- | Convert this posting's amount to market value in its default
-- valuation commodity on the given date using the given market prices.
-- If no default valuation commodity can be found, amounts are left unchanged.
-- The prices are expected to be in parse order.
postingValue :: Prices -> Day -> Posting -> Posting
postingValue prices d p = postingTransformAmount (mixedAmountValue prices d) p
postingValueAtDate :: Prices -> Day -> Posting -> Posting
postingValueAtDate prices d p = postingTransformAmount (mixedAmountValueAtDate prices d) 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=mixedAmountToCost styles a}
-- | Apply a transform function to this posting's amount.
postingTransformAmount :: (MixedAmount -> MixedAmount) -> Posting -> Posting
postingTransformAmount f p@Posting{pamount=a} = p{pamount=f a}
-- tests

View File

@ -431,6 +431,16 @@ data MarketPrice = MarketPrice {
instance NFData MarketPrice
-- | What kind of value conversion should be done on amounts ?
-- UI: --value=cost|end|now|DATE[,COMM]
data ValuationType =
AtCost (Maybe CommoditySymbol) -- ^ convert to cost commodity using transaction prices, then optionally to given commodity using market prices at posting date
| AtEnd (Maybe CommoditySymbol) -- ^ convert to default valuation commodity or given commodity, using market prices at period end(s)
| AtNow (Maybe CommoditySymbol) -- ^ convert to default valuation commodity or given commodity, using current market prices
| AtDate Day (Maybe CommoditySymbol) -- ^ convert to default valuation commodity or given commodity, using market prices on some date
| AtDefault (Maybe CommoditySymbol) -- ^ works like AtNow in single period reports, like AtEnd in multiperiod reports
deriving (Show,Data,Eq) -- Typeable
-- | A Journal, containing transactions and various other things.
-- The basic data model for hledger.
--

View File

@ -74,6 +74,7 @@ balanceReport ropts@ReportOpts{..} q j =
today = fromMaybe (error' "balanceReport: ReportOpts today_ is unset so could not satisfy --value=now") today_
multiperiod = interval_ /= NoInterval
prices = journalPrices j
styles = journalCommodityStyles j
-- Get all the summed accounts & balances, according to the query, as an account tree.
-- If doing cost valuation, amounts will be converted to cost first.
@ -84,14 +85,7 @@ balanceReport ropts@ReportOpts{..} q j =
where
valueaccount a@Account{..} = a{aebalance=val aebalance, aibalance=val aibalance}
where
val = case value_ of
Nothing -> id
Just (AtCost _mc) -> id
Just (AtEnd _mc) -> mixedAmountValue prices periodlastday
Just (AtNow _mc) -> mixedAmountValue prices today
Just (AtDefault _mc) | multiperiod -> mixedAmountValue prices periodlastday
Just (AtDefault _mc) -> mixedAmountValue prices today
Just (AtDate d _mc) -> mixedAmountValue prices d
val = maybe id (mixedAmountApplyValuation prices styles periodlastday today multiperiod) value_
where
periodlastday =
fromMaybe (error' "balanceReport: expected a non-empty journal") $ -- XXX shouldn't happen

View File

@ -41,33 +41,22 @@ entriesReport ropts@ReportOpts{..} q j@Journal{..} =
prices = journalPrices j
styles = journalCommodityStyles j
tvalue t@Transaction{..} = t{tpostings=map pvalue tpostings}
pvalue p@Posting{..} = case value_ of
Nothing -> p
Just (AtCost _mc) -> postingToCost styles p
Just (AtEnd _mc) -> valueend p
Just (AtNow _mc) -> valuenow p
Just (AtDefault _mc) -> valuenow p
Just (AtDate d _mc) -> postingValue prices d p
pvalue p = maybe p (postingApplyValuation prices styles end today False p) value_
where
valueend p = postingValue prices (
fromMaybe (postingDate p) -- XXX shouldn't happen
mperiodorjournallastday
) p
valuenow p = postingValue prices (
case today_ of Just d -> d
Nothing -> error' "erValue: ReportOpts today_ is unset so could not satisfy --value=now"
) p
mperiodorjournallastday = mperiodlastday <|> journalEndDate False j
today = fromMaybe (error' "erValue: ReportOpts today_ is unset so could not satisfy --value=now") today_
end = fromMaybe (postingDate p) mperiodorjournallastday
where
-- The last day of the report period.
-- Will be Nothing if no report period is specified, or also
-- if ReportOpts does not have today_ set, since we need that
-- to get the report period robustly.
mperiodlastday :: Maybe Day = do
t <- today_
let q = queryFromOpts t ropts
qend <- queryEndDate False q
return $ addDays (-1) qend
mperiodorjournallastday = mperiodlastday <|> journalEndDate False j
where
-- The last day of the report period.
-- Will be Nothing if no report period is specified, or also
-- if ReportOpts does not have today_ set, since we need that
-- to get the report period robustly.
mperiodlastday :: Maybe Day = do
t <- today_
let q = queryFromOpts t ropts
qend <- queryEndDate False q
return $ addDays (-1) qend
tests_EntriesReport = tests "EntriesReport" [
tests "entriesReport" [

View File

@ -157,8 +157,9 @@ multiBalanceReport ropts@ReportOpts{..} q j@Journal{..} =
-- end: summed/averaged row amounts
-- date: summed/averaged row amounts
today = fromMaybe (error' "postingsReport: ReportOpts today_ is unset so could not satisfy --value=now") today_
-- Market prices.
-- Market prices, commodity display styles.
prices = journalPrices j
styles = journalCommodityStyles j
-- The last day of each column subperiod.
lastdays :: [Day] =
map ((maybe
@ -273,17 +274,8 @@ multiBalanceReport ropts@ReportOpts{..} q j@Journal{..} =
CumulativeChange -> drop 1 $ scanl (+) 0 changes
HistoricalBalance -> drop 1 $ scanl (+) (startingBalanceFor a) changes
-- The row amounts valued according to --value if needed.
, let rowbalsendvalue = [mixedAmountValue prices periodlastday amt | (amt,periodlastday) <- zip rowbals lastdays]
, let rowbalsdatevalue d = [mixedAmountValue prices d amt | amt <- rowbals]
, let valuedrowbals = dbg1 "valuedrowbals" $ case value_ of
Nothing -> rowbals
Just (AtCost _mc) -> rowbals -- cost valuation was handled earlier
Just (AtEnd _mc) -> rowbalsendvalue
Just (AtNow _mc) -> rowbalsdatevalue today
Just (AtDefault _mc) | multiperiod -> rowbalsendvalue
Just (AtDefault _mc) -> rowbalsdatevalue today
Just (AtDate d _mc) -> rowbalsdatevalue d
, let val end = maybe id (mixedAmountApplyValuation prices styles end today multiperiod) value_
, let valuedrowbals = dbg1 "valuedrowbals" $ [val periodlastday amt | (amt,periodlastday) <- zip rowbals lastdays]
-- The total and average for the row, and their values.
-- Total for a cumulative/historical report is always zero.
, let rowtot = if balancetype_==PeriodChange then sum valuedrowbals else 0

View File

@ -74,6 +74,7 @@ postingsReport ropts@ReportOpts{..} q j@Journal{..} =
whichdate = whichDateFromOpts ropts
depth = queryDepth q
prices = journalPrices j
styles = journalCommodityStyles j
-- postings to be included in the report, and similarly-matched postings before the report start date
(precedingps, reportps) = matchedPostingsBeforeAndDuring ropts q j reportspan
@ -91,49 +92,26 @@ postingsReport ropts@ReportOpts{..} q j@Journal{..} =
--
-- In all cases, the running total/average is calculated from the above numbers.
-- "Day before report start" is a bit arbitrary.
today = fromMaybe (error' "postingsReport: ReportOpts today_ is unset so could not satisfy --value=now") today_
today =
fromMaybe (error' "postingsReport: ReportOpts today_ is unset so could not satisfy --value=now")
today_
reportperiodlastday =
fromMaybe (error' "postingsReport: expected a non-empty journal") $ -- XXX shouldn't happen
reportPeriodOrJournalLastDay ropts j
multiperiod = interval_ /= NoInterval
showempty = empty_ || average_
pvalue p end = maybe p (postingApplyValuation prices styles end today multiperiod p) value_
-- Postings, or summary postings along with their subperiod's end date, to be displayed.
displayps :: [(Posting, Maybe Day)] =
if multiperiod then
let
showempty = empty_ || average_
summaryps = summarisePostingsByInterval interval_ whichdate depth showempty reportspan reportps
summaryps' = [(p, Just e) | (p,e) <- summaryps]
summarypsendvalue = [ (postingValue prices periodlastday p, Just periodend)
| (p,periodend) <- summaryps
, let periodlastday = addDays (-1) periodend
]
summarypsdatevalue d = [(postingValue prices d p, Just periodend) | (p,periodend) <- summaryps]
in case value_ of
Nothing -> summaryps'
Just (AtCost _mc) -> summaryps' -- conversion to cost was done earlier
Just (AtEnd _mc) -> summarypsendvalue
Just (AtNow _mc) -> summarypsdatevalue today
Just (AtDefault _mc) | multiperiod -> summarypsendvalue
Just (AtDefault _mc) -> summarypsdatevalue today
Just (AtDate d _mc) -> summarypsdatevalue d
else
let
reportperiodlastday =
fromMaybe (error' "postingsReport: expected a non-empty journal") -- XXX shouldn't happen
$ reportPeriodOrJournalLastDay ropts j
reportpsdatevalue d = [(postingValue prices d p, Nothing) | p <- reportps]
reportpsnovalue = [(p, Nothing) | p <- reportps]
in case value_ of
Nothing -> reportpsnovalue
Just (AtCost _mc) -> reportpsnovalue -- conversion to cost was done earlier
Just (AtEnd _mc) -> reportpsdatevalue reportperiodlastday
Just (AtNow _mc) -> reportpsdatevalue today
Just (AtDefault _mc) | multiperiod -> reportpsdatevalue reportperiodlastday
Just (AtDefault _mc) -> reportpsdatevalue today
Just (AtDate d _mc) -> reportpsdatevalue d
-- Postings, or summary postings with their subperiod's end date, to be displayed.
displayps :: [(Posting, Maybe Day)]
| multiperiod =
let summaryps = summarisePostingsByInterval interval_ whichdate depth showempty reportspan reportps
in [(pvalue p lastday, Just periodend) | (p, periodend) <- summaryps, let lastday = addDays (-1) periodend]
| otherwise =
[(pvalue p reportperiodlastday, Nothing) | p <- reportps]
-- posting report items ready for display
items = dbg1 "postingsReport items" $ postingsReportItems displayps (nullposting,Nothing) whichdate depth valuedstartbal runningcalc startnum
items = dbg1 "postingsReport items" $ postingsReportItems displayps (nullposting,Nothing) whichdate depth startbalvalued runningcalc startnum
where
historical = balancetype_ == HistoricalBalance
precedingsum = sumPostings precedingps
@ -142,20 +120,14 @@ postingsReport ropts@ReportOpts{..} q j@Journal{..} =
startbal | average_ = if historical then precedingavg else 0
| otherwise = if historical then precedingsum else 0
-- For --value=end/now/DATE, convert the initial running total/average to value.
startbaldatevalue d = mixedAmountValue prices d startbal
valuedstartbal = case value_ of
Nothing -> startbal
Just (AtCost _mc) -> startbal -- conversion to cost was done earlier
Just (AtEnd _mc) -> startbaldatevalue daybeforereportstart
Just (AtNow _mc) -> startbaldatevalue today
Just (AtDefault _mc) | multiperiod -> startbaldatevalue daybeforereportstart
Just (AtDefault _mc) -> startbaldatevalue today
Just (AtDate d _mc) -> startbaldatevalue d
startbalvalued = val startbal
where
daybeforereportstart = maybe
(error' "postingsReport: expected a non-empty journal") -- XXX shouldn't happen
(addDays (-1))
$ reportPeriodOrJournalStart ropts j
val = maybe id (mixedAmountApplyValuation prices styles daybeforereportstart today multiperiod) value_
where
daybeforereportstart = maybe
(error' "postingsReport: expected a non-empty journal") -- XXX shouldn't happen
(addDays (-1))
$ reportPeriodOrJournalStart ropts j
startnum = if historical then length precedingps + 1 else 1
runningcalc = registerRunningCalculationFn ropts

View File

@ -78,18 +78,6 @@ data AccountListMode = ALDefault | ALTree | ALFlat deriving (Eq, Show, Data, Typ
instance Default AccountListMode where def = ALDefault
-- | What kind of value conversion should be done on amounts ?
-- UI: --value=cost|end|now|DATE[,COMM]
data ValuationType =
AtCost (Maybe CommoditySymbol) -- ^ convert to cost commodity using transaction prices, then optionally to given commodity using market prices at posting date
| AtEnd (Maybe CommoditySymbol) -- ^ convert to default valuation commodity or given commodity, using market prices at period end(s)
| AtNow (Maybe CommoditySymbol) -- ^ convert to default valuation commodity or given commodity, using current market prices
| AtDate Day (Maybe CommoditySymbol) -- ^ convert to default valuation commodity or given commodity, using market prices on some date
| AtDefault (Maybe CommoditySymbol) -- ^ works like AtNow in single period reports, like AtEnd in multiperiod reports
deriving (Show,Data,Eq) -- Typeable
-- instance Default ValuationType where def = AtNow Nothing
-- | Standard options for customising report filtering and output.
-- Most of these correspond to standard hledger command-line options
-- or query arguments, but not all. Some are used only by certain