mirror of
https://github.com/simonmichael/hledger.git
synced 2024-11-08 07:09:28 +03:00
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:
parent
dc16451de0
commit
6fb3dfdbb2
@ -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
|
||||
|
@ -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" [
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
Loading…
Reference in New Issue
Block a user