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

dev: ui: bs: reuse AccountsScreenState

Browse Source
This commit is contained in:
Simon Michael 2022-09-08 12:46:02 -10:00
parent 90703dcd84
commit a3ea054028
3 changed files with 37 additions and 44 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

46
hledger-ui/Hledger/UI/BalancesheetScreen.hs
View File

@ -60,7 +60,7 @@ bsDraw UIState{aopts=_uopts@UIOpts{uoCliOpts=copts@CliOpts{reportspec_=rspec}}
-- ltrace "availwidth" $ -- ltrace "availwidth" $
c^.availWidthL c^.availWidthL
- 2 -- XXX due to margin ? shouldn't be necessary (cf UIUtils) - 2 -- XXX due to margin ? shouldn't be necessary (cf UIUtils)
displayitems = sst ^. bssList . listElementsL displayitems = sst ^. assList . listElementsL
acctwidths = V.map (\AccountsScreenItem{..} -> asItemIndentLevel + realLength asItemDisplayAccountName) displayitems acctwidths = V.map (\AccountsScreenItem{..} -> asItemIndentLevel + realLength asItemDisplayAccountName) displayitems
balwidths = V.map (maybe 0 (wbWidth . showMixedAmountB oneLine) . asItemMixedAmount) displayitems balwidths = V.map (maybe 0 (wbWidth . showMixedAmountB oneLine) . asItemMixedAmount) displayitems
@ -80,7 +80,7 @@ bsDraw UIState{aopts=_uopts@UIOpts{uoCliOpts=copts@CliOpts{reportspec_=rspec}}
colwidths | shortfall <= 0 = (preferredacctwidth, preferredbalwidth) colwidths | shortfall <= 0 = (preferredacctwidth, preferredbalwidth)
| otherwise = (adjustedacctwidth, adjustedbalwidth) | otherwise = (adjustedacctwidth, adjustedbalwidth)
render $ defaultLayout toplabel bottomlabel $ renderList (bsDrawItem colwidths) True (sst ^. bssList) render $ defaultLayout toplabel bottomlabel $ renderList (bsDrawItem colwidths) True (sst ^. assList)
where where
ropts = (_rsReportOpts rspec){balanceaccum_=Historical} ropts = (_rsReportOpts rspec){balanceaccum_=Historical}
@ -110,12 +110,12 @@ bsDraw UIState{aopts=_uopts@UIOpts{uoCliOpts=copts@CliOpts{reportspec_=rspec}}
,if real_ ropts then ["real"] else [] ,if real_ ropts then ["real"] else []
] ]
mdepth = depth_ ropts mdepth = depth_ ropts
curidx = case sst ^. bssList . listSelectedL of curidx = case sst ^. assList . listSelectedL of
Nothing -> "-" Nothing -> "-"
Just i -> show (i + 1) Just i -> show (i + 1)
totidx = show $ V.length nonblanks totidx = show $ V.length nonblanks
where where
nonblanks = V.takeWhile (not . T.null . asItemAccountName) $ sst ^. bssList . listElementsL nonblanks = V.takeWhile (not . T.null . asItemAccountName) $ sst ^. assList . listElementsL
bottomlabel = case mode of bottomlabel = case mode of
Minibuffer label ed -> minibuffer label ed Minibuffer label ed -> minibuffer label ed
@ -174,11 +174,11 @@ bsHandle ev = do
let let
-- save the currently selected account, in case we leave this screen and lose the selection -- save the currently selected account, in case we leave this screen and lose the selection
selacct = case listSelectedElement $ _bssList sst of selacct = case listSelectedElement $ _assList sst of
Just (_, AccountsScreenItem{..}) -> asItemAccountName Just (_, AccountsScreenItem{..}) -> asItemAccountName
Nothing -> sst ^. bssSelectedAccount Nothing -> sst ^. assSelectedAccount
ui = ui1{aScreen=BS sst{_bssSelectedAccount=selacct}} ui = ui1{aScreen=BS sst{_assSelectedAccount=selacct}}
nonblanks = V.takeWhile (not . T.null . asItemAccountName) $ listElements $ _bssList sst nonblanks = V.takeWhile (not . T.null . asItemAccountName) $ listElements $ _assList sst
lastnonblankidx = max 0 (length nonblanks - 1) lastnonblankidx = max 0 (length nonblanks - 1)
journalspan = journalDateSpan False j journalspan = journalDateSpan False j
d <- liftIO getCurrentDay d <- liftIO getCurrentDay
@ -260,7 +260,7 @@ bsHandle ev = do
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 (_bssList sst) >> redraw VtyEvent (EvKey (KChar 'l') [MCtrl]) -> scrollSelectionToMiddle (_assList sst) >> redraw
VtyEvent (EvKey (KChar 'z') [MCtrl]) -> suspend ui VtyEvent (EvKey (KChar 'z') [MCtrl]) -> suspend ui
-- exit screen on LEFT -- exit screen on LEFT
@ -272,45 +272,45 @@ bsHandle ev = do
-- centering its selected transaction if possible -- centering its selected transaction if possible
-- XXX should propagate ropts{balanceaccum_=Historical} -- XXX should propagate ropts{balanceaccum_=Historical}
VtyEvent e | e `elem` moveRightEvents VtyEvent e | e `elem` moveRightEvents
, not $ isBlankElement $ listSelectedElement (_bssList sst) -> bsEnterRegisterScreen d selacct ui , not $ isBlankElement $ listSelectedElement (_assList sst) -> bsEnterRegisterScreen 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
put' ui{aScreen=BS sst} -- XXX does this do anything ? put' ui{aScreen=BS sst} -- XXX does this do anything ?
where clickedacct = maybe "" asItemAccountName $ listElements (_bssList sst) !? y where clickedacct = maybe "" asItemAccountName $ listElements (_assList sst) !? 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
bsEnterRegisterScreen d clickedacct ui bsEnterRegisterScreen d clickedacct ui
where clickedacct = maybe "" asItemAccountName $ listElements (_bssList sst) !? y where clickedacct = maybe "" asItemAccountName $ listElements (_assList sst) !? 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 $ (_bssList sst)^.listNameL) 1 vScrollBy (viewportScroll $ (_assList sst)^.listNameL) 1
where mnextelement = listSelectedElement $ listMoveDown (_bssList sst) where mnextelement = listSelectedElement $ listMoveDown (_assList sst)
-- 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' (_bssList sst) $ listScrollPushingSelection name (bsListSize (_bssList sst)) scrollamt list' <- nestEventM' (_assList sst) $ listScrollPushingSelection name (bsListSize (_assList sst)) scrollamt
put' ui{aScreen=BS sst{_bssList=list'}} put' ui{aScreen=BS sst{_assList=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
l <- nestEventM' (_bssList sst) $ handleListEvent e l <- nestEventM' (_assList sst) $ handleListEvent e
if isBlankElement $ listSelectedElement l if isBlankElement $ listSelectedElement l
then do then do
let l' = listMoveTo lastnonblankidx l let l' = listMoveTo lastnonblankidx l
scrollSelectionToMiddle l' scrollSelectionToMiddle l'
put' ui{aScreen=BS sst{_bssList=l'}} put' ui{aScreen=BS sst{_assList=l'}}
else else
put' ui{aScreen=BS sst{_bssList=l}} put' ui{aScreen=BS sst{_assList=l}}
-- fall through to the list's event handler (handles up/down) -- fall through to the list's event handler (handles up/down)
VtyEvent e -> do VtyEvent e -> do
list' <- nestEventM' (_bssList sst) $ handleListEvent (normaliseMovementKeys e) list' <- nestEventM' (_assList sst) $ handleListEvent (normaliseMovementKeys e)
put' ui{aScreen=BS $ sst & bssList .~ list' & bssSelectedAccount .~ selacct } put' ui{aScreen=BS $ sst & assList .~ list' & assSelectedAccount .~ selacct }
MouseDown{} -> return () MouseDown{} -> return ()
MouseUp{} -> return () MouseUp{} -> return ()
@ -332,7 +332,7 @@ bsEnterRegisterScreen d acct ui@UIState{ajournal=j, aopts=uopts} = do
-- | Set the selected account on an accounts screen. No effect on other screens. -- | Set the selected account on an accounts screen. No effect on other screens.
bsSetSelectedAccount :: AccountName -> Screen -> Screen bsSetSelectedAccount :: AccountName -> Screen -> Screen
bsSetSelectedAccount a (BS bss@BSS{}) = BS bss{_bssSelectedAccount=a} bsSetSelectedAccount a (BS sst@ASS{}) = BS sst{_assSelectedAccount=a}
bsSetSelectedAccount _ s = s bsSetSelectedAccount _ s = s
isBlankElement mel = ((asItemAccountName . snd) <$> mel) == Just "" isBlankElement mel = ((asItemAccountName . snd) <$> mel) == Just ""
@ -342,7 +342,7 @@ bsCenterAndContinue :: EventM Name UIState ()
bsCenterAndContinue = do bsCenterAndContinue = do
ui <- get' ui <- get'
case aScreen ui of case aScreen ui of
BS sst -> scrollSelectionToMiddle $ _bssList sst BS sst -> scrollSelectionToMiddle $ _assList sst
_ -> return () _ -> return ()
bsListSize = V.length . V.takeWhile ((/="").asItemAccountName) . listElements bsListSize = V.length . V.takeWhile ((/="").asItemAccountName) . listElements

24
hledger-ui/Hledger/UI/UIScreens.hs
View File

@ -48,12 +48,12 @@ import Data.Function ((&))
-- | Regenerate the content of any screen from new options, reporting date and journal. -- | Regenerate the content of any screen from new options, reporting date and journal.
screenUpdate :: UIOpts -> Day -> Journal -> Screen -> Screen screenUpdate :: UIOpts -> Day -> Journal -> Screen -> Screen
screenUpdate opts d j = \case screenUpdate opts d j = \case
MS mss -> MS $ msUpdate mss -- opts d j ass MS sst -> MS $ msUpdate sst -- opts d j ass
AS ass -> AS $ asUpdate opts d j ass AS sst -> AS $ asUpdate opts d j sst
BS bss -> BS $ bsUpdate opts d j bss BS sst -> BS $ asUpdate opts d j sst
RS rss -> RS $ rsUpdate opts d j rss RS sst -> RS $ rsUpdate opts d j sst
TS tss -> TS $ tsUpdate tss TS sst -> TS $ tsUpdate sst
ES ess -> ES $ esUpdate ess ES sst -> ES $ esUpdate sst
-- | Construct an error screen. -- | Construct an error screen.
-- Screen-specific arguments: the error message to show. -- Screen-specific arguments: the error message to show.
@ -161,14 +161,14 @@ bsNew uopts d j macct =
dlogUiTrace "bsNew" $ dlogUiTrace "bsNew" $
BS $ BS $
bsUpdate uopts d j $ bsUpdate uopts d j $
BSS { ASS {
_bssSelectedAccount = fromMaybe "" macct _assSelectedAccount = fromMaybe "" macct
,_bssList = list AccountsList (V.fromList []) 1 -- reusing widget name.. ,_assList = list AccountsList (V.fromList []) 1
} }
-- | Update a balance sheet screen from these options, reporting date, and journal. -- | Update a balance sheet screen from these options, reporting date, and journal.
bsUpdate :: UIOpts -> Day -> Journal -> BalancesheetScreenState -> BalancesheetScreenState bsUpdate :: UIOpts -> Day -> Journal -> AccountsScreenState -> AccountsScreenState
bsUpdate uopts d j bss = dlogUiTrace "bsUpdate" bss{_bssList=l} bsUpdate uopts d j ass = dlogUiTrace "bsUpdate" ass{_assList=l}
where where
UIOpts{uoCliOpts=copts@CliOpts{reportspec_=rspec@ReportSpec{_rsReportOpts=ropts}}} = uopts UIOpts{uoCliOpts=copts@CliOpts{reportspec_=rspec@ReportSpec{_rsReportOpts=ropts}}} = uopts
-- decide which account is selected: -- decide which account is selected:
@ -186,7 +186,7 @@ bsUpdate uopts d j bss = dlogUiTrace "bsUpdate" bss{_bssList=l}
,Just $ max 0 (length (filter (< a) as) - 1) ,Just $ max 0 (length (filter (< a) as) - 1)
] ]
where where
a = _bssSelectedAccount bss a = _assSelectedAccount ass
as = map asItemAccountName displayitems as = map asItemAccountName displayitems
displayitems = map displayitem items displayitems = map displayitem items

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

@ -173,7 +173,7 @@ data ScreenName =
data Screen = data Screen =
MS MenuScreenState MS MenuScreenState
| AS AccountsScreenState | AS AccountsScreenState
| BS BalancesheetScreenState | BS AccountsScreenState
| RS RegisterScreenState | RS RegisterScreenState
| TS TransactionScreenState | TS TransactionScreenState
| ES ErrorScreenState | ES ErrorScreenState
@ -185,6 +185,7 @@ data MenuScreenState = MSS {
,_mssUnused :: () -- ^ dummy field to silence warning ,_mssUnused :: () -- ^ dummy field to silence warning
} deriving (Show) } deriving (Show)
-- Used for the accounts screen and similar screens.
data AccountsScreenState = ASS { data AccountsScreenState = ASS {
-- screen parameters: -- screen parameters:
_assSelectedAccount :: AccountName -- ^ a copy of the account name from the list's selected item (or "") _assSelectedAccount :: AccountName -- ^ a copy of the account name from the list's selected item (or "")
@ -192,13 +193,6 @@ data AccountsScreenState = ASS {
,_assList :: List Name AccountsScreenItem -- ^ list widget showing account names & balances ,_assList :: List Name AccountsScreenItem -- ^ list widget showing account names & balances
} deriving (Show) } deriving (Show)
data BalancesheetScreenState = BSS {
-- screen parameters:
_bssSelectedAccount :: AccountName -- ^ a copy of the account name from the list's selected item (or "")
-- view data derived from options, reporting date, journal, and screen parameters:
,_bssList :: List Name AccountsScreenItem -- ^ list widget showing account names & balances
} deriving (Show)
data RegisterScreenState = RSS { data RegisterScreenState = RSS {
-- screen parameters: -- screen parameters:
_rssAccount :: AccountName -- ^ the account this register is for _rssAccount :: AccountName -- ^ the account this register is for
@ -255,7 +249,6 @@ type NumberedTransaction = (Integer, Transaction)
-- XXX foo fields producing fooL lenses would be preferable -- XXX foo fields producing fooL lenses would be preferable
makeLenses ''MenuScreenState makeLenses ''MenuScreenState
makeLenses ''AccountsScreenState makeLenses ''AccountsScreenState
makeLenses ''BalancesheetScreenState
makeLenses ''RegisterScreenState makeLenses ''RegisterScreenState
makeLenses ''TransactionScreenState makeLenses ''TransactionScreenState
makeLenses ''ErrorScreenState makeLenses ''ErrorScreenState