ui: refactor: AppState -> UIState, cleanups
This commit is contained in:
Simon Michael
parent
0851851ea9
commit
47a8eb53c8
@ -21,7 +21,7 @@ import qualified Data.Text as T
|
||||
import Data.Time.Calendar (Day)
|
||||
import System.FilePath (takeFileName)
|
||||
import qualified Data.Vector as V
|
||||
import Graphics.Vty as Vty
|
||||
import Graphics.Vty
|
||||
import Brick
|
||||
-- import Brick.Widgets.Center
|
||||
import Brick.Widgets.List
|
||||
@ -37,6 +37,7 @@ import Hledger.Cli hiding (progname,prognameandversion,green)
|
||||
import Hledger.UI.UIOptions
|
||||
-- import Hledger.UI.Theme
|
||||
import Hledger.UI.UITypes
|
||||
import Hledger.UI.UIState
|
||||
import Hledger.UI.UIUtils
|
||||
import Hledger.UI.RegisterScreen
|
||||
import Hledger.UI.ErrorScreen
|
||||
@ -50,13 +51,13 @@ accountsScreen = AccountsScreen{
|
||||
,_asSelectedAccount = ""
|
||||
}
|
||||
|
||||
asInit :: Day -> Bool -> AppState -> AppState
|
||||
asInit d reset st@AppState{
|
||||
asInit :: Day -> Bool -> UIState -> UIState
|
||||
asInit d reset ui@UIState{
|
||||
aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}},
|
||||
ajournal=j,
|
||||
aScreen=s@AccountsScreen{}
|
||||
} =
|
||||
st{aopts=uopts', aScreen=s & asList .~ newitems'}
|
||||
ui{aopts=uopts', aScreen=s & asList .~ newitems'}
|
||||
where
|
||||
newitems = list (Name "accounts") (V.fromList displayitems) 1
|
||||
|
||||
@ -103,8 +104,8 @@ asInit d reset st@AppState{
|
||||
|
||||
asInit _ _ _ = error "init function called with wrong screen type, should not happen"
|
||||
|
||||
asDraw :: AppState -> [Widget]
|
||||
asDraw AppState{aopts=UIOpts{cliopts_=CliOpts{reportopts_=ropts}}
|
||||
asDraw :: UIState -> [Widget]
|
||||
asDraw UIState{aopts=UIOpts{cliopts_=CliOpts{reportopts_=ropts}}
|
||||
,ajournal=j
|
||||
,aScreen=s@AccountsScreen{}
|
||||
,aMode=mode
|
||||
@ -230,8 +231,8 @@ asDrawItem (acctwidth, balwidth) selected AccountsScreenItem{..} =
|
||||
sel | selected = (<> "selected")
|
||||
| otherwise = id
|
||||
|
||||
asHandle :: AppState -> Vty.Event -> EventM (Next AppState)
|
||||
asHandle st'@AppState{
|
||||
asHandle :: UIState -> Event -> EventM (Next UIState)
|
||||
asHandle ui0@UIState{
|
||||
aScreen=scr@AccountsScreen{..}
|
||||
,aopts=UIOpts{cliopts_=copts}
|
||||
,ajournal=j
|
||||
@ -247,62 +248,62 @@ asHandle st'@AppState{
|
||||
selacct = case listSelectedElement $ scr ^. asList of
|
||||
Just (_, AccountsScreenItem{..}) -> asItemAccountName
|
||||
Nothing -> scr ^. asSelectedAccount
|
||||
st = st'{aScreen=scr & asSelectedAccount .~ selacct}
|
||||
ui = ui0{aScreen=scr & asSelectedAccount .~ selacct}
|
||||
|
||||
case mode of
|
||||
Minibuffer ed ->
|
||||
case ev of
|
||||
EvKey KEsc [] -> continue $ stCloseMinibuffer st
|
||||
EvKey KEnter [] -> continue $ regenerateScreens j d $ stFilter s $ stCloseMinibuffer st
|
||||
EvKey KEsc [] -> continue $ closeMinibuffer ui
|
||||
EvKey KEnter [] -> continue $ regenerateScreens j d $ setFilter s $ closeMinibuffer ui
|
||||
where s = chomp $ unlines $ getEditContents ed
|
||||
ev -> do ed' <- handleEvent ev ed
|
||||
continue $ st{aMode=Minibuffer ed'}
|
||||
continue $ ui{aMode=Minibuffer ed'}
|
||||
|
||||
Help ->
|
||||
case ev of
|
||||
EvKey (KChar 'q') [] -> halt st
|
||||
_ -> helpHandle st ev
|
||||
EvKey (KChar 'q') [] -> halt ui
|
||||
_ -> helpHandle ui ev
|
||||
|
||||
Normal ->
|
||||
case ev of
|
||||
EvKey (KChar 'q') [] -> halt st
|
||||
EvKey (KChar 'q') [] -> halt ui
|
||||
-- EvKey (KChar 'l') [MCtrl] -> do
|
||||
EvKey KEsc [] -> continue $ resetScreens d st
|
||||
EvKey k [] | k `elem` [KChar 'h', KChar '?'] -> continue $ setMode Help st
|
||||
EvKey (KChar 'g') [] -> liftIO (stReloadJournalIfChanged copts d j st) >>= continue
|
||||
EvKey (KChar 'a') [] -> suspendAndResume $ clearScreen >> setCursorPosition 0 0 >> add copts j >> stReloadJournalIfChanged copts d j st
|
||||
EvKey (KChar '0') [] -> continue $ regenerateScreens j d $ setDepth (Just 0) st
|
||||
EvKey (KChar '1') [] -> continue $ regenerateScreens j d $ setDepth (Just 1) st
|
||||
EvKey (KChar '2') [] -> continue $ regenerateScreens j d $ setDepth (Just 2) st
|
||||
EvKey (KChar '3') [] -> continue $ regenerateScreens j d $ setDepth (Just 3) st
|
||||
EvKey (KChar '4') [] -> continue $ regenerateScreens j d $ setDepth (Just 4) st
|
||||
EvKey (KChar '5') [] -> continue $ regenerateScreens j d $ setDepth (Just 5) st
|
||||
EvKey (KChar '6') [] -> continue $ regenerateScreens j d $ setDepth (Just 6) st
|
||||
EvKey (KChar '7') [] -> continue $ regenerateScreens j d $ setDepth (Just 7) st
|
||||
EvKey (KChar '8') [] -> continue $ regenerateScreens j d $ setDepth (Just 8) st
|
||||
EvKey (KChar '9') [] -> continue $ regenerateScreens j d $ setDepth (Just 9) st
|
||||
EvKey (KChar '-') [] -> continue $ regenerateScreens j d $ decDepth st
|
||||
EvKey (KChar '_') [] -> continue $ regenerateScreens j d $ decDepth st
|
||||
EvKey k [] | k `elem` [KChar '+', KChar '='] -> continue $ regenerateScreens j d $ incDepth st
|
||||
EvKey (KChar 'F') [] -> continue $ regenerateScreens j d $ stToggleFlat st
|
||||
EvKey (KChar 'E') [] -> scrollTop >> (continue $ regenerateScreens j d $ stToggleEmpty st)
|
||||
EvKey (KChar 'C') [] -> scrollTop >> (continue $ regenerateScreens j d $ stToggleCleared st)
|
||||
EvKey (KChar 'U') [] -> scrollTop >> (continue $ regenerateScreens j d $ stToggleUncleared st)
|
||||
EvKey (KChar 'R') [] -> scrollTop >> (continue $ regenerateScreens j d $ stToggleReal st)
|
||||
EvKey k [] | k `elem` [KChar '/'] -> continue $ regenerateScreens j d $ stShowMinibuffer st
|
||||
EvKey k [] | k `elem` [KBS, KDel] -> (continue $ regenerateScreens j d $ stResetFilter st)
|
||||
EvKey (KLeft) [] -> continue $ popScreen st
|
||||
EvKey (k) [] | k `elem` [KRight, KEnter] -> scrollTopRegister >> continue (screenEnter d scr st)
|
||||
EvKey KEsc [] -> continue $ resetScreens d ui
|
||||
EvKey k [] | k `elem` [KChar 'h', KChar '?'] -> continue $ setMode Help ui
|
||||
EvKey (KChar 'g') [] -> liftIO (uiReloadJournalIfChanged copts d j ui) >>= continue
|
||||
EvKey (KChar 'a') [] -> suspendAndResume $ clearScreen >> setCursorPosition 0 0 >> add copts j >> uiReloadJournalIfChanged copts d j ui
|
||||
EvKey (KChar '0') [] -> continue $ regenerateScreens j d $ setDepth (Just 0) ui
|
||||
EvKey (KChar '1') [] -> continue $ regenerateScreens j d $ setDepth (Just 1) ui
|
||||
EvKey (KChar '2') [] -> continue $ regenerateScreens j d $ setDepth (Just 2) ui
|
||||
EvKey (KChar '3') [] -> continue $ regenerateScreens j d $ setDepth (Just 3) ui
|
||||
EvKey (KChar '4') [] -> continue $ regenerateScreens j d $ setDepth (Just 4) ui
|
||||
EvKey (KChar '5') [] -> continue $ regenerateScreens j d $ setDepth (Just 5) ui
|
||||
EvKey (KChar '6') [] -> continue $ regenerateScreens j d $ setDepth (Just 6) ui
|
||||
EvKey (KChar '7') [] -> continue $ regenerateScreens j d $ setDepth (Just 7) ui
|
||||
EvKey (KChar '8') [] -> continue $ regenerateScreens j d $ setDepth (Just 8) ui
|
||||
EvKey (KChar '9') [] -> continue $ regenerateScreens j d $ setDepth (Just 9) ui
|
||||
EvKey (KChar '-') [] -> continue $ regenerateScreens j d $ decDepth ui
|
||||
EvKey (KChar '_') [] -> continue $ regenerateScreens j d $ decDepth ui
|
||||
EvKey k [] | k `elem` [KChar '+', KChar '='] -> continue $ regenerateScreens j d $ incDepth ui
|
||||
EvKey (KChar 'F') [] -> continue $ regenerateScreens j d $ toggleFlat ui
|
||||
EvKey (KChar 'E') [] -> scrollTop >> (continue $ regenerateScreens j d $ toggleEmpty ui)
|
||||
EvKey (KChar 'C') [] -> scrollTop >> (continue $ regenerateScreens j d $ toggleCleared ui)
|
||||
EvKey (KChar 'U') [] -> scrollTop >> (continue $ regenerateScreens j d $ toggleUncleared ui)
|
||||
EvKey (KChar 'R') [] -> scrollTop >> (continue $ regenerateScreens j d $ toggleReal ui)
|
||||
EvKey k [] | k `elem` [KChar '/'] -> continue $ regenerateScreens j d $ showMinibuffer ui
|
||||
EvKey k [] | k `elem` [KBS, KDel] -> (continue $ regenerateScreens j d $ resetFilter ui)
|
||||
EvKey (KLeft) [] -> continue $ popScreen ui
|
||||
EvKey (k) [] | k `elem` [KRight, KEnter] -> scrollTopRegister >> continue (screenEnter d scr ui)
|
||||
where
|
||||
scr = rsSetAccount selacct registerScreen
|
||||
|
||||
-- fall through to the list's event handler (handles up/down)
|
||||
ev -> do
|
||||
newitems <- handleEvent ev (scr ^. asList)
|
||||
continue $ st{aScreen=scr & asList .~ newitems
|
||||
continue $ ui{aScreen=scr & asList .~ newitems
|
||||
& asSelectedAccount .~ selacct
|
||||
}
|
||||
-- continue =<< handleEventLensed st someLens ev
|
||||
-- continue =<< handleEventLensed ui someLens ev
|
||||
|
||||
where
|
||||
-- Encourage a more stable scroll position when toggling list items.
|
||||
|
||||
@ -4,7 +4,7 @@
|
||||
|
||||
module Hledger.UI.ErrorScreen
|
||||
(errorScreen
|
||||
,stReloadJournalIfChanged
|
||||
,uiReloadJournalIfChanged
|
||||
)
|
||||
where
|
||||
|
||||
@ -13,7 +13,7 @@ import Control.Monad.IO.Class (liftIO)
|
||||
import Data.Monoid
|
||||
-- import Data.Maybe
|
||||
import Data.Time.Calendar (Day)
|
||||
import Graphics.Vty as Vty
|
||||
import Graphics.Vty
|
||||
import Brick
|
||||
-- import Brick.Widgets.List
|
||||
-- import Brick.Widgets.Border
|
||||
@ -26,6 +26,7 @@ import Hledger.Cli hiding (progname,prognameandversion,green)
|
||||
import Hledger.UI.UIOptions
|
||||
-- import Hledger.UI.Theme
|
||||
import Hledger.UI.UITypes
|
||||
import Hledger.UI.UIState
|
||||
import Hledger.UI.UIUtils
|
||||
|
||||
errorScreen :: Screen
|
||||
@ -36,12 +37,12 @@ errorScreen = ErrorScreen{
|
||||
,esError = ""
|
||||
}
|
||||
|
||||
esInit :: Day -> Bool -> AppState -> AppState
|
||||
esInit _ _ st@AppState{aScreen=ErrorScreen{}} = st
|
||||
esInit :: Day -> Bool -> UIState -> UIState
|
||||
esInit _ _ ui@UIState{aScreen=ErrorScreen{}} = ui
|
||||
esInit _ _ _ = error "init function called with wrong screen type, should not happen"
|
||||
|
||||
esDraw :: AppState -> [Widget]
|
||||
esDraw AppState{ -- aopts=_uopts@UIOpts{cliopts_=_copts@CliOpts{reportopts_=_ropts@ReportOpts{query_=querystr}}},
|
||||
esDraw :: UIState -> [Widget]
|
||||
esDraw UIState{ -- aopts=_uopts@UIOpts{cliopts_=_copts@CliOpts{reportopts_=_ropts@ReportOpts{query_=querystr}}},
|
||||
aScreen=ErrorScreen{..}
|
||||
,aMode=mode} =
|
||||
case mode of
|
||||
@ -65,8 +66,8 @@ esDraw AppState{ -- aopts=_uopts@UIOpts{cliopts_=_copts@CliOpts{reportopts_=_rop
|
||||
|
||||
esDraw _ = error "draw function called with wrong screen type, should not happen"
|
||||
|
||||
esHandle :: AppState -> Vty.Event -> EventM (Next AppState)
|
||||
esHandle st@AppState{
|
||||
esHandle :: UIState -> Event -> EventM (Next UIState)
|
||||
esHandle ui@UIState{
|
||||
aScreen=s@ErrorScreen{}
|
||||
,aopts=UIOpts{cliopts_=copts}
|
||||
,ajournal=j
|
||||
@ -75,35 +76,35 @@ esHandle st@AppState{
|
||||
case mode of
|
||||
Help ->
|
||||
case ev of
|
||||
EvKey (KChar 'q') [] -> halt st
|
||||
_ -> helpHandle st ev
|
||||
EvKey (KChar 'q') [] -> halt ui
|
||||
_ -> helpHandle ui ev
|
||||
|
||||
_ -> do
|
||||
d <- liftIO getCurrentDay
|
||||
case ev of
|
||||
EvKey (KChar 'q') [] -> halt st
|
||||
EvKey KEsc [] -> continue $ resetScreens d st
|
||||
EvKey k [] | k `elem` [KChar 'h', KChar '?'] -> continue $ setMode Help st
|
||||
EvKey (KChar 'q') [] -> halt ui
|
||||
EvKey KEsc [] -> continue $ resetScreens d ui
|
||||
EvKey k [] | k `elem` [KChar 'h', KChar '?'] -> continue $ setMode Help ui
|
||||
EvKey (KChar 'g') [] -> do
|
||||
(ej, _) <- liftIO $ journalReloadIfChanged copts d j
|
||||
case ej of
|
||||
Left err -> continue st{aScreen=s{esError=err}} -- show latest parse error
|
||||
Right j' -> continue $ regenerateScreens j' d $ popScreen st -- return to previous screen, and reload it
|
||||
-- EvKey (KLeft) [] -> continue $ popScreen st
|
||||
Left err -> continue ui{aScreen=s{esError=err}} -- show latest parse error
|
||||
Right j' -> continue $ regenerateScreens j' d $ popScreen ui -- return to previous screen, and reload it
|
||||
-- EvKey (KLeft) [] -> continue $ popScreen ui
|
||||
-- EvKey (KRight) [] -> error (show curItem) where curItem = listSelectedElement is
|
||||
-- fall through to the list's event handler (handles [pg]up/down)
|
||||
_ -> do continue st
|
||||
_ -> do continue ui
|
||||
-- is' <- handleEvent ev is
|
||||
-- continue st{aScreen=s{rsState=is'}}
|
||||
-- continue =<< handleEventLensed st someLens e
|
||||
-- continue ui{aScreen=s{rsState=is'}}
|
||||
-- continue =<< handleEventLensed ui someLens e
|
||||
esHandle _ _ = error "event handler called with wrong screen type, should not happen"
|
||||
|
||||
-- If journal file(s) have changed, reload the journal and regenerate all screens.
|
||||
-- This is here so it can reference the error screen.
|
||||
stReloadJournalIfChanged :: CliOpts -> Day -> Journal -> AppState -> IO AppState
|
||||
stReloadJournalIfChanged copts d j st = do
|
||||
uiReloadJournalIfChanged :: CliOpts -> Day -> Journal -> UIState -> IO UIState
|
||||
uiReloadJournalIfChanged copts d j ui = do
|
||||
(ej, _) <- journalReloadIfChanged copts d j
|
||||
return $ case ej of
|
||||
Right j' -> regenerateScreens j' d st
|
||||
Left err -> screenEnter d errorScreen{esError=err} st
|
||||
Right j' -> regenerateScreens j' d ui
|
||||
Left err -> screenEnter d errorScreen{esError=err} ui
|
||||
|
||||
|
||||
@ -107,10 +107,10 @@ runBrickUi uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}} j = do
|
||||
(error' $ "--register "++apat++" did not match any account")
|
||||
$ filter (regexMatches apat . T.unpack) $ journalAccountNames j
|
||||
-- Initialising the accounts screen is awkward, requiring
|
||||
-- another temporary AppState value..
|
||||
-- another temporary UIState value..
|
||||
ascr' = aScreen $
|
||||
asInit d True $
|
||||
AppState{
|
||||
UIState{
|
||||
aopts=uopts'
|
||||
,ajournal=j
|
||||
,aScreen=asSetSelectedAccount acct accountsScreen
|
||||
@ -118,8 +118,8 @@ runBrickUi uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}} j = do
|
||||
,aMode=Normal
|
||||
}
|
||||
|
||||
st = (sInit scr) d True
|
||||
AppState{
|
||||
ui = (sInit scr) d True
|
||||
UIState{
|
||||
aopts=uopts'
|
||||
,ajournal=j
|
||||
,aScreen=scr
|
||||
@ -127,20 +127,15 @@ runBrickUi uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}} j = do
|
||||
,aMode=Normal
|
||||
}
|
||||
|
||||
brickapp :: App (AppState) V.Event
|
||||
brickapp :: App (UIState) V.Event
|
||||
brickapp = App {
|
||||
appLiftVtyEvent = id
|
||||
, appStartEvent = return
|
||||
, appAttrMap = const theme
|
||||
, appChooseCursor = showFirstCursor
|
||||
, appHandleEvent = \st ev -> sHandle (aScreen st) st ev
|
||||
, appDraw = \st -> sDraw (aScreen st) st
|
||||
-- XXX bizarro. removing the st arg and parameter above,
|
||||
-- which according to GHCI does not change the type,
|
||||
-- causes "Exception: draw function called with wrong screen type"
|
||||
-- on entering a register. Likewise, removing the st ev args and parameters
|
||||
-- causes an exception on exiting a register.
|
||||
, appHandleEvent = \ui ev -> sHandle (aScreen ui) ui ev
|
||||
, appDraw = \ui -> sDraw (aScreen ui) ui
|
||||
}
|
||||
|
||||
void $ defaultMain brickapp st
|
||||
void $ defaultMain brickapp ui
|
||||
|
||||
|
||||
@ -18,7 +18,7 @@ import Data.Maybe
|
||||
import qualified Data.Text as T
|
||||
import Data.Time.Calendar (Day)
|
||||
import qualified Data.Vector as V
|
||||
import Graphics.Vty as Vty
|
||||
import Graphics.Vty
|
||||
import Brick
|
||||
import Brick.Widgets.List
|
||||
import Brick.Widgets.Edit
|
||||
@ -33,6 +33,7 @@ import Hledger.Cli hiding (progname,prognameandversion,green)
|
||||
import Hledger.UI.UIOptions
|
||||
-- import Hledger.UI.Theme
|
||||
import Hledger.UI.UITypes
|
||||
import Hledger.UI.UIState
|
||||
import Hledger.UI.UIUtils
|
||||
import Hledger.UI.TransactionScreen
|
||||
import Hledger.UI.ErrorScreen
|
||||
@ -49,9 +50,9 @@ registerScreen = RegisterScreen{
|
||||
rsSetAccount a scr@RegisterScreen{} = scr{rsAccount=a}
|
||||
rsSetAccount _ scr = scr
|
||||
|
||||
rsInit :: Day -> Bool -> AppState -> AppState
|
||||
rsInit d reset st@AppState{aopts=opts, ajournal=j, aScreen=s@RegisterScreen{..}} =
|
||||
st{aScreen=s{rsList=newitems'}}
|
||||
rsInit :: Day -> Bool -> UIState -> UIState
|
||||
rsInit d reset ui@UIState{aopts=opts, ajournal=j, aScreen=s@RegisterScreen{..}} =
|
||||
ui{aScreen=s{rsList=newitems'}}
|
||||
where
|
||||
-- gather arguments and queries
|
||||
ropts = (reportopts_ $ cliopts_ opts)
|
||||
@ -99,8 +100,8 @@ rsInit d reset st@AppState{aopts=opts, ajournal=j, aScreen=s@RegisterScreen{..}}
|
||||
|
||||
rsInit _ _ _ = error "init function called with wrong screen type, should not happen"
|
||||
|
||||
rsDraw :: AppState -> [Widget]
|
||||
rsDraw AppState{aopts=UIOpts{cliopts_=CliOpts{reportopts_=ropts}}
|
||||
rsDraw :: UIState -> [Widget]
|
||||
rsDraw UIState{aopts=UIOpts{cliopts_=CliOpts{reportopts_=ropts}}
|
||||
,aScreen=RegisterScreen{..}
|
||||
,aMode=mode
|
||||
} =
|
||||
@ -219,8 +220,8 @@ rsDrawItem (datewidth,descwidth,acctswidth,changewidth,balwidth) selected Regist
|
||||
sel | selected = (<> "selected")
|
||||
| otherwise = id
|
||||
|
||||
rsHandle :: AppState -> Vty.Event -> EventM (Next AppState)
|
||||
rsHandle st@AppState{
|
||||
rsHandle :: UIState -> Event -> EventM (Next UIState)
|
||||
rsHandle ui@UIState{
|
||||
aScreen=s@RegisterScreen{..}
|
||||
,aopts=UIOpts{cliopts_=copts}
|
||||
,ajournal=j
|
||||
@ -231,31 +232,31 @@ rsHandle st@AppState{
|
||||
case mode of
|
||||
Minibuffer ed ->
|
||||
case ev of
|
||||
EvKey KEsc [] -> continue $ stCloseMinibuffer st
|
||||
EvKey KEnter [] -> continue $ regenerateScreens j d $ stFilter s $ stCloseMinibuffer st
|
||||
EvKey KEsc [] -> continue $ closeMinibuffer ui
|
||||
EvKey KEnter [] -> continue $ regenerateScreens j d $ setFilter s $ closeMinibuffer ui
|
||||
where s = chomp $ unlines $ getEditContents ed
|
||||
ev -> do ed' <- handleEvent ev ed
|
||||
continue $ st{aMode=Minibuffer ed'}
|
||||
continue $ ui{aMode=Minibuffer ed'}
|
||||
|
||||
Help ->
|
||||
case ev of
|
||||
EvKey (KChar 'q') [] -> halt st
|
||||
_ -> helpHandle st ev
|
||||
EvKey (KChar 'q') [] -> halt ui
|
||||
_ -> helpHandle ui ev
|
||||
|
||||
Normal ->
|
||||
case ev of
|
||||
EvKey (KChar 'q') [] -> halt st
|
||||
EvKey KEsc [] -> continue $ resetScreens d st
|
||||
EvKey k [] | k `elem` [KChar 'h', KChar '?'] -> continue $ setMode Help st
|
||||
EvKey (KChar 'g') [] -> liftIO (stReloadJournalIfChanged copts d j st) >>= continue
|
||||
EvKey (KChar 'a') [] -> suspendAndResume $ clearScreen >> setCursorPosition 0 0 >> add copts j >> stReloadJournalIfChanged copts d j st
|
||||
EvKey (KChar 'E') [] -> scrollTop >> (continue $ regenerateScreens j d $ stToggleEmpty st)
|
||||
EvKey (KChar 'C') [] -> scrollTop >> (continue $ regenerateScreens j d $ stToggleCleared st)
|
||||
EvKey (KChar 'U') [] -> scrollTop >> (continue $ regenerateScreens j d $ stToggleUncleared st)
|
||||
EvKey (KChar 'R') [] -> scrollTop >> (continue $ regenerateScreens j d $ stToggleReal st)
|
||||
EvKey k [] | k `elem` [KChar '/'] -> (continue $ regenerateScreens j d $ stShowMinibuffer st)
|
||||
EvKey k [] | k `elem` [KBS, KDel] -> (continue $ regenerateScreens j d $ stResetFilter st)
|
||||
EvKey (KLeft) [] -> continue $ popScreen st
|
||||
EvKey (KChar 'q') [] -> halt ui
|
||||
EvKey KEsc [] -> continue $ resetScreens d ui
|
||||
EvKey k [] | k `elem` [KChar 'h', KChar '?'] -> continue $ setMode Help ui
|
||||
EvKey (KChar 'g') [] -> liftIO (uiReloadJournalIfChanged copts d j ui) >>= continue
|
||||
EvKey (KChar 'a') [] -> suspendAndResume $ clearScreen >> setCursorPosition 0 0 >> add copts j >> uiReloadJournalIfChanged copts d j ui
|
||||
EvKey (KChar 'E') [] -> scrollTop >> (continue $ regenerateScreens j d $ toggleEmpty ui)
|
||||
EvKey (KChar 'C') [] -> scrollTop >> (continue $ regenerateScreens j d $ toggleCleared ui)
|
||||
EvKey (KChar 'U') [] -> scrollTop >> (continue $ regenerateScreens j d $ toggleUncleared ui)
|
||||
EvKey (KChar 'R') [] -> scrollTop >> (continue $ regenerateScreens j d $ toggleReal ui)
|
||||
EvKey k [] | k `elem` [KChar '/'] -> (continue $ regenerateScreens j d $ showMinibuffer ui)
|
||||
EvKey k [] | k `elem` [KBS, KDel] -> (continue $ regenerateScreens j d $ resetFilter ui)
|
||||
EvKey (KLeft) [] -> continue $ popScreen ui
|
||||
|
||||
EvKey (k) [] | k `elem` [KRight, KEnter] -> do
|
||||
case listSelectedElement rsList of
|
||||
@ -267,13 +268,13 @@ rsHandle st@AppState{
|
||||
in
|
||||
continue $ screenEnter d transactionScreen{tsTransaction=(i,t)
|
||||
,tsTransactions=numberedts
|
||||
,tsAccount=rsAccount} st
|
||||
Nothing -> continue st
|
||||
,tsAccount=rsAccount} ui
|
||||
Nothing -> continue ui
|
||||
|
||||
-- fall through to the list's event handler (handles [pg]up/down)
|
||||
ev -> do newitems <- handleEvent ev rsList
|
||||
continue st{aScreen=s{rsList=newitems}}
|
||||
-- continue =<< handleEventLensed st someLens ev
|
||||
continue ui{aScreen=s{rsList=newitems}}
|
||||
-- continue =<< handleEventLensed ui someLens ev
|
||||
|
||||
where
|
||||
-- Encourage a more stable scroll position when toggling list items (cf AccountsScreen.hs)
|
||||
|
||||
@ -19,7 +19,7 @@ import Data.Monoid
|
||||
import qualified Data.Text as T
|
||||
import Data.Time.Calendar (Day)
|
||||
-- import qualified Data.Vector as V
|
||||
import Graphics.Vty as Vty
|
||||
import Graphics.Vty
|
||||
-- import Safe (headDef, lastDef)
|
||||
import Brick
|
||||
import Brick.Widgets.List (listMoveTo)
|
||||
@ -33,6 +33,7 @@ import Hledger.Cli hiding (progname,prognameandversion,green)
|
||||
import Hledger.UI.UIOptions
|
||||
-- import Hledger.UI.Theme
|
||||
import Hledger.UI.UITypes
|
||||
import Hledger.UI.UIState
|
||||
import Hledger.UI.UIUtils
|
||||
import Hledger.UI.ErrorScreen
|
||||
|
||||
@ -46,14 +47,14 @@ transactionScreen = TransactionScreen{
|
||||
,tsAccount = ""
|
||||
}
|
||||
|
||||
tsInit :: Day -> Bool -> AppState -> AppState
|
||||
tsInit _d _reset st@AppState{aopts=UIOpts{cliopts_=CliOpts{reportopts_=_ropts}}
|
||||
tsInit :: Day -> Bool -> UIState -> UIState
|
||||
tsInit _d _reset ui@UIState{aopts=UIOpts{cliopts_=CliOpts{reportopts_=_ropts}}
|
||||
,ajournal=_j
|
||||
,aScreen=TransactionScreen{..}} = st
|
||||
,aScreen=TransactionScreen{..}} = ui
|
||||
tsInit _ _ _ = error "init function called with wrong screen type, should not happen"
|
||||
|
||||
tsDraw :: AppState -> [Widget]
|
||||
tsDraw AppState{aopts=UIOpts{cliopts_=CliOpts{reportopts_=ropts}}
|
||||
tsDraw :: UIState -> [Widget]
|
||||
tsDraw UIState{aopts=UIOpts{cliopts_=CliOpts{reportopts_=ropts}}
|
||||
,aScreen=TransactionScreen{
|
||||
tsTransaction=(i,t)
|
||||
,tsTransactions=nts
|
||||
@ -107,8 +108,8 @@ tsDraw AppState{aopts=UIOpts{cliopts_=CliOpts{reportopts_=ropts}}
|
||||
|
||||
tsDraw _ = error "draw function called with wrong screen type, should not happen"
|
||||
|
||||
tsHandle :: AppState -> Vty.Event -> EventM (Next AppState)
|
||||
tsHandle st@AppState{aScreen=s@TransactionScreen{tsTransaction=(i,t)
|
||||
tsHandle :: UIState -> Event -> EventM (Next UIState)
|
||||
tsHandle ui@UIState{aScreen=s@TransactionScreen{tsTransaction=(i,t)
|
||||
,tsTransactions=nts
|
||||
,tsAccount=acct}
|
||||
,aopts=UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}}
|
||||
@ -119,8 +120,8 @@ tsHandle st@AppState{aScreen=s@TransactionScreen{tsTransaction=(i,t)
|
||||
case mode of
|
||||
Help ->
|
||||
case ev of
|
||||
EvKey (KChar 'q') [] -> halt st
|
||||
_ -> helpHandle st ev
|
||||
EvKey (KChar 'q') [] -> halt ui
|
||||
_ -> helpHandle ui ev
|
||||
|
||||
_ -> do
|
||||
d <- liftIO getCurrentDay
|
||||
@ -128,14 +129,14 @@ tsHandle st@AppState{aScreen=s@TransactionScreen{tsTransaction=(i,t)
|
||||
(iprev,tprev) = maybe (i,t) ((i-1),) $ lookup (i-1) nts
|
||||
(inext,tnext) = maybe (i,t) ((i+1),) $ lookup (i+1) nts
|
||||
case ev of
|
||||
EvKey (KChar 'q') [] -> halt st
|
||||
EvKey KEsc [] -> continue $ resetScreens d st
|
||||
EvKey k [] | k `elem` [KChar 'h', KChar '?'] -> continue $ setMode Help st
|
||||
EvKey (KChar 'q') [] -> halt ui
|
||||
EvKey KEsc [] -> continue $ resetScreens d ui
|
||||
EvKey k [] | k `elem` [KChar 'h', KChar '?'] -> continue $ setMode Help ui
|
||||
EvKey (KChar 'g') [] -> do
|
||||
d <- liftIO getCurrentDay
|
||||
(ej, _) <- liftIO $ journalReloadIfChanged copts d j
|
||||
case ej of
|
||||
Left err -> continue $ screenEnter d errorScreen{esError=err} st
|
||||
Left err -> continue $ screenEnter d errorScreen{esError=err} ui
|
||||
Right j' -> do
|
||||
-- got to redo the register screen's transactions report, to get the latest transactions list for this screen
|
||||
-- XXX duplicates rsInit
|
||||
@ -155,21 +156,21 @@ tsHandle st@AppState{aScreen=s@TransactionScreen{tsTransaction=(i,t)
|
||||
Nothing | null numberedts -> (0,nulltransaction)
|
||||
| i > fst (last numberedts) -> last numberedts
|
||||
| otherwise -> head numberedts
|
||||
st' = st{aScreen=s{tsTransaction=(i',t')
|
||||
ui' = ui{aScreen=s{tsTransaction=(i',t')
|
||||
,tsTransactions=numberedts
|
||||
,tsAccount=acct}}
|
||||
continue $ regenerateScreens j' d st'
|
||||
continue $ regenerateScreens j' d ui'
|
||||
-- if allowing toggling here, we should refresh the txn list from the parent register screen
|
||||
-- EvKey (KChar 'E') [] -> continue $ regenerateScreens j d $ stToggleEmpty st
|
||||
-- EvKey (KChar 'C') [] -> continue $ regenerateScreens j d $ stToggleCleared st
|
||||
-- EvKey (KChar 'R') [] -> continue $ regenerateScreens j d $ stToggleReal st
|
||||
EvKey KUp [] -> continue $ regenerateScreens j d st{aScreen=s{tsTransaction=(iprev,tprev)}}
|
||||
EvKey KDown [] -> continue $ regenerateScreens j d st{aScreen=s{tsTransaction=(inext,tnext)}}
|
||||
EvKey KLeft [] -> continue st''
|
||||
-- EvKey (KChar 'E') [] -> continue $ regenerateScreens j d $ stToggleEmpty ui
|
||||
-- EvKey (KChar 'C') [] -> continue $ regenerateScreens j d $ stToggleCleared ui
|
||||
-- EvKey (KChar 'R') [] -> continue $ regenerateScreens j d $ stToggleReal ui
|
||||
EvKey KUp [] -> continue $ regenerateScreens j d ui{aScreen=s{tsTransaction=(iprev,tprev)}}
|
||||
EvKey KDown [] -> continue $ regenerateScreens j d ui{aScreen=s{tsTransaction=(inext,tnext)}}
|
||||
EvKey KLeft [] -> continue ui''
|
||||
where
|
||||
st'@AppState{aScreen=scr} = popScreen st
|
||||
st'' = st'{aScreen=rsSelect (fromIntegral i) scr}
|
||||
_ -> continue st
|
||||
ui'@UIState{aScreen=scr} = popScreen ui
|
||||
ui'' = ui'{aScreen=rsSelect (fromIntegral i) scr}
|
||||
_ -> continue ui
|
||||
|
||||
tsHandle _ _ = error "event handler called with wrong screen type, should not happen"
|
||||
|
||||
|
||||
172
hledger-ui/Hledger/UI/UIState.hs
Normal file
172
hledger-ui/Hledger/UI/UIState.hs
Normal file
@ -0,0 +1,172 @@
|
||||
{- | UIState operations. -}
|
||||
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
|
||||
module Hledger.UI.UIState
|
||||
where
|
||||
|
||||
import Brick
|
||||
import Brick.Widgets.Edit
|
||||
import Data.List
|
||||
import Data.Text.Zipper (gotoEOL)
|
||||
import Data.Time.Calendar (Day)
|
||||
|
||||
import Hledger
|
||||
import Hledger.Cli.CliOptions
|
||||
import Hledger.UI.UITypes
|
||||
import Hledger.UI.UIOptions
|
||||
|
||||
-- | Toggle between showing only cleared items or all items.
|
||||
toggleCleared :: UIState -> UIState
|
||||
toggleCleared ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}}} =
|
||||
ui{aopts=uopts{cliopts_=copts{reportopts_=toggleCleared ropts}}}
|
||||
where
|
||||
toggleCleared ropts = ropts{cleared_=not $ cleared_ ropts, uncleared_=False, pending_=False}
|
||||
|
||||
-- | Toggle between showing only pending items or all items.
|
||||
togglePending :: UIState -> UIState
|
||||
togglePending ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}}} =
|
||||
ui{aopts=uopts{cliopts_=copts{reportopts_=togglePending ropts}}}
|
||||
where
|
||||
togglePending ropts = ropts{pending_=not $ pending_ ropts, uncleared_=False, cleared_=False}
|
||||
|
||||
-- | Toggle between showing only uncleared items or all items.
|
||||
toggleUncleared :: UIState -> UIState
|
||||
toggleUncleared ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}}} =
|
||||
ui{aopts=uopts{cliopts_=copts{reportopts_=toggleUncleared ropts}}}
|
||||
where
|
||||
toggleUncleared ropts = ropts{uncleared_=not $ uncleared_ ropts, cleared_=False, pending_=False}
|
||||
|
||||
-- | Toggle between showing all and showing only nonempty (more precisely, nonzero) items.
|
||||
toggleEmpty :: UIState -> UIState
|
||||
toggleEmpty ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}}} =
|
||||
ui{aopts=uopts{cliopts_=copts{reportopts_=toggleEmpty ropts}}}
|
||||
where
|
||||
toggleEmpty ropts = ropts{empty_=not $ empty_ ropts}
|
||||
|
||||
-- | Toggle between flat and tree mode. If in the third "default" mode, go to flat mode.
|
||||
toggleFlat :: UIState -> UIState
|
||||
toggleFlat ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}}} =
|
||||
ui{aopts=uopts{cliopts_=copts{reportopts_=toggleFlatMode ropts}}}
|
||||
where
|
||||
toggleFlatMode ropts@ReportOpts{accountlistmode_=ALFlat} = ropts{accountlistmode_=ALTree}
|
||||
toggleFlatMode ropts = ropts{accountlistmode_=ALFlat}
|
||||
|
||||
-- | Toggle between showing all and showing only real (non-virtual) items.
|
||||
toggleReal :: UIState -> UIState
|
||||
toggleReal ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}}} =
|
||||
ui{aopts=uopts{cliopts_=copts{reportopts_=toggleReal ropts}}}
|
||||
where
|
||||
toggleReal ropts = ropts{real_=not $ real_ ropts}
|
||||
|
||||
-- | Apply a new filter query.
|
||||
setFilter :: String -> UIState -> UIState
|
||||
setFilter s ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}}} =
|
||||
ui{aopts=uopts{cliopts_=copts{reportopts_=ropts{query_=s}}}}
|
||||
|
||||
-- | Clear all filter queries/flags.
|
||||
resetFilter :: UIState -> UIState
|
||||
resetFilter ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}}} =
|
||||
ui{aopts=uopts{cliopts_=copts{reportopts_=ropts{
|
||||
empty_=True
|
||||
,cleared_=False
|
||||
,pending_=False
|
||||
,uncleared_=False
|
||||
,real_=False
|
||||
,query_=""
|
||||
}}}}
|
||||
|
||||
resetDepth :: UIState -> UIState
|
||||
resetDepth ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}}} =
|
||||
ui{aopts=uopts{cliopts_=copts{reportopts_=ropts{depth_=Nothing}}}}
|
||||
|
||||
-- | Get the maximum account depth in the current journal.
|
||||
maxDepth :: UIState -> Int
|
||||
maxDepth UIState{ajournal=j} = maximum $ map accountNameLevel $ journalAccountNames j
|
||||
|
||||
-- | Decrement the current depth limit towards 0. If there was no depth limit,
|
||||
-- set it to one less than the maximum account depth.
|
||||
decDepth :: UIState -> UIState
|
||||
decDepth ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts@ReportOpts{..}}}}
|
||||
= ui{aopts=uopts{cliopts_=copts{reportopts_=ropts{depth_=dec depth_}}}}
|
||||
where
|
||||
dec (Just d) = Just $ max 0 (d-1)
|
||||
dec Nothing = Just $ maxDepth ui - 1
|
||||
|
||||
-- | Increment the current depth limit. If this makes it equal to the
|
||||
-- the maximum account depth, remove the depth limit.
|
||||
incDepth :: UIState -> UIState
|
||||
incDepth ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts@ReportOpts{..}}}}
|
||||
= ui{aopts=uopts{cliopts_=copts{reportopts_=ropts{depth_=inc depth_}}}}
|
||||
where
|
||||
inc (Just d) | d < (maxDepth ui - 1) = Just $ d+1
|
||||
inc _ = Nothing
|
||||
|
||||
-- | Set the current depth limit to the specified depth, or remove the depth limit.
|
||||
-- Also remove the depth limit if the specified depth is greater than the current
|
||||
-- maximum account depth. If the specified depth is negative, reset the depth limit
|
||||
-- to whatever was specified at uiartup.
|
||||
setDepth :: Maybe Int -> UIState -> UIState
|
||||
setDepth mdepth ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}}}
|
||||
= ui{aopts=uopts{cliopts_=copts{reportopts_=ropts{depth_=mdepth'}}}}
|
||||
where
|
||||
mdepth' = case mdepth of
|
||||
Nothing -> Nothing
|
||||
Just d | d < 0 -> depth_ ropts
|
||||
| d >= maxDepth ui -> Nothing
|
||||
| otherwise -> mdepth
|
||||
|
||||
-- | Open the minibuffer, setting its content to the current query with the cursor at the end.
|
||||
showMinibuffer :: UIState -> UIState
|
||||
showMinibuffer ui = setMode (Minibuffer e) ui
|
||||
where
|
||||
e = applyEdit gotoEOL $ editor "minibuffer" (str . unlines) (Just 1) oldq
|
||||
oldq = query_ $ reportopts_ $ cliopts_ $ aopts ui
|
||||
|
||||
-- | Close the minibuffer, discarding any edit in progress.
|
||||
closeMinibuffer :: UIState -> UIState
|
||||
closeMinibuffer = setMode Normal
|
||||
|
||||
setMode :: Mode -> UIState -> UIState
|
||||
setMode m ui = ui{aMode=m}
|
||||
|
||||
-- | Regenerate the content for the current and previous screens, from a new journal and current date.
|
||||
regenerateScreens :: Journal -> Day -> UIState -> UIState
|
||||
regenerateScreens j d ui@UIState{aScreen=s,aPrevScreens=ss} =
|
||||
-- XXX clumsy due to entanglement of UIState and Screen.
|
||||
-- sInit operates only on an appstate's current screen, so
|
||||
-- remove all the screens from the appstate and then add them back
|
||||
-- one at a time, regenerating as we go.
|
||||
let
|
||||
first:rest = reverse $ s:ss :: [Screen]
|
||||
ui0 = ui{ajournal=j, aScreen=first, aPrevScreens=[]} :: UIState
|
||||
|
||||
ui1 = (sInit first) d False ui0 :: UIState
|
||||
ui2 = foldl' (\ui s -> (sInit s) d False $ pushScreen s ui) ui1 rest :: UIState
|
||||
in
|
||||
ui2
|
||||
|
||||
pushScreen :: Screen -> UIState -> UIState
|
||||
pushScreen scr ui = ui{aPrevScreens=(aScreen ui:aPrevScreens ui)
|
||||
,aScreen=scr
|
||||
}
|
||||
|
||||
popScreen :: UIState -> UIState
|
||||
popScreen ui@UIState{aPrevScreens=s:ss} = ui{aScreen=s, aPrevScreens=ss}
|
||||
popScreen ui = ui
|
||||
|
||||
resetScreens :: Day -> UIState -> UIState
|
||||
resetScreens d ui@UIState{aScreen=s,aPrevScreens=ss} =
|
||||
(sInit topscreen) d True $ resetDepth $ resetFilter $ closeMinibuffer ui{aScreen=topscreen, aPrevScreens=[]}
|
||||
where
|
||||
topscreen = case ss of _:_ -> last ss
|
||||
[] -> s
|
||||
|
||||
-- | Enter a new screen, saving the old screen & state in the
|
||||
-- navigation history and initialising the new screen's state.
|
||||
screenEnter :: Day -> Screen -> UIState -> UIState
|
||||
screenEnter d scr ui = (sInit scr) d True $
|
||||
pushScreen scr
|
||||
ui
|
||||
|
||||
@ -1,16 +1,16 @@
|
||||
{- |
|
||||
Overview:
|
||||
hledger-ui's AppState holds the currently active screen and any previously visited
|
||||
hledger-ui's UIState holds the currently active screen and any previously visited
|
||||
screens (and their states).
|
||||
The brick App delegates all event-handling and rendering
|
||||
to the AppState's active screen.
|
||||
to the UIState's active screen.
|
||||
Screens have their own screen state, render function, event handler, and app state
|
||||
update function, so they have full control.
|
||||
|
||||
@
|
||||
Brick.defaultMain brickapp st
|
||||
where
|
||||
brickapp :: App (AppState) V.Event
|
||||
brickapp :: App (UIState) V.Event
|
||||
brickapp = App {
|
||||
appLiftVtyEvent = id
|
||||
, appStartEvent = return
|
||||
@ -19,9 +19,9 @@ Brick.defaultMain brickapp st
|
||||
, appHandleEvent = \st ev -> sHandle (aScreen st) st ev
|
||||
, appDraw = \st -> sDraw (aScreen st) st
|
||||
}
|
||||
st :: AppState
|
||||
st :: UIState
|
||||
st = (sInit s) d
|
||||
AppState{
|
||||
UIState{
|
||||
aopts=uopts'
|
||||
,ajournal=j
|
||||
,aScreen=s
|
||||
@ -40,7 +40,7 @@ module Hledger.UI.UITypes where
|
||||
|
||||
import Data.Monoid
|
||||
import Data.Time.Calendar (Day)
|
||||
import qualified Graphics.Vty as Vty
|
||||
import Graphics.Vty
|
||||
import Brick
|
||||
import Brick.Widgets.List
|
||||
import Brick.Widgets.Edit (Editor)
|
||||
@ -59,7 +59,7 @@ instance Show Editor where show _ = "<Editor>"
|
||||
-- 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 UIState = UIState {
|
||||
aopts :: UIOpts -- ^ the command-line options and query arguments currently in effect
|
||||
,ajournal :: Journal -- ^ the journal being viewed
|
||||
,aPrevScreens :: [Screen] -- ^ previously visited screens, most recent first
|
||||
@ -86,34 +86,34 @@ instance Eq Editor where _ == _ = True
|
||||
-- cases need to be handled, and also that their lenses are traversals, not single-value getters.
|
||||
data Screen =
|
||||
AccountsScreen {
|
||||
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
|
||||
sInit :: Day -> Bool -> UIState -> UIState -- ^ function to initialise or update this screen's state
|
||||
,sDraw :: UIState -> [Widget] -- ^ brick renderer for this screen
|
||||
,sHandle :: UIState -> Event -> EventM (Next UIState) -- ^ brick event handler for this screen
|
||||
-- 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 "")
|
||||
}
|
||||
| RegisterScreen {
|
||||
sInit :: Day -> Bool -> AppState -> AppState
|
||||
,sDraw :: AppState -> [Widget]
|
||||
,sHandle :: AppState -> Vty.Event -> EventM (Next AppState)
|
||||
sInit :: Day -> Bool -> UIState -> UIState
|
||||
,sDraw :: UIState -> [Widget]
|
||||
,sHandle :: UIState -> Event -> EventM (Next UIState)
|
||||
--
|
||||
,rsList :: List RegisterScreenItem -- ^ list widget showing transactions affecting this account
|
||||
,rsAccount :: AccountName -- ^ the account this register is for
|
||||
}
|
||||
| TransactionScreen {
|
||||
sInit :: Day -> Bool -> AppState -> AppState
|
||||
,sDraw :: AppState -> [Widget]
|
||||
,sHandle :: AppState -> Vty.Event -> EventM (Next AppState)
|
||||
sInit :: Day -> Bool -> UIState -> UIState
|
||||
,sDraw :: UIState -> [Widget]
|
||||
,sHandle :: UIState -> Event -> EventM (Next UIState)
|
||||
--
|
||||
,tsTransaction :: NumberedTransaction -- ^ the transaction we are currently viewing, and its position in the list
|
||||
,tsTransactions :: [NumberedTransaction] -- ^ list of transactions we can step through
|
||||
,tsAccount :: AccountName -- ^ the account whose register we entered this screen from
|
||||
}
|
||||
| ErrorScreen {
|
||||
sInit :: Day -> Bool -> AppState -> AppState
|
||||
,sDraw :: AppState -> [Widget]
|
||||
,sHandle :: AppState -> Vty.Event -> EventM (Next AppState)
|
||||
sInit :: Day -> Bool -> UIState -> UIState
|
||||
,sDraw :: UIState -> [Widget]
|
||||
,sHandle :: UIState -> Event -> EventM (Next UIState)
|
||||
--
|
||||
,esError :: String -- ^ error message to show
|
||||
}
|
||||
@ -139,7 +139,7 @@ data RegisterScreenItem = RegisterScreenItem {
|
||||
|
||||
type NumberedTransaction = (Integer, Transaction)
|
||||
|
||||
-- dummy monoid instance needed for lenses for now since the List fields are not common across constructors
|
||||
-- dummy monoid instance needed make lenses work with List fields not common across constructors
|
||||
instance Monoid (List a)
|
||||
where
|
||||
mempty = list "" V.empty 1
|
||||
|
||||
@ -1,212 +1,26 @@
|
||||
{- | Rendering & misc. helpers. -}
|
||||
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
|
||||
module Hledger.UI.UIUtils
|
||||
-- (
|
||||
-- pushScreen
|
||||
-- ,popScreen
|
||||
-- ,resetScreens
|
||||
-- ,screenEnter
|
||||
-- ,regenerateScreens
|
||||
-- ,getViewportSize
|
||||
-- -- ,margin
|
||||
-- ,withBorderAttr
|
||||
-- ,topBottomBorderWithLabel
|
||||
-- ,topBottomBorderWithLabels
|
||||
-- ,defaultLayout
|
||||
-- ,borderQueryStr
|
||||
-- ,borderDepthStr
|
||||
-- ,borderKeysStr
|
||||
-- ,minibuffer
|
||||
-- --
|
||||
-- ,stToggleCleared
|
||||
-- ,stTogglePending
|
||||
-- ,stToggleUncleared
|
||||
-- ,stToggleEmpty
|
||||
-- ,stToggleFlat
|
||||
-- ,stToggleReal
|
||||
-- ,stFilter
|
||||
-- ,stResetFilter
|
||||
-- ,stShowMinibuffer
|
||||
-- ,stCloseMinibuffer
|
||||
-- )
|
||||
where
|
||||
|
||||
import Lens.Micro.Platform ((^.))
|
||||
-- import Control.Monad
|
||||
-- import Control.Monad.IO.Class
|
||||
-- import Data.Default
|
||||
import Data.List
|
||||
import Data.Monoid
|
||||
import Data.Text.Zipper (gotoEOL)
|
||||
import Data.Time.Calendar (Day)
|
||||
import Brick
|
||||
import Brick.Widgets.Dialog
|
||||
-- import Brick.Widgets.List
|
||||
import Brick.Widgets.Edit
|
||||
import Brick.Widgets.Border
|
||||
import Brick.Widgets.Border.Style
|
||||
import Graphics.Vty as Vty
|
||||
import Brick.Widgets.Dialog
|
||||
import Brick.Widgets.Edit
|
||||
import Data.List
|
||||
import Data.Monoid
|
||||
import Graphics.Vty
|
||||
import Lens.Micro.Platform
|
||||
|
||||
import Hledger
|
||||
import Hledger.Cli.CliOptions
|
||||
import Hledger.UI.UITypes
|
||||
import Hledger.UI.UIOptions
|
||||
|
||||
-- | Toggle between showing only cleared items or all items.
|
||||
stToggleCleared :: AppState -> AppState
|
||||
stToggleCleared st@AppState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}}} =
|
||||
st{aopts=uopts{cliopts_=copts{reportopts_=toggleCleared ropts}}}
|
||||
where
|
||||
toggleCleared ropts = ropts{cleared_=not $ cleared_ ropts, uncleared_=False, pending_=False}
|
||||
|
||||
-- | Toggle between showing only pending items or all items.
|
||||
stTogglePending :: AppState -> AppState
|
||||
stTogglePending st@AppState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}}} =
|
||||
st{aopts=uopts{cliopts_=copts{reportopts_=togglePending ropts}}}
|
||||
where
|
||||
togglePending ropts = ropts{pending_=not $ pending_ ropts, uncleared_=False, cleared_=False}
|
||||
|
||||
-- | Toggle between showing only uncleared items or all items.
|
||||
stToggleUncleared :: AppState -> AppState
|
||||
stToggleUncleared st@AppState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}}} =
|
||||
st{aopts=uopts{cliopts_=copts{reportopts_=toggleUncleared ropts}}}
|
||||
where
|
||||
toggleUncleared ropts = ropts{uncleared_=not $ uncleared_ ropts, cleared_=False, pending_=False}
|
||||
|
||||
-- | Toggle between showing all and showing only nonempty (more precisely, nonzero) items.
|
||||
stToggleEmpty :: AppState -> AppState
|
||||
stToggleEmpty st@AppState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}}} =
|
||||
st{aopts=uopts{cliopts_=copts{reportopts_=toggleEmpty ropts}}}
|
||||
where
|
||||
toggleEmpty ropts = ropts{empty_=not $ empty_ ropts}
|
||||
|
||||
-- | Toggle between flat and tree mode. If in the third "default" mode, go to flat mode.
|
||||
stToggleFlat :: AppState -> AppState
|
||||
stToggleFlat st@AppState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}}} =
|
||||
st{aopts=uopts{cliopts_=copts{reportopts_=toggleFlatMode ropts}}}
|
||||
where
|
||||
toggleFlatMode ropts@ReportOpts{accountlistmode_=ALFlat} = ropts{accountlistmode_=ALTree}
|
||||
toggleFlatMode ropts = ropts{accountlistmode_=ALFlat}
|
||||
|
||||
-- | Toggle between showing all and showing only real (non-virtual) items.
|
||||
stToggleReal :: AppState -> AppState
|
||||
stToggleReal st@AppState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}}} =
|
||||
st{aopts=uopts{cliopts_=copts{reportopts_=toggleReal ropts}}}
|
||||
where
|
||||
toggleReal ropts = ropts{real_=not $ real_ ropts}
|
||||
|
||||
-- | Apply a new filter query.
|
||||
stFilter :: String -> AppState -> AppState
|
||||
stFilter s st@AppState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}}} =
|
||||
st{aopts=uopts{cliopts_=copts{reportopts_=ropts{query_=s}}}}
|
||||
|
||||
-- | Clear all filter queries/flags.
|
||||
stResetFilter :: AppState -> AppState
|
||||
stResetFilter st@AppState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}}} =
|
||||
st{aopts=uopts{cliopts_=copts{reportopts_=ropts{
|
||||
empty_=True
|
||||
,cleared_=False
|
||||
,pending_=False
|
||||
,uncleared_=False
|
||||
,real_=False
|
||||
,query_=""
|
||||
}}}}
|
||||
|
||||
resetDepth :: AppState -> AppState
|
||||
resetDepth st@AppState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}}} =
|
||||
st{aopts=uopts{cliopts_=copts{reportopts_=ropts{depth_=Nothing}}}}
|
||||
|
||||
-- | Get the maximum account depth in the current journal.
|
||||
maxDepth :: AppState -> Int
|
||||
maxDepth AppState{ajournal=j} = maximum $ map accountNameLevel $ journalAccountNames j
|
||||
|
||||
-- | Decrement the current depth limit towards 0. If there was no depth limit,
|
||||
-- set it to one less than the maximum account depth.
|
||||
decDepth :: AppState -> AppState
|
||||
decDepth st@AppState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts@ReportOpts{..}}}}
|
||||
= st{aopts=uopts{cliopts_=copts{reportopts_=ropts{depth_=dec depth_}}}}
|
||||
where
|
||||
dec (Just d) = Just $ max 0 (d-1)
|
||||
dec Nothing = Just $ maxDepth st - 1
|
||||
|
||||
-- | Increment the current depth limit. If this makes it equal to the
|
||||
-- the maximum account depth, remove the depth limit.
|
||||
incDepth :: AppState -> AppState
|
||||
incDepth st@AppState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts@ReportOpts{..}}}}
|
||||
= st{aopts=uopts{cliopts_=copts{reportopts_=ropts{depth_=inc depth_}}}}
|
||||
where
|
||||
inc (Just d) | d < (maxDepth st - 1) = Just $ d+1
|
||||
inc _ = Nothing
|
||||
|
||||
-- | Set the current depth limit to the specified depth, or remove the depth limit.
|
||||
-- Also remove the depth limit if the specified depth is greater than the current
|
||||
-- maximum account depth. If the specified depth is negative, reset the depth limit
|
||||
-- to whatever was specified at startup.
|
||||
setDepth :: Maybe Int -> AppState -> AppState
|
||||
setDepth mdepth st@AppState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}}}
|
||||
= st{aopts=uopts{cliopts_=copts{reportopts_=ropts{depth_=mdepth'}}}}
|
||||
where
|
||||
mdepth' = case mdepth of
|
||||
Nothing -> Nothing
|
||||
Just d | d < 0 -> depth_ ropts
|
||||
| d >= maxDepth st -> Nothing
|
||||
| otherwise -> mdepth
|
||||
|
||||
-- | Open the minibuffer, setting its content to the current query with the cursor at the end.
|
||||
stShowMinibuffer st = setMode (Minibuffer e) st
|
||||
where
|
||||
e = applyEdit gotoEOL $ editor "minibuffer" (str . unlines) (Just 1) oldq
|
||||
oldq = query_ $ reportopts_ $ cliopts_ $ aopts st
|
||||
|
||||
-- | Close the minibuffer, discarding any edit in progress.
|
||||
stCloseMinibuffer = setMode Normal
|
||||
|
||||
setMode :: Mode -> AppState -> AppState
|
||||
setMode m st = st{aMode=m}
|
||||
|
||||
-- | Regenerate the content for the current and previous screens, from a new journal and current date.
|
||||
regenerateScreens :: Journal -> Day -> AppState -> AppState
|
||||
regenerateScreens j d st@AppState{aScreen=s,aPrevScreens=ss} =
|
||||
-- XXX clumsy due to entanglement of AppState and Screen.
|
||||
-- sInit operates only on an appstate's current screen, so
|
||||
-- remove all the screens from the appstate and then add them back
|
||||
-- one at a time, regenerating as we go.
|
||||
let
|
||||
first:rest = reverse $ s:ss :: [Screen]
|
||||
st0 = st{ajournal=j, aScreen=first, aPrevScreens=[]} :: AppState
|
||||
st1 = (sInit first) d False st0 :: AppState
|
||||
st2 = foldl' (\st s -> (sInit s) d False $ pushScreen s st) st1 rest :: AppState
|
||||
in
|
||||
st2
|
||||
|
||||
pushScreen :: Screen -> AppState -> AppState
|
||||
pushScreen scr st = st{aPrevScreens=(aScreen st:aPrevScreens st)
|
||||
,aScreen=scr
|
||||
}
|
||||
|
||||
popScreen :: AppState -> AppState
|
||||
popScreen st@AppState{aPrevScreens=s:ss} = st{aScreen=s, aPrevScreens=ss}
|
||||
popScreen st = st
|
||||
|
||||
resetScreens :: Day -> AppState -> AppState
|
||||
resetScreens d st@AppState{aScreen=s,aPrevScreens=ss} =
|
||||
(sInit topscreen) d True $ resetDepth $ stResetFilter $ stCloseMinibuffer st{aScreen=topscreen, aPrevScreens=[]}
|
||||
where
|
||||
topscreen = case ss of _:_ -> last ss
|
||||
[] -> s
|
||||
|
||||
-- clearScreens :: AppState -> AppState
|
||||
-- clearScreens st = st{aPrevScreens=[]}
|
||||
|
||||
-- | Enter a new screen, saving the old screen & state in the
|
||||
-- navigation history and initialising the new screen's state.
|
||||
screenEnter :: Day -> Screen -> AppState -> AppState
|
||||
screenEnter d scr st = (sInit scr) d True $
|
||||
pushScreen scr
|
||||
st
|
||||
import Hledger.UI.UIState
|
||||
|
||||
-- | Draw the help dialog, called when help mode is active.
|
||||
helpDialog :: Widget
|
||||
helpDialog =
|
||||
Widget Fixed Fixed $ do
|
||||
c <- getContext
|
||||
@ -251,22 +65,21 @@ helpDialog =
|
||||
renderKey (key,desc) = withAttr (borderAttr <> "keys") (str key) <+> str " " <+> str desc
|
||||
|
||||
-- | Event handler used when help mode is active.
|
||||
helpHandle st ev =
|
||||
helpHandle :: UIState -> Event -> EventM (Next UIState)
|
||||
helpHandle ui ev =
|
||||
case ev of
|
||||
EvKey k [] | k `elem` [KEsc, KChar 'h'] -> continue $ setMode Normal st
|
||||
_ -> continue st
|
||||
EvKey k [] | k `elem` [KEsc, KChar 'h'] -> continue $ setMode Normal ui
|
||||
_ -> continue ui
|
||||
|
||||
-- | In the EventM monad, get the named current viewport's width and height,
|
||||
-- or (0,0) if the named viewport is not found.
|
||||
getViewportSize :: Name -> EventM (Int,Int)
|
||||
getViewportSize name = do
|
||||
mvp <- lookupViewport name
|
||||
let (w,h) = case mvp of
|
||||
Just vp -> vp ^. vpSize
|
||||
Nothing -> (0,0)
|
||||
-- liftIO $ putStrLn $ show (w,h)
|
||||
return (w,h)
|
||||
-- | Draw the minibuffer.
|
||||
minibuffer :: Editor -> Widget
|
||||
minibuffer ed =
|
||||
forceAttr (borderAttr <> "minibuffer") $
|
||||
hBox $
|
||||
[txt "filter: ", renderEditor ed]
|
||||
|
||||
-- | Wrap a widget in the default hledger-ui screen layout.
|
||||
defaultLayout :: Widget -> Widget -> Widget -> Widget
|
||||
defaultLayout toplabel bottomlabel =
|
||||
topBottomBorderWithLabels (str " "<+>toplabel<+>str " ") (str " "<+>bottomlabel<+>str " ") .
|
||||
margin 1 0 Nothing
|
||||
@ -274,6 +87,26 @@ defaultLayout toplabel bottomlabel =
|
||||
-- padLeftRight 1 -- XXX should reduce inner widget's width by 2, but doesn't
|
||||
-- "the layout adjusts... if you use the core combinators"
|
||||
|
||||
borderQueryStr :: String -> Widget
|
||||
borderQueryStr "" = str ""
|
||||
borderQueryStr qry = str " matching " <+> withAttr (borderAttr <> "query") (str qry)
|
||||
|
||||
borderDepthStr :: Maybe Int -> Widget
|
||||
borderDepthStr Nothing = str ""
|
||||
borderDepthStr (Just d) = str " to " <+> withAttr (borderAttr <> "depth") (str $ "depth "++show d)
|
||||
|
||||
borderKeysStr :: [(String,String)] -> Widget
|
||||
borderKeysStr keydescs =
|
||||
hBox $
|
||||
intersperse sep $
|
||||
[withAttr (borderAttr <> "keys") (str keys) <+> str ":" <+> str desc | (keys, desc) <- keydescs]
|
||||
where
|
||||
-- sep = str " | "
|
||||
sep = str " "
|
||||
|
||||
-- generic
|
||||
|
||||
topBottomBorderWithLabel :: Widget -> Widget -> Widget
|
||||
topBottomBorderWithLabel label = \wrapped ->
|
||||
Widget Greedy Greedy $ do
|
||||
c <- getContext
|
||||
@ -290,6 +123,7 @@ topBottomBorderWithLabel label = \wrapped ->
|
||||
<=>
|
||||
hBorder
|
||||
|
||||
topBottomBorderWithLabels :: Widget -> Widget -> Widget -> Widget
|
||||
topBottomBorderWithLabels toplabel bottomlabel = \wrapped ->
|
||||
Widget Greedy Greedy $ do
|
||||
c <- getContext
|
||||
@ -307,6 +141,7 @@ topBottomBorderWithLabels toplabel bottomlabel = \wrapped ->
|
||||
hBorderWithLabel bottomlabel
|
||||
|
||||
-- XXX should be equivalent to the above, but isn't (page down goes offscreen)
|
||||
_topBottomBorderWithLabel2 :: Widget -> Widget -> Widget
|
||||
_topBottomBorderWithLabel2 label = \wrapped ->
|
||||
let debugmsg = ""
|
||||
in hBorderWithLabel (label <+> str debugmsg)
|
||||
@ -340,33 +175,6 @@ margin h v mcolour = \w ->
|
||||
-- withBorderStyle (borderStyleFromChar ' ') .
|
||||
-- applyN n border
|
||||
|
||||
withBorderAttr :: Attr -> Widget -> Widget
|
||||
withBorderAttr attr = updateAttrMap (applyAttrMappings [(borderAttr, attr)])
|
||||
|
||||
-- _ui = vCenter $ vBox [ hCenter box
|
||||
-- , str " "
|
||||
-- , hCenter $ str "Press Esc to exit."
|
||||
-- ]
|
||||
|
||||
borderQueryStr :: String -> Widget
|
||||
borderQueryStr "" = str ""
|
||||
borderQueryStr qry = str " matching " <+> withAttr (borderAttr <> "query") (str qry)
|
||||
|
||||
borderDepthStr :: Maybe Int -> Widget
|
||||
borderDepthStr Nothing = str ""
|
||||
borderDepthStr (Just d) = str " to " <+> withAttr (borderAttr <> "depth") (str $ "depth "++show d)
|
||||
|
||||
borderKeysStr :: [(String,String)] -> Widget
|
||||
borderKeysStr keydescs =
|
||||
hBox $
|
||||
intersperse sep $
|
||||
[withAttr (borderAttr <> "keys") (str keys) <+> str ":" <+> str desc | (keys, desc) <- keydescs]
|
||||
where
|
||||
-- sep = str " | "
|
||||
sep = str " "
|
||||
|
||||
minibuffer :: Editor -> Widget
|
||||
minibuffer ed =
|
||||
forceAttr (borderAttr <> "minibuffer") $
|
||||
hBox $
|
||||
[txt "filter: ", renderEditor ed]
|
||||
|
||||
|
||||
@ -92,6 +92,7 @@ executable hledger-ui
|
||||
Hledger.UI.Main
|
||||
Hledger.UI.UIOptions
|
||||
Hledger.UI.Theme
|
||||
Hledger.UI.UIState
|
||||
Hledger.UI.UITypes
|
||||
Hledger.UI.UIUtils
|
||||
Hledger.UI.AccountsScreen
|
||||
|
||||
Loading…
Reference in New Issue
Block a user