More generic structure recognition (#2112)

Builds upon #1836.

Most importantly in this PR, the `Swarm.Game.Scenario.Topography.Structure.Recognition.Tracking` module is made generic in its `Entity` parameter, and is now able to be moved from the `swarm-engine` sublibrary to the `swarm-topology` sublibrary.

I've also introduced an intermediate `RecognitionState` record inside `StructureRecognizer` to distinguish between the stateful and read-only elements.

The `AhoCorasick` dependency is now reduced to only one sublibrary.

src/swarm-engine/Swarm/Game/State.hs

@@ -66,6 +66,7 @@ module Swarm.Game.State (
   genMultiWorld,
   genRobotTemplates,
   entityAt,
+  mtlEntityAt,
   contentAt,
   zoomWorld,
   zoomRobots,
@@ -78,6 +79,7 @@ import Control.Effect.State (State)
 import Control.Effect.Throw
 import Control.Lens hiding (Const, use, uses, view, (%=), (+=), (.=), (<+=), (<<.=))
 import Control.Monad (forM, join)
+import Control.Monad.Trans.State.Strict qualified as TS
 import Data.Aeson (ToJSON)
 import Data.Digest.Pure.SHA (sha1, showDigest)
 import Data.Foldable (toList)
@@ -94,6 +96,7 @@ import Data.Text qualified as T (drop, take)
 import Data.Text.IO qualified as TIO
 import Data.Text.Lazy qualified as TL
 import Data.Text.Lazy.Encoding qualified as TL
+import Data.Tuple (swap)
 import GHC.Generics (Generic)
 import Swarm.Game.CESK (Store, emptyStore, store, suspendedEnv)
 import Swarm.Game.Entity
@@ -473,6 +476,15 @@ initGameState gsc =
     , _messageInfo = initMessages
     }
 
+-- | Provide an entity accessor via the MTL transformer State API.
+-- This is useful for the structure recognizer.
+mtlEntityAt :: Cosmic Location -> TS.State GameState (Maybe Entity)
+mtlEntityAt = TS.state . runGetEntity
+ where
+  runGetEntity :: Cosmic Location -> GameState -> (Maybe Entity, GameState)
+  runGetEntity loc gs =
+    swap . run . Fused.runState gs $ entityAt loc
+
 -- | Get the entity (if any) at a given location.
 entityAt :: (Has (State GameState) sig m) => Cosmic Location -> m (Maybe Entity)
 entityAt (Cosmic subworldName loc) =

src/swarm-engine/Swarm/Game/State/Initialize.hs

@@ -182,9 +182,10 @@ mkRecognizer ::
 mkRecognizer structInfo@(StaticStructureInfo structDefs _) = do
   foundIntact <- mapM (sequenceA . (id &&& ensureStructureIntact)) allPlaced
   let fs = populateStaticFoundStructures . map fst . filter snd $ foundIntact
-  return $
-    StructureRecognizer
+  return
+    $ StructureRecognizer
       (mkAutomatons structDefs)
+    $ RecognitionState
       fs
       [IntactStaticPlacement $ map mkLogEntry foundIntact]
  where

src/swarm-engine/Swarm/Game/State/Substate.hs

@@ -428,7 +428,10 @@ initDiscovery =
     , -- This does not need to be initialized with anything,
       -- since the master list of achievements is stored in UIState
       _gameAchievements = mempty
-    , _structureRecognition = StructureRecognizer (RecognizerAutomatons mempty mempty) emptyFoundStructures []
+    , _structureRecognition =
+        StructureRecognizer
+          (RecognizerAutomatons mempty mempty)
+          (RecognitionState emptyFoundStructures [])
     , _tagMembers = mempty
     }
 

src/swarm-engine/Swarm/Game/Step/Const.hs

@@ -64,7 +64,7 @@ import Swarm.Game.Scenario.Topography.Area (getAreaDimensions)
 import Swarm.Game.Scenario.Topography.Navigation.Portal (Navigation (..))
 import Swarm.Game.Scenario.Topography.Navigation.Util
 import Swarm.Game.Scenario.Topography.Navigation.Waypoint (WaypointName (..))
-import Swarm.Game.Scenario.Topography.Structure.Recognition (automatons, foundStructures)
+import Swarm.Game.Scenario.Topography.Structure.Recognition (automatons, foundStructures, recognitionState)
 import Swarm.Game.Scenario.Topography.Structure.Recognition.Registry (foundByName)
 import Swarm.Game.Scenario.Topography.Structure.Recognition.Type
 import Swarm.Game.State
@@ -567,7 +567,7 @@ execConst runChildProg c vs s k = do
       _ -> badConst
     Structure -> case vs of
       [VText name, VInt idx] -> do
-        registry <- use $ discovery . structureRecognition . foundStructures
+        registry <- use $ discovery . structureRecognition . recognitionState . foundStructures
         let maybeFoundStructures = M.lookup name $ foundByName registry
             mkOutput mapNE = (NE.length xs, bottomLeftCorner)
              where

src/swarm-engine/Swarm/Game/Step/Path/Cache.hs

@@ -44,6 +44,7 @@ import Swarm.Game.Entity
 import Swarm.Game.Location
 import Swarm.Game.Robot
 import Swarm.Game.Robot.Walk
+import Swarm.Game.Scenario.Topography.Terraform
 import Swarm.Game.State
 import Swarm.Game.Step.Path.Cache.DistanceLimit
 import Swarm.Game.Step.Path.Type
@@ -51,7 +52,6 @@ import Swarm.Game.Step.Path.Walkability (checkUnwalkable)
 import Swarm.Game.Step.RobotStepState
 import Swarm.Game.Step.Util.Inspect (robotWithID)
 import Swarm.Game.Universe (Cosmic (..), SubworldName)
-import Swarm.Game.World.Modify
 import Swarm.Util (prependList, tails1)
 import Swarm.Util.RingBuffer qualified as RB
 

src/swarm-engine/Swarm/Game/Step/Util.hs

@@ -16,6 +16,7 @@ import Control.Effect.Lens
 import Control.Monad (forM_, guard, when)
 import Control.Monad.Trans.Class (lift)
 import Control.Monad.Trans.Maybe (MaybeT (..), runMaybeT)
+import Control.Monad.Trans.State.Strict qualified as TS
 import Data.Array (bounds, (!))
 import Data.IntMap qualified as IM
 import Data.Set qualified as S
@@ -76,7 +77,15 @@ updateEntityAt cLoc@(Cosmic subworldName loc) upd = do
     currentTick <- use $ temporal . ticks
     myID <- use robotID
     zoomRobots $ wakeWatchingRobots myID currentTick cLoc
-    SRT.entityModified modType cLoc
+    oldRecognizer <- use $ discovery . structureRecognition
+
+    oldGS <- get @GameState
+    let (newRecognizer, newGS) =
+          flip TS.runState oldGS $
+            SRT.entityModified mtlEntityAt modType cLoc oldRecognizer
+    put newGS
+
+    discovery . structureRecognition .= newRecognizer
 
     pcr <- use $ pathCaching . pathCachingRobots
     mapM_ (revalidatePathCache cLoc modType) $ IM.toList pcr

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

@@ -9,6 +9,7 @@ module Swarm.Game.World.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"
 data CellUpdate e
@@ -19,13 +20,6 @@ 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.
-    -- The values are guaranteed to be different.
-    Swap e e
-  | Remove e
-  | Add e
-
 classifyModification ::
   -- | before
   Maybe Entity ->

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

@@ -12,14 +12,24 @@ import Swarm.Game.Scenario.Topography.Structure.Recognition.Log
 import Swarm.Game.Scenario.Topography.Structure.Recognition.Registry
 import Swarm.Game.Scenario.Topography.Structure.Recognition.Type
 
+-- | State of the structure recognizer that is intended
+-- to be modifiable.
+data RecognitionState b a = RecognitionState
+  { _foundStructures :: FoundRegistry b a
+  -- ^ Records the top-left corner of the found structure
+  , _recognitionLog :: [SearchLog a]
+  }
+
+makeLenses ''RecognitionState
+
 -- |
 -- The type parameters, `b`, and `a`, correspond
 -- to 'StructureCells' and 'Entity', respectively.
 data StructureRecognizer b a = StructureRecognizer
   { _automatons :: RecognizerAutomatons b a
-  , _foundStructures :: FoundRegistry b a
-  -- ^ Records the top-left corner of the found structure
-  , _recognitionLog :: [SearchLog a]
+  -- ^ read-only
+  , _recognitionState :: RecognitionState b a
+  -- ^ mutatable
   }
   deriving (Generic)
 

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

@@ -9,10 +9,9 @@ module Swarm.Game.Scenario.Topography.Structure.Recognition.Tracking (
   entityModified,
 ) where
 
-import Control.Carrier.State.Lazy
-import Control.Effect.Lens
-import Control.Lens ((^.))
-import Control.Monad (forM, forM_, guard)
+import Control.Lens ((%~), (&), (.~), (^.))
+import Control.Monad (forM, guard)
+import Control.Monad.Trans.Maybe (MaybeT (..), runMaybeT)
 import Data.HashMap.Strict qualified as HM
 import Data.HashSet (HashSet)
 import Data.HashSet qualified as HS
@@ -25,19 +24,23 @@ import Data.Maybe (listToMaybe)
 import Data.Ord (Down (..))
 import Data.Semigroup (Max (..), Min (..))
 import Linear (V2 (..))
-import Swarm.Game.Entity (Entity)
 import Swarm.Game.Location (Location)
-import Swarm.Game.Scenario (StructureCells)
 import Swarm.Game.Scenario.Topography.Structure.Recognition
 import Swarm.Game.Scenario.Topography.Structure.Recognition.Log
 import Swarm.Game.Scenario.Topography.Structure.Recognition.Registry
 import Swarm.Game.Scenario.Topography.Structure.Recognition.Type
-import Swarm.Game.State
-import Swarm.Game.State.Substate
+import Swarm.Game.Scenario.Topography.Terraform
 import Swarm.Game.Universe
-import Swarm.Game.World.Modify
 import Text.AhoCorasick
 
+-- | Interface that provides monadic access to
+-- querying entities at locations.
+-- The provider may be a 'State' monad or just
+-- a 'Reader'.
+--
+-- 's' is the state variable, 'a' is the return type.
+type GenericEntLocator s a = Cosmic Location -> s (Maybe a)
+
 -- | A hook called from the centralized entity update function,
 -- 'Swarm.Game.Step.Util.updateEntityAt'.
 --
@@ -45,31 +48,47 @@ import Text.AhoCorasick
 -- and structure de-registration upon removal of an entity.
 -- Also handles atomic entity swaps.
 entityModified ::
-  (Has (State GameState) sig m) =>
-  CellModification Entity ->
+  (Monad s, Hashable a, Eq b) =>
+  GenericEntLocator s a ->
+  CellModification a ->
   Cosmic Location ->
-  m ()
-entityModified modification cLoc = do
+  StructureRecognizer b a ->
+  s (StructureRecognizer b a)
+entityModified entLoader modification cLoc recognizer =
   case modification of
-    Add newEntity -> doAddition newEntity
+    Add newEntity -> doAddition newEntity recognizer
     Remove _ -> doRemoval
-    Swap _ newEntity -> doRemoval >> doAddition newEntity
+    Swap _ newEntity -> doRemoval >>= doAddition newEntity
  where
-  doAddition newEntity = do
-    entLookup <- use $ discovery . structureRecognition . automatons . automatonsByEntity
-    forM_ (HM.lookup newEntity entLookup) $ \finder -> do
-      let msg = FoundParticipatingEntity $ ParticipatingEntity newEntity (finder ^. inspectionOffsets)
-      discovery . structureRecognition . recognitionLog %= (msg :)
-      registerRowMatches cLoc finder
+  entLookup = recognizer ^. automatons . automatonsByEntity
+
+  doAddition newEntity r = do
+    let oldRecognitionState = r ^. recognitionState
+    stateRevision <- case HM.lookup newEntity entLookup of
+      Nothing -> return oldRecognitionState
+      Just finder -> do
+        let msg = FoundParticipatingEntity $ ParticipatingEntity newEntity (finder ^. inspectionOffsets)
+            stateRevision' = oldRecognitionState & recognitionLog %~ (msg :)
+
+        registerRowMatches entLoader cLoc finder stateRevision'
+
+    return $ r & recognitionState .~ stateRevision
 
   doRemoval = do
     -- Entity was removed; may need to remove registered structure.
-    structureRegistry <- use $ discovery . structureRecognition . foundStructures
-    forM_ (M.lookup cLoc $ foundByLocation structureRegistry) $ \fs -> do
-      let structureName = getName $ originalDefinition $ structureWithGrid fs
-       in do
-            discovery . structureRecognition . recognitionLog %= (StructureRemoved structureName :)
-            discovery . structureRecognition . foundStructures %= removeStructure fs
+    let oldRecognitionState = recognizer ^. recognitionState
+        structureRegistry = oldRecognitionState ^. foundStructures
+    stateRevision <- case M.lookup cLoc $ foundByLocation structureRegistry of
+      Nothing -> return oldRecognitionState
+      Just fs ->
+        return $
+          oldRecognitionState
+            & recognitionLog %~ (StructureRemoved structureName :)
+            & foundStructures %~ removeStructure fs
+       where
+        structureName = getName $ originalDefinition $ structureWithGrid fs
+
+    return $ recognizer & recognitionState .~ stateRevision
 
 -- | In case this cell would match a candidate structure,
 -- ensures that the entity in this cell is not already
@@ -85,35 +104,35 @@ entityModified modification cLoc = do
 -- to intrude into the candidate structure's bounding box
 -- where the candidate structure has empty cells.
 candidateEntityAt ::
-  (Has (State GameState) sig m) =>
+  (Monad s, Hashable a) =>
+  GenericEntLocator s a ->
+  FoundRegistry b a ->
   -- | participating entities
-  HashSet Entity ->
+  HashSet a ->
   Cosmic Location ->
-  m (Maybe Entity)
-candidateEntityAt participating cLoc = do
-  registry <- use $ discovery . structureRecognition . foundStructures
-  if M.member cLoc $ foundByLocation registry
-    then return Nothing
-    else do
-      maybeEnt <- entityAt cLoc
-      return $ do
-        ent <- maybeEnt
-        guard $ HS.member ent participating
-        return ent
+  s (Maybe a)
+candidateEntityAt entLoader registry participating cLoc = runMaybeT $ do
+  guard $ M.notMember cLoc $ foundByLocation registry
+  ent <- MaybeT $ entLoader cLoc
+  guard $ HS.member ent participating
+  return ent
 
 -- | Excludes entities that are already part of a
 -- registered found structure.
 getWorldRow ::
-  (Has (State GameState) sig m) =>
+  (Monad s, Hashable a) =>
+  GenericEntLocator s a ->
+  FoundRegistry b a ->
   -- | participating entities
-  HashSet Entity ->
+  HashSet a ->
   Cosmic Location ->
   InspectionOffsets ->
   Int32 ->
-  m [Maybe Entity]
-getWorldRow participatingEnts cLoc (InspectionOffsets (Min offsetLeft) (Max offsetRight)) yOffset =
-  mapM (candidateEntityAt participatingEnts) horizontalOffsets
+  s [Maybe a]
+getWorldRow entLoader registry participatingEnts cLoc (InspectionOffsets (Min offsetLeft) (Max offsetRight)) yOffset = do
+  mapM getCandidate horizontalOffsets
  where
+  getCandidate = candidateEntityAt entLoader registry participatingEnts
   horizontalOffsets = map mkLoc [offsetLeft .. offsetRight]
 
   -- NOTE: We negate the yOffset because structure rows are numbered increasing from top
@@ -123,12 +142,16 @@ getWorldRow participatingEnts cLoc (InspectionOffsets (Min offsetLeft) (Max offs
 -- | This is the first (one-dimensional) stage
 -- in a two-stage (two-dimensional) search.
 registerRowMatches ::
-  (Has (State GameState) sig m) =>
+  (Monad s, Hashable a, Eq b) =>
+  GenericEntLocator s a ->
   Cosmic Location ->
-  AutomatonInfo Entity (AtomicKeySymbol Entity) (StructureSearcher StructureCells Entity) ->
-  m ()
-registerRowMatches cLoc (AutomatonInfo participatingEnts horizontalOffsets sm) = do
-  entitiesRow <- getWorldRow participatingEnts cLoc horizontalOffsets 0
+  AutomatonInfo a (AtomicKeySymbol a) (StructureSearcher b a) ->
+  RecognitionState b a ->
+  s (RecognitionState b a)
+registerRowMatches entLoader cLoc (AutomatonInfo participatingEnts horizontalOffsets sm) rState = do
+  let registry = rState ^. foundStructures
+
+  entitiesRow <- getWorldRow entLoader registry participatingEnts cLoc horizontalOffsets 0
   let candidates = findAll sm entitiesRow
       mkCandidateLogEntry c =
         FoundRowCandidate
@@ -138,23 +161,34 @@ registerRowMatches cLoc (AutomatonInfo participatingEnts horizontalOffsets sm) =
        where
         rowMatchInfo = NE.toList . NE.map (f . myRow) . singleRowItems $ pVal c
          where
-          f x = MatchingRowFrom (rowIndex x) $ getName . originalDefinition . wholeStructure $ x
+          f x =
+            MatchingRowFrom (rowIndex x) $
+              getName . originalDefinition . wholeStructure $
+                x
 
       logEntry = FoundRowCandidates $ map mkCandidateLogEntry candidates
 
-  discovery . structureRecognition . recognitionLog %= (logEntry :)
-  candidates2D <- forM candidates $ checkVerticalMatch cLoc horizontalOffsets
-  registerStructureMatches $ concat candidates2D
+  candidates2D <-
+    forM candidates $
+      checkVerticalMatch entLoader registry cLoc horizontalOffsets
 
+  return $
+    registerStructureMatches (concat candidates2D) $
+      rState & recognitionLog %~ (logEntry :)
+
+-- | Examines contiguous rows of entities, accounting
+-- for the offset of the initially found row.
 checkVerticalMatch ::
-  (Has (State GameState) sig m) =>
+  (Monad s, Hashable a) =>
+  GenericEntLocator s a ->
+  FoundRegistry b a ->
   Cosmic Location ->
   -- | Horizontal search offsets
   InspectionOffsets ->
-  Position (StructureSearcher StructureCells Entity) ->
-  m [FoundStructure StructureCells Entity]
-checkVerticalMatch cLoc (InspectionOffsets (Min searchOffsetLeft) _) foundRow =
-  getMatches2D cLoc horizontalFoundOffsets $ automaton2D $ pVal foundRow
+  Position (StructureSearcher b a) ->
+  s [FoundStructure b a]
+checkVerticalMatch entLoader registry cLoc (InspectionOffsets (Min searchOffsetLeft) _) foundRow =
+  getMatches2D entLoader registry cLoc horizontalFoundOffsets $ automaton2D $ pVal foundRow
  where
   foundLeftOffset = searchOffsetLeft + fromIntegral (pIndex foundRow)
   foundRightInclusiveIndex = foundLeftOffset + fromIntegral (pLength foundRow) - 1
@@ -164,9 +198,9 @@ getFoundStructures ::
   Hashable keySymb =>
   (Int32, Int32) ->
   Cosmic Location ->
-  StateMachine keySymb (StructureWithGrid StructureCells Entity) ->
+  StateMachine keySymb (StructureWithGrid b a) ->
   [keySymb] ->
-  [FoundStructure StructureCells Entity]
+  [FoundStructure b a]
 getFoundStructures (offsetTop, offsetLeft) cLoc sm entityRows =
   map mkFound candidates
  where
@@ -178,20 +212,24 @@ getFoundStructures (offsetTop, offsetLeft) cLoc sm entityRows =
     loc = V2 offsetLeft $ negate $ offsetTop + fromIntegral (pIndex candidate)
 
 getMatches2D ::
-  (Has (State GameState) sig m) =>
+  (Monad s, Hashable a) =>
+  GenericEntLocator s a ->
+  FoundRegistry b a ->
   Cosmic Location ->
   -- | Horizontal found offsets (inclusive indices)
   InspectionOffsets ->
-  AutomatonInfo Entity (SymbolSequence Entity) (StructureWithGrid StructureCells Entity) ->
-  m [FoundStructure StructureCells Entity]
+  AutomatonInfo a (SymbolSequence a) (StructureWithGrid b a) ->
+  s [FoundStructure b a]
 getMatches2D
+  entLoader
+  registry
   cLoc
   horizontalFoundOffsets@(InspectionOffsets (Min offsetLeft) _)
   (AutomatonInfo participatingEnts (InspectionOffsets (Min offsetTop) (Max offsetBottom)) sm) = do
     entityRows <- mapM getRow verticalOffsets
     return $ getFoundStructures (offsetTop, offsetLeft) cLoc sm entityRows
    where
-    getRow = getWorldRow participatingEnts cLoc horizontalFoundOffsets
+    getRow = getWorldRow entLoader registry participatingEnts cLoc horizontalFoundOffsets
     verticalOffsets = [offsetTop .. offsetBottom]
 
 -- |
@@ -199,14 +237,14 @@ getMatches2D
 -- so multiple matches require a tie-breaker.
 -- The largest structure (by area) shall win.
 registerStructureMatches ::
-  (Has (State GameState) sig m) =>
-  [FoundStructure StructureCells Entity] ->
-  m ()
-registerStructureMatches unrankedCandidates = do
-  discovery . structureRecognition . recognitionLog %= (newMsg :)
-
-  forM_ (listToMaybe rankedCandidates) $ \fs ->
-    discovery . structureRecognition . foundStructures %= addFound fs
+  (Eq a, Eq b) =>
+  [FoundStructure a b] ->
+  RecognitionState a b ->
+  RecognitionState a b
+registerStructureMatches unrankedCandidates oldState =
+  oldState
+    & (recognitionLog %~ (newMsg :))
+    & foundStructures %~ maybe id addFound (listToMaybe rankedCandidates)
  where
   -- Sorted by decreasing order of preference.
   rankedCandidates = sortOn Down unrankedCandidates

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

@@ -0,0 +1,10 @@
+-- |
+-- SPDX-License-Identifier: BSD-3-Clause
+module Swarm.Game.Scenario.Topography.Terraform where
+
+data CellModification e
+  = -- | Fields represent what existed in the cell "before" and "after", in that order.
+    -- The values are guaranteed to be different.
+    Swap e e
+  | Remove e
+  | Add e

src/swarm-tui/Swarm/TUI/View/CellDisplay.hs

@@ -33,7 +33,7 @@ import Swarm.Game.Entity
 import Swarm.Game.Land
 import Swarm.Game.Robot
 import Swarm.Game.Scenario.Topography.EntityFacade
-import Swarm.Game.Scenario.Topography.Structure.Recognition (foundStructures)
+import Swarm.Game.Scenario.Topography.Structure.Recognition (foundStructures, recognitionState)
 import Swarm.Game.Scenario.Topography.Structure.Recognition.Registry (foundByLocation)
 import Swarm.Game.State
 import Swarm.Game.State.Landscape
@@ -71,7 +71,7 @@ drawLoc ui g cCoords@(Cosmic _ coords) =
 
   boldStructure = applyWhen isStructure $ modifyDefAttr (`V.withStyle` V.bold)
    where
-    sMap = foundByLocation $ g ^. discovery . structureRecognition . foundStructures
+    sMap = foundByLocation $ g ^. discovery . structureRecognition . recognitionState . foundStructures
     isStructure = M.member (coordsToLoc <$> cCoords) sMap
 
 -- | Subset of the game state needed to render the world

src/swarm-tui/Swarm/TUI/View/Structure.hs

@@ -24,7 +24,7 @@ import Swarm.Game.Scenario (StructureCells)
 import Swarm.Game.Scenario.Topography.Area
 import Swarm.Game.Scenario.Topography.Placement (getStructureName)
 import Swarm.Game.Scenario.Topography.Structure qualified as Structure
-import Swarm.Game.Scenario.Topography.Structure.Recognition (foundStructures)
+import Swarm.Game.Scenario.Topography.Structure.Recognition (foundStructures, recognitionState)
 import Swarm.Game.Scenario.Topography.Structure.Recognition.Precompute (getEntityGrid)
 import Swarm.Game.Scenario.Topography.Structure.Recognition.Registry (foundByName)
 import Swarm.Game.Scenario.Topography.Structure.Recognition.Type
@@ -92,7 +92,7 @@ structureWidget gs s =
       Structure.description . namedGrid . annotatedGrid $
         s
 
-  registry = gs ^. discovery . structureRecognition . foundStructures
+  registry = gs ^. discovery . structureRecognition . recognitionState . foundStructures
   occurrenceCountSuffix = case M.lookup theName $ foundByName registry of
     Nothing -> emptyWidget
     Just inner -> padLeft (Pad 2) . headerItem "Count" . T.pack . show $ NEM.size inner

src/swarm-web/Swarm/Web.hs

@@ -212,12 +212,12 @@ recogLogHandler appStateRef = do
   appState <- liftIO appStateRef
   return $
     map (fmap (view entityName)) $
-      appState ^. gameState . discovery . structureRecognition . recognitionLog
+      appState ^. gameState . discovery . structureRecognition . recognitionState . recognitionLog
 
 recogFoundHandler :: IO AppState -> Handler [StructureLocation]
 recogFoundHandler appStateRef = do
   appState <- liftIO appStateRef
-  let registry = appState ^. gameState . discovery . structureRecognition . foundStructures
+  let registry = appState ^. gameState . discovery . structureRecognition . recognitionState . foundStructures
   return
     . map (uncurry StructureLocation)
     . concatMap (\(x, ys) -> map (x,) $ NE.toList ys)

swarm.cabal

@@ -227,7 +227,9 @@ library swarm-topography
     Swarm.Game.Scenario.Topography.Structure.Recognition.Prep
     Swarm.Game.Scenario.Topography.Structure.Recognition.Registry
     Swarm.Game.Scenario.Topography.Structure.Recognition.Symmetry
+    Swarm.Game.Scenario.Topography.Structure.Recognition.Tracking
     Swarm.Game.Scenario.Topography.Structure.Recognition.Type
+    Swarm.Game.Scenario.Topography.Terraform
     Swarm.Game.Universe
     Swarm.Game.World.Coords
 
@@ -247,6 +249,7 @@ library swarm-topography
     nonempty-containers >=0.3.4 && <0.3.5,
     servant-docs >=0.12 && <0.14,
     text >=1.2.4 && <2.2,
+    transformers,
     unordered-containers,
     vector >=0.12 && <0.14,
     yaml >=0.11 && <0.11.12.0,
@@ -386,7 +389,6 @@ library swarm-engine
     Swarm.Game.Scenario.Scoring.GenericMetrics
     Swarm.Game.Scenario.Status
     Swarm.Game.Scenario.Topography.Navigation.Util
-    Swarm.Game.Scenario.Topography.Structure.Recognition.Tracking
     Swarm.Game.ScenarioInfo
     Swarm.Game.State
     Swarm.Game.State.Initialize
@@ -416,7 +418,6 @@ library swarm-engine
   other-modules: Paths_swarm
   autogen-modules: Paths_swarm
   build-depends:
-    AhoCorasick >=0.0.4 && <0.0.5,
     SHA >=1.6.4 && <1.6.5,
     aeson >=2.2 && <2.3,
     array >=0.5.4 && <0.6,
@@ -432,7 +433,6 @@ library swarm-engine
     fused-effects >=1.1.1.1 && <1.2,
     fused-effects-lens >=1.2.0.1 && <1.3,
     githash,
-    hashable >=1.3.4 && <1.5,
     http-client >=0.7 && <0.8,
     http-client-tls >=0.3 && <0.4,
     http-types >=0.12 && <0.13,