diff --git a/data/scenarios/Testing/144-subworlds/basic-subworld.yaml b/data/scenarios/Testing/144-subworlds/basic-subworld.yaml index 18b6e27dd7..aa6c9c4e0c 100644 --- a/data/scenarios/Testing/144-subworlds/basic-subworld.yaml +++ b/data/scenarios/Testing/144-subworlds/basic-subworld.yaml @@ -82,6 +82,7 @@ subworlds: .p..f...P. b..b..b..b world: + name: root default: [blank] palette: '.': [grass] diff --git a/data/scenarios/Testing/144-subworlds/subworld-located-robots.yaml b/data/scenarios/Testing/144-subworlds/subworld-located-robots.yaml index c48d6a3747..2d1b831461 100644 --- a/data/scenarios/Testing/144-subworlds/subworld-located-robots.yaml +++ b/data/scenarios/Testing/144-subworlds/subworld-located-robots.yaml @@ -89,6 +89,7 @@ subworlds: .p......P. b..b..b..b world: + name: root default: [blank] palette: '.': [grass] diff --git a/data/scenarios/Testing/144-subworlds/subworld-mapped-robots.yaml b/data/scenarios/Testing/144-subworlds/subworld-mapped-robots.yaml index 7cce067027..5d26158066 100644 --- a/data/scenarios/Testing/144-subworlds/subworld-mapped-robots.yaml +++ b/data/scenarios/Testing/144-subworlds/subworld-mapped-robots.yaml @@ -90,6 +90,7 @@ subworlds: .p.t....P. b..b..b..b world: + name: root default: [blank] palette: '.': [grass] diff --git a/data/scenarios/Testing/144-subworlds/subworld-shared-structures.yaml b/data/scenarios/Testing/144-subworlds/subworld-shared-structures.yaml index 69e2438e80..5e6759b7b7 100644 --- a/data/scenarios/Testing/144-subworlds/subworld-shared-structures.yaml +++ b/data/scenarios/Testing/144-subworlds/subworld-shared-structures.yaml @@ -170,6 +170,7 @@ subworlds: ..... ..... world: + name: root default: [blank] palette: '.': [grass] diff --git a/data/scenarios/Testing/_Validation/144-subworld-uniqueness-enforcement-default.yaml b/data/scenarios/Testing/_Validation/144-subworld-uniqueness-enforcement-default.yaml new file mode 100644 index 0000000000..062101a5d6 --- /dev/null +++ b/data/scenarios/Testing/_Validation/144-subworld-uniqueness-enforcement-default.yaml @@ -0,0 +1,87 @@ +version: 1 +name: Subworld uniqueness (default name) +description: | + Has two unnamed subworlds, which fail uniquenss +attrs: + - name: portal_in + fg: "#ff9a00" + bg: "#ff5d00" + - name: portal_out + fg: "#00a2ff" + bg: "#0065ff" +entities: + - name: telepad entrance + display: + attr: portal_in + char: "o" + description: + - Portal entrance + properties: [known] + - name: telepad exit + display: + attr: portal_out + char: "o" + description: + - Portal exit + properties: [known] +robots: + - name: base + dir: [1, 0] + devices: + - ADT calculator + - branch predictor + - comparator + - compass + - dictionary + - GPS receiver + - grabber + - lambda + - lodestone + - logger + - strange loop + - treads + - name: judge + dir: [1, 0] + system: true + display: + char: 'J' + invisible: true +known: [flower, boulder] +subworlds: + - default: [blank] + palette: + '.': [dirt] + 'f': [dirt, flower] + 'b': [dirt, boulder] + 'p': + cell: [dirt, telepad exit] + waypoint: + name: portal_out2 + 'P': + cell: [dirt, telepad entrance] + waypoint: + name: portal_in2 + upperleft: [-1, 1] + map: | + b..b..b..b + .p..f...P. + b..b..b..b +world: + default: [blank] + palette: + '.': [grass] + 'B': [grass, null, base] + 't': [ice, null, judge] + 'p': + cell: [grass, telepad exit] + waypoint: + name: portal_out1 + 'P': + cell: [grass, telepad entrance] + waypoint: + name: portal_in1 + upperleft: [-1, 1] + map: | + .......... + .p.Bt...P. + .......... diff --git a/data/scenarios/Testing/_Validation/144-subworld-uniqueness-enforcement-named.yaml b/data/scenarios/Testing/_Validation/144-subworld-uniqueness-enforcement-named.yaml new file mode 100644 index 0000000000..b608da8ec1 --- /dev/null +++ b/data/scenarios/Testing/_Validation/144-subworld-uniqueness-enforcement-named.yaml @@ -0,0 +1,89 @@ +version: 1 +name: Subworld uniqueness (explicit name) +description: | + Has two identically-named subworlds +attrs: + - name: portal_in + fg: "#ff9a00" + bg: "#ff5d00" + - name: portal_out + fg: "#00a2ff" + bg: "#0065ff" +entities: + - name: telepad entrance + display: + attr: portal_in + char: "o" + description: + - Portal entrance + properties: [known] + - name: telepad exit + display: + attr: portal_out + char: "o" + description: + - Portal exit + properties: [known] +robots: + - name: base + dir: [1, 0] + devices: + - ADT calculator + - branch predictor + - comparator + - compass + - dictionary + - GPS receiver + - grabber + - lambda + - lodestone + - logger + - strange loop + - treads + - name: judge + dir: [1, 0] + system: true + display: + char: 'J' + invisible: true +known: [flower, boulder] +subworlds: + - name: foo + default: [blank] + palette: + '.': [dirt] + 'f': [dirt, flower] + 'b': [dirt, boulder] + 'p': + cell: [dirt, telepad exit] + waypoint: + name: portal_out2 + 'P': + cell: [dirt, telepad entrance] + waypoint: + name: portal_in2 + upperleft: [-1, 1] + map: | + b..b..b..b + .p..f...P. + b..b..b..b +world: + name: foo + default: [blank] + palette: + '.': [grass] + 'B': [grass, null, base] + 't': [ice, null, judge] + 'p': + cell: [grass, telepad exit] + waypoint: + name: portal_out1 + 'P': + cell: [grass, telepad entrance] + waypoint: + name: portal_in1 + upperleft: [-1, 1] + map: | + .......... + .p.Bt...P. + .......... diff --git a/src/Swarm/Game/Scenario.hs b/src/Swarm/Game/Scenario.hs index 55e170b8de..a13020f811 100644 --- a/src/Swarm/Game/Scenario.hs +++ b/src/Swarm/Game/Scenario.hs @@ -48,7 +48,7 @@ module Swarm.Game.Scenario ( import Control.Arrow ((&&&)) import Control.Lens hiding (from, (.=), (<.>)) -import Control.Monad (filterM) +import Control.Monad (filterM, unless) import Control.Monad.Except (ExceptT (..), runExceptT, withExceptT) import Control.Monad.IO.Class (MonadIO (liftIO)) import Control.Monad.Trans.Except (except) @@ -77,7 +77,7 @@ import Swarm.Game.Scenario.Topography.Structure qualified as Structure import Swarm.Game.Scenario.Topography.WorldDescription import Swarm.Game.Universe import Swarm.Language.Pipeline (ProcessedTerm) -import Swarm.Util (failT) +import Swarm.Util (binTuples, failT) import Swarm.Util.Lens (makeLensesNoSigs) import Swarm.Util.Yaml import System.Directory (doesFileExist) @@ -140,6 +140,16 @@ instance FromJSONE EntityMap Scenario where subworlds <- v ..:? "subworlds" ..!= [] return $ rootWorld :| subworlds + let worldsByName = binTuples $ NE.toList $ NE.map (worldName &&& id) allWorlds + dupedNames = M.keys $ M.filter ((> 1) . length) worldsByName + unless (null dupedNames) + . fail + . T.unpack + $ T.unwords + [ "Subworld names are not unique:" + , T.intercalate ", " $ map renderWorldName dupedNames + ] + let mergedWaypoints = M.fromList $ map (worldName &&& runIdentity . waypoints . navigation) $ diff --git a/src/Swarm/Game/Scenario/Topography/Navigation/Portal.hs b/src/Swarm/Game/Scenario/Topography/Navigation/Portal.hs index 253e12b631..c5f2903f68 100644 --- a/src/Swarm/Game/Scenario/Topography/Navigation/Portal.hs +++ b/src/Swarm/Game/Scenario/Topography/Navigation/Portal.hs @@ -165,7 +165,7 @@ validatePortals (Navigation wpUniverse partialPortals) = do return $ M.fromList portalPairs where - getLocs (Cosmo swName@(SubworldName rawSwName) wpWrapper@(WaypointName exitName)) = do + getLocs (Cosmo swName wpWrapper@(WaypointName exitName)) = do subworldWaypoints <- case M.lookup swName wpUniverse of Just x -> return x Nothing -> @@ -175,7 +175,7 @@ validatePortals (Navigation wpUniverse partialPortals) = do [ "Could not lookup waypoint" , quote exitName , "for portal exit because subworld" - , quote rawSwName + , quote $ renderWorldName swName , "does not exist" ] diff --git a/src/Swarm/Game/Scenario/Topography/WorldDescription.hs b/src/Swarm/Game/Scenario/Topography/WorldDescription.hs index 3cb4f7ab0b..a83c3e1d53 100644 --- a/src/Swarm/Game/Scenario/Topography/WorldDescription.hs +++ b/src/Swarm/Game/Scenario/Topography/WorldDescription.hs @@ -59,7 +59,7 @@ instance FromJSONE (InheritedStructureDefs, (EntityMap, RobotMap)) WorldDescript (initialArea, mapWaypoints) <- liftE ((v .:? "map" .!= "") >>= Structure.paintMap Nothing pal) upperLeft <- liftE (v .:? "upperleft" .!= origin) - subWorldName <- liftE (v .:? "name" .!= defaultRootSubworldName) + subWorldName <- liftE (v .:? "name" .!= DefaultRootSubworld) let initialStructureDefs = scnenarioLevelStructureDefs <> rootWorldStructureDefs struc = Structure initialArea initialStructureDefs placementDefs $ waypointDefs <> mapWaypoints diff --git a/src/Swarm/Game/Universe.hs b/src/Swarm/Game/Universe.hs index 71b2b4b265..8cdab8a9a9 100644 --- a/src/Swarm/Game/Universe.hs +++ b/src/Swarm/Game/Universe.hs @@ -9,28 +9,21 @@ import Control.Lens (makeLenses, view) import Data.Function (on) import Data.Int (Int32) import Data.Text (Text) -import Data.Yaml (FromJSON, ToJSON, Value (Object), parseJSON, (.:)) +import Data.Yaml (FromJSON, ToJSON, Value (Object), parseJSON, withText, (.:)) import GHC.Generics (Generic) import Linear (V2 (..)) import Swarm.Game.Location --- TODO: It would be better not to use this as --- an "in-band" reserved name. Preferably its use --- should be eliminated entirely. --- E.g., robot locations specified within a toplevel robot --- definition (instead of on a map) should require the subworld --- to be specified. Currently, the subworld name is optional --- for backwards compatibility. --- If, after all, a "default" is still required, should --- use a dedicated sum type member to designate --- the "default" for cases in which it is required. -defaultRootSubworldName :: SubworldName -defaultRootSubworldName = SubworldName "root" +data SubworldName = DefaultRootSubworld | SubworldName Text + deriving (Show, Eq, Ord, Generic, ToJSON) --- | Note: The primary overworld shall use --- the reserved name \"root\". -newtype SubworldName = SubworldName Text - deriving (Show, Eq, Ord, Generic, FromJSON, ToJSON) +instance FromJSON SubworldName where + parseJSON = withText "subworld name" $ return . SubworldName + +renderWorldName :: SubworldName -> Text +renderWorldName = \case + SubworldName s -> s + DefaultRootSubworld -> "" -- | The swarm universe consists of locations -- indexed by subworld. @@ -47,7 +40,7 @@ makeLenses ''Cosmo instance (FromJSON a) => FromJSON (Cosmo a) where parseJSON x = case x of Object v -> objParse v - _ -> Cosmo defaultRootSubworldName <$> parseJSON x + _ -> Cosmo DefaultRootSubworld <$> parseJSON x where objParse v = Cosmo @@ -55,7 +48,7 @@ instance (FromJSON a) => FromJSON (Cosmo a) where <*> v .: "loc" defaultCosmoLocation :: Cosmo Location -defaultCosmoLocation = Cosmo defaultRootSubworldName origin +defaultCosmoLocation = Cosmo DefaultRootSubworld origin data DistanceMeasure b = Measurable b | InfinitelyFar deriving (Eq, Ord) diff --git a/src/Swarm/TUI/Editor/Model.hs b/src/Swarm/TUI/Editor/Model.hs index 8f62befba9..4a335d8e7c 100644 --- a/src/Swarm/TUI/Editor/Model.hs +++ b/src/Swarm/TUI/Editor/Model.hs @@ -83,6 +83,6 @@ initialWorldEditor ts = MapEditingBounds -- Note that these are in "world coordinates", -- not in player-facing "Location" coordinates - (Just $ Cosmo defaultRootSubworldName (W.Coords (-10, -20), W.Coords (10, 20))) + (Just $ Cosmo DefaultRootSubworld (W.Coords (-10, -20), W.Coords (10, 20))) (ts - 1) SelectionComplete diff --git a/src/Swarm/TUI/Editor/Palette.hs b/src/Swarm/TUI/Editor/Palette.hs index d416a1d4a8..122fe0bbc8 100644 --- a/src/Swarm/TUI/Editor/Palette.hs +++ b/src/Swarm/TUI/Editor/Palette.hs @@ -129,7 +129,7 @@ constructScenario maybeOriginalScenario cellGrid = , ul = upperLeftCoord , area = cellGrid , navigation = Navigation mempty mempty - , worldName = defaultRootSubworldName + , worldName = DefaultRootSubworld } suggestedPalette = makeSuggestedPalette maybeOriginalScenario cellGrid diff --git a/src/Swarm/TUI/Editor/Util.hs b/src/Swarm/TUI/Editor/Util.hs index 1e832ff36a..b9eb365b7c 100644 --- a/src/Swarm/TUI/Editor/Util.hs +++ b/src/Swarm/TUI/Editor/Util.hs @@ -29,7 +29,7 @@ getEditingBounds :: WorldDescription -> (Bool, Cosmo W.BoundsRectangle) getEditingBounds myWorld = (EA.isEmpty a, newBounds) where - newBounds = Cosmo defaultRootSubworldName (W.locToCoords upperLeftLoc, W.locToCoords lowerRightLoc) + newBounds = Cosmo DefaultRootSubworld (W.locToCoords upperLeftLoc, W.locToCoords lowerRightLoc) upperLeftLoc = ul myWorld a = EA.getAreaDimensions $ area myWorld lowerRightLoc = EA.upperLeftToBottomRight a upperLeftLoc diff --git a/src/Swarm/TUI/View.hs b/src/Swarm/TUI/View.hs index 9a566a0a37..bb9d86b673 100644 --- a/src/Swarm/TUI/View.hs +++ b/src/Swarm/TUI/View.hs @@ -467,10 +467,10 @@ renderCoordsString cCoords = unwords [ VU.locationToString coords , "in" - , T.unpack swName + , T.unpack $ renderWorldName sw ] where - Cosmo (SubworldName swName) coords = cCoords + Cosmo sw coords = cCoords drawWorldCursorInfo :: WorldEditor Name -> GameState -> Cosmo W.Coords -> Widget Name drawWorldCursorInfo worldEditor g cCoords =