ui: preliminary lensification, just the accounts screen state
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
parent
5c657dbd81
commit
e6b1d2d5a7
@ -28,6 +28,7 @@ import Brick.Widgets.List
|
||||
import Brick.Widgets.Edit
|
||||
import Brick.Widgets.Border (borderAttr)
|
||||
-- import Brick.Widgets.Center
|
||||
import Lens.Micro ((.~), (&))
|
||||
|
||||
import Hledger
|
||||
import Hledger.Cli hiding (progname,prognameandversion,green)
|
||||
@ -41,24 +42,24 @@ import Hledger.UI.ErrorScreen
|
||||
|
||||
accountsScreen :: Screen
|
||||
accountsScreen = AccountsScreen{
|
||||
asState = AccountsScreenState{asItems=list "accounts" V.empty 1
|
||||
,asSelectedAccount=""
|
||||
_asState = AccountsScreenState{_asItems=list "accounts" V.empty 1
|
||||
,_asSelectedAccount=""
|
||||
}
|
||||
,sInitFn = initAccountsScreen
|
||||
,sDrawFn = drawAccountsScreen
|
||||
,sHandleFn = handleAccountsScreen
|
||||
}
|
||||
|
||||
asSetSelectedAccount a scr@AccountsScreen{asState=st} = scr{asState=st{asSelectedAccount=a}}
|
||||
asSetSelectedAccount _ scr = scr
|
||||
asSetSelectedAccount a s@AccountsScreen{} = s & asState . asSelectedAccount .~ a
|
||||
asSetSelectedAccount _ s = s
|
||||
|
||||
initAccountsScreen :: Day -> Bool -> AppState -> AppState
|
||||
initAccountsScreen d reset st@AppState{
|
||||
aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}},
|
||||
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
|
||||
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)
|
||||
newitems' = listMoveTo selidx newitems
|
||||
where
|
||||
selidx = case (reset, listSelectedElement asItems) of
|
||||
selidx = case (reset, listSelectedElement $ s ^. asState . asItems) of
|
||||
(True, _) -> 0
|
||||
(_, Nothing) -> 0
|
||||
(_, 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{aopts=UIOpts{cliopts_=CliOpts{reportopts_=ropts}}
|
||||
,ajournal=j
|
||||
,aScreen=AccountsScreen{asState=AccountsScreenState{..}}
|
||||
,aScreen=s@AccountsScreen{}
|
||||
,aMinibuffer=mbuf} =
|
||||
[ui]
|
||||
where
|
||||
@ -141,10 +142,10 @@ drawAccountsScreen AppState{aopts=UIOpts{cliopts_=CliOpts{reportopts_=ropts}}
|
||||
fs -> str " with " <+> withAttr (borderAttr <> "query") (str $ intercalate ", " fs) <+> str " txns"
|
||||
nonzero | empty_ ropts = str ""
|
||||
| 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 -> "-"
|
||||
Just i -> show (i + 1))
|
||||
total = str $ show $ V.length $ asItems ^. listElementsL
|
||||
total = str $ show $ V.length $ s ^. asState . asItems . listElementsL
|
||||
|
||||
bottomlabel = borderKeysStr [
|
||||
-- ("up/down/pgup/pgdown/home/end", "move")
|
||||
@ -173,7 +174,7 @@ drawAccountsScreen AppState{aopts=UIOpts{cliopts_=CliOpts{reportopts_=ropts}}
|
||||
-- ltrace "availwidth" $
|
||||
c^.availWidthL
|
||||
- 2 -- XXX due to margin ? shouldn't be necessary (cf UIUtils)
|
||||
displayitems = listElements asItems
|
||||
displayitems = s ^. asState . asItems . listElementsL
|
||||
maxacctwidthseen =
|
||||
-- ltrace "maxacctwidthseen" $
|
||||
V.maximum $
|
||||
@ -201,7 +202,7 @@ drawAccountsScreen AppState{aopts=UIOpts{cliopts_=CliOpts{reportopts_=ropts}}
|
||||
|
||||
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"
|
||||
|
||||
@ -234,7 +235,7 @@ drawAccountsItem (acctwidth, balwidth) selected AccountsScreenItem{..} =
|
||||
|
||||
handleAccountsScreen :: AppState -> Vty.Event -> EventM (Next AppState)
|
||||
handleAccountsScreen st@AppState{
|
||||
aScreen=scr@AccountsScreen{asState=asState@AccountsScreenState{..}}
|
||||
aScreen=scr@AccountsScreen{..}
|
||||
,aopts=UIOpts{cliopts_=copts}
|
||||
,ajournal=j
|
||||
,aMinibuffer=mbuf
|
||||
@ -247,10 +248,10 @@ handleAccountsScreen st@AppState{
|
||||
-- before we go anywhere, remember the currently selected account.
|
||||
-- (This is preserved across screen changes, unlike List's selection state)
|
||||
let
|
||||
selacct = case listSelectedElement asItems of
|
||||
selacct = case listSelectedElement $ scr ^. asState . asItems of
|
||||
Just (_, AccountsScreenItem{..}) -> asItemAccountName
|
||||
Nothing -> asSelectedAccount
|
||||
st' = st{aScreen=scr{asState=asState{asSelectedAccount=selacct}}}
|
||||
Nothing -> scr ^. asState . asSelectedAccount
|
||||
st' = st{aScreen=scr & asState . asSelectedAccount .~ selacct}
|
||||
|
||||
case mbuf of
|
||||
Nothing ->
|
||||
@ -290,8 +291,9 @@ handleAccountsScreen st@AppState{
|
||||
|
||||
-- fall through to the list's event handler (handles up/down)
|
||||
ev -> do
|
||||
newitems <- handleEvent ev asItems
|
||||
continue $ st'{aScreen=scr{asState=asState{asItems=newitems,asSelectedAccount=selacct}}}
|
||||
newitems <- handleEvent ev (scr ^. asState . asItems)
|
||||
continue $ st'{aScreen=scr & asState . asItems .~ newitems
|
||||
& asState . asSelectedAccount .~ selacct}
|
||||
-- continue =<< handleEventLensed st' someLens ev
|
||||
|
||||
Just ed ->
|
||||
|
||||
@ -30,14 +30,21 @@ Brick.defaultMain brickapp st
|
||||
-}
|
||||
|
||||
{-# LANGUAGE StandaloneDeriving #-}
|
||||
{-# LANGUAGE DeriveAnyClass #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
|
||||
module Hledger.UI.UITypes where
|
||||
|
||||
import Data.Monoid
|
||||
import Data.Time.Calendar (Day)
|
||||
import qualified Graphics.Vty as V
|
||||
import qualified Graphics.Vty as Vty
|
||||
import Brick
|
||||
import Brick.Widgets.List (List)
|
||||
import Brick.Widgets.List
|
||||
import Brick.Widgets.Edit (Editor)
|
||||
import qualified Data.Vector as V
|
||||
import Lens.Micro
|
||||
import Lens.Micro.TH
|
||||
import Text.Show.Functions ()
|
||||
-- import the Show instance for functions. Warning, this also re-exports it
|
||||
|
||||
@ -62,35 +69,43 @@ data AppState = AppState {
|
||||
-- partial functions, so take care.
|
||||
data Screen =
|
||||
AccountsScreen {
|
||||
asState :: AccountsScreenState
|
||||
_asState :: AccountsScreenState
|
||||
,sInitFn :: Day -> Bool -> AppState -> AppState -- ^ function to generate the screen's state on entry or change
|
||||
,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 {
|
||||
rsState :: RegisterScreenState
|
||||
,sInitFn :: Day -> Bool -> AppState -> AppState
|
||||
,sDrawFn :: AppState -> [Widget]
|
||||
,sHandleFn :: AppState -> V.Event -> EventM (Next AppState)
|
||||
,sHandleFn :: AppState -> Vty.Event -> EventM (Next AppState)
|
||||
}
|
||||
| TransactionScreen {
|
||||
tsState :: TransactionScreenState
|
||||
,sInitFn :: Day -> Bool -> AppState -> AppState
|
||||
,sDrawFn :: AppState -> [Widget]
|
||||
,sHandleFn :: AppState -> V.Event -> EventM (Next AppState)
|
||||
,sHandleFn :: AppState -> Vty.Event -> EventM (Next AppState)
|
||||
}
|
||||
| ErrorScreen {
|
||||
esState :: ErrorScreenState
|
||||
,sInitFn :: Day -> Bool -> AppState -> AppState
|
||||
,sDrawFn :: AppState -> [Widget]
|
||||
,sHandleFn :: AppState -> V.Event -> EventM (Next AppState)
|
||||
,sHandleFn :: AppState -> Vty.Event -> EventM (Next AppState)
|
||||
}
|
||||
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.
|
||||
data AccountsScreenState = AccountsScreenState {
|
||||
asItems :: List AccountsScreenItem -- ^ list of account names & balances
|
||||
,asSelectedAccount :: AccountName -- ^ full name of the currently selected account (or "")
|
||||
_asItems :: List AccountsScreenItem -- ^ list of account names & balances
|
||||
,_asSelectedAccount :: AccountName -- ^ full name of the currently selected account (or "")
|
||||
} deriving (Show)
|
||||
|
||||
-- | 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
|
||||
} deriving (Show)
|
||||
|
||||
instance Show (List a) where show _ = "<List>"
|
||||
instance Show Editor where show _ = "<Editor>"
|
||||
-- makeLenses ''AccountsScreenState
|
||||
concat <$> mapM makeLenses [
|
||||
''AccountsScreenState
|
||||
-- ,''RegisterScreenState
|
||||
-- ,''TransactionScreenState
|
||||
-- ,''ErrorScreenState
|
||||
,''Screen
|
||||
]
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user