From aa75cc69f612637a5d22b0098def3563fb8b7577 Mon Sep 17 00:00:00 2001 From: Simon Michael Date: Fri, 10 Jun 2016 08:40:00 -0700 Subject: [PATCH] ui: a more general mode mechanism --- hledger-ui/Hledger/UI/AccountsScreen.hs | 31 +++++++++++----------- hledger-ui/Hledger/UI/Main.hs | 4 +-- hledger-ui/Hledger/UI/RegisterScreen.hs | 34 +++++++++++++------------ hledger-ui/Hledger/UI/UITypes.hs | 17 ++++++++++--- hledger-ui/Hledger/UI/UIUtils.hs | 4 +-- 5 files changed, 52 insertions(+), 38 deletions(-) diff --git a/hledger-ui/Hledger/UI/AccountsScreen.hs b/hledger-ui/Hledger/UI/AccountsScreen.hs index ba286476f..fb4b87422 100644 --- a/hledger-ui/Hledger/UI/AccountsScreen.hs +++ b/hledger-ui/Hledger/UI/AccountsScreen.hs @@ -106,7 +106,8 @@ asDraw :: AppState -> [Widget] asDraw AppState{aopts=UIOpts{cliopts_=CliOpts{reportopts_=ropts}} ,ajournal=j ,aScreen=s@AccountsScreen{} - ,aMinibuffer=mbuf} = + ,aMode=mode + } = [ui] where toplabel = files @@ -160,9 +161,9 @@ asDraw AppState{aopts=UIOpts{cliopts_=CliOpts{reportopts_=ropts}} ,("q", "quit") ] - bottomarea = case mbuf of - Nothing -> bottomlabel - Just ed -> minibuffer ed + bottomarea = case mode of + Minibuffer ed -> minibuffer ed + _ -> bottomlabel ui = Widget Greedy Greedy $ do c <- getContext @@ -235,7 +236,7 @@ asHandle st'@AppState{ aScreen=scr@AccountsScreen{..} ,aopts=UIOpts{cliopts_=copts} ,ajournal=j - ,aMinibuffer=mbuf + ,aMode=mode } ev = do d <- liftIO getCurrentDay -- c <- getContext @@ -249,8 +250,16 @@ asHandle st'@AppState{ Nothing -> scr ^. asSelectedAccount st = st'{aScreen=scr & asSelectedAccount .~ selacct} - case mbuf of - Nothing -> + case mode of + Minibuffer ed -> + case ev of + Vty.EvKey Vty.KEsc [] -> continue $ stHideMinibuffer st' + Vty.EvKey Vty.KEnter [] -> continue $ regenerateScreens j d $ stFilter s $ stHideMinibuffer st' + where s = chomp $ unlines $ getEditContents ed + ev -> do ed' <- handleEvent ev ed + continue $ st'{aMode=Minibuffer ed'} + + _ -> case ev of Vty.EvKey (Vty.KChar 'q') [] -> halt st @@ -291,14 +300,6 @@ asHandle st'@AppState{ } -- continue =<< handleEventLensed st' someLens ev - Just ed -> - case ev of - Vty.EvKey Vty.KEsc [] -> continue $ stHideMinibuffer st' - Vty.EvKey Vty.KEnter [] -> continue $ regenerateScreens j d $ stFilter s $ stHideMinibuffer st' - where s = chomp $ unlines $ getEditContents ed - ev -> do ed' <- handleEvent ev ed - continue $ st'{aMinibuffer=Just ed'} - where -- Encourage a more stable scroll position when toggling list items. -- We scroll to the top, and the viewport will automatically diff --git a/hledger-ui/Hledger/UI/Main.hs b/hledger-ui/Hledger/UI/Main.hs index dc1be8e2c..df85f8a24 100644 --- a/hledger-ui/Hledger/UI/Main.hs +++ b/hledger-ui/Hledger/UI/Main.hs @@ -115,7 +115,7 @@ runBrickUi uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}} j = do ,ajournal=j ,aScreen=asSetSelectedAccount acct accountsScreen ,aPrevScreens=[] - ,aMinibuffer=Nothing + ,aMode=Normal } st = (sInit scr) d True @@ -124,7 +124,7 @@ runBrickUi uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}} j = do ,ajournal=j ,aScreen=scr ,aPrevScreens=prevscrs - ,aMinibuffer=Nothing + ,aMode=Normal } brickapp :: App (AppState) V.Event diff --git a/hledger-ui/Hledger/UI/RegisterScreen.hs b/hledger-ui/Hledger/UI/RegisterScreen.hs index 559d4a68e..d1988ee24 100644 --- a/hledger-ui/Hledger/UI/RegisterScreen.hs +++ b/hledger-ui/Hledger/UI/RegisterScreen.hs @@ -101,8 +101,9 @@ rsInit _ _ _ = error "init function called with wrong screen type, should not ha rsDraw :: AppState -> [Widget] rsDraw AppState{aopts=UIOpts{cliopts_=CliOpts{reportopts_=ropts}} - ,aScreen=RegisterScreen{..} - ,aMinibuffer=mbuf} + ,aScreen=RegisterScreen{..} + ,aMode=mode + } = [ui] where toplabel = withAttr ("border" <> "bold") (str $ T.unpack rsAccount) @@ -194,9 +195,9 @@ rsDraw AppState{aopts=UIOpts{cliopts_=CliOpts{reportopts_=ropts}} ,("q", "quit") ] - bottomarea = case mbuf of - Nothing -> bottomlabel - Just ed -> minibuffer ed + bottomarea = case mode of + Minibuffer ed -> minibuffer ed + _ -> bottomlabel render $ defaultLayout toplabel bottomarea $ renderList rsList (rsDrawItem colwidths) @@ -228,11 +229,20 @@ rsHandle st@AppState{ aScreen=s@RegisterScreen{..} ,aopts=UIOpts{cliopts_=copts} ,ajournal=j - ,aMinibuffer=mbuf + ,aMode=mode } ev = do d <- liftIO getCurrentDay - case mbuf of - Nothing -> + + case mode of + Minibuffer ed -> + case ev of + Vty.EvKey Vty.KEsc [] -> continue $ stHideMinibuffer st + Vty.EvKey Vty.KEnter [] -> continue $ regenerateScreens j d $ stFilter s $ stHideMinibuffer st + where s = chomp $ unlines $ getEditContents ed + ev -> do ed' <- handleEvent ev ed + continue $ st{aMode=Minibuffer ed'} + + _ -> case ev of Vty.EvKey (Vty.KChar 'q') [] -> halt st @@ -266,14 +276,6 @@ rsHandle st@AppState{ continue st{aScreen=s{rsList=newitems}} -- continue =<< handleEventLensed st someLens ev - Just ed -> - case ev of - Vty.EvKey Vty.KEsc [] -> continue $ stHideMinibuffer st - Vty.EvKey Vty.KEnter [] -> continue $ regenerateScreens j d $ stFilter s $ stHideMinibuffer st - where s = chomp $ unlines $ getEditContents ed - ev -> do ed' <- handleEvent ev ed - continue $ st{aMinibuffer=Just ed'} - where -- Encourage a more stable scroll position when toggling list items (cf AccountsScreen.hs) scrollTop = vScrollToBeginning $ viewportScroll "register" diff --git a/hledger-ui/Hledger/UI/UITypes.hs b/hledger-ui/Hledger/UI/UITypes.hs index 22a900044..d674a4eb9 100644 --- a/hledger-ui/Hledger/UI/UITypes.hs +++ b/hledger-ui/Hledger/UI/UITypes.hs @@ -56,14 +56,25 @@ instance Show (List a) where show _ = "" instance Show Editor where show _ = "" -- | hledger-ui's application state. This holds one or more stateful screens. +-- As you navigate through screens, the old ones are saved in a stack. +-- The app can be in one of several modes: normal screen operation, +-- showing a help dialog, entering data in the minibuffer etc. data AppState = AppState { aopts :: UIOpts -- ^ the command-line options and query arguments currently in effect ,ajournal :: Journal -- ^ the journal being viewed - ,aScreen :: Screen -- ^ the currently active screen ,aPrevScreens :: [Screen] -- ^ previously visited screens, most recent first - ,aMinibuffer :: Maybe Editor -- ^ a compact editor, when active, used for data entry on all screens + ,aScreen :: Screen -- ^ the currently active screen + ,aMode :: Mode -- ^ the currently active mode } deriving (Show) +-- | The mode modifies the screen's rendering and event handling. +-- It resets to Normal when entering a new screen. +data Mode = + Normal + | Help + | Minibuffer Editor + deriving (Show) + -- | hledger-ui screen types & instances. -- Each screen type has generically named initialisation, draw, and event handling functions, -- and zero or more uniquely named screen state fields, which hold the data for a particular @@ -74,7 +85,7 @@ data Screen = sInit :: Day -> Bool -> AppState -> AppState -- ^ function to initialise or update this screen's state ,sDraw :: AppState -> [Widget] -- ^ brick renderer for this screen ,sHandle :: AppState -> Vty.Event -> EventM (Next AppState) -- ^ brick event handler for this screen - -- state fields. These ones have lenses: + -- state fields.These ones have lenses: ,_asList :: List AccountsScreenItem -- ^ list widget showing account names & balances ,_asSelectedAccount :: AccountName -- ^ a backup of the account name from the list widget's selected item (or "") } diff --git a/hledger-ui/Hledger/UI/UIUtils.hs b/hledger-ui/Hledger/UI/UIUtils.hs index 4cad58ee3..2f1d7ea44 100644 --- a/hledger-ui/Hledger/UI/UIUtils.hs +++ b/hledger-ui/Hledger/UI/UIUtils.hs @@ -154,13 +154,13 @@ setDepth depth st@AppState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_ | otherwise = Just depth -- | Enable the minibuffer, setting its content to the current query with the cursor at the end. -stShowMinibuffer st = st{aMinibuffer=Just e} +stShowMinibuffer st = st{aMode=Minibuffer e} where e = applyEdit gotoEOL $ editor "minibuffer" (str . unlines) (Just 1) oldq oldq = query_ $ reportopts_ $ cliopts_ $ aopts st -- | Disable the minibuffer, discarding any edit in progress. -stHideMinibuffer st = st{aMinibuffer=Nothing} +stHideMinibuffer st = st{aMode=Normal} -- | Regenerate the content for the current and previous screens, from a new journal and current date. regenerateScreens :: Journal -> Day -> AppState -> AppState