lib,cli,ui: Ensure ReportOpts always has today_ set.
This commit is contained in:
		
							parent
							
								
									fcbe511d42
								
							
						
					
					
						commit
						1171c23eee
					
				| @ -117,10 +117,9 @@ accountTransactionsReport ropts j reportq thisacctq = (label, items) | |||||||
|       fromMaybe (error' "journalApplyValuation: expected a non-empty journal") $ -- XXX shouldn't happen |       fromMaybe (error' "journalApplyValuation: expected a non-empty journal") $ -- XXX shouldn't happen | ||||||
|       reportPeriodOrJournalLastDay ropts j |       reportPeriodOrJournalLastDay ropts j | ||||||
|     mreportlast = reportPeriodLastDay ropts |     mreportlast = reportPeriodLastDay ropts | ||||||
|     today = fromMaybe (error' "journalApplyValuation: could not pick a valuation date, ReportOpts today_ is unset") $ today_ ropts -- XXX shouldn't happen |  | ||||||
|     multiperiod = interval_ ropts /= NoInterval |     multiperiod = interval_ ropts /= NoInterval | ||||||
|     tval = case value_ ropts of |     tval = case value_ ropts of | ||||||
|              Just v  -> \t -> transactionApplyValuation prices styles periodlast mreportlast today multiperiod t v |              Just v  -> \t -> transactionApplyValuation prices styles periodlast mreportlast (today_ ropts) multiperiod t v | ||||||
|              Nothing -> id |              Nothing -> id | ||||||
|     ts4 = |     ts4 = | ||||||
|       ptraceAtWith 5 (("ts4:\n"++).pshowTransactions) $ |       ptraceAtWith 5 (("ts4:\n"++).pshowTransactions) $ | ||||||
|  | |||||||
| @ -41,12 +41,11 @@ entriesReport ropts@ReportOpts{..} j@Journal{..} = | |||||||
|     tvalue t@Transaction{..} = t{tpostings=map pvalue tpostings} |     tvalue t@Transaction{..} = t{tpostings=map pvalue tpostings} | ||||||
|       where |       where | ||||||
|         pvalue p = maybe p |         pvalue p = maybe p | ||||||
|           (postingApplyValuation (journalPriceOracle infer_value_ j) (journalCommodityStyles j) periodlast mreportlast today False p) |           (postingApplyValuation (journalPriceOracle infer_value_ j) (journalCommodityStyles j) periodlast mreportlast today_ False p) | ||||||
|           value_ |           value_ | ||||||
|           where |           where | ||||||
|             periodlast  = fromMaybe today $ reportPeriodOrJournalLastDay ropts j |             periodlast  = fromMaybe today_ $ reportPeriodOrJournalLastDay ropts j | ||||||
|             mreportlast = reportPeriodLastDay ropts |             mreportlast = reportPeriodLastDay ropts | ||||||
|             today       = fromMaybe (error' "erValue: could not pick a valuation date, ReportOpts today_ is unset") today_  -- PARTIAL: should not happen |  | ||||||
| 
 | 
 | ||||||
| tests_EntriesReport = tests "EntriesReport" [ | tests_EntriesReport = tests "EntriesReport" [ | ||||||
|   tests "entriesReport" [ |   tests "entriesReport" [ | ||||||
|  | |||||||
| @ -244,12 +244,11 @@ makeReportQuery ropts reportspan | |||||||
| makeValuation :: ReportOpts -> Journal -> PriceOracle -> Valuation | makeValuation :: ReportOpts -> Journal -> PriceOracle -> Valuation | ||||||
| makeValuation ropts j priceoracle day = case value_ ropts of | makeValuation ropts j priceoracle day = case value_ ropts of | ||||||
|     Nothing -> id |     Nothing -> id | ||||||
|     Just v  -> mixedAmountApplyValuation priceoracle styles day mreportlast today multiperiod v |     Just v  -> mixedAmountApplyValuation priceoracle styles day mreportlast (today_ ropts) multiperiod v | ||||||
|   where |   where | ||||||
|     -- Some things needed if doing valuation. |     -- Some things needed if doing valuation. | ||||||
|     styles = journalCommodityStyles j |     styles = journalCommodityStyles j | ||||||
|     mreportlast = reportPeriodLastDay ropts |     mreportlast = reportPeriodLastDay ropts | ||||||
|     today = fromMaybe (error' "multiBalanceReport: could not pick a valuation date, ReportOpts today_ is unset") $ today_ ropts  -- XXX shouldn't happen |  | ||||||
|     multiperiod = interval_ ropts /= NoInterval |     multiperiod = interval_ ropts /= NoInterval | ||||||
| 
 | 
 | ||||||
| -- | Group postings, grouped by their column | -- | Group postings, grouped by their column | ||||||
|  | |||||||
| @ -75,7 +75,6 @@ postingsReport ropts@ReportOpts{..} j = | |||||||
|       styles      = journalCommodityStyles j |       styles      = journalCommodityStyles j | ||||||
|       priceoracle = journalPriceOracle infer_value_ j |       priceoracle = journalPriceOracle infer_value_ j | ||||||
|       multiperiod = interval_ /= NoInterval |       multiperiod = interval_ /= NoInterval | ||||||
|       today       = fromMaybe (error' "postingsReport: could not pick a valuation date, ReportOpts today_ is unset") today_  -- PARTIAL: |  | ||||||
| 
 | 
 | ||||||
|       -- 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 ropts j reportspan |       (precedingps, reportps) = matchedPostingsBeforeAndDuring ropts j reportspan | ||||||
| @ -90,7 +89,7 @@ postingsReport ropts@ReportOpts{..} j = | |||||||
|         where |         where | ||||||
|           showempty = empty_ || average_ |           showempty = empty_ || average_ | ||||||
|           -- We may be converting posting amounts to value, per hledger_options.m4.md "Effect of --value on reports". |           -- We may be converting posting amounts to value, per hledger_options.m4.md "Effect of --value on reports". | ||||||
|           pvalue p periodlast = maybe p (postingApplyValuation priceoracle styles periodlast mreportlast today multiperiod p) value_ |           pvalue p periodlast = maybe p (postingApplyValuation priceoracle styles periodlast mreportlast today_ multiperiod p) value_ | ||||||
|             where |             where | ||||||
|               mreportlast = reportPeriodLastDay ropts |               mreportlast = reportPeriodLastDay ropts | ||||||
|           reportorjournallast = |           reportorjournallast = | ||||||
| @ -113,7 +112,7 @@ postingsReport ropts@ReportOpts{..} j = | |||||||
|               precedingsum = sumPostings precedingps |               precedingsum = sumPostings precedingps | ||||||
|               precedingavg | null precedingps = 0 |               precedingavg | null precedingps = 0 | ||||||
|                            | otherwise        = divideMixedAmount (fromIntegral $ length precedingps) precedingsum |                            | otherwise        = divideMixedAmount (fromIntegral $ length precedingps) precedingsum | ||||||
|               bvalue = maybe id (mixedAmountApplyValuation priceoracle styles daybeforereportstart Nothing today multiperiod) value_ |               bvalue = maybe id (mixedAmountApplyValuation priceoracle styles daybeforereportstart Nothing today_ multiperiod) value_ | ||||||
|                   -- XXX constrain valuation type to AtDate daybeforereportstart here ? |                   -- XXX constrain valuation type to AtDate daybeforereportstart here ? | ||||||
|                 where |                 where | ||||||
|                   daybeforereportstart = |                   daybeforereportstart = | ||||||
|  | |||||||
| @ -80,10 +80,9 @@ instance Default AccountListMode where def = ALFlat | |||||||
| -- commands, as noted below. | -- commands, as noted below. | ||||||
| data ReportOpts = ReportOpts { | data ReportOpts = ReportOpts { | ||||||
|      -- for most reports: |      -- for most reports: | ||||||
|      today_          :: Maybe Day  -- ^ The current date. A late addition to ReportOpts. |      today_          :: Day  -- ^ The current date. A late addition to ReportOpts. | ||||||
|                                    -- Optional, but when set it may affect some reports: |                              -- Reports use it when picking a -V valuation date. | ||||||
|                                    -- Reports use it when picking a -V valuation date. |                              -- This is not great, adds indeterminacy. | ||||||
|                                    -- This is not great, adds indeterminacy. |  | ||||||
|     ,period_         :: Period |     ,period_         :: Period | ||||||
|     ,interval_       :: Interval |     ,interval_       :: Interval | ||||||
|     ,statuses_       :: [Status]  -- ^ Zero, one, or two statuses to be matched |     ,statuses_       :: [Status]  -- ^ Zero, one, or two statuses to be matched | ||||||
| @ -134,7 +133,7 @@ instance Default ReportOpts where def = defreportopts | |||||||
| 
 | 
 | ||||||
| defreportopts :: ReportOpts | defreportopts :: ReportOpts | ||||||
| defreportopts = ReportOpts | defreportopts = ReportOpts | ||||||
|     def |     nulldate | ||||||
|     def |     def | ||||||
|     def |     def | ||||||
|     def |     def | ||||||
| @ -184,7 +183,7 @@ rawOptsToReportOpts rawopts = do | |||||||
|     (argsquery, queryopts) <- either fail return $ parseQuery d querystring |     (argsquery, queryopts) <- either fail return $ parseQuery d querystring | ||||||
| 
 | 
 | ||||||
|     let reportopts = defreportopts |     let reportopts = defreportopts | ||||||
|           {today_       = Just d |           {today_       = d | ||||||
|           ,period_      = periodFromRawOpts d rawopts |           ,period_      = periodFromRawOpts d rawopts | ||||||
|           ,interval_    = intervalFromRawOpts rawopts |           ,interval_    = intervalFromRawOpts rawopts | ||||||
|           ,statuses_    = statusesFromRawOpts rawopts |           ,statuses_    = statusesFromRawOpts rawopts | ||||||
| @ -486,9 +485,6 @@ specifiedEndDate ropts = snd <$> specifiedStartEndDates ropts | |||||||
| 
 | 
 | ||||||
| -- Get the report's start date. | -- Get the report's start date. | ||||||
| -- If no report period is specified, will be Nothing. | -- If no report period is specified, will be Nothing. | ||||||
| -- Will also be Nothing if ReportOpts does not have today_ set, |  | ||||||
| -- since we need that to get the report period robustly |  | ||||||
| -- (unlike reportStartDate, which looks up the date with IO.) |  | ||||||
| reportPeriodStart :: ReportOpts -> Maybe Day | reportPeriodStart :: ReportOpts -> Maybe Day | ||||||
| reportPeriodStart = queryStartDate False . query_ | reportPeriodStart = queryStartDate False . query_ | ||||||
| 
 | 
 | ||||||
| @ -503,9 +499,6 @@ reportPeriodOrJournalStart ropts j = | |||||||
| -- This the inclusive end date (one day before the | -- This the inclusive end date (one day before the | ||||||
| -- more commonly used, exclusive, report end date). | -- more commonly used, exclusive, report end date). | ||||||
| -- If no report period is specified, will be Nothing. | -- If no report period is specified, will be Nothing. | ||||||
| -- Will also be Nothing if ReportOpts does not have today_ set, |  | ||||||
| -- since we need that to get the report period robustly |  | ||||||
| -- (unlike reportEndDate, which looks up the date with IO.) |  | ||||||
| reportPeriodLastDay :: ReportOpts -> Maybe Day | reportPeriodLastDay :: ReportOpts -> Maybe Day | ||||||
| reportPeriodLastDay = fmap (addDays (-1)) . queryEndDate False . query_ | reportPeriodLastDay = fmap (addDays (-1)) . queryEndDate False . query_ | ||||||
| 
 | 
 | ||||||
|  | |||||||
| @ -79,13 +79,12 @@ tsDraw UIState{aopts=UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts},querystrin | |||||||
|           fromMaybe (error' "TransactionScreen: expected a non-empty journal") $  -- PARTIAL: shouldn't happen |           fromMaybe (error' "TransactionScreen: expected a non-empty journal") $  -- PARTIAL: shouldn't happen | ||||||
|           reportPeriodOrJournalLastDay ropts j |           reportPeriodOrJournalLastDay ropts j | ||||||
|         mreportlast = reportPeriodLastDay ropts |         mreportlast = reportPeriodLastDay ropts | ||||||
|         today = fromMaybe (error' "TransactionScreen: could not pick a valuation date, ReportOpts today_ is unset") $ today_ ropts  -- PARTIAL: |  | ||||||
|         multiperiod = interval_ ropts /= NoInterval |         multiperiod = interval_ ropts /= NoInterval | ||||||
| 
 | 
 | ||||||
|       render $ defaultLayout toplabel bottomlabel $ str $ |       render $ defaultLayout toplabel bottomlabel $ str $ | ||||||
|         showTransactionOneLineAmounts $ |         showTransactionOneLineAmounts $ | ||||||
|         (if valuationTypeIsCost ropts then transactionToCost (journalCommodityStyles j) else id) $ |         (if valuationTypeIsCost ropts then transactionToCost (journalCommodityStyles j) else id) $ | ||||||
|         (if valuationTypeIsDefaultValue ropts then (\t -> transactionApplyValuation prices styles periodlast mreportlast today multiperiod t (AtDefault Nothing)) else id) $ |         (if valuationTypeIsDefaultValue ropts then (\t -> transactionApplyValuation prices styles periodlast mreportlast (today_ ropts) multiperiod t (AtDefault Nothing)) else id) $ | ||||||
|         -- (if real_ ropts then filterTransactionPostings (Real True) else id) -- filter postings by --real |         -- (if real_ ropts then filterTransactionPostings (Real True) else id) -- filter postings by --real | ||||||
|         t |         t | ||||||
|       where |       where | ||||||
|  | |||||||
| @ -621,7 +621,7 @@ tests_Balance = tests "Balance" [ | |||||||
|     test "unicode in balance layout" $ do |     test "unicode in balance layout" $ do | ||||||
|       j <- readJournal' "2009/01/01 * медвежья шкура\n  расходы:покупки  100\n  актив:наличные\n" |       j <- readJournal' "2009/01/01 * медвежья шкура\n  расходы:покупки  100\n  актив:наличные\n" | ||||||
|       let opts = defreportopts |       let opts = defreportopts | ||||||
|       balanceReportAsText opts (balanceReport opts{today_=Just $ fromGregorian 2008 11 26} j) |       balanceReportAsText opts (balanceReport opts{today_=fromGregorian 2008 11 26} j) | ||||||
|         @?= |         @?= | ||||||
|         unlines |         unlines | ||||||
|         ["                -100  актив:наличные" |         ["                -100  актив:наличные" | ||||||
|  | |||||||
		Loading…
	
		Reference in New Issue
	
	Block a user