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