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

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
+   _asState  = AccountsScreenState{_asItems=list "accounts" V.empty 1
-                                  ,asSelectedAccount=""
+                                  ,_asSelectedAccount=""
                                   }
   ,sInitFn   = initAccountsScreen
   ,sDrawFn   = drawAccountsScreen
   ,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 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
+                  Nothing -> scr ^. asState . asSelectedAccount
-      st' = st{aScreen=scr{asState=asState{asSelectedAccount=selacct}}}
+      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
+                                         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
 
       Just ed ->

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 _ = "<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
+   _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)
 
 -- | 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 _ = "<List>"
+-- makeLenses ''AccountsScreenState
-instance Show Editor   where show _ = "<Editor>"
+concat <$> mapM makeLenses [
+   ''AccountsScreenState
+--   ,''RegisterScreenState
+--   ,''TransactionScreenState
+--   ,''ErrorScreenState
+  ,''Screen
+  ]