diff --git a/hledger-lib/Hledger/Data/Posting.hs b/hledger-lib/Hledger/Data/Posting.hs index 57a8ce7d9..56c2c173e 100644 --- a/hledger-lib/Hledger/Data/Posting.hs +++ b/hledger-lib/Hledger/Data/Posting.hs @@ -334,17 +334,16 @@ 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 -> Maybe Day -> Day -> Bool -> Posting -> ValuationType -> Posting -postingApplyValuation priceoracle styles periodlast mreportlast today ismultiperiod p v = +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 - AtDefault mc | ismultiperiod -> postingValueAtDate priceoracle styles mc periodlast p - AtDefault mc -> postingValueAtDate priceoracle styles mc (fromMaybe today mreportlast) p - AtDate d mc -> postingValueAtDate priceoracle styles mc d p + 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 + AtDefault mc -> postingValueAtDate priceoracle styles mc periodlast p + AtDate d mc -> postingValueAtDate priceoracle styles mc d p -- | Convert this posting's amount to cost, and apply the appropriate amount styles. postingToCost :: M.Map CommoditySymbol AmountStyle -> Posting -> Posting diff --git a/hledger-lib/Hledger/Data/Transaction.hs b/hledger-lib/Hledger/Data/Transaction.hs index e0b5b090e..18f4ccf01 100644 --- a/hledger-lib/Hledger/Data/Transaction.hs +++ b/hledger-lib/Hledger/Data/Transaction.hs @@ -584,9 +584,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 -> Maybe Day -> Day -> Bool -> Transaction -> ValuationType -> Transaction -transactionApplyValuation priceoracle styles periodlast mreportlast today ismultiperiod t v = - transactionTransformPostings (\p -> postingApplyValuation priceoracle styles periodlast mreportlast today ismultiperiod p v) t +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 -- | Convert this transaction's amounts to cost, and apply the appropriate amount styles. transactionToCost :: M.Map CommoditySymbol AmountStyle -> Transaction -> Transaction diff --git a/hledger-lib/Hledger/Data/Valuation.hs b/hledger-lib/Hledger/Data/Valuation.hs index 64a4a830f..0e4c15bf5 100644 --- a/hledger-lib/Hledger/Data/Valuation.hs +++ b/hledger-lib/Hledger/Data/Valuation.hs @@ -34,7 +34,6 @@ import Data.List ( (\\), sortBy ) import Data.List.Extra (nubSortBy) import qualified Data.Map as M import qualified Data.Set as S -import Data.Maybe ( fromMaybe ) import qualified Data.Text as T import Data.Time.Calendar (Day, fromGregorian) import Data.MemoUgly (memo) @@ -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 -> Maybe Day -> Day -> Bool -> ValuationType -> MixedAmount -> MixedAmount -mixedAmountApplyValuation priceoracle styles periodlast mreportlast today ismultiperiod v (Mixed as) = - Mixed $ map (amountApplyValuation priceoracle styles periodlast mreportlast today ismultiperiod v) as +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 -- | Apply a specified valuation to this amount, using the provided -- price oracle, reference dates, and whether this is for a @@ -133,18 +132,17 @@ mixedAmountApplyValuation priceoracle styles periodlast mreportlast today ismult -- 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 -> Maybe Day -> Day -> Bool -> ValuationType -> Amount -> Amount -amountApplyValuation priceoracle styles periodlast mreportlast today ismultiperiod v a = +amountApplyValuation :: PriceOracle -> M.Map CommoditySymbol AmountStyle -> Day -> Day -> ValuationType -> Amount -> Amount +amountApplyValuation priceoracle styles periodlast today 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 - AtEnd mc -> amountValueAtDate priceoracle styles mc periodlast a - AtNow mc -> amountValueAtDate priceoracle styles mc today a - AtDefault mc | ismultiperiod -> amountValueAtDate priceoracle styles mc periodlast a - AtDefault mc -> amountValueAtDate priceoracle styles mc (fromMaybe today mreportlast) a - AtDate d mc -> amountValueAtDate priceoracle styles mc d a + 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 + AtEnd mc -> amountValueAtDate priceoracle styles mc periodlast a + AtNow mc -> amountValueAtDate priceoracle styles mc today a + AtDefault mc -> amountValueAtDate priceoracle styles mc periodlast a + AtDate d mc -> amountValueAtDate priceoracle styles mc d a -- | Standard error message for a report not supporting --value=then. unsupportedValueThenError :: String diff --git a/hledger-lib/Hledger/Reports/AccountTransactionsReport.hs b/hledger-lib/Hledger/Reports/AccountTransactionsReport.hs index ba7506fcc..43c900704 100644 --- a/hledger-lib/Hledger/Reports/AccountTransactionsReport.hs +++ b/hledger-lib/Hledger/Reports/AccountTransactionsReport.hs @@ -116,14 +116,12 @@ accountTransactionsReport rspec@ReportSpec{rsOpts=ropts} j reportq thisacctq = ( periodlast = fromMaybe (error' "journalApplyValuation: expected a non-empty journal") $ -- XXX shouldn't happen reportPeriodOrJournalLastDay rspec j - mreportlast = reportPeriodLastDay rspec - multiperiod = interval_ ropts /= NoInterval tval = case value_ ropts of - Just v -> \t -> transactionApplyValuation prices styles periodlast mreportlast (rsToday rspec) multiperiod t v + Just v -> \t -> transactionApplyValuation prices styles periodlast (rsToday rspec) t v Nothing -> id ts4 = ptraceAtWith 5 (("ts4:\n"++).pshowTransactions) $ - map tval ts3 + map tval ts3 -- sort by the transaction's register date, for accurate starting balance -- these are not yet filtered by tdate, we want to search them all for priorps diff --git a/hledger-lib/Hledger/Reports/EntriesReport.hs b/hledger-lib/Hledger/Reports/EntriesReport.hs index 3357bee9a..545f9b607 100644 --- a/hledger-lib/Hledger/Reports/EntriesReport.hs +++ b/hledger-lib/Hledger/Reports/EntriesReport.hs @@ -41,11 +41,10 @@ entriesReport rspec@ReportSpec{rsOpts=ropts@ReportOpts{..}} j@Journal{..} = tvalue t@Transaction{..} = t{tpostings=map pvalue tpostings} where pvalue p = maybe p - (postingApplyValuation (journalPriceOracle infer_value_ j) (journalCommodityStyles j) periodlast mreportlast (rsToday rspec) False p) + (postingApplyValuation (journalPriceOracle infer_value_ j) (journalCommodityStyles j) periodlast (rsToday rspec) p) value_ where periodlast = fromMaybe (rsToday rspec) $ reportPeriodOrJournalLastDay rspec j - mreportlast = reportPeriodLastDay rspec tests_EntriesReport = tests "EntriesReport" [ tests "entriesReport" [ diff --git a/hledger-lib/Hledger/Reports/MultiBalanceReport.hs b/hledger-lib/Hledger/Reports/MultiBalanceReport.hs index e0b8b2ac8..3be0d96fe 100644 --- a/hledger-lib/Hledger/Reports/MultiBalanceReport.hs +++ b/hledger-lib/Hledger/Reports/MultiBalanceReport.hs @@ -253,12 +253,9 @@ makeReportQuery rspec reportspan 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 mreportlast (rsToday rspec) multiperiod v + Just v -> mixedAmountApplyValuation priceoracle styles day (rsToday rspec) v where - -- Some things needed if doing valuation. styles = journalCommodityStyles j - mreportlast = reportPeriodOrJournalLastDay rspec j - multiperiod = interval_ (rsOpts rspec) /= NoInterval -- | Group postings, grouped by their column getPostingsByColumn :: ReportSpec -> Journal -> DateSpan -> Map DateSpan [Posting] diff --git a/hledger-lib/Hledger/Reports/PostingsReport.hs b/hledger-lib/Hledger/Reports/PostingsReport.hs index 0350d9aa6..eac60c3d5 100644 --- a/hledger-lib/Hledger/Reports/PostingsReport.hs +++ b/hledger-lib/Hledger/Reports/PostingsReport.hs @@ -89,9 +89,7 @@ postingsReport rspec@ReportSpec{rsOpts=ropts@ReportOpts{..}} j = 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 mreportlast (rsToday rspec) multiperiod p) value_ - where - mreportlast = reportPeriodLastDay rspec + 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 @@ -112,7 +110,7 @@ postingsReport rspec@ReportSpec{rsOpts=ropts@ReportOpts{..}} j = precedingsum = sumPostings precedingps precedingavg | null precedingps = 0 | otherwise = divideMixedAmount (fromIntegral $ length precedingps) precedingsum - bvalue = maybe id (mixedAmountApplyValuation priceoracle styles daybeforereportstart Nothing (rsToday rspec) multiperiod) value_ + bvalue = maybe id (mixedAmountApplyValuation priceoracle styles daybeforereportstart $ rsToday rspec) value_ -- XXX constrain valuation type to AtDate daybeforereportstart here ? where daybeforereportstart = diff --git a/hledger-ui/Hledger/UI/TransactionScreen.hs b/hledger-ui/Hledger/UI/TransactionScreen.hs index c69bca6bb..eba68f026 100644 --- a/hledger-ui/Hledger/UI/TransactionScreen.hs +++ b/hledger-ui/Hledger/UI/TransactionScreen.hs @@ -78,13 +78,11 @@ tsDraw UIState{aopts=UIOpts{cliopts_=copts@CliOpts{reportspec_=rspec@ReportSpec{ periodlast = fromMaybe (error' "TransactionScreen: expected a non-empty journal") $ -- PARTIAL: shouldn't happen reportPeriodOrJournalLastDay rspec j - mreportlast = reportPeriodLastDay rspec - multiperiod = interval_ ropts /= NoInterval render $ defaultLayout toplabel bottomlabel $ str $ showTransactionOneLineAmounts $ (if valuationTypeIsCost ropts then transactionToCost (journalCommodityStyles j) else id) $ - (if valuationTypeIsDefaultValue ropts then (\t -> transactionApplyValuation prices styles periodlast mreportlast (rsToday rspec) multiperiod t (AtDefault Nothing)) else id) $ + (if valuationTypeIsDefaultValue ropts then (\t -> transactionApplyValuation prices styles periodlast (rsToday rspec) t (AtDefault Nothing)) else id) $ -- (if real_ ropts then filterTransactionPostings (Real True) else id) -- filter postings by --real t where