remove 'unGrid' accessor (#1982)

Towards #1981

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

@@ -18,7 +18,7 @@ import Swarm.Game.Entity
 import Swarm.Game.Land
 import Swarm.Game.Location
 import Swarm.Game.Scenario.RobotLookup
-import Swarm.Game.Scenario.Topography.Area (Grid (..))
+import Swarm.Game.Scenario.Topography.Area (emptyGrid)
 import Swarm.Game.Scenario.Topography.Cell
 import Swarm.Game.Scenario.Topography.EntityFacade
 import Swarm.Game.Scenario.Topography.Navigation.Portal
@@ -84,7 +84,7 @@ integrateArea ::
 integrateArea palette initialStructureDefs v = do
   placementDefs <- v .:? "placements" .!= []
   waypointDefs <- v .:? "waypoints" .!= []
-  rawMap <- v .:? "map" .!= Grid []
+  rawMap <- v .:? "map" .!= emptyGrid
   (initialArea, mapWaypoints) <- paintMap Nothing palette rawMap
   let unflattenedStructure =
         Structure

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

@@ -10,7 +10,6 @@ import Data.Aeson.KeyMap qualified as KM
 import Data.Map qualified as M
 import Data.Maybe (catMaybes)
 import Data.Set qualified as Set
-import Data.Text (Text)
 import Data.Text qualified as T
 import Data.Tuple (swap)
 import Swarm.Game.Entity
@@ -43,10 +42,10 @@ toKey = fmap $ fmap (\(EntityFacade eName _display) -> eName)
 -- (terrain, entity name) key, and couple it with the original
 -- (terrain, entity facade) pair in a Map.
 getUniqueTerrainFacadePairs ::
-  [[CellPaintDisplay]] ->
+  [CellPaintDisplay] ->
   M.Map (TerrainWith EntityName) (TerrainWith EntityFacade)
 getUniqueTerrainFacadePairs cellGrid =
-  M.fromList $ concatMap (map genTuple) cellGrid
+  M.fromList $ map genTuple cellGrid
  where
   genTuple c =
     (toKey terrainEfd, terrainEfd)
@@ -67,9 +66,9 @@ constructWorldMap ::
   -- | Mask char
   Char ->
   Grid (Maybe CellPaintDisplay) ->
-  Text
+  String
 constructWorldMap mappedPairs maskChar =
-  T.unlines . map (T.pack . map renderMapCell) . unGrid
+  unlines . getRows . fmap renderMapCell
  where
   invertedMappedPairs = map (swap . fmap toKey) mappedPairs
 
@@ -100,7 +99,7 @@ data PaletteAndMaskChar = PaletteAndMaskChar
 prepForJson ::
   PaletteAndMaskChar ->
   Grid (Maybe CellPaintDisplay) ->
-  (Text, KM.KeyMap CellPaintDisplay)
+  (String, KM.KeyMap CellPaintDisplay)
 prepForJson (PaletteAndMaskChar (StructurePalette suggestedPalette) maybeMaskChar) cellGrid =
   (constructWorldMap mappedPairs maskCharacter cellGrid, constructPalette mappedPairs)
  where
@@ -111,7 +110,7 @@ prepForJson (PaletteAndMaskChar (StructurePalette suggestedPalette) maybeMaskCha
         KM.toMapText suggestedPalette
 
   entityCells :: M.Map (TerrainWith EntityName) (TerrainWith EntityFacade)
-  entityCells = getUniqueTerrainFacadePairs $ map catMaybes $ unGrid cellGrid
+  entityCells = getUniqueTerrainFacadePairs $ catMaybes $ allMembers cellGrid
 
   unassignedCells :: M.Map (TerrainWith EntityName) (TerrainWith EntityFacade)
   unassignedCells =

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

@@ -154,7 +154,7 @@ buildWorld tem WorldDescription {..} =
   arrayBoundsTuple = (unCoords coords, arrayMaxBound)
 
   worldArray :: Array (Int32, Int32) (TerrainType, Erasable Entity)
-  worldArray = listArray arrayBoundsTuple $ concat $ unGrid worldGrid
+  worldArray = listArray arrayBoundsTuple $ allMembers worldGrid
 
   dslWF, arrayWF :: Seed -> WorldFun TerrainType Entity
   dslWF = maybe mempty ((applyWhen offsetOrigin findGoodOrigin .) . runWorld) worldProg
@@ -165,14 +165,11 @@ buildWorld tem WorldDescription {..} =
   -- Get all the robots described in cells and set their locations appropriately
   robots :: SubworldName -> [IndexedTRobot]
   robots swName =
-    unGrid g
-      & traversed Control.Lens.<.> traversed %@~ (,) -- add (r,c) indices
-      & concat
-      & concatMap
-        ( \((fromIntegral -> r, fromIntegral -> c), maybeCell) ->
-            let robotWithLoc = trobotLocation ?~ Cosmic swName (coordsToLoc (coords `addTuple` (r, c)))
-             in map (fmap robotWithLoc) (maybe [] cellRobots maybeCell)
-        )
+    concat $ mapIndexedMembers extractRobots g
+   where
+    extractRobots (Coords coordsTuple) maybeCell =
+      let robotWithLoc = trobotLocation ?~ Cosmic swName (coordsToLoc (coords `addTuple` coordsTuple))
+       in map (fmap robotWithLoc) (maybe [] cellRobots maybeCell)
 
 -- |
 -- Returns a list of robots, ordered by decreasing preference

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

@@ -165,7 +165,7 @@ doRenderCmd opts@(RenderOpts _ asPng _ _ _) mapPath =
 renderScenarioMap :: RenderOpts -> FilePath -> IO [String]
 renderScenarioMap opts fp = simpleErrorHandle $ do
   (grid, _) <- getRenderableGrid opts fp
-  return $ unGrid $ getDisplayChar <$> grid
+  return $ getRows $ getDisplayChar <$> grid
 
 renderScenarioPng :: RenderOpts -> FilePath -> IO ()
 renderScenarioPng opts fp = do

src/swarm-topography/Swarm/Game/Scenario/Topography/Area.hs

@@ -12,11 +12,15 @@ import Linear (V2 (..))
 import Swarm.Game.Location
 import Swarm.Game.World.Coords
 
-newtype Grid c = Grid
-  { unGrid :: [[c]]
-  }
+newtype Grid c = Grid [[c]]
   deriving (Show, Eq, Functor, Foldable, Traversable)
 
+emptyGrid :: Grid a
+emptyGrid = Grid []
+
+getRows :: Grid a -> [[a]]
+getRows (Grid g) = g
+
 -- | Since the derived 'Functor' instance applies to the
 -- type parameter that is nested within lists, we define
 -- an explicit function for mapping over the enclosing lists.

src/swarm-topography/Swarm/Game/Scenario/Topography/Structure.hs

@@ -92,7 +92,7 @@ instance FromJSON (Grid Char) where
   parseJSON = withText "area" $ \t -> do
     let textLines = map T.unpack $ T.lines t
     case NE.nonEmpty textLines of
-      Nothing -> return $ Grid []
+      Nothing -> return emptyGrid
       Just nonemptyRows -> do
         let firstRowLength = length $ NE.head nonemptyRows
         unless (all ((== firstRowLength) . length) $ NE.tail nonemptyRows) $
@@ -107,7 +107,7 @@ instance (FromJSONE e a) => FromJSONE e (PStructure (Maybe a)) where
       placements <- v .:? "placements" .!= []
       waypointDefs <- v .:? "waypoints" .!= []
       maybeMaskChar <- v .:? "mask"
-      rawGrid <- v .:? "map" .!= Grid []
+      rawGrid <- v .:? "map" .!= emptyGrid
       (maskedArea, mapWaypoints) <- paintMap maybeMaskChar pal rawGrid
       let area = PositionedGrid origin maskedArea
           waypoints = waypointDefs <> mapWaypoints

src/swarm-topography/Swarm/Game/Scenario/Topography/Structure/Overlay.hs

@@ -71,11 +71,11 @@ zipGridRows ::
   OverlayPair (Grid (f a)) ->
   Grid (f a)
 zipGridRows dims (OverlayPair (Grid paddedBaseRows) (Grid paddedOverlayRows)) =
-  mapRows (pad2D paddedBaseRows . pad2D paddedOverlayRows) emptyGrid
+  mapRows (pad2D paddedBaseRows . pad2D paddedOverlayRows) blankGrid
  where
   -- Right-bias; that is, take the last non-empty value
   pad2D = zipPadded $ zipPadded $ flip (<|>)
-  emptyGrid = fillGrid dims empty
+  blankGrid = fillGrid dims empty
 
 -- |
 -- First arg: base layer

src/swarm-tui/Swarm/TUI/Editor/Palette.hs

@@ -50,7 +50,7 @@ makeSuggestedPalette tm originalScenarioPalette cellGrid =
     -- NOTE: the left-most maps take precedence!
     $ paletteCellsByKey <> pairsWithDisplays <> terrainOnlyPalette
  where
-  cellList = concatMap catMaybes $ unGrid cellGrid
+  cellList = catMaybes $ allMembers cellGrid
 
   getMaybeEntityDisplay :: PCell EntityFacade -> Maybe (EntityName, Display)
   getMaybeEntityDisplay (Cell _terrain (erasableToMaybe -> maybeEntity) _) = do

src/swarm-tui/Swarm/TUI/Editor/Util.hs

@@ -107,7 +107,7 @@ getEditedMapRectangle ::
   Maybe (Cosmic BoundsRectangle) ->
   W.MultiWorld Int Entity ->
   EA.Grid CellPaintDisplay
-getEditedMapRectangle _ _ Nothing _ = EA.Grid []
+getEditedMapRectangle _ _ Nothing _ = EA.emptyGrid
 getEditedMapRectangle tm worldEditor (Just (Cosmic subworldName coords)) w =
   getMapRectangle toFacade getContent coords
  where