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

ui: acc: preserve account selection across reloads

Browse Source
This commit is contained in:
Simon Michael 2015-10-28 11:13:33 -07:00
parent 423934b2b8
commit 45db0a28cc
3 changed files with 59 additions and 59 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -36,31 +36,30 @@ import qualified Hledger.UI.RegisterScreen as RS (screen)
import qualified Hledger.UI.ErrorScreen as ES (screen) import qualified Hledger.UI.ErrorScreen as ES (screen)
screen = AccountsScreen{ screen = AccountsScreen{
asState = list "accounts" V.empty 1 asState = (list "accounts" V.empty 1, "")
,sInitFn = initAccountsScreen Nothing ,sInitFn = initAccountsScreen
,sDrawFn = drawAccountsScreen ,sDrawFn = drawAccountsScreen
,sHandleFn = handleAccountsScreen ,sHandleFn = handleAccountsScreen
} }
initAccountsScreen :: Maybe AccountName -> Day -> AppState -> AppState initAccountsScreen :: Day -> AppState -> AppState
initAccountsScreen mselacct d st@AppState{ initAccountsScreen d st@AppState{
aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}}, aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}},
ajournal=j, ajournal=j,
aScreen=s@AccountsScreen{} aScreen=s@AccountsScreen{asState=(_,selacct)}
} = } =
st{aopts=uopts', aScreen=s{asState=l'}} st{aopts=uopts', aScreen=s{asState=(l',selacct)}}
where where
l = list (Name "accounts") (V.fromList displayitems) 1 l = list (Name "accounts") (V.fromList displayitems) 1
-- hacky: when we're adjusting depth, mselacct is the account that was selected previously, -- keep the selection near the last known selected account if possible
-- in which case try and keep the selection near where it was l' | null selacct = l
l' = case mselacct of | otherwise = maybe l (flip listMoveTo l) midx
Nothing -> l where
Just a -> -- vScrollToBeginning $ viewportScroll "accounts" midx = findIndex (\((a,_,_),_) -> a==selacctclipped) items
maybe l (flip listMoveTo l) mi selacctclipped = case depth_ ropts of
where Nothing -> selacct
mi = findIndex (\((acct,_,_),_) -> acct==a') items Just d -> clipAccountName d selacct
a' = maybe a (flip clipAccountName a) $ depth_ ropts
uopts' = uopts{cliopts_=copts{reportopts_=ropts'}} uopts' = uopts{cliopts_=copts{reportopts_=ropts'}}
ropts' = ropts { ropts' = ropts {
@ -92,10 +91,10 @@ initAccountsScreen mselacct d st@AppState{
displayitems = map displayitem items displayitems = map displayitem items
initAccountsScreen _ _ _ = error "init function called with wrong screen type, should not happen" initAccountsScreen _ _ = error "init function called with wrong screen type, should not happen"
drawAccountsScreen :: AppState -> [Widget] drawAccountsScreen :: AppState -> [Widget]
drawAccountsScreen _st@AppState{aopts=uopts, ajournal=j, aScreen=AccountsScreen{asState=l}} = drawAccountsScreen _st@AppState{aopts=uopts, ajournal=j, aScreen=AccountsScreen{asState=(l,_)}} =
[ui] [ui]
where where
toplabel = files toplabel = files
@ -196,7 +195,7 @@ drawAccountsItem (acctwidth, balwidth) selected (indent, _fullacct, displayacct,
handleAccountsScreen :: AppState -> Vty.Event -> EventM (Next AppState) handleAccountsScreen :: AppState -> Vty.Event -> EventM (Next AppState)
handleAccountsScreen st@AppState{ handleAccountsScreen st@AppState{
aScreen=scr@AccountsScreen{asState=l} aScreen=scr@AccountsScreen{asState=(l,selacct)}
,aopts=UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}} ,aopts=UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}}
,ajournal=j ,ajournal=j
} e = do } e = do
@ -204,63 +203,59 @@ handleAccountsScreen st@AppState{
-- c <- getContext -- c <- getContext
-- let h = c^.availHeightL -- let h = c^.availHeightL
-- moveSel n l = listMoveBy n l -- moveSel n l = listMoveBy n l
let
acct = case listSelectedElement l of
Just (_, (_, fullacct, _, _)) -> fullacct
Nothing -> ""
-- Customize reload to preserve the account selection while reloading. -- before we go anywhere, remember the currently selected account.
-- XXX reloads only the current screen, not previous ones - ok for now as accounts screen is always the first -- (This is preserved across screen changes, unlike List's selection state)
-- XXX won't have any effect when this screen is reloaded by a deeper screen's reload - should move selected acct into state let
reload' = initAccountsScreen (Just acct) selacct' = case listSelectedElement l of
Just (_, (_, fullacct, _, _)) -> fullacct
Nothing -> selacct
st' = st{aScreen=scr{asState=(l,selacct')}}
case e of case e of
Vty.EvKey Vty.KEsc [] -> halt st Vty.EvKey Vty.KEsc [] -> halt st'
Vty.EvKey (Vty.KChar 'q') [] -> halt st Vty.EvKey (Vty.KChar 'q') [] -> halt st'
-- Vty.EvKey (Vty.KChar 'l') [Vty.MCtrl] -> do -- Vty.EvKey (Vty.KChar 'l') [Vty.MCtrl] -> do
Vty.EvKey (Vty.KChar 'g') [] -> do Vty.EvKey (Vty.KChar 'g') [] -> do
ej <- liftIO $ journalReload j -- (ej, changed) <- liftIO $ journalReloadIfChanged copts j ej <- liftIO $ journalReload j -- (ej, changed) <- liftIO $ journalReloadIfChanged copts j
case ej of case ej of
Right j' -> continue $ reload j' d st Right j' -> continue $ reload j' d st'
Left err -> continue $ screenEnter d ES.screen{esState=err} st Left err -> continue $ screenEnter d ES.screen{esState=err} st'
Vty.EvKey (Vty.KChar '-') [] -> continue $ reload' d $ decDepth st Vty.EvKey (Vty.KChar '-') [] -> continue $ reload j d $ decDepth st'
Vty.EvKey (Vty.KChar '+') [] -> continue $ reload' d $ incDepth st Vty.EvKey (Vty.KChar '+') [] -> continue $ reload j d $ incDepth st'
Vty.EvKey (Vty.KChar '=') [] -> continue $ reload' d $ incDepth st Vty.EvKey (Vty.KChar '=') [] -> continue $ reload j d $ incDepth st'
Vty.EvKey (Vty.KChar '1') [] -> continue $ reload' d $ setDepth 1 st Vty.EvKey (Vty.KChar '1') [] -> continue $ reload j d $ setDepth 1 st'
Vty.EvKey (Vty.KChar '2') [] -> continue $ reload' d $ setDepth 2 st Vty.EvKey (Vty.KChar '2') [] -> continue $ reload j d $ setDepth 2 st'
Vty.EvKey (Vty.KChar '3') [] -> continue $ reload' d $ setDepth 3 st Vty.EvKey (Vty.KChar '3') [] -> continue $ reload j d $ setDepth 3 st'
Vty.EvKey (Vty.KChar '4') [] -> continue $ reload' d $ setDepth 4 st Vty.EvKey (Vty.KChar '4') [] -> continue $ reload j d $ setDepth 4 st'
Vty.EvKey (Vty.KChar '5') [] -> continue $ reload' d $ setDepth 5 st Vty.EvKey (Vty.KChar '5') [] -> continue $ reload j d $ setDepth 5 st'
Vty.EvKey (Vty.KChar '6') [] -> continue $ reload' d $ setDepth 6 st Vty.EvKey (Vty.KChar '6') [] -> continue $ reload j d $ setDepth 6 st'
Vty.EvKey (Vty.KChar '7') [] -> continue $ reload' d $ setDepth 7 st Vty.EvKey (Vty.KChar '7') [] -> continue $ reload j d $ setDepth 7 st'
Vty.EvKey (Vty.KChar '8') [] -> continue $ reload' d $ setDepth 8 st Vty.EvKey (Vty.KChar '8') [] -> continue $ reload j d $ setDepth 8 st'
Vty.EvKey (Vty.KChar '9') [] -> continue $ reload' d $ setDepth 9 st Vty.EvKey (Vty.KChar '9') [] -> continue $ reload j d $ setDepth 9 st'
Vty.EvKey (Vty.KChar '0') [] -> continue $ reload' d $ setDepth 0 st Vty.EvKey (Vty.KChar '0') [] -> continue $ reload j d $ setDepth 0 st'
Vty.EvKey (Vty.KChar 'f') [] -> continue $ reload' d $ st' Vty.EvKey (Vty.KChar 'f') [] -> continue $ reload j d $ st''
where where
st' = st{ st'' = st'{
aopts=(aopts st){ aopts=(aopts st'){
cliopts_=copts{ cliopts_=copts{
reportopts_=toggleFlatMode ropts reportopts_=toggleFlatMode ropts
} }
} }
} }
Vty.EvKey (Vty.KLeft) [] -> continue $ popScreen st Vty.EvKey (Vty.KLeft) [] -> continue $ popScreen st'
Vty.EvKey (k) [] | k `elem` [Vty.KRight, Vty.KEnter] -> do Vty.EvKey (k) [] | k `elem` [Vty.KRight, Vty.KEnter] -> do
let st' = screenEnter d RS.screen{rsAcct=acct} st let st'' = screenEnter d RS.screen{rsAcct=selacct'} st'
vScrollToBeginning $ viewportScroll "register" vScrollToBeginning $ viewportScroll "register"
continue st' continue st''
-- Vty.EvKey (Vty.KPageDown) [] -> continue $ st{aScreen=scr{asState=moveSel h l}}
-- Vty.EvKey (Vty.KPageUp) [] -> continue $ st{aScreen=scr{asState=moveSel (-h) l}}
-- fall through to the list's event handler (handles up/down) -- fall through to the list's event handler (handles up/down)
ev -> do ev -> do
l' <- handleEvent ev l l' <- handleEvent ev l
continue $ st{aScreen=scr{asState=l'}} continue $ st'{aScreen=scr{asState=(l',selacct')}}
-- continue =<< handleEventLensed st someLens ev -- continue =<< handleEventLensed st' someLens ev
handleAccountsScreen _ _ = error "event handler called with wrong screen type, should not happen" handleAccountsScreen _ _ = error "event handler called with wrong screen type, should not happen"
-- | Toggle between flat and tree mode. If in the third "default" mode, go to flat mode. -- | Toggle between flat and tree mode. If in the third "default" mode, go to flat mode.

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

@ -102,13 +102,16 @@ runBrickUi uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}} j = do
-- Initialising the accounts screen is awkward, requiring -- Initialising the accounts screen is awkward, requiring
-- another temporary AppState value.. -- another temporary AppState value..
ascr' = aScreen $ ascr' = aScreen $
AS.initAccountsScreen (Just acct) d -- acct will be selected AS.initAccountsScreen d $
AppState{ AppState{
aopts=uopts' aopts=uopts'
,ajournal=j ,ajournal=j
,aScreen=AS.screen ,aScreen=setAccountsScreenSelection acct AS.screen
,aPrevScreens=[] ,aPrevScreens=[]
} }
-- ugh
setAccountsScreenSelection a scr@AccountsScreen{asState=(l,_)} = scr{asState=(l,a)}
setAccountsScreenSelection _ scr = scr
st = (sInitFn scr) d st = (sInitFn scr) d
AppState{ AppState{

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

@ -25,13 +25,15 @@ data AppState = AppState {
-- of their state (which must have unique accessor names). -- of their state (which must have unique accessor names).
data Screen = data Screen =
AccountsScreen { AccountsScreen {
asState :: List (Int,String,String,[String]) -- ^ list of (indent level, full account name, full or short account name to display, rendered amounts) asState :: (List (Int,String,String,[String]), AccountName) -- ^ list widget holding (indent level, full account name, full or short account name to display, rendered amounts);
-- the currently selected account's full name (or "")
,sInitFn :: Day -> AppState -> AppState -- ^ function to initialise the screen's state on entry ,sInitFn :: Day -> AppState -> AppState -- ^ function to initialise the screen's state on entry
,sHandleFn :: AppState -> V.Event -> EventM (Next AppState) -- ^ brick event handler to use for this screen ,sHandleFn :: AppState -> V.Event -> EventM (Next AppState) -- ^ brick event handler to use for this screen
,sDrawFn :: AppState -> [Widget] -- ^ brick renderer to use for this screen ,sDrawFn :: AppState -> [Widget] -- ^ brick renderer to use for this screen
} }
| RegisterScreen { | RegisterScreen {
rsState :: List (String,String,String,String,String) -- ^ list of (date, description, other accts, change amt, balance amt) rsState :: List (String,String,String,String,String) -- ^ list widget holding (date, description, other accts, change amt, balance amt)
-- XXX move into rsState ?
,rsAcct :: AccountName -- ^ the account we are showing a register for ,rsAcct :: AccountName -- ^ the account we are showing a register for
,sInitFn :: Day -> AppState -> AppState ,sInitFn :: Day -> AppState -> AppState
,sHandleFn :: AppState -> V.Event -> EventM (Next AppState) ,sHandleFn :: AppState -> V.Event -> EventM (Next AppState)