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.List (mapAccumL, nub, partition, sortBy)
import Data.Ord (comparing) import Data.Ord (comparing)
import Data.Maybe (catMaybes, fromMaybe) import Data.Maybe (catMaybes)
import Data.Text (Text) import Data.Text (Text)
import qualified Data.Text as T import qualified Data.Text as T
import Data.Time.Calendar (Day) import Data.Time.Calendar (Day)
@ -88,12 +88,6 @@ accountTransactionsReport rspec@ReportSpec{rsOpts=ropts} j reportq thisacctq = i
symq = filterQuery queryIsSym reportq' symq = filterQuery queryIsSym reportq'
realq = filterQuery queryIsReal reportq' realq = filterQuery queryIsReal reportq'
statusq = filterQuery queryIsStatus 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 -- 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 -- 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 . jtxns
-- maybe convert these transactions to cost or value -- maybe convert these transactions to cost or value
. ptraceAtWith 5 (("ts4:\n"++).pshowTransactions.jtxns) . ptraceAtWith 5 (("ts4:\n"++).pshowTransactions.jtxns)
. journalMapPostings pvalue
. journalSelectingAmountFromOpts ropts . journalSelectingAmountFromOpts ropts
-- keep just the transactions affecting this account (via possibly realness or status-filtered postings) -- keep just the transactions affecting this account (via possibly realness or status-filtered postings)
. traceAt 3 ("thisacctq: "++show thisacctq) . traceAt 3 ("thisacctq: "++show thisacctq)
@ -112,7 +105,8 @@ accountTransactionsReport rspec@ReportSpec{rsOpts=ropts} j reportq thisacctq = i
. filterJournalPostings (And [realq, statusq]) . filterJournalPostings (And [realq, statusq])
-- apply any cur:SYM filters in reportq' -- apply any cur:SYM filters in reportq'
. ptraceAtWith 5 (("ts2:\n"++).pshowTransactions.jtxns) . 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 startbal
| balancetype_ ropts == HistoricalBalance = sumPostings priorps | 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. Journal entries report, used by the print command.
@ -15,12 +17,11 @@ module Hledger.Reports.EntriesReport (
where where
import Data.List (sortBy) import Data.List (sortBy)
import Data.Maybe (fromMaybe)
import Data.Ord (comparing) import Data.Ord (comparing)
import Data.Time (fromGregorian) import Data.Time (fromGregorian)
import Hledger.Data import Hledger.Data
import Hledger.Query import Hledger.Query (Query(..))
import Hledger.Reports.ReportOptions import Hledger.Reports.ReportOptions
import Hledger.Utils import Hledger.Utils
@ -33,18 +34,9 @@ type EntriesReportItem = Transaction
-- | Select transactions for an entries report. -- | Select transactions for an entries report.
entriesReport :: ReportSpec -> Journal -> EntriesReport entriesReport :: ReportSpec -> Journal -> EntriesReport
entriesReport rspec@ReportSpec{rsOpts=ropts@ReportOpts{..}} j = entriesReport rspec@ReportSpec{rsOpts=ropts} =
sortBy (comparing getdate) . jtxns . filterJournalTransactions (rsQuery rspec) sortBy (comparing $ transactionDateFn ropts) . jtxns . filterJournalTransactions (rsQuery rspec)
. journalMapPostings pvalue . journalApplyValuationFromOpts rspec{rsOpts=ropts{show_costs_=True}}
$ 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
tests_EntriesReport = tests "EntriesReport" [ tests_EntriesReport = tests "EntriesReport" [
tests "entriesReport" [ tests "entriesReport" [

View File

@ -68,28 +68,18 @@ postingsReport rspec@ReportSpec{rsOpts=ropts@ReportOpts{..}} j = items
reportspan = reportSpanBothDates j rspec reportspan = reportSpanBothDates j rspec
whichdate = whichDateFromOpts ropts whichdate = whichDateFromOpts ropts
mdepth = queryDepth $ rsQuery rspec mdepth = queryDepth $ rsQuery rspec
styles = journalCommodityStyles j
priceoracle = journalPriceOracle infer_value_ j
multiperiod = interval_ /= NoInterval multiperiod = interval_ /= NoInterval
-- postings to be included in the report, and similarly-matched postings before the report start date -- postings to be included in the report, and similarly-matched postings before the report start date
(precedingps, reportps) = matchedPostingsBeforeAndDuring rspec j reportspan (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. -- Postings, or summary postings with their subperiod's end date, to be displayed.
displayps :: [(Posting, Maybe Day)] 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 reportps]
| multiperiod = [(p, Just periodend) | (p, periodend) <- summariseps valuedps] | otherwise = [(p, Nothing) | p <- reportps]
| otherwise = [(p, Nothing) | p <- valuedps]
where where
summariseps = summarisePostingsByInterval interval_ whichdate mdepth showempty reportspan summariseps = summarisePostingsByInterval interval_ whichdate mdepth showempty reportspan
valuedps = map (pvalue reportorjournallast) reportps
showempty = empty_ || average_ 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. -- Posting report items ready for display.
items = items =
@ -104,12 +94,8 @@ postingsReport rspec@ReportSpec{rsOpts=ropts@ReportOpts{..}} j = items
startbal | average_ = if historical then precedingavg else nullmixedamt startbal | average_ = if historical then precedingavg else nullmixedamt
| otherwise = if historical then precedingsum else nullmixedamt | otherwise = if historical then precedingsum else nullmixedamt
where where
precedingsum = sumPostings $ map (pvalue daybeforereportstart) precedingps precedingsum = sumPostings precedingps
precedingavg = divideMixedAmount (fromIntegral $ length precedingps) precedingsum 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 runningcalc = registerRunningCalculationFn ropts
startnum = if historical then length precedingps + 1 else 1 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. -- Date restrictions and depth restrictions in the query are ignored.
-- A helper for the postings report. -- A helper for the postings report.
matchedPostingsBeforeAndDuring :: ReportSpec -> Journal -> DateSpan -> ([Posting],[Posting]) 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 dbg5 "beforeps, duringps" $ span (beforestartq `matchesPosting`) beforeandduringps
where where
beforestartq = dbg3 "beforestartq" $ dateqtype $ DateSpan Nothing mstart beforestartq = dbg3 "beforestartq" $ dateqtype $ DateSpan Nothing $ spanStart reportspan
beforeandduringps = beforeandduringps =
dbg5 "ps5" $ sortOn sortdate $ -- sort postings by date or date2 dbg5 "ps5" $ sortOn sortdate $ -- sort postings by date or date2
dbg5 "ps4" $ (if invert_ ropts then map negatePostingAmount else id) $ -- with --invert, invert amounts 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 "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 dbg5 "ps1" $ filter (beforeandduringq `matchesPosting`) $ -- filter postings by the query, with no start date or depth limit
journalPostings $ 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 where
beforeandduringq = dbg4 "beforeandduringq" $ And [depthless $ dateless q, beforeendq] beforeandduringq = dbg4 "beforeandduringq" $ And [depthless $ dateless q, beforeendq]
where where
depthless = filterQuery (not . queryIsDepth) depthless = filterQuery (not . queryIsDepth)
dateless = filterQuery (not . queryIsDateOrDate2) dateless = filterQuery (not . queryIsDateOrDate2)
beforeendq = dateqtype $ DateSpan Nothing mend beforeendq = dateqtype $ DateSpan Nothing $ spanEnd reportspan
sortdate = if date2_ ropts then postingDate2 else postingDate sortdate = if date2_ ropts then postingDate2 else postingDate
symq = dbg4 "symq" $ filterQuery queryIsSym q symq = dbg4 "symq" $ filterQuery queryIsSym q
dateqtype dateqtype

View File

@ -29,6 +29,8 @@ module Hledger.Reports.ReportOptions (
simplifyStatuses, simplifyStatuses,
whichDateFromOpts, whichDateFromOpts,
journalSelectingAmountFromOpts, journalSelectingAmountFromOpts,
journalApplyValuationFromOpts,
journalApplyValuationFromOptsWith,
intervalFromRawOpts, intervalFromRawOpts,
forecastPeriodFromRawOpts, forecastPeriodFromRawOpts,
queryFromFlags, queryFromFlags,
@ -47,6 +49,7 @@ module Hledger.Reports.ReportOptions (
where where
import Control.Applicative ((<|>)) import Control.Applicative ((<|>))
import Control.Monad ((<=<))
import Data.List.Extra (nubSort) import Data.List.Extra (nubSort)
import Data.Maybe (fromMaybe, mapMaybe) import Data.Maybe (fromMaybe, mapMaybe)
import qualified Data.Text as T import qualified Data.Text as T
@ -497,6 +500,48 @@ journalSelectingAmountFromOpts ropts = maybeStripPrices . case cost_ ropts of
where where
maybeStripPrices = if show_costs_ ropts then id else journalMapPostingAmounts mixedAmountStripPrices 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. -- | Convert report options to a query, ignoring any non-flag command line arguments.
queryFromFlags :: ReportOpts -> Query queryFromFlags :: ReportOpts -> Query
queryFromFlags ReportOpts{..} = simplifyQuery $ And flagsq queryFromFlags ReportOpts{..} = simplifyQuery $ And flagsq