From 67cd6be42481361edf88ada5602e1b40a57b60ae Mon Sep 17 00:00:00 2001 From: Simon Michael Date: Mon, 22 Aug 2022 23:55:14 +0100 Subject: [PATCH] imp: ui: at --debug=2, do lots of logging to debug.log --- hledger-ui/Hledger/UI/AccountsScreen.hs | 89 ++++++++++---------- hledger-ui/Hledger/UI/ErrorScreen.hs | 2 +- hledger-ui/Hledger/UI/Main.hs | 4 +- hledger-ui/Hledger/UI/RegisterScreen.hs | 96 +++++++++++----------- hledger-ui/Hledger/UI/TransactionScreen.hs | 40 ++++----- hledger-ui/Hledger/UI/UITypes.hs | 7 +- hledger-ui/Hledger/UI/UIUtils.hs | 47 ++++++++++- 7 files changed, 170 insertions(+), 115 deletions(-) diff --git a/hledger-ui/Hledger/UI/AccountsScreen.hs b/hledger-ui/Hledger/UI/AccountsScreen.hs index e16deb011..45394b5c8 100644 --- a/hledger-ui/Hledger/UI/AccountsScreen.hs +++ b/hledger-ui/Hledger/UI/AccountsScreen.hs @@ -54,7 +54,7 @@ asInit d reset ui@UIState{ aopts=UIOpts{uoCliOpts=copts@CliOpts{reportspec_=rspec@ReportSpec{_rsReportOpts=ropts}}}, ajournal=j, aScreen=s@AccountsScreen{} - } = + } = dlogUiTrace "asInit 1" $ ui{aScreen=s & asList .~ newitems'} where newitems = list AccountsList (V.fromList $ displayitems ++ blankitems) 1 @@ -97,7 +97,7 @@ asInit d reset ui@UIState{ displayitems = map displayitem items -- blanks added for scrolling control, cf RegisterScreen. -- XXX Ugly. Changing to 0 helps when debugging. - blankitems = replicate 100 + blankitems = replicate uiNumBlankItems AccountsScreenItem{asItemIndentLevel = 0 ,asItemAccountName = "" ,asItemDisplayAccountName = "" @@ -105,14 +105,14 @@ asInit d reset ui@UIState{ } -asInit _ _ _ = error "init function called with wrong screen type, should not happen" -- PARTIAL: +asInit _ _ _ = dlogUiTrace "asInit 2" $ errorWrongScreenType "init function" -- PARTIAL: asDraw :: UIState -> [Widget Name] asDraw UIState{aopts=_uopts@UIOpts{uoCliOpts=copts@CliOpts{reportspec_=rspec}} ,ajournal=j ,aScreen=s@AccountsScreen{} ,aMode=mode - } = + } = dlogUiTrace "asDraw 1" $ case mode of Help -> [helpDialog copts, maincontent] -- Minibuffer e -> [minibuffer e, maincontent] @@ -203,7 +203,7 @@ asDraw UIState{aopts=_uopts@UIOpts{uoCliOpts=copts@CliOpts{reportspec_=rspec}} ,("q", str "quit") ] -asDraw _ = error "draw function called with wrong screen type, should not happen" -- PARTIAL: +asDraw _ = dlogUiTrace "asDraw 2" $ errorWrongScreenType "draw function" -- PARTIAL: asDrawItem :: (Int,Int) -> Bool -> AccountsScreenItem -> Widget Name asDrawItem (acctwidth, balwidth) selected AccountsScreenItem{..} = @@ -227,7 +227,8 @@ asDrawItem (acctwidth, balwidth) selected AccountsScreenItem{..} = asHandle :: BrickEvent Name AppEvent -> EventM Name UIState () asHandle ev = do - ui0 <- get + ui0 <- get' + dlogUiTraceM "asHandle 1" case ui0 of ui1@UIState{ aScreen=scr@AccountsScreen{..} @@ -250,8 +251,8 @@ asHandle ev = do case mode of Minibuffer _ ed -> case ev of - VtyEvent (EvKey KEsc []) -> put $ closeMinibuffer ui - VtyEvent (EvKey KEnter []) -> put $ regenerateScreens j d $ + VtyEvent (EvKey KEsc []) -> put' $ closeMinibuffer ui + VtyEvent (EvKey KEnter []) -> put' $ regenerateScreens j d $ case setFilter s $ closeMinibuffer ui of Left bad -> showMinibuffer "Cannot compile regular expression" (Just bad) ui Right ui' -> ui' @@ -260,7 +261,7 @@ asHandle ev = do VtyEvent (EvKey (KChar 'z') [MCtrl]) -> suspend ui VtyEvent ev -> do ed' <- nestEventM' ed $ handleEditorEvent (VtyEvent ev) - put ui{aMode=Minibuffer "filter" ed'} + put' ui{aMode=Minibuffer "filter" ed'} AppEvent _ -> return () MouseDown{} -> return () MouseUp{} -> return () @@ -276,36 +277,36 @@ asHandle ev = do case ev of VtyEvent (EvKey (KChar 'q') []) -> halt -- EvKey (KChar 'l') [MCtrl] -> do - VtyEvent (EvKey KEsc []) -> put $ resetScreens d ui - VtyEvent (EvKey (KChar c) []) | c == '?' -> put $ setMode Help ui + VtyEvent (EvKey KEsc []) -> put' $ resetScreens d ui + VtyEvent (EvKey (KChar c) []) | c == '?' -> put' $ setMode Help ui -- XXX AppEvents currently handled only in Normal mode -- XXX be sure we don't leave unconsumed events piling up AppEvent (DateChange old _) | isStandardPeriod p && p `periodContainsDate` old -> - put $ regenerateScreens j d $ setReportPeriod (DayPeriod d) ui + put' $ regenerateScreens j d $ setReportPeriod (DayPeriod d) ui where p = reportPeriod ui e | e `elem` [VtyEvent (EvKey (KChar 'g') []), AppEvent FileChange] -> - liftIO (uiReloadJournal copts d ui) >>= put - VtyEvent (EvKey (KChar 'I') []) -> put $ uiCheckBalanceAssertions d (toggleIgnoreBalanceAssertions ui) + liftIO (uiReloadJournal copts d ui) >>= put' + VtyEvent (EvKey (KChar 'I') []) -> put' $ uiCheckBalanceAssertions d (toggleIgnoreBalanceAssertions ui) VtyEvent (EvKey (KChar 'a') []) -> suspendAndResume $ clearScreen >> setCursorPosition 0 0 >> add copts j >> uiReloadJournalIfChanged copts d j ui VtyEvent (EvKey (KChar 'A') []) -> suspendAndResume $ void (runIadd (journalFilePath j)) >> uiReloadJournalIfChanged copts d j ui VtyEvent (EvKey (KChar 'E') []) -> suspendAndResume $ void (runEditor endPosition (journalFilePath j)) >> uiReloadJournalIfChanged copts d j ui - VtyEvent (EvKey (KChar 'B') []) -> put $ regenerateScreens j d $ toggleConversionOp ui - VtyEvent (EvKey (KChar 'V') []) -> put $ regenerateScreens j d $ toggleValue ui - VtyEvent (EvKey (KChar '0') []) -> put $ regenerateScreens j d $ setDepth (Just 0) ui - VtyEvent (EvKey (KChar '1') []) -> put $ regenerateScreens j d $ setDepth (Just 1) ui - VtyEvent (EvKey (KChar '2') []) -> put $ regenerateScreens j d $ setDepth (Just 2) ui - VtyEvent (EvKey (KChar '3') []) -> put $ regenerateScreens j d $ setDepth (Just 3) ui - VtyEvent (EvKey (KChar '4') []) -> put $ regenerateScreens j d $ setDepth (Just 4) ui - VtyEvent (EvKey (KChar '5') []) -> put $ regenerateScreens j d $ setDepth (Just 5) ui - VtyEvent (EvKey (KChar '6') []) -> put $ regenerateScreens j d $ setDepth (Just 6) ui - VtyEvent (EvKey (KChar '7') []) -> put $ regenerateScreens j d $ setDepth (Just 7) ui - VtyEvent (EvKey (KChar '8') []) -> put $ regenerateScreens j d $ setDepth (Just 8) ui - VtyEvent (EvKey (KChar '9') []) -> put $ regenerateScreens j d $ setDepth (Just 9) ui - VtyEvent (EvKey (KChar '-') []) -> put $ regenerateScreens j d $ decDepth ui - VtyEvent (EvKey (KChar '_') []) -> put $ regenerateScreens j d $ decDepth ui - VtyEvent (EvKey (KChar c) []) | c `elem` ['+','='] -> put $ regenerateScreens j d $ incDepth ui - VtyEvent (EvKey (KChar 'T') []) -> put $ regenerateScreens j d $ setReportPeriod (DayPeriod d) ui + VtyEvent (EvKey (KChar 'B') []) -> put' $ regenerateScreens j d $ toggleConversionOp ui + VtyEvent (EvKey (KChar 'V') []) -> put' $ regenerateScreens j d $ toggleValue ui + VtyEvent (EvKey (KChar '0') []) -> put' $ regenerateScreens j d $ setDepth (Just 0) ui + VtyEvent (EvKey (KChar '1') []) -> put' $ regenerateScreens j d $ setDepth (Just 1) ui + VtyEvent (EvKey (KChar '2') []) -> put' $ regenerateScreens j d $ setDepth (Just 2) ui + VtyEvent (EvKey (KChar '3') []) -> put' $ regenerateScreens j d $ setDepth (Just 3) ui + VtyEvent (EvKey (KChar '4') []) -> put' $ regenerateScreens j d $ setDepth (Just 4) ui + VtyEvent (EvKey (KChar '5') []) -> put' $ regenerateScreens j d $ setDepth (Just 5) ui + VtyEvent (EvKey (KChar '6') []) -> put' $ regenerateScreens j d $ setDepth (Just 6) ui + VtyEvent (EvKey (KChar '7') []) -> put' $ regenerateScreens j d $ setDepth (Just 7) ui + VtyEvent (EvKey (KChar '8') []) -> put' $ regenerateScreens j d $ setDepth (Just 8) ui + VtyEvent (EvKey (KChar '9') []) -> put' $ regenerateScreens j d $ setDepth (Just 9) ui + VtyEvent (EvKey (KChar '-') []) -> put' $ regenerateScreens j d $ decDepth ui + VtyEvent (EvKey (KChar '_') []) -> put' $ regenerateScreens j d $ decDepth ui + VtyEvent (EvKey (KChar c) []) | c `elem` ['+','='] -> put' $ regenerateScreens j d $ incDepth ui + VtyEvent (EvKey (KChar 'T') []) -> put' $ regenerateScreens j d $ setReportPeriod (DayPeriod d) ui -- display mode/query toggles VtyEvent (EvKey (KChar 'H') []) -> modify (regenerateScreens j d . toggleHistorical) >> asCenterAndContinue @@ -317,13 +318,13 @@ asHandle ev = do VtyEvent (EvKey (KChar 'C') []) -> modify (regenerateScreens j d . toggleCleared) >> asCenterAndContinue VtyEvent (EvKey (KChar 'F') []) -> modify (regenerateScreens j d . toggleForecast d) - VtyEvent (EvKey (KDown) [MShift]) -> put $ regenerateScreens j d $ shrinkReportPeriod d ui - VtyEvent (EvKey (KUp) [MShift]) -> put $ regenerateScreens j d $ growReportPeriod d ui - VtyEvent (EvKey (KRight) [MShift]) -> put $ regenerateScreens j d $ nextReportPeriod journalspan ui - VtyEvent (EvKey (KLeft) [MShift]) -> put $ regenerateScreens j d $ previousReportPeriod journalspan ui - VtyEvent (EvKey (KChar '/') []) -> put $ regenerateScreens j d $ showMinibuffer "filter" Nothing ui - VtyEvent (EvKey k []) | k `elem` [KBS, KDel] -> (put $ regenerateScreens j d $ resetFilter ui) - VtyEvent e | e `elem` moveLeftEvents -> put $ popScreen ui + VtyEvent (EvKey (KDown) [MShift]) -> put' $ regenerateScreens j d $ shrinkReportPeriod d ui + VtyEvent (EvKey (KUp) [MShift]) -> put' $ regenerateScreens j d $ growReportPeriod d ui + VtyEvent (EvKey (KRight) [MShift]) -> put' $ regenerateScreens j d $ nextReportPeriod journalspan ui + VtyEvent (EvKey (KLeft) [MShift]) -> put' $ regenerateScreens j d $ previousReportPeriod journalspan ui + VtyEvent (EvKey (KChar '/') []) -> put' $ regenerateScreens j d $ showMinibuffer "filter" Nothing ui + VtyEvent (EvKey k []) | k `elem` [KBS, KDel] -> (put' $ regenerateScreens j d $ resetFilter ui) + VtyEvent e | e `elem` moveLeftEvents -> put' $ popScreen ui VtyEvent (EvKey (KChar 'l') [MCtrl]) -> scrollSelectionToMiddle _asList >> redraw VtyEvent (EvKey (KChar 'z') [MCtrl]) -> suspend ui @@ -335,7 +336,7 @@ asHandle ev = do -- MouseDown is sometimes duplicated, https://github.com/jtdaugherty/brick/issues/347 -- just use it to move the selection MouseDown _n BLeft _mods Location{loc=(_x,y)} | not $ (=="") clickedacct -> do - put ui{aScreen=scr} -- XXX does this do anything ? + put' ui{aScreen=scr} -- XXX does this do anything ? where clickedacct = maybe "" asItemAccountName $ listElements _asList !? y -- and on MouseUp, enter the subscreen MouseUp _n (Just BLeft) Location{loc=(_x,y)} | not $ (=="") clickedacct -> do @@ -352,7 +353,7 @@ asHandle ev = do MouseDown name btn _mods _loc | btn `elem` [BScrollUp, BScrollDown] -> do let scrollamt = if btn==BScrollUp then -1 else 1 list' <- nestEventM' _asList $ listScrollPushingSelection name (asListSize _asList) scrollamt - put ui{aScreen=scr{_asList=list'}} + put' ui{aScreen=scr{_asList=list'}} -- if page down or end leads to a blank padding item, stop at last non-blank VtyEvent e@(EvKey k []) | k `elem` [KPageDown, KEnd] -> do @@ -361,20 +362,20 @@ asHandle ev = do then do let list' = listMoveTo lastnonblankidx list scrollSelectionToMiddle list' - put ui{aScreen=scr{_asList=list'}} + put' ui{aScreen=scr{_asList=list'}} else - put ui{aScreen=scr{_asList=list}} + put' ui{aScreen=scr{_asList=list}} -- fall through to the list's event handler (handles up/down) VtyEvent ev -> do list' <- nestEventM' _asList $ handleListEvent (normaliseMovementKeys ev) - put $ ui{aScreen=scr & asList .~ list' & asSelectedAccount .~ selacct } + put' $ ui{aScreen=scr & asList .~ list' & asSelectedAccount .~ selacct } MouseDown{} -> put ui MouseUp{} -> put ui AppEvent _ -> put ui - _ -> errorWrongScreenType + _ -> dlogUiTraceM "asHandle 2" >> errorWrongScreenType "event handler" asEnterRegister d selacct ui = do rsCenterAndContinue $ @@ -393,7 +394,7 @@ isBlankElement mel = ((asItemAccountName . snd) <$> mel) == Just "" asCenterAndContinue :: EventM Name UIState () asCenterAndContinue = do - ui <- get + ui <- get' scrollSelectionToMiddle (_asList $ aScreen ui) asListSize = V.length . V.takeWhile ((/="").asItemAccountName) . listElements diff --git a/hledger-ui/Hledger/UI/ErrorScreen.hs b/hledger-ui/Hledger/UI/ErrorScreen.hs index 2b5b5e68c..5aad8acdf 100644 --- a/hledger-ui/Hledger/UI/ErrorScreen.hs +++ b/hledger-ui/Hledger/UI/ErrorScreen.hs @@ -114,7 +114,7 @@ esHandle ev = do VtyEvent (EvKey (KChar 'z') [MCtrl]) -> suspend ui _ -> return () - _ -> errorWrongScreenType + _ -> errorWrongScreenType "event handler" -- | 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 diff --git a/hledger-ui/Hledger/UI/Main.hs b/hledger-ui/Hledger/UI/Main.hs index 35bf8b558..fa1c6bf91 100644 --- a/hledger-ui/Hledger/UI/Main.hs +++ b/hledger-ui/Hledger/UI/Main.hs @@ -35,6 +35,7 @@ import Hledger.UI.UITypes import Hledger.UI.Theme import Hledger.UI.AccountsScreen import Hledger.UI.RegisterScreen +import Hledger.UI.UIUtils (dlogUiTrace) ---------------------------------------------------------------------- @@ -62,7 +63,8 @@ main = do _ -> withJournalDo copts' (runBrickUi opts) 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 = + dlogUiTrace "========= runBrickUi" $ do let today = copts^.rsDay diff --git a/hledger-ui/Hledger/UI/RegisterScreen.hs b/hledger-ui/Hledger/UI/RegisterScreen.hs index 6e6241802..85de9ff23 100644 --- a/hledger-ui/Hledger/UI/RegisterScreen.hs +++ b/hledger-ui/Hledger/UI/RegisterScreen.hs @@ -10,7 +10,7 @@ module Hledger.UI.RegisterScreen (registerScreen ,rsHandle ,rsSetAccount - ,rsCenterAndContinue + ,rsCenterSelection ) where @@ -59,6 +59,7 @@ rsSetAccount _ _ scr = scr rsInit :: Day -> Bool -> UIState -> UIState rsInit d reset ui@UIState{aopts=_uopts@UIOpts{uoCliOpts=copts@CliOpts{reportspec_=rspec@ReportSpec{_rsReportOpts=ropts}}}, ajournal=j, aScreen=s@RegisterScreen{..}} = + dlogUiTrace "rsInit 1" $ ui{aScreen=s{rsList=newitems'}} where -- gather arguments and queries @@ -101,7 +102,7 @@ rsInit d reset ui@UIState{aopts=_uopts@UIOpts{uoCliOpts=copts@CliOpts{reportspec where showamt = showMixedAmountB oneLine{displayMaxWidth=Just 32} -- 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 100 -- "100 ought to be enough for anyone" + blankitems = replicate uiNumBlankItems RegisterScreenItem{rsItemDate = "" ,rsItemStatus = Unmarked ,rsItemDescription = "" @@ -136,13 +137,13 @@ rsInit d reset ui@UIState{aopts=_uopts@UIOpts{uoCliOpts=copts@CliOpts{reportspec ts = map rsItemTransaction displayitems endidx = max 0 $ length displayitems - 1 -rsInit _ _ _ = error "init function called with wrong screen type, should not happen" -- PARTIAL: +rsInit _ _ _ = dlogUiTrace "rsInit 2" $ errorWrongScreenType "init function" -- PARTIAL: rsDraw :: UIState -> [Widget Name] rsDraw UIState{aopts=_uopts@UIOpts{uoCliOpts=copts@CliOpts{reportspec_=rspec}} ,aScreen=RegisterScreen{..} ,aMode=mode - } = + } = dlogUiTrace "rsDraw 1" $ case mode of Help -> [helpDialog copts, maincontent] -- Minibuffer e -> [minibuffer e, maincontent] @@ -250,7 +251,7 @@ rsDraw UIState{aopts=_uopts@UIOpts{uoCliOpts=copts@CliOpts{reportspec_=rspec}} -- ,("q", "quit") ] -rsDraw _ = error "draw function called with wrong screen type, should not happen" -- PARTIAL: +rsDraw _ = dlogUiTrace "rsDraw 2" $ errorWrongScreenType "draw function" -- PARTIAL: rsDrawItem :: (Int,Int,Int,Int,Int) -> Bool -> RegisterScreenItem -> Widget Name rsDrawItem (datewidth,descwidth,acctswidth,changewidth,balwidth) selected RegisterScreenItem{..} = @@ -279,7 +280,8 @@ rsDrawItem (datewidth,descwidth,acctswidth,changewidth,balwidth) selected Regist rsHandle :: BrickEvent Name AppEvent -> EventM Name UIState () rsHandle ev = do - ui0 <- get + ui0 <- get' + dlogUiTraceM "rsHandle 1" case ui0 of ui@UIState{ aScreen=s@RegisterScreen{..} @@ -297,17 +299,17 @@ rsHandle ev = do Minibuffer _ ed -> case ev of VtyEvent (EvKey KEsc []) -> modify closeMinibuffer - VtyEvent (EvKey KEnter []) -> put $ regenerateScreens j d $ + VtyEvent (EvKey KEnter []) -> put' $ regenerateScreens j d $ case setFilter s $ closeMinibuffer ui of Left bad -> showMinibuffer "Cannot compile regular expression" (Just bad) ui Right ui' -> ui' where s = chomp . unlines . map strip $ getEditContents ed - -- VtyEvent (EvKey (KChar '/') []) -> put $ regenerateScreens j d $ showMinibuffer ui + -- VtyEvent (EvKey (KChar '/') []) -> put' $ regenerateScreens j d $ showMinibuffer ui VtyEvent (EvKey (KChar 'l') [MCtrl]) -> redraw VtyEvent (EvKey (KChar 'z') [MCtrl]) -> suspend ui VtyEvent ev -> do ed' <- nestEventM' ed $ handleEditorEvent (VtyEvent ev) - put ui{aMode=Minibuffer "filter" ed'} + put' ui{aMode=Minibuffer "filter" ed'} AppEvent _ -> return () MouseDown{} -> return () MouseUp{} -> return () @@ -322,18 +324,18 @@ rsHandle ev = do Normal -> case ev of VtyEvent (EvKey (KChar 'q') []) -> halt - VtyEvent (EvKey KEsc []) -> put $ resetScreens d ui - VtyEvent (EvKey (KChar c) []) | c == '?' -> put $ setMode Help ui + VtyEvent (EvKey KEsc []) -> put' $ resetScreens d ui + VtyEvent (EvKey (KChar c) []) | c == '?' -> put' $ setMode Help ui AppEvent (DateChange old _) | isStandardPeriod p && p `periodContainsDate` old -> - put $ regenerateScreens j d $ setReportPeriod (DayPeriod d) ui + put' $ regenerateScreens j d $ setReportPeriod (DayPeriod d) ui where p = reportPeriod ui e | e `elem` [VtyEvent (EvKey (KChar 'g') []), AppEvent FileChange] -> - liftIO (uiReloadJournal copts d ui) >>= put - VtyEvent (EvKey (KChar 'I') []) -> put $ uiCheckBalanceAssertions d (toggleIgnoreBalanceAssertions ui) + liftIO (uiReloadJournal copts d ui) >>= put' + VtyEvent (EvKey (KChar 'I') []) -> put' $ uiCheckBalanceAssertions d (toggleIgnoreBalanceAssertions ui) VtyEvent (EvKey (KChar 'a') []) -> suspendAndResume $ clearScreen >> setCursorPosition 0 0 >> add copts j >> uiReloadJournalIfChanged copts d j ui VtyEvent (EvKey (KChar 'A') []) -> suspendAndResume $ void (runIadd (journalFilePath j)) >> uiReloadJournalIfChanged copts d j ui - VtyEvent (EvKey (KChar 'T') []) -> put $ regenerateScreens j d $ setReportPeriod (DayPeriod d) ui + VtyEvent (EvKey (KChar 'T') []) -> put' $ regenerateScreens j d $ setReportPeriod (DayPeriod d) ui VtyEvent (EvKey (KChar 'E') []) -> suspendAndResume $ void (runEditor pos f) >> uiReloadJournalIfChanged copts d j ui where (pos,f) = case listSelectedElement rsList of @@ -342,53 +344,53 @@ rsHandle ev = do rsItemTransaction=Transaction{tsourcepos=(SourcePos f l c,_)}}) -> (Just (unPos l, Just $ unPos c),f) -- display mode/query toggles - VtyEvent (EvKey (KChar 'B') []) -> rsCenterAndContinue $ regenerateScreens j d $ toggleConversionOp ui - VtyEvent (EvKey (KChar 'V') []) -> rsCenterAndContinue $ regenerateScreens j d $ toggleValue ui - VtyEvent (EvKey (KChar 'H') []) -> rsCenterAndContinue $ regenerateScreens j d $ toggleHistorical ui - VtyEvent (EvKey (KChar 't') []) -> rsCenterAndContinue $ regenerateScreens j d $ toggleTree ui - VtyEvent (EvKey (KChar c) []) | c `elem` ['z','Z'] -> rsCenterAndContinue $ regenerateScreens j d $ toggleEmpty ui - VtyEvent (EvKey (KChar 'R') []) -> rsCenterAndContinue $ regenerateScreens j d $ toggleReal ui - VtyEvent (EvKey (KChar 'U') []) -> rsCenterAndContinue $ regenerateScreens j d $ toggleUnmarked ui - VtyEvent (EvKey (KChar 'P') []) -> rsCenterAndContinue $ regenerateScreens j d $ togglePending ui - VtyEvent (EvKey (KChar 'C') []) -> rsCenterAndContinue $ regenerateScreens j d $ toggleCleared ui - VtyEvent (EvKey (KChar 'F') []) -> rsCenterAndContinue $ regenerateScreens j d $ toggleForecast d ui + VtyEvent (EvKey (KChar 'B') []) -> rsCenterSelection $ regenerateScreens j d $ toggleConversionOp ui + VtyEvent (EvKey (KChar 'V') []) -> rsCenterSelection $ regenerateScreens j d $ toggleValue ui + VtyEvent (EvKey (KChar 'H') []) -> rsCenterSelection $ regenerateScreens j d $ toggleHistorical ui + VtyEvent (EvKey (KChar 't') []) -> rsCenterSelection $ regenerateScreens j d $ toggleTree ui + VtyEvent (EvKey (KChar c) []) | c `elem` ['z','Z'] -> rsCenterSelection $ regenerateScreens j d $ toggleEmpty ui + VtyEvent (EvKey (KChar 'R') []) -> rsCenterSelection $ regenerateScreens j d $ toggleReal ui + VtyEvent (EvKey (KChar 'U') []) -> rsCenterSelection $ regenerateScreens j d $ toggleUnmarked ui + VtyEvent (EvKey (KChar 'P') []) -> rsCenterSelection $ regenerateScreens j d $ togglePending ui + VtyEvent (EvKey (KChar 'C') []) -> rsCenterSelection $ regenerateScreens j d $ toggleCleared ui + VtyEvent (EvKey (KChar 'F') []) -> rsCenterSelection $ regenerateScreens j d $ toggleForecast d ui - VtyEvent (EvKey (KChar '/') []) -> put $ regenerateScreens j d $ showMinibuffer "filter" Nothing ui - VtyEvent (EvKey (KDown) [MShift]) -> put $ regenerateScreens j d $ shrinkReportPeriod d ui - VtyEvent (EvKey (KUp) [MShift]) -> put $ regenerateScreens j d $ growReportPeriod d ui - VtyEvent (EvKey (KRight) [MShift]) -> put $ regenerateScreens j d $ nextReportPeriod journalspan ui - VtyEvent (EvKey (KLeft) [MShift]) -> put $ regenerateScreens j d $ previousReportPeriod journalspan ui - VtyEvent (EvKey k []) | k `elem` [KBS, KDel] -> (put $ regenerateScreens j d $ resetFilter ui) + VtyEvent (EvKey (KChar '/') []) -> put' $ regenerateScreens j d $ showMinibuffer "filter" Nothing ui + VtyEvent (EvKey (KDown) [MShift]) -> put' $ regenerateScreens j d $ shrinkReportPeriod d ui + VtyEvent (EvKey (KUp) [MShift]) -> put' $ regenerateScreens j d $ growReportPeriod d ui + VtyEvent (EvKey (KRight) [MShift]) -> put' $ regenerateScreens j d $ nextReportPeriod journalspan ui + VtyEvent (EvKey (KLeft) [MShift]) -> put' $ regenerateScreens j d $ previousReportPeriod journalspan ui + VtyEvent (EvKey k []) | k `elem` [KBS, KDel] -> (put' $ regenerateScreens j d $ resetFilter ui) VtyEvent (EvKey (KChar 'l') [MCtrl]) -> scrollSelectionToMiddle rsList >> redraw VtyEvent (EvKey (KChar 'z') [MCtrl]) -> suspend ui -- exit screen on LEFT - VtyEvent e | e `elem` moveLeftEvents -> put $ popScreen ui + VtyEvent e | e `elem` moveLeftEvents -> put' $ popScreen ui -- or on a click in the app's left margin. This is a VtyEvent since not in a clickable widget. - VtyEvent (EvMouseUp x _y (Just BLeft)) | x==0 -> put $ popScreen ui + VtyEvent (EvMouseUp x _y (Just BLeft)) | x==0 -> put' $ popScreen ui -- or on clicking a blank list item. - MouseUp _ (Just BLeft) Location{loc=(_,y)} | clickeddate == "" -> put $ popScreen ui + MouseUp _ (Just BLeft) Location{loc=(_,y)} | clickeddate == "" -> put' $ popScreen ui where clickeddate = maybe "" rsItemDate $ listElements rsList !? y -- enter transaction screen on RIGHT VtyEvent e | e `elem` moveRightEvents -> case listSelectedElement rsList of - Just _ -> put $ screenEnter d transactionScreen{tsAccount=rsAccount} ui - Nothing -> put ui + Just _ -> put' $ screenEnter d transactionScreen{tsAccount=rsAccount} ui + Nothing -> put' ui -- or on transaction click -- MouseDown is sometimes duplicated, https://github.com/jtdaugherty/brick/issues/347 -- just use it to move the selection MouseDown _n BLeft _mods Location{loc=(_x,y)} | not $ (=="") clickeddate -> do - put $ ui{aScreen=s{rsList=listMoveTo y rsList}} + put' $ ui{aScreen=s{rsList=listMoveTo y rsList}} where clickeddate = maybe "" rsItemDate $ listElements rsList !? y -- and on MouseUp, enter the subscreen MouseUp _n (Just BLeft) Location{loc=(_x,y)} | not $ (=="") clickeddate -> do - put $ screenEnter d transactionScreen{tsAccount=rsAccount} ui + put' $ screenEnter d transactionScreen{tsAccount=rsAccount} ui where clickeddate = maybe "" rsItemDate $ listElements rsList !? y -- when selection is at the last item, DOWN scrolls instead of moving, until maximally scrolled VtyEvent e | e `elem` moveDownEvents, isBlankElement mnextelement -> do - vScrollBy (viewportScroll $ rsList ^. listNameL) 1 >> put ui + vScrollBy (viewportScroll $ rsList ^. listNameL) 1 >> put' ui where mnextelement = listSelectedElement $ listMoveDown rsList -- mouse scroll wheel scrolls the viewport up or down to its maximum extent, @@ -396,7 +398,7 @@ rsHandle ev = do MouseDown name btn _mods _loc | btn `elem` [BScrollUp, BScrollDown] -> do let scrollamt = if btn==BScrollUp then -1 else 1 list' <- nestEventM' rsList $ listScrollPushingSelection name (rsListSize rsList) scrollamt - put ui{aScreen=s{rsList=list'}} + put' ui{aScreen=s{rsList=list'}} -- if page down or end leads to a blank padding item, stop at last non-blank VtyEvent e@(EvKey k []) | k `elem` [KPageDown, KEnd] -> do @@ -405,21 +407,21 @@ rsHandle ev = do then do let list' = listMoveTo lastnonblankidx list scrollSelectionToMiddle list' - put ui{aScreen=s{rsList=list'}} + put' ui{aScreen=s{rsList=list'}} else - put ui{aScreen=s{rsList=list}} + put' ui{aScreen=s{rsList=list}} -- fall through to the list's event handler (handles other [pg]up/down events) VtyEvent ev -> do let ev' = normaliseMovementKeys ev newitems <- nestEventM' rsList $ handleListEvent ev' - put ui{aScreen=s{rsList=newitems}} + put' ui{aScreen=s{rsList=newitems}} - MouseDown{} -> put ui - MouseUp{} -> put ui - AppEvent _ -> put ui + MouseDown{} -> put' ui + MouseUp{} -> put' ui + AppEvent _ -> put' ui - _ -> errorWrongScreenType + _ -> dlogUiTrace "rsHandle 2" $ errorWrongScreenType "event handler" isBlankElement mel = ((rsItemDate . snd) <$> mel) == Just "" diff --git a/hledger-ui/Hledger/UI/TransactionScreen.hs b/hledger-ui/Hledger/UI/TransactionScreen.hs index da4b903b0..997fac524 100644 --- a/hledger-ui/Hledger/UI/TransactionScreen.hs +++ b/hledger-ui/Hledger/UI/TransactionScreen.hs @@ -59,7 +59,7 @@ tsInit _d _reset ui@UIState{aopts=UIOpts{} seltxn = maybe nulltransaction (rsItemTransaction . snd) $ listSelectedElement xs nonblanks = V.toList . V.takeWhile (not . T.null . rsItemDate) $ xs ^. listElementsL _ -> (t, nts) -tsInit _ _ _ = error "init function called with wrong screen type, should not happen" -- PARTIAL: +tsInit _ _ _ = errorWrongScreenType "init function" -- PARTIAL: -- Render a transaction suitably for the transaction screen. showTxn :: ReportOpts -> ReportSpec -> Journal -> Transaction -> T.Text @@ -139,11 +139,11 @@ tsDraw UIState{aopts=UIOpts{uoCliOpts=copts@CliOpts{reportspec_=rspec@ReportSpec ,("q", "quit") ] -tsDraw _ = error "draw function called with wrong screen type, should not happen" -- PARTIAL: +tsDraw _ = errorWrongScreenType "draw function" -- PARTIAL: tsHandle :: BrickEvent Name AppEvent -> EventM Name UIState () tsHandle ev = do - ui0 <- get + ui0 <- get' case ui0 of ui@UIState{aScreen=TransactionScreen{tsTransaction=(i,t), tsTransactions=nts} ,aopts=UIOpts{uoCliOpts=copts@CliOpts{reportspec_=rspec@ReportSpec{_rsReportOpts=ropts}}} @@ -165,48 +165,48 @@ tsHandle ev = do (inext,tnext) = maybe (i,t) ((i+1),) $ lookup (i+1) nts case ev of VtyEvent (EvKey (KChar 'q') []) -> halt - VtyEvent (EvKey KEsc []) -> put $ resetScreens d ui - VtyEvent (EvKey (KChar c) []) | c == '?' -> put $ setMode Help ui + VtyEvent (EvKey KEsc []) -> put' $ resetScreens d ui + VtyEvent (EvKey (KChar c) []) | c == '?' -> put' $ setMode Help ui VtyEvent (EvKey (KChar 'E') []) -> suspendAndResume $ void (runEditor pos f) >> uiReloadJournalIfChanged copts d j ui 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 + put' $ regenerateScreens j d $ setReportPeriod (DayPeriod d) ui where p = reportPeriod ui e | e `elem` [VtyEvent (EvKey (KChar 'g') []), AppEvent FileChange] -> do -- plog (if e == AppEvent FileChange then "file change" else "manual reload") "" `seq` return () ej <- liftIO . runExceptT $ journalReload copts case ej of - Left err -> put $ screenEnter d errorScreen{esError=err} ui - Right j' -> put $ regenerateScreens j' d ui - VtyEvent (EvKey (KChar 'I') []) -> put $ uiCheckBalanceAssertions d (toggleIgnoreBalanceAssertions ui) + Left err -> put' $ screenEnter d errorScreen{esError=err} ui + Right j' -> put' $ regenerateScreens j' d ui + VtyEvent (EvKey (KChar 'I') []) -> put' $ uiCheckBalanceAssertions d (toggleIgnoreBalanceAssertions ui) -- for toggles that may change the current/prev/next transactions, -- we must regenerate the transaction list, like the g handler above ? with regenerateTransactions ? TODO WIP - -- EvKey (KChar 'E') [] -> put $ regenerateScreens j d $ stToggleEmpty ui - -- EvKey (KChar 'C') [] -> put $ regenerateScreens j d $ stToggleCleared ui - -- EvKey (KChar 'R') [] -> put $ regenerateScreens j d $ stToggleReal ui - VtyEvent (EvKey (KChar 'B') []) -> put . regenerateScreens j d $ toggleConversionOp ui - VtyEvent (EvKey (KChar 'V') []) -> put . regenerateScreens j d $ toggleValue ui + -- EvKey (KChar 'E') [] -> put' $ regenerateScreens j d $ stToggleEmpty ui + -- EvKey (KChar 'C') [] -> put' $ regenerateScreens j d $ stToggleCleared ui + -- EvKey (KChar 'R') [] -> put' $ regenerateScreens j d $ stToggleReal ui + VtyEvent (EvKey (KChar 'B') []) -> put' . regenerateScreens j d $ toggleConversionOp ui + VtyEvent (EvKey (KChar 'V') []) -> put' . regenerateScreens j d $ toggleValue ui - VtyEvent e | e `elem` moveUpEvents -> put $ tsSelect iprev tprev ui - VtyEvent e | e `elem` moveDownEvents -> put $ tsSelect inext tnext ui + VtyEvent e | e `elem` moveUpEvents -> put' $ tsSelect iprev tprev ui + VtyEvent e | e `elem` moveDownEvents -> put' $ tsSelect inext tnext ui -- exit screen on LEFT - VtyEvent e | e `elem` moveLeftEvents -> put . popScreen $ tsSelect i t ui -- Probably not necessary to tsSelect here, but it's safe. + VtyEvent e | e `elem` moveLeftEvents -> put' . popScreen $ tsSelect i t ui -- Probably not necessary to tsSelect here, but it's safe. -- or on a click in the app's left margin. - VtyEvent (EvMouseUp x _y (Just BLeft)) | x==0 -> put . popScreen $ tsSelect i t ui + VtyEvent (EvMouseUp x _y (Just BLeft)) | x==0 -> put' . popScreen $ tsSelect i t ui -- or on clicking the blank area below the transaction. - MouseUp _ (Just BLeft) Location{loc=(_,y)} | y+1 > numentrylines -> put . popScreen $ tsSelect i t ui + MouseUp _ (Just BLeft) Location{loc=(_,y)} | y+1 > numentrylines -> put' . popScreen $ tsSelect i t ui where numentrylines = length (T.lines $ showTxn ropts rspec j t) - 1 VtyEvent (EvKey (KChar 'l') [MCtrl]) -> redraw VtyEvent (EvKey (KChar 'z') [MCtrl]) -> suspend ui _ -> return () - _ -> errorWrongScreenType + _ -> errorWrongScreenType "event handler" -- | Select a new transaction and update the previous register screen tsSelect i t ui@UIState{aScreen=s@TransactionScreen{}} = case aPrevScreens ui of diff --git a/hledger-ui/Hledger/UI/UITypes.hs b/hledger-ui/Hledger/UI/UITypes.hs index 185c43617..8af7dcb9e 100644 --- a/hledger-ui/Hledger/UI/UITypes.hs +++ b/hledger-ui/Hledger/UI/UITypes.hs @@ -39,6 +39,8 @@ Brick.defaultMain brickapp st module Hledger.UI.UITypes where +-- import Control.Concurrent (threadDelay) +-- import GHC.IO (unsafePerformIO) import Data.Text (Text) import Data.Time.Calendar (Day) import Brick @@ -137,7 +139,10 @@ data Screen = -- XXX check for ideas: https://github.com/jtdaugherty/brick/issues/379#issuecomment-1191993357 -- | Error message to use in case statements adapting to the different Screen shapes. -errorWrongScreenType = error' "handler called with wrong screen type, should not happen" +errorWrongScreenType :: String -> a +errorWrongScreenType lbl = + -- unsafePerformIO $ threadDelay 2000000 >> -- delay to allow console output to be seen + error' (unwords [lbl, "called with wrong screen type, should not happen"]) -- | An item in the accounts screen's list of accounts and balances. data AccountsScreenItem = AccountsScreenItem { diff --git a/hledger-ui/Hledger/UI/UIUtils.hs b/hledger-ui/Hledger/UI/UIUtils.hs index 8ce7b1796..8d9e07366 100644 --- a/hledger-ui/Hledger/UI/UIUtils.hs +++ b/hledger-ui/Hledger/UI/UIUtils.hs @@ -23,10 +23,17 @@ module Hledger.UI.UIUtils ( ,renderToggle1 ,replaceHiddenAccountsNameWith ,scrollSelectionToMiddle + ,get' + ,put' + ,modify' ,suspend ,redraw ,reportSpecSetFutureAndForecast ,listScrollPushingSelection + ,dlogUiTrace + ,dlogUiTraceM + ,uiDebugLevel + ,uiNumBlankItems ) where @@ -65,6 +72,23 @@ suspendSignal :: IO () suspendSignal = raiseSignal sigSTOP #endif +-- Debug logging for UI state changes. + +get' = do + x <- get + dlogUiTraceM $ "getting state: " ++ (head $ lines $ pshow $ aScreen x) + return x + +put' x = do + dlogUiTraceM $ "putting state: " ++ (head $ lines $ pshow $ aScreen x) + put x + +modify' f = do + x <- get + let x' = f x + dlogUiTraceM $ "modifying state: " ++ (head $ lines $ pshow $ aScreen x') + modify f + -- | On posix platforms, suspend the program using the STOP signal, -- like control-z in bash, returning to the original shell prompt, -- and when resumed, continue where we left off. @@ -170,7 +194,7 @@ helpHandle ev = do ui <- get let ui' = setMode Normal ui case ev of - VtyEvent e | e `elem` closeHelpEvents -> put ui' + VtyEvent e | e `elem` closeHelpEvents -> put' ui' VtyEvent (EvKey (KChar 'p') []) -> suspendAndResume $ runPagerForTopic "hledger-ui" Nothing >> return ui' VtyEvent (EvKey (KChar 'm') []) -> suspendAndResume $ runManForTopic "hledger-ui" Nothing >> return ui' VtyEvent (EvKey (KChar 'i') []) -> suspendAndResume $ runInfoForTopic "hledger-ui" Nothing >> return ui' @@ -383,3 +407,24 @@ listScrollPushingSelection name listheight scrollamt = do | otherwise = id _ -> return list _ -> return list + +-- | Log a string to ./debug.log before returning the second argument, +-- if the global debug level is at or above a standard hledger-ui debug level. +-- Uses unsafePerformIO. +dlogUiTrace :: String -> a -> a +dlogUiTrace = dlogTraceAt uiDebugLevel + +-- | Like dlogUiTrace, but within the hledger-ui brick event handler monad. +dlogUiTraceM :: String -> EventM Name UIState () +dlogUiTraceM s = dlogUiTrace s $ return () + +-- | Log hledger-ui events at this debug level. +uiDebugLevel :: Int +uiDebugLevel = 2 + +-- | How many blank items to add to lists to fill the full window height. +uiNumBlankItems :: Int +uiNumBlankItems + -- | debugLevel >= uiDebugLevel = 0 -- suppress to improve debug output. + -- | otherwise + = 100 -- 100 ought to be enough for anyone