lib,ui: Do all cost conversion and price stripping in journalSelectingAmountFromOpts.

2024-09-20 02:37:12 +03:00 · 2021-05-07 20:20:47 +10:00 · 2021-05-07 20:20:47 +10:00 · 53611be6e9
commit 53611be6e9
parent 0078f1a520
6 changed files with 54 additions and 59 deletions
--- a/hledger-lib/Hledger/Reports/AccountTransactionsReport.hs
+++ b/hledger-lib/Hledger/Reports/AccountTransactionsReport.hs
@ -84,45 +84,35 @@ accountTransactionsReport rspec@ReportSpec{rsOpts=ropts} j reportq thisacctq = i
  where
    -- a depth limit should not affect the account transactions report
    -- seems unnecessary for some reason XXX
-    reportq' = -- filterQuery (not . queryIsDepth)
-               reportq
-
-    -- get all transactions
-    ts1 =
-      -- ptraceAtWith 5 (("ts1:\n"++).pshowTransactions) $
-      jtxns j
-
-    -- apply any cur:SYM filters in reportq'
-    symq  = filterQuery queryIsSym reportq'
-    ts2 =
-      ptraceAtWith 5 (("ts2:\n"++).pshowTransactions) $
-      (if queryIsNull symq then id else map (filterTransactionAmounts symq)) ts1
-
-    -- keep just the transactions affecting this account (via possibly realness or status-filtered postings)
-    realq = filterQuery queryIsReal reportq'
-    statusq = filterQuery queryIsStatus reportq'
-    ts3 =
-      traceAt 3 ("thisacctq: "++show thisacctq) $
-      ptraceAtWith 5 (("ts3:\n"++).pshowTransactions) $
-      filter (matchesTransaction thisacctq . filterTransactionPostings (And [realq, statusq])) ts2
-
-    -- maybe convert these transactions to cost or value
-    -- PARTIAL:
-    prices = journalPriceOracle (infer_value_ ropts) j
-    styles = journalCommodityStyles j
+    reportq'   = reportq -- filterQuery (not . queryIsDepth)
+    symq       = filterQuery queryIsSym reportq'
+    realq      = filterQuery queryIsReal reportq'
+    statusq    = filterQuery queryIsStatus reportq'
+    prices     = journalPriceOracle (infer_value_ ropts) j
+    styles     = journalCommodityStyles j
    periodlast =
      fromMaybe (error' "journalApplyValuation: expected a non-empty journal") $ -- XXX shouldn't happen
      reportPeriodOrJournalLastDay rspec j
-    tval = transactionApplyCostValuation prices styles periodlast (rsToday rspec) (cost_ ropts) $ value_ ropts
-    ts4 =
-      ptraceAtWith 5 (("ts4:\n"++).pshowTransactions) $
-      map tval ts3
+    pvalue = maybe id (postingApplyValuation prices styles periodlast (rsToday rspec)) $ value_ ropts

    -- 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
-    ts5 =
-      ptraceAtWith 5 (("ts5:\n"++).pshowTransactions) $
-      sortBy (comparing (transactionRegisterDate reportq' thisacctq)) ts4
+    transactions =
+        ptraceAtWith 5 (("ts5:\n"++).pshowTransactions)
+      . sortBy (comparing (transactionRegisterDate reportq' thisacctq))
+      . jtxns
+      -- maybe convert these transactions to cost or value
+      . ptraceAtWith 5 (("ts4:\n"++).pshowTransactions.jtxns)
+      . journalMapPostings pvalue
+      . journalSelectingAmountFromOpts ropts
+      -- keep just the transactions affecting this account (via possibly realness or status-filtered postings)
+      . traceAt 3 ("thisacctq: "++show thisacctq)
+      . ptraceAtWith 5 (("ts3:\n"++).pshowTransactions.jtxns)
+      . filterJournalTransactions thisacctq
+      . filterJournalPostings (And [realq, statusq])
+      -- apply any cur:SYM filters in reportq'
+      . ptraceAtWith 5 (("ts2:\n"++).pshowTransactions.jtxns)
+      $ (if queryIsNull symq then id else filterJournalAmounts symq) j

    startbal
      | balancetype_ ropts == HistoricalBalance = sumPostings priorps
@ -132,7 +122,7 @@ accountTransactionsReport rspec@ReportSpec{rsOpts=ropts} j reportq thisacctq = i
                  filter (matchesPosting
                          (dbg5 "priorq" $
                           And [thisacctq, tostartdateq, datelessreportq]))
-                         $ transactionsPostings ts5
+                         $ transactionsPostings transactions
        tostartdateq =
          case mstartdate of
            Just _  -> Date (DateSpan Nothing mstartdate)
@ -149,7 +139,7 @@ accountTransactionsReport rspec@ReportSpec{rsOpts=ropts} j reportq thisacctq = i
    items = reverse $
            accountTransactionsReportItems reportq' thisacctq startbal maNegate $
            (if filtertxns then filter (reportq' `matchesTransaction`) else id) $
-            ts5
+            transactions

 pshowTransactions :: [Transaction] -> String
 pshowTransactions = pshow . map (\t -> unwords [show $ tdate t, T.unpack $ tdescription t])
--- a/hledger-lib/Hledger/Reports/EntriesReport.hs
+++ b/hledger-lib/Hledger/Reports/EntriesReport.hs
@ -33,15 +33,18 @@ type EntriesReportItem = Transaction

 -- | Select transactions for an entries report.
 entriesReport :: ReportSpec -> Journal -> EntriesReport
-entriesReport rspec@ReportSpec{rsOpts=ropts@ReportOpts{..}} j@Journal{..} =
-  sortBy (comparing getdate) $ filter (rsQuery rspec `matchesTransaction`) $ map tvalue jtxns
+entriesReport rspec@ReportSpec{rsOpts=ropts@ReportOpts{..}} j =
+  sortBy (comparing getdate) . jtxns . filterJournalTransactions (rsQuery rspec)
+    . journalMapPostings pvalue
+    $ journalSelectingAmountFromOpts ropts{show_costs_=True} j
  where
    getdate = transactionDateFn ropts
    -- 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}
+    pvalue = maybe id (postingApplyValuation priceoracle styles periodlast (rsToday rspec)) value_
      where
-        pvalue = postingApplyCostValuation (journalPriceOracle infer_value_ j) (journalCommodityStyles j) periodlast (rsToday rspec) cost_ value_
-          where periodlast  = fromMaybe (rsToday rspec) $ reportPeriodOrJournalLastDay rspec j
+        priceoracle = journalPriceOracle infer_value_ j
+        styles = journalCommodityStyles j
+        periodlast  = fromMaybe (rsToday rspec) $ reportPeriodOrJournalLastDay rspec j

 tests_EntriesReport = tests "EntriesReport" [
  tests "entriesReport" [
--- a/hledger-lib/Hledger/Reports/MultiBalanceReport.hs
+++ b/hledger-lib/Hledger/Reports/MultiBalanceReport.hs
@ -248,8 +248,9 @@ getPostings :: ReportSpec -> Journal -> [(Posting, Day)]
 getPostings ReportSpec{rsQuery=query,rsOpts=ropts} =
    map (\p -> (p, date p)) .
    journalPostings .
-    filterJournalAmounts symq .    -- remove amount parts excluded by cur:
-    filterJournalPostings reportq  -- remove postings not matched by (adjusted) query
+    filterJournalAmounts symq .      -- remove amount parts excluded by cur:
+    filterJournalPostings reportq .  -- remove postings not matched by (adjusted) query
+    journalSelectingAmountFromOpts ropts
  where
    symq = dbg3 "symq" . filterQuery queryIsSym $ dbg3 "requested q" query
    -- The user's query with no depth limit, and expanded to the report span
@ -553,25 +554,24 @@ cumulativeSum :: (DateSpan -> Account -> Account) -> Account -> Map DateSpan Acc
 cumulativeSum value start = snd . M.mapAccumWithKey accumValued start
  where accumValued startAmt date newAmt = let s = sumAcct startAmt newAmt in (s, value date s)

-- | Calculate the Posting and Account valuation functions required by this
-- MultiBalanceReport.
+-- | Calculate the Posting and Account valuation functions required by this MultiBalanceReport.
 postingAndAccountValuations :: ReportSpec -> Journal -> PriceOracle
                            -> (DateSpan -> Posting -> Posting, DateSpan -> Account -> Account)
 postingAndAccountValuations ReportSpec{rsToday=today, rsOpts=ropts} j priceoracle = case value_ ropts of
+    -- If we're doing no valuation, just return the identity functions.
+    Nothing          -> (const id, const id)
    -- If we're doing AtEnd valuation, we may need to value the same posting at different dates
-    -- (for example, when preparing a ValueChange report). So we should only convert to cost and
-    -- maybe strip prices from the Posting, and should do valuation on the Accounts.
-    Just v@(AtEnd _) -> (pvalue Nothing, avalue v)
-    -- Otherwise, all costing and valuation should be done on the Postings.
-    _                -> (pvalue (value_ ropts), const id)
+    -- (for example, when preparing a ValueChange report). So we should do valuation on the Accounts.
+    Just v@(AtEnd _) -> (const id, avalue v)
+    -- Otherwise, all valuation should be done on the Postings.
+    Just v           -> (pvalue v, const id)
  where
    -- For a Posting: convert to cost, apply valuation, then strip prices if we don't need them (See issue #1507).
-    pvalue v span = maybeStripPrices . postingApplyCostValuation priceoracle styles (end span) today (cost_ ropts) v
+    pvalue v span = postingApplyValuation priceoracle styles (end span) today v
    -- For an Account: Apply valuation to both the inclusive and exclusive balances.
    avalue v span a = a{aibalance = value (aibalance a), aebalance = value (aebalance a)}
      where value = mixedAmountApplyValuation priceoracle styles (end span) today (error "multiBalanceReport: did not expect amount valuation to be called ") v  -- PARTIAL: should not happen

-    maybeStripPrices = if show_costs_ ropts then id else postingStripPrices
    end = maybe (error "multiBalanceReport: expected all spans to have an end date")  -- PARTIAL: should not happen
            (addDays (-1)) . spanEnd
    styles = journalCommodityStyles j
--- a/hledger-lib/Hledger/Reports/PostingsReport.hs
+++ b/hledger-lib/Hledger/Reports/PostingsReport.hs
@ -76,9 +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".
-      -- Strip prices from postings if we won't need them.
-      pvalue periodlast = maybeStripPrices . postingApplyCostValuation priceoracle styles periodlast (rsToday rspec) cost_ value_
-        where maybeStripPrices = if show_costs_ then id else postingStripPrices
+      pvalue periodlast = maybe id (postingApplyValuation priceoracle styles periodlast (rsToday rspec)) value_

      -- Postings, or summary postings with their subperiod's end date, to be displayed.
      displayps :: [(Posting, Maybe Day)]
--- a/hledger-lib/Hledger/Reports/ReportOptions.hs
+++ b/hledger-lib/Hledger/Reports/ReportOptions.hs
@ -488,13 +488,14 @@ flat_ = not . tree_
 -- depthFromOpts :: ReportOpts -> Int
 -- depthFromOpts opts = min (fromMaybe 99999 $ depth_ opts) (queryDepth $ queryFromOpts nulldate opts)

-- | Convert this journal's postings' amounts to cost using their
-- transaction prices, if specified by options (-B/--cost).
-- Maybe soon superseded by newer valuation code.
+-- | Convert this journal's postings' amounts to cost using their transaction prices,
+-- if specified by options (-B/--cost). Strip prices if not needed.
 journalSelectingAmountFromOpts :: ReportOpts -> Journal -> Journal
-journalSelectingAmountFromOpts opts = case cost_ opts of
+journalSelectingAmountFromOpts ropts = maybeStripPrices . case cost_ ropts of
    Cost   -> journalToCost
    NoCost -> id
+  where
+    maybeStripPrices = if show_costs_ ropts then id else journalMapPostingAmounts mixedAmountStripPrices

 -- | Convert report options to a query, ignoring any non-flag command line arguments.
 queryFromFlags :: ReportOpts -> Query
--- a/hledger-ui/Hledger/UI/TransactionScreen.hs
+++ b/hledger-ui/Hledger/UI/TransactionScreen.hs
@ -83,7 +83,10 @@ tsDraw UIState{aopts=UIOpts{cliopts_=copts@CliOpts{reportspec_=rspec@ReportSpec{

      render . defaultLayout toplabel bottomlabel . str
        . T.unpack . showTransactionOneLineAmounts
-        $ transactionApplyCostValuation prices styles periodlast (rsToday rspec) (cost_ ropts) (value_ ropts) t
+        . maybe id (transactionApplyValuation prices styles periodlast (rsToday rspec)) (value_ ropts)
+        $ case cost_ ropts of
+               Cost   -> transactionToCost styles t
+               NoCost -> t
        -- (if real_ ropts then filterTransactionPostings (Real True) else id) -- filter postings by --real
      where
        toplabel =