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.
This commit is contained in:
Simon Michael
parent
549ccd2743
commit
112272fd8f
@ -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'
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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}
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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.
|
||||
|
||||
@ -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
|
||||
|
||||
Loading…
Reference in New Issue
Block a user