slaesvuo/hledger
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

fix: ui: cleanups, fix more state & logging bugs (#1889)

Browse Source
This commit is contained in:
Simon Michael 2022-08-23 01:54:16 +01:00
parent b6353804b8
commit f5efb2e08e
5 changed files with 41 additions and 40 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
hledger-ui/Hledger/UI/AccountsScreen.hs
View File

@ -309,14 +309,14 @@ asHandle ev = do
VtyEvent (EvKey (KChar 'T') []) -> put' $ regenerateScreens j d $ setReportPeriod (DayPeriod d) ui VtyEvent (EvKey (KChar 'T') []) -> put' $ regenerateScreens j d $ setReportPeriod (DayPeriod d) ui
-- display mode/query toggles -- display mode/query toggles
VtyEvent (EvKey (KChar 'H') []) -> modify (regenerateScreens j d . toggleHistorical) >> asCenterAndContinue VtyEvent (EvKey (KChar 'H') []) -> modify' (regenerateScreens j d . toggleHistorical) >> asCenterAndContinue
VtyEvent (EvKey (KChar 't') []) -> modify (regenerateScreens j d . toggleTree) >> 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 c) []) | c `elem` ['z','Z'] -> modify' (regenerateScreens j d . toggleEmpty) >> asCenterAndContinue
VtyEvent (EvKey (KChar 'R') []) -> modify (regenerateScreens j d . toggleReal) >> asCenterAndContinue VtyEvent (EvKey (KChar 'R') []) -> modify' (regenerateScreens j d . toggleReal) >> asCenterAndContinue
VtyEvent (EvKey (KChar 'U') []) -> modify (regenerateScreens j d . toggleUnmarked) >> asCenterAndContinue VtyEvent (EvKey (KChar 'U') []) -> modify' (regenerateScreens j d . toggleUnmarked) >> asCenterAndContinue
VtyEvent (EvKey (KChar 'P') []) -> modify (regenerateScreens j d . togglePending) >> asCenterAndContinue VtyEvent (EvKey (KChar 'P') []) -> modify' (regenerateScreens j d . togglePending) >> asCenterAndContinue
VtyEvent (EvKey (KChar 'C') []) -> modify (regenerateScreens j d . toggleCleared) >> asCenterAndContinue VtyEvent (EvKey (KChar 'C') []) -> modify' (regenerateScreens j d . toggleCleared) >> asCenterAndContinue
VtyEvent (EvKey (KChar 'F') []) -> modify (regenerateScreens j d . toggleForecast d) VtyEvent (EvKey (KChar 'F') []) -> modify' (regenerateScreens j d . toggleForecast d)
VtyEvent (EvKey (KDown) [MShift]) -> put' $ regenerateScreens j d $ shrinkReportPeriod d 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 (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) -- fall through to the list's event handler (handles up/down)
VtyEvent ev -> do VtyEvent ev -> do
list' <- nestEventM' _asList $ handleListEvent (normaliseMovementKeys ev) list' <- nestEventM' _asList $ handleListEvent (normaliseMovementKeys ev)
put' $ ui{aScreen=scr & asList .~ list' & asSelectedAccount .~ selacct } put' ui{aScreen=scr & asList .~ list' & asSelectedAccount .~ selacct }
MouseDown{} -> return () MouseDown{} -> return ()
MouseUp{} -> return () MouseUp{} -> return ()
@ -386,9 +386,7 @@ asEnterRegister d selacct ui = do
isdepthclipped = case getDepth ui of isdepthclipped = case getDepth ui of
Just d -> accountNameLevel selacct >= d Just d -> accountNameLevel selacct >= d
Nothing -> False Nothing -> False
let ui' = screenEnter d regscr ui rsCenterSelection (screenEnter d regscr ui) >>= put'
put' ui'
rsCenterSelection ui'
asSetSelectedAccount a s@AccountsScreen{} = s & asSelectedAccount .~ a asSetSelectedAccount a s@AccountsScreen{} = s & asSelectedAccount .~ a
asSetSelectedAccount _ s = s asSetSelectedAccount _ s = s
@ -401,3 +399,4 @@ asCenterAndContinue = do
scrollSelectionToMiddle (_asList $ aScreen ui) scrollSelectionToMiddle (_asList $ aScreen ui)
asListSize = V.length . V.takeWhile ((/="").asItemAccountName) . listElements asListSize = V.length . V.takeWhile ((/="").asItemAccountName) . listElements

10
hledger-ui/Hledger/UI/ErrorScreen.hs
View File

@ -77,7 +77,7 @@ esDraw _ = error "draw function called with wrong screen type, should not happen
esHandle :: BrickEvent Name AppEvent -> EventM Name UIState () esHandle :: BrickEvent Name AppEvent -> EventM Name UIState ()
esHandle ev = do esHandle ev = do
ui0 <- get ui0 <- get'
case ui0 of case ui0 of
ui@UIState{aScreen=ErrorScreen{..} ui@UIState{aScreen=ErrorScreen{..}
,aopts=UIOpts{uoCliOpts=copts} ,aopts=UIOpts{uoCliOpts=copts}
@ -96,20 +96,20 @@ esHandle ev = do
let d = copts^.rsDay let d = copts^.rsDay
case ev of case ev of
VtyEvent (EvKey (KChar 'q') []) -> halt VtyEvent (EvKey (KChar 'q') []) -> halt
VtyEvent (EvKey KEsc []) -> put $ uiCheckBalanceAssertions d $ resetScreens d ui VtyEvent (EvKey KEsc []) -> put' $ uiCheckBalanceAssertions d $ resetScreens d ui
VtyEvent (EvKey (KChar c) []) | c `elem` ['h','?'] -> put $ setMode Help 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) VtyEvent (EvKey (KChar 'E') []) -> suspendAndResume $ void (runEditor pos f) >> uiReloadJournalIfChanged copts d j (popScreen ui)
where where
(pos,f) = case parsewithString hledgerparseerrorpositionp esError of (pos,f) = case parsewithString hledgerparseerrorpositionp esError of
Right (f,l,c) -> (Just (l, Just c),f) Right (f,l,c) -> (Just (l, Just c),f)
Left _ -> (endPosition, journalFilePath j) Left _ -> (endPosition, journalFilePath j)
e | e `elem` [VtyEvent (EvKey (KChar 'g') []), AppEvent FileChange] -> 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 -- (ej, _) <- liftIO $ journalReloadIfChanged copts d j
-- case ej of -- case ej of
-- Left err -> continue ui{aScreen=s{esError=err}} -- show latest parse error -- 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 -- 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 'l') [MCtrl]) -> redraw
VtyEvent (EvKey (KChar 'z') [MCtrl]) -> suspend ui VtyEvent (EvKey (KChar 'z') [MCtrl]) -> suspend ui
_ -> return () _ -> return ()

36
hledger-ui/Hledger/UI/RegisterScreen.hs
View File

@ -298,7 +298,7 @@ rsHandle ev = do
case mode of case mode of
Minibuffer _ ed -> Minibuffer _ ed ->
case ev of case ev of
VtyEvent (EvKey KEsc []) -> modify closeMinibuffer 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 case setFilter s $ closeMinibuffer ui of
Left bad -> showMinibuffer "Cannot compile regular expression" (Just bad) ui Left bad -> showMinibuffer "Cannot compile regular expression" (Just bad) ui
@ -344,16 +344,16 @@ rsHandle ev = do
rsItemTransaction=Transaction{tsourcepos=(SourcePos f l c,_)}}) -> (Just (unPos l, Just $ unPos c),f) rsItemTransaction=Transaction{tsourcepos=(SourcePos f l c,_)}}) -> (Just (unPos l, Just $ unPos c),f)
-- display mode/query toggles -- display mode/query toggles
VtyEvent (EvKey (KChar 'B') []) -> rsCenterSelection $ regenerateScreens j d $ toggleConversionOp ui VtyEvent (EvKey (KChar 'B') []) -> rsCenterSelection (regenerateScreens j d $ toggleConversionOp ui) >>= put'
VtyEvent (EvKey (KChar 'V') []) -> rsCenterSelection $ regenerateScreens j d $ toggleValue ui VtyEvent (EvKey (KChar 'V') []) -> rsCenterSelection (regenerateScreens j d $ toggleValue ui) >>= put'
VtyEvent (EvKey (KChar 'H') []) -> rsCenterSelection $ regenerateScreens j d $ toggleHistorical ui VtyEvent (EvKey (KChar 'H') []) -> rsCenterSelection (regenerateScreens j d $ toggleHistorical ui) >>= put'
VtyEvent (EvKey (KChar 't') []) -> rsCenterSelection $ regenerateScreens j d $ toggleTree ui 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 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 VtyEvent (EvKey (KChar 'R') []) -> rsCenterSelection (regenerateScreens j d $ toggleReal ui) >>= put'
VtyEvent (EvKey (KChar 'U') []) -> rsCenterSelection $ regenerateScreens j d $ toggleUnmarked ui VtyEvent (EvKey (KChar 'U') []) -> rsCenterSelection (regenerateScreens j d $ toggleUnmarked ui) >>= put'
VtyEvent (EvKey (KChar 'P') []) -> rsCenterSelection $ regenerateScreens j d $ togglePending ui VtyEvent (EvKey (KChar 'P') []) -> rsCenterSelection (regenerateScreens j d $ togglePending ui) >>= put'
VtyEvent (EvKey (KChar 'C') []) -> rsCenterSelection $ regenerateScreens j d $ toggleCleared ui VtyEvent (EvKey (KChar 'C') []) -> rsCenterSelection (regenerateScreens j d $ toggleCleared ui) >>= put'
VtyEvent (EvKey (KChar 'F') []) -> rsCenterSelection $ regenerateScreens j d $ toggleForecast d ui 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 (KChar '/') []) -> put' $ regenerateScreens j d $ showMinibuffer "filter" Nothing ui
VtyEvent (EvKey (KDown) [MShift]) -> put' $ regenerateScreens j d $ shrinkReportPeriod d 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 -- when selection is at the last item, DOWN scrolls instead of moving, until maximally scrolled
VtyEvent e | e `elem` moveDownEvents, isBlankElement mnextelement -> do 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 where mnextelement = listSelectedElement $ listMoveDown rsList
-- mouse scroll wheel scrolls the viewport up or down to its maximum extent, -- 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' newitems <- nestEventM' rsList $ handleListEvent ev'
put' ui{aScreen=s{rsList=newitems}} put' ui{aScreen=s{rsList=newitems}}
MouseDown{} -> put' ui MouseDown{} -> return ()
MouseUp{} -> put' ui MouseUp{} -> return ()
AppEvent _ -> put' ui AppEvent _ -> return ()
_ -> dlogUiTrace "rsHandle 2" $ errorWrongScreenType "event handler" _ -> dlogUiTrace "rsHandle 2" $ errorWrongScreenType "event handler"
isBlankElement mel = ((rsItemDate . snd) <$> mel) == Just "" isBlankElement mel = ((rsItemDate . snd) <$> mel) == Just ""
rsCenterSelection :: UIState -> EventM Name UIState () rsCenterSelection :: UIState -> EventM Name UIState UIState
rsCenterSelection = scrollSelectionToMiddle . rsList . aScreen 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 rsListSize = V.length . V.takeWhile ((/="").rsItemDate) . listElements

6
hledger-ui/Hledger/UI/UIUtils.hs
View File

@ -195,9 +195,9 @@ helpHandle ev = do
let ui' = setMode Normal ui let ui' = setMode Normal ui
case ev of 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 'p') []) -> suspendAndResume (runPagerForTopic "hledger-ui" Nothing >> return ui')
VtyEvent (EvKey (KChar 'm') []) -> suspendAndResume $ runManForTopic "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 'i') []) -> suspendAndResume (runInfoForTopic "hledger-ui" Nothing >> return ui')
_ -> return () _ -> return ()
where where
closeHelpEvents = moveLeftEvents ++ [EvKey KEsc [], EvKey (KChar '?') [], EvKey (KChar 'q') []] closeHelpEvents = moveLeftEvents ++ [EvKey KEsc [], EvKey (KChar '?') [], EvKey (KChar 'q') []]