Use rich entity modification info (#1604)

This is a refactoring that is a prerequisite for both #1579 and #1595.

src/Swarm/Game/Step/Util.hs

@@ -13,14 +13,13 @@ import Control.Effect.Error
 import Control.Effect.Lens
 import Control.Effect.Lift
 import Control.Lens as Lens hiding (Const, distrib, from, parts, use, uses, view, (%=), (+=), (.=), (<+=), (<>=))
-import Control.Monad (forM, guard, join, when)
+import Control.Monad (forM, forM_, guard, join, when)
 import Control.Monad.Trans.Class (lift)
 import Control.Monad.Trans.Maybe (MaybeT (..), runMaybeT)
 import Data.Array (bounds, (!))
 import Data.IntMap qualified as IM
 import Data.List (find)
 import Data.Map qualified as M
-import Data.Maybe (fromMaybe)
 import Data.Set qualified as S
 import Data.Text (Text)
 import Data.Text qualified as T
@@ -33,6 +32,7 @@ import Swarm.Game.Robot
 import Swarm.Game.State
 import Swarm.Game.Universe
 import Swarm.Game.World qualified as W
+import Swarm.Game.World.Modify qualified as WM
 import Swarm.Language.Capability
 import Swarm.Language.Requirement qualified as R
 import Swarm.Language.Syntax
@@ -68,11 +68,11 @@ updateEntityAt ::
   (Maybe Entity -> Maybe Entity) ->
   m ()
 updateEntityAt cLoc@(Cosmic subworldName loc) upd = do
-  didChange <-
-    fmap (fromMaybe False) $
-      zoomWorld subworldName $
-        W.updateM @Int (W.locToCoords loc) upd
-  when didChange $
+  someChange <-
+    zoomWorld subworldName $
+      W.updateM @Int (W.locToCoords loc) upd
+
+  forM_ (WM.getModification =<< someChange) $ \_modType -> do
     wakeWatchingRobots cLoc
 
 -- * Capabilities

src/Swarm/Game/World.hs

@@ -59,18 +59,18 @@ import Data.Array.Unboxed qualified as U
 import Data.Bifunctor (second)
 import Data.Bits
 import Data.Foldable (foldl')
-import Data.Function (on)
 import Data.Int (Int32)
 import Data.Map (Map)
 import Data.Map.Strict qualified as M
 import Data.Semigroup (Last (..))
 import Data.Yaml (FromJSON, ToJSON)
 import GHC.Generics (Generic)
-import Swarm.Game.Entity (Entity, entityHash)
+import Swarm.Game.Entity (Entity)
 import Swarm.Game.Location
 import Swarm.Game.Terrain (TerrainType (BlankT))
 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)
@@ -265,9 +265,9 @@ update ::
   Coords ->
   (Maybe Entity -> Maybe Entity) ->
   World t Entity ->
-  (World t Entity, Bool)
+  (World t Entity, CellUpdate Entity)
 update i g w@(World f t m) =
-  (wNew, ((/=) `on` fmap (view entityHash)) entityAfter entityBefore)
+  (wNew, classifyModification entityBefore entityAfter)
  where
   wNew = World f t $ M.insert i entityAfter m
   entityBefore = lookupEntity i w
@@ -280,7 +280,7 @@ updateM ::
   (Has (State (World t Entity)) sig m, IArray U.UArray t) =>
   Coords ->
   (Maybe Entity -> Maybe Entity) ->
-  m Bool
+  m (CellUpdate Entity)
 updateM c g = do
   state @(World t Entity) $ update c g . loadCell c
 

src/Swarm/Game/World/Modify.hs

@@ -0,0 +1,40 @@
+-- |
+-- SPDX-License-Identifier: BSD-3-Clause
+--
+-- 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
+
+import Control.Lens (view)
+import Data.Function (on)
+import Swarm.Game.Entity (Entity, entityHash)
+
+-- | Compare to 'WorldUpdate' in "Swarm.Game.World"
+data CellUpdate e
+  = NoChange (Maybe e)
+  | Modified (CellModification e)
+
+getModification :: CellUpdate e -> Maybe (CellModification e)
+getModification (NoChange _) = Nothing
+getModification (Modified x) = Just x
+
+data CellModification e
+  = -- | Fields represent what existed in the cell "before" and "after", in that order.
+    Swap e e
+  | Remove e
+  | Add e
+
+classifyModification ::
+  -- | before
+  Maybe Entity ->
+  -- | 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
+    then Modified $ Swap x y
+    else NoChange $ Just x

swarm.cabal

@@ -166,6 +166,7 @@ library
                       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