Move more code to Robots.hs, do not export private fields (#1669)

A continuation of #1667.

* Do not export `_viewCenter` or `_focusedRobotID`
* Move record initialization code to `Robot.hs` as `setRobotInfo`.
* `modifyViewCenter`, `unfocus`, `recalcViewCenter` now operate directly on `Robots` instead of `GameState`.

Author: kostmo

src/Swarm/Game/State.hs

@@ -47,11 +47,8 @@ module Swarm.Game.State (
   currentScenarioPath,
   needsRedraw,
   replWorking,
-  applyViewCenterRule,
-  recalcViewCenter,
-  modifyViewCenter,
+  recalcViewCenterAndRedraw,
   viewingRegion,
-  unfocus,
   focusedRobot,
   RobotRange (..),
   focusedRange,
@@ -84,8 +81,8 @@ import Data.Bifunctor (first)
 import Data.Digest.Pure.SHA (sha1, showDigest)
 import Data.Foldable (toList)
 import Data.Foldable.Extra (allM)
+import Data.Function (on)
 import Data.Int (Int32)
-import Data.IntMap (IntMap)
 import Data.IntMap qualified as IM
 import Data.IntSet qualified as IS
 import Data.List (partition, sortOn)
@@ -323,51 +320,19 @@ messageIsFromNearby l e = case e ^. leSource of
     InfinitelyFar -> False
     Measurable x -> x <= hearingDistance
 
--- | Given a current mapping from robot names to robots, apply a
---   'ViewCenterRule' to derive the location it refers to.  The result
---   is 'Maybe' because the rule may refer to a robot which does not
---   exist.
-applyViewCenterRule :: ViewCenterRule -> IntMap Robot -> Maybe (Cosmic Location)
-applyViewCenterRule (VCLocation l) _ = Just l
-applyViewCenterRule (VCRobot name) m = m ^? at name . _Just . robotLocation
-
 -- | Recalculate the view center (and cache the result in the
 --   'viewCenter' field) based on the current 'viewCenterRule'.  If
 --   the 'viewCenterRule' specifies a robot which does not exist,
 --   simply leave the current 'viewCenter' as it is. Set 'needsRedraw'
 --   if the view center changes.
-recalcViewCenter :: GameState -> GameState
-recalcViewCenter g =
+recalcViewCenterAndRedraw :: GameState -> GameState
+recalcViewCenterAndRedraw g =
   g
-    { _robotInfo =
-        (g ^. robotInfo)
-          { _viewCenter = newViewCenter
-          }
-    }
-    & (if newViewCenter /= oldViewCenter then needsRedraw .~ True else id)
+    & robotInfo .~ newRobotInfo
+    & (if ((/=) `on` (^. viewCenter)) oldRobotInfo newRobotInfo then needsRedraw .~ True else id)
  where
-  oldViewCenter = g ^. robotInfo . viewCenter
-  newViewCenter =
-    fromMaybe oldViewCenter $
-      applyViewCenterRule (g ^. robotInfo . viewCenterRule) (g ^. robotInfo . robotMap)
-
--- | Modify the 'viewCenter' by applying an arbitrary function to the
---   current value.  Note that this also modifies the 'viewCenterRule'
---   to match.  After calling this function the 'viewCenterRule' will
---   specify a particular location, not a robot.
-modifyViewCenter :: (Cosmic Location -> Cosmic Location) -> GameState -> GameState
-modifyViewCenter update g =
-  g
-    & case g ^. robotInfo . viewCenterRule of
-      VCLocation l -> robotInfo . viewCenterRule .~ VCLocation (update l)
-      VCRobot _ -> robotInfo . viewCenterRule .~ VCLocation (update (g ^. robotInfo . viewCenter))
-
--- | "Unfocus" by modifying the view center rule to look at the
---   current location instead of a specific robot, and also set the
---   focused robot ID to an invalid value.  In classic mode this
---   causes the map view to become nothing but static.
-unfocus :: GameState -> GameState
-unfocus = (\g -> g {_robotInfo = (g ^. robotInfo) {_focusedRobotID = -1000}}) . modifyViewCenter id
+  oldRobotInfo = g ^. robotInfo
+  newRobotInfo = recalcViewCenter oldRobotInfo
 
 -- | Given a width and height, compute the region, centered on the
 --   'viewCenter', that should currently be in view.
@@ -663,10 +628,7 @@ pureScenarioToGameState scenario theSeed now toRun gsc =
   gs = initGameState gsc
   preliminaryGameState =
     gs
-      & robotInfo .~ (gs ^. robotInfo) {_focusedRobotID = baseID}
-      & robotInfo %~ setRobotList robotList'
-      & robotInfo . viewCenterRule .~ VCRobot baseID
-      & robotInfo . robotNaming . gensym .~ initGensym
+      & robotInfo %~ setRobotInfo baseID robotList'
       & creativeMode .~ scenario ^. scenarioCreative
       & winCondition .~ theWinCondition
       & winSolution .~ scenario ^. scenarioSolution
@@ -756,7 +718,6 @@ pureScenarioToGameState scenario theSeed now toRun gsc =
       (\x -> WinConditions Ongoing (ObjectiveCompletion (CompletionBuckets (NE.toList x) mempty mempty) mempty))
       (NE.nonEmpty (scenario ^. scenarioObjectives))
 
-  initGensym = length robotList - 1
   addRecipesWith f = IM.unionWith (<>) (f $ scenario ^. scenarioRecipes)
 
 -- | Create an initial game state corresponding to the given scenario.

src/Swarm/Game/State/Robot.hs

@@ -17,10 +17,9 @@ module Swarm.Game.State.Robot (
 
   -- * Initialization
   initRobots,
+  setRobotInfo,
 
   -- * Accessors
-  _viewCenter,
-  _focusedRobotID,
   robotMap,
   robotsByLocation,
   robotsWatching,
@@ -41,7 +40,11 @@ module Swarm.Game.State.Robot (
   addRobot,
   addRobotToLocation,
   addTRobot,
-  setRobotList,
+
+  -- ** View
+  modifyViewCenter,
+  unfocus,
+  recalcViewCenter,
 ) where
 
 import Control.Arrow (Arrow ((&&&)))
@@ -59,7 +62,7 @@ import Data.IntSet.Lens (setOf)
 import Data.List.NonEmpty qualified as NE
 import Data.Map (Map)
 import Data.Map qualified as M
-import Data.Maybe (mapMaybe)
+import Data.Maybe (fromMaybe, mapMaybe)
 import Data.Set qualified as S
 import Data.Tuple (swap)
 import GHC.Generics (Generic)
@@ -378,17 +381,65 @@ removeRobotFromLocationMap (Cosmic oldSubworld oldPlanar) rid =
   tidyDelete robID =
     surfaceEmpty M.null . M.update (deleteOne robID) oldPlanar
 
+setRobotInfo :: RID -> [Robot] -> Robots -> Robots
+setRobotInfo baseID robotList rState =
+  (setRobotList robotList rState) {_focusedRobotID = baseID}
+    & viewCenterRule .~ VCRobot baseID
+
 setRobotList :: [Robot] -> Robots -> Robots
 setRobotList robotList rState =
   rState
     & robotMap .~ IM.fromList (map (view robotID &&& id) robotList)
     & robotsByLocation .~ M.map (groupRobotsByPlanarLocation . NE.toList) (groupRobotsBySubworld robotList)
     & internalActiveRobots .~ setOf (traverse . robotID) robotList
+    & robotNaming . gensym .~ initGensym
  where
+  initGensym = length robotList - 1
+
   groupRobotsBySubworld =
     binTuples . map (view (robotLocation . subworld) &&& id)
 
   groupRobotsByPlanarLocation rs =
     M.fromListWith
       IS.union
       (map (view (robotLocation . planar) &&& (IS.singleton . view robotID)) rs)
+
+-- | Modify the 'viewCenter' by applying an arbitrary function to the
+--   current value.  Note that this also modifies the 'viewCenterRule'
+--   to match.  After calling this function the 'viewCenterRule' will
+--   specify a particular location, not a robot.
+modifyViewCenter :: (Cosmic Location -> Cosmic Location) -> Robots -> Robots
+modifyViewCenter update rInfo =
+  rInfo
+    & case rInfo ^. viewCenterRule of
+      VCLocation l -> viewCenterRule .~ VCLocation (update l)
+      VCRobot _ -> viewCenterRule .~ VCLocation (update (rInfo ^. viewCenter))
+
+-- | "Unfocus" by modifying the view center rule to look at the
+--   current location instead of a specific robot, and also set the
+--   focused robot ID to an invalid value.  In classic mode this
+--   causes the map view to become nothing but static.
+unfocus :: Robots -> Robots
+unfocus = (\ri -> ri {_focusedRobotID = -1000}) . modifyViewCenter id
+
+-- | Recalculate the view center (and cache the result in the
+--   'viewCenter' field) based on the current 'viewCenterRule'.  If
+--   the 'viewCenterRule' specifies a robot which does not exist,
+--   simply leave the current 'viewCenter' as it is.
+recalcViewCenter :: Robots -> Robots
+recalcViewCenter rInfo =
+  rInfo
+    { _viewCenter = newViewCenter
+    }
+ where
+  newViewCenter =
+    fromMaybe (rInfo ^. viewCenter) $
+      applyViewCenterRule (rInfo ^. viewCenterRule) (rInfo ^. robotMap)
+
+-- | Given a current mapping from robot names to robots, apply a
+--   'ViewCenterRule' to derive the location it refers to.  The result
+--   is 'Maybe' because the rule may refer to a robot which does not
+--   exist.
+applyViewCenterRule :: ViewCenterRule -> IntMap Robot -> Maybe (Cosmic Location)
+applyViewCenterRule (VCLocation l) _ = Just l
+applyViewCenterRule (VCRobot name) m = m ^? at name . _Just . robotLocation

src/Swarm/Game/Step.hs

@@ -110,7 +110,7 @@ gameTick = do
     Nothing -> pure ()
 
   -- Possibly update the view center.
-  modify recalcViewCenter
+  modify recalcViewCenterAndRedraw
 
   when ticked $ do
     -- On new tick see if the winning condition for the current objective is met.

src/Swarm/Game/Step/Const.hs

@@ -769,7 +769,7 @@ execConst runChildProg c vs s k = do
                 -- point is that there's no way to tell the difference
                 -- between this situation and the situation where the
                 -- robot exists but is too far away.
-                False -> modify unfocus
+                False -> robotInfo %= unfocus
 
             -- If it does exist, set it as the view center.
             Just _ -> robotInfo . viewCenterRule .= VCRobot rid

src/Swarm/TUI/Controller.hs

@@ -1371,7 +1371,7 @@ scrollView update = do
   -- always work, but there seems to be some sort of race condition
   -- where 'needsRedraw' gets reset before the UI drawing code runs.
   invalidateCacheEntry WorldCache
-  gameState %= modifyViewCenter (fmap update)
+  gameState . robotInfo %= modifyViewCenter (fmap update)
 
 -- | Convert a directional key into a direction.
 keyToDir :: V.Key -> Heading