nested lens usage refactor (part 1) (#2268)

Towards #2265. This will be a multi-part refactoring, since `uiGamestate` is accessed in hundreds of places. The more repetition that can be eliminated, the easier it will be to eventually modify the type of the record fields. In this PR, a few no-op refactorings: * use a narrower type in many places (e.g. pass `UIGameplay` rather than `AppState` as function parameter * define local aliases for long lens chains * Use `zoom` for blocks of operations on deeply nested state
swarm-game · Jan 6, 2025 · 2193e84 · 2193e84
1 parent 0ad3582
commit 2193e84
Show file tree

Hide file tree

Showing 9 changed files with 290 additions and 234 deletions.
diff --git a/src/swarm-tui/Swarm/TUI/Controller.hs b/src/swarm-tui/Swarm/TUI/Controller.hs
@@ -641,14 +641,15 @@ handleREPLEventTyping = \case
                   modify validateREPLForm
           -- Otherwise, just move around in the history as normal.
           _ -> modify $ adjReplHistIndex Newer
-      ControlChar 'r' -> do
-        s <- get
-        let uinput = s ^. uiState . uiGameplay . uiREPL . replPromptText
-        case s ^. uiState . uiGameplay . uiREPL . replPromptType of
-          CmdPrompt _ -> uiState . uiGameplay . uiREPL . replPromptType .= SearchPrompt (s ^. uiState . uiGameplay . uiREPL . replHistory)
-          SearchPrompt rh -> case lastEntry uinput rh of
-            Nothing -> pure ()
-            Just found -> uiState . uiGameplay . uiREPL . replPromptType .= SearchPrompt (removeEntry found rh)
+      ControlChar 'r' ->
+        Brick.zoom (uiState . uiGameplay . uiREPL) $ do
+          uir <- get
+          let uinput = uir ^. replPromptText
+          case uir ^. replPromptType of
+            CmdPrompt _ -> replPromptType .= SearchPrompt (uir ^. replHistory)
+            SearchPrompt rh -> case lastEntry uinput rh of
+              Nothing -> pure ()
+              Just found -> replPromptType .= SearchPrompt (removeEntry found rh)
       CharKey '\t' -> do
         s <- get
         let names = s ^.. gameState . baseEnv . envTypes . to assocs . traverse . _1

diff --git a/src/swarm-tui/Swarm/TUI/Controller/EventHandlers/Frame.hs b/src/swarm-tui/Swarm/TUI/Controller/EventHandlers/Frame.hs
@@ -51,69 +51,76 @@ runFrame = do
 
   -- The logic here is taken from https://gafferongames.com/post/fix_your_timestep/ .
 
-  -- Find out how long the previous frame took, by subtracting the
-  -- previous time from the current time.
-  prevTime <- use (uiState . uiGameplay . uiTiming . lastFrameTime)
   curTime <- liftIO $ getTime Monotonic
-  let frameTime = diffTimeSpec curTime prevTime
-
-  -- Remember now as the new previous time.
-  uiState . uiGameplay . uiTiming . lastFrameTime .= curTime
-
-  -- We now have some additional accumulated time to play with.  The
-  -- idea is to now "catch up" by doing as many ticks as are supposed
-  -- to fit in the accumulated time.  Some accumulated time may be
-  -- left over, but it will roll over to the next frame.  This way we
-  -- deal smoothly with things like a variable frame rate, the frame
-  -- rate not being a nice multiple of the desired ticks per second,
-  -- etc.
-  uiState . uiGameplay . uiTiming . accumulatedTime += frameTime
-
-  -- Figure out how many ticks per second we're supposed to do,
-  -- and compute the timestep `dt` for a single tick.
-  lgTPS <- use (uiState . uiGameplay . uiTiming . lgTicksPerSecond)
-  let oneSecond = 1_000_000_000 -- one second = 10^9 nanoseconds
-      dt
-        | lgTPS >= 0 = oneSecond `div` (1 `shiftL` lgTPS)
-        | otherwise = oneSecond * (1 `shiftL` abs lgTPS)
+  Brick.zoom (uiState . uiGameplay . uiTiming) $ do
+    -- Find out how long the previous frame took, by subtracting the
+    -- previous time from the current time.
+    prevTime <- use lastFrameTime
+    let frameTime = diffTimeSpec curTime prevTime
+
+    -- Remember now as the new previous time.
+    lastFrameTime .= curTime
+
+    -- We now have some additional accumulated time to play with.  The
+    -- idea is to now "catch up" by doing as many ticks as are supposed
+    -- to fit in the accumulated time.  Some accumulated time may be
+    -- left over, but it will roll over to the next frame.  This way we
+    -- deal smoothly with things like a variable frame rate, the frame
+    -- rate not being a nice multiple of the desired ticks per second,
+    -- etc.
+    accumulatedTime += frameTime
 
   -- Update TPS/FPS counters every second
   infoUpdateTime <- use (uiState . uiGameplay . uiTiming . lastInfoTime)
   let updateTime = toNanoSecs $ diffTimeSpec curTime infoUpdateTime
   when (updateTime >= oneSecond) $ do
     -- Wait for at least one second to have elapsed
     when (infoUpdateTime /= 0) $ do
-      -- set how much frame got processed per second
-      frames <- use (uiState . uiGameplay . uiTiming . frameCount)
-      uiState . uiGameplay . uiTiming . uiFPS .= fromIntegral (frames * fromInteger oneSecond) / fromIntegral updateTime
+      Brick.zoom (uiState . uiGameplay . uiTiming) $ do
+        -- set how much frame got processed per second
+        frames <- use frameCount
+        uiFPS .= fromIntegral (frames * fromInteger oneSecond) / fromIntegral updateTime
 
-      -- set how much ticks got processed per frame
-      uiTicks <- use (uiState . uiGameplay . uiTiming . tickCount)
-      uiState . uiGameplay . uiTiming . uiTPF .= fromIntegral uiTicks / fromIntegral frames
+        -- set how much ticks got processed per frame
+        uiTicks <- use tickCount
+        uiTPF .= fromIntegral uiTicks / fromIntegral frames
 
       -- ensure this frame gets drawn
       gameState . needsRedraw .= True
 
-    -- Reset the counter and wait another seconds for the next update
-    uiState . uiGameplay . uiTiming . tickCount .= 0
-    uiState . uiGameplay . uiTiming . frameCount .= 0
-    uiState . uiGameplay . uiTiming . lastInfoTime .= curTime
+    Brick.zoom (uiState . uiGameplay . uiTiming) $ do
+      -- Reset the counter and wait another seconds for the next update
+      tickCount .= 0
+      frameCount .= 0
+      lastInfoTime .= curTime
+
+  Brick.zoom (uiState . uiGameplay . uiTiming) $ do
+    -- Increment the frame count
+    frameCount += 1
 
-  -- Increment the frame count
-  uiState . uiGameplay . uiTiming . frameCount += 1
+    -- Now do as many ticks as we need to catch up.
+    frameTickCount .= 0
+
+  -- Figure out how many ticks per second we're supposed to do,
+  -- and compute the timestep `dt` for a single tick.
+  lgTPS <- use (uiState . uiGameplay . uiTiming . lgTicksPerSecond)
+  let dt
+        | lgTPS >= 0 = oneSecond `div` (1 `shiftL` lgTPS)
+        | otherwise = oneSecond * (1 `shiftL` abs lgTPS)
 
-  -- Now do as many ticks as we need to catch up.
-  uiState . uiGameplay . uiTiming . frameTickCount .= 0
   runFrameTicks (fromNanoSecs dt)
+ where
+  oneSecond = 1_000_000_000 -- one second = 10^9 nanoseconds
 
 -- | Do zero or more ticks, with each tick notionally taking the given
 --   timestep, until we have used up all available accumulated time,
 --   OR until we have hit the cap on ticks per frame, whichever comes
 --   first.
 runFrameTicks :: TimeSpec -> EventM Name AppState ()
 runFrameTicks dt = do
-  a <- use (uiState . uiGameplay . uiTiming . accumulatedTime)
-  t <- use (uiState . uiGameplay . uiTiming . frameTickCount)
+  timing <- use $ uiState . uiGameplay . uiTiming
+  let a = timing ^. accumulatedTime
+      t = timing ^. frameTickCount
 
   -- Ensure there is still enough time left, and we haven't hit the
   -- tick limit for this frame.

diff --git a/src/swarm-tui/Swarm/TUI/Controller/EventHandlers/Main.hs b/src/swarm-tui/Swarm/TUI/Controller/EventHandlers/Main.hs
@@ -94,15 +94,15 @@ viewGoal = do
     else continueWithoutRedraw
 
 hideRobots :: EventM Name AppState ()
-hideRobots = do
+hideRobots = Brick.zoom (uiState . uiGameplay) $ do
   t <- liftIO $ getTime Monotonic
-  h <- use $ uiState . uiGameplay . uiHideRobotsUntil
+  h <- use uiHideRobotsUntil
   case h >= t of
     -- ignore repeated keypresses
     True -> continueWithoutRedraw
     -- hide for two seconds
     False -> do
-      uiState . uiGameplay . uiHideRobotsUntil .= t + TimeSpec 2 0
+      uiHideRobotsUntil .= t + TimeSpec 2 0
       invalidateCacheEntry WorldCache
 
 showCESKDebug :: EventM Name AppState ()

diff --git a/src/swarm-tui/Swarm/TUI/Controller/EventHandlers/REPL.hs b/src/swarm-tui/Swarm/TUI/Controller/EventHandlers/REPL.hs
@@ -51,7 +51,7 @@ togglePilotingMode = do
   s <- get
   let theRepl = s ^. uiState . uiGameplay . uiREPL
       uinput = theRepl ^. replPromptText
-  curMode <- use $ uiState . uiGameplay . uiREPL . replControlMode
+      curMode = theRepl ^. replControlMode
   case curMode of
     Piloting -> uiState . uiGameplay . uiREPL . replControlMode .= Typing
     _ ->

diff --git a/src/swarm-tui/Swarm/TUI/Editor/Controller.hs b/src/swarm-tui/Swarm/TUI/Editor/Controller.hs
@@ -41,11 +41,12 @@ import System.Clock
 activateWorldEditorFunction :: WorldEditorFocusable -> EventM Name AppState ()
 activateWorldEditorFunction BrushSelector = openModal TerrainPaletteModal
 activateWorldEditorFunction EntitySelector = openModal EntityPaletteModal
-activateWorldEditorFunction AreaSelector = do
-  selectorStage <- use $ uiState . uiGameplay . uiWorldEditor . editingBounds . boundsSelectionStep
-  case selectorStage of
-    SelectionComplete -> uiState . uiGameplay . uiWorldEditor . editingBounds . boundsSelectionStep .= UpperLeftPending
-    _ -> return ()
+activateWorldEditorFunction AreaSelector =
+  Brick.zoom (uiState . uiGameplay . uiWorldEditor . editingBounds) $ do
+    selectorStage <- use boundsSelectionStep
+    case selectorStage of
+      SelectionComplete -> boundsSelectionStep .= UpperLeftPending
+      _ -> return ()
 activateWorldEditorFunction OutputPathSelector =
   -- TODO: #1371
   liftIO $ putStrLn "File selection"
@@ -143,16 +144,20 @@ updateAreaBounds = \case
 
 saveMapFile :: EventM Name AppState ()
 saveMapFile = do
-  worldEditor <- use $ uiState . uiGameplay . uiWorldEditor
-  maybeBounds <- use $ uiState . uiGameplay . uiWorldEditor . editingBounds . boundsRect
-  w <- use $ gameState . landscape . multiWorld
-  tm <- use $ gameState . landscape . terrainAndEntities . terrainMap
-  let mapCellGrid =
+  uig <- use $ uiState . uiGameplay
+  land <- use $ gameState . landscape
+  let worldEditor = uig ^. uiWorldEditor
+      maybeBounds = uig ^. uiWorldEditor . editingBounds . boundsRect
+
+      w = land ^. multiWorld
+      tm = land ^. terrainAndEntities . terrainMap
+      mapCellGrid =
         Just
           <$> EU.getEditedMapRectangle tm (worldEditor ^. worldOverdraw) maybeBounds w
 
-  let fp = worldEditor ^. outputFilePath
-  maybeScenarioPair <- use $ uiState . uiGameplay . scenarioRef
+      fp = worldEditor ^. outputFilePath
+      maybeScenarioPair = uig ^. scenarioRef
+
   liftIO $ Y.encodeFile fp $ constructScenario (fst <$> maybeScenarioPair) mapCellGrid
 
   uiState . uiGameplay . uiWorldEditor . lastWorldEditorMessage .= Just "Saved."
diff --git a/src/swarm-tui/Swarm/TUI/Editor/View.hs b/src/swarm-tui/Swarm/TUI/Editor/View.hs
@@ -19,21 +19,20 @@ import Swarm.TUI.Border
 import Swarm.TUI.Editor.Model
 import Swarm.TUI.Model
 import Swarm.TUI.Model.Name
-import Swarm.TUI.Model.UI
 import Swarm.TUI.Model.UI.Gameplay
 import Swarm.TUI.Panel
 import Swarm.TUI.View.Attribute.Attr
 import Swarm.TUI.View.CellDisplay (renderDisplay)
 import Swarm.TUI.View.Util qualified as VU
 import Swarm.Util (applyWhen)
 
-extractTerrainMap :: UIState -> TerrainMap
-extractTerrainMap uis =
+extractTerrainMap :: UIGameplay -> TerrainMap
+extractTerrainMap uig =
   maybe mempty (view (scenarioLandscape . scenarioTerrainAndEntities . terrainMap) . fst) $
-    uis ^. uiGameplay . scenarioRef
+    uig ^. scenarioRef
 
-drawWorldEditor :: FocusRing Name -> UIState -> Widget Name
-drawWorldEditor toplevelFocusRing uis =
+drawWorldEditor :: FocusRing Name -> UIGameplay -> Widget Name
+drawWorldEditor toplevelFocusRing uig =
   if worldEditor ^. worldOverdraw . isWorldEditorEnabled
     then
       panel
@@ -64,7 +63,7 @@ drawWorldEditor toplevelFocusRing uis =
       hLimit 30 $
         controlsBox <=> statusBox
 
-  worldEditor = uis ^. uiGameplay . uiWorldEditor
+  worldEditor = uig ^. uiWorldEditor
   maybeAreaBounds = worldEditor ^. editingBounds . boundsRect
 
   -- TODO (#1150): Use withFocusRing?
@@ -80,7 +79,7 @@ drawWorldEditor toplevelFocusRing uis =
    where
     selectedThing = snd <$> BL.listSelectedElement list
 
-  tm = extractTerrainMap uis
+  tm = extractTerrainMap uig
 
   brushWidget =
     mkFormControl (WorldEditorPanelControl BrushSelector) $
@@ -146,25 +145,25 @@ drawLabeledEntitySwatch (EntityFacade eName eDisplay) =
  where
   tile = padRight (Pad 1) $ renderDisplay eDisplay
 
-drawTerrainSelector :: AppState -> Widget Name
-drawTerrainSelector s =
+drawTerrainSelector :: UIGameplay -> Widget Name
+drawTerrainSelector uig =
   padAll 1
     . hCenter
     . vLimit 8
-    . BL.renderListWithIndex (listDrawTerrainElement $ extractTerrainMap $ s ^. uiState) True
-    $ s ^. uiState . uiGameplay . uiWorldEditor . terrainList
+    . BL.renderListWithIndex (listDrawTerrainElement $ extractTerrainMap uig) True
+    $ uig ^. uiWorldEditor . terrainList
 
 listDrawTerrainElement :: TerrainMap -> Int -> Bool -> TerrainType -> Widget Name
 listDrawTerrainElement tm pos _isSelected a =
   clickable (TerrainListItem pos) $ VU.drawLabeledTerrainSwatch tm a
 
-drawEntityPaintSelector :: AppState -> Widget Name
-drawEntityPaintSelector s =
+drawEntityPaintSelector :: UIGameplay -> Widget Name
+drawEntityPaintSelector uig =
   padAll 1
     . hCenter
     . vLimit 10
     . BL.renderListWithIndex listDrawEntityPaintElement True
-    $ s ^. uiState . uiGameplay . uiWorldEditor . entityPaintList
+    $ uig ^. uiWorldEditor . entityPaintList
 
 listDrawEntityPaintElement :: Int -> Bool -> EntityFacade -> Widget Name
 listDrawEntityPaintElement pos _isSelected a =

diff --git a/src/swarm-tui/Swarm/TUI/Model/StateUpdate.hs b/src/swarm-tui/Swarm/TUI/Model/StateUpdate.hs
@@ -245,14 +245,54 @@ scenarioToAppState siPair@(scene, _) lp = do
     l .= x'
     return x'
 
+setUIGameplay ::
+  GameState ->
+  TimeSpec ->
+  Bool ->
+  ScenarioInfoPair ->
+  UIGameplay ->
+  UIGameplay
+setUIGameplay gs curTime isAutoplaying siPair@(scenario, _) uig =
+  uig
+    & uiDialogs . uiGoal .~ emptyGoalDisplay
+    & uiIsAutoPlay .~ isAutoplaying
+    & uiFocusRing .~ initFocusRing
+    & uiInventory . uiInventorySearch .~ Nothing
+    & uiInventory . uiInventoryList .~ Nothing
+    & uiInventory . uiInventorySort .~ defaultSortOptions
+    & uiInventory . uiShowZero .~ True
+    & uiTiming . uiShowFPS .~ False
+    & uiREPL .~ initREPLState (uig ^. uiREPL . replHistory)
+    & uiREPL . replHistory %~ restartREPLHistory
+    & scenarioRef ?~ siPair
+    & uiTiming . lastFrameTime .~ curTime
+    & uiWorldEditor . EM.entityPaintList %~ BL.listReplace entityList Nothing
+    & uiWorldEditor . EM.editingBounds . EM.boundsRect %~ setNewBounds
+    & uiDialogs . uiStructure
+      .~ StructureDisplay
+        (SR.makeListWidget . M.elems $ gs ^. landscape . recognizerAutomatons . originalStructureDefinitions)
+        (focusSetCurrent (StructureWidgets StructuresList) $ focusRing $ map StructureWidgets enumerate)
+ where
+  entityList = EU.getEntitiesForList $ gs ^. landscape . terrainAndEntities . entityMap
+
+  (isEmptyArea, newBounds) =
+    EU.getEditingBounds $
+      NE.head $
+        scenario ^. scenarioLandscape . scenarioWorlds
+
+  setNewBounds maybeOldBounds =
+    if isEmptyArea
+      then maybeOldBounds
+      else Just newBounds
+
 -- | Modify the UI state appropriately when starting a new scenario.
 scenarioToUIState ::
   Bool ->
   ScenarioInfoPair ->
   GameState ->
   UIState ->
   IO UIState
-scenarioToUIState isAutoplaying siPair@(scenario, _) gs u = do
+scenarioToUIState isAutoplaying siPair gs u = do
   curTime <- getTime Monotonic
   return $
     u
@@ -263,36 +303,7 @@ scenarioToUIState isAutoplaying siPair@(scenario, _) gs u = do
               fst siPair ^. scenarioLandscape . scenarioAttrs
           )
           swarmAttrMap
-      & uiGameplay . uiDialogs . uiGoal .~ emptyGoalDisplay
-      & uiGameplay . uiIsAutoPlay .~ isAutoplaying
-      & uiGameplay . uiFocusRing .~ initFocusRing
-      & uiGameplay . uiInventory . uiInventorySearch .~ Nothing
-      & uiGameplay . uiInventory . uiInventoryList .~ Nothing
-      & uiGameplay . uiInventory . uiInventorySort .~ defaultSortOptions
-      & uiGameplay . uiInventory . uiShowZero .~ True
-      & uiGameplay . uiTiming . uiShowFPS .~ False
-      & uiGameplay . uiREPL .~ initREPLState (u ^. uiGameplay . uiREPL . replHistory)
-      & uiGameplay . uiREPL . replHistory %~ restartREPLHistory
-      & uiGameplay . scenarioRef ?~ siPair
-      & uiGameplay . uiTiming . lastFrameTime .~ curTime
-      & uiGameplay . uiWorldEditor . EM.entityPaintList %~ BL.listReplace entityList Nothing
-      & uiGameplay . uiWorldEditor . EM.editingBounds . EM.boundsRect %~ setNewBounds
-      & uiGameplay . uiDialogs . uiStructure
-        .~ StructureDisplay
-          (SR.makeListWidget . M.elems $ gs ^. landscape . recognizerAutomatons . originalStructureDefinitions)
-          (focusSetCurrent (StructureWidgets StructuresList) $ focusRing $ map StructureWidgets enumerate)
- where
-  entityList = EU.getEntitiesForList $ gs ^. landscape . terrainAndEntities . entityMap
-
-  (isEmptyArea, newBounds) =
-    EU.getEditingBounds $
-      NE.head $
-        scenario ^. scenarioLandscape . scenarioWorlds
-
-  setNewBounds maybeOldBounds =
-    if isEmptyArea
-      then maybeOldBounds
-      else Just newBounds
+      & uiGameplay %~ setUIGameplay gs curTime isAutoplaying siPair
 
 -- | Create an initial app state for a specific scenario.  Note that
 --   this function is used only for unit tests, integration tests, and