ui: types cleanup

This commit is contained in:
Simon Michael 2015-10-28 11:35:40 -07:00
parent b950bd0d83
commit b48ee2d22e
4 changed files with 22 additions and 19 deletions

View File

@ -6,6 +6,7 @@
module Hledger.UI.AccountsScreen module Hledger.UI.AccountsScreen
(screen (screen
,initAccountsScreen ,initAccountsScreen
,asSetSelectedAccount
) )
where where
@ -32,7 +33,7 @@ import Hledger.UI.UIOptions
-- import Hledger.UI.Theme -- import Hledger.UI.Theme
import Hledger.UI.UITypes import Hledger.UI.UITypes
import Hledger.UI.UIUtils import Hledger.UI.UIUtils
import qualified Hledger.UI.RegisterScreen as RS (screen) import qualified Hledger.UI.RegisterScreen as RS (screen, rsSetCurrentAccount)
import qualified Hledger.UI.ErrorScreen as ES (screen) import qualified Hledger.UI.ErrorScreen as ES (screen)
screen = AccountsScreen{ screen = AccountsScreen{
@ -42,6 +43,9 @@ screen = AccountsScreen{
,sHandleFn = handleAccountsScreen ,sHandleFn = handleAccountsScreen
} }
asSetSelectedAccount a scr@AccountsScreen{asState=(l,_)} = scr{asState=(l,a)}
asSetSelectedAccount _ scr = scr
initAccountsScreen :: Day -> AppState -> AppState initAccountsScreen :: Day -> AppState -> AppState
initAccountsScreen d st@AppState{ initAccountsScreen d st@AppState{
aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}}, aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}},
@ -248,7 +252,7 @@ handleAccountsScreen st@AppState{
Vty.EvKey (Vty.KLeft) [] -> continue $ popScreen st' Vty.EvKey (Vty.KLeft) [] -> continue $ popScreen st'
Vty.EvKey (k) [] | k `elem` [Vty.KRight, Vty.KEnter] -> do Vty.EvKey (k) [] | k `elem` [Vty.KRight, Vty.KEnter] -> do
let let
scr = setRegisterScreenCurrentAccount selacct' RS.screen scr = RS.rsSetCurrentAccount selacct' RS.screen
st'' = screenEnter d scr st' st'' = screenEnter d scr st'
vScrollToBeginning $ viewportScroll "register" vScrollToBeginning $ viewportScroll "register"
continue st'' continue st''

View File

@ -94,7 +94,7 @@ runBrickUi uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}} j = do
-- with --register, start on the register screen, and also put -- with --register, start on the register screen, and also put
-- the accounts screen on the prev screens stack so you can exit -- the accounts screen on the prev screens stack so you can exit
-- to that as usual. -- to that as usual.
Just apat -> (setRegisterScreenCurrentAccount acct RS.screen, [ascr']) Just apat -> (rsSetCurrentAccount acct RS.screen, [ascr'])
where where
acct = headDef acct = headDef
(error' $ "--register "++apat++" did not match any account") (error' $ "--register "++apat++" did not match any account")
@ -106,7 +106,7 @@ runBrickUi uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}} j = do
AppState{ AppState{
aopts=uopts' aopts=uopts'
,ajournal=j ,ajournal=j
,aScreen=setAccountsScreenSelectedAccount acct AS.screen ,aScreen=asSetSelectedAccount acct AS.screen
,aPrevScreens=[] ,aPrevScreens=[]
} }

View File

@ -3,7 +3,9 @@
{-# LANGUAGE OverloadedStrings, FlexibleContexts #-} {-# LANGUAGE OverloadedStrings, FlexibleContexts #-}
module Hledger.UI.RegisterScreen module Hledger.UI.RegisterScreen
(screen) (screen
,rsSetCurrentAccount
)
where where
import Control.Lens ((^.)) import Control.Lens ((^.))
@ -37,6 +39,9 @@ screen = RegisterScreen{
,sHandleFn = handleRegisterScreen ,sHandleFn = handleRegisterScreen
} }
rsSetCurrentAccount a scr@RegisterScreen{rsState=(l,_)} = scr{rsState=(l,a)}
rsSetCurrentAccount _ scr = scr
initRegisterScreen :: Day -> AppState -> AppState initRegisterScreen :: Day -> AppState -> AppState
initRegisterScreen d st@AppState{aopts=opts, ajournal=j, aScreen=s@RegisterScreen{rsState=(_,acct)}} = initRegisterScreen d st@AppState{aopts=opts, ajournal=j, aScreen=s@RegisterScreen{rsState=(_,acct)}} =
st{aScreen=s{rsState=(l,acct)}} st{aScreen=s{rsState=(l,acct)}}

View File

@ -13,16 +13,17 @@ import Hledger.UI.UIOptions
-- | hledger-ui's application state. This is part of, but distinct -- | hledger-ui's application state. This is part of, but distinct
-- from, brick's App. -- from, brick's App.
data AppState = AppState { data AppState = AppState {
aopts :: UIOpts -- ^ command-line options, query, depth etc. currently in effect. aopts :: UIOpts -- ^ the command-line options and query currently in effect
-- ,aargs :: [String] -- ^ command-line arguments at startup ,ajournal :: Journal -- ^ the journal being viewed
,ajournal :: Journal -- ^ the parsed journal
,aScreen :: Screen -- ^ the currently active screen ,aScreen :: Screen -- ^ the currently active screen
,aPrevScreens :: [Screen] -- ^ previously visited screens ,aPrevScreens :: [Screen] -- ^ previously visited screens, most recent first
} deriving (Show) } deriving (Show)
-- | Types of screen available within the app, along with their state. -- | Types of screen available within the app, along with their state.
-- Screen types are distinguished by their constructor and by the type -- Screen types are distinguished by their constructor and their state
-- of their state (which must have unique accessor names). -- field, which must have unique names.
--
-- This type causes partial functions, so take care.
data Screen = data Screen =
AccountsScreen { AccountsScreen {
asState :: (List (Int,String,String,[String]), AccountName) -- ^ list widget holding (indent level, full account name, full or short account name to display, rendered amounts); asState :: (List (Int,String,String,[String]), AccountName) -- ^ list widget holding (indent level, full account name, full or short account name to display, rendered amounts);
@ -39,7 +40,7 @@ data Screen =
,sDrawFn :: AppState -> [Widget] ,sDrawFn :: AppState -> [Widget]
} }
| ErrorScreen { | ErrorScreen {
esState :: String -- ^ error message to display esState :: String -- ^ error message to display
,sInitFn :: Day -> AppState -> AppState ,sInitFn :: Day -> AppState -> AppState
,sHandleFn :: AppState -> V.Event -> EventM (Next AppState) ,sHandleFn :: AppState -> V.Event -> EventM (Next AppState)
,sDrawFn :: AppState -> [Widget] ,sDrawFn :: AppState -> [Widget]
@ -47,10 +48,3 @@ data Screen =
deriving (Show) deriving (Show)
instance Show (List a) where show _ = "<List>" instance Show (List a) where show _ = "<List>"
-- ugh
setAccountsScreenSelectedAccount a scr@AccountsScreen{asState=(l,_)} = scr{asState=(l,a)}
setAccountsScreenSelectedAccount _ scr = scr
setRegisterScreenCurrentAccount a scr@RegisterScreen{rsState=(l,_)} = scr{rsState=(l,a)}
setRegisterScreenCurrentAccount _ scr = scr