ui: a more general mode mechanism
This commit is contained in:
Simon Michael
parent
e6769b26fc
commit
aa75cc69f6
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -102,7 +102,8 @@ 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}
|
||||
,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"
|
||||
|
||||
@ -56,14 +56,25 @@ instance Show (List a) where show _ = "<List>"
|
||||
instance Show Editor where show _ = "<Editor>"
|
||||
|
||||
-- | 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
|
||||
|
||||
@ -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
|
||||
|
||||
Loading…
Reference in New Issue
Block a user