diff --git a/hledger-ui/Hledger/UI/AccountsScreen.hs b/hledger-ui/Hledger/UI/AccountsScreen.hs index 0964f51b1..12953f1b0 100644 --- a/hledger-ui/Hledger/UI/AccountsScreen.hs +++ b/hledger-ui/Hledger/UI/AccountsScreen.hs @@ -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 -> diff --git a/hledger-ui/Hledger/UI/UITypes.hs b/hledger-ui/Hledger/UI/UITypes.hs index 708126ce5..953af2f60 100644 --- a/hledger-ui/Hledger/UI/UITypes.hs +++ b/hledger-ui/Hledger/UI/UITypes.hs @@ -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 _ = "" +instance Show Editor where show _ = "" + +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. @@ -128,9 +143,15 @@ type NumberedTransaction = (Integer, Transaction) -- | Render state for this type of screen. data ErrorScreenState = ErrorScreenState { - esError :: String -- ^ error message to show + esError :: String -- ^ error message to show } deriving (Show) -instance Show (List a) where show _ = "" -instance Show Editor where show _ = "" +-- makeLenses ''AccountsScreenState +concat <$> mapM makeLenses [ + ''AccountsScreenState +-- ,''RegisterScreenState +-- ,''TransactionScreenState +-- ,''ErrorScreenState + ,''Screen + ]