feat: ui: add top-level menu screen

hledger-ui/Hledger/UI/AccountsScreen.hs

@@ -263,6 +263,14 @@ asHandle ev = do
             VtyEvent (EvKey (KChar 'l') [MCtrl]) -> scrollSelectionToMiddle (_assList sst) >> redraw
             VtyEvent (EvKey (KChar 'z') [MCtrl]) -> suspend ui
 
+            -- exit screen on LEFT
+            VtyEvent e | e `elem` moveLeftEvents -> put' $ popScreen ui
+            -- or on a click in the app's left margin. This is a VtyEvent since not in a clickable widget.
+            VtyEvent (EvMouseUp x _y (Just BLeft)) | x==0 -> put' $ popScreen ui
+            -- or on clicking a blank list item.
+            MouseUp _ (Just BLeft) Location{loc=(_,y)} | clickedacct == "" -> put' $ popScreen ui
+              where clickedacct = maybe "" asItemAccountName $ listElements (_assList sst) !? y
+
             -- enter register screen for selected account (if there is one),
             -- centering its selected transaction if possible
             VtyEvent e | e `elem` moveRightEvents

hledger-ui/Hledger/UI/Main.hs

@@ -34,6 +34,7 @@ import Hledger.UI.UIOptions
 import Hledger.UI.UITypes
 import Hledger.UI.UIState (uiState, getDepth)
 import Hledger.UI.UIUtils (dlogUiTrace)
+import Hledger.UI.MenuScreen
 import Hledger.UI.AccountsScreen
 import Hledger.UI.RegisterScreen
 import Hledger.UI.TransactionScreen
@@ -127,14 +128,12 @@ 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.
     (prevscrs, startscr) = case uoRegister uopts of
-      Nothing -> ([], acctsscr)
-      -- with --register, start on the register screen, and also put
-      -- the accounts screen on the prev screens stack so you can exit
-      -- to that as usual.
-      Just apat -> ([acctsscr'], regscr)
+      Nothing   -> ([menuscr], acctsscr)
+      Just apat -> ([menuscr, asSetSelectedAccount acct acctsscr], regscr)
         where
-          acctsscr' = asSetSelectedAccount acct acctsscr
           regscr = 
             rsSetAccount acct False $
             rsNew uopts today j acct forceinclusive
@@ -149,6 +148,7 @@ runBrickUi uopts0@UIOpts{uoCliOpts=copts@CliOpts{inputopts_=_iopts,reportspec_=r
                   Right re -> find (regexMatchText re)
                   Left  _  -> const Nothing
       where
+        menuscr = msNew
         acctsscr = asNew uopts today j Nothing
 
     ui = uiState uopts j prevscrs startscr
@@ -241,6 +241,7 @@ uiHandle :: BrickEvent Name AppEvent -> EventM Name UIState ()
 uiHandle ev = do
   ui <- get
   case aScreen ui of
+    MS _ -> msHandle ev
     AS _ -> asHandle ev
     RS _ -> rsHandle ev
     TS _ -> tsHandle ev
@@ -249,6 +250,7 @@ uiHandle ev = do
 uiDraw :: UIState -> [Widget Name]
 uiDraw ui =
   case aScreen ui of
+    MS _ -> msDraw ui
     AS _ -> asDraw ui
     RS _ -> rsDraw ui
     TS _ -> tsDraw ui

hledger-ui/Hledger/UI/MenuScreen.hs

@@ -0,0 +1,341 @@
+-- The menu screen, showing other screens available in hledger-ui.
+
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+
+module Hledger.UI.MenuScreen
+ (msNew
+ ,msUpdate
+ ,msDraw
+ ,msHandle
+ )
+where
+
+import Brick
+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
+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)
+import Hledger.UI.UIOptions
+import Hledger.UI.UITypes
+import Hledger.UI.UIState
+import Hledger.UI.UIUtils
+import Hledger.UI.UIScreens
+import Hledger.UI.ErrorScreen (uiReloadJournal, uiCheckBalanceAssertions, uiReloadJournalIfChanged)
+import Data.Text (Text)
+import Hledger.UI.Editor (runIadd, runEditor, endPosition)
+import Brick.Widgets.Edit (getEditContents, handleEditorEvent)
+-- import Hledger.UI.AccountsScreen
+
+
+msDraw :: UIState -> [Widget Name]
+msDraw UIState{aopts=_uopts@UIOpts{uoCliOpts=copts@CliOpts{reportspec_=_rspec}}
+              ,ajournal=j
+              ,aScreen=MS sst
+              ,aMode=mode
+              } = dlogUiTrace "msDraw 1" $
+    case mode of
+      Help              -> [helpDialog copts, maincontent]
+      Minibuffer lbl ed -> [minibuffer lbl ed, maincontent]
+      _                 -> [maincontent]
+  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 ^. mssList . listElementsL
+
+        -- acctwidths = V.map (\AccountsScreenItem{..} -> msItemIndentLevel + realLength msItemDisplayAccountName) displayitems
+        -- balwidths  = V.map (maybe 0 (wbWidth . showMixedAmountB oneLine) . msItemMixedAmount) 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 msDrawItem True (sst ^. mssList)
+
+      where
+        -- ropts = _rsReportOpts rspec
+        -- ishistorical = balanceaccum_ ropts == Historical
+
+        toplabel =
+              withAttr (attrName "border" <> attrName "filename") files
+          -- <+> toggles
+          -- <+> str " menu"
+          -- <+> 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 ^. mssList . listSelectedL of
+            --            Nothing -> "-"
+            --            Just i -> show (i + 1)
+            -- totidx = show $ V.length nonblanks
+            --   where
+            --     nonblanks = V.takeWhile (not . T.null . msItemScreenName) $ sst ^. mssList . 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")
+              -- ,("H", 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")
+              ]
+
+msDraw _ =  dlogUiTrace "msDraw 2" $ errorWrongScreenType "draw function"  -- PARTIAL:
+
+-- msDrawItem :: (Int,Int) -> Bool -> MenuScreenItem -> Widget Name
+-- msDrawItem (_acctwidth, _balwidth) _selected MenuScreenItem{..} =
+msDrawItem :: Bool -> MenuScreenItem -> Widget Name
+msDrawItem _selected MenuScreenItem{..} =
+  Widget Greedy Fixed $ do
+    -- c <- getContext
+      -- let showitem = intercalate "\n" . balanceReportItemAsText defreportopts fmt
+    render $
+      txt msItemScreenName
+      -- txt (fitText (Just acctwidth) (Just acctwidth) True True $ T.replicate (msItemIndentLevel) " " <> msItemDisplayAccountName) <+>
+      -- txt balspace <+>
+      -- splitAmounts balBuilder
+      -- where
+      --   balBuilder = maybe mempty showamt msItemMixedAmount
+      --   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
+
+msHandle :: BrickEvent Name AppEvent -> EventM Name UIState ()
+msHandle ev = do
+  ui0 <- get'
+  dlogUiTraceM "msHandle 1"
+  case ui0 of
+    ui@UIState{
+       aopts=UIOpts{uoCliOpts=copts}
+      ,ajournal=j
+      ,aMode=mode
+      ,aScreen=MS sst
+      } -> do
+      let
+        -- save the currently selected account, in case we leave this screen and lose the selection
+        mselscr = case listSelectedElement $ _mssList sst of
+                    Just (_, MenuScreenItem{..}) -> Just msItemScreenName
+                    Nothing -> Nothing
+        -- ui = ui1{aScreen=MS sst{_assSelectedAccount=selacct}}
+        nonblanks = V.takeWhile (not . T.null . msItemScreenName) $ listElements $ _mssList sst
+        lastnonblankidx = max 0 (length nonblanks - 1)
+--         journalspan = journalDateSpan False j
+        d = copts^.rsDay
+
+      case mode of
+        Minibuffer _ ed ->
+          case ev of
+            VtyEvent (EvKey KEsc   []) -> put' $ closeMinibuffer ui
+            VtyEvent (EvKey KEnter []) -> put' $ regenerateScreens j d $
+                case setFilter s $ closeMinibuffer ui of
+                  Left bad -> showMinibuffer "Cannot compile regular expression" (Just bad) ui
+                  Right ui' -> ui'
+              where s = chomp $ unlines $ map strip $ getEditContents ed
+            VtyEvent (EvKey (KChar 'l') [MCtrl]) -> redraw
+            VtyEvent (EvKey (KChar 'z') [MCtrl]) -> suspend ui
+            VtyEvent e -> do
+              ed' <- nestEventM' ed $ handleEditorEvent (VtyEvent e)
+              put' ui{aMode=Minibuffer "filter" ed'}
+            AppEvent _  -> return ()
+            MouseDown{} -> return ()
+            MouseUp{}   -> return ()
+
+        Help ->
+          case ev of
+            -- VtyEvent (EvKey (KChar 'q') []) -> halt
+            VtyEvent (EvKey (KChar 'l') [MCtrl]) -> redraw
+            VtyEvent (EvKey (KChar 'z') [MCtrl]) -> suspend ui
+            _ -> helpHandle ev
+
+        Normal ->
+          case ev of
+            VtyEvent (EvKey (KChar 'q') []) -> halt
+            -- EvKey (KChar 'l') [MCtrl] -> do
+            VtyEvent (EvKey KEsc        []) -> put' $ resetScreens d ui
+            VtyEvent (EvKey (KChar c)   []) | c == '?' -> put' $ setMode Help ui
+            -- XXX AppEvents currently handled only in Normal mode
+            -- XXX be sure we don't leave unconsumed events piling up
+            AppEvent (DateChange old _) | isStandardPeriod p && p `periodContainsDate` old ->
+              put' $ regenerateScreens j d $ setReportPeriod (DayPeriod d) ui
+              where
+                p = reportPeriod ui
+            e | e `elem` [VtyEvent (EvKey (KChar 'g') []), AppEvent FileChange] ->
+              liftIO (uiReloadJournal copts d ui) >>= put'
+            VtyEvent (EvKey (KChar 'I') []) -> put' $ uiCheckBalanceAssertions d (toggleIgnoreBalanceAssertions ui)
+            VtyEvent (EvKey (KChar 'a') []) -> suspendAndResume $ clearScreen >> setCursorPosition 0 0 >> add copts j >> uiReloadJournalIfChanged copts d j ui
+            VtyEvent (EvKey (KChar 'A') []) -> suspendAndResume $ void (runIadd (journalFilePath j)) >> uiReloadJournalIfChanged copts d j ui
+            VtyEvent (EvKey (KChar 'E') []) -> suspendAndResume $ void (runEditor endPosition (journalFilePath j)) >> uiReloadJournalIfChanged copts d j ui
+
+--             VtyEvent (EvKey (KChar 'B') []) -> put' $ regenerateScreens j d $ toggleConversionOp ui
+--             VtyEvent (EvKey (KChar 'V') []) -> put' $ regenerateScreens j d $ toggleValue ui
+--             VtyEvent (EvKey (KChar '0') []) -> put' $ regenerateScreens j d $ setDepth (Just 0) ui
+--             VtyEvent (EvKey (KChar '1') []) -> put' $ regenerateScreens j d $ setDepth (Just 1) ui
+--             VtyEvent (EvKey (KChar '2') []) -> put' $ regenerateScreens j d $ setDepth (Just 2) ui
+--             VtyEvent (EvKey (KChar '3') []) -> put' $ regenerateScreens j d $ setDepth (Just 3) ui
+--             VtyEvent (EvKey (KChar '4') []) -> put' $ regenerateScreens j d $ setDepth (Just 4) ui
+--             VtyEvent (EvKey (KChar '5') []) -> put' $ regenerateScreens j d $ setDepth (Just 5) ui
+--             VtyEvent (EvKey (KChar '6') []) -> put' $ regenerateScreens j d $ setDepth (Just 6) ui
+--             VtyEvent (EvKey (KChar '7') []) -> put' $ regenerateScreens j d $ setDepth (Just 7) ui
+--             VtyEvent (EvKey (KChar '8') []) -> put' $ regenerateScreens j d $ setDepth (Just 8) ui
+--             VtyEvent (EvKey (KChar '9') []) -> put' $ regenerateScreens j d $ setDepth (Just 9) ui
+--             VtyEvent (EvKey (KChar '-') []) -> put' $ regenerateScreens j d $ decDepth ui
+--             VtyEvent (EvKey (KChar '_') []) -> put' $ regenerateScreens j d $ decDepth ui
+--             VtyEvent (EvKey (KChar c)   []) | c `elem` ['+','='] -> put' $ regenerateScreens j d $ incDepth ui
+--             VtyEvent (EvKey (KChar 'T') []) -> put' $ regenerateScreens j d $ setReportPeriod (DayPeriod d) ui
+
+--             -- display mode/query toggles
+--             VtyEvent (EvKey (KChar 'H') []) -> modify' (regenerateScreens j d . toggleHistorical) >> msCenterAndContinue
+--             VtyEvent (EvKey (KChar 't') []) -> modify' (regenerateScreens j d . toggleTree) >> msCenterAndContinue
+--             VtyEvent (EvKey (KChar c) []) | c `elem` ['z','Z'] -> modify' (regenerateScreens j d . toggleEmpty) >> msCenterAndContinue
+--             VtyEvent (EvKey (KChar 'R') []) -> modify' (regenerateScreens j d . toggleReal) >> msCenterAndContinue
+--             VtyEvent (EvKey (KChar 'U') []) -> modify' (regenerateScreens j d . toggleUnmarked) >> msCenterAndContinue
+--             VtyEvent (EvKey (KChar 'P') []) -> modify' (regenerateScreens j d . togglePending) >> msCenterAndContinue
+--             VtyEvent (EvKey (KChar 'C') []) -> modify' (regenerateScreens j d . toggleCleared) >> msCenterAndContinue
+--             VtyEvent (EvKey (KChar 'F') []) -> modify' (regenerateScreens j d . toggleForecast d)
+
+            -- VtyEvent (EvKey (KDown)     [MShift]) -> put' $ regenerateScreens j d $ shrinkReportPeriod d ui
+            -- VtyEvent (EvKey (KUp)       [MShift]) -> put' $ regenerateScreens j d $ growReportPeriod d ui
+            -- VtyEvent (EvKey (KRight)    [MShift]) -> put' $ regenerateScreens j d $ nextReportPeriod journalspan ui
+            -- VtyEvent (EvKey (KLeft)     [MShift]) -> put' $ regenerateScreens j d $ previousReportPeriod journalspan 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 (KChar 'l') [MCtrl]) -> scrollSelectionToMiddle (_mssList sst) >> redraw
+            VtyEvent (EvKey (KChar 'z') [MCtrl]) -> suspend ui
+
+            -- Enter enters selected screen if there is one
+            VtyEvent e | e `elem` moveRightEvents
+                      , not $ isBlankElement $ listSelectedElement (_mssList sst) -> msEnterScreen d (fromMaybe "" mselscr) 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 $ (=="") clickedscr -> do
+              put' ui{aScreen=MS sst}  -- XXX does this do anything ?
+              where clickedscr = maybe "" msItemScreenName $ listElements (_mssList sst) !? y
+            -- and on MouseUp, enter the subscreen
+            MouseUp _n (Just BLeft) Location{loc=(_x,y)} | not $ (=="") clickedscr -> do
+              msEnterScreen d clickedscr ui
+              where clickedscr = maybe "" msItemScreenName $ listElements (_mssList 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 $ (_mssList sst)^.listNameL) 1
+              where mnextelement = listSelectedElement $ listMoveDown (_mssList 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' (_mssList sst) $ listScrollPushingSelection name (msListSize (_mssList sst)) scrollamt
+              put' ui{aScreen=MS sst{_mssList=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' (_mssList sst) $ handleListEvent e
+              if isBlankElement $ listSelectedElement l
+              then do
+                let l' = listMoveTo lastnonblankidx l
+                scrollSelectionToMiddle l'
+                put' ui{aScreen=MS sst{_mssList=l'}}
+              else
+                put' ui{aScreen=MS sst{_mssList=l}}
+
+            -- fall through to the list's event handler (handles up/down)
+            VtyEvent e -> do
+              list' <- nestEventM' (_mssList sst) $ handleListEvent (normaliseMovementKeys e)
+              put' ui{aScreen=MS $ sst & mssList .~ list'}
+
+            MouseDown{} -> return ()
+            MouseUp{}   -> return ()
+            AppEvent _  -> return ()
+
+    _ -> dlogUiTraceM "msHandle 2" >> errorWrongScreenType "event handler"
+
+type ScreenName = Text
+
+msEnterScreen :: Day -> ScreenName -> UIState -> EventM Name UIState ()
+msEnterScreen d _scrname ui@UIState{ajournal=j, aopts=uopts} = do
+  dlogUiTraceM "msEnterScreen"
+  let scr = asNew uopts d j Nothing
+  put' $ pushScreen scr ui
+
+-- -- | Set the selected account on an accounts screen. No effect on other screens.
+-- msSetSelectedAccount :: AccountName -> Screen -> Screen
+-- msSetSelectedAccount a (MS mss@ASS{}) = MS mss{_assSelectedAccount=a}
+-- msSetSelectedAccount _ s = s
+
+isBlankElement mel = ((msItemScreenName . snd) <$> mel) == Just ""
+
+-- -- | Scroll the accounts screen's selection to the center. No effect if on another screen.
+-- msCenterAndContinue :: EventM Name UIState ()
+-- msCenterAndContinue = do
+--   ui <- get'
+--   case aScreen ui of
+--     MS sst -> scrollSelectionToMiddle $ _assList sst
+--     _ -> return ()
+
+msListSize = V.length . V.takeWhile ((/="").msItemScreenName) . listElements
+

hledger-ui/Hledger/UI/UIScreens.hs

@@ -16,6 +16,8 @@
 
 module Hledger.UI.UIScreens
  (screenUpdate
+ ,msNew
+ ,msUpdate
  ,asNew
  ,asUpdate
  ,rsNew
@@ -43,11 +45,29 @@ import Hledger.UI.UIUtils
 -- | 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
   RS rss -> RS $ rsUpdate opts d j rss
   TS tss -> TS $ tsUpdate tss
   ES ess -> ES $ esUpdate ess
 
+-- | Construct a menu screen.
+-- Screen-specific arguments: none.
+msNew :: Screen
+msNew =
+  dlogUiTrace "msNew" $
+  MS MSS {
+     _mssList            = list MenuList (V.fromList [
+        MenuScreenItem "All accounts" AccountsViewport
+      ]) 1
+    ,_mssUnused = ()
+    }
+
+-- | Recalculate a menu screen. Currently a no-op since menu screen
+-- has unchanging content.
+msUpdate :: MenuScreenState -> MenuScreenState
+msUpdate = dlogUiTrace "msUpdate`"
+
 -- | Construct an accounts screen listing the appropriate set of accounts,
 -- with the appropriate one selected.
 -- Screen-specific arguments: the account to select if any.

hledger-ui/Hledger/UI/UITypes.hs

@@ -90,6 +90,7 @@ instance Eq (Editor l n) where _ == _ = True
 data Name =
     HelpDialog
   | MinibufferEditor
+  | MenuList
   | AccountsViewport
   | AccountsList
   | RegisterViewport
@@ -164,12 +165,19 @@ data Name =
 -- along with any screen-specific parameters or data influencing what they display.
 -- (The separate state types add code noise but seem to reduce partial code/invalid data a bit.)
 data Screen =
-    AS AccountsScreenState
+    MS MenuScreenState
+  | AS AccountsScreenState
   | RS RegisterScreenState
   | TS TransactionScreenState
   | ES ErrorScreenState
   deriving (Show)
 
+data MenuScreenState = MSS {
+    -- view data:
+   _mssList            :: List Name MenuScreenItem  -- ^ list widget showing screen names
+  ,_mssUnused          :: ()                        -- ^ dummy field to silence warning
+} deriving (Show)
+
 data AccountsScreenState = ASS {
     -- screen parameters:
    _assSelectedAccount :: AccountName                   -- ^ a copy of the account name from the list's selected item (or "")
@@ -200,6 +208,12 @@ data ErrorScreenState = ESS {
   ,_essUnused :: ()                                 -- ^ dummy field to silence warning
 } deriving (Show)
 
+-- | An item in the menu screen's list of screens.
+data MenuScreenItem = MenuScreenItem {
+   msItemScreenName :: Text                         -- ^ screen name
+  ,msItemScreen :: Name                             -- ^ an internal name we can use to find the corresponding screen
+  } deriving (Show)
+
 -- | An item in the accounts screen's list of accounts and balances.
 data AccountsScreenItem = AccountsScreenItem {
    asItemIndentLevel        :: Int                -- ^ indent level
@@ -225,6 +239,7 @@ type NumberedTransaction = (Integer, Transaction)
 -- These TH calls must come after most of the types above.
 -- Fields named _foo produce lenses named foo.
 -- XXX foo fields producing fooL lenses would be preferable
+makeLenses ''MenuScreenState
 makeLenses ''AccountsScreenState
 makeLenses ''RegisterScreenState
 makeLenses ''TransactionScreenState

hledger-ui/hledger-ui.cabal

@@ -52,6 +52,7 @@ executable hledger-ui
       Hledger.UI.Editor
       Hledger.UI.ErrorScreen
       Hledger.UI.Main
+      Hledger.UI.MenuScreen
       Hledger.UI.RegisterScreen
       Hledger.UI.Theme
       Hledger.UI.TransactionScreen

hledger-ui/hledger-ui.m4.md

@@ -189,6 +189,10 @@ Additional screen-specific keys are described below.
 
 # SCREENS
 
+## Menu screen
+
+The top-most screen, currently with just one menu item and not shown by default.
+
 ## Accounts screen
 
 This is normally the first screen displayed.
@@ -230,6 +234,7 @@ are shown (hledger-ui shows zero items by default, unlike command-line
 hledger).
 
 Press `RIGHT` to view an account's transactions register.
+Or, `LEFT` to see the menu screen.
 
 ## Register screen