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.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 | ||||||
|  | |||||||
| @ -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" [ | ||||||
|  | |||||||
| @ -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 | ||||||
|  | |||||||
| @ -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 | ||||||
|  | |||||||
		Loading…
	
		Reference in New Issue
	
	Block a user