fix: ui: Make sure RegisterScreen (and consequently TransactionScreen)
only display forecast transactions when the appropriate flag is set.
This commit is contained in:
		
							parent
							
								
									90fd2a9aaf
								
							
						
					
					
						commit
						a3cacca71d
					
				| @ -19,7 +19,7 @@ import Control.Monad.IO.Class (liftIO) | |||||||
| import Data.List | import Data.List | ||||||
| import Data.Maybe | import Data.Maybe | ||||||
| import qualified Data.Text as T | import qualified Data.Text as T | ||||||
| import Data.Time.Calendar (Day, addDays) | import Data.Time.Calendar (Day) | ||||||
| import qualified Data.Vector as V | import qualified Data.Vector as V | ||||||
| import Graphics.Vty (Event(..),Key(..),Modifier(..)) | import Graphics.Vty (Event(..),Key(..),Modifier(..)) | ||||||
| import Lens.Micro.Platform | import Lens.Micro.Platform | ||||||
| @ -77,16 +77,7 @@ asInit d reset ui@UIState{ | |||||||
|                         as = map asItemAccountName displayitems |                         as = map asItemAccountName displayitems | ||||||
| 
 | 
 | ||||||
|     -- Further restrict the query based on the current period and future/forecast mode. |     -- Further restrict the query based on the current period and future/forecast mode. | ||||||
|     rspec' = rspec{_rsQuery=simplifyQuery $ And [_rsQuery rspec, periodq, excludeforecastq (forecast_ $ inputopts_ copts)]} |     rspec' = reportSpecSetFutureAndForecast d (forecast_ $ inputopts_ copts) rspec | ||||||
|       where |  | ||||||
|         periodq = Date $ periodAsDateSpan $ period_ ropts |  | ||||||
|         -- Except in forecast mode, exclude future/forecast transactions. |  | ||||||
|         excludeforecastq (Just _) = Any |  | ||||||
|         excludeforecastq Nothing  =  -- not:date:tomorrow- not:tag:generated-transaction |  | ||||||
|           And [ |  | ||||||
|              Not (Date $ DateSpan (Just $ addDays 1 d) Nothing) |  | ||||||
|             ,Not generatedTransactionTag |  | ||||||
|           ] |  | ||||||
| 
 | 
 | ||||||
|     -- run the report |     -- run the report | ||||||
|     (items,_total) = balanceReport rspec' j |     (items,_total) = balanceReport rspec' j | ||||||
|  | |||||||
| @ -56,7 +56,7 @@ rsSetAccount a forceinclusive scr@RegisterScreen{} = | |||||||
| rsSetAccount _ _ scr = scr | rsSetAccount _ _ scr = scr | ||||||
| 
 | 
 | ||||||
| rsInit :: Day -> Bool -> UIState -> UIState | rsInit :: Day -> Bool -> UIState -> UIState | ||||||
| rsInit d reset ui@UIState{aopts=_uopts@UIOpts{cliopts_=CliOpts{reportspec_=rspec@ReportSpec{_rsReportOpts=ropts}}}, ajournal=j, aScreen=s@RegisterScreen{..}} = | rsInit d reset ui@UIState{aopts=_uopts@UIOpts{cliopts_=copts@CliOpts{reportspec_=rspec@ReportSpec{_rsReportOpts=ropts}}}, ajournal=j, aScreen=s@RegisterScreen{..}} = | ||||||
|   ui{aScreen=s{rsList=newitems'}} |   ui{aScreen=s{rsList=newitems'}} | ||||||
|   where |   where | ||||||
|     -- gather arguments and queries |     -- gather arguments and queries | ||||||
| @ -72,7 +72,7 @@ rsInit d reset ui@UIState{aopts=_uopts@UIOpts{cliopts_=CliOpts{reportspec_=rspec | |||||||
|         -- always show historical balance |         -- always show historical balance | ||||||
|       -- , balanceaccum_= Historical |       -- , balanceaccum_= Historical | ||||||
|       } |       } | ||||||
|     rspec' = |     rspec' = reportSpecSetFutureAndForecast d (forecast_ $ inputopts_ copts) . | ||||||
|       either (error "rsInit: adjusting the query for register, should not have failed") id $ -- PARTIAL: |       either (error "rsInit: adjusting the query for register, should not have failed") id $ -- PARTIAL: | ||||||
|       updateReportSpec ropts' rspec{_rsDay=d} |       updateReportSpec ropts' rspec{_rsDay=d} | ||||||
|     items = accountTransactionsReport rspec' j thisacctq |     items = accountTransactionsReport rspec' j thisacctq | ||||||
|  | |||||||
| @ -24,6 +24,7 @@ module Hledger.UI.UIUtils ( | |||||||
|   ,scrollSelectionToMiddle |   ,scrollSelectionToMiddle | ||||||
|   ,suspend |   ,suspend | ||||||
|   ,redraw |   ,redraw | ||||||
|  |   ,reportSpecSetFutureAndForecast | ||||||
| ) | ) | ||||||
| where | where | ||||||
| 
 | 
 | ||||||
| @ -36,6 +37,7 @@ import Brick.Widgets.List (List, listSelectedL, listNameL, listItemHeightL) | |||||||
| import Control.Monad.IO.Class | import Control.Monad.IO.Class | ||||||
| import Data.List | import Data.List | ||||||
| import qualified Data.Text as T | import qualified Data.Text as T | ||||||
|  | import Data.Time (Day, addDays) | ||||||
| import Graphics.Vty | import Graphics.Vty | ||||||
|   (Event(..),Key(..),Modifier(..),Vty(..),Color,Attr,currentAttr,refresh |   (Event(..),Key(..),Modifier(..),Vty(..),Color,Attr,currentAttr,refresh | ||||||
|   -- ,Output(displayBounds,mkDisplayContext),DisplayContext(..) |   -- ,Output(displayBounds,mkDisplayContext),DisplayContext(..) | ||||||
| @ -342,3 +344,19 @@ normaliseMovementKeys ev | |||||||
|   | ev `elem` moveLeftEvents  = EvKey KLeft [] |   | ev `elem` moveLeftEvents  = EvKey KLeft [] | ||||||
|   | ev `elem` moveRightEvents = EvKey KRight [] |   | ev `elem` moveRightEvents = EvKey KRight [] | ||||||
|   | otherwise = ev |   | otherwise = ev | ||||||
|  | 
 | ||||||
|  | -- | Update the ReportSpec's query to exclude future transactions (later than the given day) | ||||||
|  | -- and forecast transactions (generated by --forecast), if the given forecast DateSpan is Nothing, | ||||||
|  | -- and include them otherwise. | ||||||
|  | reportSpecSetFutureAndForecast :: Day -> Maybe DateSpan -> ReportSpec -> ReportSpec | ||||||
|  | reportSpecSetFutureAndForecast d forecast rspec = | ||||||
|  |     rspec{_rsQuery=simplifyQuery $ And [_rsQuery rspec, periodq, excludeforecastq forecast]} | ||||||
|  |   where | ||||||
|  |     periodq = Date . periodAsDateSpan . period_ $ _rsReportOpts rspec | ||||||
|  |     -- Except in forecast mode, exclude future/forecast transactions. | ||||||
|  |     excludeforecastq (Just _) = Any | ||||||
|  |     excludeforecastq Nothing  =  -- not:date:tomorrow- not:tag:generated-transaction | ||||||
|  |       And [ | ||||||
|  |          Not (Date $ DateSpan (Just $ addDays 1 d) Nothing) | ||||||
|  |         ,Not generatedTransactionTag | ||||||
|  |       ] | ||||||
|  | |||||||
		Loading…
	
		Reference in New Issue
	
	Block a user