slaesvuo/hledger
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

ui: preliminary lensification, just the accounts screen state

Browse Source 
Experimenting with lenses to reduce record accessing/updating noise.
So far, it's not at all a clear win.
cf https://github.com/jtdaugherty/brick/issues/62
This commit is contained in:
Simon Michael 2016-06-08 15:46:19 -07:00
parent 5c657dbd81
commit e6b1d2d5a7
2 changed files with 54 additions and 31 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

38
hledger-ui/Hledger/UI/AccountsScreen.hs
View File

@ -28,6 +28,7 @@ import Brick.Widgets.List
import Brick.Widgets.Edit import Brick.Widgets.Edit
import Brick.Widgets.Border (borderAttr) import Brick.Widgets.Border (borderAttr)
-- import Brick.Widgets.Center -- import Brick.Widgets.Center
import Lens.Micro ((.~), (&))
import Hledger import Hledger
import Hledger.Cli hiding (progname,prognameandversion,green) import Hledger.Cli hiding (progname,prognameandversion,green)
@ -41,24 +42,24 @@ import Hledger.UI.ErrorScreen
accountsScreen :: Screen accountsScreen :: Screen
accountsScreen = AccountsScreen{ accountsScreen = AccountsScreen{
asState = AccountsScreenState{asItems=list "accounts" V.empty 1 _asState = AccountsScreenState{_asItems=list "accounts" V.empty 1
,asSelectedAccount="" ,_asSelectedAccount=""
} }
,sInitFn = initAccountsScreen ,sInitFn = initAccountsScreen
,sDrawFn = drawAccountsScreen ,sDrawFn = drawAccountsScreen
,sHandleFn = handleAccountsScreen ,sHandleFn = handleAccountsScreen
} }
asSetSelectedAccount a scr@AccountsScreen{asState=st} = scr{asState=st{asSelectedAccount=a}} asSetSelectedAccount a s@AccountsScreen{} = s & asState . asSelectedAccount .~ a
asSetSelectedAccount _ scr = scr asSetSelectedAccount _ s = s
initAccountsScreen :: Day -> Bool -> AppState -> AppState initAccountsScreen :: Day -> Bool -> AppState -> AppState
initAccountsScreen d reset st@AppState{ initAccountsScreen d reset st@AppState{
aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}}, aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}},
ajournal=j, ajournal=j,
aScreen=s@AccountsScreen{asState=asState@AccountsScreenState{..}} aScreen=s@AccountsScreen{}
} = } =
st{aopts=uopts', aScreen=s{asState=asState{asItems=newitems'}}} st{aopts=uopts', aScreen=s & asState . asItems .~ newitems'}
where where
newitems = list (Name "accounts") (V.fromList displayitems) 1 newitems = list (Name "accounts") (V.fromList displayitems) 1
@ -66,7 +67,7 @@ initAccountsScreen d reset st@AppState{
-- (may need to move to the next leaf account when entering flat mode) -- (may need to move to the next leaf account when entering flat mode)
newitems' = listMoveTo selidx newitems newitems' = listMoveTo selidx newitems
where where
selidx = case (reset, listSelectedElement asItems) of selidx = case (reset, listSelectedElement $ s ^. asState . asItems) of
(True, _) -> 0 (True, _) -> 0
(_, Nothing) -> 0 (_, Nothing) -> 0
(_, Just (_,AccountsScreenItem{asItemAccountName=a})) -> fromMaybe (fromMaybe 0 mprefixmatch) mexactmatch (_, Just (_,AccountsScreenItem{asItemAccountName=a})) -> fromMaybe (fromMaybe 0 mprefixmatch) mexactmatch
@ -108,7 +109,7 @@ initAccountsScreen _ _ _ = error "init function called with wrong screen type, s
drawAccountsScreen :: AppState -> [Widget] drawAccountsScreen :: AppState -> [Widget]
drawAccountsScreen AppState{aopts=UIOpts{cliopts_=CliOpts{reportopts_=ropts}} drawAccountsScreen AppState{aopts=UIOpts{cliopts_=CliOpts{reportopts_=ropts}}
,ajournal=j ,ajournal=j
,aScreen=AccountsScreen{asState=AccountsScreenState{..}} ,aScreen=s@AccountsScreen{}
,aMinibuffer=mbuf} = ,aMinibuffer=mbuf} =
[ui] [ui]
where where
@ -141,10 +142,10 @@ drawAccountsScreen AppState{aopts=UIOpts{cliopts_=CliOpts{reportopts_=ropts}}
fs -> str " with " <+> withAttr (borderAttr <> "query") (str $ intercalate ", " fs) <+> str " txns" fs -> str " with " <+> withAttr (borderAttr <> "query") (str $ intercalate ", " fs) <+> str " txns"
nonzero | empty_ ropts = str "" nonzero | empty_ ropts = str ""
| otherwise = withAttr (borderAttr <> "query") (str " nonzero") | otherwise = withAttr (borderAttr <> "query") (str " nonzero")
cur = str (case asItems ^. listSelectedL of cur = str (case s ^. asState . asItems ^. listSelectedL of -- XXX second ^. required here but not below..
Nothing -> "-" Nothing -> "-"
Just i -> show (i + 1)) Just i -> show (i + 1))
total = str $ show $ V.length $ asItems ^. listElementsL total = str $ show $ V.length $ s ^. asState . asItems . listElementsL
bottomlabel = borderKeysStr [ bottomlabel = borderKeysStr [
-- ("up/down/pgup/pgdown/home/end", "move") -- ("up/down/pgup/pgdown/home/end", "move")
@ -173,7 +174,7 @@ drawAccountsScreen AppState{aopts=UIOpts{cliopts_=CliOpts{reportopts_=ropts}}
-- ltrace "availwidth" $ -- ltrace "availwidth" $
c^.availWidthL c^.availWidthL
- 2 -- XXX due to margin ? shouldn't be necessary (cf UIUtils) - 2 -- XXX due to margin ? shouldn't be necessary (cf UIUtils)
displayitems = listElements asItems displayitems = s ^. asState . asItems . listElementsL
maxacctwidthseen = maxacctwidthseen =
-- ltrace "maxacctwidthseen" $ -- ltrace "maxacctwidthseen" $
V.maximum $ V.maximum $
@ -201,7 +202,7 @@ drawAccountsScreen AppState{aopts=UIOpts{cliopts_=CliOpts{reportopts_=ropts}}
colwidths = (acctwidth, balwidth) colwidths = (acctwidth, balwidth)
render $ defaultLayout toplabel bottomarea $ renderList asItems (drawAccountsItem colwidths) render $ defaultLayout toplabel bottomarea $ renderList (s ^. asState . asItems) (drawAccountsItem colwidths)
drawAccountsScreen _ = error "draw function called with wrong screen type, should not happen" drawAccountsScreen _ = error "draw function called with wrong screen type, should not happen"
@ -234,7 +235,7 @@ drawAccountsItem (acctwidth, balwidth) selected AccountsScreenItem{..} =
handleAccountsScreen :: AppState -> Vty.Event -> EventM (Next AppState) handleAccountsScreen :: AppState -> Vty.Event -> EventM (Next AppState)
handleAccountsScreen st@AppState{ handleAccountsScreen st@AppState{
aScreen=scr@AccountsScreen{asState=asState@AccountsScreenState{..}} aScreen=scr@AccountsScreen{..}
,aopts=UIOpts{cliopts_=copts} ,aopts=UIOpts{cliopts_=copts}
,ajournal=j ,ajournal=j
,aMinibuffer=mbuf ,aMinibuffer=mbuf
@ -247,10 +248,10 @@ handleAccountsScreen st@AppState{
-- before we go anywhere, remember the currently selected account. -- before we go anywhere, remember the currently selected account.
-- (This is preserved across screen changes, unlike List's selection state) -- (This is preserved across screen changes, unlike List's selection state)
let let
selacct = case listSelectedElement asItems of selacct = case listSelectedElement $ scr ^. asState . asItems of
Just (_, AccountsScreenItem{..}) -> asItemAccountName Just (_, AccountsScreenItem{..}) -> asItemAccountName
Nothing -> asSelectedAccount Nothing -> scr ^. asState . asSelectedAccount
st' = st{aScreen=scr{asState=asState{asSelectedAccount=selacct}}} st' = st{aScreen=scr & asState . asSelectedAccount .~ selacct}
case mbuf of case mbuf of
Nothing -> Nothing ->
@ -290,8 +291,9 @@ handleAccountsScreen st@AppState{
-- fall through to the list's event handler (handles up/down) -- fall through to the list's event handler (handles up/down)
ev -> do ev -> do
newitems <- handleEvent ev asItems newitems <- handleEvent ev (scr ^. asState . asItems)
continue $ st'{aScreen=scr{asState=asState{asItems=newitems,asSelectedAccount=selacct}}} continue $ st'{aScreen=scr & asState . asItems .~ newitems
& asState . asSelectedAccount .~ selacct}
-- continue =<< handleEventLensed st' someLens ev -- continue =<< handleEventLensed st' someLens ev
Just ed -> Just ed ->

43
hledger-ui/Hledger/UI/UITypes.hs
View File

@ -30,14 +30,21 @@ Brick.defaultMain brickapp st
-} -}
{-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
module Hledger.UI.UITypes where module Hledger.UI.UITypes where
import Data.Monoid
import Data.Time.Calendar (Day) import Data.Time.Calendar (Day)
import qualified Graphics.Vty as V import qualified Graphics.Vty as Vty
import Brick import Brick
import Brick.Widgets.List (List) import Brick.Widgets.List
import Brick.Widgets.Edit (Editor) import Brick.Widgets.Edit (Editor)
import qualified Data.Vector as V
import Lens.Micro
import Lens.Micro.TH
import Text.Show.Functions () import Text.Show.Functions ()
-- import the Show instance for functions. Warning, this also re-exports it -- import the Show instance for functions. Warning, this also re-exports it
@ -62,35 +69,43 @@ data AppState = AppState {
-- partial functions, so take care. -- partial functions, so take care.
data Screen = data Screen =
AccountsScreen { AccountsScreen {
asState :: AccountsScreenState _asState :: AccountsScreenState
,sInitFn :: Day -> Bool -> AppState -> AppState -- ^ function to generate the screen's state on entry or change ,sInitFn :: Day -> Bool -> AppState -> AppState -- ^ function to generate the screen's state on entry or change
,sDrawFn :: AppState -> [Widget] -- ^ brick renderer for this screen ,sDrawFn :: AppState -> [Widget] -- ^ brick renderer for this screen
,sHandleFn :: AppState -> V.Event -> EventM (Next AppState) -- ^ brick event handler for this screen ,sHandleFn :: AppState -> Vty.Event -> EventM (Next AppState) -- ^ brick event handler for this screen
} }
| RegisterScreen { | RegisterScreen {
rsState :: RegisterScreenState rsState :: RegisterScreenState
,sInitFn :: Day -> Bool -> AppState -> AppState ,sInitFn :: Day -> Bool -> AppState -> AppState
,sDrawFn :: AppState -> [Widget] ,sDrawFn :: AppState -> [Widget]
,sHandleFn :: AppState -> V.Event -> EventM (Next AppState) ,sHandleFn :: AppState -> Vty.Event -> EventM (Next AppState)
} }
| TransactionScreen { | TransactionScreen {
tsState :: TransactionScreenState tsState :: TransactionScreenState
,sInitFn :: Day -> Bool -> AppState -> AppState ,sInitFn :: Day -> Bool -> AppState -> AppState
,sDrawFn :: AppState -> [Widget] ,sDrawFn :: AppState -> [Widget]
,sHandleFn :: AppState -> V.Event -> EventM (Next AppState) ,sHandleFn :: AppState -> Vty.Event -> EventM (Next AppState)
} }
| ErrorScreen { | ErrorScreen {
esState :: ErrorScreenState esState :: ErrorScreenState
,sInitFn :: Day -> Bool -> AppState -> AppState ,sInitFn :: Day -> Bool -> AppState -> AppState
,sDrawFn :: AppState -> [Widget] ,sDrawFn :: AppState -> [Widget]
,sHandleFn :: AppState -> V.Event -> EventM (Next AppState) ,sHandleFn :: AppState -> Vty.Event -> EventM (Next AppState)
} }
deriving (Show) deriving (Show)
instance Show (List a) where show _ = "<List>"
instance Show Editor where show _ = "<Editor>"
instance Monoid (List a)
where
mempty = list "" V.empty 1
mappend a b = a & listElementsL .~ (a^.listElementsL <> b^.listElementsL)
-- | Render state for this type of screen. -- | Render state for this type of screen.
data AccountsScreenState = AccountsScreenState { data AccountsScreenState = AccountsScreenState {
asItems :: List AccountsScreenItem -- ^ list of account names & balances _asItems :: List AccountsScreenItem -- ^ list of account names & balances
,asSelectedAccount :: AccountName -- ^ full name of the currently selected account (or "") ,_asSelectedAccount :: AccountName -- ^ full name of the currently selected account (or "")
} deriving (Show) } deriving (Show)
-- | An item in the accounts screen's list of accounts and balances. -- | An item in the accounts screen's list of accounts and balances.
@ -131,6 +146,12 @@ data ErrorScreenState = ErrorScreenState {
esError :: String -- ^ error message to show esError :: String -- ^ error message to show
} deriving (Show) } deriving (Show)
instance Show (List a) where show _ = "<List>" -- makeLenses ''AccountsScreenState
instance Show Editor where show _ = "<Editor>" concat <$> mapM makeLenses [
''AccountsScreenState
-- ,''RegisterScreenState
-- ,''TransactionScreenState
-- ,''ErrorScreenState
,''Screen
]