From 112272fd8f74da7f26dd9bb50b92cb258d72f850 Mon Sep 17 00:00:00 2001 From: Simon Michael Date: Sat, 13 Sep 2025 09:17:49 +0100 Subject: [PATCH] fix:ui:transaction, error screens: more robust updating, third fix [#2014], [#2288] This makes both transaction screen and error screen below the transaction screen update as we'd expect when using the E key, g key, or --watch. No visible bugs known at the moment. --- hledger-ui/Hledger/UI/ErrorScreen.hs | 44 ++++++++---- hledger-ui/Hledger/UI/TransactionScreen.hs | 82 +++++++++++++++------- hledger-ui/Hledger/UI/UIState.hs | 5 +- hledger-ui/Hledger/UI/UIUtils.hs | 10 +++ hledger-ui/hledger-ui.m4.md | 11 --- hledger-ui/package.yaml | 1 + 6 files changed, 98 insertions(+), 55 deletions(-) diff --git a/hledger-ui/Hledger/UI/ErrorScreen.hs b/hledger-ui/Hledger/UI/ErrorScreen.hs index 19d7937e3..b6864d007 100644 --- a/hledger-ui/Hledger/UI/ErrorScreen.hs +++ b/hledger-ui/Hledger/UI/ErrorScreen.hs @@ -18,12 +18,12 @@ where import Brick -- import Brick.Widgets.Border ("border") -import Control.Monad import Control.Monad.IO.Class (liftIO) import Data.Time.Calendar (Day) import Data.Void (Void) import Graphics.Vty (Event(..),Key(..),Modifier(..)) import Lens.Micro ((^.)) +import Safe (headMay) import Text.Megaparsec import Text.Megaparsec.Char @@ -88,19 +88,20 @@ esHandle ev = do VtyEvent (EvKey (KChar 'q') []) -> halt VtyEvent (EvKey KEsc []) -> put' $ uiCheckBalanceAssertions d $ resetScreens d ui VtyEvent (EvKey (KChar c) []) | c `elem` ['h','?'] -> put' $ setMode Help ui - VtyEvent (EvKey (KChar 'E') []) -> suspendAndResume $ void (runEditor pos f) >> uiReloadIfFileChanged copts d j (popScreen ui) - -- XXX put ? uiCheckBalanceAssertions ? - -- does the error screen update the state, and check balance assertions, after running editor ? - where - (pos,f) = case parsewithString hledgerparseerrorpositionp _essError of - Right (f',l,c) -> (Just (l, Just c),f') - Left _ -> (endPosition, journalFilePath j) - e | e `elem` [VtyEvent (EvKey (KChar 'g') []), AppEvent FileChange] -> - uiReload copts d (popScreen ui) >>= put' . uiCheckBalanceAssertions d - -- (ej, _) <- liftIO $ journalReloadIfChanged copts d j - -- case ej of - -- Left err -> continue ui{aScreen=s{esError=err}} -- show latest parse error - -- Right j' -> continue $ regenerateScreens j' d $ popScreen ui -- return to previous screen, and reload it + + -- g or file change: reload the journal and rebuild app state. + e | e `elem` [VtyEvent (EvKey (KChar 'g') []), AppEvent FileChange] -> esReload copts d ui + + -- E: run editor, reload the journal. + VtyEvent (EvKey (KChar 'E') []) -> do + suspendAndResume' $ do + let + (pos,f) = case parsewithString hledgerparseerrorpositionp _essError of + Right (f',l,c) -> (Just (l, Just c),f') + Left _ -> (endPosition, journalFilePath j) + runEditor pos f + esReloadIfFileChanged copts d j ui + VtyEvent (EvKey (KChar 'I') []) -> put' $ uiCheckBalanceAssertions d (popScreen $ toggleIgnoreBalanceAssertions ui) VtyEvent (EvKey (KChar 'l') [MCtrl]) -> redraw VtyEvent (EvKey (KChar 'z') [MCtrl]) -> suspend ui @@ -108,6 +109,21 @@ esHandle ev = do _ -> errorWrongScreenType "esHandle" + where + -- Reload and fully regenerate the error screen. + -- XXX On an error screen below the transaction screen, this is tricky because of a current limitation of regenerateScreens. + -- For now we try to work around by re-entering the transaction screen. + -- This can show flicker in the UI and it's hard to handle all situations robustly. + esReload copts d ui = uiReload copts d ui >>= maybeReloadErrorScreen d + esReloadIfFileChanged copts d j ui = liftIO (uiReloadIfFileChanged copts d j ui) >>= maybeReloadErrorScreen d + maybeReloadErrorScreen d ui = + case headMay $ aPrevScreens ui of + Just (TS _) -> do + -- check balance assertions, exit to register screen, enter transaction screen, reload once more + put' $ popScreen $ popScreen $ uiCheckBalanceAssertions d ui + sendVtyEvents [EvKey KEnter [], EvKey (KChar 'g') []] -- XXX Might be disrupted if other events are queued ? + _ -> return () + -- | Parse the file name, line and column number from a hledger parse error message, if possible. -- Temporary, we should keep the original parse error location. XXX -- Keep in sync with 'Hledger.Data.Transaction.showGenericSourcePos' diff --git a/hledger-ui/Hledger/UI/TransactionScreen.hs b/hledger-ui/Hledger/UI/TransactionScreen.hs index 7d1409f2f..1d8ff408d 100644 --- a/hledger-ui/Hledger/UI/TransactionScreen.hs +++ b/hledger-ui/Hledger/UI/TransactionScreen.hs @@ -12,14 +12,15 @@ module Hledger.UI.TransactionScreen ,tsHandle ) where +import Brick import Brick.Widgets.Edit (editorText, renderEditor) +import Brick.Widgets.List (listMoveTo) import Control.Monad.IO.Class (liftIO) import Data.List import Data.Maybe import qualified Data.Text as T import Graphics.Vty (Event(..),Key(..),Modifier(..), Button (BLeft)) -import Brick -import Brick.Widgets.List (listMoveTo) +import System.Exit (ExitCode (..)) import Hledger import Hledger.Cli hiding (mode, prices, progname,prognameandversion) @@ -31,8 +32,6 @@ import Hledger.UI.UIScreens import Hledger.UI.Editor import Hledger.UI.ErrorScreen (uiCheckBalanceAssertions, uiReload, uiReloadIfFileChanged) import Hledger.UI.RegisterScreen (rsHandle) -import System.Exit (ExitCode(..)) -import Data.Function ((&)) tsDraw :: UIState -> [Widget Name] tsDraw UIState{aopts=UIOpts{uoCliOpts=copts@CliOpts{reportspec_=rspec@ReportSpec{_rsReportOpts=ropts}}} @@ -140,25 +139,9 @@ tsHandle ev = do VtyEvent (EvKey KEsc []) -> put' $ resetScreens d ui VtyEvent (EvKey (KChar c) []) | c == '?' -> put' $ setMode Help ui - -- g or file change: reload the journal. - e | e `elem` [VtyEvent (EvKey (KChar 'g') []), AppEvent FileChange] -> do - -- Update app state. This is tricky: (XXX anywhere else we need to be this thorough ?) - - -- Reload and regenerate screens - ui1 <- uiReload copts d ui - -- If that moved us to the error screen, save that and return to the transaction screen. - let - (merrscr, ui2) = case aScreen ui1 of - s@(ES _) -> (Just s, popScreen ui1) - _ -> (Nothing, ui1) - -- put' ui2 - -- Now exit to register screen and make it regenerate the transaction screen, - -- for best initialisation. - put' $ popScreen ui2 - rsHandle (VtyEvent (EvKey KEnter [])) -- XXX PARTIAL assumes we are on the register screen - -- Then re-enter the error screen if any, so error repair will return to the transaction screen. - let ui3 = maybe ui2 (`pushScreen` ui2) merrscr - put' ui3 + -- g or file change: reload the journal and rebuild app state. + e | e `elem` [VtyEvent (EvKey (KChar 'g') []), AppEvent FileChange] -> + tsReload copts d ui -- for debugging; leaving these here because they were hard to find -- \u -> dbguiEv (pshow u) >> put' u -- doesn't log @@ -167,14 +150,12 @@ tsHandle ev = do -- E: run editor, reload the journal. VtyEvent (EvKey (KChar 'E') []) -> do suspendAndResume' $ do + let (pos,f) = case tsourcepos t of (SourcePos f' l1 c1,_) -> (Just (unPos l1, Just $ unPos c1),f') exitcode <- runEditor pos f case exitcode of ExitSuccess -> return () ExitFailure c -> error' $ "running the text editor failed with exit code " ++ show c - -- Update all state, similar to above. - put' =<< liftIO (popScreen ui & uiReloadIfFileChanged copts d j) - rsHandle (VtyEvent (EvKey KEnter [])) - where (pos,f) = case tsourcepos t of (SourcePos f' l1 c1,_) -> (Just (unPos l1, Just $ unPos c1),f') + tsReloadIfFileChanged copts d j ui AppEvent (DateChange old _) | isStandardPeriod p && p `periodContainsDate` old -> put' $ regenerateScreens j d $ setReportPeriod (DayPeriod d) ui @@ -205,6 +186,53 @@ tsHandle ev = do _ -> errorWrongScreenType "tsHandle" + 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 + + -- | Select a new transaction and update the previous register screen tsSelect :: Integer -> Transaction -> UIState -> UIState tsSelect i t ui@UIState{aScreen=TS sst} = case aPrevScreens ui of diff --git a/hledger-ui/Hledger/UI/UIState.hs b/hledger-ui/Hledger/UI/UIState.hs index 9d282a89a..dab638ea2 100644 --- a/hledger-ui/Hledger/UI/UIState.hs +++ b/hledger-ui/Hledger/UI/UIState.hs @@ -366,9 +366,8 @@ 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. -- --- Currently this does not properly regenerate the transaction screen or error screen, --- which depend on state from their parent(s). (Eg rsHandle generates TS's nts from its list items.) --- As a workaround we can additionally exit and reenter those screens; but this is fragile. +-- 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. 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} diff --git a/hledger-ui/Hledger/UI/UIUtils.hs b/hledger-ui/Hledger/UI/UIUtils.hs index 4e0c07508..a5a2a1a66 100644 --- a/hledger-ui/Hledger/UI/UIUtils.hs +++ b/hledger-ui/Hledger/UI/UIUtils.hs @@ -42,6 +42,7 @@ module Hledger.UI.UIUtils ( ,mapScreens ,uiNumBlankItems ,showScreenStack + ,sendVtyEvents ) where @@ -51,6 +52,7 @@ import Brick.Widgets.Border.Style import Brick.Widgets.Dialog import Brick.Widgets.Edit import Brick.Widgets.List (List, listSelectedL, listNameL, listItemHeightL, listSelected, listMoveDown, listMoveUp, GenericList, listElements) +import Control.Concurrent.STM (atomically, writeTChan) -- GHC only import Control.Monad.IO.Class import Data.Bifunctor (second) import Data.List @@ -59,6 +61,7 @@ import Data.Time (addDays) import Graphics.Vty (Event(..),Key(..),Modifier(..),Vty(..),Color,Attr,currentAttr,refresh, displayBounds -- ,Output(displayBounds,mkDisplayContext),DisplayContext(..) + ,Vty (inputIface), InternalEvent (InputEvent), Input (eventChannel) ) import Lens.Micro.Platform @@ -530,3 +533,10 @@ uiNumBlankItems -- | debugLevel >= uiDebugLevel = 0 -- suppress to improve debug output. -- | otherwise = 100 -- 100 ought to be enough for anyone + +-- Send some events to vty, atomically so they won't have other events interleaved. +-- (But there may be events already in the channel ahead of them.) +sendVtyEvents :: [Event] -> EventM n s () +sendVtyEvents evs = do + input <- eventChannel . inputIface <$> getVtyHandle + liftIO $ atomically $ mapM_ (writeTChan input . InputEvent) evs diff --git a/hledger-ui/hledger-ui.m4.md b/hledger-ui/hledger-ui.m4.md index 2ddef2e62..c9b16634c 100644 --- a/hledger-ui/hledger-ui.m4.md +++ b/hledger-ui/hledger-ui.m4.md @@ -291,13 +291,6 @@ reload). On this screen (and the register screen), the `E` key will open your text editor with the cursor positioned at the current transaction if possible. -This screen has a limitation with showing file updates: -it will not show them until you exit and re-enter it. -So eg to see the effect of using the `E` key, currently you must: -- press `E`, edit and save the file, then exit the editor, returning to hledger-ui -- press `g` to reload the file (or use `-w/--watch` mode) -- press `LEFT` then `RIGHT` to exit and re-enter the transaction screen. - ## Error screen This screen will appear if there is a problem, such as a parse error, @@ -365,8 +358,4 @@ Some known issues: `--watch` is not robust, especially with large files (see WATCH MODE above). -The Transaction screen does not update after file changes, even if you press `g`, -until you exit and re-enter it. -([#2288](https://github.com/simonmichael/hledger/issues/2288)) - If you press `g` with large files, there could be a noticeable pause with the UI unresponsive. diff --git a/hledger-ui/package.yaml b/hledger-ui/package.yaml index 260cf486b..b85a9be32 100644 --- a/hledger-ui/package.yaml +++ b/hledger-ui/package.yaml @@ -106,6 +106,7 @@ library: - process >=1.2 - safe >=0.3.20 - split >=0.1 + - stm - text >=1.2.4.1 - text-zipper >=0.4 - time >=1.5