From 6084fca44a2e470ff41738b5d16945b7c7163359 Mon Sep 17 00:00:00 2001
From: Karl Ostmo <kostmo@gmail.com>
Date: Sat, 1 Jul 2023 23:59:24 -0700
Subject: [PATCH] Add subworlds

---
 src/Swarm/Game/Scenario.hs                    |  9 +++++++
 .../Game/Scenario/Topography/Subworld.hs      | 27 +++++++++++++++++++
 swarm.cabal                                   |  1 +
 3 files changed, 37 insertions(+)
 create mode 100644 src/Swarm/Game/Scenario/Topography/Subworld.hs

diff --git a/src/Swarm/Game/Scenario.hs b/src/Swarm/Game/Scenario.hs
index 2818ea84de..5690476a2b 100644
--- a/src/Swarm/Game/Scenario.hs
+++ b/src/Swarm/Game/Scenario.hs
@@ -33,6 +33,7 @@ module Swarm.Game.Scenario (
   scenarioEntities,
   scenarioRecipes,
   scenarioKnown,
+  secenarioSubworlds,
   scenarioWorld,
   scenarioRobots,
   scenarioObjectives,
@@ -65,6 +66,7 @@ import Swarm.Game.Scenario.Objective.Validation
 import Swarm.Game.Scenario.RobotLookup
 import Swarm.Game.Scenario.Style
 import Swarm.Game.Scenario.Topography.Cell
+import Swarm.Game.Scenario.Topography.Subworld
 import Swarm.Game.Scenario.Topography.WorldDescription
 import Swarm.Language.Pipeline (ProcessedTerm)
 import Swarm.Util (failT)
@@ -91,6 +93,7 @@ data Scenario = Scenario
   , _scenarioEntities :: EntityMap
   , _scenarioRecipes :: [Recipe Entity]
   , _scenarioKnown :: [Text]
+  , _secenarioSubworlds :: [Subworld]
   , _scenarioWorld :: WorldDescription
   , _scenarioRobots :: [TRobot]
   , _scenarioObjectives :: [Objective]
@@ -110,6 +113,8 @@ instance FromJSONE EntityMap Scenario where
       Left x -> failT [x]
     -- extend ambient EntityMap with custom entities
 
+    subworlds <- v ..:? "subworlds" ..!= []
+
     withE em $ do
       -- parse 'known' entity names and make sure they exist
       known <- liftE (v .:? "known" .!= [])
@@ -133,6 +138,7 @@ instance FromJSONE EntityMap Scenario where
         <*> pure em
         <*> v ..:? "recipes" ..!= []
         <*> pure known
+        <*> pure subworlds
         <*> localE (,rsMap) (v ..: "world")
         <*> pure rs
         <*> (liftE (v .:? "objectives" .!= []) >>= validateObjectives)
@@ -178,6 +184,9 @@ scenarioRecipes :: Lens' Scenario [Recipe Entity]
 --   not have to scan them.
 scenarioKnown :: Lens' Scenario [Text]
 
+-- | The subworlds of the scenario.
+secenarioSubworlds :: Lens' Scenario [Subworld]
+
 -- | The starting world for the scenario.
 scenarioWorld :: Lens' Scenario WorldDescription
 
diff --git a/src/Swarm/Game/Scenario/Topography/Subworld.hs b/src/Swarm/Game/Scenario/Topography/Subworld.hs
new file mode 100644
index 0000000000..7a67dbe9d4
--- /dev/null
+++ b/src/Swarm/Game/Scenario/Topography/Subworld.hs
@@ -0,0 +1,27 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+-- |
+-- SPDX-License-Identifier: BSD-3-Clause
+module Swarm.Game.Scenario.Topography.Subworld where
+
+import Data.Aeson
+import Swarm.Game.Entity
+import Swarm.Game.Scenario.Topography.Navigation.Portal
+import Swarm.Game.Scenario.RobotLookup
+import Swarm.Game.Scenario.Topography.WorldDescription
+import Swarm.Util.Yaml
+
+data Subworld = Subworld
+  { name :: SubworldName
+  , portals :: [Portal]
+  , world :: WorldDescription
+  }
+  deriving (Eq, Show)
+
+instance FromJSONE EntityMap Subworld where
+  parseJSONE = withObjectE "subworld" $ \v -> do
+    n <- liftE (v .: "name")
+    c <- liftE (v .: "connectivity")
+    let rsMap = buildRobotMap []
+    w <- localE (,rsMap) (v ..: "world")
+    return $ Subworld n c w
diff --git a/swarm.cabal b/swarm.cabal
index 1264ba38c3..5df09c9fb5 100644
--- a/swarm.cabal
+++ b/swarm.cabal
@@ -118,6 +118,7 @@ library
                       Swarm.Game.Scenario.Scoring.ConcreteMetrics
                       Swarm.Game.Scenario.Scoring.GenericMetrics
                       Swarm.Game.Scenario.Status
+                      Swarm.Game.Scenario.Topography.Subworld
                       Swarm.Game.Scenario.Style
                       Swarm.Game.Scenario.Topography.EntityFacade
                       Swarm.Game.Scenario.Topography.Navigation.Portal