test: ui: web: Use report date from _rsDay for hledger-ui and
hledger-web, rather than getCurrentDay. File watching in hledger-ui continues to use getCurrentDay.
This commit is contained in:
		
							parent
							
								
									6905e40c4d
								
							
						
					
					
						commit
						3456fcb862
					
				| @ -227,8 +227,8 @@ asHandle ui0@UIState{ | |||||||
|   ,ajournal=j |   ,ajournal=j | ||||||
|   ,aMode=mode |   ,aMode=mode | ||||||
|   } ev = do |   } ev = do | ||||||
|   d <- liftIO getCurrentDay |  | ||||||
|   let |   let | ||||||
|  |     d = copts^.rsDay | ||||||
|     nonblanks = V.takeWhile (not . T.null . asItemAccountName) $ _asList^.listElementsL |     nonblanks = V.takeWhile (not . T.null . asItemAccountName) $ _asList^.listElementsL | ||||||
|     lastnonblankidx = max 0 (length nonblanks - 1) |     lastnonblankidx = max 0 (length nonblanks - 1) | ||||||
| 
 | 
 | ||||||
|  | |||||||
| @ -19,9 +19,9 @@ import Control.Monad.IO.Class (liftIO) | |||||||
| import Data.Time.Calendar (Day) | import Data.Time.Calendar (Day) | ||||||
| import Data.Void (Void) | import Data.Void (Void) | ||||||
| import Graphics.Vty (Event(..),Key(..),Modifier(..)) | import Graphics.Vty (Event(..),Key(..),Modifier(..)) | ||||||
|  | import Lens.Micro ((^.)) | ||||||
| import Text.Megaparsec | import Text.Megaparsec | ||||||
| import Text.Megaparsec.Char | import Text.Megaparsec.Char | ||||||
| import Lens.Micro ((^.)) |  | ||||||
| 
 | 
 | ||||||
| import Hledger.Cli hiding (progname,prognameandversion) | import Hledger.Cli hiding (progname,prognameandversion) | ||||||
| import Hledger.UI.UIOptions | import Hledger.UI.UIOptions | ||||||
| @ -90,7 +90,7 @@ esHandle ui@UIState{aScreen=ErrorScreen{..} | |||||||
|         _                    -> helpHandle ui ev |         _                    -> helpHandle ui ev | ||||||
| 
 | 
 | ||||||
|     _ -> do |     _ -> do | ||||||
|       d <- liftIO getCurrentDay |       let d = copts^.rsDay | ||||||
|       case ev of |       case ev of | ||||||
|         VtyEvent (EvKey (KChar 'q') []) -> halt ui |         VtyEvent (EvKey (KChar 'q') []) -> halt ui | ||||||
|         VtyEvent (EvKey KEsc        []) -> continue $ uiCheckBalanceAssertions d $ resetScreens d ui |         VtyEvent (EvKey KEsc        []) -> continue $ uiCheckBalanceAssertions d $ resetScreens d ui | ||||||
|  | |||||||
| @ -18,6 +18,7 @@ import Data.List.Extra (nubSort) | |||||||
| import Data.Maybe (fromMaybe) | import Data.Maybe (fromMaybe) | ||||||
| import qualified Data.Text as T | import qualified Data.Text as T | ||||||
| import Graphics.Vty (mkVty) | import Graphics.Vty (mkVty) | ||||||
|  | import Lens.Micro ((^.)) | ||||||
| import System.Directory (canonicalizePath) | import System.Directory (canonicalizePath) | ||||||
| import System.FilePath (takeDirectory) | import System.FilePath (takeDirectory) | ||||||
| import System.FSNotify (Event(Modified), isPollingManager, watchDir, withManager) | import System.FSNotify (Event(Modified), isPollingManager, watchDir, withManager) | ||||||
| @ -60,9 +61,8 @@ main = do | |||||||
| 
 | 
 | ||||||
| runBrickUi :: UIOpts -> Journal -> IO () | runBrickUi :: UIOpts -> Journal -> IO () | ||||||
| runBrickUi uopts@UIOpts{uoCliOpts=copts@CliOpts{inputopts_=_iopts,reportspec_=rspec@ReportSpec{_rsReportOpts=ropts}}} j = do | runBrickUi uopts@UIOpts{uoCliOpts=copts@CliOpts{inputopts_=_iopts,reportspec_=rspec@ReportSpec{_rsReportOpts=ropts}}} j = do | ||||||
|   d <- getCurrentDay |  | ||||||
| 
 |  | ||||||
|   let |   let | ||||||
|  |     today = copts^.rsDay | ||||||
| 
 | 
 | ||||||
|     -- hledger-ui's query handling is currently in flux, mixing old and new approaches. |     -- hledger-ui's query handling is currently in flux, mixing old and new approaches. | ||||||
|     -- Related: #1340, #1383, #1387. Some notes and terminology: |     -- Related: #1340, #1383, #1387. Some notes and terminology: | ||||||
| @ -136,7 +136,7 @@ runBrickUi uopts@UIOpts{uoCliOpts=copts@CliOpts{inputopts_=_iopts,reportspec_=rs | |||||||
|           -- Initialising the accounts screen is awkward, requiring |           -- Initialising the accounts screen is awkward, requiring | ||||||
|           -- another temporary UIState value.. |           -- another temporary UIState value.. | ||||||
|           ascr' = aScreen $ |           ascr' = aScreen $ | ||||||
|                   asInit d True |                   asInit today True | ||||||
|                     UIState{ |                     UIState{ | ||||||
|                      astartupopts=uopts' |                      astartupopts=uopts' | ||||||
|                     ,aopts=uopts' |                     ,aopts=uopts' | ||||||
| @ -147,7 +147,7 @@ runBrickUi uopts@UIOpts{uoCliOpts=copts@CliOpts{inputopts_=_iopts,reportspec_=rs | |||||||
|                     } |                     } | ||||||
| 
 | 
 | ||||||
|     ui = |     ui = | ||||||
|       (sInit scr) d True $ |       (sInit scr) today True $ | ||||||
|           UIState{ |           UIState{ | ||||||
|            astartupopts=uopts' |            astartupopts=uopts' | ||||||
|           ,aopts=uopts' |           ,aopts=uopts' | ||||||
|  | |||||||
| @ -279,8 +279,8 @@ rsHandle ui@UIState{ | |||||||
|   ,ajournal=j |   ,ajournal=j | ||||||
|   ,aMode=mode |   ,aMode=mode | ||||||
|   } ev = do |   } ev = do | ||||||
|   d <- liftIO getCurrentDay |  | ||||||
|   let |   let | ||||||
|  |     d = copts^.rsDay | ||||||
|     journalspan = journalDateSpan False j |     journalspan = journalDateSpan False j | ||||||
|     nonblanks = V.takeWhile (not . T.null . rsItemDate) $ rsList^.listElementsL |     nonblanks = V.takeWhile (not . T.null . rsItemDate) $ rsList^.listElementsL | ||||||
|     lastnonblankidx = max 0 (length nonblanks - 1) |     lastnonblankidx = max 0 (length nonblanks - 1) | ||||||
|  | |||||||
| @ -147,8 +147,8 @@ tsHandle ui@UIState{aScreen=TransactionScreen{tsTransaction=(i,t), tsTransaction | |||||||
|         _                    -> helpHandle ui ev |         _                    -> helpHandle ui ev | ||||||
| 
 | 
 | ||||||
|     _ -> do |     _ -> do | ||||||
|       d <- liftIO getCurrentDay |  | ||||||
|       let |       let | ||||||
|  |         d = copts^.rsDay | ||||||
|         (iprev,tprev) = maybe (i,t) ((i-1),) $ lookup (i-1) nts |         (iprev,tprev) = maybe (i,t) ((i-1),) $ lookup (i-1) nts | ||||||
|         (inext,tnext) = maybe (i,t) ((i+1),) $ lookup (i+1) nts |         (inext,tnext) = maybe (i,t) ((i+1),) $ lookup (i+1) nts | ||||||
|       case ev of |       case ev of | ||||||
| @ -166,7 +166,6 @@ tsHandle ui@UIState{aScreen=TransactionScreen{tsTransaction=(i,t), tsTransaction | |||||||
|             p = reportPeriod ui |             p = reportPeriod ui | ||||||
|         e | e `elem` [VtyEvent (EvKey (KChar 'g') []), AppEvent FileChange] -> do |         e | e `elem` [VtyEvent (EvKey (KChar 'g') []), AppEvent FileChange] -> do | ||||||
|           -- plog (if e == AppEvent FileChange then "file change" else "manual reload") "" `seq` return () |           -- plog (if e == AppEvent FileChange then "file change" else "manual reload") "" `seq` return () | ||||||
|           d <- liftIO getCurrentDay |  | ||||||
|           ej <- liftIO $ journalReload copts |           ej <- liftIO $ journalReload copts | ||||||
|           case ej of |           case ej of | ||||||
|             Left err -> continue $ screenEnter d errorScreen{esError=err} ui |             Left err -> continue $ screenEnter d errorScreen{esError=err} ui | ||||||
|  | |||||||
| @ -199,7 +199,7 @@ instance Show Text.Blaze.Markup where show _ = "<blaze markup>" | |||||||
| getViewData :: Handler ViewData | getViewData :: Handler ViewData | ||||||
| getViewData = do | getViewData = do | ||||||
|   App{appOpts=opts@WebOpts{cliopts_=copts@CliOpts{reportspec_=rspec@ReportSpec{_rsReportOpts}}}, appJournal} <- getYesod |   App{appOpts=opts@WebOpts{cliopts_=copts@CliOpts{reportspec_=rspec@ReportSpec{_rsReportOpts}}}, appJournal} <- getYesod | ||||||
|   today <- liftIO getCurrentDay |   let today = _rsDay rspec | ||||||
| 
 | 
 | ||||||
|   -- try to read the latest journal content, keeping the old content |   -- try to read the latest journal content, keeping the old content | ||||||
|   -- if there's an error |   -- if there's an error | ||||||
|  | |||||||
		Loading…
	
		Reference in New Issue
	
	Block a user