From a3c071613343d3b092d182ea9aafd2e86ca48c44 Mon Sep 17 00:00:00 2001 From: Simon Michael Date: Thu, 8 Sep 2022 13:42:29 -1000 Subject: [PATCH] dev: ui: as, bs: reuse update, draw code --- hledger-ui/Hledger/UI/AccountsScreen.hs | 39 +++--- hledger-ui/Hledger/UI/BalancesheetScreen.hs | 124 +------------------- hledger-ui/Hledger/UI/ErrorScreen.hs | 5 +- hledger-ui/Hledger/UI/MenuScreen.hs | 2 +- hledger-ui/Hledger/UI/RegisterScreen.hs | 2 +- hledger-ui/Hledger/UI/TransactionScreen.hs | 2 +- hledger-ui/Hledger/UI/UIScreens.hs | 107 +++++------------ hledger-ui/Hledger/UI/UIUtils.hs | 5 +- 8 files changed, 68 insertions(+), 218 deletions(-) diff --git a/hledger-ui/Hledger/UI/AccountsScreen.hs b/hledger-ui/Hledger/UI/AccountsScreen.hs index 1efd923b8..e47707e8d 100644 --- a/hledger-ui/Hledger/UI/AccountsScreen.hs +++ b/hledger-ui/Hledger/UI/AccountsScreen.hs @@ -8,6 +8,7 @@ module Hledger.UI.AccountsScreen (asNew ,asUpdate ,asDraw + ,asDrawHelper ,asHandle ,asSetSelectedAccount ) @@ -31,7 +32,7 @@ import System.FilePath (takeFileName) import Text.DocLayout (realLength) import Hledger -import Hledger.Cli hiding (mode, progname, prognameandversion) +import Hledger.Cli hiding (Mode, mode, progname, prognameandversion) import Hledger.UI.UIOptions import Hledger.UI.UITypes import Hledger.UI.UIState @@ -43,16 +44,26 @@ import Hledger.UI.RegisterScreen (rsCenterSelection) asDraw :: UIState -> [Widget Name] -asDraw UIState{aopts=_uopts@UIOpts{uoCliOpts=copts@CliOpts{reportspec_=rspec}} - ,ajournal=j - ,aScreen=AS sst - ,aMode=mode - } = dlogUiTrace "asDraw 1" $ - case mode of - Help -> [helpDialog copts, maincontent] - -- Minibuffer e -> [minibuffer e, maincontent] - _ -> [maincontent] +asDraw ui = dlogUiTrace "asDraw 1" $ asDrawHelper ui ropts' scrname showbalchgkey where + ropts' = _rsReportOpts $ reportspec_ $ uoCliOpts $ aopts ui + scrname = "account " ++ if ishistorical then "balances" else "changes" + where ishistorical = balanceaccum_ ropts' == Historical + showbalchgkey = True + +-- | Draw an accounts-screen-like screen. +-- The provided ReportOpts are used instead of the ones in the UIState. +-- The other arguments are the screen display name and whether to show a key +-- for toggling between end balance and balance change mode. +asDrawHelper :: UIState -> ReportOpts -> String -> Bool -> [Widget Name] +asDrawHelper UIState{aopts=uopts, ajournal=j, aScreen=AS sst, aMode=mode} ropts scrname showbalchgkey = + dlogUiTrace "asDraw 1" $ + case mode of + Help -> [helpDialog, maincontent] + -- Minibuffer e -> [minibuffer e, maincontent] + _ -> [maincontent] + where + UIOpts{uoCliOpts=copts} = uopts maincontent = Widget Greedy Greedy $ do c <- getContext let @@ -83,13 +94,12 @@ asDraw UIState{aopts=_uopts@UIOpts{uoCliOpts=copts@CliOpts{reportspec_=rspec}} render $ defaultLayout toplabel bottomlabel $ renderList (asDrawItem colwidths) True (sst ^. assList) where - ropts = _rsReportOpts rspec ishistorical = balanceaccum_ ropts == Historical toplabel = withAttr (attrName "border" <> attrName "filename") files <+> toggles - <+> str (" account " ++ if ishistorical then "balances" else "changes") + <+> str (" " ++ scrname) <+> borderPeriodStr (if ishistorical then "at end of" else "in") (period_ ropts) <+> borderQueryStr (T.unpack . T.unwords . map textQuoteIfNeeded $ querystring_ ropts) <+> borderDepthStr mdepth @@ -128,7 +138,7 @@ asDraw UIState{aopts=_uopts@UIOpts{uoCliOpts=copts@CliOpts{reportspec_=rspec}} -- ,("t", str "tree") -- ,("l", str "list") ,("-+", str "depth") - ,("H", renderToggle (not ishistorical) "end-bals" "changes") + ,(if showbalchgkey then "H" else "", renderToggle (not ishistorical) "end-bals" "changes") ,("F", renderToggle1 (isJust . forecast_ $ inputopts_ copts) "forecast") --,("/", "filter") --,("DEL", "unfilter") @@ -137,8 +147,7 @@ asDraw UIState{aopts=_uopts@UIOpts{uoCliOpts=copts@CliOpts{reportspec_=rspec}} -- ,("g", "reload") ,("q", str "quit") ] - -asDraw _ = dlogUiTrace "asDraw 2" $ errorWrongScreenType "draw function" -- PARTIAL: +asDrawHelper _ _ _ _ = dlogUiTrace "asDrawHelper" $ errorWrongScreenType "draw function" -- PARTIAL: asDrawItem :: (Int,Int) -> Bool -> AccountsScreenItem -> Widget Name asDrawItem (acctwidth, balwidth) selected AccountsScreenItem{..} = diff --git a/hledger-ui/Hledger/UI/BalancesheetScreen.hs b/hledger-ui/Hledger/UI/BalancesheetScreen.hs index 8172d7656..13c938b3f 100644 --- a/hledger-ui/Hledger/UI/BalancesheetScreen.hs +++ b/hledger-ui/Hledger/UI/BalancesheetScreen.hs @@ -18,8 +18,6 @@ import Brick.Widgets.List import Brick.Widgets.Edit import Control.Monad import Control.Monad.IO.Class (liftIO) -import Data.List hiding (reverse) -import Data.Maybe import qualified Data.Text as T import Data.Time.Calendar (Day) import qualified Data.Vector as V @@ -27,8 +25,6 @@ import Data.Vector ((!?)) import Graphics.Vty (Event(..),Key(..),Modifier(..), Button (BLeft, BScrollDown, BScrollUp)) import Lens.Micro.Platform import System.Console.ANSI -import System.FilePath (takeFileName) -import Text.DocLayout (realLength) import Hledger import Hledger.Cli hiding (mode, progname, prognameandversion) @@ -39,126 +35,16 @@ import Hledger.UI.UIUtils import Hledger.UI.UIScreens import Hledger.UI.Editor import Hledger.UI.ErrorScreen (uiReloadJournal, uiCheckBalanceAssertions, uiReloadJournalIfChanged) +import Hledger.UI.AccountsScreen (asDrawHelper) import Hledger.UI.RegisterScreen (rsCenterSelection) bsDraw :: UIState -> [Widget Name] -bsDraw UIState{aopts=_uopts@UIOpts{uoCliOpts=copts@CliOpts{reportspec_=rspec}} - ,ajournal=j - ,aScreen=BS sst - ,aMode=mode - } = dlogUiTrace "bsDraw 1" $ - case mode of - Help -> [helpDialog copts, maincontent] - -- Minibuffer e -> [minibuffer e, maincontent] - _ -> [maincontent] +bsDraw ui = dlogUiTrace "bsDraw" $ asDrawHelper ui ropts' scrname showbalchgkey where - maincontent = Widget Greedy Greedy $ do - c <- getContext - let - availwidth = - -- ltrace "availwidth" $ - c^.availWidthL - - 2 -- XXX due to margin ? shouldn't be necessary (cf UIUtils) - displayitems = sst ^. assList . listElementsL - - acctwidths = V.map (\AccountsScreenItem{..} -> asItemIndentLevel + realLength asItemDisplayAccountName) displayitems - balwidths = V.map (maybe 0 (wbWidth . showMixedAmountB oneLine) . asItemMixedAmount) displayitems - preferredacctwidth = V.maximum acctwidths - totalacctwidthseen = V.sum acctwidths - preferredbalwidth = V.maximum balwidths - totalbalwidthseen = V.sum balwidths - - totalwidthseen = totalacctwidthseen + totalbalwidthseen - shortfall = preferredacctwidth + preferredbalwidth + 2 - availwidth - acctwidthproportion = fromIntegral totalacctwidthseen / fromIntegral totalwidthseen - adjustedacctwidth = min preferredacctwidth . max 15 . round $ acctwidthproportion * fromIntegral (availwidth - 2) -- leave 2 whitespace for padding - adjustedbalwidth = availwidth - 2 - adjustedacctwidth - - -- XXX how to minimise the balance column's jumping around as you change the depth limit ? - - colwidths | shortfall <= 0 = (preferredacctwidth, preferredbalwidth) - | otherwise = (adjustedacctwidth, adjustedbalwidth) - - render $ defaultLayout toplabel bottomlabel $ renderList (bsDrawItem colwidths) True (sst ^. assList) - - where - ropts = (_rsReportOpts rspec){balanceaccum_=Historical} - ishistorical = balanceaccum_ ropts == Historical - - toplabel = - withAttr (attrName "border" <> attrName "filename") files - <+> toggles - <+> str (" balance sheet") - <+> borderPeriodStr (if ishistorical then "at end of" else "in") (period_ ropts) - <+> borderQueryStr (T.unpack . T.unwords . map textQuoteIfNeeded $ querystring_ ropts) - <+> borderDepthStr mdepth - <+> str (" ("++curidx++"/"++totidx++")") - <+> (if ignore_assertions_ . balancingopts_ $ inputopts_ copts - then withAttr (attrName "border" <> attrName "query") (str " ignoring balance assertions") - else str "") - where - files = case journalFilePaths j of - [] -> str "" - f:_ -> str $ takeFileName f - -- [f,_:[]] -> (withAttr ("border" <> "bold") $ str $ takeFileName f) <+> str " (& 1 included file)" - -- f:fs -> (withAttr ("border" <> "bold") $ str $ takeFileName f) <+> str (" (& " ++ show (length fs) ++ " included files)") - toggles = withAttr (attrName "border" <> attrName "query") $ str $ unwords $ concat [ - [""] - ,if empty_ ropts then [] else ["nonzero"] - ,uiShowStatus copts $ statuses_ ropts - ,if real_ ropts then ["real"] else [] - ] - mdepth = depth_ ropts - 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 ^. assList . listElementsL - - bottomlabel = case mode of - Minibuffer label ed -> minibuffer label ed - _ -> quickhelp - where - quickhelp = borderKeysStr' [ - ("?", str "help") --- ,("RIGHT", str "register") - ,("t", renderToggle (tree_ ropts) "list" "tree") - -- ,("t", str "tree") - -- ,("l", str "list") - ,("-+", str "depth") - ,("", renderToggle (not ishistorical) "end-bals" "changes") - ,("F", renderToggle1 (isJust . forecast_ $ inputopts_ copts) "forecast") - --,("/", "filter") - --,("DEL", "unfilter") - --,("ESC", "cancel/top") - ,("a", str "add") --- ,("g", "reload") - ,("q", str "quit") - ] - -bsDraw _ = dlogUiTrace "bsDraw 2" $ errorWrongScreenType "draw function" -- PARTIAL: - -bsDrawItem :: (Int,Int) -> Bool -> AccountsScreenItem -> Widget Name -bsDrawItem (acctwidth, balwidth) selected AccountsScreenItem{..} = - Widget Greedy Fixed $ do - -- c <- getContext - -- let showitem = intercalate "\n" . balanceReportItemAsText defreportopts fmt - render $ - txt (fitText (Just acctwidth) (Just acctwidth) True True $ T.replicate (asItemIndentLevel) " " <> asItemDisplayAccountName) <+> - txt balspace <+> - splitAmounts balBuilder - where - balBuilder = maybe mempty showamt asItemMixedAmount - showamt = showMixedAmountB oneLine{displayMinWidth=Just balwidth, displayMaxWidth=Just balwidth} - balspace = T.replicate (2 + balwidth - wbWidth balBuilder) " " - splitAmounts = foldr1 (<+>) . intersperse (str ", ") . map renderamt . T.splitOn ", " . wbToText - renderamt :: T.Text -> Widget Name - renderamt a | T.any (=='-') a = withAttr (sel $ attrName "list" <> attrName "balance" <> attrName "negative") $ txt a - | otherwise = withAttr (sel $ attrName "list" <> attrName "balance" <> attrName "positive") $ txt a - sel | selected = (<> attrName "selected") - | otherwise = id + scrname = "balance sheet" + ropts' = (_rsReportOpts $ reportspec_ $ uoCliOpts $ aopts ui){balanceaccum_=Historical} + showbalchgkey = False bsHandle :: BrickEvent Name AppEvent -> EventM Name UIState () bsHandle ev = do diff --git a/hledger-ui/Hledger/UI/ErrorScreen.hs b/hledger-ui/Hledger/UI/ErrorScreen.hs index e619f56e2..5e0956e1a 100644 --- a/hledger-ui/Hledger/UI/ErrorScreen.hs +++ b/hledger-ui/Hledger/UI/ErrorScreen.hs @@ -36,12 +36,11 @@ import Hledger.UI.UIScreens import Hledger.UI.Editor esDraw :: UIState -> [Widget Name] -esDraw UIState{aopts=UIOpts{uoCliOpts=copts} - ,aScreen=ES ESS{..} +esDraw UIState{aScreen=ES ESS{..} ,aMode=mode } = case mode of - Help -> [helpDialog copts, maincontent] + Help -> [helpDialog, maincontent] -- Minibuffer e -> [minibuffer e, maincontent] _ -> [maincontent] where diff --git a/hledger-ui/Hledger/UI/MenuScreen.hs b/hledger-ui/Hledger/UI/MenuScreen.hs index b4e5fc487..cb185908d 100644 --- a/hledger-ui/Hledger/UI/MenuScreen.hs +++ b/hledger-ui/Hledger/UI/MenuScreen.hs @@ -44,7 +44,7 @@ msDraw UIState{aopts=_uopts@UIOpts{uoCliOpts=copts@CliOpts{reportspec_=_rspec}} ,aMode=mode } = dlogUiTrace "msDraw 1" $ case mode of - Help -> [helpDialog copts, maincontent] + Help -> [helpDialog, maincontent] Minibuffer lbl ed -> [minibuffer lbl ed, maincontent] _ -> [maincontent] where diff --git a/hledger-ui/Hledger/UI/RegisterScreen.hs b/hledger-ui/Hledger/UI/RegisterScreen.hs index e65acb587..42e25631b 100644 --- a/hledger-ui/Hledger/UI/RegisterScreen.hs +++ b/hledger-ui/Hledger/UI/RegisterScreen.hs @@ -47,7 +47,7 @@ rsDraw UIState{aopts=_uopts@UIOpts{uoCliOpts=copts@CliOpts{reportspec_=rspec}} ,aMode=mode } = dlogUiTrace "rsDraw 1" $ case mode of - Help -> [helpDialog copts, maincontent] + Help -> [helpDialog, maincontent] -- Minibuffer e -> [minibuffer e, maincontent] _ -> [maincontent] where diff --git a/hledger-ui/Hledger/UI/TransactionScreen.hs b/hledger-ui/Hledger/UI/TransactionScreen.hs index 00335d970..be9cfa572 100644 --- a/hledger-ui/Hledger/UI/TransactionScreen.hs +++ b/hledger-ui/Hledger/UI/TransactionScreen.hs @@ -42,7 +42,7 @@ tsDraw UIState{aopts=UIOpts{uoCliOpts=copts@CliOpts{reportspec_=rspec@ReportSpec ,aMode=mode } = case mode of - Help -> [helpDialog copts, maincontent] + Help -> [helpDialog, maincontent] -- Minibuffer e -> [minibuffer e, maincontent] _ -> [maincontent] where diff --git a/hledger-ui/Hledger/UI/UIScreens.hs b/hledger-ui/Hledger/UI/UIScreens.hs index 811e445a0..0521a136c 100644 --- a/hledger-ui/Hledger/UI/UIScreens.hs +++ b/hledger-ui/Hledger/UI/UIScreens.hs @@ -88,24 +88,35 @@ msNew = msUpdate :: MenuScreenState -> MenuScreenState msUpdate = dlogUiTrace "msUpdate`" +nullass macct = ASS { + _assSelectedAccount = fromMaybe "" macct + ,_assList = list AccountsList (V.fromList []) 1 + } + + -- | Construct an accounts screen listing the appropriate set of accounts, -- with the appropriate one selected. -- Screen-specific arguments: the account to select if any. asNew :: UIOpts -> Day -> Journal -> Maybe AccountName -> Screen -asNew uopts d j macct = - dlogUiTrace "asNew" $ - AS $ - asUpdate uopts d j $ - ASS { - _assSelectedAccount = fromMaybe "" macct - ,_assList = list AccountsList (V.fromList []) 1 - } +asNew uopts d j macct = dlogUiTrace "asNew" $ AS $ asUpdate uopts d j $ nullass macct -- | Update an accounts screen from these options, reporting date, and journal. asUpdate :: UIOpts -> Day -> Journal -> AccountsScreenState -> AccountsScreenState -asUpdate uopts d j ass = dlogUiTrace "asUpdate" ass{_assList=l} +asUpdate uopts d = dlogUiTrace "asUpdate" . asUpdateHelper rspec' where UIOpts{uoCliOpts=copts@CliOpts{reportspec_=rspec@ReportSpec{_rsReportOpts=ropts}}} = uopts + rspec' = + updateReportSpec + ropts{declared_=True} -- always show declared accounts even if unused + rspec{_rsDay=d} -- update to the given day, might have changed since program start + & either (error "asUpdate: adjusting the query, should not have failed") id -- PARTIAL: + & reportSpecSetFutureAndForecast (forecast_ $ inputopts_ copts) -- include/exclude future & forecast transactions + +-- | Update an accounts-screen-like screen from this report spec and journal. +asUpdateHelper :: ReportSpec -> Journal -> AccountsScreenState -> AccountsScreenState +asUpdateHelper rspec j ass = dlogUiTrace "asUpdate" ass{_assList=l} + where + ropts = _rsReportOpts rspec -- decide which account is selected: -- if selectfirst is true, the first account; -- otherwise, the previously selected account if possible; @@ -127,14 +138,7 @@ asUpdate uopts d j ass = dlogUiTrace "asUpdate" ass{_assList=l} displayitems = map displayitem items where -- run the report - (items, _) = balanceReport rspec' j - where - rspec' = - updateReportSpec - ropts{declared_=True} -- always show declared accounts even if unused - rspec{_rsDay=d} -- update to the given day, might have changed since program start - & either (error "asUpdate: adjusting the query, should not have failed") id -- PARTIAL: - & reportSpecSetFutureAndForecast (forecast_ $ inputopts_ copts) -- include/exclude future & forecast transactions + (items, _) = balanceReport rspec j -- pre-render a list item displayitem (fullacct, shortacct, indent, bal) = @@ -157,69 +161,22 @@ asUpdate uopts d j ass = dlogUiTrace "asUpdate" ass{_assList=l} -- with the appropriate one selected. -- Screen-specific arguments: the account to select if any. bsNew :: UIOpts -> Day -> Journal -> Maybe AccountName -> Screen -bsNew uopts d j macct = - dlogUiTrace "bsNew" $ - BS $ - bsUpdate uopts d j $ - ASS { - _assSelectedAccount = fromMaybe "" macct - ,_assList = list AccountsList (V.fromList []) 1 - } +bsNew uopts d j macct = dlogUiTrace "bsNew" $ BS $ bsUpdate uopts d j $ nullass macct -- | Update a balance sheet screen from these options, reporting date, and journal. bsUpdate :: UIOpts -> Day -> Journal -> AccountsScreenState -> AccountsScreenState -bsUpdate uopts d j ass = dlogUiTrace "bsUpdate" ass{_assList=l} +bsUpdate uopts d = dlogUiTrace "bsUpdate" . asUpdateHelper rspec' where UIOpts{uoCliOpts=copts@CliOpts{reportspec_=rspec@ReportSpec{_rsReportOpts=ropts}}} = uopts - -- decide which account is selected: - -- if selectfirst is true, the first account; - -- otherwise, the previously selected account if possible; - -- otherwise, the first account with the same prefix (eg first leaf account when entering flat mode); - -- otherwise, the alphabetically preceding account. - l = - listMoveTo selidx $ - list AccountsList (V.fromList $ displayitems ++ blankitems) 1 - where - selidx = headDef 0 $ catMaybes [ - elemIndex a as - ,findIndex (a `isAccountNamePrefixOf`) as - ,Just $ max 0 (length (filter (< a) as) - 1) - ] - where - a = _assSelectedAccount ass - as = map asItemAccountName displayitems - - displayitems = map displayitem items - where - -- run the report - (items, _) = balanceReport rspec' j - where - rspec' = - updateReportSpec - ropts{declared_=True -- always show declared accounts even if unused - ,balanceaccum_=Historical -- always show historical end balances - } - rspec{_rsDay=d} -- update to the given day, might have changed since program start - & either (error "bsUpdate: adjusting the query, should not have failed") id -- PARTIAL: - & reportSpecSetFutureAndForecast (forecast_ $ inputopts_ copts) -- include/exclude future & forecast transactions - & reportSpecAddQuery (Type [Asset,Liability,Equity]) -- restrict to balance sheet accounts - - -- pre-render a list item - displayitem (fullacct, shortacct, indent, bal) = - AccountsScreenItem{asItemIndentLevel = indent - ,asItemAccountName = fullacct - ,asItemDisplayAccountName = replaceHiddenAccountsNameWith "All" $ if tree_ ropts then shortacct else fullacct - ,asItemMixedAmount = Just bal - } - - -- blanks added for scrolling control, cf RegisterScreen. - -- XXX Ugly. Changing to 0 helps when debugging. - blankitems = replicate uiNumBlankItems - AccountsScreenItem{asItemIndentLevel = 0 - ,asItemAccountName = "" - ,asItemDisplayAccountName = "" - ,asItemMixedAmount = Nothing - } + rspec' = + updateReportSpec + ropts{declared_=True -- always show declared accounts even if unused + ,balanceaccum_=Historical -- always show historical end balances + } + rspec{_rsDay=d} -- update to the given day, might have changed since program start + & either (error "bsUpdate: adjusting the query, should not have failed") id -- PARTIAL: + & reportSpecSetFutureAndForecast (forecast_ $ inputopts_ copts) -- include/exclude future & forecast transactions + & reportSpecAddQuery (Type [Asset,Liability,Equity]) -- restrict to balance sheet accounts -- | Construct a register screen listing the appropriate set of transactions, -- with the appropriate one selected. diff --git a/hledger-ui/Hledger/UI/UIUtils.hs b/hledger-ui/Hledger/UI/UIUtils.hs index 54665823b..cd558a94c 100644 --- a/hledger-ui/Hledger/UI/UIUtils.hs +++ b/hledger-ui/Hledger/UI/UIUtils.hs @@ -56,7 +56,6 @@ import Graphics.Vty import Lens.Micro.Platform import Hledger -import Hledger.Cli (CliOpts) import Hledger.Cli.DocFiles import Hledger.UI.UITypes @@ -111,8 +110,8 @@ defaultLayout toplabel bottomlabel = -- "the layout adjusts... if you use the core combinators" -- | Draw the help dialog, called when help mode is active. -helpDialog :: CliOpts -> Widget Name -helpDialog _copts = +helpDialog :: Widget Name +helpDialog = Widget Fixed Fixed $ do c <- getContext render $