decompose scenario record (#1771)

Peripheral to #1715.

app/doc/Swarm/Doc/Gen.hs

@@ -37,7 +37,7 @@ import Swarm.Game.Entity (Entity, EntityMap (entitiesByName), entityName)
 import Swarm.Game.Entity qualified as E
 import Swarm.Game.Recipe (Recipe, recipeCatalysts, recipeInputs, recipeOutputs)
 import Swarm.Game.Robot (Robot, equippedDevices, robotInventory)
-import Swarm.Game.Scenario (GameStateInputs (..), loadStandaloneScenario)
+import Swarm.Game.Scenario (GameStateInputs (..), 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 entities recipes) <- loadStandaloneScenario "data/scenarios/classic.yaml"
-  baseRobot <- instantiateBaseRobot classic
+  baseRobot <- instantiateBaseRobot $ classic ^. scenarioLandscape
   return . Dot.showDot $ recipesToDot baseRobot (worlds ! "classic") entities recipes
 
 recipesToDot :: Robot -> Some (TTerm '[]) -> EntityMap -> [Recipe Entity] -> Dot ()

src/Swarm/Doc/Pedagogy.hs

@@ -33,9 +33,24 @@ import Data.Text qualified as T
 import Swarm.Constant
 import Swarm.Game.Entity (loadEntities)
 import Swarm.Game.Failure (SystemFailure)
-import Swarm.Game.Scenario (Scenario, scenarioDescription, scenarioName, scenarioObjectives, scenarioSolution)
+import Swarm.Game.Scenario (
+  Scenario,
+  scenarioDescription,
+  scenarioMetadata,
+  scenarioName,
+  scenarioObjectives,
+  scenarioOperation,
+  scenarioSolution,
+ )
 import Swarm.Game.Scenario.Objective (objectiveGoal)
-import Swarm.Game.ScenarioInfo (ScenarioCollection, ScenarioInfoPair, flatten, loadScenarios, scenarioCollectionToList, scenarioPath)
+import Swarm.Game.ScenarioInfo (
+  ScenarioCollection,
+  ScenarioInfoPair,
+  flatten,
+  loadScenarios,
+  scenarioCollectionToList,
+  scenarioPath,
+ )
 import Swarm.Game.World.Load (loadWorlds)
 import Swarm.Language.Module (Module (..))
 import Swarm.Language.Pipeline (ProcessedTerm (..))
@@ -85,14 +100,14 @@ extractCommandUsages idx siPair@(s, _si) =
   TutorialInfo siPair idx solnCommands $ getDescCommands s
  where
   solnCommands = getCommands maybeSoln
-  maybeSoln = view scenarioSolution s
+  maybeSoln = view (scenarioOperation . scenarioSolution) s
 
 -- | Obtain the set of all commands mentioned by
 -- name in the tutorial's goal descriptions.
 getDescCommands :: Scenario -> Set Const
 getDescCommands s = S.fromList $ concatMap filterConst allCode
  where
-  goalTextParagraphs = view objectiveGoal <$> view scenarioObjectives s
+  goalTextParagraphs = view objectiveGoal <$> view (scenarioOperation . scenarioObjectives) s
   allCode = concatMap findCode goalTextParagraphs
   filterConst :: Syntax -> [Const]
   filterConst sx = mapMaybe toConst $ universe (sx ^. sTerm)
@@ -176,7 +191,7 @@ renderUsagesMarkdown (CoverageInfo (TutorialInfo (s, si) idx _sCmds dCmds) novel
     intercalate
       [""]
       [ pure . surround "`" . T.pack $ view scenarioPath si
-      , pure . surround "*" . T.strip . docToText $ view scenarioDescription s
+      , pure . surround "*" . T.strip . docToText $ view (scenarioOperation . scenarioDescription) s
       , renderSection "Introduced in solution" . renderCmdList $ M.keysSet novelCmds
       , renderSection "Referenced in description" $ renderCmdList dCmds
       ]
@@ -195,7 +210,7 @@ renderTutorialTitle :: (Show a) => a -> Scenario -> Text
 renderTutorialTitle idx s =
   T.unwords
     [ T.pack $ show idx <> ":"
-    , view scenarioName s
+    , view (scenarioMetadata . scenarioName) s
     ]
 
 linkifyCommand :: Text -> Text

src/Swarm/Doc/Util.hs

@@ -15,7 +15,7 @@ import Data.Text qualified as T
 import Swarm.Game.Failure (SystemFailure (CustomFailure))
 import Swarm.Game.Robot (Robot)
 import Swarm.Game.Robot.Concrete (instantiateRobot)
-import Swarm.Game.Scenario (Scenario, scenarioRobots)
+import Swarm.Game.Scenario (ScenarioLandscape, scenarioRobots)
 import Swarm.Language.Syntax (Const (..))
 import Swarm.Language.Syntax qualified as Syntax
 
@@ -49,7 +49,7 @@ commands = filter Syntax.isCmd Syntax.allConst
 constSyntax :: Const -> Text
 constSyntax = Syntax.syntax . Syntax.constInfo
 
-instantiateBaseRobot :: Has (Throw SystemFailure) sig m => Scenario -> m Robot
-instantiateBaseRobot s = case listToMaybe $ view scenarioRobots s of
+instantiateBaseRobot :: Has (Throw SystemFailure) sig m => ScenarioLandscape -> m Robot
+instantiateBaseRobot sLandscape = case listToMaybe $ view scenarioRobots sLandscape of
   Just r -> pure $ instantiateRobot Nothing 0 r
   Nothing -> throwError $ CustomFailure "Scenario contains no robots"

src/Swarm/TUI/Editor/Palette.hs

@@ -19,7 +19,7 @@ import Data.Set qualified as Set
 import Data.Text qualified as T
 import Data.Tuple (swap)
 import Swarm.Game.Display (Display, defaultChar)
-import Swarm.Game.Entity (EntityName, entitiesByName)
+import Swarm.Game.Entity (Entity, EntityName, entitiesByName)
 import Swarm.Game.Location
 import Swarm.Game.Scenario
 import Swarm.Game.Scenario.Topography.Area
@@ -35,8 +35,11 @@ import Swarm.Util (binTuples, histogram)
 import Swarm.Util qualified as U
 import Swarm.Util.Erasable
 
-makeSuggestedPalette :: Maybe Scenario -> [[CellPaintDisplay]] -> KM.KeyMap (AugmentedCell EntityFacade)
-makeSuggestedPalette maybeOriginalScenario cellGrid =
+makeSuggestedPalette ::
+  KM.KeyMap (AugmentedCell Entity) ->
+  [[CellPaintDisplay]] ->
+  KM.KeyMap (AugmentedCell EntityFacade)
+makeSuggestedPalette originalScenarioPalette cellGrid =
   KM.fromMapText
     . M.map (AugmentedCell Nothing)
     . M.fromList
@@ -91,8 +94,7 @@ makeSuggestedPalette maybeOriginalScenario cellGrid =
 
   originalPalette :: KM.KeyMap CellPaintDisplay
   originalPalette =
-    KM.map (toCellPaintDisplay . standardCell) $
-      maybe mempty (unPalette . palette . NE.head . (^. scenarioWorlds)) maybeOriginalScenario
+    KM.map (toCellPaintDisplay . standardCell) originalScenarioPalette
 
   pairsWithDisplays :: Map (TerrainWith EntityName) (T.Text, CellPaintDisplay)
   pairsWithDisplays = M.fromList $ mapMaybe g entitiesWithModalTerrain
@@ -115,16 +117,16 @@ makeSuggestedPalette maybeOriginalScenario cellGrid =
 constructScenario :: Maybe Scenario -> Grid CellPaintDisplay -> SkeletonScenario
 constructScenario maybeOriginalScenario (Grid cellGrid) =
   SkeletonScenario
-    (maybe 1 (^. scenarioVersion) maybeOriginalScenario)
-    (maybe "My Scenario" (^. scenarioName) maybeOriginalScenario)
-    (maybe (fromText "The scenario description...") (^. scenarioDescription) maybeOriginalScenario)
+    (maybe 1 (^. scenarioMetadata . scenarioVersion) maybeOriginalScenario)
+    (maybe "My Scenario" (^. scenarioMetadata . scenarioName) maybeOriginalScenario)
+    (maybe (fromText "The scenario description...") (^. scenarioOperation . scenarioDescription) maybeOriginalScenario)
     -- (maybe True (^. scenarioCreative) maybeOriginalScenario)
     True
     (M.elems $ entitiesByName customEntities)
     wd
     [] -- robots
  where
-  customEntities = maybe mempty (^. scenarioEntities) maybeOriginalScenario
+  customEntities = maybe mempty (^. scenarioLandscape . scenarioEntities) maybeOriginalScenario
   wd =
     WorldDescription
       { offsetOrigin = False
@@ -138,7 +140,9 @@ constructScenario maybeOriginalScenario (Grid cellGrid) =
       , worldProg = Nothing
       }
 
-  suggestedPalette = makeSuggestedPalette maybeOriginalScenario cellGrid
+  extractPalette = unPalette . palette . NE.head . (^. scenarioLandscape . scenarioWorlds)
+  originalPalette = maybe mempty extractPalette maybeOriginalScenario
+  suggestedPalette = makeSuggestedPalette originalPalette cellGrid
 
   upperLeftCoord =
     Location

src/Swarm/TUI/Launch/View.hs

@@ -19,7 +19,7 @@ import Control.Lens
 import Data.Either (isRight)
 import Data.Text (Text)
 import Data.Text qualified as T
-import Swarm.Game.Scenario (scenarioSeed)
+import Swarm.Game.Scenario (scenarioLandscape, scenarioSeed)
 import Swarm.Game.Scenario.Status (ParameterizableLaunchParams (..))
 import Swarm.Game.State (getRunCodePath)
 import Swarm.TUI.Launch.Model
@@ -104,7 +104,10 @@ drawLaunchConfigPanel (LaunchOptions lc launchParams) =
     Left _ -> mkSeedEditorWidget
     Right x -> mkSeedEntryWidget x
 
-  scenarioSeedText = maybe "random" show $ view scenarioSeed . fst =<< displayedFor
+  scenarioSeedText =
+    maybe "random" show $
+      view (scenarioLandscape . scenarioSeed) . fst =<< displayedFor
+
   mkSeedEntryWidget seedEntryContent =
     if isFocused SeedSelector
       then mkSeedEditorWidget

src/Swarm/TUI/Model/StateUpdate.hs

@@ -45,7 +45,14 @@ import Swarm.Game.Achievement.Attainment
 import Swarm.Game.Achievement.Definitions
 import Swarm.Game.Achievement.Persistence
 import Swarm.Game.Failure (SystemFailure)
-import Swarm.Game.Scenario (loadScenario, scenarioAttrs, scenarioSolution, scenarioWorlds)
+import Swarm.Game.Scenario (
+  loadScenario,
+  scenarioAttrs,
+  scenarioLandscape,
+  scenarioOperation,
+  scenarioSolution,
+  scenarioWorlds,
+ )
 import Swarm.Game.Scenario.Scoring.Best
 import Swarm.Game.Scenario.Scoring.ConcreteMetrics
 import Swarm.Game.Scenario.Scoring.GenericMetrics
@@ -139,7 +146,7 @@ constructAppState rs ui opts@(AppOpts {..}) = do
 
       let maybeAutoplay = do
             guard autoPlay
-            soln <- scenario ^. scenarioSolution
+            soln <- scenario ^. scenarioOperation . scenarioSolution
             return $ CodeToRun ScenarioSuggested soln
           codeToRun = maybeAutoplay <|> maybeRunScript
 
@@ -263,7 +270,12 @@ scenarioToUIState isAutoplaying siPair@(scenario, _) gs u = do
       & uiGameplay . uiTiming . uiShowFPS .~ False
       & uiGameplay . uiREPL .~ initREPLState (u ^. uiGameplay . uiREPL . replHistory)
       & uiGameplay . uiREPL . replHistory %~ restartREPLHistory
-      & uiAttrMap .~ applyAttrMappings (map (first getWorldAttrName . toAttrPair) $ fst siPair ^. scenarioAttrs) swarmAttrMap
+      & uiAttrMap
+        .~ applyAttrMappings
+          ( map (first getWorldAttrName . toAttrPair) $
+              fst siPair ^. scenarioLandscape . scenarioAttrs
+          )
+          swarmAttrMap
       & uiGameplay . scenarioRef ?~ siPair
       & uiGameplay . uiTiming . lastFrameTime .~ curTime
       & uiGameplay . uiWorldEditor . EM.entityPaintList %~ BL.listReplace entityList Nothing
@@ -275,7 +287,11 @@ scenarioToUIState isAutoplaying siPair@(scenario, _) gs u = do
  where
   entityList = EU.getEntitiesForList $ gs ^. landscape . entityMap
 
-  (isEmptyArea, newBounds) = EU.getEditingBounds $ NE.head $ scenario ^. scenarioWorlds
+  (isEmptyArea, newBounds) =
+    EU.getEditingBounds $
+      NE.head $
+        scenario ^. scenarioLandscape . scenarioWorlds
+
   setNewBounds maybeOldBounds =
     if isEmptyArea
       then maybeOldBounds

src/Swarm/TUI/View.hs

@@ -85,8 +85,11 @@ import Swarm.Game.Scenario (
   scenarioCreative,
   scenarioDescription,
   scenarioKnown,
+  scenarioLandscape,
+  scenarioMetadata,
   scenarioName,
   scenarioObjectives,
+  scenarioOperation,
   scenarioSeed,
  )
 import Swarm.Game.Scenario.Scoring.Best
@@ -219,11 +222,11 @@ drawNewGameMenuUI (l :| ls) launchOptions = case displayedFor of
     (Nothing, Just (SISingle _)) -> hCenter $ txt "Press 'o' for launch options, or 'Enter' to launch with defaults"
     _ -> txt " "
 
-  drawScenarioItem (SISingle (s, si)) = padRight (Pad 1) (drawStatusInfo s si) <+> txt (s ^. scenarioName)
+  drawScenarioItem (SISingle (s, si)) = padRight (Pad 1) (drawStatusInfo s si) <+> txt (s ^. scenarioMetadata . scenarioName)
   drawScenarioItem (SICollection nm _) = padRight (Pad 1) (withAttr boldAttr $ txt " > ") <+> txt nm
   drawStatusInfo s si = case si ^. scenarioStatus of
     NotStarted -> txt " ○ "
-    Played _initialScript (Metric Attempted _) _ -> case s ^. scenarioObjectives of
+    Played _initialScript (Metric Attempted _) _ -> case s ^. scenarioOperation . scenarioObjectives of
       [] -> withAttr cyanAttr $ txt " ◉ "
       _ -> withAttr yellowAttr $ txt " ◎ "
     Played _initialScript (Metric Completed _) _ -> withAttr greenAttr $ txt " ● "
@@ -244,22 +247,25 @@ drawNewGameMenuUI (l :| ls) launchOptions = case displayedFor of
   drawDescription (SICollection _ _) = txtWrap " "
   drawDescription (SISingle (s, si)) =
     vBox
-      [ drawMarkdown (nonBlank (s ^. scenarioDescription))
+      [ drawMarkdown (nonBlank (s ^. scenarioOperation . scenarioDescription))
       , hCenter . padTop (Pad 1) . vLimit 6 $ hLimitPercent 60 worldPeek
       , padTop (Pad 1) table
       ]
    where
-    vc = determineStaticViewCenter s worldTuples
+    vc = determineStaticViewCenter (s ^. scenarioLandscape) worldTuples
 
-    worldTuples = buildWorldTuples s
-    theWorlds = genMultiWorld worldTuples $ fromMaybe 0 $ s ^. scenarioSeed
+    worldTuples = buildWorldTuples $ s ^. scenarioLandscape
+    theWorlds =
+      genMultiWorld worldTuples $
+        fromMaybe 0 $
+          s ^. scenarioLandscape . scenarioSeed
 
     ri =
       RenderingInput theWorlds $
         getEntityIsKnown $
           EntityKnowledgeDependencies
-            { isCreativeMode = s ^. scenarioCreative
-            , globallyKnownEntities = s ^. scenarioKnown
+            { isCreativeMode = s ^. scenarioOperation . scenarioCreative
+            , globallyKnownEntities = s ^. scenarioLandscape . scenarioKnown
             , theFocusedRobot = Nothing
             }
     renderCoord = renderDisplay . displayLocRaw (WorldOverdraw False mempty) ri []
@@ -267,7 +273,7 @@ drawNewGameMenuUI (l :| ls) launchOptions = case displayedFor of
 
     firstRow =
       ( withAttr dimAttr $ txt "Author:"
-      , withAttr dimAttr . txt <$> s ^. scenarioAuthor
+      , withAttr dimAttr . txt <$> s ^. scenarioMetadata . scenarioAuthor
       )
     secondRow =
       ( txt "last:"
@@ -623,7 +629,7 @@ drawModal s = \case
   QuitModal -> padBottom (Pad 1) $ hCenter $ txt (quitMsg (s ^. uiState . uiMenu))
   GoalModal ->
     GR.renderGoalsDisplay (s ^. uiState . uiGameplay . uiGoal) $
-      view scenarioDescription . fst <$> s ^. uiState . uiGameplay . scenarioRef
+      view (scenarioOperation . scenarioDescription) . fst <$> s ^. uiState . uiGameplay . scenarioRef
   KeepPlayingModal ->
     padLeftRight 1 $
       displayParagraphs $

src/Swarm/TUI/View/Util.hs

@@ -17,7 +17,7 @@ import Data.Text qualified as T
 import Graphics.Vty qualified as V
 import Swarm.Game.Entity as E
 import Swarm.Game.Location
-import Swarm.Game.Scenario (scenarioName)
+import Swarm.Game.Scenario (scenarioMetadata, scenarioName)
 import Swarm.Game.ScenarioInfo (scenarioItemName)
 import Swarm.Game.State
 import Swarm.Game.State.Substate
@@ -105,7 +105,7 @@ generateModal s mt = Modal mt (dialog (Just $ str title) buttons (maxModalWindow
       GoalModal ->
         let goalModalTitle = case currentScenario of
               Nothing -> "Goal"
-              Just (scenario, _) -> scenario ^. scenarioName
+              Just (scenario, _) -> scenario ^. scenarioMetadata . scenarioName
          in (" " <> T.unpack goalModalTitle <> " ", Nothing, descriptionWidth)
       KeepPlayingModal -> ("", Just (Button CancelButton, [("OK", Button CancelButton, Cancel)]), 80)
       TerrainPaletteModal -> ("Terrain", Nothing, w)

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

@@ -78,7 +78,7 @@ data ScenarioItem = SISingle ScenarioInfoPair | SICollection Text ScenarioCollec
 
 -- | Retrieve the name of a scenario item.
 scenarioItemName :: ScenarioItem -> Text
-scenarioItemName (SISingle (s, _ss)) = s ^. scenarioName
+scenarioItemName (SISingle (s, _ss)) = s ^. scenarioMetadata . scenarioName
 scenarioItemName (SICollection name _) = name
 
 -- | A scenario collection is a tree of scenarios, keyed by name,

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

@@ -557,31 +557,33 @@ pureScenarioToGameState scenario theSeed now toRun gsc =
   preliminaryGameState
     & discovery . structureRecognition .~ recognizer
  where
+  sLandscape = scenario ^. scenarioLandscape
+
   recognizer =
     runIdentity $
       Fused.evalState preliminaryGameState $
-        mkRecognizer (scenario ^. scenarioStructures)
+        mkRecognizer (sLandscape ^. scenarioStructures)
 
   gs = initGameState gsc
   preliminaryGameState =
     gs
       & robotInfo %~ setRobotInfo baseID robotList'
-      & creativeMode .~ scenario ^. scenarioCreative
+      & creativeMode .~ scenario ^. scenarioOperation . scenarioCreative
       & winCondition .~ theWinCondition
-      & winSolution .~ scenario ^. scenarioSolution
+      & winSolution .~ scenario ^. scenarioOperation . scenarioSolution
       & discovery . availableCommands .~ Notifications 0 initialCommands
-      & discovery . knownEntities .~ scenario ^. scenarioKnown
+      & discovery . knownEntities .~ sLandscape ^. scenarioKnown
       & discovery . tagMembers .~ buildTagMap em
       & randomness . seed .~ theSeed
       & randomness . randGen .~ mkStdGen theSeed
       & recipesInfo %~ modifyRecipesInfo
-      & landscape .~ mkLandscape scenario em worldTuples theSeed
+      & landscape .~ mkLandscape sLandscape em worldTuples theSeed
       & gameControls . initiallyRunCode .~ initialCodeToRun
       & gameControls . replStatus .~ case running of -- When the base starts out running a program, the REPL status must be set to working,
       -- otherwise the store of definition cells is not saved (see #333, #838)
         False -> REPLDone Nothing
         True -> REPLWorking (Typed Nothing PolyUnit mempty)
-      & temporal . robotStepsPerTick .~ ((scenario ^. scenarioStepsPerTick) ? defaultRobotStepsPerTick)
+      & temporal . robotStepsPerTick .~ ((scenario ^. scenarioOperation . scenarioStepsPerTick) ? defaultRobotStepsPerTick)
 
   robotList' = (robotCreatedAt .~ now) <$> robotList
 
@@ -591,13 +593,13 @@ pureScenarioToGameState scenario theSeed now toRun gsc =
       & recipesIn %~ addRecipesWith inRecipeMap
       & recipesCat %~ addRecipesWith catRecipeMap
 
-  em = integrateScenarioEntities (initState gsc) scenario
+  em = integrateScenarioEntities (initState gsc) sLandscape
   baseID = 0
   (things, devices) = partition (null . view entityCapabilities) (M.elems (entitiesByName em))
 
   getCodeToRun (CodeToRun _ s) = s
 
-  robotsByBasePrecedence = genRobotTemplates scenario worldTuples
+  robotsByBasePrecedence = genRobotTemplates sLandscape worldTuples
 
   initialCodeToRun = getCodeToRun <$> toRun
 
@@ -619,12 +621,12 @@ pureScenarioToGameState scenario theSeed now toRun gsc =
       -- If we are in creative mode, give base all the things
       & ix baseID
         . robotInventory
-        %~ case scenario ^. scenarioCreative of
+        %~ case scenario ^. scenarioOperation . scenarioCreative of
           False -> id
           True -> union (fromElems (map (0,) things))
       & ix baseID
         . equippedDevices
-        %~ case scenario ^. scenarioCreative of
+        %~ case scenario ^. scenarioOperation . scenarioCreative of
           False -> id
           True -> const (fromList devices)
 
@@ -644,15 +646,15 @@ pureScenarioToGameState scenario theSeed now toRun gsc =
       (maybe True (`S.member` initialCaps) . constCaps)
       allConst
 
-  worldTuples = buildWorldTuples scenario
+  worldTuples = buildWorldTuples sLandscape
 
   theWinCondition =
     maybe
       NoWinCondition
       (WinConditions Ongoing . initCompletion . NE.toList)
-      (NE.nonEmpty (scenario ^. scenarioObjectives))
+      (NE.nonEmpty (scenario ^. scenarioOperation . scenarioObjectives))
 
-  addRecipesWith f = IM.unionWith (<>) (f $ scenario ^. scenarioRecipes)
+  addRecipesWith f = IM.unionWith (<>) (f $ scenario ^. scenarioOperation . scenarioRecipes)
 
 -- | Create an initial game state corresponding to the given scenario.
 scenarioToGameState ::
@@ -661,6 +663,6 @@ scenarioToGameState ::
   GameStateConfig ->
   IO GameState
 scenarioToGameState scenario (LaunchParams (Identity userSeed) (Identity toRun)) gsc = do
-  theSeed <- arbitrateSeed userSeed scenario
+  theSeed <- arbitrateSeed userSeed $ scenario ^. scenarioLandscape
   now <- Clock.getTime Clock.Monotonic
   return $ pureScenarioToGameState scenario theSeed now toRun gsc

src/swarm-scenario/Swarm/Game/Scenario.hs

@@ -22,11 +22,15 @@ module Swarm.Game.Scenario (
 
   -- * Scenario
   Scenario (..),
+  ScenarioLandscape (..),
   StaticStructureInfo (..),
   staticPlacements,
   structureDefs,
 
   -- ** Fields
+  scenarioMetadata,
+  scenarioOperation,
+  scenarioLandscape,
   scenarioVersion,
   scenarioName,
   scenarioAuthor,
@@ -127,36 +131,138 @@ structureDefs :: Lens' StaticStructureInfo [SymmetryAnnotatedGrid (Maybe Cell)]
 -- added to the "recognized" list upon scenario initialization
 staticPlacements :: Lens' StaticStructureInfo (M.Map SubworldName [Structure.LocatedStructure])
 
-------------------------------------------------------------
--- Scenario
-------------------------------------------------------------
+-- * Scenario records
 
--- | A 'Scenario' contains all the information to describe a
---   scenario.
-data Scenario = Scenario
+-- | Authorship information about scenario not used at play-time
+data ScenarioMetadata = ScenarioMetadata
   { _scenarioVersion :: Int
   , _scenarioName :: Text
   , _scenarioAuthor :: Maybe Text
+  }
+  deriving (Show)
+
+makeLensesNoSigs ''ScenarioMetadata
+
+-- | The version number of the scenario schema.  Currently, this
+--   should always be 1, but it is ignored.  In the future, this may
+--   be used to convert older formats to newer ones, or simply to
+--   print a nice error message when we can't read an older format.
+scenarioVersion :: Lens' ScenarioMetadata Int
+
+-- | The name of the scenario.
+scenarioName :: Lens' ScenarioMetadata Text
+
+-- | The author of the scenario.
+scenarioAuthor :: Lens' ScenarioMetadata (Maybe Text)
+
+-- | Non-structural gameplay content of the scenario;
+-- how it is to be played.
+data ScenarioOperation = ScenarioOperation
+  { _scenarioCreative :: Bool
   , _scenarioDescription :: Document Syntax
-  , _scenarioCreative :: Bool
-  , _scenarioSeed :: Maybe Int
+  -- ^ Note: the description is in this record instead of
+  -- 'ScenarioMetadata' because it relates to the goals.
+  , _scenarioObjectives :: [Objective]
+  , _scenarioSolution :: Maybe ProcessedTerm
+  , _scenarioRecipes :: [Recipe Entity]
+  , _scenarioStepsPerTick :: Maybe Int
+  }
+  deriving (Show)
+
+makeLensesNoSigs ''ScenarioOperation
+
+-- | A high-level description of the scenario, shown /e.g./ in the
+--   menu.
+scenarioDescription :: Lens' ScenarioOperation (Document Syntax)
+
+-- | Whether the scenario should start in creative mode.
+scenarioCreative :: Lens' ScenarioOperation Bool
+
+-- | Any custom recipes used in this scenario.
+scenarioRecipes :: Lens' ScenarioOperation [Recipe Entity]
+
+-- | A sequence of objectives for the scenario (if any).
+scenarioObjectives :: Lens' ScenarioOperation [Objective]
+
+-- | An optional solution of the scenario, expressed as a
+--   program of type @cmd a@. This is useful for automated
+--   testing of the win condition.
+scenarioSolution :: Lens' ScenarioOperation (Maybe ProcessedTerm)
+
+-- | Optionally, specify the maximum number of steps each robot may
+--   take during a single tick.
+scenarioStepsPerTick :: Lens' ScenarioOperation (Maybe Int)
+
+-- | All cosmetic and structural content of the scenario.
+data ScenarioLandscape = ScenarioLandscape
+  { _scenarioSeed :: Maybe Int
   , _scenarioAttrs :: [CustomAttr]
   , _scenarioEntities :: EntityMap
   , _scenarioCosmetics :: M.Map WorldAttr PreservableColor
-  , _scenarioRecipes :: [Recipe Entity]
   , _scenarioKnown :: Set EntityName
   , _scenarioWorlds :: NonEmpty WorldDescription
   , _scenarioNavigation :: Navigation (M.Map SubworldName) Location
   , _scenarioStructures :: StaticStructureInfo
   , _scenarioRobots :: [TRobot]
-  , _scenarioObjectives :: [Objective]
-  , _scenarioSolution :: Maybe ProcessedTerm
-  , _scenarioStepsPerTick :: Maybe Int
+  }
+  deriving (Show)
+
+makeLensesNoSigs ''ScenarioLandscape
+
+-- | The seed used for the random number generator.  If @Nothing@, use
+--   a random seed / prompt the user for the seed.
+scenarioSeed :: Lens' ScenarioLandscape (Maybe Int)
+
+-- | Custom attributes defined in the scenario.
+scenarioAttrs :: Lens' ScenarioLandscape [CustomAttr]
+
+-- | Any custom entities used for this scenario.
+scenarioEntities :: Lens' ScenarioLandscape EntityMap
+
+-- | High-fidelity color map for entities
+scenarioCosmetics :: Lens' ScenarioLandscape (M.Map WorldAttr PreservableColor)
+
+-- | List of entities that should be considered "known", so robots do
+--   not have to scan them.
+scenarioKnown :: Lens' ScenarioLandscape (Set EntityName)
+
+-- | The subworlds of the scenario.
+-- The "root" subworld shall always be at the head of the list, by construction.
+scenarioWorlds :: Lens' ScenarioLandscape (NonEmpty WorldDescription)
+
+-- | Information required for structure recognition
+scenarioStructures :: Lens' ScenarioLandscape StaticStructureInfo
+
+-- | Waypoints and inter-world portals
+scenarioNavigation :: Lens' ScenarioLandscape (Navigation (M.Map SubworldName) Location)
+
+-- | The starting robots for the scenario.  Note this should
+--   include the base.
+scenarioRobots :: Lens' ScenarioLandscape [TRobot]
+
+-- | A 'Scenario' contains all the information to describe a
+--   scenario.
+data Scenario = Scenario
+  { _scenarioMetadata :: ScenarioMetadata
+  , _scenarioOperation :: ScenarioOperation
+  , _scenarioLandscape :: ScenarioLandscape
   }
   deriving (Show)
 
 makeLensesNoSigs ''Scenario
 
+-- | Authorship information about scenario not used at play-time
+scenarioMetadata :: Lens' Scenario ScenarioMetadata
+
+-- | Non-structural gameplay content of the scenario;
+-- how it is to be played.
+scenarioOperation :: Lens' Scenario ScenarioOperation
+
+-- | All cosmetic and structural content of the scenario.
+scenarioLandscape :: Lens' Scenario ScenarioLandscape
+
+-- * Parsing
+
 instance FromJSONE (EntityMap, WorldMap) Scenario where
   parseJSONE = withObjectE "scenario" $ \v -> do
     -- parse custom entities
@@ -166,13 +272,9 @@ instance FromJSONE (EntityMap, WorldMap) Scenario where
     let mergedCosmetics = worldAttributes <> M.fromList (mapMaybe toHifiPair parsedAttrs)
         attrsUnion = M.keysSet mergedCosmetics
 
-    case run . runThrow $ validateAttrRefs attrsUnion emRaw of
-      Right x -> return x
-      Left x -> failT [prettyText @LoadingFailure x]
+    runValidation $ validateAttrRefs attrsUnion emRaw
 
-    em <- case run . runThrow $ buildEntityMap emRaw of
-      Right x -> return x
-      Left x -> failT [prettyText @LoadingFailure x]
+    em <- runValidation $ buildEntityMap emRaw
 
     -- Save the passed in WorldMap for later
     worldMap <- snd <$> getE
@@ -248,96 +350,41 @@ instance FromJSONE (EntityMap, WorldMap) Scenario where
               . NE.toList
               $ NE.map (worldName &&& placedStructures) allWorlds
 
-      Scenario
-        <$> liftE (v .: "version")
-        <*> liftE (v .: "name")
-        <*> liftE (v .:? "author")
-        <*> liftE (v .:? "description" .!= "")
-        <*> liftE (v .:? "creative" .!= False)
-        <*> liftE (v .:? "seed")
-        <*> pure parsedAttrs
-        <*> pure em
-        <*> pure mergedCosmetics
-        <*> v ..:? "recipes" ..!= []
-        <*> pure (Set.fromList known)
-        <*> pure allWorlds
-        <*> pure mergedNavigation
-        <*> pure structureInfo
-        <*> pure rs
-        <*> (liftE (v .:? "objectives" .!= []) >>= validateObjectives)
-        <*> liftE (v .:? "solution")
-        <*> liftE (v .:? "stepsPerTick")
+      seed <- liftE (v .:? "seed")
+      let landscape =
+            ScenarioLandscape
+              seed
+              parsedAttrs
+              em
+              mergedCosmetics
+              (Set.fromList known)
+              allWorlds
+              mergedNavigation
+              structureInfo
+              rs
 
---------------------------------------------------
--- Lenses
+      metadata <-
+        ScenarioMetadata
+          <$> liftE (v .: "version")
+          <*> liftE (v .: "name")
+          <*> liftE (v .:? "author")
 
--- | The version number of the scenario schema.  Currently, this
---   should always be 1, but it is ignored.  In the future, this may
---   be used to convert older formats to newer ones, or simply to
---   print a nice error message when we can't read an older format.
-scenarioVersion :: Lens' Scenario Int
+      playInfo <-
+        ScenarioOperation
+          <$> liftE (v .:? "creative" .!= False)
+          <*> liftE (v .:? "description" .!= "")
+          <*> (liftE (v .:? "objectives" .!= []) >>= validateObjectives)
+          <*> liftE (v .:? "solution")
+          <*> v ..:? "recipes" ..!= []
+          <*> liftE (v .:? "stepsPerTick")
 
--- | The name of the scenario.
-scenarioName :: Lens' Scenario Text
+      return $ Scenario metadata playInfo landscape
+   where
+    runValidation f = case run . runThrow $ f of
+      Right x -> return x
+      Left x -> failT [prettyText @LoadingFailure x]
 
--- | The author of the scenario.
-scenarioAuthor :: Lens' Scenario (Maybe Text)
-
--- | A high-level description of the scenario, shown /e.g./ in the
---   menu.
-scenarioDescription :: Lens' Scenario (Document Syntax)
-
--- | Whether the scenario should start in creative mode.
-scenarioCreative :: Lens' Scenario Bool
-
--- | The seed used for the random number generator.  If @Nothing@, use
---   a random seed / prompt the user for the seed.
-scenarioSeed :: Lens' Scenario (Maybe Int)
-
--- | Custom attributes defined in the scenario.
-scenarioAttrs :: Lens' Scenario [CustomAttr]
-
--- | Any custom entities used for this scenario.
-scenarioEntities :: Lens' Scenario EntityMap
-
--- | High-fidelity color map for entities
-scenarioCosmetics :: Lens' Scenario (M.Map WorldAttr PreservableColor)
-
--- | Any custom recipes used in this scenario.
-scenarioRecipes :: Lens' Scenario [Recipe Entity]
-
--- | List of entities that should be considered "known", so robots do
---   not have to scan them.
-scenarioKnown :: Lens' Scenario (Set EntityName)
-
--- | The subworlds of the scenario.
--- The "root" subworld shall always be at the head of the list, by construction.
-scenarioWorlds :: Lens' Scenario (NonEmpty WorldDescription)
-
--- | Information required for structure recognition
-scenarioStructures :: Lens' Scenario StaticStructureInfo
-
--- | Waypoints and inter-world portals
-scenarioNavigation :: Lens' Scenario (Navigation (M.Map SubworldName) Location)
-
--- | The starting robots for the scenario.  Note this should
---   include the base.
-scenarioRobots :: Lens' Scenario [TRobot]
-
--- | A sequence of objectives for the scenario (if any).
-scenarioObjectives :: Lens' Scenario [Objective]
-
--- | An optional solution of the scenario, expressed as a
---   program of type @cmd a@. This is useful for automated
---   testing of the win condition.
-scenarioSolution :: Lens' Scenario (Maybe ProcessedTerm)
-
--- | Optionally, specify the maximum number of steps each robot may
---   take during a single tick.
-scenarioStepsPerTick :: Lens' Scenario (Maybe Int)
-------------------------------------------------------------
--- Loading scenarios
-------------------------------------------------------------
+-- * Loading scenarios
 
 getScenarioPath ::
   (Has (Lift IO) sig m) =>
@@ -393,17 +440,17 @@ data GameStateInputs = GameStateInputs
   , initRecipes :: [Recipe Entity]
   }
 
-integrateScenarioEntities :: GameStateInputs -> Scenario -> EntityMap
-integrateScenarioEntities gsi scenario =
-  initEntities gsi <> scenario ^. scenarioEntities
+integrateScenarioEntities :: GameStateInputs -> ScenarioLandscape -> EntityMap
+integrateScenarioEntities gsi sLandscape =
+  initEntities gsi <> sLandscape ^. scenarioEntities
 
 -- |
 -- Decide on a seed.  In order of preference, we will use:
 --   1. seed value provided by the user
 --   2. seed value specified in the scenario description
 --   3. randomly chosen seed value
-arbitrateSeed :: Maybe Seed -> Scenario -> IO Seed
-arbitrateSeed userSeed scenario =
-  case userSeed <|> scenario ^. scenarioSeed of
+arbitrateSeed :: Maybe Seed -> ScenarioLandscape -> IO Seed
+arbitrateSeed userSeed sLandscape =
+  case userSeed <|> sLandscape ^. scenarioSeed of
     Just s -> return s
     Nothing -> randomRIO (0, maxBound :: Int)

src/swarm-scenario/Swarm/Game/Scenario/Topography/Center.hs

@@ -11,7 +11,7 @@ import Data.List.NonEmpty (NonEmpty)
 import Data.Maybe (fromMaybe, listToMaybe)
 import Swarm.Game.Location (Location, origin)
 import Swarm.Game.Robot (trobotLocation)
-import Swarm.Game.Scenario (Scenario)
+import Swarm.Game.Scenario (ScenarioLandscape)
 import Swarm.Game.State.Landscape (SubworldDescription, genRobotTemplates)
 import Swarm.Game.Universe (Cosmic (..), SubworldName (DefaultRootSubworld))
 
@@ -19,13 +19,13 @@ import Swarm.Game.Universe (Cosmic (..), SubworldName (DefaultRootSubworld))
 -- without reference to a 'GameState'
 -- (i.e. outside the context of an active game)
 determineStaticViewCenter ::
-  Scenario ->
+  ScenarioLandscape ->
   NonEmpty SubworldDescription ->
   Cosmic Location
-determineStaticViewCenter s worldTuples =
+determineStaticViewCenter sLandscape worldTuples =
   fromMaybe defaultVC baseRobotLoc
  where
-  theRobots = genRobotTemplates s worldTuples
+  theRobots = genRobotTemplates sLandscape worldTuples
   defaultVC = Cosmic DefaultRootSubworld origin
 
   -- The first robot is guaranteed to be the base.

src/swarm-scenario/Swarm/Game/State/Landscape.hs

@@ -86,22 +86,22 @@ initLandscape gsc =
     , _worldScrollable = True
     }
 
-mkLandscape :: Scenario -> EntityMap -> NonEmpty SubworldDescription -> Seed -> Landscape
-mkLandscape scenario em worldTuples theSeed =
+mkLandscape :: ScenarioLandscape -> EntityMap -> NonEmpty SubworldDescription -> Seed -> Landscape
+mkLandscape sLandscape em worldTuples theSeed =
   Landscape
     { _entityMap = em
-    , _worldNavigation = scenario ^. scenarioNavigation
+    , _worldNavigation = sLandscape ^. scenarioNavigation
     , _multiWorld = genMultiWorld worldTuples theSeed
     , -- TODO (#1370): Should we allow subworlds to have their own scrollability?
       -- Leaning toward no, but for now just adopt the root world scrollability
       -- as being universal.
-      _worldScrollable = NE.head (scenario ^. scenarioWorlds) ^. to scrollable
+      _worldScrollable = NE.head (sLandscape ^. scenarioWorlds) ^. to scrollable
     }
 
-buildWorldTuples :: Scenario -> NonEmpty SubworldDescription
-buildWorldTuples s =
+buildWorldTuples :: ScenarioLandscape -> NonEmpty SubworldDescription
+buildWorldTuples sLandscape =
   NE.map (worldName &&& buildWorld) $
-    s ^. scenarioWorlds
+    sLandscape ^. scenarioWorlds
 
 genMultiWorld :: NonEmpty SubworldDescription -> Seed -> MultiWorld Int Entity
 genMultiWorld worldTuples s =
@@ -179,14 +179,14 @@ buildWorld WorldDescription {..} = (robots worldName, first fromEnum . wf)
 --        same subworld, then
 --        prefer the one closest to the upper-left of the screen, with higher
 --        rows given precedence over columns (i.e. first in row-major order).
-genRobotTemplates :: Scenario -> NonEmpty (a, ([(Int, TRobot)], b)) -> [TRobot]
-genRobotTemplates scenario worldTuples =
+genRobotTemplates :: ScenarioLandscape -> NonEmpty (a, ([(Int, TRobot)], b)) -> [TRobot]
+genRobotTemplates sLandscape worldTuples =
   locatedRobots ++ map snd (sortOn fst genRobots)
  where
   -- Keep only robots from the robot list with a concrete location;
   -- the others existed only to serve as a template for robots drawn
   -- in the world map
-  locatedRobots = filter (isJust . view trobotLocation) $ scenario ^. scenarioRobots
+  locatedRobots = filter (isJust . view trobotLocation) $ sLandscape ^. scenarioRobots
 
   -- Subworld order as encountered in the scenario YAML file is preserved for
   -- the purpose of numbering robots, other than the "root" subworld

src/swarm-scenario/Swarm/Game/World/Render.hs

@@ -121,11 +121,11 @@ getBoundingBox vc scenarioWorld maybeSize =
 
 getDisplayGrid ::
   Location ->
-  Scenario ->
+  ScenarioLandscape ->
   Landscape ->
   Maybe AreaDimensions ->
   Grid CellPaintDisplay
-getDisplayGrid vc myScenario ls maybeSize =
+getDisplayGrid vc sLandscape ls maybeSize =
   getMapRectangle
     mkFacade
     (getContentAt worlds . mkCosmic)
@@ -134,7 +134,7 @@ getDisplayGrid vc myScenario ls maybeSize =
   mkCosmic = Cosmic $ worldName firstScenarioWorld
   worlds = view multiWorld ls
 
-  firstScenarioWorld = NE.head $ view scenarioWorlds myScenario
+  firstScenarioWorld = NE.head $ view scenarioWorlds sLandscape
 
 getRenderableGrid ::
   (Has (Throw SystemFailure) sig m, Has (Lift IO) sig m) =>
@@ -143,18 +143,18 @@ getRenderableGrid ::
   m (Grid (PCell EntityFacade), M.Map WorldAttr PreservableColor)
 getRenderableGrid (RenderOpts maybeSeed _ _ maybeSize _) fp = do
   (myScenario, gsi) <- loadStandaloneScenario fp
-  theSeed <- sendIO $ arbitrateSeed maybeSeed myScenario
+  let sLandscape = myScenario ^. scenarioLandscape
+  theSeed <- sendIO $ arbitrateSeed maybeSeed sLandscape
 
-  let em = integrateScenarioEntities gsi myScenario
-      worldTuples = buildWorldTuples myScenario
-      myLandscape = mkLandscape myScenario em worldTuples theSeed
+  let em = integrateScenarioEntities gsi sLandscape
+      worldTuples = buildWorldTuples sLandscape
+      myLandscape = mkLandscape sLandscape em worldTuples theSeed
 
       vc =
         view planar $
-          determineStaticViewCenter myScenario $
-            buildWorldTuples myScenario
+          determineStaticViewCenter sLandscape worldTuples
 
-  return (getDisplayGrid vc myScenario myLandscape maybeSize, myScenario ^. scenarioCosmetics)
+  return (getDisplayGrid vc sLandscape myLandscape maybeSize, sLandscape ^. scenarioCosmetics)
 
 doRenderCmd :: RenderOpts -> FilePath -> IO ()
 doRenderCmd opts@(RenderOpts _ asPng _ _ _) mapPath =

src/swarm-web/Swarm/Web/Worldview.hs

@@ -12,7 +12,7 @@ import Data.Text qualified as T
 import GHC.Generics (Generic)
 import Servant.Docs qualified as SD
 import Swarm.Game.Entity.Cosmetic (RGBColor, flattenBg)
-import Swarm.Game.Scenario (Scenario, scenarioCosmetics)
+import Swarm.Game.Scenario (Scenario, scenarioCosmetics, scenarioLandscape)
 import Swarm.Game.Scenario.Style
 import Swarm.Game.Scenario.Topography.Area (AreaDimensions (..), Grid)
 import Swarm.Game.State (GameState, landscape, robotInfo)
@@ -37,8 +37,9 @@ getCellGrid myScenario gs requestedSize =
   CellGrid indexGrid encoding
  where
   vc = gs ^. robotInfo . viewCenter
-  dg = getDisplayGrid (vc ^. planar) myScenario (gs ^. landscape) (Just requestedSize)
-  aMap = myScenario ^. scenarioCosmetics
+  sLandscape = myScenario ^. scenarioLandscape
+  dg = getDisplayGrid (vc ^. planar) sLandscape (gs ^. landscape) (Just requestedSize)
+  aMap = sLandscape ^. scenarioCosmetics
 
   asColour :: RGBColor -> Kolor
   asColour (RGB r g b) = sRGB24 r g b