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
(screen
,initAccountsScreen
,asSetSelectedAccount
)
where
@ -32,7 +33,7 @@ import Hledger.UI.UIOptions
-- import Hledger.UI.Theme
import Hledger.UI.UITypes
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)
screen = AccountsScreen{
@ -42,6 +43,9 @@ screen = AccountsScreen{
,sHandleFn = handleAccountsScreen
}
asSetSelectedAccount a scr@AccountsScreen{asState=(l,_)} = scr{asState=(l,a)}
asSetSelectedAccount _ scr = scr
initAccountsScreen :: Day -> AppState -> AppState
initAccountsScreen d st@AppState{
aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}},
@ -248,7 +252,7 @@ handleAccountsScreen st@AppState{
Vty.EvKey (Vty.KLeft) [] -> continue $ popScreen st'
Vty.EvKey (k) [] | k `elem` [Vty.KRight, Vty.KEnter] -> do
let
scr = setRegisterScreenCurrentAccount selacct' RS.screen
scr = RS.rsSetCurrentAccount selacct' RS.screen
st'' = screenEnter d scr st'
vScrollToBeginning $ viewportScroll "register"
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
-- the accounts screen on the prev screens stack so you can exit
-- to that as usual.
Just apat -> (setRegisterScreenCurrentAccount acct RS.screen, [ascr'])
Just apat -> (rsSetCurrentAccount acct RS.screen, [ascr'])
where
acct = headDef
(error' $ "--register "++apat++" did not match any account")
@ -106,7 +106,7 @@ runBrickUi uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}} j = do
AppState{
aopts=uopts'
,ajournal=j
,aScreen=setAccountsScreenSelectedAccount acct AS.screen
,aScreen=asSetSelectedAccount acct AS.screen
,aPrevScreens=[]
}

View File

@ -3,7 +3,9 @@
{-# LANGUAGE OverloadedStrings, FlexibleContexts #-}
module Hledger.UI.RegisterScreen
(screen)
(screen
,rsSetCurrentAccount
)
where
import Control.Lens ((^.))
@ -37,6 +39,9 @@ screen = RegisterScreen{
,sHandleFn = handleRegisterScreen
}
rsSetCurrentAccount a scr@RegisterScreen{rsState=(l,_)} = scr{rsState=(l,a)}
rsSetCurrentAccount _ scr = scr
initRegisterScreen :: Day -> AppState -> AppState
initRegisterScreen d st@AppState{aopts=opts, ajournal=j, aScreen=s@RegisterScreen{rsState=(_,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
-- from, brick's App.
data AppState = AppState {
aopts :: UIOpts -- ^ command-line options, query, depth etc. currently in effect.
-- ,aargs :: [String] -- ^ command-line arguments at startup
,ajournal :: Journal -- ^ the parsed journal
aopts :: UIOpts -- ^ the command-line options and query currently in effect
,ajournal :: Journal -- ^ the journal being viewed
,aScreen :: Screen -- ^ the currently active screen
,aPrevScreens :: [Screen] -- ^ previously visited screens
,aPrevScreens :: [Screen] -- ^ previously visited screens, most recent first
} deriving (Show)
-- | Types of screen available within the app, along with their state.
-- Screen types are distinguished by their constructor and by the type
-- of their state (which must have unique accessor names).
-- Screen types are distinguished by their constructor and their state
-- field, which must have unique names.
--
-- This type causes partial functions, so take care.
data Screen =
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);
@ -39,7 +40,7 @@ data Screen =
,sDrawFn :: AppState -> [Widget]
}
| ErrorScreen {
esState :: String -- ^ error message to display
esState :: String -- ^ error message to display
,sInitFn :: Day -> AppState -> AppState
,sHandleFn :: AppState -> V.Event -> EventM (Next AppState)
,sDrawFn :: AppState -> [Widget]
@ -47,10 +48,3 @@ data Screen =
deriving (Show)
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