From d3cecf6434094a607f1472bf1d3d99c9f00726ea Mon Sep 17 00:00:00 2001
From: Karl Ostmo <kostmo@gmail.com>
Date: Sat, 28 Dec 2024 23:04:00 -0800
Subject: [PATCH] generic cell modification

---
 src/swarm-engine/Swarm/Game/Step/Util.hs      |  2 +-
 src/swarm-scenario/Swarm/Game/World.hs        |  6 ++---
 .../Swarm/Game/Scenario/Topography}/Modify.hs | 22 +++++++++----------
 swarm.cabal                                   |  2 +-
 4 files changed, 16 insertions(+), 16 deletions(-)
 rename src/{swarm-scenario/Swarm/Game/World => swarm-topography/Swarm/Game/Scenario/Topography}/Modify.hs (62%)

diff --git a/src/swarm-engine/Swarm/Game/Step/Util.hs b/src/swarm-engine/Swarm/Game/Step/Util.hs
index 706301eb3..b9ae0424f 100644
--- a/src/swarm-engine/Swarm/Game/Step/Util.hs
+++ b/src/swarm-engine/Swarm/Game/Step/Util.hs
@@ -28,6 +28,7 @@ import Swarm.Game.Entity hiding (empty, lookup, singleton, union)
 import Swarm.Game.Exception
 import Swarm.Game.Location
 import Swarm.Game.Robot
+import Swarm.Game.Scenario.Topography.Modify qualified as WM
 import Swarm.Game.Scenario.Topography.Structure.Recognition.Tracking qualified as SRT
 import Swarm.Game.State
 import Swarm.Game.State.Landscape (recognizerAutomatons)
@@ -40,7 +41,6 @@ import Swarm.Game.Step.RobotStepState
 import Swarm.Game.Universe
 import Swarm.Game.World qualified as W
 import Swarm.Game.World.Coords
-import Swarm.Game.World.Modify qualified as WM
 import Swarm.Language.Capability
 import Swarm.Language.Requirements.Type qualified as R
 import Swarm.Language.Syntax
diff --git a/src/swarm-scenario/Swarm/Game/World.hs b/src/swarm-scenario/Swarm/Game/World.hs
index 2e443a397..d72aac99c 100644
--- a/src/swarm-scenario/Swarm/Game/World.hs
+++ b/src/swarm-scenario/Swarm/Game/World.hs
@@ -63,12 +63,12 @@ import Data.Maybe (fromMaybe)
 import Data.Semigroup (Last (..))
 import Data.Yaml (FromJSON, ToJSON)
 import GHC.Generics (Generic)
-import Swarm.Game.Entity (Entity)
+import Swarm.Game.Entity (Entity, entityHash)
 import Swarm.Game.Location
+import Swarm.Game.Scenario.Topography.Modify
 import Swarm.Game.Terrain (TerrainMap, TerrainType (BlankT), terrainByIndex, terrainName)
 import Swarm.Game.Universe
 import Swarm.Game.World.Coords
-import Swarm.Game.World.Modify
 import Swarm.Util ((?))
 import Swarm.Util.Erasable
 import Prelude hiding (lookup)
@@ -278,7 +278,7 @@ update ::
   World t Entity ->
   (World t Entity, CellUpdate Entity)
 update i g w@(World f t m) =
-  (wNew, classifyModification entityBefore entityAfter)
+  (wNew, classifyModification (view entityHash) entityBefore entityAfter)
  where
   wNew = World f t $ M.insert i entityAfter m
   entityBefore = lookupEntity i w
diff --git a/src/swarm-scenario/Swarm/Game/World/Modify.hs b/src/swarm-topography/Swarm/Game/Scenario/Topography/Modify.hs
similarity index 62%
rename from src/swarm-scenario/Swarm/Game/World/Modify.hs
rename to src/swarm-topography/Swarm/Game/Scenario/Topography/Modify.hs
index 5a1167f92..1dd157a33 100644
--- a/src/swarm-scenario/Swarm/Game/World/Modify.hs
+++ b/src/swarm-topography/Swarm/Game/Scenario/Topography/Modify.hs
@@ -4,11 +4,9 @@
 -- Captures the various possibilities of cell
 -- modification as a sum type for use by the structure recognizer
 -- (see 'Swarm.Game.Scenario.Topography.Structure.Recognition.Tracking.entityModified').
-module Swarm.Game.World.Modify where
+module Swarm.Game.Scenario.Topography.Modify where
 
-import Control.Lens (view)
 import Data.Function (on)
-import Swarm.Game.Entity (Entity, entityHash)
 import Swarm.Game.Scenario.Topography.Terraform
 
 -- | Compare to 'WorldUpdate' in "Swarm.Game.World"
@@ -21,15 +19,17 @@ getModification (NoChange _) = Nothing
 getModification (Modified x) = Just x
 
 classifyModification ::
+  Eq b =>
+  (a -> b) ->
   -- | before
-  Maybe Entity ->
+  Maybe a ->
   -- | after
-  Maybe Entity ->
-  CellUpdate Entity
-classifyModification Nothing Nothing = NoChange Nothing
-classifyModification Nothing (Just x) = Modified $ Add x
-classifyModification (Just x) Nothing = Modified $ Remove x
-classifyModification (Just x) (Just y) =
-  if ((/=) `on` view entityHash) x y
+  Maybe a ->
+  CellUpdate a
+classifyModification _ Nothing Nothing = NoChange Nothing
+classifyModification _ Nothing (Just x) = Modified $ Add x
+classifyModification _ (Just x) Nothing = Modified $ Remove x
+classifyModification f (Just x) (Just y) =
+  if ((/=) `on` f) x y
     then Modified $ Swap x y
     else NoChange $ Just x
diff --git a/swarm.cabal b/swarm.cabal
index ad8e25b49..7027dfd5d 100644
--- a/swarm.cabal
+++ b/swarm.cabal
@@ -522,6 +522,7 @@ library swarm-topography
     Swarm.Game.Location
     Swarm.Game.Scenario.Topography.Area
     Swarm.Game.Scenario.Topography.Grid
+    Swarm.Game.Scenario.Topography.Modify
     Swarm.Game.Scenario.Topography.Navigation.Waypoint
     Swarm.Game.Scenario.Topography.Placement
     Swarm.Game.Scenario.Topography.ProtoCell
@@ -635,7 +636,6 @@ library swarm-scenario
     Swarm.Game.World.Gen
     Swarm.Game.World.Interpret
     Swarm.Game.World.Load
-    Swarm.Game.World.Modify
     Swarm.Game.World.Parse
     Swarm.Game.World.Render
     Swarm.Game.World.Syntax