imp: ui: start on balance sheet screen: better initial screen stack

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

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 acct scr =
-asSetSelectedAccount _ s = s
+  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 ""
 

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:
+    -- Set up the initial screen to display, and a stack of previous screens
-    -- menu > accounts by default, or menu > accounts > register with --register.
+    -- as if you had navigated down to it from the top.
-    -- Remember the parent screens are ordered nearest/lowest first.
+    (prevscrs, currscr) = case uoRegister uopts of
-    (prevscrs, startscr) = case uoRegister uopts of
+
-      Nothing   -> ([menuscr], bsacctsscr)
+      -- The default initial screen stack is: 
-      Just apat -> ([asSetSelectedAccount acct bsacctsscr, menuscr], regscr)
+      -- 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

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

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:
+    l = listMoveTo selidx $ list AccountsList (V.fromList $ displayitems ++ blankitems) 1
-    -- 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
+        -- which account should be selected ?
         selidx = headDef 0 $ catMaybes [
-                  elemIndex a as
+           elemIndex a as                               -- the one previously selected, if it can be found
-                  ,findIndex (a `isAccountNamePrefixOf`) as
+          ,findIndex (a `isAccountNamePrefixOf`) as     -- or the first account found with the same prefix
-                  ,Just $ max 0 (length (filter (< a) as) - 1)
+          ,Just $ max 0 (length (filter (< a) as) - 1)  -- otherwise, the alphabetically preceding account.
-                  ]
+          ]
-                  where
+          where
-                    a = _assSelectedAccount ass
+            a = _assSelectedAccount ass
-                    as = map asItemAccountName displayitems
+            as = map asItemAccountName displayitems
 
         displayitems = map displayitem items
           where