From f5efb2e08ec2efddb2aa63538bac35553d67c8f5 Mon Sep 17 00:00:00 2001 From: Simon Michael Date: Tue, 23 Aug 2022 01:54:16 +0100 Subject: [PATCH] fix: ui: cleanups, fix more state & logging bugs (#1889) --- hledger-ui/Hledger/UI/AccountsScreen.hs | 25 +++++++------- hledger-ui/Hledger/UI/ErrorScreen.hs | 10 +++--- hledger-ui/Hledger/UI/RegisterScreen.hs | 38 ++++++++++++---------- hledger-ui/Hledger/UI/TransactionScreen.hs | 2 +- hledger-ui/Hledger/UI/UIUtils.hs | 6 ++-- 5 files changed, 41 insertions(+), 40 deletions(-) diff --git a/hledger-ui/Hledger/UI/AccountsScreen.hs b/hledger-ui/Hledger/UI/AccountsScreen.hs index acebfda5d..ba85f6720 100644 --- a/hledger-ui/Hledger/UI/AccountsScreen.hs +++ b/hledger-ui/Hledger/UI/AccountsScreen.hs @@ -271,7 +271,7 @@ asHandle ev = do -- VtyEvent (EvKey (KChar 'q') []) -> halt VtyEvent (EvKey (KChar 'l') [MCtrl]) -> redraw VtyEvent (EvKey (KChar 'z') [MCtrl]) -> suspend ui - _ -> helpHandle ev + _ -> helpHandle ev Normal -> case ev of @@ -309,14 +309,14 @@ asHandle ev = do 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 - VtyEvent (EvKey (KChar 't') []) -> modify (regenerateScreens j d . toggleTree) >> asCenterAndContinue - VtyEvent (EvKey (KChar c) []) | c `elem` ['z','Z'] -> modify (regenerateScreens j d . toggleEmpty) >> asCenterAndContinue - VtyEvent (EvKey (KChar 'R') []) -> modify (regenerateScreens j d . toggleReal) >> asCenterAndContinue - VtyEvent (EvKey (KChar 'U') []) -> modify (regenerateScreens j d . toggleUnmarked) >> asCenterAndContinue - VtyEvent (EvKey (KChar 'P') []) -> modify (regenerateScreens j d . togglePending) >> asCenterAndContinue - VtyEvent (EvKey (KChar 'C') []) -> modify (regenerateScreens j d . toggleCleared) >> asCenterAndContinue - VtyEvent (EvKey (KChar 'F') []) -> modify (regenerateScreens j d . toggleForecast d) + VtyEvent (EvKey (KChar 'H') []) -> modify' (regenerateScreens j d . toggleHistorical) >> asCenterAndContinue + VtyEvent (EvKey (KChar 't') []) -> modify' (regenerateScreens j d . toggleTree) >> asCenterAndContinue + VtyEvent (EvKey (KChar c) []) | c `elem` ['z','Z'] -> modify' (regenerateScreens j d . toggleEmpty) >> asCenterAndContinue + VtyEvent (EvKey (KChar 'R') []) -> modify' (regenerateScreens j d . toggleReal) >> asCenterAndContinue + VtyEvent (EvKey (KChar 'U') []) -> modify' (regenerateScreens j d . toggleUnmarked) >> asCenterAndContinue + VtyEvent (EvKey (KChar 'P') []) -> modify' (regenerateScreens j d . togglePending) >> asCenterAndContinue + 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 @@ -369,7 +369,7 @@ asHandle ev = do -- 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{} -> return () MouseUp{} -> return () @@ -386,9 +386,7 @@ asEnterRegister d selacct ui = do isdepthclipped = case getDepth ui of Just d -> accountNameLevel selacct >= d Nothing -> False - let ui' = screenEnter d regscr ui - put' ui' - rsCenterSelection ui' + rsCenterSelection (screenEnter d regscr ui) >>= put' asSetSelectedAccount a s@AccountsScreen{} = s & asSelectedAccount .~ a asSetSelectedAccount _ s = s @@ -401,3 +399,4 @@ asCenterAndContinue = do 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 5aad8acdf..620cfea8c 100644 --- a/hledger-ui/Hledger/UI/ErrorScreen.hs +++ b/hledger-ui/Hledger/UI/ErrorScreen.hs @@ -77,7 +77,7 @@ esDraw _ = error "draw function called with wrong screen type, should not happen esHandle :: BrickEvent Name AppEvent -> EventM Name UIState () esHandle ev = do - ui0 <- get + ui0 <- get' case ui0 of ui@UIState{aScreen=ErrorScreen{..} ,aopts=UIOpts{uoCliOpts=copts} @@ -96,20 +96,20 @@ esHandle ev = do let d = copts^.rsDay case ev of 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 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) >> uiReloadJournalIfChanged copts d j (popScreen ui) where (pos,f) = case parsewithString hledgerparseerrorpositionp esError of Right (f,l,c) -> (Just (l, Just c),f) Left _ -> (endPosition, journalFilePath j) e | e `elem` [VtyEvent (EvKey (KChar 'g') []), AppEvent FileChange] -> - liftIO (uiReloadJournal copts d (popScreen ui)) >>= put . uiCheckBalanceAssertions d + liftIO (uiReloadJournal 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 - VtyEvent (EvKey (KChar 'I') []) -> put $ uiCheckBalanceAssertions d (popScreen $ toggleIgnoreBalanceAssertions ui) + VtyEvent (EvKey (KChar 'I') []) -> put' $ uiCheckBalanceAssertions d (popScreen $ toggleIgnoreBalanceAssertions ui) VtyEvent (EvKey (KChar 'l') [MCtrl]) -> redraw VtyEvent (EvKey (KChar 'z') [MCtrl]) -> suspend ui _ -> return () diff --git a/hledger-ui/Hledger/UI/RegisterScreen.hs b/hledger-ui/Hledger/UI/RegisterScreen.hs index 2be4a9567..a4b057147 100644 --- a/hledger-ui/Hledger/UI/RegisterScreen.hs +++ b/hledger-ui/Hledger/UI/RegisterScreen.hs @@ -298,7 +298,7 @@ rsHandle ev = do case mode of Minibuffer _ ed -> case ev of - VtyEvent (EvKey KEsc []) -> modify closeMinibuffer + VtyEvent (EvKey KEsc []) -> modify' closeMinibuffer VtyEvent (EvKey KEnter []) -> put' $ regenerateScreens j d $ case setFilter s $ closeMinibuffer ui of Left bad -> showMinibuffer "Cannot compile regular expression" (Just bad) ui @@ -319,7 +319,7 @@ rsHandle ev = do -- VtyEvent (EvKey (KChar 'q') []) -> halt VtyEvent (EvKey (KChar 'l') [MCtrl]) -> redraw VtyEvent (EvKey (KChar 'z') [MCtrl]) -> suspend ui - _ -> helpHandle ev + _ -> helpHandle ev Normal -> case ev of @@ -344,16 +344,16 @@ 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') []) -> 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 'B') []) -> rsCenterSelection (regenerateScreens j d $ toggleConversionOp ui) >>= put' + VtyEvent (EvKey (KChar 'V') []) -> rsCenterSelection (regenerateScreens j d $ toggleValue ui) >>= put' + VtyEvent (EvKey (KChar 'H') []) -> rsCenterSelection (regenerateScreens j d $ toggleHistorical ui) >>= put' + VtyEvent (EvKey (KChar 't') []) -> rsCenterSelection (regenerateScreens j d $ toggleTree ui) >>= put' + VtyEvent (EvKey (KChar c) []) | c `elem` ['z','Z'] -> rsCenterSelection (regenerateScreens j d $ toggleEmpty ui) >>= put' + VtyEvent (EvKey (KChar 'R') []) -> rsCenterSelection (regenerateScreens j d $ toggleReal ui) >>= put' + VtyEvent (EvKey (KChar 'U') []) -> rsCenterSelection (regenerateScreens j d $ toggleUnmarked ui) >>= put' + VtyEvent (EvKey (KChar 'P') []) -> rsCenterSelection (regenerateScreens j d $ togglePending ui) >>= put' + VtyEvent (EvKey (KChar 'C') []) -> rsCenterSelection (regenerateScreens j d $ toggleCleared ui) >>= put' + VtyEvent (EvKey (KChar 'F') []) -> rsCenterSelection (regenerateScreens j d $ toggleForecast d ui) >>= put' VtyEvent (EvKey (KChar '/') []) -> put' $ regenerateScreens j d $ showMinibuffer "filter" Nothing ui VtyEvent (EvKey (KDown) [MShift]) -> put' $ regenerateScreens j d $ shrinkReportPeriod d ui @@ -390,7 +390,7 @@ rsHandle ev = do -- 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 where mnextelement = listSelectedElement $ listMoveDown rsList -- mouse scroll wheel scrolls the viewport up or down to its maximum extent, @@ -417,15 +417,17 @@ rsHandle ev = do newitems <- nestEventM' rsList $ handleListEvent ev' put' ui{aScreen=s{rsList=newitems}} - MouseDown{} -> put' ui - MouseUp{} -> put' ui - AppEvent _ -> put' ui + MouseDown{} -> return () + MouseUp{} -> return () + AppEvent _ -> return () _ -> dlogUiTrace "rsHandle 2" $ errorWrongScreenType "event handler" isBlankElement mel = ((rsItemDate . snd) <$> mel) == Just "" -rsCenterSelection :: UIState -> EventM Name UIState () -rsCenterSelection = scrollSelectionToMiddle . rsList . aScreen +rsCenterSelection :: UIState -> EventM Name UIState UIState +rsCenterSelection ui = do + scrollSelectionToMiddle $ rsList $ aScreen ui + return ui -- ui is unchanged, but this makes the function more chainable rsListSize = V.length . V.takeWhile ((/="").rsItemDate) . listElements diff --git a/hledger-ui/Hledger/UI/TransactionScreen.hs b/hledger-ui/Hledger/UI/TransactionScreen.hs index 997fac524..1ccba5d79 100644 --- a/hledger-ui/Hledger/UI/TransactionScreen.hs +++ b/hledger-ui/Hledger/UI/TransactionScreen.hs @@ -156,7 +156,7 @@ tsHandle ev = do -- VtyEvent (EvKey (KChar 'q') []) -> halt VtyEvent (EvKey (KChar 'l') [MCtrl]) -> redraw VtyEvent (EvKey (KChar 'z') [MCtrl]) -> suspend ui - _ -> helpHandle ev + _ -> helpHandle ev _ -> do let diff --git a/hledger-ui/Hledger/UI/UIUtils.hs b/hledger-ui/Hledger/UI/UIUtils.hs index 8d9e07366..b908b95f4 100644 --- a/hledger-ui/Hledger/UI/UIUtils.hs +++ b/hledger-ui/Hledger/UI/UIUtils.hs @@ -195,9 +195,9 @@ helpHandle ev = do let ui' = setMode Normal ui case ev of 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' + 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') _ -> return () where closeHelpEvents = moveLeftEvents ++ [EvKey KEsc [], EvKey (KChar '?') [], EvKey (KChar 'q') []]