slaesvuo/hledger
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

ui: a more general mode mechanism

Browse Source
This commit is contained in:
Simon Michael 2016-06-10 08:40:00 -07:00
parent e6769b26fc
commit aa75cc69f6
5 changed files with 52 additions and 38 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

31
hledger-ui/Hledger/UI/AccountsScreen.hs
View File

@ -106,7 +106,8 @@ asDraw :: AppState -> [Widget]
asDraw AppState{aopts=UIOpts{cliopts_=CliOpts{reportopts_=ropts}} asDraw AppState{aopts=UIOpts{cliopts_=CliOpts{reportopts_=ropts}}
,ajournal=j ,ajournal=j
,aScreen=s@AccountsScreen{} ,aScreen=s@AccountsScreen{}
,aMinibuffer=mbuf} = ,aMode=mode
} =
[ui] [ui]
where where
toplabel = files toplabel = files
@ -160,9 +161,9 @@ asDraw AppState{aopts=UIOpts{cliopts_=CliOpts{reportopts_=ropts}}
,("q", "quit") ,("q", "quit")
] ]
bottomarea = case mbuf of bottomarea = case mode of
Nothing -> bottomlabel Minibuffer ed -> minibuffer ed
Just ed -> minibuffer ed _ -> bottomlabel
ui = Widget Greedy Greedy $ do ui = Widget Greedy Greedy $ do
c <- getContext c <- getContext
@ -235,7 +236,7 @@ asHandle st'@AppState{
aScreen=scr@AccountsScreen{..} aScreen=scr@AccountsScreen{..}
,aopts=UIOpts{cliopts_=copts} ,aopts=UIOpts{cliopts_=copts}
,ajournal=j ,ajournal=j
,aMinibuffer=mbuf ,aMode=mode
} ev = do } ev = do
d <- liftIO getCurrentDay d <- liftIO getCurrentDay
-- c <- getContext -- c <- getContext
@ -249,8 +250,16 @@ asHandle st'@AppState{
Nothing -> scr ^. asSelectedAccount Nothing -> scr ^. asSelectedAccount
st = st'{aScreen=scr & asSelectedAccount .~ selacct} st = st'{aScreen=scr & asSelectedAccount .~ selacct}
case mbuf of case mode of
Nothing -> 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 case ev of
Vty.EvKey (Vty.KChar 'q') [] -> halt st Vty.EvKey (Vty.KChar 'q') [] -> halt st
@ -291,14 +300,6 @@ asHandle st'@AppState{
} }
-- continue =<< handleEventLensed st' someLens ev -- 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 where
-- Encourage a more stable scroll position when toggling list items. -- Encourage a more stable scroll position when toggling list items.
-- We scroll to the top, and the viewport will automatically -- We scroll to the top, and the viewport will automatically

4
hledger-ui/Hledger/UI/Main.hs
View File

@ -115,7 +115,7 @@ runBrickUi uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}} j = do
,ajournal=j ,ajournal=j
,aScreen=asSetSelectedAccount acct accountsScreen ,aScreen=asSetSelectedAccount acct accountsScreen
,aPrevScreens=[] ,aPrevScreens=[]
,aMinibuffer=Nothing ,aMode=Normal
} }
st = (sInit scr) d True st = (sInit scr) d True
@ -124,7 +124,7 @@ runBrickUi uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}} j = do
,ajournal=j ,ajournal=j
,aScreen=scr ,aScreen=scr
,aPrevScreens=prevscrs ,aPrevScreens=prevscrs
,aMinibuffer=Nothing ,aMode=Normal
} }
brickapp :: App (AppState) V.Event brickapp :: App (AppState) V.Event

34
hledger-ui/Hledger/UI/RegisterScreen.hs
View File

@ -101,8 +101,9 @@ rsInit _ _ _ = error "init function called with wrong screen type, should not ha
rsDraw :: AppState -> [Widget] rsDraw :: AppState -> [Widget]
rsDraw AppState{aopts=UIOpts{cliopts_=CliOpts{reportopts_=ropts}} rsDraw AppState{aopts=UIOpts{cliopts_=CliOpts{reportopts_=ropts}}
,aScreen=RegisterScreen{..} ,aScreen=RegisterScreen{..}
,aMinibuffer=mbuf} ,aMode=mode
}
= [ui] = [ui]
where where
toplabel = withAttr ("border" <> "bold") (str $ T.unpack rsAccount) toplabel = withAttr ("border" <> "bold") (str $ T.unpack rsAccount)
@ -194,9 +195,9 @@ rsDraw AppState{aopts=UIOpts{cliopts_=CliOpts{reportopts_=ropts}}
,("q", "quit") ,("q", "quit")
] ]
bottomarea = case mbuf of bottomarea = case mode of
Nothing -> bottomlabel Minibuffer ed -> minibuffer ed
Just ed -> minibuffer ed _ -> bottomlabel
render $ defaultLayout toplabel bottomarea $ renderList rsList (rsDrawItem colwidths) render $ defaultLayout toplabel bottomarea $ renderList rsList (rsDrawItem colwidths)
@ -228,11 +229,20 @@ rsHandle st@AppState{
aScreen=s@RegisterScreen{..} aScreen=s@RegisterScreen{..}
,aopts=UIOpts{cliopts_=copts} ,aopts=UIOpts{cliopts_=copts}
,ajournal=j ,ajournal=j
,aMinibuffer=mbuf ,aMode=mode
} ev = do } ev = do
d <- liftIO getCurrentDay 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 case ev of
Vty.EvKey (Vty.KChar 'q') [] -> halt st Vty.EvKey (Vty.KChar 'q') [] -> halt st
@ -266,14 +276,6 @@ rsHandle st@AppState{
continue st{aScreen=s{rsList=newitems}} continue st{aScreen=s{rsList=newitems}}
-- continue =<< handleEventLensed st someLens ev -- 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 where
-- Encourage a more stable scroll position when toggling list items (cf AccountsScreen.hs) -- Encourage a more stable scroll position when toggling list items (cf AccountsScreen.hs)
scrollTop = vScrollToBeginning $ viewportScroll "register" scrollTop = vScrollToBeginning $ viewportScroll "register"

17
hledger-ui/Hledger/UI/UITypes.hs
View File

@ -56,14 +56,25 @@ instance Show (List a) where show _ = "<List>"
instance Show Editor where show _ = "<Editor>" instance Show Editor where show _ = "<Editor>"
-- | hledger-ui's application state. This holds one or more stateful screens. -- | 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 { data AppState = AppState {
aopts :: UIOpts -- ^ the command-line options and query arguments currently in effect aopts :: UIOpts -- ^ the command-line options and query arguments currently in effect
,ajournal :: Journal -- ^ the journal being viewed ,ajournal :: Journal -- ^ the journal being viewed
,aScreen :: Screen -- ^ the currently active screen
,aPrevScreens :: [Screen] -- ^ previously visited screens, most recent first ,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) } 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. -- | hledger-ui screen types & instances.
-- Each screen type has generically named initialisation, draw, and event handling functions, -- 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 -- 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 sInit :: Day -> Bool -> AppState -> AppState -- ^ function to initialise or update this screen's state
,sDraw :: AppState -> [Widget] -- ^ brick renderer for this screen ,sDraw :: AppState -> [Widget] -- ^ brick renderer for this screen
,sHandle :: AppState -> Vty.Event -> EventM (Next AppState) -- ^ brick event handler 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 ,_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 "") ,_asSelectedAccount :: AccountName -- ^ a backup of the account name from the list widget's selected item (or "")
} }

4
hledger-ui/Hledger/UI/UIUtils.hs
View File

@ -154,13 +154,13 @@ setDepth depth st@AppState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_
| otherwise = Just depth | otherwise = Just depth
-- | Enable the minibuffer, setting its content to the current query with the cursor at the end. -- | 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 where
e = applyEdit gotoEOL $ editor "minibuffer" (str . unlines) (Just 1) oldq e = applyEdit gotoEOL $ editor "minibuffer" (str . unlines) (Just 1) oldq
oldq = query_ $ reportopts_ $ cliopts_ $ aopts st oldq = query_ $ reportopts_ $ cliopts_ $ aopts st
-- | Disable the minibuffer, discarding any edit in progress. -- | 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. -- | Regenerate the content for the current and previous screens, from a new journal and current date.
regenerateScreens :: Journal -> Day -> AppState -> AppState regenerateScreens :: Journal -> Day -> AppState -> AppState