reorganization

src/swarm-scenario/Swarm/Game/Scenario/Topography/Structure/Recognition/Precompute.hs

@@ -54,8 +54,8 @@ import Data.Set qualified as Set
 import Data.Tuple (swap)
 import Swarm.Game.Entity (Entity, EntityName, entityName)
 import Swarm.Game.Scenario (StaticStructureInfo (..))
-import Swarm.Game.Scenario.Topography.Area (Grid, getRows)
 import Swarm.Game.Scenario.Topography.Cell (PCell, cellEntity)
+import Swarm.Game.Scenario.Topography.Grid (Grid, getRows)
 import Swarm.Game.Scenario.Topography.Placement (Orientation (..), applyOrientationTransform)
 import Swarm.Game.Scenario.Topography.Structure
 import Swarm.Game.Scenario.Topography.Structure.Recognition.Registry

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

@@ -18,9 +18,9 @@ import Swarm.Game.Entity
 import Swarm.Game.Land
 import Swarm.Game.Location
 import Swarm.Game.Scenario.RobotLookup
-import Swarm.Game.Scenario.Topography.Area (Grid (EmptyGrid))
 import Swarm.Game.Scenario.Topography.Cell
 import Swarm.Game.Scenario.Topography.EntityFacade
+import Swarm.Game.Scenario.Topography.Grid (Grid (EmptyGrid))
 import Swarm.Game.Scenario.Topography.Navigation.Portal
 import Swarm.Game.Scenario.Topography.Navigation.Waypoint (
   Parentage (Root),

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

@@ -13,9 +13,9 @@ import Data.Set qualified as Set
 import Data.Text qualified as T
 import Data.Tuple (swap)
 import Swarm.Game.Entity
-import Swarm.Game.Scenario.Topography.Area
 import Swarm.Game.Scenario.Topography.Cell
 import Swarm.Game.Scenario.Topography.EntityFacade
+import Swarm.Game.Scenario.Topography.Grid
 import Swarm.Game.Scenario.Topography.ProtoCell
 import Swarm.Game.Terrain (TerrainType)
 import Swarm.Util.Erasable

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

@@ -40,6 +40,7 @@ import Swarm.Game.Location
 import Swarm.Game.Robot (TRobot, trobotLocation)
 import Swarm.Game.Scenario
 import Swarm.Game.Scenario.Topography.Area
+import Swarm.Game.Scenario.Topography.Grid
 import Swarm.Game.Scenario.Topography.Navigation.Portal (Navigation (..))
 import Swarm.Game.Scenario.Topography.Structure.Overlay
 import Swarm.Game.State.Config

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

@@ -26,6 +26,7 @@ import Swarm.Game.Scenario.Topography.Area
 import Swarm.Game.Scenario.Topography.Cell
 import Swarm.Game.Scenario.Topography.Center
 import Swarm.Game.Scenario.Topography.EntityFacade (EntityFacade (..), mkFacade)
+import Swarm.Game.Scenario.Topography.Grid
 import Swarm.Game.Scenario.Topography.Rasterize
 import Swarm.Game.Scenario.Topography.Structure.Overlay
 import Swarm.Game.State.Landscape

src/swarm-scenario/Swarm/Util/Content.hs

@@ -11,9 +11,9 @@ import Data.Map qualified as M
 import Data.Text qualified as T
 import Swarm.Game.Display
 import Swarm.Game.Entity.Cosmetic
-import Swarm.Game.Scenario.Topography.Area qualified as EA
 import Swarm.Game.Scenario.Topography.Cell (PCell (..))
 import Swarm.Game.Scenario.Topography.EntityFacade
+import Swarm.Game.Scenario.Topography.Grid
 import Swarm.Game.Terrain (TerrainMap, TerrainType, getTerrainWord)
 import Swarm.Game.Universe
 import Swarm.Game.World
@@ -36,9 +36,9 @@ getMapRectangle ::
   (d -> e) ->
   (Coords -> (TerrainType, Maybe d)) ->
   BoundsRectangle ->
-  EA.Grid (PCell e)
+  Grid (PCell e)
 getMapRectangle paintTransform contentFunc coords =
-  EA.mkGrid $ map renderRow [yTop .. yBottom]
+  mkGrid $ map renderRow [yTop .. yBottom]
  where
   (Coords (yTop, xLeft), Coords (yBottom, xRight)) = coords
 

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

@@ -4,66 +4,24 @@
 -- SPDX-License-Identifier: BSD-3-Clause
 module Swarm.Game.Scenario.Topography.Area where
 
-import Data.Aeson (ToJSON (..))
 import Data.Int (Int32)
 import Data.List qualified as L
-import Data.List.NonEmpty (NonEmpty)
-import Data.List.NonEmpty qualified as NE
-import Data.Maybe (fromMaybe, listToMaybe)
+import Data.Maybe (listToMaybe)
 import Data.Semigroup
 import Linear (V2 (..))
 import Swarm.Game.Location
-import Swarm.Game.World.Coords
+import Swarm.Game.Scenario.Topography.Grid
 import Prelude hiding (zipWith)
 
-data Grid c
-  = EmptyGrid
-  | Grid (NonEmpty (NonEmpty c))
-  deriving (Show, Eq, Functor, Foldable, Traversable)
-
-mkGrid :: [[a]] -> Grid a
-mkGrid rows = fromMaybe EmptyGrid $ do
-  rowsNE <- NE.nonEmpty =<< mapM NE.nonEmpty rows
-  return $ Grid rowsNE
-
-getRows :: Grid a -> [[a]]
-getRows EmptyGrid = []
-getRows (Grid g) = NE.toList . NE.map NE.toList $ 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.
-mapRows :: (NonEmpty (NonEmpty a) -> NonEmpty (NonEmpty b)) -> Grid a -> Grid b
-mapRows _ EmptyGrid = EmptyGrid
-mapRows f (Grid rows) = Grid $ f rows
-
-allMembers :: Grid a -> [a]
-allMembers EmptyGrid = []
-allMembers g = concat . getRows $ g
-
-mapIndexedMembers :: (Coords -> a -> b) -> Grid a -> [b]
-mapIndexedMembers _ EmptyGrid = []
-mapIndexedMembers f (Grid g) =
-  NE.toList $
-    sconcat $
-      NE.zipWith (\i -> NE.zipWith (\j -> f (Coords (i, j))) nonemptyCount) nonemptyCount g
- where
-  nonemptyCount = NE.iterate succ 0
-
-instance (ToJSON a) => ToJSON (Grid a) where
-  toJSON EmptyGrid = toJSON ([] :: [a])
-  toJSON (Grid g) = toJSON g
-
-getGridDimensions :: Grid a -> AreaDimensions
-getGridDimensions EmptyGrid = AreaDimensions 0 0
-getGridDimensions g = getAreaDimensions $ getRows g
-
 -- | Height and width of a 2D map region
 data AreaDimensions = AreaDimensions
   { rectWidth :: Int32
   , rectHeight :: Int32
   }
 
+getGridDimensions :: Grid a -> AreaDimensions
+getGridDimensions g = getAreaDimensions $ getRows g
+
 asTuple :: AreaDimensions -> (Int32, Int32)
 asTuple (AreaDimensions x y) = (x, y)
 

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

@@ -0,0 +1,65 @@
+-- |
+-- SPDX-License-Identifier: BSD-3-Clause
+module Swarm.Game.Scenario.Topography.Grid (
+  Grid (..),
+  gridToVec,
+  mapIndexedMembers,
+  allMembers,
+  mapRows,
+  getRows,
+  mkGrid,
+)
+where
+
+import Data.Aeson (ToJSON (..))
+import Data.List.NonEmpty (NonEmpty)
+import Data.List.NonEmpty qualified as NE
+import Data.Maybe (fromMaybe)
+import Data.Semigroup
+import Data.Vector qualified as V
+import Swarm.Game.World.Coords
+import Prelude hiding (zipWith)
+
+data Grid c
+  = EmptyGrid
+  | Grid (NonEmpty (NonEmpty c))
+  deriving (Show, Eq, Functor, Foldable, Traversable)
+
+mkGrid :: [[a]] -> Grid a
+mkGrid rows = fromMaybe EmptyGrid $ do
+  rowsNE <- NE.nonEmpty =<< mapM NE.nonEmpty rows
+  return $ Grid rowsNE
+
+getRows :: Grid a -> [[a]]
+getRows EmptyGrid = []
+getRows (Grid g) = NE.toList . NE.map NE.toList $ 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.
+mapRows :: (NonEmpty (NonEmpty a) -> NonEmpty (NonEmpty b)) -> Grid a -> Grid b
+mapRows _ EmptyGrid = EmptyGrid
+mapRows f (Grid rows) = Grid $ f rows
+
+allMembers :: Grid a -> [a]
+allMembers EmptyGrid = []
+allMembers g = concat . getRows $ g
+
+mapIndexedMembers :: (Coords -> a -> b) -> Grid a -> [b]
+mapIndexedMembers _ EmptyGrid = []
+mapIndexedMembers f (Grid g) =
+  NE.toList $
+    sconcat $
+      NE.zipWith (\i -> NE.zipWith (\j -> f (Coords (i, j))) nonemptyCount) nonemptyCount g
+ where
+  nonemptyCount = NE.iterate succ 0
+
+-- | Converts linked lists to vectors to facilitate
+-- random access when assembling the image
+gridToVec :: Grid a -> V.Vector (V.Vector a)
+gridToVec EmptyGrid = V.empty
+gridToVec (Grid g) = V.fromList . map (V.fromList . NE.toList) $ NE.toList g
+
+instance (ToJSON a) => ToJSON (Grid a) where
+  toJSON EmptyGrid = toJSON ([] :: [a])
+  toJSON (Grid g) = toJSON g

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

@@ -14,6 +14,7 @@ import Data.Yaml as Y
 import GHC.Generics (Generic)
 import Swarm.Game.Location
 import Swarm.Game.Scenario.Topography.Area
+import Swarm.Game.Scenario.Topography.Grid
 import Swarm.Language.Syntax.Direction (AbsoluteDir (..))
 
 newtype StructureName = StructureName Text

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

@@ -5,15 +5,9 @@
 module Swarm.Game.Scenario.Topography.Rasterize where
 
 import Codec.Picture
-import Data.List.NonEmpty qualified as NE
 import Data.Vector qualified as V
 import Swarm.Game.Scenario.Topography.Area
-
--- | Converts linked lists to vectors to facilitate
--- random access when assembling the image
-gridToVec :: Grid a -> V.Vector (V.Vector a)
-gridToVec EmptyGrid = V.empty
-gridToVec (Grid g) = V.fromList . map (V.fromList . NE.toList) $ NE.toList g
+import Swarm.Game.Scenario.Topography.Grid
 
 makeImage :: Pixel px => (a -> px) -> Grid a -> Image px
 makeImage computeColor g =

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

@@ -21,7 +21,7 @@ import Data.Text (Text)
 import Data.Text qualified as T
 import Data.Yaml as Y
 import Swarm.Game.Location
-import Swarm.Game.Scenario.Topography.Area
+import Swarm.Game.Scenario.Topography.Grid
 import Swarm.Game.Scenario.Topography.Navigation.Waypoint
 import Swarm.Game.Scenario.Topography.Placement
 import Swarm.Game.Scenario.Topography.ProtoCell

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

@@ -22,6 +22,7 @@ import Data.Text qualified as T
 import Linear.Affine
 import Swarm.Game.Location
 import Swarm.Game.Scenario.Topography.Area
+import Swarm.Game.Scenario.Topography.Grid
 import Swarm.Game.Scenario.Topography.Navigation.Waypoint
 import Swarm.Game.Scenario.Topography.Placement
 import Swarm.Game.Scenario.Topography.Structure

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

@@ -15,6 +15,7 @@ import Data.Tuple (swap)
 import Linear
 import Swarm.Game.Location
 import Swarm.Game.Scenario.Topography.Area
+import Swarm.Game.Scenario.Topography.Grid
 import Swarm.Util (applyWhen)
 
 data PositionedGrid a = PositionedGrid

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

@@ -26,6 +26,7 @@ import Swarm.Game.Scenario
 import Swarm.Game.Scenario.Topography.Area
 import Swarm.Game.Scenario.Topography.Cell
 import Swarm.Game.Scenario.Topography.EntityFacade
+import Swarm.Game.Scenario.Topography.Grid
 import Swarm.Game.Scenario.Topography.Navigation.Portal (Navigation (..))
 import Swarm.Game.Scenario.Topography.ProtoCell
 import Swarm.Game.Scenario.Topography.Structure.Overlay

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

@@ -13,6 +13,7 @@ import Swarm.Game.Entity
 import Swarm.Game.Scenario.Topography.Area qualified as EA
 import Swarm.Game.Scenario.Topography.Cell
 import Swarm.Game.Scenario.Topography.EntityFacade
+import Swarm.Game.Scenario.Topography.Grid
 import Swarm.Game.Scenario.Topography.Structure.Overlay
 import Swarm.Game.Scenario.Topography.WorldDescription
 import Swarm.Game.Terrain (TerrainMap, TerrainType)
@@ -106,8 +107,8 @@ getEditedMapRectangle ::
   WorldOverdraw ->
   Maybe (Cosmic BoundsRectangle) ->
   W.MultiWorld Int Entity ->
-  EA.Grid CellPaintDisplay
-getEditedMapRectangle _ _ Nothing _ = EA.EmptyGrid
+  Grid CellPaintDisplay
+getEditedMapRectangle _ _ Nothing _ = EmptyGrid
 getEditedMapRectangle tm worldEditor (Just (Cosmic subworldName coords)) w =
   getMapRectangle toFacade getContent coords
  where

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

@@ -14,7 +14,8 @@ import Servant.Docs qualified as SD
 import Swarm.Game.Entity.Cosmetic (RGBColor, flattenBg)
 import Swarm.Game.Scenario (Scenario, scenarioCosmetics, scenarioLandscape)
 import Swarm.Game.Scenario.Style
-import Swarm.Game.Scenario.Topography.Area (AreaDimensions (..), Grid)
+import Swarm.Game.Scenario.Topography.Area (AreaDimensions (..))
+import Swarm.Game.Scenario.Topography.Grid (Grid)
 import Swarm.Game.State (GameState, landscape, robotInfo)
 import Swarm.Game.State.Robot (viewCenter)
 import Swarm.Game.Universe (planar)

swarm.cabal

@@ -211,6 +211,7 @@ library swarm-topography
   exposed-modules:
     Swarm.Game.Location
     Swarm.Game.Scenario.Topography.Area
+    Swarm.Game.Scenario.Topography.Grid
     Swarm.Game.Scenario.Topography.Navigation.Waypoint
     Swarm.Game.Scenario.Topography.Placement
     Swarm.Game.Scenario.Topography.ProtoCell

test/unit/TestOverlay.hs

@@ -7,7 +7,7 @@
 module TestOverlay where
 
 import Swarm.Game.Location
-import Swarm.Game.Scenario.Topography.Area
+import Swarm.Game.Scenario.Topography.Grid
 import Swarm.Game.Scenario.Topography.Structure.Overlay
 import Test.Tasty
 import Test.Tasty.HUnit