diff --git a/hledger-ui/Hledger/UI/RegisterScreen.hs b/hledger-ui/Hledger/UI/RegisterScreen.hs index 74ebe55fc80..541c19a2dd8 100644 --- a/hledger-ui/Hledger/UI/RegisterScreen.hs +++ b/hledger-ui/Hledger/UI/RegisterScreen.hs @@ -245,7 +245,9 @@ rsHandle ev = do where p = reportPeriod ui - e | e `elem` [AppEvent FileChange, VtyEvent (EvKey (KChar 'g') [])] -> uiReload copts d ui >>= put' + e | e `elem` [AppEvent FileChange, VtyEvent (EvKey (KChar 'g') [])] -> do + ui' <- uiReload copts d ui + put' $ regenerateScreens (ajournal ui') d ui' VtyEvent (EvKey (KChar 'I') []) -> uiToggleBalanceAssertions d ui VtyEvent (EvKey (KChar 'a') []) -> suspendAndResume $ clearScreen >> setCursorPosition 0 0 >> add (cliOptsDropArgs copts) j >> uiReloadIfFileChanged copts d j ui diff --git a/hledger-ui/Hledger/UI/TransactionScreen.hs b/hledger-ui/Hledger/UI/TransactionScreen.hs index 50ac313b7c9..5656b065902 100644 --- a/hledger-ui/Hledger/UI/TransactionScreen.hs +++ b/hledger-ui/Hledger/UI/TransactionScreen.hs @@ -31,7 +31,6 @@ import Hledger.UI.UIUtils import Hledger.UI.UIScreens import Hledger.UI.Editor import Hledger.UI.ErrorScreen (uiCheckBalanceAssertions, uiReload, uiReloadIfFileChanged, uiToggleBalanceAssertions) -import Hledger.UI.RegisterScreen (rsHandle) tsDraw :: UIState -> [Widget Name] tsDraw UIState{aopts=UIOpts{uoCliOpts=copts@CliOpts{reportspec_=rspec@ReportSpec{_rsReportOpts=ropts}}} @@ -188,50 +187,8 @@ tsHandle ev = do where -- Reload and fully regenerate the transaction screen. - -- XXX On transaction screen or below, this is tricky because of a current limitation of regenerateScreens. - -- For now we try to work around by re-entering the screen(s). - -- This can show flicker in the UI and it's hard to handle all situations robustly. - tsReload copts d ui = uiReload copts d ui >>= reEnterTransactionScreen copts d - tsReloadIfFileChanged copts d j ui = liftIO (uiReloadIfFileChanged copts d j ui) >>= reEnterTransactionScreen copts d - - reEnterTransactionScreen _copts d ui = do - -- 1. If uiReload (or checking balance assertions) moved us to the error screen, save that, and return to the transaction screen. - let - (merrscr, uiTxn) = case aScreen $ uiCheckBalanceAssertions d ui of - s@(ES _) -> (Just s, popScreen ui) - _ -> (Nothing, ui) - -- 2. Exit to register screen - let uiReg = popScreen uiTxn - put' uiReg - -- 3. Re-enter the transaction screen - rsHandle (VtyEvent (EvKey KEnter [])) -- PARTIAL assumes we are on the register screen. - -- 4. Return to the error screen (below the transaction screen) if there was one. - -- Next events will be handled by esHandle. Error repair will return to the transaction screen. - maybe (return ()) (put' . flip pushScreen uiTxn) merrscr - -- doesn't uiTxn have old state from before step 3 ? seems to work - - -- XXX some problem: - -- 4. Reload once more, possibly re-entering the error screen, by sending a g event. - -- sendVtyEvents [EvKey (KChar 'g') []] -- XXX Might be disrupted if other events are queued - - -- XXX doesn't update on non-error change: - -- 4. Reload once more, possibly re-entering the error screen. - -- uiTxnOrErr <- uiReload copts d uiTxn - -- uiReloadIfChanged ? - -- uiCheckBalanceAssertions ? seems unneeded - -- put' uiTxnOrErr - - -- XXX not working right: - -- -- 1. If uiReload (or checking balance assertions) moved us to the error screen, exit to the transaction screen. - -- let - -- uiTxn = case aScreen $ uiCheckBalanceAssertions d ui of - -- ES _ -> popScreen ui - -- _ -> ui - -- -- 2. Exit to register screen - -- put' $ popScreen uiTxn - -- -- 3. Re-enter the transaction screen, and reload once more. - -- sendVtyEvents [EvKey KEnter [], EvKey (KChar 'g') []] -- XXX Might be disrupted if other events are queued - + tsReload copts d ui = uiReload copts d ui >>= put' + tsReloadIfFileChanged copts d j ui = liftIO (uiReloadIfFileChanged copts d j ui) >>= put' -- | Select a new transaction and update the previous register screen tsSelect :: Integer -> Transaction -> UIState -> UIState diff --git a/hledger-ui/Hledger/UI/UIScreens.hs b/hledger-ui/Hledger/UI/UIScreens.hs index d182345a2d3..e8810634265 100644 --- a/hledger-ui/Hledger/UI/UIScreens.hs +++ b/hledger-ui/Hledger/UI/UIScreens.hs @@ -63,7 +63,7 @@ screenUpdate opts d j = \case BS sst -> BS $ bsUpdate opts d j sst IS sst -> IS $ isUpdate opts d j sst RS sst -> RS $ rsUpdate opts d j sst - TS sst -> TS $ tsUpdate sst + TS sst -> TS $ tsUpdate opts d j sst ES sst -> ES $ esUpdate sst -- | Construct an error screen. @@ -241,11 +241,12 @@ rsNew uopts d j acct forceinclusive = -- XXX forcedefaultselection - whether to } -- | Update a register screen from these options, reporting date, and journal. -rsUpdate :: UIOpts -> Day -> Journal -> RegisterScreenState -> RegisterScreenState -rsUpdate uopts d j rss@RSS{_rssAccount, _rssForceInclusive, _rssList=oldlist} = - dbgui "rsUpdate" +rsUpdate uopts d j rss@RSS{_rssAccount, _rssForceInclusive} = + dbgui "rsUpdate" $ rss{_rssList=l'} where + -- Force evaluation of old list to allow GC + !oldlist = _rssList rss UIOpts{uoCliOpts=copts@CliOpts{reportspec_=rspec@ReportSpec{_rsReportOpts=ropts}}} = uopts -- gather arguments and queries -- XXX temp @@ -279,7 +280,8 @@ rsUpdate uopts d j rss@RSS{_rssAccount, _rssForceInclusive, _rssList=oldlist} = items -- pre-render the list items, helps calculate column widths - displayitems = map displayitem items' + -- Force evaluation to prevent thunk accumulation + !displayitems = map displayitem items' where displayitem (t, _, _issplit, otheraccts, change, bal) = RegisterScreenItem{rsItemDate = showDate $ transactionRegisterDate wd (_rsQuery rspec') thisacctq t @@ -297,7 +299,7 @@ rsUpdate uopts d j rss@RSS{_rssAccount, _rssForceInclusive, _rssList=oldlist} = -- blank items are added to allow more control of scroll position; we won't allow movement over these. -- XXX Ugly. Changing to 0 helps when debugging. - blankitems = replicate uiNumBlankItems + !blankitems = replicate uiNumBlankItems RegisterScreenItem{rsItemDate = "" ,rsItemStatus = Unmarked ,rsItemDescription = "" @@ -308,7 +310,8 @@ rsUpdate uopts d j rss@RSS{_rssAccount, _rssForceInclusive, _rssList=oldlist} = } -- build the new list widget - l = list RegisterList (V.fromList $ displayitems ++ blankitems) 1 + !itemsVector = V.fromList $ displayitems ++ blankitems + !l = list RegisterList itemsVector 1 -- ensure the appropriate list item is selected: -- if forcedefaultselection is true, the last (latest) transaction; XXX still needed ? @@ -316,7 +319,7 @@ rsUpdate uopts d j rss@RSS{_rssAccount, _rssForceInclusive, _rssList=oldlist} = -- otherwise, the transaction nearest in date to it; -- or if there's several with the same date, the nearest in journal order; -- otherwise, the last (latest) transaction. - l' = listMoveTo newselidx l + !l' = listMoveTo newselidx l where endidx = max 0 $ length displayitems - 1 newselidx = @@ -357,10 +360,17 @@ tsNew acct nts nt = ,_tssTransaction = nt } --- | Update a transaction screen. --- This currently does nothing because the initialisation in rsHandle is not so easy to extract. --- To see the updated transaction, one must exit and re-enter the transaction screen. --- See also tsHandle. -tsUpdate :: TransactionScreenState -> TransactionScreenState -tsUpdate = dbgui "tsUpdate" - +-- | Update a transaction screen by refreshing the current transaction from the journal. +-- This preserves the current transaction selection while updating its data. +-- XXX Caveat, this works by showing the transaction at the same index in the processed ledger, +-- if transactions have been inserted or removed before the one shown this will just show +-- whatever transaction landed at the same index in the new data set. +tsUpdate :: UIOpts -> Day -> Journal -> TransactionScreenState -> TransactionScreenState +tsUpdate _ _ j tss@TSS{_tssTransaction=(currentIdx,currentTxn)} = + dbgui "tsUpdate" $ + let + -- Find the updated version of the current transaction in the journal + updatedTxn = case find (\t -> tindex t == tindex currentTxn) (jtxns j) of + Just t -> t + Nothing -> currentTxn -- fallback to current if not found + in tss { _tssTransaction = (currentIdx, updatedTxn) } diff --git a/hledger-ui/Hledger/UI/UIState.hs b/hledger-ui/Hledger/UI/UIState.hs index d7a97f7c57e..1b8a9b6c248 100644 --- a/hledger-ui/Hledger/UI/UIState.hs +++ b/hledger-ui/Hledger/UI/UIState.hs @@ -59,7 +59,7 @@ import Hledger import Hledger.Cli.CliOptions import Hledger.UI.UITypes import Hledger.UI.UIOptions (UIOpts(uoCliOpts)) -import Hledger.UI.UIScreens (screenUpdate) +import Hledger.UI.UIScreens import Hledger.UI.UIUtils (showScreenId, showScreenStack) -- | Make an initial UI state with the given options, journal, @@ -366,8 +366,18 @@ resetScreens d ui@UIState{astartupopts=origopts, ajournal=j, aScreen=s,aPrevScre -- (using the ui state's current options), preserving the screen navigation history. -- Note, does not save the reporting date. -- --- XXX Currently this does not properly regenerate the transaction screen or error screen, --- which depend on state from their parent(s); those screens' handlers must do additional work, which is fragile. +-- XXX Currently this does not properly regenerate the error screen, +-- which depends on state from their parent(s); that screens' handler must do additional work, which is fragile. regenerateScreens :: Journal -> Day -> UIState -> UIState -regenerateScreens j d ui@UIState{aopts=opts, aScreen=s,aPrevScreens=ss} = - ui{ajournal=j, aScreen=screenUpdate opts d j s, aPrevScreens=map (screenUpdate opts d j) ss} +regenerateScreens j d ui@UIState{aScreen=s} = + let !ui' = ui{ajournal=j, aScreen=s'} + !s' = case s of + MS mss -> MS $! msUpdate mss + AS ass -> AS $! asUpdate (aopts ui') d j ass + CS ass -> CS $! csUpdate (aopts ui') d j ass + BS ass -> BS $! bsUpdate (aopts ui') d j ass + IS ass -> IS $! isUpdate (aopts ui') d j ass + RS rss -> RS $! rsUpdate (aopts ui') d j rss + TS tss -> TS $! tsUpdate (aopts ui') d j tss + ES _ -> s + in ui' diff --git a/hledger-ui/hledger-ui.m4.md b/hledger-ui/hledger-ui.m4.md index 74126d9d372..940d6dd3c0d 100644 --- a/hledger-ui/hledger-ui.m4.md +++ b/hledger-ui/hledger-ui.m4.md @@ -330,14 +330,10 @@ eg to toggle cleared mode, or to explore the history. ([#836](https://github.com/simonmichael/hledger/issues/836)) - It may not detect changes made from outside a virtual machine, ie by an editor running on the host system. - It may not detect file changes on certain less common filesystems. -- It may use increasing CPU and RAM over time, especially with large files. - (This is probably not --watch specific, you may be able to reproduce it by pressing `g` repeatedly.) - ([#1825](https://github.com/simonmichael/hledger/issues/1825)) Tips/workarounds: - If --watch won't work for you, press `g` to reload data manually instead. -- If --watch is leaking resources over time, quit and restart (or suspend and resume) hledger-ui when you're not using it. - When running hledger-ui inside a VM, also make file changes inside the VM. - When working with files mounted from another machine, make sure the system clocks on both machines are roughly in agreement.