From a3ea0540289d579fe3da670181f6c53573f98dd7 Mon Sep 17 00:00:00 2001 From: Simon Michael Date: Thu, 8 Sep 2022 12:46:02 -1000 Subject: [PATCH] dev: ui: bs: reuse AccountsScreenState --- hledger-ui/Hledger/UI/BalancesheetScreen.hs | 46 ++++++++++----------- hledger-ui/Hledger/UI/UIScreens.hs | 24 +++++------ hledger-ui/Hledger/UI/UITypes.hs | 11 +---- 3 files changed, 37 insertions(+), 44 deletions(-) diff --git a/hledger-ui/Hledger/UI/BalancesheetScreen.hs b/hledger-ui/Hledger/UI/BalancesheetScreen.hs index 489d543c8..8172d7656 100644 --- a/hledger-ui/Hledger/UI/BalancesheetScreen.hs +++ b/hledger-ui/Hledger/UI/BalancesheetScreen.hs @@ -60,7 +60,7 @@ bsDraw UIState{aopts=_uopts@UIOpts{uoCliOpts=copts@CliOpts{reportspec_=rspec}} -- ltrace "availwidth" $ c^.availWidthL - 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 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) | otherwise = (adjustedacctwidth, adjustedbalwidth) - render $ defaultLayout toplabel bottomlabel $ renderList (bsDrawItem colwidths) True (sst ^. bssList) + render $ defaultLayout toplabel bottomlabel $ renderList (bsDrawItem colwidths) True (sst ^. assList) where 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 [] ] mdepth = depth_ ropts - curidx = case sst ^. bssList . listSelectedL of + curidx = case sst ^. assList . listSelectedL of Nothing -> "-" Just i -> show (i + 1) totidx = show $ V.length nonblanks 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 Minibuffer label ed -> minibuffer label ed @@ -174,11 +174,11 @@ bsHandle ev = do let -- 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 - Nothing -> sst ^. bssSelectedAccount - ui = ui1{aScreen=BS sst{_bssSelectedAccount=selacct}} - nonblanks = V.takeWhile (not . T.null . asItemAccountName) $ listElements $ _bssList sst + Nothing -> sst ^. assSelectedAccount + ui = ui1{aScreen=BS sst{_assSelectedAccount=selacct}} + nonblanks = V.takeWhile (not . T.null . asItemAccountName) $ listElements $ _assList sst lastnonblankidx = max 0 (length nonblanks - 1) journalspan = journalDateSpan False j d <- liftIO getCurrentDay @@ -260,7 +260,7 @@ bsHandle ev = do 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 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 -- exit screen on LEFT @@ -272,45 +272,45 @@ bsHandle ev = do -- centering its selected transaction if possible -- XXX should propagate ropts{balanceaccum_=Historical} 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 -- just use it to move the selection MouseDown _n BLeft _mods Location{loc=(_x,y)} | not $ (=="") clickedacct -> do 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 MouseUp _n (Just BLeft) Location{loc=(_x,y)} | not $ (=="") clickedacct -> do 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 VtyEvent e | e `elem` moveDownEvents, isBlankElement mnextelement -> do - vScrollBy (viewportScroll $ (_bssList sst)^.listNameL) 1 - where mnextelement = listSelectedElement $ listMoveDown (_bssList sst) + vScrollBy (viewportScroll $ (_assList sst)^.listNameL) 1 + where mnextelement = listSelectedElement $ listMoveDown (_assList sst) -- mouse scroll wheel scrolls the viewport up or down to its maximum extent, -- pushing the selection when necessary. MouseDown name btn _mods _loc | btn `elem` [BScrollUp, BScrollDown] -> do let scrollamt = if btn==BScrollUp then -1 else 1 - list' <- nestEventM' (_bssList sst) $ listScrollPushingSelection name (bsListSize (_bssList sst)) scrollamt - put' ui{aScreen=BS sst{_bssList=list'}} + list' <- nestEventM' (_assList sst) $ listScrollPushingSelection name (bsListSize (_assList sst)) scrollamt + put' ui{aScreen=BS sst{_assList=list'}} -- 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 - l <- nestEventM' (_bssList sst) $ handleListEvent e + l <- nestEventM' (_assList sst) $ handleListEvent e if isBlankElement $ listSelectedElement l then do let l' = listMoveTo lastnonblankidx l scrollSelectionToMiddle l' - put' ui{aScreen=BS sst{_bssList=l'}} + put' ui{aScreen=BS sst{_assList=l'}} 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) VtyEvent e -> do - list' <- nestEventM' (_bssList sst) $ handleListEvent (normaliseMovementKeys e) - put' ui{aScreen=BS $ sst & bssList .~ list' & bssSelectedAccount .~ selacct } + list' <- nestEventM' (_assList sst) $ handleListEvent (normaliseMovementKeys e) + put' ui{aScreen=BS $ sst & assList .~ list' & assSelectedAccount .~ selacct } MouseDown{} -> 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. 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 isBlankElement mel = ((asItemAccountName . snd) <$> mel) == Just "" @@ -342,7 +342,7 @@ bsCenterAndContinue :: EventM Name UIState () bsCenterAndContinue = do ui <- get' case aScreen ui of - BS sst -> scrollSelectionToMiddle $ _bssList sst + BS sst -> scrollSelectionToMiddle $ _assList sst _ -> return () bsListSize = V.length . V.takeWhile ((/="").asItemAccountName) . listElements diff --git a/hledger-ui/Hledger/UI/UIScreens.hs b/hledger-ui/Hledger/UI/UIScreens.hs index 92f693955..811e445a0 100644 --- a/hledger-ui/Hledger/UI/UIScreens.hs +++ b/hledger-ui/Hledger/UI/UIScreens.hs @@ -48,12 +48,12 @@ import Data.Function ((&)) -- | Regenerate the content of any screen from new options, reporting date and journal. screenUpdate :: UIOpts -> Day -> Journal -> Screen -> Screen screenUpdate opts d j = \case - MS mss -> MS $ msUpdate mss -- opts d j ass - AS ass -> AS $ asUpdate opts d j ass - BS bss -> BS $ bsUpdate opts d j bss - RS rss -> RS $ rsUpdate opts d j rss - TS tss -> TS $ tsUpdate tss - ES ess -> ES $ esUpdate ess + MS sst -> MS $ msUpdate sst -- opts d j ass + AS sst -> AS $ asUpdate opts d j sst + BS sst -> BS $ asUpdate opts d j sst + RS sst -> RS $ rsUpdate opts d j sst + TS sst -> TS $ tsUpdate sst + ES sst -> ES $ esUpdate sst -- | Construct an error screen. -- Screen-specific arguments: the error message to show. @@ -161,14 +161,14 @@ bsNew uopts d j macct = dlogUiTrace "bsNew" $ BS $ bsUpdate uopts d j $ - BSS { - _bssSelectedAccount = fromMaybe "" macct - ,_bssList = list AccountsList (V.fromList []) 1 -- reusing widget name.. + ASS { + _assSelectedAccount = fromMaybe "" macct + ,_assList = list AccountsList (V.fromList []) 1 } -- | Update a balance sheet screen from these options, reporting date, and journal. -bsUpdate :: UIOpts -> Day -> Journal -> BalancesheetScreenState -> BalancesheetScreenState -bsUpdate uopts d j bss = dlogUiTrace "bsUpdate" bss{_bssList=l} +bsUpdate :: UIOpts -> Day -> Journal -> AccountsScreenState -> AccountsScreenState +bsUpdate uopts d j ass = dlogUiTrace "bsUpdate" ass{_assList=l} where UIOpts{uoCliOpts=copts@CliOpts{reportspec_=rspec@ReportSpec{_rsReportOpts=ropts}}} = uopts -- 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) ] where - a = _bssSelectedAccount bss + a = _assSelectedAccount ass as = map asItemAccountName displayitems displayitems = map displayitem items diff --git a/hledger-ui/Hledger/UI/UITypes.hs b/hledger-ui/Hledger/UI/UITypes.hs index 0fa48aa56..275010b90 100644 --- a/hledger-ui/Hledger/UI/UITypes.hs +++ b/hledger-ui/Hledger/UI/UITypes.hs @@ -173,7 +173,7 @@ data ScreenName = data Screen = MS MenuScreenState | AS AccountsScreenState - | BS BalancesheetScreenState + | BS AccountsScreenState | RS RegisterScreenState | TS TransactionScreenState | ES ErrorScreenState @@ -185,6 +185,7 @@ data MenuScreenState = MSS { ,_mssUnused :: () -- ^ dummy field to silence warning } deriving (Show) +-- Used for the accounts screen and similar screens. data AccountsScreenState = ASS { -- screen parameters: _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 } 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 { -- screen parameters: _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 makeLenses ''MenuScreenState makeLenses ''AccountsScreenState -makeLenses ''BalancesheetScreenState makeLenses ''RegisterScreenState makeLenses ''TransactionScreenState makeLenses ''ErrorScreenState