From 130739e3ef2b5f2bd7da55d6dbf83e4129bafb1d Mon Sep 17 00:00:00 2001 From: Stephen Morgan Date: Tue, 26 Jan 2021 09:26:25 +1100 Subject: [PATCH] lib,cli,ui: Introduce *ApplyCostValuation functions, which perform both costing and valuation. This currently is given a dummy NoCost argument and is equivalent to "maybe id (*ApplyValuation ...)", but provides a constant interface so that internal behaviour can be changed freely. --- hledger-lib/Hledger/Data/Posting.hs | 16 +++++++++--- hledger-lib/Hledger/Data/Transaction.hs | 13 +++++++--- hledger-lib/Hledger/Data/Valuation.hs | 26 ++++++++++++++++--- .../Reports/AccountTransactionsReport.hs | 2 +- hledger-lib/Hledger/Reports/EntriesReport.hs | 7 ++--- .../Hledger/Reports/MultiBalanceReport.hs | 14 +++++----- hledger-lib/Hledger/Reports/PostingsReport.hs | 2 +- hledger-ui/Hledger/UI/TransactionScreen.hs | 2 +- hledger/Hledger/Cli/Commands/Roi.hs | 9 ++----- 9 files changed, 58 insertions(+), 33 deletions(-) diff --git a/hledger-lib/Hledger/Data/Posting.hs b/hledger-lib/Hledger/Data/Posting.hs index 581536790..6833f77d4 100644 --- a/hledger-lib/Hledger/Data/Posting.hs +++ b/hledger-lib/Hledger/Data/Posting.hs @@ -64,6 +64,7 @@ module Hledger.Data.Posting ( -- * misc. showComment, postingTransformAmount, + postingApplyCostValuation, postingApplyValuation, postingToCost, tests_Posting @@ -330,17 +331,24 @@ aliasReplace (BasicAlias old new) a aliasReplace (RegexAlias re repl) a = fmap T.pack . regexReplace re repl $ T.unpack a -- XXX +-- | Apply a specified costing and valuation to this posting's amount, +-- using the provided price oracle, commodity styles, and reference dates. +-- Costing is done first if requested, and after that any valuation. +-- See amountApplyValuation and amountCost. +postingApplyCostValuation :: PriceOracle -> M.Map CommoditySymbol AmountStyle -> Day -> Day -> Costing -> Maybe ValuationType -> Posting -> Posting +postingApplyCostValuation priceoracle styles periodlast today cost v p = + postingTransformAmount (mixedAmountApplyCostValuation priceoracle styles periodlast today (postingDate p) cost v) p + -- | Apply a specified valuation to this posting's amount, using the --- provided price oracle, commodity styles, reference dates, and --- whether this is for a multiperiod report or not. See --- amountApplyValuation. +-- provided price oracle, commodity styles, and reference dates. +-- See amountApplyValuation. 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} +postingToCost styles = postingTransformAmount (styleMixedAmount styles . mixedAmountCost) -- | Apply a transform function to this posting's amount. postingTransformAmount :: (MixedAmount -> MixedAmount) -> Posting -> Posting diff --git a/hledger-lib/Hledger/Data/Transaction.hs b/hledger-lib/Hledger/Data/Transaction.hs index 95ab27cc4..40927ccdc 100644 --- a/hledger-lib/Hledger/Data/Transaction.hs +++ b/hledger-lib/Hledger/Data/Transaction.hs @@ -32,6 +32,7 @@ module Hledger.Data.Transaction ( balanceTransaction, balanceTransactionHelper, transactionTransformPostings, + transactionApplyCostValuation, transactionApplyValuation, transactionToCost, transactionApplyAliases, @@ -590,10 +591,16 @@ postingSetTransaction t p = p{ptransaction=Just t} transactionTransformPostings :: (Posting -> Posting) -> Transaction -> Transaction transactionTransformPostings f t@Transaction{tpostings=ps} = t{tpostings=map f ps} +-- | Apply a specified costing and valuation to this transaction's amounts, +-- using the provided price oracle, commodity styles, and reference dates. +-- See amountApplyValuation and amountCost. +transactionApplyCostValuation :: PriceOracle -> M.Map CommoditySymbol AmountStyle -> Day -> Day -> Costing -> Maybe ValuationType -> Transaction -> Transaction +transactionApplyCostValuation priceoracle styles periodlast today cost v = + transactionTransformPostings (postingApplyCostValuation priceoracle styles periodlast today cost v) + -- | Apply a specified valuation to this transaction's amounts, using --- the provided price oracle, commodity styles, reference dates, and --- whether this is for a multiperiod report or not. See --- amountApplyValuation. +-- the provided price oracle, commodity styles, and reference dates. +-- See amountApplyValuation. transactionApplyValuation :: PriceOracle -> M.Map CommoditySymbol AmountStyle -> Day -> Day -> ValuationType -> Transaction -> Transaction transactionApplyValuation priceoracle styles periodlast today v = transactionTransformPostings (postingApplyValuation priceoracle styles periodlast today v) diff --git a/hledger-lib/Hledger/Data/Valuation.hs b/hledger-lib/Hledger/Data/Valuation.hs index 073c8d84e..8ea3ed814 100644 --- a/hledger-lib/Hledger/Data/Valuation.hs +++ b/hledger-lib/Hledger/Data/Valuation.hs @@ -13,11 +13,13 @@ looking up historical market prices (exchange rates) between commodities. {-# LANGUAGE DeriveGeneric #-} module Hledger.Data.Valuation ( - ValuationType(..) + Costing(..) + ,ValuationType(..) ,PriceOracle ,journalPriceOracle -- ,amountApplyValuation -- ,amountValueAtDate + ,mixedAmountApplyCostValuation ,mixedAmountApplyValuation ,mixedAmountValueAtDate ,marketPriceReverse @@ -51,6 +53,10 @@ import Text.Printf (printf) ------------------------------------------------------------------------------ -- Types +-- | Whether to convert amounts to cost. +data Costing = Cost | NoCost + deriving (Show,Eq) + -- | What kind of value conversion should be done on amounts ? -- CLI: --value=cost|then|end|now|DATE[,COMM] data ValuationType = @@ -94,9 +100,21 @@ priceDirectiveToMarketPrice PriceDirective{..} = ------------------------------------------------------------------------------ -- Converting things to value +-- | Apply a specified costing and valuation to this mixed amount, +-- using the provided price oracle, commodity styles, and reference dates. +-- Costing is done first if requested, and after that any valuation. +-- See amountApplyValuation and amountCost. +mixedAmountApplyCostValuation :: PriceOracle -> M.Map CommoditySymbol AmountStyle -> Day -> Day -> Day -> Costing -> Maybe ValuationType -> MixedAmount -> MixedAmount +mixedAmountApplyCostValuation priceoracle styles periodlast today postingdate cost v = + valuation -- . costing + where + valuation = maybe id (mixedAmountApplyValuation priceoracle styles periodlast today postingdate) v + costing = case cost of + Cost -> styleMixedAmount styles . mixedAmountCost + NoCost -> id + -- | Apply a specified valuation to this mixed amount, using the --- provided price oracle, commodity styles, reference dates, and --- whether this is for a multiperiod report or not. +-- provided price oracle, commodity styles, and reference dates. -- See amountApplyValuation. mixedAmountApplyValuation :: PriceOracle -> M.Map CommoditySymbol AmountStyle -> Day -> Day -> Day -> ValuationType -> MixedAmount -> MixedAmount mixedAmountApplyValuation priceoracle styles periodlast today postingdate v = @@ -114,7 +132,7 @@ mixedAmountApplyValuation priceoracle styles periodlast today postingdate v = -- -- - a fixed date specified by the ValuationType itself -- (--value=DATE). --- +-- -- - the provided "period end" date - this is typically the last day -- of a subperiod (--value=end with a multi-period report), or of -- the specified report period or the journal (--value=end with a diff --git a/hledger-lib/Hledger/Reports/AccountTransactionsReport.hs b/hledger-lib/Hledger/Reports/AccountTransactionsReport.hs index d2cf07235..acfd30f75 100644 --- a/hledger-lib/Hledger/Reports/AccountTransactionsReport.hs +++ b/hledger-lib/Hledger/Reports/AccountTransactionsReport.hs @@ -111,7 +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 = maybe id (transactionApplyValuation prices styles periodlast (rsToday rspec)) $ value_ ropts + tval = transactionApplyCostValuation prices styles periodlast (rsToday rspec) NoCost $ value_ ropts ts4 = ptraceAtWith 5 (("ts4:\n"++).pshowTransactions) $ map tval ts3 diff --git a/hledger-lib/Hledger/Reports/EntriesReport.hs b/hledger-lib/Hledger/Reports/EntriesReport.hs index ef2259502..cb2147a90 100644 --- a/hledger-lib/Hledger/Reports/EntriesReport.hs +++ b/hledger-lib/Hledger/Reports/EntriesReport.hs @@ -40,11 +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 = maybe id - (postingApplyValuation (journalPriceOracle infer_value_ j) (journalCommodityStyles j) periodlast (rsToday rspec)) - value_ - where - periodlast = fromMaybe (rsToday rspec) $ reportPeriodOrJournalLastDay rspec j + pvalue = postingApplyCostValuation (journalPriceOracle infer_value_ j) (journalCommodityStyles j) periodlast (rsToday rspec) NoCost value_ + where periodlast = fromMaybe (rsToday rspec) $ reportPeriodOrJournalLastDay rspec j tests_EntriesReport = tests "EntriesReport" [ tests "entriesReport" [ diff --git a/hledger-lib/Hledger/Reports/MultiBalanceReport.hs b/hledger-lib/Hledger/Reports/MultiBalanceReport.hs index 77092ce7f..863aff908 100644 --- a/hledger-lib/Hledger/Reports/MultiBalanceReport.hs +++ b/hledger-lib/Hledger/Reports/MultiBalanceReport.hs @@ -574,17 +574,17 @@ cumulativeSum value start = snd . M.mapAccumWithKey accumValued start -- 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) +postingAndAccountValuations rspec@ReportSpec{rsOpts=ropts} j priceoracle + | changingValuation ropts = (const id, avalue' NoCost mv) + | otherwise = (pvalue' NoCost mv, 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 + avalue' c v span a = a{aibalance = value (aibalance a), aebalance = value (aebalance a)} + where value = mixedAmountApplyCostValuation priceoracle styles (end span) (rsToday rspec) (error "multiBalanceReport: did not expect amount valuation to be called ") c v -- PARTIAL: should not happen + pvalue' c v span = postingApplyCostValuation priceoracle styles (end span) (rsToday rspec) c v end = fromMaybe (error "multiBalanceReport: expected all spans to have an end date") -- XXX should not happen . fmap (addDays (-1)) . spanEnd styles = journalCommodityStyles j + mv = value_ ropts -- tests diff --git a/hledger-lib/Hledger/Reports/PostingsReport.hs b/hledger-lib/Hledger/Reports/PostingsReport.hs index 073757e46..e1a6fc48b 100644 --- a/hledger-lib/Hledger/Reports/PostingsReport.hs +++ b/hledger-lib/Hledger/Reports/PostingsReport.hs @@ -76,7 +76,7 @@ postingsReport rspec@ReportSpec{rsOpts=ropts@ReportOpts{..}} j = items (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_ + pvalue periodlast = postingApplyCostValuation priceoracle styles periodlast (rsToday rspec) NoCost value_ -- Postings, or summary postings with their subperiod's end date, to be displayed. displayps :: [(Posting, Maybe Day)] diff --git a/hledger-ui/Hledger/UI/TransactionScreen.hs b/hledger-ui/Hledger/UI/TransactionScreen.hs index 5e12ef8bf..e9b71f3db 100644 --- a/hledger-ui/Hledger/UI/TransactionScreen.hs +++ b/hledger-ui/Hledger/UI/TransactionScreen.hs @@ -81,7 +81,7 @@ tsDraw UIState{aopts=UIOpts{cliopts_=copts@CliOpts{reportspec_=rspec@ReportSpec{ render . defaultLayout toplabel bottomlabel . str . T.unpack . showTransactionOneLineAmounts - $ maybe id (transactionApplyValuation prices styles periodlast (rsToday rspec)) (value_ ropts) t + $ transactionApplyCostValuation prices styles periodlast (rsToday rspec) NoCost (value_ ropts) t -- (if real_ ropts then filterTransactionPostings (Real True) else id) -- filter postings by --real where toplabel = diff --git a/hledger/Hledger/Cli/Commands/Roi.hs b/hledger/Hledger/Cli/Commands/Roi.hs index ba6b806da..455400225 100644 --- a/hledger/Hledger/Cli/Commands/Roi.hs +++ b/hledger/Hledger/Cli/Commands/Roi.hs @@ -61,13 +61,8 @@ roi CliOpts{rawopts_=rawopts, reportspec_=rspec@ReportSpec{rsOpts=ReportOpts{..} d <- getCurrentDay -- We may be converting posting amounts to value, per hledger_options.m4.md "Effect of --value on reports". let - tvalue t@Transaction{..} = t{tpostings=map pvalue tpostings} - where - pvalue = maybe id - (postingApplyValuation (journalPriceOracle infer_value_ j) (journalCommodityStyles j) periodlast (rsToday rspec)) - value_ - where - periodlast = fromMaybe (rsToday rspec) $ reportPeriodOrJournalLastDay rspec j + tvalue = transactionApplyCostValuation (journalPriceOracle infer_value_ j) (journalCommodityStyles j) periodlast (rsToday rspec) NoCost value_ + where periodlast = fromMaybe (rsToday rspec) $ reportPeriodOrJournalLastDay rspec j let ropts = rsOpts rspec showCashFlow = boolopt "cashflow" rawopts