From 47a8eb53c8e54cf932a1cab79a735844d801abc7 Mon Sep 17 00:00:00 2001 From: Simon Michael Date: Fri, 10 Jun 2016 17:30:45 -0700 Subject: [PATCH] ui: refactor: AppState -> UIState, cleanups --- hledger-ui/Hledger/UI/AccountsScreen.hs | 87 +++---- hledger-ui/Hledger/UI/ErrorScreen.hs | 47 ++-- hledger-ui/Hledger/UI/Main.hs | 21 +- hledger-ui/Hledger/UI/RegisterScreen.hs | 59 ++--- hledger-ui/Hledger/UI/TransactionScreen.hs | 51 ++-- hledger-ui/Hledger/UI/UIState.hs | 172 +++++++++++++ hledger-ui/Hledger/UI/UITypes.hs | 50 ++-- hledger-ui/Hledger/UI/UIUtils.hs | 284 ++++----------------- hledger-ui/hledger-ui.cabal | 1 + 9 files changed, 376 insertions(+), 396 deletions(-) create mode 100644 hledger-ui/Hledger/UI/UIState.hs diff --git a/hledger-ui/Hledger/UI/AccountsScreen.hs b/hledger-ui/Hledger/UI/AccountsScreen.hs index c86f825ad..7c6511a7f 100644 --- a/hledger-ui/Hledger/UI/AccountsScreen.hs +++ b/hledger-ui/Hledger/UI/AccountsScreen.hs @@ -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. diff --git a/hledger-ui/Hledger/UI/ErrorScreen.hs b/hledger-ui/Hledger/UI/ErrorScreen.hs index bd5263b95..cb16f57de 100644 --- a/hledger-ui/Hledger/UI/ErrorScreen.hs +++ b/hledger-ui/Hledger/UI/ErrorScreen.hs @@ -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 diff --git a/hledger-ui/Hledger/UI/Main.hs b/hledger-ui/Hledger/UI/Main.hs index df85f8a24..9725e3c38 100644 --- a/hledger-ui/Hledger/UI/Main.hs +++ b/hledger-ui/Hledger/UI/Main.hs @@ -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 diff --git a/hledger-ui/Hledger/UI/RegisterScreen.hs b/hledger-ui/Hledger/UI/RegisterScreen.hs index 871188c22..8984aab2a 100644 --- a/hledger-ui/Hledger/UI/RegisterScreen.hs +++ b/hledger-ui/Hledger/UI/RegisterScreen.hs @@ -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) diff --git a/hledger-ui/Hledger/UI/TransactionScreen.hs b/hledger-ui/Hledger/UI/TransactionScreen.hs index 6d2576873..cf53afdfa 100644 --- a/hledger-ui/Hledger/UI/TransactionScreen.hs +++ b/hledger-ui/Hledger/UI/TransactionScreen.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" diff --git a/hledger-ui/Hledger/UI/UIState.hs b/hledger-ui/Hledger/UI/UIState.hs new file mode 100644 index 000000000..60d7d7995 --- /dev/null +++ b/hledger-ui/Hledger/UI/UIState.hs @@ -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 + diff --git a/hledger-ui/Hledger/UI/UITypes.hs b/hledger-ui/Hledger/UI/UITypes.hs index 7b7b98593..7a0bd850e 100644 --- a/hledger-ui/Hledger/UI/UITypes.hs +++ b/hledger-ui/Hledger/UI/UITypes.hs @@ -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,12 +59,12 @@ instance Show Editor where show _ = "" -- 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 - ,aPrevScreens :: [Screen] -- ^ previously visited screens, most recent first - ,aScreen :: Screen -- ^ the currently active screen - ,aMode :: Mode -- ^ the currently active mode +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 + ,aScreen :: Screen -- ^ the currently active screen + ,aMode :: Mode -- ^ the currently active mode } deriving (Show) -- | The mode modifies the screen's rendering and event handling. @@ -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 diff --git a/hledger-ui/Hledger/UI/UIUtils.hs b/hledger-ui/Hledger/UI/UIUtils.hs index a329ebd46..a4c4ed9fb 100644 --- a/hledger-ui/Hledger/UI/UIUtils.hs +++ b/hledger-ui/Hledger/UI/UIUtils.hs @@ -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 +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] - diff --git a/hledger-ui/hledger-ui.cabal b/hledger-ui/hledger-ui.cabal index 4c562c761..7fe017d88 100644 --- a/hledger-ui/hledger-ui.cabal +++ b/hledger-ui/hledger-ui.cabal @@ -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