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

imp: ui: at --debug=2, do lots of logging to debug.log

Browse Source
This commit is contained in:
Simon Michael 2022-08-22 23:55:14 +01:00
parent b7b09f991a
commit 67cd6be424
7 changed files with 170 additions and 115 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -54,7 +54,7 @@ asInit d reset ui@UIState{
aopts=UIOpts{uoCliOpts=copts@CliOpts{reportspec_=rspec@ReportSpec{_rsReportOpts=ropts}}}, aopts=UIOpts{uoCliOpts=copts@CliOpts{reportspec_=rspec@ReportSpec{_rsReportOpts=ropts}}},
ajournal=j, ajournal=j,
aScreen=s@AccountsScreen{} aScreen=s@AccountsScreen{}
} = } = dlogUiTrace "asInit 1" $
ui{aScreen=s & asList .~ newitems'} ui{aScreen=s & asList .~ newitems'}
where where
newitems = list AccountsList (V.fromList $ displayitems ++ blankitems) 1 newitems = list AccountsList (V.fromList $ displayitems ++ blankitems) 1
@ -97,7 +97,7 @@ asInit d reset ui@UIState{
displayitems = map displayitem items displayitems = map displayitem items
-- blanks added for scrolling control, cf RegisterScreen. -- blanks added for scrolling control, cf RegisterScreen.
-- XXX Ugly. Changing to 0 helps when debugging. -- XXX Ugly. Changing to 0 helps when debugging.
blankitems = replicate 100 blankitems = replicate uiNumBlankItems
AccountsScreenItem{asItemIndentLevel = 0 AccountsScreenItem{asItemIndentLevel = 0
,asItemAccountName = "" ,asItemAccountName = ""
,asItemDisplayAccountName = "" ,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 -> [Widget Name]
asDraw UIState{aopts=_uopts@UIOpts{uoCliOpts=copts@CliOpts{reportspec_=rspec}} asDraw UIState{aopts=_uopts@UIOpts{uoCliOpts=copts@CliOpts{reportspec_=rspec}}
,ajournal=j ,ajournal=j
,aScreen=s@AccountsScreen{} ,aScreen=s@AccountsScreen{}
,aMode=mode ,aMode=mode
} = } = dlogUiTrace "asDraw 1" $
case mode of case mode of
Help -> [helpDialog copts, maincontent] Help -> [helpDialog copts, maincontent]
-- Minibuffer e -> [minibuffer e, maincontent] -- Minibuffer e -> [minibuffer e, maincontent]
@ -203,7 +203,7 @@ asDraw UIState{aopts=_uopts@UIOpts{uoCliOpts=copts@CliOpts{reportspec_=rspec}}
,("q", str "quit") ,("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 :: (Int,Int) -> Bool -> AccountsScreenItem -> Widget Name
asDrawItem (acctwidth, balwidth) selected AccountsScreenItem{..} = asDrawItem (acctwidth, balwidth) selected AccountsScreenItem{..} =
@ -227,7 +227,8 @@ 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 <- get ui0 <- get'
dlogUiTraceM "asHandle 1"
case ui0 of case ui0 of
ui1@UIState{ ui1@UIState{
aScreen=scr@AccountsScreen{..} aScreen=scr@AccountsScreen{..}
@ -250,8 +251,8 @@ asHandle ev = do
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'
@ -260,7 +261,7 @@ asHandle ev = do
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 ()
@ -276,36 +277,36 @@ asHandle ev = do
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
@ -317,13 +318,13 @@ asHandle ev = do
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
@ -335,7 +336,7 @@ asHandle ev = do
-- 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
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 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
@ -352,7 +353,7 @@ asHandle ev = do
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
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 -- 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
@ -361,20 +362,20 @@ asHandle ev = do
then do then do
let list' = listMoveTo lastnonblankidx list let list' = listMoveTo lastnonblankidx list
scrollSelectionToMiddle list' scrollSelectionToMiddle list'
put ui{aScreen=scr{_asList=list'}} put' ui{aScreen=scr{_asList=list'}}
else else
put ui{aScreen=scr{_asList=list}} 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 _ -> dlogUiTraceM "asHandle 2" >> errorWrongScreenType "event handler"
asEnterRegister d selacct ui = do asEnterRegister d selacct ui = do
rsCenterAndContinue $ rsCenterAndContinue $
@ -393,7 +394,7 @@ isBlankElement mel = ((asItemAccountName . snd) <$> mel) == Just ""
asCenterAndContinue :: EventM Name UIState () asCenterAndContinue :: EventM Name UIState ()
asCenterAndContinue = do asCenterAndContinue = do
ui <- get ui <- get'
scrollSelectionToMiddle (_asList $ aScreen ui) scrollSelectionToMiddle (_asList $ aScreen ui)
asListSize = V.length . V.takeWhile ((/="").asItemAccountName) . listElements asListSize = V.length . V.takeWhile ((/="").asItemAccountName) . listElements

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

@ -114,7 +114,7 @@ esHandle ev = do
VtyEvent (EvKey (KChar 'z') [MCtrl]) -> suspend ui VtyEvent (EvKey (KChar 'z') [MCtrl]) -> suspend ui
_ -> return () _ -> return ()
_ -> errorWrongScreenType _ -> errorWrongScreenType "event handler"
-- | 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

4
hledger-ui/Hledger/UI/Main.hs
View File

@ -35,6 +35,7 @@ import Hledger.UI.UITypes
import Hledger.UI.Theme import Hledger.UI.Theme
import Hledger.UI.AccountsScreen import Hledger.UI.AccountsScreen
import Hledger.UI.RegisterScreen import Hledger.UI.RegisterScreen
import Hledger.UI.UIUtils (dlogUiTrace)
---------------------------------------------------------------------- ----------------------------------------------------------------------
@ -62,7 +63,8 @@ main = do
_ -> withJournalDo copts' (runBrickUi opts) _ -> withJournalDo copts' (runBrickUi opts)
runBrickUi :: UIOpts -> Journal -> IO () 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 let
today = copts^.rsDay today = copts^.rsDay

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

@ -10,7 +10,7 @@ module Hledger.UI.RegisterScreen
(registerScreen (registerScreen
,rsHandle ,rsHandle
,rsSetAccount ,rsSetAccount
,rsCenterAndContinue ,rsCenterSelection
) )
where where
@ -59,6 +59,7 @@ rsSetAccount _ _ scr = scr
rsInit :: Day -> Bool -> UIState -> UIState 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{..}} = 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'}} ui{aScreen=s{rsList=newitems'}}
where where
-- gather arguments and queries -- 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} 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. -- 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. -- XXX Ugly. Changing to 0 helps when debugging.
blankitems = replicate 100 -- "100 ought to be enough for anyone" blankitems = replicate uiNumBlankItems
RegisterScreenItem{rsItemDate = "" RegisterScreenItem{rsItemDate = ""
,rsItemStatus = Unmarked ,rsItemStatus = Unmarked
,rsItemDescription = "" ,rsItemDescription = ""
@ -136,13 +137,13 @@ rsInit d reset ui@UIState{aopts=_uopts@UIOpts{uoCliOpts=copts@CliOpts{reportspec
ts = map rsItemTransaction displayitems ts = map rsItemTransaction displayitems
endidx = max 0 $ length displayitems - 1 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 -> [Widget Name]
rsDraw UIState{aopts=_uopts@UIOpts{uoCliOpts=copts@CliOpts{reportspec_=rspec}} rsDraw UIState{aopts=_uopts@UIOpts{uoCliOpts=copts@CliOpts{reportspec_=rspec}}
,aScreen=RegisterScreen{..} ,aScreen=RegisterScreen{..}
,aMode=mode ,aMode=mode
} = } = dlogUiTrace "rsDraw 1" $
case mode of case mode of
Help -> [helpDialog copts, maincontent] Help -> [helpDialog copts, maincontent]
-- Minibuffer e -> [minibuffer e, maincontent] -- Minibuffer e -> [minibuffer e, maincontent]
@ -250,7 +251,7 @@ rsDraw UIState{aopts=_uopts@UIOpts{uoCliOpts=copts@CliOpts{reportspec_=rspec}}
-- ,("q", "quit") -- ,("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 :: (Int,Int,Int,Int,Int) -> Bool -> RegisterScreenItem -> Widget Name
rsDrawItem (datewidth,descwidth,acctswidth,changewidth,balwidth) selected RegisterScreenItem{..} = 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 :: BrickEvent Name AppEvent -> EventM Name UIState ()
rsHandle ev = do rsHandle ev = do
ui0 <- get ui0 <- get'
dlogUiTraceM "rsHandle 1"
case ui0 of case ui0 of
ui@UIState{ ui@UIState{
aScreen=s@RegisterScreen{..} aScreen=s@RegisterScreen{..}
@ -297,17 +299,17 @@ rsHandle ev = do
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 ()
@ -322,18 +324,18 @@ rsHandle ev = do
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
@ -342,53 +344,53 @@ 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') []) -> rsCenterAndContinue $ regenerateScreens j d $ toggleConversionOp ui VtyEvent (EvKey (KChar 'B') []) -> rsCenterSelection $ regenerateScreens j d $ toggleConversionOp ui
VtyEvent (EvKey (KChar 'V') []) -> rsCenterAndContinue $ regenerateScreens j d $ toggleValue ui VtyEvent (EvKey (KChar 'V') []) -> rsCenterSelection $ regenerateScreens j d $ toggleValue ui
VtyEvent (EvKey (KChar 'H') []) -> rsCenterAndContinue $ regenerateScreens j d $ toggleHistorical ui VtyEvent (EvKey (KChar 'H') []) -> rsCenterSelection $ regenerateScreens j d $ toggleHistorical ui
VtyEvent (EvKey (KChar 't') []) -> rsCenterAndContinue $ regenerateScreens j d $ toggleTree ui VtyEvent (EvKey (KChar 't') []) -> rsCenterSelection $ 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'] -> rsCenterSelection $ regenerateScreens j d $ toggleEmpty ui
VtyEvent (EvKey (KChar 'R') []) -> rsCenterAndContinue $ regenerateScreens j d $ toggleReal ui VtyEvent (EvKey (KChar 'R') []) -> rsCenterSelection $ regenerateScreens j d $ toggleReal ui
VtyEvent (EvKey (KChar 'U') []) -> rsCenterAndContinue $ regenerateScreens j d $ toggleUnmarked ui VtyEvent (EvKey (KChar 'U') []) -> rsCenterSelection $ regenerateScreens j d $ toggleUnmarked ui
VtyEvent (EvKey (KChar 'P') []) -> rsCenterAndContinue $ regenerateScreens j d $ togglePending ui VtyEvent (EvKey (KChar 'P') []) -> rsCenterSelection $ regenerateScreens j d $ togglePending ui
VtyEvent (EvKey (KChar 'C') []) -> rsCenterAndContinue $ regenerateScreens j d $ toggleCleared ui VtyEvent (EvKey (KChar 'C') []) -> rsCenterSelection $ regenerateScreens j d $ toggleCleared ui
VtyEvent (EvKey (KChar 'F') []) -> rsCenterAndContinue $ regenerateScreens j d $ toggleForecast d 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 (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,
@ -396,7 +398,7 @@ rsHandle ev = do
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
@ -405,21 +407,21 @@ rsHandle ev = do
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 _ -> dlogUiTrace "rsHandle 2" $ errorWrongScreenType "event handler"
isBlankElement mel = ((rsItemDate . snd) <$> mel) == Just "" isBlankElement mel = ((rsItemDate . snd) <$> mel) == Just ""

40
hledger-ui/Hledger/UI/TransactionScreen.hs
View File

@ -59,7 +59,7 @@ tsInit _d _reset ui@UIState{aopts=UIOpts{}
seltxn = maybe nulltransaction (rsItemTransaction . snd) $ listSelectedElement xs seltxn = maybe nulltransaction (rsItemTransaction . snd) $ listSelectedElement xs
nonblanks = V.toList . V.takeWhile (not . T.null . rsItemDate) $ xs ^. listElementsL nonblanks = V.toList . V.takeWhile (not . T.null . rsItemDate) $ xs ^. listElementsL
_ -> (t, nts) _ -> (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. -- Render a transaction suitably for the transaction screen.
showTxn :: ReportOpts -> ReportSpec -> Journal -> Transaction -> T.Text showTxn :: ReportOpts -> ReportSpec -> Journal -> Transaction -> T.Text
@ -139,11 +139,11 @@ tsDraw UIState{aopts=UIOpts{uoCliOpts=copts@CliOpts{reportspec_=rspec@ReportSpec
,("q", "quit") ,("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 :: BrickEvent Name AppEvent -> EventM Name UIState ()
tsHandle ev = do tsHandle ev = do
ui0 <- get ui0 <- get'
case ui0 of case ui0 of
ui@UIState{aScreen=TransactionScreen{tsTransaction=(i,t), tsTransactions=nts} ui@UIState{aScreen=TransactionScreen{tsTransaction=(i,t), tsTransactions=nts}
,aopts=UIOpts{uoCliOpts=copts@CliOpts{reportspec_=rspec@ReportSpec{_rsReportOpts=ropts}}} ,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 (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 _ -> errorWrongScreenType "event handler"
-- | 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

7
hledger-ui/Hledger/UI/UITypes.hs
View File

@ -39,6 +39,8 @@ Brick.defaultMain brickapp st
module Hledger.UI.UITypes where module Hledger.UI.UITypes where
-- import Control.Concurrent (threadDelay)
-- import GHC.IO (unsafePerformIO)
import Data.Text (Text) import Data.Text (Text)
import Data.Time.Calendar (Day) import Data.Time.Calendar (Day)
import Brick import Brick
@ -137,7 +139,10 @@ data Screen =
-- XXX check for ideas: https://github.com/jtdaugherty/brick/issues/379#issuecomment-1191993357 -- 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. -- | 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. -- | An item in the accounts screen's list of accounts and balances.
data AccountsScreenItem = AccountsScreenItem { data AccountsScreenItem = AccountsScreenItem {

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

@ -23,10 +23,17 @@ module Hledger.UI.UIUtils (
,renderToggle1 ,renderToggle1
,replaceHiddenAccountsNameWith ,replaceHiddenAccountsNameWith
,scrollSelectionToMiddle ,scrollSelectionToMiddle
,get'
,put'
,modify'
,suspend ,suspend
,redraw ,redraw
,reportSpecSetFutureAndForecast ,reportSpecSetFutureAndForecast
,listScrollPushingSelection ,listScrollPushingSelection
,dlogUiTrace
,dlogUiTraceM
,uiDebugLevel
,uiNumBlankItems
) )
where where
@ -65,6 +72,23 @@ suspendSignal :: IO ()
suspendSignal = raiseSignal sigSTOP suspendSignal = raiseSignal sigSTOP
#endif #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, -- | On posix platforms, suspend the program using the STOP signal,
-- like control-z in bash, returning to the original shell prompt, -- like control-z in bash, returning to the original shell prompt,
-- and when resumed, continue where we left off. -- and when resumed, continue where we left off.
@ -170,7 +194,7 @@ helpHandle ev = do
ui <- get ui <- get
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'
@ -383,3 +407,24 @@ listScrollPushingSelection name listheight scrollamt = do
| otherwise = id | otherwise = id
_ -> return list _ -> return list
_ -> 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