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