Refactor hierarchy of state inputs

app/doc/Swarm/Doc/Gen.hs

@@ -38,7 +38,7 @@ import Swarm.Game.Entity qualified as E
 import Swarm.Game.Land
 import Swarm.Game.Recipe (Recipe, recipeCatalysts, recipeInputs, recipeOutputs)
 import Swarm.Game.Robot (Robot, equippedDevices, robotInventory)
-import Swarm.Game.Scenario (GameStateInputs (..), loadStandaloneScenario, scenarioLandscape)
+import Swarm.Game.Scenario (GameStateInputs (..), ScenarioInputs (..), loadStandaloneScenario, scenarioLandscape)
 import Swarm.Game.World.Gen (extractEntities)
 import Swarm.Game.World.Typecheck (Some (..), TTerm)
 import Swarm.Language.Key (specialKeyNames)
@@ -136,7 +136,7 @@ generateSpecialKeyNames =
 
 generateRecipe :: IO String
 generateRecipe = simpleErrorHandle $ do
-  (classic, GameStateInputs worlds (TerrainEntityMaps _ entities) recipes) <- loadStandaloneScenario "data/scenarios/classic.yaml"
+  (classic, GameStateInputs (ScenarioInputs worlds (TerrainEntityMaps _ entities)) recipes) <- loadStandaloneScenario "data/scenarios/classic.yaml"
   baseRobot <- instantiateBaseRobot $ classic ^. scenarioLandscape
   return . Dot.showDot $ recipesToDot baseRobot (worlds ! "classic") entities recipes
 

src/Swarm/Doc/Pedagogy.hs

@@ -35,6 +35,7 @@ import Swarm.Game.Failure (SystemFailure)
 import Swarm.Game.Land
 import Swarm.Game.Scenario (
   Scenario,
+  ScenarioInputs (..),
   scenarioDescription,
   scenarioMetadata,
   scenarioName,
@@ -181,7 +182,7 @@ loadScenarioCollection = simpleErrorHandle $ do
   -- all the scenarios via the usual code path; we do not need to do
   -- anything with them here while simply rendering pedagogy info.
   worlds <- ignoreWarnings @(Seq SystemFailure) $ loadWorlds tem
-  ignoreWarnings @(Seq SystemFailure) $ loadScenarios tem worlds
+  ignoreWarnings @(Seq SystemFailure) $ loadScenarios $ ScenarioInputs worlds tem
 
 renderUsagesMarkdown :: CoverageInfo -> Text
 renderUsagesMarkdown (CoverageInfo (TutorialInfo (s, si) idx _sCmds dCmds) novelCmds) =

src/Swarm/TUI/Model/StateUpdate.hs

@@ -47,6 +47,8 @@ import Swarm.Game.Achievement.Persistence
 import Swarm.Game.Failure (SystemFailure)
 import Swarm.Game.Land
 import Swarm.Game.Scenario (
+  ScenarioInputs (..),
+  gsiScenarioInputs,
   loadScenario,
   scenarioAttrs,
   scenarioLandscape,
@@ -138,16 +140,15 @@ constructAppState ::
   AppOpts ->
   m AppState
 constructAppState rs ui opts@(AppOpts {..}) = do
-  let gs = initGameState (mkGameStateConfig rs)
+  let gs = initGameState $ rs ^. stdGameConfigInputs
   case skipMenu opts of
     False -> return $ AppState gs (ui & uiGameplay . uiTiming . lgTicksPerSecond .~ defaultInitLgTicksPerSecond) rs
     True -> do
       let tem = gs ^. landscape . terrainAndEntities
       (scenario, path) <-
         loadScenario
           (fromMaybe "classic" userScenario)
-          tem
-          (rs ^. worlds)
+          (ScenarioInputs (initWorldMap . gsiScenarioInputs . initState $ rs ^. stdGameConfigInputs) tem)
       maybeRunScript <- traverse parseCodeFile scriptToRun
 
       let maybeAutoplay = do
@@ -219,7 +220,7 @@ scenarioToAppState ::
   m ()
 scenarioToAppState siPair@(scene, _) lp = do
   rs <- use runtimeState
-  gs <- liftIO $ scenarioToGameState scene lp $ mkGameStateConfig rs
+  gs <- liftIO $ scenarioToGameState scene lp $ rs ^. stdGameConfigInputs
   gameState .= gs
   void $ withLensIO uiState $ scenarioToUIState isAutoplaying siPair gs
  where

src/swarm-engine/Swarm/Game/ScenarioInfo.hs

@@ -56,12 +56,10 @@ import Data.Sequence qualified as Seq
 import Data.Text (Text)
 import Data.Yaml as Y
 import Swarm.Game.Failure
-import Swarm.Game.Land
 import Swarm.Game.ResourceLoading (getDataDirSafe, getSwarmSavePath)
 import Swarm.Game.Scenario
 import Swarm.Game.Scenario.Scoring.CodeSize
 import Swarm.Game.Scenario.Status
-import Swarm.Game.World.Typecheck (WorldMap)
 import Swarm.Util.Effect (warn, withThrow)
 import System.Directory (canonicalizePath, doesDirectoryExist, doesFileExist, listDirectory)
 import System.FilePath (pathSeparator, splitDirectories, takeBaseName, takeExtensions, (-<.>), (</>))
@@ -137,16 +135,15 @@ flatten (SICollection _ c) = concatMap flatten $ scenarioCollectionToList c
 -- | Load all the scenarios from the scenarios data directory.
 loadScenarios ::
   (Has (Accum (Seq SystemFailure)) sig m, Has (Lift IO) sig m) =>
-  TerrainEntityMaps ->
-  WorldMap ->
+  ScenarioInputs ->
   m ScenarioCollection
-loadScenarios tem worldMap = do
+loadScenarios scenarioInputs = do
   res <- runThrow @SystemFailure $ getDataDirSafe Scenarios "scenarios"
   case res of
     Left err -> do
       warn err
       return $ SC mempty mempty
-    Right dataDir -> loadScenarioDir tem worldMap dataDir
+    Right dataDir -> loadScenarioDir scenarioInputs dataDir
 
 -- | The name of the special file which indicates the order of
 --   scenarios in a folder.
@@ -161,11 +158,10 @@ readOrderFile orderFile =
 --   the 00-ORDER file (if any) giving the order for the scenarios.
 loadScenarioDir ::
   (Has (Accum (Seq SystemFailure)) sig m, Has (Lift IO) sig m) =>
-  TerrainEntityMaps ->
-  WorldMap ->
+  ScenarioInputs ->
   FilePath ->
   m ScenarioCollection
-loadScenarioDir tem worldMap dir = do
+loadScenarioDir scenarioInputs dir = do
   let orderFile = dir </> orderFileName
       dirName = takeBaseName dir
   orderExists <- sendIO $ doesFileExist orderFile
@@ -196,7 +192,7 @@ loadScenarioDir tem worldMap dir = do
   -- Only keep the files from 00-ORDER.txt that actually exist.
   let morder' = filter (`elem` itemPaths) <$> morder
       loadItem filepath = do
-        item <- loadScenarioItem tem worldMap (dir </> filepath)
+        item <- loadScenarioItem scenarioInputs (dir </> filepath)
         return (filepath, item)
   scenarios <- mapM (runThrow @SystemFailure . loadItem) itemPaths
   let (failures, successes) = partitionEithers scenarios
@@ -257,17 +253,16 @@ loadScenarioItem ::
   , Has (Accum (Seq SystemFailure)) sig m
   , Has (Lift IO) sig m
   ) =>
-  TerrainEntityMaps ->
-  WorldMap ->
+  ScenarioInputs ->
   FilePath ->
   m ScenarioItem
-loadScenarioItem tem worldMap path = do
+loadScenarioItem scenarioInputs path = do
   isDir <- sendIO $ doesDirectoryExist path
   let collectionName = into @Text . dropWhile isSpace . takeBaseName $ path
   case isDir of
-    True -> SICollection collectionName <$> loadScenarioDir tem worldMap path
+    True -> SICollection collectionName <$> loadScenarioDir scenarioInputs path
     False -> do
-      s <- loadScenarioFile tem worldMap path
+      s <- loadScenarioFile scenarioInputs path
       eitherSi <- runThrow @SystemFailure (loadScenarioInfo path)
       case eitherSi of
         Right si -> return $ SISingle (s, si)

src/swarm-engine/Swarm/Game/State/Robot.hs

@@ -207,7 +207,7 @@ initRobots gsc =
     , _robotsWatching = mempty
     , _robotNaming =
         RobotNaming
-          { _nameGenerator = initNameParts gsc
+          { _nameGenerator = nameParts gsc
           , _gensym = 0
           }
     , _viewCenterRule = VCRobot 0

src/swarm-engine/Swarm/Game/State/Runtime.hs

@@ -11,16 +11,14 @@ module Swarm.Game.State.Runtime (
   webPort,
   upstreamRelease,
   eventLog,
-  worlds,
   scenarios,
-  stdEntityTerrainMap,
-  stdRecipes,
   appData,
-  nameParts,
+  stdGameConfigInputs,
 
   -- ** Utility
+  initScenarioInputs,
   initRuntimeState,
-  mkGameStateConfig,
+  initGameStateConfig,
 )
 where
 
@@ -32,16 +30,14 @@ import Data.Map (Map)
 import Data.Sequence (Seq)
 import Data.Text (Text)
 import Network.Wai.Handler.Warp (Port)
-import Swarm.Game.Entity (Entity)
 import Swarm.Game.Failure (SystemFailure)
 import Swarm.Game.Land
-import Swarm.Game.Recipe (Recipe, loadRecipes)
-import Swarm.Game.ResourceLoading (NameGenerator, initNameGenerator, readAppData)
-import Swarm.Game.Scenario (GameStateInputs (..))
+import Swarm.Game.Recipe (loadRecipes)
+import Swarm.Game.ResourceLoading (initNameGenerator, readAppData)
+import Swarm.Game.Scenario (GameStateInputs (..), ScenarioInputs (..))
 import Swarm.Game.ScenarioInfo (ScenarioCollection, loadScenarios)
 import Swarm.Game.State.Substate
 import Swarm.Game.World.Load (loadWorlds)
-import Swarm.Game.World.Typecheck (WorldMap)
 import Swarm.Log
 import Swarm.Util.Lens (makeLensesNoSigs)
 import Swarm.Version (NewReleaseFailure (..))
@@ -50,38 +46,63 @@ data RuntimeState = RuntimeState
   { _webPort :: Maybe Port
   , _upstreamRelease :: Either NewReleaseFailure String
   , _eventLog :: Notifications LogEntry
-  , _worlds :: WorldMap
   , _scenarios :: ScenarioCollection
-  , _stdEntityTerrainMap :: TerrainEntityMaps
-  , _stdRecipes :: [Recipe Entity]
+  , _stdGameConfigInputs :: GameStateConfig
   , _appData :: Map Text Text
-  , _nameParts :: NameGenerator
   }
 
-initRuntimeState ::
+initScenarioInputs ::
   ( Has (Throw SystemFailure) sig m
   , Has (Accum (Seq SystemFailure)) sig m
   , Has (Lift IO) sig m
   ) =>
-  m RuntimeState
-initRuntimeState = do
+  m ScenarioInputs
+initScenarioInputs = do
   tem <- loadEntitiesAndTerrain
-  recipes <- loadRecipes $ tem ^. entityMap
   worlds <- loadWorlds tem
-  scenarios <- loadScenarios tem worlds
+  return $ ScenarioInputs worlds tem
+
+initGameStateInputs ::
+  ( Has (Throw SystemFailure) sig m
+  , Has (Accum (Seq SystemFailure)) sig m
+  , Has (Lift IO) sig m
+  ) =>
+  m GameStateInputs
+initGameStateInputs = do
+  scenarioInputs <- initScenarioInputs
+  recipes <- loadRecipes $ initEntityTerrain scenarioInputs ^. entityMap
+  return $ GameStateInputs scenarioInputs recipes
+
+initGameStateConfig ::
+  ( Has (Throw SystemFailure) sig m
+  , Has (Accum (Seq SystemFailure)) sig m
+  , Has (Lift IO) sig m
+  ) =>
+  m GameStateConfig
+initGameStateConfig = do
+  gsi <- initGameStateInputs
   appDataMap <- readAppData
   nameGen <- initNameGenerator appDataMap
+  return $ GameStateConfig appDataMap nameGen gsi
+
+initRuntimeState ::
+  ( Has (Throw SystemFailure) sig m
+  , Has (Accum (Seq SystemFailure)) sig m
+  , Has (Lift IO) sig m
+  ) =>
+  m RuntimeState
+initRuntimeState = do
+  gsc <- initGameStateConfig
+  scenarios <- loadScenarios $ gsiScenarioInputs $ initState gsc
+
   return $
     RuntimeState
       { _webPort = Nothing
       , _upstreamRelease = Left (NoMainUpstreamRelease [])
       , _eventLog = mempty
-      , _worlds = worlds
       , _scenarios = scenarios
-      , _stdEntityTerrainMap = tem
-      , _stdRecipes = recipes
-      , _appData = appDataMap
-      , _nameParts = nameGen
+      , _appData = initAppDataMap gsc
+      , _stdGameConfigInputs = gsc
       }
 
 makeLensesNoSigs ''RuntimeState
@@ -99,39 +120,12 @@ upstreamRelease :: Lens' RuntimeState (Either NewReleaseFailure String)
 -- place to log it.
 eventLog :: Lens' RuntimeState (Notifications LogEntry)
 
--- | A collection of typechecked world DSL terms that are available to
---   be used in scenario definitions.
-worlds :: Lens' RuntimeState WorldMap
-
 -- | The collection of scenarios that comes with the game.
 scenarios :: Lens' RuntimeState ScenarioCollection
 
--- | The standard terrain/entity maps loaded from disk.  Individual scenarios
---   may define additional terrain/entities which will get added to this map
---   when loading the scenario.
-stdEntityTerrainMap :: Lens' RuntimeState TerrainEntityMaps
-
--- | The standard list of recipes loaded from disk.  Individual scenarios
---   may define additional recipes which will get added to this list
---   when loading the scenario.
-stdRecipes :: Lens' RuntimeState [Recipe Entity]
+-- | Built-in resources for loading games
+stdGameConfigInputs :: Lens' RuntimeState GameStateConfig
 
 -- | Free-form data loaded from the @data@ directory, for things like
 --   the logo, about page, tutorial story, etc.
 appData :: Lens' RuntimeState (Map Text Text)
-
--- | Lists of words/adjectives for use in building random robot names.
-nameParts :: Lens' RuntimeState NameGenerator
-
--- | Create a 'GameStateConfig' record from the 'RuntimeState'.
-mkGameStateConfig :: RuntimeState -> GameStateConfig
-mkGameStateConfig rs =
-  GameStateConfig
-    { initNameParts = rs ^. nameParts
-    , initState =
-        GameStateInputs
-          { initEntityTerrain = rs ^. stdEntityTerrainMap
-          , initRecipes = rs ^. stdRecipes
-          , initWorldMap = rs ^. worlds
-          }
-    }

src/swarm-engine/Swarm/Game/State/Substate.hs

@@ -448,4 +448,4 @@ initRecipeMaps gsc =
     , _recipesCat = catRecipeMap recipeList
     }
  where
-  recipeList = initRecipes $ initState gsc
+  recipeList = gsiRecipes $ initState gsc