; refactor: centralise valuation logic #131
This commit is contained in:
Simon Michael
parent
ad83919c6a
commit
42ce95aaef
@ -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.
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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.
|
||||
--
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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" [
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
Loading…
Reference in New Issue
Block a user