From 9a8a8a75a2121b5afe52136373ecb797f0c5f77b Mon Sep 17 00:00:00 2001 From: Simon Michael Date: Sun, 6 Nov 2022 07:55:57 -1000 Subject: [PATCH] imp: ui: start on balance sheet screen: better initial screen stack --- hledger-lib/Hledger/Data/Types.hs | 15 ++++++ hledger-ui/Hledger/UI/AccountsScreen.hs | 27 +++++++++-- hledger-ui/Hledger/UI/Main.hs | 63 ++++++++++++++++++------- hledger-ui/Hledger/UI/MenuScreen.hs | 6 +++ hledger-ui/Hledger/UI/UIScreens.hs | 25 ++++------ 5 files changed, 100 insertions(+), 36 deletions(-) diff --git a/hledger-lib/Hledger/Data/Types.hs b/hledger-lib/Hledger/Data/Types.hs index 0b6fae97e..5e77ea8a0 100644 --- a/hledger-lib/Hledger/Data/Types.hs +++ b/hledger-lib/Hledger/Data/Types.hs @@ -163,6 +163,21 @@ instance Show AccountType where show Cash = "C" show Conversion = "V" +isBalanceSheetAccountType :: AccountType -> Bool +isBalanceSheetAccountType t = t `elem` [ + Asset, + Liability, + Equity, + Cash, + Conversion + ] + +isIncomeStatementAccountType :: AccountType -> Bool +isIncomeStatementAccountType t = t `elem` [ + Revenue, + Expense + ] + -- | Check whether the first argument is a subtype of the second: either equal -- or one of the defined subtypes. isAccountSubtypeOf :: AccountType -> AccountType -> Bool diff --git a/hledger-ui/Hledger/UI/AccountsScreen.hs b/hledger-ui/Hledger/UI/AccountsScreen.hs index f122c2cc9..5b20b120e 100644 --- a/hledger-ui/Hledger/UI/AccountsScreen.hs +++ b/hledger-ui/Hledger/UI/AccountsScreen.hs @@ -47,6 +47,7 @@ import Hledger.UI.ErrorScreen (uiReloadJournal, uiCheckBalanceAssertions, uiRelo import Hledger.UI.RegisterScreen (rsCenterSelection) import Data.Either (fromRight) import Control.Arrow ((>>>)) +import Safe (headDef) asDraw :: UIState -> [Widget Name] @@ -363,7 +364,7 @@ enterRegisterScreen d acct ui@UIState{ajournal=j, aopts=uopts} = do ui1 = pushScreen regscr ui rsCenterSelection ui1 >>= put' --- | From an accounts-screen-like screen's state, get the account name from the +-- | From any accounts screen's state, get the account name from the -- currently selected list item, or otherwise the last known selected account name. asSelectedAccount :: AccountsScreenState -> AccountName asSelectedAccount ass = @@ -371,10 +372,28 @@ asSelectedAccount ass = Just (_, AccountsScreenItem{..}) -> asItemAccountName Nothing -> ass ^. assSelectedAccount --- | Set the selected account on an accounts screen. No effect on other screens. +-- | Set the selected account on any of the accounts screens. Has no effect on other screens. +-- Sets the high-level property _assSelectedAccount and also selects the corresponding or +-- best alternative item in the list widget (_assList). asSetSelectedAccount :: AccountName -> Screen -> Screen -asSetSelectedAccount a (AS ass@ASS{}) = AS ass{_assSelectedAccount=a} -asSetSelectedAccount _ s = s +asSetSelectedAccount acct scr = + case scr of + (AS ass) -> AS $ assSetSelectedAccount acct ass + (BS ass) -> BS $ assSetSelectedAccount acct ass + (IS ass) -> IS $ assSetSelectedAccount acct ass + _ -> scr + where + assSetSelectedAccount a ass@ASS{_assList=l} = + ass{_assSelectedAccount=a, _assList=listMoveTo selidx l} + where + -- which list item should be selected ? + selidx = headDef 0 $ catMaybes [ + elemIndex a as -- the specified account, if it can be found + ,findIndex (a `isAccountNamePrefixOf`) as -- or the first account found with the same prefix + ,Just $ max 0 (length (filter (< a) as) - 1) -- otherwise, the alphabetically preceding account. + ] + where + as = map asItemAccountName $ V.toList $ listElements l isBlankItem mitem = ((asItemAccountName . snd) <$> mitem) == Just "" diff --git a/hledger-ui/Hledger/UI/Main.hs b/hledger-ui/Hledger/UI/Main.hs index f1460c12e..2c393139d 100644 --- a/hledger-ui/Hledger/UI/Main.hs +++ b/hledger-ui/Hledger/UI/Main.hs @@ -15,6 +15,8 @@ import Control.Applicative ((<|>)) import Control.Concurrent (threadDelay) import Control.Concurrent.Async (withAsync) import Control.Monad (forM_, void, when) +import Data.Bifunctor (first) +import Data.Function ((&)) import Data.List (find) import Data.List.Extra (nubSort) import Data.Maybe (fromMaybe) @@ -22,6 +24,7 @@ import qualified Data.Text as T import Graphics.Vty (mkVty, Mode (Mouse), Vty (outputIface), Output (setMode)) import Lens.Micro ((^.)) import System.Directory (canonicalizePath) +import System.Environment (withProgName) import System.FilePath (takeDirectory) import System.FSNotify (Event(Modified), watchDir, withManager, EventIsDirectory (IsFile)) import Brick hiding (bsDraw) @@ -41,7 +44,7 @@ import Hledger.UI.IncomestatementScreen import Hledger.UI.RegisterScreen import Hledger.UI.TransactionScreen import Hledger.UI.ErrorScreen -import System.Environment (withProgName) + ---------------------------------------------------------------------- @@ -132,13 +135,30 @@ runBrickUi uopts0@UIOpts{uoCliOpts=copts@CliOpts{inputopts_=_iopts,reportspec_=r filteredQuery q = simplifyQuery $ And [queryFromFlags ropts, filtered q] where filtered = filterQuery (\x -> not $ queryIsDepth x || queryIsDate x) - -- Select the starting screen, and parent screens you can step back to: - -- menu > accounts by default, or menu > accounts > register with --register. - -- Remember the parent screens are ordered nearest/lowest first. - (prevscrs, startscr) = case uoRegister uopts of - Nothing -> ([menuscr], bsacctsscr) - Just apat -> ([asSetSelectedAccount acct bsacctsscr, menuscr], regscr) + -- Set up the initial screen to display, and a stack of previous screens + -- as if you had navigated down to it from the top. + (prevscrs, currscr) = case uoRegister uopts of + + -- The default initial screen stack is: + -- menu screen, with balance sheet accounts screen selected + -- balance sheet accounts screen + Nothing -> ([menuscr], bsacctsscr) + + -- With --register=ACCT, it is: + -- menu screen, with ACCTSSCR selected + -- ACCTSSCR (the accounts screen containing ACCT), with ACCT selected + -- register screen for ACCT + Just apat -> ([acctsscr, menuscr'], regscr) -- remember, previous screens are ordered nearest/lowest first where + -- the account being requested + acct = fromMaybe (error' $ "--register "++apat++" did not match any account") -- PARTIAL: + . firstMatch $ journalAccountNamesDeclaredOrImplied j + where + firstMatch = case toRegexCI $ T.pack apat of + Right re -> find (regexMatchText re) + Left _ -> const Nothing + + -- the register screen for acct regscr = rsSetAccount acct False $ rsNew uopts today j acct forceinclusive @@ -146,17 +166,26 @@ runBrickUi uopts0@UIOpts{uoCliOpts=copts@CliOpts{inputopts_=_iopts,reportspec_=r forceinclusive = case getDepth ui of Just de -> accountNameLevel acct >= de Nothing -> False - acct = fromMaybe (error' $ "--register "++apat++" did not match any account") -- PARTIAL: - . firstMatch $ journalAccountNamesDeclaredOrImplied j - where - firstMatch = case toRegexCI $ T.pack apat of - Right re -> find (regexMatchText re) - Left _ -> const Nothing - where - menuscr = msNew - bsacctsscr = bsNew uopts today j Nothing - ui = uiState uopts j prevscrs startscr + -- The accounts screen containing acct. + -- Keep these selidx values synced with the menu items in msNew. + (acctsscr, selidx) = + case journalAccountType j acct of + Just t | isBalanceSheetAccountType t -> (bsacctsscr, 1) + Just t | isIncomeStatementAccountType t -> (isacctsscr, 2) + _ -> (allacctsscr,0) + & first (asSetSelectedAccount acct) + + -- the menu screen + menuscr' = msSetSelectedScreen selidx menuscr + + where + menuscr = msNew + allacctsscr = asNew uopts today j Nothing + bsacctsscr = bsNew uopts today j Nothing + isacctsscr = isNew uopts today j Nothing + + ui = uiState uopts j prevscrs currscr app = brickApp (uoTheme uopts) -- print (length (show ui)) >> exitSuccess -- show any debug output to this point & quit diff --git a/hledger-ui/Hledger/UI/MenuScreen.hs b/hledger-ui/Hledger/UI/MenuScreen.hs index b8dfa9cb6..e909bf592 100644 --- a/hledger-ui/Hledger/UI/MenuScreen.hs +++ b/hledger-ui/Hledger/UI/MenuScreen.hs @@ -8,6 +8,7 @@ module Hledger.UI.MenuScreen ,msUpdate ,msDraw ,msHandle + ,msSetSelectedScreen ) where @@ -261,6 +262,11 @@ msEnterScreen d scrname ui@UIState{ajournal=j, aopts=uopts} = do Incomestatement -> isNew uopts d j Nothing put' $ pushScreen scr ui +-- | Set the selected list item on the menu screen. Has no effect on other screens. +msSetSelectedScreen :: Int -> Screen -> Screen +msSetSelectedScreen selidx (MS mss@MSS{_mssList=l}) = MS mss{_mssList=listMoveTo selidx l} +msSetSelectedScreen _ s = s + isBlankElement mel = ((msItemScreenName . snd) <$> mel) == Just "" msListSize = V.length . V.takeWhile ((/="").msItemScreenName) . listElements diff --git a/hledger-ui/Hledger/UI/UIScreens.hs b/hledger-ui/Hledger/UI/UIScreens.hs index 3f55004f3..847249c00 100644 --- a/hledger-ui/Hledger/UI/UIScreens.hs +++ b/hledger-ui/Hledger/UI/UIScreens.hs @@ -80,6 +80,7 @@ msNew = dbgui "msNew" $ MS MSS { _mssList = list MenuList (V.fromList [ + -- keep initial screen stack setup in UI.Main synced with these MenuScreenItem "All accounts" Accounts ,MenuScreenItem "Balance sheet accounts (assets, liabilities, equity)" Balancesheet ,MenuScreenItem "Income statement accounts (revenues, expenses)" Incomestatement @@ -128,23 +129,17 @@ asUpdateHelper rspec0 d copts roptsModify extraquery j ass = dbgui "asUpdateHelp & reportSpecSetFutureAndForecast (forecast_ $ inputopts_ copts) -- include/exclude future & forecast transactions & reportSpecAddQuery extraquery -- add any extra restrictions - -- 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 + l = listMoveTo selidx $ list AccountsList (V.fromList $ displayitems ++ blankitems) 1 where + -- which account should be selected ? 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 + elemIndex a as -- the one previously selected, if it can be found + ,findIndex (a `isAccountNamePrefixOf`) as -- or the first account found with the same prefix + ,Just $ max 0 (length (filter (< a) as) - 1) -- otherwise, the alphabetically preceding account. + ] + where + a = _assSelectedAccount ass + as = map asItemAccountName displayitems displayitems = map displayitem items where