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