diff --git a/hledger-ui/Hledger/UI/AccountsScreen.hs b/hledger-ui/Hledger/UI/AccountsScreen.hs index b4555ae29..9344b27a0 100644 --- a/hledger-ui/Hledger/UI/AccountsScreen.hs +++ b/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 diff --git a/hledger-ui/Hledger/UI/Main.hs b/hledger-ui/Hledger/UI/Main.hs index 1db7d7b77..8e9794300 100644 --- a/hledger-ui/Hledger/UI/Main.hs +++ b/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 diff --git a/hledger-ui/Hledger/UI/MenuScreen.hs b/hledger-ui/Hledger/UI/MenuScreen.hs new file mode 100644 index 000000000..1021c273b --- /dev/null +++ b/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 + diff --git a/hledger-ui/Hledger/UI/UIScreens.hs b/hledger-ui/Hledger/UI/UIScreens.hs index cfc5939be..22cdf6cbf 100644 --- a/hledger-ui/Hledger/UI/UIScreens.hs +++ b/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. diff --git a/hledger-ui/Hledger/UI/UITypes.hs b/hledger-ui/Hledger/UI/UITypes.hs index 2075b101c..404d5a625 100644 --- a/hledger-ui/Hledger/UI/UITypes.hs +++ b/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 diff --git a/hledger-ui/hledger-ui.cabal b/hledger-ui/hledger-ui.cabal index 31e113cf5..aa1c73868 100644 --- a/hledger-ui/hledger-ui.cabal +++ b/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 diff --git a/hledger-ui/hledger-ui.m4.md b/hledger-ui/hledger-ui.m4.md index 1bb30e0fc..075ee1322 100644 --- a/hledger-ui/hledger-ui.m4.md +++ b/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