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

@@ -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 ?
+            -- g or file change: reload the journal and rebuild app state.
-              -- does the error screen update the state, and check balance assertions, after running editor ?
+            e | e `elem` [VtyEvent (EvKey (KChar 'g') []), AppEvent FileChange] -> esReload copts d ui
-              where
+
-                (pos,f) = case parsewithString hledgerparseerrorpositionp _essError of
+            -- E: run editor, reload the journal.
-                            Right (f',l,c) -> (Just (l, Just c),f')
+            VtyEvent (EvKey (KChar 'E') []) -> do
-                            Left  _       -> (endPosition, journalFilePath j)
+              suspendAndResume' $ do
-            e | e `elem` [VtyEvent (EvKey (KChar 'g') []), AppEvent FileChange] ->
+                let
-              uiReload copts d (popScreen ui) >>= put' . uiCheckBalanceAssertions d
+                  (pos,f) = case parsewithString hledgerparseerrorpositionp _essError of
-              -- (ej, _) <- liftIO $ journalReloadIfChanged copts d j
+                              Right (f',l,c) -> (Just (l, Just c),f')
-              -- case ej of
+                              Left  _       -> (endPosition, journalFilePath j)
-              --   Left err -> continue ui{aScreen=s{esError=err}} -- show latest parse error
+                runEditor pos f
-              --   Right j' -> continue $ regenerateScreens j' d $ popScreen ui  -- return to previous screen, and reload it
+              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'

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 System.Exit (ExitCode (..))
-import Brick.Widgets.List (listMoveTo)
 
 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.
+            -- g or file change: reload the journal and rebuild app state.
-            e | e `elem` [VtyEvent (EvKey (KChar 'g') []), AppEvent FileChange] -> do
+            e | e `elem` [VtyEvent (EvKey (KChar 'g') []), AppEvent FileChange] ->
-              -- Update app state. This is tricky: (XXX anywhere else we need to be this thorough ?)
+              tsReload copts d ui
-
-              -- 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
 
               -- 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.
+              tsReloadIfFileChanged copts d j ui
-              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')
 
             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

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,
+-- XXX 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.)
+-- which depend on state from their parent(s); those screens' handlers must do additional work, which is fragile.
--- As a workaround we can additionally exit and reenter those screens; but this 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}

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

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.

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