From 53611be6e9594e7ac54db95b91d8601105aeb928 Mon Sep 17 00:00:00 2001 From: Stephen Morgan Date: Fri, 7 May 2021 20:20:47 +1000 Subject: [PATCH 1/5] lib,ui: Do all cost conversion and price stripping in journalSelectingAmountFromOpts. --- .../Reports/AccountTransactionsReport.hs | 60 ++++++++----------- hledger-lib/Hledger/Reports/EntriesReport.hs | 13 ++-- .../Hledger/Reports/MultiBalanceReport.hs | 22 +++---- hledger-lib/Hledger/Reports/PostingsReport.hs | 4 +- hledger-lib/Hledger/Reports/ReportOptions.hs | 9 +-- hledger-ui/Hledger/UI/TransactionScreen.hs | 5 +- 6 files changed, 54 insertions(+), 59 deletions(-) diff --git a/hledger-lib/Hledger/Reports/AccountTransactionsReport.hs b/hledger-lib/Hledger/Reports/AccountTransactionsReport.hs index 49b717f97..7f8ca6acd 100644 --- 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]) diff --git a/hledger-lib/Hledger/Reports/EntriesReport.hs b/hledger-lib/Hledger/Reports/EntriesReport.hs index 9da872834..491909f37 100644 --- 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" [ diff --git a/hledger-lib/Hledger/Reports/MultiBalanceReport.hs b/hledger-lib/Hledger/Reports/MultiBalanceReport.hs index d46330ae1..383417a15 100644 --- 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 diff --git a/hledger-lib/Hledger/Reports/PostingsReport.hs b/hledger-lib/Hledger/Reports/PostingsReport.hs index 25eb91ecc..9a53bbc13 100644 --- 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)] diff --git a/hledger-lib/Hledger/Reports/ReportOptions.hs b/hledger-lib/Hledger/Reports/ReportOptions.hs index f72d23583..8608bde8a 100644 --- 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 diff --git a/hledger-ui/Hledger/UI/TransactionScreen.hs b/hledger-ui/Hledger/UI/TransactionScreen.hs index 7303df1b8..b5319726f 100644 --- 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 = From dc16451de0e7a519356653ce88b23a0176d0f202 Mon Sep 17 00:00:00 2001 From: Stephen Morgan Date: Fri, 7 May 2021 21:56:48 +1000 Subject: [PATCH 2/5] lib: Remove unused (amount|mixedAmount|posting|transaction)ApplyCostValuation functions. --- hledger-lib/Hledger/Data/Posting.hs | 9 ------- hledger-lib/Hledger/Data/Transaction.hs | 10 +------- hledger-lib/Hledger/Data/Valuation.hs | 33 +++++++------------------ hledger/Hledger/Cli/Commands/Roi.hs | 5 +++- 4 files changed, 14 insertions(+), 43 deletions(-) diff --git a/hledger-lib/Hledger/Data/Posting.hs b/hledger-lib/Hledger/Data/Posting.hs index 778e6c967..54c1d8f4a 100644 --- a/hledger-lib/Hledger/Data/Posting.hs +++ b/hledger-lib/Hledger/Data/Posting.hs @@ -64,7 +64,6 @@ module Hledger.Data.Posting ( -- * misc. showComment, postingTransformAmount, - postingApplyCostValuation, postingApplyValuation, postingToCost, tests_Posting @@ -332,14 +331,6 @@ 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, and reference dates. -- See amountApplyValuation. diff --git a/hledger-lib/Hledger/Data/Transaction.hs b/hledger-lib/Hledger/Data/Transaction.hs index 54e9d93c5..9f80c8ba0 100644 --- a/hledger-lib/Hledger/Data/Transaction.hs +++ b/hledger-lib/Hledger/Data/Transaction.hs @@ -33,7 +33,6 @@ module Hledger.Data.Transaction ( balanceTransaction, balanceTransactionHelper, transactionTransformPostings, - transactionApplyCostValuation, transactionApplyValuation, transactionToCost, transactionApplyAliases, @@ -615,13 +614,6 @@ 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, and reference dates. -- See amountApplyValuation. @@ -631,7 +623,7 @@ transactionApplyValuation priceoracle styles periodlast today v = -- | Convert this transaction's amounts to cost, and apply the appropriate amount styles. transactionToCost :: M.Map CommoditySymbol AmountStyle -> Transaction -> Transaction -transactionToCost styles t@Transaction{tpostings=ps} = t{tpostings=map (postingToCost styles) ps} +transactionToCost styles = transactionTransformPostings (postingToCost styles) -- | Apply some account aliases to all posting account names in the transaction, as described by accountNameApplyAliases. -- This can fail due to a bad replacement pattern in a regular expression alias. diff --git a/hledger-lib/Hledger/Data/Valuation.hs b/hledger-lib/Hledger/Data/Valuation.hs index c95b79130..7b301d2b3 100644 --- a/hledger-lib/Hledger/Data/Valuation.hs +++ b/hledger-lib/Hledger/Data/Valuation.hs @@ -17,10 +17,7 @@ module Hledger.Data.Valuation ( ,ValuationType(..) ,PriceOracle ,journalPriceOracle - ,amountApplyCostValuation - ,amountApplyValuation - ,amountValueAtDate - ,mixedAmountApplyCostValuation + ,mixedAmountToCost ,mixedAmountApplyValuation ,mixedAmountValueAtDate ,marketPriceReverse @@ -100,13 +97,9 @@ 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 = - mapMixedAmount (amountApplyCostValuation priceoracle styles periodlast today postingdate cost v) +-- | Convert all component amounts to cost/selling price if requested, and style them. +mixedAmountToCost :: Costing -> M.Map CommoditySymbol AmountStyle -> MixedAmount -> MixedAmount +mixedAmountToCost cost styles = mapMixedAmount (amountToCost cost styles) -- | Apply a specified valuation to this mixed amount, using the -- provided price oracle, commodity styles, and reference dates. @@ -115,18 +108,10 @@ mixedAmountApplyValuation :: PriceOracle -> M.Map CommoditySymbol AmountStyle -> mixedAmountApplyValuation priceoracle styles periodlast today postingdate v = mapMixedAmount (amountApplyValuation priceoracle styles periodlast today postingdate v) --- | Apply a specified costing and valuation to this 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. -amountApplyCostValuation :: PriceOracle -> M.Map CommoditySymbol AmountStyle -> Day -> Day -> Day -> Costing -> Maybe ValuationType -> Amount -> Amount -amountApplyCostValuation priceoracle styles periodlast today postingdate cost v = - valuation . costing - where - valuation = maybe id (amountApplyValuation priceoracle styles periodlast today postingdate) v - costing = case cost of - Cost -> styleAmount styles . amountCost - NoCost -> id +-- | Convert an Amount to its cost if requested, and style it appropriately. +amountToCost :: Costing -> M.Map CommoditySymbol AmountStyle -> Amount -> Amount +amountToCost NoCost _ = id +amountToCost Cost styles = styleAmount styles . amountCost -- | Apply a specified valuation to this amount, using the provided -- price oracle, reference dates, and whether this is for a @@ -151,7 +136,7 @@ amountApplyCostValuation priceoracle styles periodlast today postingdate cost v -- -- - the provided "today" date - (--value=now, or -V/X with no report -- end date). --- +-- -- This is all a bit complicated. See the reference doc at -- https://hledger.org/hledger.html#effect-of-valuation-on-reports -- (hledger_options.m4.md "Effect of valuation on reports"), and #1083. diff --git a/hledger/Hledger/Cli/Commands/Roi.hs b/hledger/Hledger/Cli/Commands/Roi.hs index b32c3869b..643674a7c 100644 --- a/hledger/Hledger/Cli/Commands/Roi.hs +++ b/hledger/Hledger/Cli/Commands/Roi.hs @@ -63,7 +63,10 @@ roi CliOpts{rawopts_=rawopts, reportspec_=rspec@ReportSpec{rsOpts=ReportOpts{..} priceOracle = journalPriceOracle infer_value_ j styles = journalCommodityStyles j today = rsToday rspec - mixedAmountValue periodlast date = mixedAmountApplyCostValuation priceOracle styles periodlast today date cost_ value_ + mixedAmountValue periodlast date = + maybe id (mixedAmountApplyValuation priceOracle styles periodlast today date) value_ + . mixedAmountToCost cost_ styles + let ropts = rsOpts rspec showCashFlow = boolopt "cashflow" rawopts From 6fb3dfdbb295a137bad08c04f7306632ac394596 Mon Sep 17 00:00:00 2001 From: Stephen Morgan Date: Thu, 13 May 2021 19:00:43 +1000 Subject: [PATCH 3/5] lib: Create journalApplyValuationFromOpts. This does costing and valuation on a journal, and is meant to replace most direct calls of costing and valuation. The exception is for reports which require amounts to be summed before valuation is applied, for example a historical balance report with --value=end. --- .../Reports/AccountTransactionsReport.hs | 12 ++--- hledger-lib/Hledger/Reports/EntriesReport.hs | 22 +++------ hledger-lib/Hledger/Reports/PostingsReport.hs | 28 +++--------- hledger-lib/Hledger/Reports/ReportOptions.hs | 45 +++++++++++++++++++ 4 files changed, 62 insertions(+), 45 deletions(-) diff --git a/hledger-lib/Hledger/Reports/AccountTransactionsReport.hs b/hledger-lib/Hledger/Reports/AccountTransactionsReport.hs index 7f8ca6acd..b718d53d8 100644 --- a/hledger-lib/Hledger/Reports/AccountTransactionsReport.hs +++ b/hledger-lib/Hledger/Reports/AccountTransactionsReport.hs @@ -19,7 +19,7 @@ where import Data.List (mapAccumL, nub, partition, sortBy) import Data.Ord (comparing) -import Data.Maybe (catMaybes, fromMaybe) +import Data.Maybe (catMaybes) import Data.Text (Text) import qualified Data.Text as T import Data.Time.Calendar (Day) @@ -88,12 +88,6 @@ accountTransactionsReport rspec@ReportSpec{rsOpts=ropts} j reportq thisacctq = i 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 - 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 @@ -103,7 +97,6 @@ accountTransactionsReport rspec@ReportSpec{rsOpts=ropts} j reportq thisacctq = i . 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) @@ -112,7 +105,8 @@ accountTransactionsReport rspec@ReportSpec{rsOpts=ropts} j reportq thisacctq = i . 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 + . (if queryIsNull symq then id else filterJournalAmounts symq) + $ journalApplyValuationFromOpts rspec j startbal | balancetype_ ropts == HistoricalBalance = sumPostings priorps diff --git a/hledger-lib/Hledger/Reports/EntriesReport.hs b/hledger-lib/Hledger/Reports/EntriesReport.hs index 491909f37..8565d361e 100644 --- a/hledger-lib/Hledger/Reports/EntriesReport.hs +++ b/hledger-lib/Hledger/Reports/EntriesReport.hs @@ -1,4 +1,6 @@ -{-# LANGUAGE OverloadedStrings, RecordWildCards, FlexibleInstances, ScopedTypeVariables #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} {-| Journal entries report, used by the print command. @@ -15,12 +17,11 @@ module Hledger.Reports.EntriesReport ( where import Data.List (sortBy) -import Data.Maybe (fromMaybe) import Data.Ord (comparing) import Data.Time (fromGregorian) import Hledger.Data -import Hledger.Query +import Hledger.Query (Query(..)) import Hledger.Reports.ReportOptions import Hledger.Utils @@ -33,18 +34,9 @@ type EntriesReportItem = Transaction -- | Select transactions for an entries report. entriesReport :: ReportSpec -> Journal -> EntriesReport -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". - pvalue = maybe id (postingApplyValuation priceoracle styles periodlast (rsToday rspec)) value_ - where - priceoracle = journalPriceOracle infer_value_ j - styles = journalCommodityStyles j - periodlast = fromMaybe (rsToday rspec) $ reportPeriodOrJournalLastDay rspec j +entriesReport rspec@ReportSpec{rsOpts=ropts} = + sortBy (comparing $ transactionDateFn ropts) . jtxns . filterJournalTransactions (rsQuery rspec) + . journalApplyValuationFromOpts rspec{rsOpts=ropts{show_costs_=True}} tests_EntriesReport = tests "EntriesReport" [ tests "entriesReport" [ diff --git a/hledger-lib/Hledger/Reports/PostingsReport.hs b/hledger-lib/Hledger/Reports/PostingsReport.hs index 9a53bbc13..cefa47298 100644 --- a/hledger-lib/Hledger/Reports/PostingsReport.hs +++ b/hledger-lib/Hledger/Reports/PostingsReport.hs @@ -68,28 +68,18 @@ postingsReport rspec@ReportSpec{rsOpts=ropts@ReportOpts{..}} j = items reportspan = reportSpanBothDates j rspec whichdate = whichDateFromOpts ropts mdepth = queryDepth $ rsQuery rspec - styles = journalCommodityStyles j - priceoracle = journalPriceOracle infer_value_ j multiperiod = interval_ /= NoInterval -- postings to be included in the report, and similarly-matched postings before the report start date (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_ - -- Postings, or summary postings with their subperiod's end date, to be displayed. displayps :: [(Posting, Maybe Day)] - | multiperiod, Just (AtEnd _) <- value_ = [(pvalue lastday p, Just periodend) | (p, periodend) <- summariseps reportps, let lastday = addDays (-1) periodend] - | multiperiod = [(p, Just periodend) | (p, periodend) <- summariseps valuedps] - | otherwise = [(p, Nothing) | p <- valuedps] + | multiperiod = [(p, Just periodend) | (p, periodend) <- summariseps reportps] + | otherwise = [(p, Nothing) | p <- reportps] where summariseps = summarisePostingsByInterval interval_ whichdate mdepth showempty reportspan - valuedps = map (pvalue reportorjournallast) reportps showempty = empty_ || average_ - reportorjournallast = - fromMaybe (error' "postingsReport: expected a non-empty journal") $ -- PARTIAL: shouldn't happen - reportPeriodOrJournalLastDay rspec j -- Posting report items ready for display. items = @@ -104,12 +94,8 @@ postingsReport rspec@ReportSpec{rsOpts=ropts@ReportOpts{..}} j = items startbal | average_ = if historical then precedingavg else nullmixedamt | otherwise = if historical then precedingsum else nullmixedamt where - precedingsum = sumPostings $ map (pvalue daybeforereportstart) precedingps + precedingsum = sumPostings precedingps precedingavg = divideMixedAmount (fromIntegral $ length precedingps) precedingsum - daybeforereportstart = - maybe (error' "postingsReport: expected a non-empty journal") -- PARTIAL: shouldn't happen - (addDays (-1)) - $ reportPeriodOrJournalStart rspec j runningcalc = registerRunningCalculationFn ropts startnum = if historical then length precedingps + 1 else 1 @@ -128,10 +114,10 @@ registerRunningCalculationFn ropts -- Date restrictions and depth restrictions in the query are ignored. -- A helper for the postings report. matchedPostingsBeforeAndDuring :: ReportSpec -> Journal -> DateSpan -> ([Posting],[Posting]) -matchedPostingsBeforeAndDuring ReportSpec{rsOpts=ropts,rsQuery=q} j (DateSpan mstart mend) = +matchedPostingsBeforeAndDuring rspec@ReportSpec{rsOpts=ropts,rsQuery=q} j reportspan = dbg5 "beforeps, duringps" $ span (beforestartq `matchesPosting`) beforeandduringps where - beforestartq = dbg3 "beforestartq" $ dateqtype $ DateSpan Nothing mstart + beforestartq = dbg3 "beforestartq" $ dateqtype $ DateSpan Nothing $ spanStart reportspan beforeandduringps = dbg5 "ps5" $ sortOn sortdate $ -- sort postings by date or date2 dbg5 "ps4" $ (if invert_ ropts then map negatePostingAmount else id) $ -- with --invert, invert amounts @@ -139,13 +125,13 @@ matchedPostingsBeforeAndDuring ReportSpec{rsOpts=ropts,rsQuery=q} j (DateSpan ms dbg5 "ps2" $ (if related_ ropts then concatMap relatedPostings else id) $ -- with -r, replace each with its sibling postings dbg5 "ps1" $ filter (beforeandduringq `matchesPosting`) $ -- filter postings by the query, with no start date or depth limit journalPostings $ - journalSelectingAmountFromOpts ropts j -- maybe convert to cost early, will be seen by amt:. XXX what about converting to value ? + journalApplyValuationFromOpts rspec j -- convert to cost and apply valuation where beforeandduringq = dbg4 "beforeandduringq" $ And [depthless $ dateless q, beforeendq] where depthless = filterQuery (not . queryIsDepth) dateless = filterQuery (not . queryIsDateOrDate2) - beforeendq = dateqtype $ DateSpan Nothing mend + beforeendq = dateqtype $ DateSpan Nothing $ spanEnd reportspan sortdate = if date2_ ropts then postingDate2 else postingDate symq = dbg4 "symq" $ filterQuery queryIsSym q dateqtype diff --git a/hledger-lib/Hledger/Reports/ReportOptions.hs b/hledger-lib/Hledger/Reports/ReportOptions.hs index 8608bde8a..985aeda19 100644 --- a/hledger-lib/Hledger/Reports/ReportOptions.hs +++ b/hledger-lib/Hledger/Reports/ReportOptions.hs @@ -29,6 +29,8 @@ module Hledger.Reports.ReportOptions ( simplifyStatuses, whichDateFromOpts, journalSelectingAmountFromOpts, + journalApplyValuationFromOpts, + journalApplyValuationFromOptsWith, intervalFromRawOpts, forecastPeriodFromRawOpts, queryFromFlags, @@ -47,6 +49,7 @@ module Hledger.Reports.ReportOptions ( where import Control.Applicative ((<|>)) +import Control.Monad ((<=<)) import Data.List.Extra (nubSort) import Data.Maybe (fromMaybe, mapMaybe) import qualified Data.Text as T @@ -497,6 +500,48 @@ journalSelectingAmountFromOpts ropts = maybeStripPrices . case cost_ ropts of where maybeStripPrices = if show_costs_ ropts then id else journalMapPostingAmounts mixedAmountStripPrices +-- | Convert this journal's postings' amounts to cost using their transaction +-- prices and apply valuation, if specified by options (-B/--cost). Strip prices +-- if not needed. This should be the main stop for performing costing and valuation. +-- The exception is whenever you need to perform valuation _after_ summing up amounts, +-- as in a historical balance report with --value=end. valuationAfterSum will +-- check for this condition. +journalApplyValuationFromOpts :: ReportSpec -> Journal -> Journal +journalApplyValuationFromOpts rspec j = + journalApplyValuationFromOptsWith rspec j priceoracle + where priceoracle = journalPriceOracle (infer_value_ $ rsOpts rspec) j + +-- | Like journalApplyValuationFromOpts, but takes PriceOracle as an argument. +journalApplyValuationFromOptsWith :: ReportSpec -> Journal -> PriceOracle -> Journal +journalApplyValuationFromOptsWith rspec@ReportSpec{rsOpts=ropts} j priceoracle = + journalMapPostings (valuation . maybeStripPrices) $ costing j + where + valuation p = maybe id (postingApplyValuation priceoracle styles (periodEnd p) (rsToday rspec)) (value_ ropts) p + maybeStripPrices = if show_costs_ ropts then id else postingStripPrices + costing = case cost_ ropts of + Cost -> journalToCost + NoCost -> id + + -- Find the end of the period containing this posting + periodEnd = addDays (-1) . fromMaybe err . mPeriodEnd . postingDate + mPeriodEnd = spanEnd <=< latestSpanContaining (historical : spans) + historical = DateSpan Nothing $ spanStart =<< headMay spans + spans = splitSpan (interval_ ropts) $ reportSpanBothDates j rspec + styles = journalCommodityStyles j + err = error' "journalApplyValuationFromOpts: expected a non-empty journal" + +-- | Whether we need to perform valuation after summing amounts, as in a +-- historical report with --value=end. +valuationAfterSum :: ReportOpts -> Bool +valuationAfterSum ropts = case value_ ropts of + Just (AtEnd _) -> case (reporttype_ ropts, balancetype_ ropts) of + (ValueChangeReport, _) -> True + (_, HistoricalBalance) -> True + (_, CumulativeChange) -> True + _ -> False + _ -> False + + -- | Convert report options to a query, ignoring any non-flag command line arguments. queryFromFlags :: ReportOpts -> Query queryFromFlags ReportOpts{..} = simplifyQuery $ And flagsq From 940b2c6ab905593e4e3e9b02470f3054df381963 Mon Sep 17 00:00:00 2001 From: Stephen Morgan Date: Thu, 13 May 2021 20:48:31 +1000 Subject: [PATCH 4/5] lib: Create mixedAmountApplyValuationAfterSumFromOptsWith for doing any valuation needed after summing amounts. --- .../Hledger/Reports/MultiBalanceReport.hs | 57 +++++++------------ hledger-lib/Hledger/Reports/ReportOptions.hs | 38 +++++++++---- 2 files changed, 47 insertions(+), 48 deletions(-) diff --git a/hledger-lib/Hledger/Reports/MultiBalanceReport.hs b/hledger-lib/Hledger/Reports/MultiBalanceReport.hs index 383417a15..b30e9571b 100644 --- a/hledger-lib/Hledger/Reports/MultiBalanceReport.hs +++ b/hledger-lib/Hledger/Reports/MultiBalanceReport.hs @@ -42,13 +42,13 @@ import Data.HashMap.Strict (HashMap) import qualified Data.HashMap.Strict as HM import Data.Map (Map) import qualified Data.Map as M -import Data.Maybe (fromMaybe, mapMaybe) +import Data.Maybe (fromMaybe, isJust, mapMaybe) import Data.Ord (Down(..)) #if !(MIN_VERSION_base(4,11,0)) import Data.Semigroup ((<>)) #endif import Data.Semigroup (sconcat) -import Data.Time.Calendar (Day, addDays, fromGregorian) +import Data.Time.Calendar (Day, fromGregorian) import Safe (lastDef, minimumMay) import Hledger.Data @@ -115,7 +115,7 @@ multiBalanceReportWith rspec' j priceoracle = report rspec = dbg3 "reportopts" $ makeReportQuery rspec' reportspan -- Group postings into their columns. - colps = dbg5 "colps" $ getPostingsByColumn rspec j reportspan + colps = dbg5 "colps" $ getPostingsByColumn rspec j priceoracle reportspan -- The matched accounts with a starting balance. All of these should appear -- in the report, even if they have no postings during the report period. @@ -143,7 +143,7 @@ compoundBalanceReportWith rspec' j priceoracle subreportspecs = cbr rspec = dbg3 "reportopts" $ makeReportQuery rspec' reportspan -- Group postings into their columns. - colps = dbg5 "colps" $ getPostingsByColumn rspec j reportspan + colps = dbg5 "colps" $ getPostingsByColumn rspec j priceoracle reportspan -- The matched accounts with a starting balance. All of these should appear -- in the report, even if they have no postings during the report period. @@ -191,7 +191,7 @@ startingBalances rspec@ReportSpec{rsQuery=query,rsOpts=ropts} j priceoracle repo fmap (M.findWithDefault nullacct precedingspan) acctmap where acctmap = calculateReportMatrix rspec' j priceoracle mempty - . M.singleton precedingspan . map fst $ getPostings rspec' j + . M.singleton precedingspan . map fst $ getPostings rspec' j priceoracle rspec' = rspec{rsQuery=startbalq,rsOpts=ropts'} -- If we're re-valuing every period, we need to have the unvalued start @@ -229,11 +229,11 @@ makeReportQuery rspec reportspan dateqcons = if date2_ (rsOpts rspec) then Date2 else Date -- | Group postings, grouped by their column -getPostingsByColumn :: ReportSpec -> Journal -> DateSpan -> Map DateSpan [Posting] -getPostingsByColumn rspec j reportspan = columns +getPostingsByColumn :: ReportSpec -> Journal -> PriceOracle -> DateSpan -> Map DateSpan [Posting] +getPostingsByColumn rspec j priceoracle reportspan = columns where -- Postings matching the query within the report period. - ps :: [(Posting, Day)] = dbg5 "getPostingsByColumn" $ getPostings rspec j + ps :: [(Posting, Day)] = dbg5 "getPostingsByColumn" $ getPostings rspec j priceoracle -- The date spans to be included as report columns. colspans = dbg3 "colspans" $ splitSpan (interval_ $ rsOpts rspec) reportspan @@ -244,13 +244,13 @@ getPostingsByColumn rspec j reportspan = columns columns = foldr addPosting emptyMap ps -- | Gather postings matching the query within the report period. -getPostings :: ReportSpec -> Journal -> [(Posting, Day)] -getPostings ReportSpec{rsQuery=query,rsOpts=ropts} = +getPostings :: ReportSpec -> Journal -> PriceOracle -> [(Posting, Day)] +getPostings rspec@ReportSpec{rsQuery=query,rsOpts=ropts} j priceoracle = map (\p -> (p, date p)) . journalPostings . filterJournalAmounts symq . -- remove amount parts excluded by cur: - filterJournalPostings reportq . -- remove postings not matched by (adjusted) query - journalSelectingAmountFromOpts ropts + filterJournalPostings reportq $ -- remove postings not matched by (adjusted) query + valuedJournal where symq = dbg3 "symq" . filterQuery queryIsSym $ dbg3 "requested q" query -- The user's query with no depth limit, and expanded to the report span @@ -258,6 +258,8 @@ getPostings ReportSpec{rsQuery=query,rsOpts=ropts} = -- handles the hledger-ui+future txns case above). reportq = dbg3 "reportq" $ depthless query depthless = dbg3 "depthless" . filterQuery (not . queryIsDepth) + valuedJournal | isJust (valuationAfterSum ropts) = j + | otherwise = journalApplyValuationFromOptsWith rspec j priceoracle date = case whichDateFromOpts ropts of PrimaryDate -> postingDate @@ -296,7 +298,7 @@ calculateReportMatrix rspec@ReportSpec{rsOpts=ropts} j priceoracle startbals col -- starting-balance-based historical balances. rowbals name changes = dbg5 "rowbals" $ case balancetype_ ropts of PeriodChange -> changeamts - CumulativeChange -> cumulativeSum avalue nullacct changeamts + CumulativeChange -> cumulative HistoricalBalance -> historical where -- changes to report on: usually just the changes itself, but use the @@ -305,6 +307,7 @@ calculateReportMatrix rspec@ReportSpec{rsOpts=ropts} j priceoracle startbals col ChangeReport -> M.mapWithKey avalue changes BudgetReport -> M.mapWithKey avalue changes ValueChangeReport -> periodChanges valuedStart historical + cumulative = cumulativeSum avalue nullacct changeamts historical = cumulativeSum avalue startingBalance changes startingBalance = HM.lookupDefault nullacct name startbals valuedStart = avalue (DateSpan Nothing historicalDate) startingBalance @@ -313,10 +316,10 @@ calculateReportMatrix rspec@ReportSpec{rsOpts=ropts} j priceoracle startbals col -- pad with zeros allchanges = ((<>zeros) <$> acctchanges) <> (zeros <$ startbals) acctchanges = dbg5 "acctchanges" . addElided $ transposeMap colacctchanges - colacctchanges = dbg5 "colacctchanges" $ fmap (acctChangesFromPostings rspec) valuedps - valuedps = M.mapWithKey (\colspan -> map (pvalue colspan)) colps + colacctchanges = dbg5 "colacctchanges" $ fmap (acctChangesFromPostings rspec) colps - (pvalue, avalue) = postingAndAccountValuations rspec j priceoracle + avalue = acctApplyBoth . mixedAmountApplyValuationAfterSumFromOptsWith ropts j priceoracle + acctApplyBoth f a = a{aibalance = f $ aibalance a, aebalance = f $ aebalance a} addElided = if queryDepth (rsQuery rspec) == Just 0 then HM.insert "..." zeros else id historicalDate = minimumMay $ mapMaybe spanStart colspans zeros = M.fromList [(span, nullacct) | span <- colspans] @@ -554,28 +557,6 @@ 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. -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 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 = 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 - - end = maybe (error "multiBalanceReport: expected all spans to have an end date") -- PARTIAL: should not happen - (addDays (-1)) . spanEnd - styles = journalCommodityStyles j - -- tests tests_MultiBalanceReport = tests "MultiBalanceReport" [ diff --git a/hledger-lib/Hledger/Reports/ReportOptions.hs b/hledger-lib/Hledger/Reports/ReportOptions.hs index 985aeda19..3991d7c8c 100644 --- a/hledger-lib/Hledger/Reports/ReportOptions.hs +++ b/hledger-lib/Hledger/Reports/ReportOptions.hs @@ -31,6 +31,8 @@ module Hledger.Reports.ReportOptions ( journalSelectingAmountFromOpts, journalApplyValuationFromOpts, journalApplyValuationFromOptsWith, + mixedAmountApplyValuationAfterSumFromOptsWith, + valuationAfterSum, intervalFromRawOpts, forecastPeriodFromRawOpts, queryFromFlags, @@ -528,18 +530,34 @@ journalApplyValuationFromOptsWith rspec@ReportSpec{rsOpts=ropts} j priceoracle = historical = DateSpan Nothing $ spanStart =<< headMay spans spans = splitSpan (interval_ ropts) $ reportSpanBothDates j rspec styles = journalCommodityStyles j - err = error' "journalApplyValuationFromOpts: expected a non-empty journal" + err = error "journalApplyValuationFromOpts: expected all spans to have an end date" --- | Whether we need to perform valuation after summing amounts, as in a --- historical report with --value=end. -valuationAfterSum :: ReportOpts -> Bool +-- | Calculate the Account valuation functions required for valuing after summing amounts. +-- Used in MultiBalanceReport to value historical reports and the like. +mixedAmountApplyValuationAfterSumFromOptsWith :: ReportOpts -> Journal -> PriceOracle -> (DateSpan -> MixedAmount -> MixedAmount) +mixedAmountApplyValuationAfterSumFromOptsWith ropts j priceoracle = case valuationAfterSum ropts of + Just mc -> \span -> valuation mc span . maybeStripPrices . costing + Nothing -> const id + where + valuation mc span = mixedAmountValueAtDate priceoracle styles mc (maybe err (addDays (-1)) $ spanEnd span) + where err = error "mixedAmountApplyValuationAfterSumFromOptsWith: expected all spans to have an end date" + maybeStripPrices = if show_costs_ ropts then id else mixedAmountStripPrices + costing = case cost_ ropts of + Cost -> styleMixedAmount styles . mixedAmountCost + NoCost -> id + styles = journalCommodityStyles j + +-- | If we are performing valuation after summing amounts, return Just the +-- commodity symbols we're converting to, otherwise return Nothing. +-- Used for example with historical reports with --value=end. +valuationAfterSum :: ReportOpts -> Maybe (Maybe CommoditySymbol) valuationAfterSum ropts = case value_ ropts of - Just (AtEnd _) -> case (reporttype_ ropts, balancetype_ ropts) of - (ValueChangeReport, _) -> True - (_, HistoricalBalance) -> True - (_, CumulativeChange) -> True - _ -> False - _ -> False + Just (AtEnd mc) -> case (reporttype_ ropts, balancetype_ ropts) of + (ValueChangeReport, _) -> Just mc + (_, HistoricalBalance) -> Just mc + (_, CumulativeChange) -> Just mc + _ -> Nothing + _ -> Nothing -- | Convert report options to a query, ignoring any non-flag command line arguments. From 0a019e2167053b3a0eae9832fa30af4e29a17b3a Mon Sep 17 00:00:00 2001 From: Stephen Morgan Date: Thu, 13 May 2021 21:00:25 +1000 Subject: [PATCH 5/5] lib,cli,web,bin: Replace journalSelectingAmountFromOpts with journalApplyValuationFromOpts. This also has the effect of allowing valuation in more reports, for example the transactionReport. --- bin/hledger-swap-dates.hs | 2 +- .../Reports/AccountTransactionsReport.hs | 3 +- hledger-lib/Hledger/Reports/ReportOptions.hs | 50 ++++++++----------- .../Hledger/Reports/TransactionsReport.hs | 8 +-- hledger-web/Hledger/Web/Handler/JournalR.hs | 2 +- .../Cli/Commands/Check/Ordereddates.hs | 2 +- hledger/Hledger/Cli/Commands/Checkdates.hs | 2 +- hledger/Hledger/Cli/Commands/Tags.hs | 2 +- 8 files changed, 30 insertions(+), 41 deletions(-) diff --git a/bin/hledger-swap-dates.hs b/bin/hledger-swap-dates.hs index 00f3efc6a..9ed385b2c 100755 --- a/bin/hledger-swap-dates.hs +++ b/bin/hledger-swap-dates.hs @@ -34,7 +34,7 @@ main = do d <- getCurrentDay let q = rsQuery rspec - ts = filter (q `matchesTransaction`) $ jtxns $ journalSelectingAmountFromOpts (rsOpts rspec) j + ts = filter (q `matchesTransaction`) $ jtxns $ journalApplyValuationFromOpts rspec j ts' = map transactionSwapDates ts mapM_ (T.putStrLn . showTransaction) ts' diff --git a/hledger-lib/Hledger/Reports/AccountTransactionsReport.hs b/hledger-lib/Hledger/Reports/AccountTransactionsReport.hs index b718d53d8..d7b268250 100644 --- a/hledger-lib/Hledger/Reports/AccountTransactionsReport.hs +++ b/hledger-lib/Hledger/Reports/AccountTransactionsReport.hs @@ -95,9 +95,7 @@ accountTransactionsReport rspec@ReportSpec{rsOpts=ropts} j reportq thisacctq = i 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) - . 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) @@ -106,6 +104,7 @@ accountTransactionsReport rspec@ReportSpec{rsOpts=ropts} j reportq thisacctq = i -- apply any cur:SYM filters in reportq' . ptraceAtWith 5 (("ts2:\n"++).pshowTransactions.jtxns) . (if queryIsNull symq then id else filterJournalAmounts symq) + -- maybe convert these transactions to cost or value $ journalApplyValuationFromOpts rspec j startbal diff --git a/hledger-lib/Hledger/Reports/ReportOptions.hs b/hledger-lib/Hledger/Reports/ReportOptions.hs index 3991d7c8c..5fd1a730b 100644 --- a/hledger-lib/Hledger/Reports/ReportOptions.hs +++ b/hledger-lib/Hledger/Reports/ReportOptions.hs @@ -28,7 +28,6 @@ module Hledger.Reports.ReportOptions ( reportOptsToggleStatus, simplifyStatuses, whichDateFromOpts, - journalSelectingAmountFromOpts, journalApplyValuationFromOpts, journalApplyValuationFromOptsWith, mixedAmountApplyValuationAfterSumFromOptsWith, @@ -493,21 +492,12 @@ 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). Strip prices if not needed. -journalSelectingAmountFromOpts :: ReportOpts -> Journal -> Journal -journalSelectingAmountFromOpts ropts = maybeStripPrices . case cost_ ropts of - Cost -> journalToCost - NoCost -> id - where - maybeStripPrices = if show_costs_ ropts then id else journalMapPostingAmounts mixedAmountStripPrices - --- | Convert this journal's postings' amounts to cost using their transaction --- prices and apply valuation, if specified by options (-B/--cost). Strip prices --- if not needed. This should be the main stop for performing costing and valuation. --- The exception is whenever you need to perform valuation _after_ summing up amounts, --- as in a historical balance report with --value=end. valuationAfterSum will --- check for this condition. +-- | Convert this journal's postings' amounts to cost and/or to value, if specified +-- by options (-B/--cost/-V/-X/--value etc.). Strip prices if not needed. This +-- should be the main stop for performing costing and valuation. The exception is +-- whenever you need to perform valuation _after_ summing up amounts, as in a +-- historical balance report with --value=end. valuationAfterSum will check for this +-- condition. journalApplyValuationFromOpts :: ReportSpec -> Journal -> Journal journalApplyValuationFromOpts rspec j = journalApplyValuationFromOptsWith rspec j priceoracle @@ -532,12 +522,14 @@ journalApplyValuationFromOptsWith rspec@ReportSpec{rsOpts=ropts} j priceoracle = styles = journalCommodityStyles j err = error "journalApplyValuationFromOpts: expected all spans to have an end date" --- | Calculate the Account valuation functions required for valuing after summing amounts. --- Used in MultiBalanceReport to value historical reports and the like. -mixedAmountApplyValuationAfterSumFromOptsWith :: ReportOpts -> Journal -> PriceOracle -> (DateSpan -> MixedAmount -> MixedAmount) -mixedAmountApplyValuationAfterSumFromOptsWith ropts j priceoracle = case valuationAfterSum ropts of - Just mc -> \span -> valuation mc span . maybeStripPrices . costing - Nothing -> const id +-- | Select the Account valuation functions required for performing valuation after summing +-- amounts. Used in MultiBalanceReport to value historical and similar reports. +mixedAmountApplyValuationAfterSumFromOptsWith :: ReportOpts -> Journal -> PriceOracle + -> (DateSpan -> MixedAmount -> MixedAmount) +mixedAmountApplyValuationAfterSumFromOptsWith ropts j priceoracle = + case valuationAfterSum ropts of + Just mc -> \span -> valuation mc span . maybeStripPrices . costing + Nothing -> const id where valuation mc span = mixedAmountValueAtDate priceoracle styles mc (maybe err (addDays (-1)) $ spanEnd span) where err = error "mixedAmountApplyValuationAfterSumFromOptsWith: expected all spans to have an end date" @@ -547,17 +539,15 @@ mixedAmountApplyValuationAfterSumFromOptsWith ropts j priceoracle = case valuati NoCost -> id styles = journalCommodityStyles j --- | If we are performing valuation after summing amounts, return Just the --- commodity symbols we're converting to, otherwise return Nothing. +-- | If the ReportOpts specify that we are performing valuation after summing amounts, +-- return Just the commodity symbol we're converting to, otherwise return Nothing. -- Used for example with historical reports with --value=end. valuationAfterSum :: ReportOpts -> Maybe (Maybe CommoditySymbol) valuationAfterSum ropts = case value_ ropts of - Just (AtEnd mc) -> case (reporttype_ ropts, balancetype_ ropts) of - (ValueChangeReport, _) -> Just mc - (_, HistoricalBalance) -> Just mc - (_, CumulativeChange) -> Just mc - _ -> Nothing - _ -> Nothing + Just (AtEnd mc) | valueAfterSum -> Just mc + _ -> Nothing + where valueAfterSum = reporttype_ ropts == ValueChangeReport + || balancetype_ ropts /= PeriodChange -- | Convert report options to a query, ignoring any non-flag command line arguments. diff --git a/hledger-lib/Hledger/Reports/TransactionsReport.hs b/hledger-lib/Hledger/Reports/TransactionsReport.hs index a469b52d6..51433f59f 100644 --- a/hledger-lib/Hledger/Reports/TransactionsReport.hs +++ b/hledger-lib/Hledger/Reports/TransactionsReport.hs @@ -62,13 +62,13 @@ triCommodityBalance c = filterMixedAmountByCommodity c . triBalance -- "postingsReport" except with transaction-based report items which -- are ordered most recent first. XXX Or an EntriesReport - use that instead ? -- This is used by hledger-web's journal view. -transactionsReport :: ReportOpts -> Journal -> Query -> TransactionsReport -transactionsReport opts j q = items +transactionsReport :: ReportSpec -> Journal -> Query -> TransactionsReport +transactionsReport rspec j q = items where -- XXX items' first element should be the full transaction with all postings items = reverse $ accountTransactionsReportItems q None nullmixedamt id ts - ts = sortBy (comparing date) $ filter (q `matchesTransaction`) $ jtxns $ journalSelectingAmountFromOpts opts j - date = transactionDateFn opts + ts = sortBy (comparing date) $ filter (q `matchesTransaction`) $ jtxns $ journalApplyValuationFromOpts rspec j + date = transactionDateFn $ rsOpts rspec -- | Split a transactions report whose items may involve several commodities, -- into one or more single-commodity transactions reports. diff --git a/hledger-web/Hledger/Web/Handler/JournalR.hs b/hledger-web/Hledger/Web/Handler/JournalR.hs index 4e8dd2093..1d4199be6 100644 --- a/hledger-web/Hledger/Web/Handler/JournalR.hs +++ b/hledger-web/Hledger/Web/Handler/JournalR.hs @@ -27,7 +27,7 @@ getJournalR = do Just (a, inclsubs) -> "Transactions in " <> a <> if inclsubs then "" else " (excluding subaccounts)" title' = title <> if m /= Any then ", filtered" else "" acctlink a = (RegisterR, [("q", replaceInacct q $ accountQuery a)]) - items = transactionsReport (rsOpts . reportspec_ $ cliopts_ opts) j m + items = transactionsReport (reportspec_ $ cliopts_ opts) j m transactionFrag = transactionFragment j defaultLayout $ do diff --git a/hledger/Hledger/Cli/Commands/Check/Ordereddates.hs b/hledger/Hledger/Cli/Commands/Check/Ordereddates.hs index e3721f8fc..061e5ce9a 100755 --- a/hledger/Hledger/Cli/Commands/Check/Ordereddates.hs +++ b/hledger/Hledger/Cli/Commands/Check/Ordereddates.hs @@ -22,7 +22,7 @@ journalCheckOrdereddates CliOpts{reportspec_=rspec} j = do filets = groupBy (\t1 t2 -> transactionFile t1 == transactionFile t2) $ filter (rsQuery rspec `matchesTransaction`) $ - jtxns $ journalSelectingAmountFromOpts ropts j + jtxns $ journalApplyValuationFromOpts rspec j checkunique = False -- boolopt "unique" rawopts XXX was supported by checkdates command compare a b = if checkunique then getdate a < getdate b else getdate a <= getdate b where getdate = transactionDateFn ropts diff --git a/hledger/Hledger/Cli/Commands/Checkdates.hs b/hledger/Hledger/Cli/Commands/Checkdates.hs index 00c1f215c..ec9d7027d 100755 --- a/hledger/Hledger/Cli/Commands/Checkdates.hs +++ b/hledger/Hledger/Cli/Commands/Checkdates.hs @@ -29,7 +29,7 @@ checkdates :: CliOpts -> Journal -> IO () checkdates CliOpts{rawopts_=rawopts,reportspec_=rspec} j = do let ropts = (rsOpts rspec){accountlistmode_=ALFlat} let ts = filter (rsQuery rspec `matchesTransaction`) $ - jtxns $ journalSelectingAmountFromOpts ropts j + jtxns $ journalApplyValuationFromOpts rspec{rsOpts=ropts} j -- pprint rawopts let unique = boolopt "--unique" rawopts -- TEMP: it's this for hledger check dates || boolopt "unique" rawopts -- and this for hledger check-dates (for some reason) diff --git a/hledger/Hledger/Cli/Commands/Tags.hs b/hledger/Hledger/Cli/Commands/Tags.hs index 8bc18e624..e406327c6 100755 --- a/hledger/Hledger/Cli/Commands/Tags.hs +++ b/hledger/Hledger/Cli/Commands/Tags.hs @@ -39,7 +39,7 @@ tags CliOpts{rawopts_=rawopts,reportspec_=rspec} j = do argsquery <- either usageError (return . fst) $ parseQueryList d querystring let q = simplifyQuery $ And [queryFromFlags $ rsOpts rspec, argsquery] - txns = filter (q `matchesTransaction`) $ jtxns $ journalSelectingAmountFromOpts (rsOpts rspec) j + txns = filter (q `matchesTransaction`) $ jtxns $ journalApplyValuationFromOpts rspec j tagsorvalues = (if parsed then id else nubSort) [ r