move 'entityMap'

src/Swarm/Game/State.hs

@@ -505,6 +505,7 @@ gameAchievements :: Lens' Discovery (Map GameplayAchievement Attainment)
 data Landscape = Landscape
   { _worldNavigation :: Navigation (M.Map SubworldName) Location
   , _multiWorld :: W.MultiWorld Int Entity
+  , _entityMap :: EntityMap
   , _worldScrollable :: Bool
   }
 
@@ -520,6 +521,9 @@ worldNavigation :: Lens' Landscape (Navigation (M.Map SubworldName) Location)
 --   unboxed tile arrays.
 multiWorld :: Lens' Landscape (W.MultiWorld Int Entity)
 
+-- | The catalog of all entities that the game knows about.
+entityMap :: Lens' Landscape EntityMap
+
 -- | Whether the world map is supposed to be scrollable or not.
 worldScrollable :: Lens' Landscape Bool
 
@@ -555,7 +559,6 @@ data GameState = GameState
   , _seed :: Seed
   , _randGen :: StdGen
   , _robotNaming :: RobotNaming
-  , _entityMap :: EntityMap
   , _recipesInfo :: Recipes
   , _currentScenarioPath :: Maybe FilePath
   , _landscape :: Landscape
@@ -660,9 +663,6 @@ randGen :: Lens' GameState StdGen
 -- | State and data for assigning identifiers to robots
 robotNaming :: Lens' GameState RobotNaming
 
--- | The catalog of all entities that the game knows about.
-entityMap :: Lens' GameState EntityMap
-
 -- | Collection of recipe info
 recipesInfo :: Lens' GameState Recipes
 
@@ -1132,7 +1132,6 @@ initGameState gsc =
                 }
           , _gensym = 0
           }
-    , _entityMap = initEntities gsc
     , _recipesInfo =
         Recipes
           { _recipesOut = outRecipeMap (initRecipes gsc)
@@ -1144,6 +1143,7 @@ initGameState gsc =
         Landscape
           { _worldNavigation = Navigation mempty mempty
           , _multiWorld = mempty
+          , _entityMap = initEntities gsc
           , _worldScrollable = True
           }
     , _viewCenterRule = VCRobot 0
@@ -1204,8 +1204,8 @@ scenarioToGameState scenario (LaunchParams (Identity userSeed) (Identity toRun))
       & robotNaming . gensym .~ initGensym
       & seed .~ theSeed
       & randGen .~ mkStdGen theSeed
-      & entityMap .~ em
       & recipesInfo %~ modifyRecipesInfo
+      & landscape . entityMap .~ em
       & landscape . worldNavigation .~ scenario ^. scenarioNavigation
       & landscape . multiWorld .~ allSubworldsMap theSeed
       -- TODO (#1370): Should we allow subworlds to have their own scrollability?

src/Swarm/Game/Step.hs

@@ -143,7 +143,7 @@ gameTick = do
     case wc of
       WinConditions winState oc -> do
         g <- get @GameState
-        em <- use entityMap
+        em <- use $ landscape . entityMap
         hypotheticalWinCheck em g winState oc
       _ -> pure ()
   return ticked
@@ -729,7 +729,7 @@ stepCESK cesk = case cesk of
   -- listing the requirements of the given expression.
   Out (VRequirements src t _) s (FExec : k) -> do
     currentContext <- use $ robotContext . defReqs
-    em <- use entityMap
+    em <- use $ landscape . entityMap
     let (R.Requirements caps devs inv, _) = R.requirements currentContext t
 
         devicesForCaps, requiredDevices :: Set (Set Text)
@@ -889,7 +889,7 @@ stepCESK cesk = case cesk of
     -- cells which were in the middle of being evaluated will be reset.
     let s' = resetBlackholes s
     h <- hasCapability CLog
-    em <- use entityMap
+    em <- use $ landscape . entityMap
     if h
       then do
         void $ traceLog (ErrorTrace Error) (formatExn em exn)
@@ -1233,7 +1233,7 @@ execConst c vs s k = do
       [VText name] -> do
         inv <- use robotInventory
         ins <- use equippedDevices
-        em <- use entityMap
+        em <- use $ landscape . entityMap
         e <-
           lookupEntityName name em
             `isJustOrFail` ["I've never heard of", indefiniteQ name <> "."]
@@ -1616,7 +1616,7 @@ execConst c vs s k = do
       _ -> badConst
     Create -> case vs of
       [VText name] -> do
-        em <- use entityMap
+        em <- use $ landscape . entityMap
         e <-
           lookupEntityName name em
             `isJustOrFail` ["I've never heard of", indefiniteQ name <> "."]
@@ -1899,7 +1899,7 @@ execConst c vs s k = do
 
             -- Copy over the salvaged robot's log, if we have one
             inst <- use equippedDevices
-            em <- use entityMap
+            em <- use $ landscape . entityMap
             isPrivileged <- isPrivilegedBot
             logger <-
               lookupEntityName "logger" em
@@ -2232,7 +2232,7 @@ execConst c vs s k = do
     m (Set Entity, Inventory)
   checkRequirements parentInventory childInventory childDevices cmd subject fixI = do
     currentContext <- use $ robotContext . defReqs
-    em <- use entityMap
+    em <- use $ landscape . entityMap
     creative <- use creativeMode
     let -- Note that _capCtx must be empty: at least at the
         -- moment, definitions are only allowed at the top level,
@@ -2506,7 +2506,7 @@ execConst c vs s k = do
     let yieldName = e ^. entityYields
     e' <- case yieldName of
       Nothing -> return e
-      Just n -> fromMaybe e <$> uses entityMap (lookupEntityName n)
+      Just n -> fromMaybe e <$> uses (landscape . entityMap) (lookupEntityName n)
 
     robotInventory %= insert e'
     updateDiscoveredEntities e'

src/Swarm/Game/Step/Combustion.hs

@@ -89,7 +89,7 @@ addCombustionBot inputEntity combustibility ts loc = do
   botInventory <- case maybeCombustionProduct of
     Nothing -> return []
     Just n -> do
-      maybeE <- uses entityMap (lookupEntityName n)
+      maybeE <- uses (landscape . entityMap) (lookupEntityName n)
       return $ maybe [] (pure . (1,)) maybeE
   combustionDurationRand <- uniform durationRange
   let combustionProg = combustionProgram combustionDurationRand combustibility

src/Swarm/TUI/Controller.hs

@@ -1160,7 +1160,7 @@ handleREPLEventTyping = \case
       CharKey '\t' -> do
         s <- get
         let names = s ^.. gameState . baseRobot . robotContext . defTypes . to assocs . traverse . _1
-        uiState . uiREPL %= tabComplete names (s ^. gameState . entityMap)
+        uiState . uiREPL %= tabComplete names (s ^. gameState . landscape . entityMap)
         modify validateREPLForm
       EscapeKey -> do
         formSt <- use $ uiState . uiREPL . replPromptType

src/Swarm/TUI/Model/StateUpdate.hs

@@ -123,7 +123,7 @@ constructAppState rs ui opts@(AppOpts {..}) = do
   case skipMenu opts of
     False -> return $ AppState gs (ui & lgTicksPerSecond .~ defaultInitLgTicksPerSecond) rs
     True -> do
-      (scenario, path) <- loadScenario (fromMaybe "classic" userScenario) (gs ^. entityMap) (rs ^. worlds)
+      (scenario, path) <- loadScenario (fromMaybe "classic" userScenario) (gs ^. landscape . entityMap) (rs ^. worlds)
       maybeRunScript <- traverse parseCodeFile scriptToRun
 
       let maybeAutoplay = do
@@ -258,7 +258,7 @@ scenarioToUIState isAutoplaying siPair@(scenario, _) gs u = do
       & uiWorldEditor . EM.entityPaintList %~ BL.listReplace entityList Nothing
       & uiWorldEditor . EM.editingBounds . EM.boundsRect %~ setNewBounds
  where
-  entityList = EU.getEntitiesForList $ gs ^. entityMap
+  entityList = EU.getEntitiesForList $ gs ^. landscape . entityMap
 
   (isEmptyArea, newBounds) = EU.getEditingBounds $ NE.head $ scenario ^. scenarioWorlds
   setNewBounds maybeOldBounds =

test/unit/TestUtil.hs

@@ -44,7 +44,7 @@ evalCESK g cesk =
   orderResult ((res, rr), rg) = (rg, rr, res)
 
 runCESK :: Int -> CESK -> StateT Robot (StateT GameState IO) (Either Text (Value, Int))
-runCESK _ (Up exn _ []) = Left . flip formatExn exn <$> lift (use entityMap)
+runCESK _ (Up exn _ []) = Left . flip formatExn exn <$> lift (use $ landscape . entityMap)
 runCESK !steps cesk = case finalValue cesk of
   Just (v, _) -> return (Right (v, steps))
   Nothing -> stepCESK cesk >>= runCESK (steps + 1)