eliminate remaining Cell dependence in structure recognizer (#2114)

Builds upon #1836.

Ultimately, this allows us to move the final remaining module, `Precompute.hs`, into the `swarm-topology` sublibrary to live alongside the rest of the structure recognizer code.

## Also in this PR
* improve logging details for shape recognition

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

@@ -1,3 +1,4 @@
+-- |
 -- SPDX-License-Identifier: BSD-3-Clause
 -- Description: Game-related state and utilities
 --
@@ -39,9 +40,11 @@ import Swarm.Game.Robot.Concrete
 import Swarm.Game.Scenario
 import Swarm.Game.Scenario.Objective (initCompletion)
 import Swarm.Game.Scenario.Status
+import Swarm.Game.Scenario.Topography.Cell (Cell, cellToEntity)
 import Swarm.Game.Scenario.Topography.Structure.Recognition
 import Swarm.Game.Scenario.Topography.Structure.Recognition.Log
 import Swarm.Game.Scenario.Topography.Structure.Recognition.Precompute
+import Swarm.Game.Scenario.Topography.Structure.Recognition.Static
 import Swarm.Game.Scenario.Topography.Structure.Recognition.Type
 import Swarm.Game.State
 import Swarm.Game.State.Landscape (mkLandscape)
@@ -177,19 +180,19 @@ pureScenarioToGameState scenario theSeed now toRun gsc =
 
 mkRecognizer ::
   (Has (State GameState) sig m) =>
-  StaticStructureInfo ->
-  m (StructureRecognizer StructureCells Entity)
+  StaticStructureInfo Cell ->
+  m (StructureRecognizer (Maybe Cell) Entity)
 mkRecognizer structInfo@(StaticStructureInfo structDefs _) = do
   foundIntact <- mapM (sequenceA . (id &&& ensureStructureIntact)) allPlaced
   let fs = populateStaticFoundStructures . map fst . filter snd $ foundIntact
   return
     $ StructureRecognizer
-      (mkAutomatons structDefs)
+      (mkAutomatons cellToEntity structDefs)
     $ RecognitionState
       fs
       [IntactStaticPlacement $ map mkLogEntry foundIntact]
  where
-  allPlaced = lookupStaticPlacements structInfo
+  allPlaced = lookupStaticPlacements cellToEntity structInfo
   mkLogEntry (x, intact) =
     IntactPlacementLog
       intact
@@ -201,7 +204,7 @@ mkRecognizer structInfo@(StaticStructureInfo structDefs _) = do
 -- cell is encountered.
 ensureStructureIntact ::
   (Has (State GameState) sig m) =>
-  FoundStructure StructureCells Entity ->
+  FoundStructure (Maybe Cell) Entity ->
   m Bool
 ensureStructureIntact (FoundStructure (StructureWithGrid _ _ grid) upperLeft) =
   allM outer $ zip [0 ..] grid

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

@@ -101,8 +101,9 @@ import Swarm.Game.Recipe (
   outRecipeMap,
  )
 import Swarm.Game.Robot
-import Swarm.Game.Scenario (GameStateInputs (..), StructureCells)
+import Swarm.Game.Scenario (GameStateInputs (..))
 import Swarm.Game.Scenario.Objective
+import Swarm.Game.Scenario.Topography.Cell (Cell)
 import Swarm.Game.Scenario.Topography.Structure.Recognition
 import Swarm.Game.Scenario.Topography.Structure.Recognition.Registry (emptyFoundStructures)
 import Swarm.Game.Scenario.Topography.Structure.Recognition.Type (RecognizerAutomatons (..))
@@ -326,7 +327,7 @@ data Discovery = Discovery
   , _availableCommands :: Notifications Const
   , _knownEntities :: S.Set EntityName
   , _gameAchievements :: Map GameplayAchievement Attainment
-  , _structureRecognition :: StructureRecognizer StructureCells Entity
+  , _structureRecognition :: StructureRecognizer (Maybe Cell) Entity
   , _tagMembers :: Map Text (NonEmpty EntityName)
   }
 
@@ -349,7 +350,7 @@ knownEntities :: Lens' Discovery (S.Set EntityName)
 gameAchievements :: Lens' Discovery (Map GameplayAchievement Attainment)
 
 -- | Recognizer for robot-constructed structures
-structureRecognition :: Lens' Discovery (StructureRecognizer StructureCells Entity)
+structureRecognition :: Lens' Discovery (StructureRecognizer (Maybe Cell) Entity)
 
 -- | Map from tags to entities that possess that tag
 tagMembers :: Lens' Discovery (Map Text (NonEmpty EntityName))

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

@@ -13,13 +13,9 @@
 -- conditions, which can be used both for building interactive
 -- tutorials and for standalone puzzles and scenarios.
 module Swarm.Game.Scenario (
-  -- * WorldDescription
-  StructureCells,
-
   -- * Scenario
   Scenario (..),
   ScenarioLandscape (..),
-  StaticStructureInfo (..),
   ScenarioMetadata (ScenarioMetadata),
   staticPlacements,
   structureDefs,
@@ -95,9 +91,10 @@ import Swarm.Game.Scenario.Topography.Navigation.Portal
 import Swarm.Game.Scenario.Topography.Navigation.Waypoint (Parentage (..))
 import Swarm.Game.Scenario.Topography.Structure qualified as Structure
 import Swarm.Game.Scenario.Topography.Structure.Assembly qualified as Assembly
+import Swarm.Game.Scenario.Topography.Structure.Named qualified as Structure
 import Swarm.Game.Scenario.Topography.Structure.Overlay
+import Swarm.Game.Scenario.Topography.Structure.Recognition.Static
 import Swarm.Game.Scenario.Topography.Structure.Recognition.Symmetry
-import Swarm.Game.Scenario.Topography.Structure.Recognition.Type (SymmetryAnnotatedGrid (..))
 import Swarm.Game.Scenario.Topography.WorldDescription
 import Swarm.Game.Terrain
 import Swarm.Game.Universe
@@ -115,24 +112,6 @@ import System.Directory (doesFileExist)
 import System.FilePath ((<.>), (</>))
 import System.Random (randomRIO)
 
-type StructureCells = Structure.NamedGrid (Maybe Cell)
-
-data StaticStructureInfo = StaticStructureInfo
-  { _structureDefs :: [SymmetryAnnotatedGrid StructureCells]
-  , _staticPlacements :: M.Map SubworldName [Structure.LocatedStructure]
-  }
-  deriving (Show)
-
-makeLensesNoSigs ''StaticStructureInfo
-
--- | Structure templates that may be auto-recognized when constructed
--- by a robot
-structureDefs :: Lens' StaticStructureInfo [SymmetryAnnotatedGrid StructureCells]
-
--- | A record of the static placements of structures, so that they can be
--- added to the "recognized" list upon scenario initialization
-staticPlacements :: Lens' StaticStructureInfo (M.Map SubworldName [Structure.LocatedStructure])
-
 -- * Scenario records
 
 -- | Authorship information about scenario not used at play-time
@@ -211,7 +190,7 @@ data ScenarioLandscape = ScenarioLandscape
   , _scenarioKnown :: Set EntityName
   , _scenarioWorlds :: NonEmpty WorldDescription
   , _scenarioNavigation :: Navigation (M.Map SubworldName) Location
-  , _scenarioStructures :: StaticStructureInfo
+  , _scenarioStructures :: StaticStructureInfo Cell
   , _scenarioRobots :: [TRobot]
   }
   deriving (Show)
@@ -241,7 +220,7 @@ scenarioKnown :: Lens' ScenarioLandscape (Set EntityName)
 scenarioWorlds :: Lens' ScenarioLandscape (NonEmpty WorldDescription)
 
 -- | Information required for structure recognition
-scenarioStructures :: Lens' ScenarioLandscape StaticStructureInfo
+scenarioStructures :: Lens' ScenarioLandscape (StaticStructureInfo Cell)
 
 -- | Waypoints and inter-world portals
 scenarioNavigation :: Lens' ScenarioLandscape (Navigation (M.Map SubworldName) Location)

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

@@ -8,6 +8,7 @@ module Swarm.Game.Scenario.Topography.Cell (
   Cell,
   AugmentedCell,
   CellPaintDisplay,
+  cellToEntity,
 ) where
 
 import Control.Lens hiding (from, (.=), (<.>))
@@ -26,7 +27,7 @@ import Swarm.Game.Scenario.Topography.EntityFacade
 import Swarm.Game.Scenario.Topography.ProtoCell hiding (name)
 import Swarm.Game.Terrain
 import Swarm.Util (quote, showT)
-import Swarm.Util.Erasable (Erasable (..))
+import Swarm.Util.Erasable (Erasable (..), erasableToMaybe)
 import Swarm.Util.Yaml
 
 ------------------------------------------------------------
@@ -107,6 +108,9 @@ instance FromJSONE (TerrainEntityMaps, RobotMap) Cell where
 
     return $ Cell terr ent robs
 
+cellToEntity :: Maybe Cell -> Maybe Entity
+cellToEntity = ((erasableToMaybe . cellEntity) =<<)
+
 ------------------------------------------------------------
 -- World editor
 ------------------------------------------------------------

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

@@ -29,7 +29,6 @@ import Swarm.Game.Scenario.Topography.ProtoCell (
   StructurePalette (StructurePalette),
  )
 import Swarm.Game.Scenario.Topography.Structure (
-  LocatedStructure,
   MergedStructure (MergedStructure),
   NamedStructure,
   parseStructure,
@@ -38,6 +37,7 @@ import Swarm.Game.Scenario.Topography.Structure.Assembly qualified as Assembly
 import Swarm.Game.Scenario.Topography.Structure.Overlay (
   PositionedGrid (..),
  )
+import Swarm.Game.Scenario.Topography.Structure.Recognition.Static (LocatedStructure)
 import Swarm.Game.Scenario.Topography.WorldPalette
 import Swarm.Game.Universe (SubworldName (DefaultRootSubworld))
 import Swarm.Game.World.Parse ()

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

@@ -14,41 +14,21 @@ import Data.List (intercalate)
 import Data.List.NonEmpty qualified as NE
 import Data.Map qualified as M
 import Data.Maybe (catMaybes, fromMaybe)
-import Data.Set (Set)
 import Data.Set qualified as Set
-import Data.Text (Text)
 import Data.Text qualified as T
 import Data.Yaml as Y
 import Swarm.Game.Location
 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
+import Swarm.Game.Scenario.Topography.Structure.Named
 import Swarm.Game.Scenario.Topography.Structure.Overlay
+import Swarm.Game.Scenario.Topography.Structure.Recognition.Static
 import Swarm.Game.World.Coords
-import Swarm.Language.Syntax.Direction (AbsoluteDir)
 import Swarm.Util (failT, showT)
 import Swarm.Util.Yaml
 
-data NamedArea a = NamedArea
-  { name :: StructureName
-  , recognize :: Set AbsoluteDir
-  -- ^ whether this structure should be registered for automatic recognition
-  -- and which orientations shall be recognized.
-  -- The supplied direction indicates which cardinal direction the
-  -- original map's "North" has been re-oriented to.
-  -- E.g., 'DWest' represents a rotation of 90 degrees counter-clockwise.
-  , description :: Maybe Text
-  -- ^ will be UI-facing only if this is a recognizable structure
-  , structure :: a
-  }
-  deriving (Eq, Show, Functor)
-
-isRecognizable :: NamedArea a -> Bool
-isRecognizable = not . null . recognize
-
-type NamedGrid c = NamedArea (Grid c)
-
 type NamedStructure c = NamedArea (PStructure c)
 
 data PStructure c = Structure
@@ -64,18 +44,6 @@ data PStructure c = Structure
 data Placed c = Placed Placement (NamedStructure c)
   deriving (Show)
 
--- | For use in registering recognizable pre-placed structures
-data LocatedStructure = LocatedStructure
-  { placedName :: StructureName
-  , upDirection :: AbsoluteDir
-  , cornerLoc :: Location
-  }
-  deriving (Show)
-
-instance HasLocation LocatedStructure where
-  modifyLoc f (LocatedStructure x y originalLoc) =
-    LocatedStructure x y $ f originalLoc
-
 data MergedStructure c = MergedStructure (PositionedGrid c) [LocatedStructure] [Originated Waypoint]
 
 instance (FromJSONE e a) => FromJSONE e (NamedStructure (Maybe a)) where

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

@@ -26,7 +26,9 @@ 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
+import Swarm.Game.Scenario.Topography.Structure.Named
 import Swarm.Game.Scenario.Topography.Structure.Overlay
+import Swarm.Game.Scenario.Topography.Structure.Recognition.Static
 import Swarm.Language.Syntax.Direction (directionJsonModifier)
 import Swarm.Util (commaList, quote, showT)
 

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

@@ -0,0 +1,28 @@
+-- |
+-- SPDX-License-Identifier: BSD-3-Clause
+module Swarm.Game.Scenario.Topography.Structure.Named where
+
+import Data.Set (Set)
+import Data.Text (Text)
+import Swarm.Game.Scenario.Topography.Grid (Grid)
+import Swarm.Game.Scenario.Topography.Placement (StructureName)
+import Swarm.Language.Syntax.Direction (AbsoluteDir)
+
+data NamedArea a = NamedArea
+  { name :: StructureName
+  , recognize :: Set AbsoluteDir
+  -- ^ whether this structure should be registered for automatic recognition
+  -- and which orientations shall be recognized.
+  -- The supplied direction indicates which cardinal direction the
+  -- original map's "North" has been re-oriented to.
+  -- E.g., 'DWest' represents a rotation of 90 degrees counter-clockwise.
+  , description :: Maybe Text
+  -- ^ will be UI-facing only if this is a recognizable structure
+  , structure :: a
+  }
+  deriving (Eq, Show, Functor)
+
+isRecognizable :: NamedArea a -> Bool
+isRecognizable = not . null . recognize
+
+type NamedGrid c = NamedArea (Grid c)

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

@@ -24,7 +24,7 @@ makeLenses ''RecognitionState
 
 -- |
 -- The type parameters, `b`, and `a`, correspond
--- to 'StructureCells' and 'Entity', respectively.
+-- to 'Cell' and 'Entity', respectively.
 data StructureRecognizer b a = StructureRecognizer
   { _automatons :: RecognizerAutomatons b a
   -- ^ read-only

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

@@ -12,21 +12,33 @@ import Servant.Docs qualified as SD
 import Swarm.Game.Location (Location)
 import Swarm.Game.Scenario.Topography.Structure.Recognition.Type
 import Swarm.Game.Universe (Cosmic)
+import Swarm.Language.Syntax.Direction (AbsoluteDir)
 
 type StructureRowContent e = [Maybe e]
 type WorldRowContent e = [Maybe e]
 
+data OrientedStructure = OrientedStructure
+  { oName :: OriginalName
+  , oDir :: AbsoluteDir
+  }
+  deriving (Generic, ToJSON)
+
+distillLabel :: StructureWithGrid b a -> OrientedStructure
+distillLabel swg = OrientedStructure (getName $ originalDefinition swg) (rotatedTo swg)
+
 data MatchingRowFrom = MatchingRowFrom
   { rowIdx :: Int32
-  , structure :: OriginalName
+  , structure :: OrientedStructure
   }
   deriving (Generic, ToJSON)
 
 newtype HaystackPosition = HaystackPosition Int
   deriving (Generic, ToJSON)
 
 data HaystackContext e = HaystackContext
-  { worldRow :: WorldRowContent e
+  { maskedWorldRow :: WorldRowContent e
+  -- ^ entities that do not constitute any of the eligible structures
+  -- are replaced with 'null' in this list.
   , haystackPosition :: HaystackPosition
   }
   deriving (Functor, Generic, ToJSON)
@@ -55,7 +67,10 @@ data SearchLog e
   = FoundParticipatingEntity (ParticipatingEntity e)
   | StructureRemoved OriginalName
   | FoundRowCandidates [FoundRowCandidate e]
-  | FoundCompleteStructureCandidates [OriginalName]
+  | FoundCompleteStructureCandidates [OrientedStructure]
+  | -- | There may be multiple candidate structures that could be
+    -- completed by the element that was just placed. This lists all of them.
+    VerticalSearchSpans [(InspectionOffsets, [OrientedStructure])]
   | IntactStaticPlacement [IntactPlacementLog]
   deriving (Functor, Generic)