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.
This commit is contained in:
Stephen Morgan 2021-05-13 19:00:43 +10:00
parent dc16451de0
commit 6fb3dfdbb2
4 changed files with 62 additions and 45 deletions

View File

@ -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

View File

@ -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" [

View File

@ -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

View File

@ -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