dev: ui: avoid MonadFail entirely, simplifying ghc version compat (#1889)
This commit is contained in:
Simon Michael
parent
2a594b7fb7
commit
4bd9f4a6f7
@ -227,151 +227,154 @@ asDrawItem (acctwidth, balwidth) selected AccountsScreenItem{..} =
|
|||||||
|
|
||||||
asHandle :: BrickEvent Name AppEvent -> EventM Name UIState ()
|
asHandle :: BrickEvent Name AppEvent -> EventM Name UIState ()
|
||||||
asHandle ev = do
|
asHandle ev = do
|
||||||
ui0@UIState{
|
ui0 <- get
|
||||||
aScreen=scr@AccountsScreen{..}
|
case ui0 of
|
||||||
,aopts=UIOpts{uoCliOpts=copts}
|
ui1@UIState{
|
||||||
,ajournal=j
|
aScreen=scr@AccountsScreen{..}
|
||||||
,aMode=mode
|
,aopts=UIOpts{uoCliOpts=copts}
|
||||||
} <- get -- PARTIAL: should not fail
|
,ajournal=j
|
||||||
let
|
,aMode=mode
|
||||||
d = copts^.rsDay
|
} -> do
|
||||||
nonblanks = V.takeWhile (not . T.null . asItemAccountName) $ _asList^.listElementsL
|
|
||||||
lastnonblankidx = max 0 (length nonblanks - 1)
|
|
||||||
journalspan = journalDateSpan False j
|
|
||||||
|
|
||||||
-- save the currently selected account, in case we leave this screen and lose the selection
|
let
|
||||||
let
|
-- save the currently selected account, in case we leave this screen and lose the selection
|
||||||
selacct = case listSelectedElement _asList of
|
selacct = case listSelectedElement _asList of
|
||||||
Just (_, AccountsScreenItem{..}) -> asItemAccountName
|
Just (_, AccountsScreenItem{..}) -> asItemAccountName
|
||||||
Nothing -> scr ^. asSelectedAccount
|
Nothing -> scr ^. asSelectedAccount
|
||||||
ui = ui0{aScreen=scr & asSelectedAccount .~ selacct}
|
ui = ui1{aScreen=scr & asSelectedAccount .~ selacct}
|
||||||
|
nonblanks = V.takeWhile (not . T.null . asItemAccountName) $ _asList^.listElementsL
|
||||||
|
lastnonblankidx = max 0 (length nonblanks - 1)
|
||||||
|
journalspan = journalDateSpan False j
|
||||||
|
d = copts^.rsDay
|
||||||
|
|
||||||
case mode of
|
case mode of
|
||||||
Minibuffer _ ed ->
|
Minibuffer _ ed ->
|
||||||
case ev of
|
case ev of
|
||||||
VtyEvent (EvKey KEsc []) -> put $ closeMinibuffer ui
|
VtyEvent (EvKey KEsc []) -> put $ closeMinibuffer ui
|
||||||
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
|
||||||
Right ui' -> ui'
|
Right ui' -> ui'
|
||||||
where s = chomp $ unlines $ map strip $ getEditContents ed
|
where s = chomp $ unlines $ map strip $ getEditContents ed
|
||||||
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
|
||||||
VtyEvent ev -> do
|
VtyEvent ev -> do
|
||||||
ed' <- nestEventM' ed $ handleEditorEvent (VtyEvent ev)
|
ed' <- nestEventM' ed $ handleEditorEvent (VtyEvent ev)
|
||||||
put ui{aMode=Minibuffer "filter" ed'}
|
put ui{aMode=Minibuffer "filter" ed'}
|
||||||
AppEvent _ -> return ()
|
AppEvent _ -> return ()
|
||||||
MouseDown{} -> return ()
|
MouseDown{} -> return ()
|
||||||
MouseUp{} -> return ()
|
MouseUp{} -> return ()
|
||||||
|
|
||||||
Help ->
|
Help ->
|
||||||
case ev of
|
case ev of
|
||||||
-- VtyEvent (EvKey (KChar 'q') []) -> halt
|
-- VtyEvent (EvKey (KChar 'q') []) -> halt
|
||||||
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
|
||||||
_ -> helpHandle ev
|
_ -> helpHandle ev
|
||||||
|
|
||||||
Normal ->
|
Normal ->
|
||||||
case ev of
|
case ev of
|
||||||
VtyEvent (EvKey (KChar 'q') []) -> halt
|
VtyEvent (EvKey (KChar 'q') []) -> halt
|
||||||
-- EvKey (KChar 'l') [MCtrl] -> do
|
-- EvKey (KChar 'l') [MCtrl] -> do
|
||||||
VtyEvent (EvKey KEsc []) -> put $ resetScreens d ui
|
VtyEvent (EvKey KEsc []) -> put $ resetScreens d ui
|
||||||
VtyEvent (EvKey (KChar c) []) | c == '?' -> put $ setMode Help ui
|
VtyEvent (EvKey (KChar c) []) | c == '?' -> put $ setMode Help ui
|
||||||
-- XXX AppEvents currently handled only in Normal mode
|
-- XXX AppEvents currently handled only in Normal mode
|
||||||
-- XXX be sure we don't leave unconsumed events piling up
|
-- XXX be sure we don't leave unconsumed events piling up
|
||||||
AppEvent (DateChange old _) | isStandardPeriod p && p `periodContainsDate` old ->
|
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
|
where
|
||||||
p = reportPeriod ui
|
p = reportPeriod ui
|
||||||
e | e `elem` [VtyEvent (EvKey (KChar 'g') []), AppEvent FileChange] ->
|
e | e `elem` [VtyEvent (EvKey (KChar 'g') []), AppEvent FileChange] ->
|
||||||
liftIO (uiReloadJournal copts d ui) >>= put
|
liftIO (uiReloadJournal copts d ui) >>= put
|
||||||
VtyEvent (EvKey (KChar 'I') []) -> put $ uiCheckBalanceAssertions d (toggleIgnoreBalanceAssertions ui)
|
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 $ 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 '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 '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 'B') []) -> put $ regenerateScreens j d $ toggleConversionOp ui
|
||||||
VtyEvent (EvKey (KChar 'V') []) -> put $ regenerateScreens j d $ toggleValue 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 '0') []) -> put $ regenerateScreens j d $ setDepth (Just 0) ui
|
||||||
VtyEvent (EvKey (KChar '1') []) -> put $ regenerateScreens j d $ setDepth (Just 1) 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 '2') []) -> put $ regenerateScreens j d $ setDepth (Just 2) ui
|
||||||
VtyEvent (EvKey (KChar '3') []) -> put $ regenerateScreens j d $ setDepth (Just 3) 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 '4') []) -> put $ regenerateScreens j d $ setDepth (Just 4) ui
|
||||||
VtyEvent (EvKey (KChar '5') []) -> put $ regenerateScreens j d $ setDepth (Just 5) 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 '6') []) -> put $ regenerateScreens j d $ setDepth (Just 6) ui
|
||||||
VtyEvent (EvKey (KChar '7') []) -> put $ regenerateScreens j d $ setDepth (Just 7) 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 '8') []) -> put $ regenerateScreens j d $ setDepth (Just 8) ui
|
||||||
VtyEvent (EvKey (KChar '9') []) -> put $ regenerateScreens j d $ setDepth (Just 9) 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 '_') []) -> 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 c) []) | c `elem` ['+','='] -> put $ regenerateScreens j d $ incDepth 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
|
||||||
|
|
||||||
-- 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
|
||||||
VtyEvent (EvKey (KRight) [MShift]) -> put $ regenerateScreens j d $ nextReportPeriod journalspan 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 (KLeft) [MShift]) -> put $ regenerateScreens j d $ previousReportPeriod journalspan ui
|
||||||
VtyEvent (EvKey (KChar '/') []) -> put $ regenerateScreens j d $ showMinibuffer "filter" Nothing 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 (EvKey k []) | k `elem` [KBS, KDel] -> (put $ regenerateScreens j d $ resetFilter ui)
|
||||||
VtyEvent e | e `elem` moveLeftEvents -> put $ popScreen ui
|
VtyEvent e | e `elem` moveLeftEvents -> put $ popScreen ui
|
||||||
VtyEvent (EvKey (KChar 'l') [MCtrl]) -> scrollSelectionToMiddle _asList >> redraw
|
VtyEvent (EvKey (KChar 'l') [MCtrl]) -> scrollSelectionToMiddle _asList >> redraw
|
||||||
VtyEvent (EvKey (KChar 'z') [MCtrl]) -> suspend ui
|
VtyEvent (EvKey (KChar 'z') [MCtrl]) -> suspend ui
|
||||||
|
|
||||||
-- enter register screen for selected account (if there is one),
|
-- enter register screen for selected account (if there is one),
|
||||||
-- centering its selected transaction if possible
|
-- centering its selected transaction if possible
|
||||||
VtyEvent e | e `elem` moveRightEvents
|
VtyEvent e | e `elem` moveRightEvents
|
||||||
, not $ isBlankElement $ listSelectedElement _asList -> asEnterRegister d selacct ui
|
, not $ isBlankElement $ listSelectedElement _asList -> asEnterRegister d selacct ui
|
||||||
|
|
||||||
-- MouseDown is sometimes duplicated, https://github.com/jtdaugherty/brick/issues/347
|
-- MouseDown is sometimes duplicated, https://github.com/jtdaugherty/brick/issues/347
|
||||||
-- just use it to move the selection
|
-- just use it to move the selection
|
||||||
MouseDown _n BLeft _mods Location{loc=(_x,y)} | not $ (=="") clickedacct -> do
|
MouseDown _n BLeft _mods Location{loc=(_x,y)} | not $ (=="") clickedacct -> do
|
||||||
case scr of AccountsScreen{} -> put ui{aScreen=scr}; _ -> fail "" -- PARTIAL: should not happen
|
put ui{aScreen=scr} -- XXX does this do anything ?
|
||||||
where clickedacct = maybe "" asItemAccountName $ listElements _asList !? y
|
where clickedacct = maybe "" asItemAccountName $ listElements _asList !? y
|
||||||
-- and on MouseUp, enter the subscreen
|
-- and on MouseUp, enter the subscreen
|
||||||
MouseUp _n (Just BLeft) Location{loc=(_x,y)} | not $ (=="") clickedacct -> do
|
MouseUp _n (Just BLeft) Location{loc=(_x,y)} | not $ (=="") clickedacct -> do
|
||||||
asEnterRegister d clickedacct ui
|
asEnterRegister d clickedacct ui
|
||||||
where clickedacct = maybe "" asItemAccountName $ listElements _asList !? y
|
where clickedacct = maybe "" asItemAccountName $ listElements _asList !? y
|
||||||
|
|
||||||
-- 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 $ _asList^.listNameL) 1 >> put ui
|
vScrollBy (viewportScroll $ _asList^.listNameL) 1
|
||||||
where mnextelement = listSelectedElement $ listMoveDown _asList
|
where mnextelement = listSelectedElement $ listMoveDown _asList
|
||||||
|
|
||||||
-- 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,
|
||||||
-- pushing the selection when necessary.
|
-- pushing the selection when necessary.
|
||||||
MouseDown name btn _mods _loc | btn `elem` [BScrollUp, BScrollDown] -> do
|
MouseDown name btn _mods _loc | btn `elem` [BScrollUp, BScrollDown] -> do
|
||||||
let scrollamt = if btn==BScrollUp then -1 else 1
|
let scrollamt = if btn==BScrollUp then -1 else 1
|
||||||
list' <- nestEventM' _asList $ listScrollPushingSelection name (asListSize _asList) scrollamt
|
list' <- nestEventM' _asList $ listScrollPushingSelection name (asListSize _asList) scrollamt
|
||||||
case scr of AccountsScreen{} -> put ui{aScreen=scr{_asList=list'}}; _ -> fail "" -- PARTIAL: should not fail
|
put ui{aScreen=scr{_asList=list'}}
|
||||||
|
|
||||||
-- if page down or end leads to a blank padding item, stop at last non-blank
|
-- 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
|
VtyEvent e@(EvKey k []) | k `elem` [KPageDown, KEnd] -> do
|
||||||
list <- nestEventM' _asList $ handleListEvent e
|
list <- nestEventM' _asList $ handleListEvent e
|
||||||
if isBlankElement $ listSelectedElement list
|
if isBlankElement $ listSelectedElement list
|
||||||
then do
|
then do
|
||||||
let list' = listMoveTo lastnonblankidx list
|
let list' = listMoveTo lastnonblankidx list
|
||||||
scrollSelectionToMiddle list'
|
scrollSelectionToMiddle list'
|
||||||
case scr of AccountsScreen{} -> put ui{aScreen=scr{_asList=list'}}; _ -> fail "" -- PARTIAL: should not fail
|
put ui{aScreen=scr{_asList=list'}}
|
||||||
else
|
else
|
||||||
case scr of AccountsScreen{} -> put ui{aScreen=scr{_asList=list}}; _ -> fail "" -- PARTIAL: should not fail
|
put ui{aScreen=scr{_asList=list}}
|
||||||
|
|
||||||
-- 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{} -> put ui
|
MouseDown{} -> put ui
|
||||||
MouseUp{} -> put ui
|
MouseUp{} -> put ui
|
||||||
AppEvent _ -> put ui
|
AppEvent _ -> put ui
|
||||||
|
|
||||||
|
_ -> errorWrongScreenType
|
||||||
|
|
||||||
asEnterRegister d selacct ui = do
|
asEnterRegister d selacct ui = do
|
||||||
rsCenterAndContinue $
|
rsCenterAndContinue $
|
||||||
|
|||||||
@ -77,40 +77,44 @@ 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
|
||||||
ui@UIState{aScreen=ErrorScreen{..}
|
ui0 <- get
|
||||||
,aopts=UIOpts{uoCliOpts=copts}
|
case ui0 of
|
||||||
,ajournal=j
|
ui@UIState{aScreen=ErrorScreen{..}
|
||||||
,aMode=mode
|
,aopts=UIOpts{uoCliOpts=copts}
|
||||||
} <- get
|
,ajournal=j
|
||||||
case mode of
|
,aMode=mode
|
||||||
Help ->
|
} ->
|
||||||
case ev of
|
case mode of
|
||||||
VtyEvent (EvKey (KChar 'q') []) -> halt
|
Help ->
|
||||||
VtyEvent (EvKey (KChar 'l') [MCtrl]) -> redraw
|
case ev of
|
||||||
VtyEvent (EvKey (KChar 'z') [MCtrl]) -> suspend ui
|
VtyEvent (EvKey (KChar 'q') []) -> halt
|
||||||
_ -> helpHandle ev
|
VtyEvent (EvKey (KChar 'l') [MCtrl]) -> redraw
|
||||||
|
VtyEvent (EvKey (KChar 'z') [MCtrl]) -> suspend ui
|
||||||
|
_ -> helpHandle ev
|
||||||
|
|
||||||
_ -> do
|
_ -> 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 ()
|
||||||
|
|
||||||
|
_ -> errorWrongScreenType
|
||||||
|
|
||||||
-- | Parse the file name, line and column number from a hledger parse error message, if possible.
|
-- | 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
|
-- Temporary, we should keep the original parse error location. XXX
|
||||||
|
|||||||
@ -279,143 +279,147 @@ rsDrawItem (datewidth,descwidth,acctswidth,changewidth,balwidth) selected Regist
|
|||||||
|
|
||||||
rsHandle :: BrickEvent Name AppEvent -> EventM Name UIState ()
|
rsHandle :: BrickEvent Name AppEvent -> EventM Name UIState ()
|
||||||
rsHandle ev = do
|
rsHandle ev = do
|
||||||
ui@UIState{
|
ui0 <- get
|
||||||
aScreen=s@RegisterScreen{..}
|
case ui0 of
|
||||||
,aopts=UIOpts{uoCliOpts=copts}
|
ui@UIState{
|
||||||
,ajournal=j
|
aScreen=s@RegisterScreen{..}
|
||||||
,aMode=mode
|
,aopts=UIOpts{uoCliOpts=copts}
|
||||||
} <- get
|
,ajournal=j
|
||||||
let
|
,aMode=mode
|
||||||
d = copts^.rsDay
|
} -> do
|
||||||
journalspan = journalDateSpan False j
|
let
|
||||||
nonblanks = V.takeWhile (not . T.null . rsItemDate) $ rsList^.listElementsL
|
d = copts^.rsDay
|
||||||
lastnonblankidx = max 0 (length nonblanks - 1)
|
journalspan = journalDateSpan False j
|
||||||
|
nonblanks = V.takeWhile (not . T.null . rsItemDate) $ rsList^.listElementsL
|
||||||
|
lastnonblankidx = max 0 (length nonblanks - 1)
|
||||||
|
|
||||||
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
|
||||||
Right ui' -> ui'
|
Right ui' -> ui'
|
||||||
where s = chomp . unlines . map strip $ getEditContents ed
|
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 'l') [MCtrl]) -> redraw
|
||||||
VtyEvent (EvKey (KChar 'z') [MCtrl]) -> suspend ui
|
VtyEvent (EvKey (KChar 'z') [MCtrl]) -> suspend ui
|
||||||
VtyEvent ev -> do
|
VtyEvent ev -> do
|
||||||
ed' <- nestEventM' ed $ handleEditorEvent (VtyEvent ev)
|
ed' <- nestEventM' ed $ handleEditorEvent (VtyEvent ev)
|
||||||
put ui{aMode=Minibuffer "filter" ed'}
|
put ui{aMode=Minibuffer "filter" ed'}
|
||||||
AppEvent _ -> return ()
|
AppEvent _ -> return ()
|
||||||
MouseDown{} -> return ()
|
MouseDown{} -> return ()
|
||||||
MouseUp{} -> return ()
|
MouseUp{} -> return ()
|
||||||
|
|
||||||
Help ->
|
Help ->
|
||||||
case ev of
|
case ev of
|
||||||
-- VtyEvent (EvKey (KChar 'q') []) -> halt
|
-- VtyEvent (EvKey (KChar 'q') []) -> halt
|
||||||
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
|
||||||
_ -> helpHandle ev
|
_ -> helpHandle ev
|
||||||
|
|
||||||
Normal ->
|
Normal ->
|
||||||
case ev of
|
case ev of
|
||||||
VtyEvent (EvKey (KChar 'q') []) -> halt
|
VtyEvent (EvKey (KChar 'q') []) -> halt
|
||||||
VtyEvent (EvKey KEsc []) -> put $ resetScreens d ui
|
VtyEvent (EvKey KEsc []) -> put $ resetScreens d ui
|
||||||
VtyEvent (EvKey (KChar c) []) | c == '?' -> put $ setMode Help ui
|
VtyEvent (EvKey (KChar c) []) | c == '?' -> put $ setMode Help ui
|
||||||
AppEvent (DateChange old _) | isStandardPeriod p && p `periodContainsDate` old ->
|
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
|
where
|
||||||
p = reportPeriod ui
|
p = reportPeriod ui
|
||||||
e | e `elem` [VtyEvent (EvKey (KChar 'g') []), AppEvent FileChange] ->
|
e | e `elem` [VtyEvent (EvKey (KChar 'g') []), AppEvent FileChange] ->
|
||||||
liftIO (uiReloadJournal copts d ui) >>= put
|
liftIO (uiReloadJournal copts d ui) >>= put
|
||||||
VtyEvent (EvKey (KChar 'I') []) -> put $ uiCheckBalanceAssertions d (toggleIgnoreBalanceAssertions ui)
|
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 $ 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 '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
|
VtyEvent (EvKey (KChar 'E') []) -> suspendAndResume $ void (runEditor pos f) >> uiReloadJournalIfChanged copts d j ui
|
||||||
where
|
where
|
||||||
(pos,f) = case listSelectedElement rsList of
|
(pos,f) = case listSelectedElement rsList of
|
||||||
Nothing -> (endPosition, journalFilePath j)
|
Nothing -> (endPosition, journalFilePath j)
|
||||||
Just (_, RegisterScreenItem{
|
Just (_, RegisterScreenItem{
|
||||||
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') []) -> rsCenterAndContinue $ regenerateScreens j d $ toggleConversionOp ui
|
VtyEvent (EvKey (KChar 'B') []) -> rsCenterAndContinue $ regenerateScreens j d $ toggleConversionOp ui
|
||||||
VtyEvent (EvKey (KChar 'V') []) -> rsCenterAndContinue $ regenerateScreens j d $ toggleValue ui
|
VtyEvent (EvKey (KChar 'V') []) -> rsCenterAndContinue $ regenerateScreens j d $ toggleValue ui
|
||||||
VtyEvent (EvKey (KChar 'H') []) -> rsCenterAndContinue $ regenerateScreens j d $ toggleHistorical ui
|
VtyEvent (EvKey (KChar 'H') []) -> rsCenterAndContinue $ regenerateScreens j d $ toggleHistorical ui
|
||||||
VtyEvent (EvKey (KChar 't') []) -> rsCenterAndContinue $ regenerateScreens j d $ toggleTree 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 c) []) | c `elem` ['z','Z'] -> rsCenterAndContinue $ regenerateScreens j d $ toggleEmpty ui
|
||||||
VtyEvent (EvKey (KChar 'R') []) -> rsCenterAndContinue $ regenerateScreens j d $ toggleReal ui
|
VtyEvent (EvKey (KChar 'R') []) -> rsCenterAndContinue $ regenerateScreens j d $ toggleReal ui
|
||||||
VtyEvent (EvKey (KChar 'U') []) -> rsCenterAndContinue $ regenerateScreens j d $ toggleUnmarked ui
|
VtyEvent (EvKey (KChar 'U') []) -> rsCenterAndContinue $ regenerateScreens j d $ toggleUnmarked ui
|
||||||
VtyEvent (EvKey (KChar 'P') []) -> rsCenterAndContinue $ regenerateScreens j d $ togglePending ui
|
VtyEvent (EvKey (KChar 'P') []) -> rsCenterAndContinue $ regenerateScreens j d $ togglePending ui
|
||||||
VtyEvent (EvKey (KChar 'C') []) -> rsCenterAndContinue $ regenerateScreens j d $ toggleCleared 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 'F') []) -> rsCenterAndContinue $ regenerateScreens j d $ toggleForecast d ui
|
||||||
|
|
||||||
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
|
||||||
VtyEvent (EvKey (KUp) [MShift]) -> put $ regenerateScreens j d $ growReportPeriod 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 (KRight) [MShift]) -> put $ regenerateScreens j d $ nextReportPeriod journalspan ui
|
||||||
VtyEvent (EvKey (KLeft) [MShift]) -> put $ regenerateScreens j d $ previousReportPeriod 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 k []) | k `elem` [KBS, KDel] -> (put $ regenerateScreens j d $ resetFilter ui)
|
||||||
VtyEvent (EvKey (KChar 'l') [MCtrl]) -> scrollSelectionToMiddle rsList >> redraw
|
VtyEvent (EvKey (KChar 'l') [MCtrl]) -> scrollSelectionToMiddle rsList >> redraw
|
||||||
VtyEvent (EvKey (KChar 'z') [MCtrl]) -> suspend ui
|
VtyEvent (EvKey (KChar 'z') [MCtrl]) -> suspend ui
|
||||||
|
|
||||||
-- exit screen on LEFT
|
-- 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.
|
-- 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.
|
-- 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
|
where clickeddate = maybe "" rsItemDate $ listElements rsList !? y
|
||||||
|
|
||||||
-- enter transaction screen on RIGHT
|
-- enter transaction screen on RIGHT
|
||||||
VtyEvent e | e `elem` moveRightEvents ->
|
VtyEvent e | e `elem` moveRightEvents ->
|
||||||
case listSelectedElement rsList of
|
case listSelectedElement rsList of
|
||||||
Just _ -> put $ screenEnter d transactionScreen{tsAccount=rsAccount} ui
|
Just _ -> put $ screenEnter d transactionScreen{tsAccount=rsAccount} ui
|
||||||
Nothing -> put ui
|
Nothing -> put ui
|
||||||
-- or on transaction click
|
-- or on transaction click
|
||||||
-- MouseDown is sometimes duplicated, https://github.com/jtdaugherty/brick/issues/347
|
-- MouseDown is sometimes duplicated, https://github.com/jtdaugherty/brick/issues/347
|
||||||
-- just use it to move the selection
|
-- just use it to move the selection
|
||||||
MouseDown _n BLeft _mods Location{loc=(_x,y)} | not $ (=="") clickeddate -> do
|
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
|
where clickeddate = maybe "" rsItemDate $ listElements rsList !? y
|
||||||
-- and on MouseUp, enter the subscreen
|
-- and on MouseUp, enter the subscreen
|
||||||
MouseUp _n (Just BLeft) Location{loc=(_x,y)} | not $ (=="") clickeddate -> do
|
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
|
where clickeddate = maybe "" rsItemDate $ listElements rsList !? y
|
||||||
|
|
||||||
-- 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 >> put ui
|
||||||
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,
|
||||||
-- pushing the selection when necessary.
|
-- pushing the selection when necessary.
|
||||||
MouseDown name btn _mods _loc | btn `elem` [BScrollUp, BScrollDown] -> do
|
MouseDown name btn _mods _loc | btn `elem` [BScrollUp, BScrollDown] -> do
|
||||||
let scrollamt = if btn==BScrollUp then -1 else 1
|
let scrollamt = if btn==BScrollUp then -1 else 1
|
||||||
list' <- nestEventM' rsList $ listScrollPushingSelection name (rsListSize rsList) scrollamt
|
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
|
-- 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
|
VtyEvent e@(EvKey k []) | k `elem` [KPageDown, KEnd] -> do
|
||||||
list <- nestEventM' rsList $ handleListEvent e
|
list <- nestEventM' rsList $ handleListEvent e
|
||||||
if isBlankElement $ listSelectedElement list
|
if isBlankElement $ listSelectedElement list
|
||||||
then do
|
then do
|
||||||
let list' = listMoveTo lastnonblankidx list
|
let list' = listMoveTo lastnonblankidx list
|
||||||
scrollSelectionToMiddle list'
|
scrollSelectionToMiddle list'
|
||||||
put ui{aScreen=s{rsList=list'}}
|
put ui{aScreen=s{rsList=list'}}
|
||||||
else
|
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)
|
-- fall through to the list's event handler (handles other [pg]up/down events)
|
||||||
VtyEvent ev -> do
|
VtyEvent ev -> do
|
||||||
let ev' = normaliseMovementKeys ev
|
let ev' = normaliseMovementKeys ev
|
||||||
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{} -> put ui
|
||||||
MouseUp{} -> put ui
|
MouseUp{} -> put ui
|
||||||
AppEvent _ -> put ui
|
AppEvent _ -> put ui
|
||||||
|
|
||||||
|
_ -> errorWrongScreenType
|
||||||
|
|
||||||
isBlankElement mel = ((rsItemDate . snd) <$> mel) == Just ""
|
isBlankElement mel = ((rsItemDate . snd) <$> mel) == Just ""
|
||||||
|
|
||||||
|
|||||||
@ -143,66 +143,70 @@ tsDraw _ = error "draw function called with wrong screen type, should not happen
|
|||||||
|
|
||||||
tsHandle :: BrickEvent Name AppEvent -> EventM Name UIState ()
|
tsHandle :: BrickEvent Name AppEvent -> EventM Name UIState ()
|
||||||
tsHandle ev = do
|
tsHandle ev = do
|
||||||
ui@UIState{aScreen=TransactionScreen{tsTransaction=(i,t), tsTransactions=nts}
|
ui0 <- get
|
||||||
,aopts=UIOpts{uoCliOpts=copts@CliOpts{reportspec_=rspec@ReportSpec{_rsReportOpts=ropts}}}
|
case ui0 of
|
||||||
,ajournal=j
|
ui@UIState{aScreen=TransactionScreen{tsTransaction=(i,t), tsTransactions=nts}
|
||||||
,aMode=mode
|
,aopts=UIOpts{uoCliOpts=copts@CliOpts{reportspec_=rspec@ReportSpec{_rsReportOpts=ropts}}}
|
||||||
} <- get
|
,ajournal=j
|
||||||
case mode of
|
,aMode=mode
|
||||||
Help ->
|
} ->
|
||||||
case ev of
|
case mode of
|
||||||
-- VtyEvent (EvKey (KChar 'q') []) -> halt
|
Help ->
|
||||||
VtyEvent (EvKey (KChar 'l') [MCtrl]) -> redraw
|
case ev of
|
||||||
VtyEvent (EvKey (KChar 'z') [MCtrl]) -> suspend ui
|
-- VtyEvent (EvKey (KChar 'q') []) -> halt
|
||||||
_ -> helpHandle ev
|
VtyEvent (EvKey (KChar 'l') [MCtrl]) -> redraw
|
||||||
|
VtyEvent (EvKey (KChar 'z') [MCtrl]) -> suspend ui
|
||||||
|
_ -> helpHandle ev
|
||||||
|
|
||||||
_ -> do
|
_ -> do
|
||||||
let
|
let
|
||||||
d = copts^.rsDay
|
d = copts^.rsDay
|
||||||
(iprev,tprev) = maybe (i,t) ((i-1),) $ lookup (i-1) nts
|
(iprev,tprev) = maybe (i,t) ((i-1),) $ lookup (i-1) nts
|
||||||
(inext,tnext) = maybe (i,t) ((i+1),) $ lookup (i+1) nts
|
(inext,tnext) = maybe (i,t) ((i+1),) $ lookup (i+1) nts
|
||||||
case ev of
|
case ev of
|
||||||
VtyEvent (EvKey (KChar 'q') []) -> halt
|
VtyEvent (EvKey (KChar 'q') []) -> halt
|
||||||
VtyEvent (EvKey KEsc []) -> put $ resetScreens d ui
|
VtyEvent (EvKey KEsc []) -> put $ resetScreens d ui
|
||||||
VtyEvent (EvKey (KChar c) []) | c == '?' -> put $ setMode Help ui
|
VtyEvent (EvKey (KChar c) []) | c == '?' -> put $ setMode Help ui
|
||||||
VtyEvent (EvKey (KChar 'E') []) -> suspendAndResume $ void (runEditor pos f) >> uiReloadJournalIfChanged copts d j ui
|
VtyEvent (EvKey (KChar 'E') []) -> suspendAndResume $ void (runEditor pos f) >> uiReloadJournalIfChanged copts d j ui
|
||||||
where
|
where
|
||||||
(pos,f) = case tsourcepos t of
|
(pos,f) = case tsourcepos t of
|
||||||
(SourcePos f l1 c1,_) -> (Just (unPos l1, Just $ unPos c1),f)
|
(SourcePos f l1 c1,_) -> (Just (unPos l1, Just $ unPos c1),f)
|
||||||
AppEvent (DateChange old _) | isStandardPeriod p && p `periodContainsDate` old ->
|
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
|
where
|
||||||
p = reportPeriod ui
|
p = reportPeriod ui
|
||||||
e | e `elem` [VtyEvent (EvKey (KChar 'g') []), AppEvent FileChange] -> do
|
e | e `elem` [VtyEvent (EvKey (KChar 'g') []), AppEvent FileChange] -> do
|
||||||
-- plog (if e == AppEvent FileChange then "file change" else "manual reload") "" `seq` return ()
|
-- plog (if e == AppEvent FileChange then "file change" else "manual reload") "" `seq` return ()
|
||||||
ej <- liftIO . runExceptT $ journalReload copts
|
ej <- liftIO . runExceptT $ journalReload copts
|
||||||
case ej of
|
case ej of
|
||||||
Left err -> put $ screenEnter d errorScreen{esError=err} ui
|
Left err -> put $ screenEnter d errorScreen{esError=err} ui
|
||||||
Right j' -> put $ regenerateScreens j' d ui
|
Right j' -> put $ regenerateScreens j' d ui
|
||||||
VtyEvent (EvKey (KChar 'I') []) -> put $ uiCheckBalanceAssertions d (toggleIgnoreBalanceAssertions ui)
|
VtyEvent (EvKey (KChar 'I') []) -> put $ uiCheckBalanceAssertions d (toggleIgnoreBalanceAssertions ui)
|
||||||
|
|
||||||
-- for toggles that may change the current/prev/next transactions,
|
-- 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
|
-- 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 'E') [] -> put $ regenerateScreens j d $ stToggleEmpty ui
|
||||||
-- EvKey (KChar 'C') [] -> put $ regenerateScreens j d $ stToggleCleared ui
|
-- EvKey (KChar 'C') [] -> put $ regenerateScreens j d $ stToggleCleared ui
|
||||||
-- EvKey (KChar 'R') [] -> put $ regenerateScreens j d $ stToggleReal ui
|
-- EvKey (KChar 'R') [] -> put $ regenerateScreens j d $ stToggleReal ui
|
||||||
VtyEvent (EvKey (KChar 'B') []) -> put . regenerateScreens j d $ toggleConversionOp ui
|
VtyEvent (EvKey (KChar 'B') []) -> put . regenerateScreens j d $ toggleConversionOp ui
|
||||||
VtyEvent (EvKey (KChar 'V') []) -> put . regenerateScreens j d $ toggleValue 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` moveUpEvents -> put $ tsSelect iprev tprev ui
|
||||||
VtyEvent e | e `elem` moveDownEvents -> put $ tsSelect inext tnext ui
|
VtyEvent e | e `elem` moveDownEvents -> put $ tsSelect inext tnext ui
|
||||||
|
|
||||||
-- exit screen on LEFT
|
-- 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.
|
-- 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.
|
-- 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
|
where numentrylines = length (T.lines $ showTxn ropts rspec j t) - 1
|
||||||
|
|
||||||
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 ()
|
||||||
|
|
||||||
|
_ -> errorWrongScreenType
|
||||||
|
|
||||||
-- | Select a new transaction and update the previous register screen
|
-- | Select a new transaction and update the previous register screen
|
||||||
tsSelect i t ui@UIState{aScreen=s@TransactionScreen{}} = case aPrevScreens ui of
|
tsSelect i t ui@UIState{aScreen=s@TransactionScreen{}} = case aPrevScreens ui of
|
||||||
|
|||||||
@ -135,6 +135,9 @@ data Screen =
|
|||||||
}
|
}
|
||||||
deriving (Show)
|
deriving (Show)
|
||||||
|
|
||||||
|
-- | Error message to use in case statements adapting to the different Screen shapes.
|
||||||
|
errorWrongScreenType = error' "handler called with wrong screen type, should not happen"
|
||||||
|
|
||||||
-- | An item in the accounts screen's list of accounts and balances.
|
-- | An item in the accounts screen's list of accounts and balances.
|
||||||
data AccountsScreenItem = AccountsScreenItem {
|
data AccountsScreenItem = AccountsScreenItem {
|
||||||
asItemIndentLevel :: Int -- ^ indent level
|
asItemIndentLevel :: Int -- ^ indent level
|
||||||
@ -155,10 +158,6 @@ data RegisterScreenItem = RegisterScreenItem {
|
|||||||
}
|
}
|
||||||
deriving (Show)
|
deriving (Show)
|
||||||
|
|
||||||
instance MonadFail (EventM Name UIState) where fail _ = wrongScreenTypeError
|
|
||||||
|
|
||||||
wrongScreenTypeError = error' "handler called with wrong screen type, should not happen"
|
|
||||||
|
|
||||||
type NumberedTransaction = (Integer, Transaction)
|
type NumberedTransaction = (Integer, Transaction)
|
||||||
|
|
||||||
-- dummy monoid instance needed make lenses work with List fields not common across constructors
|
-- dummy monoid instance needed make lenses work with List fields not common across constructors
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user