diff --git a/hledger-lib/Hledger/Data/Amount.hs b/hledger-lib/Hledger/Data/Amount.hs index 39f7e733e..b3b57998a 100644 --- a/hledger-lib/Hledger/Data/Amount.hs +++ b/hledger-lib/Hledger/Data/Amount.hs @@ -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. diff --git a/hledger-lib/Hledger/Data/Posting.hs b/hledger-lib/Hledger/Data/Posting.hs index a4b7e2f03..724dcec30 100644 --- a/hledger-lib/Hledger/Data/Posting.hs +++ b/hledger-lib/Hledger/Data/Posting.hs @@ -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 diff --git a/hledger-lib/Hledger/Data/Types.hs b/hledger-lib/Hledger/Data/Types.hs index 167139475..71221d6d6 100644 --- a/hledger-lib/Hledger/Data/Types.hs +++ b/hledger-lib/Hledger/Data/Types.hs @@ -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. -- diff --git a/hledger-lib/Hledger/Reports/BalanceReport.hs b/hledger-lib/Hledger/Reports/BalanceReport.hs index e28a9ab1c..08f0b07e1 100644 --- a/hledger-lib/Hledger/Reports/BalanceReport.hs +++ b/hledger-lib/Hledger/Reports/BalanceReport.hs @@ -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 diff --git a/hledger-lib/Hledger/Reports/EntriesReport.hs b/hledger-lib/Hledger/Reports/EntriesReport.hs index 9ff2e63a4..ef34163fa 100644 --- a/hledger-lib/Hledger/Reports/EntriesReport.hs +++ b/hledger-lib/Hledger/Reports/EntriesReport.hs @@ -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" [ diff --git a/hledger-lib/Hledger/Reports/MultiBalanceReports.hs b/hledger-lib/Hledger/Reports/MultiBalanceReports.hs index 74cd02821..223c18404 100644 --- a/hledger-lib/Hledger/Reports/MultiBalanceReports.hs +++ b/hledger-lib/Hledger/Reports/MultiBalanceReports.hs @@ -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 diff --git a/hledger-lib/Hledger/Reports/PostingsReport.hs b/hledger-lib/Hledger/Reports/PostingsReport.hs index ebe79f2bc..7f5501021 100644 --- a/hledger-lib/Hledger/Reports/PostingsReport.hs +++ b/hledger-lib/Hledger/Reports/PostingsReport.hs @@ -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 diff --git a/hledger-lib/Hledger/Reports/ReportOptions.hs b/hledger-lib/Hledger/Reports/ReportOptions.hs index 013849a95..d4360c5ee 100644 --- a/hledger-lib/Hledger/Reports/ReportOptions.hs +++ b/hledger-lib/Hledger/Reports/ReportOptions.hs @@ -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