generic cell modification (#2247)

Makes the `classifyModification` function generic with type parameters, so that it can be moved "up" to the `swarm-topography` sublibrary.

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

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 (Foldable (..), 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

src/swarm-scenario/Swarm/Game/World/Modify.hs → 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

swarm.cabal

@@ -523,6 +523,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
@@ -636,7 +637,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