wip2

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

@@ -104,7 +104,7 @@ import Swarm.Game.Recipe (
   outRecipeMap,
  )
 import Swarm.Game.Robot
-import Swarm.Game.Scenario (GameStateInputs (..))
+import Swarm.Game.Scenario (GameStateInputs (..), RecognizableStructureContent)
 import Swarm.Game.Scenario.Objective
 import Swarm.Game.Scenario.Topography.Cell (Cell)
 import Swarm.Game.Scenario.Topography.Grid
@@ -365,7 +365,7 @@ knownEntities :: Lens' Discovery (S.Set EntityName)
 gameAchievements :: Lens' Discovery (Map GameplayAchievement Attainment)
 
 -- | Recognizer for robot-constructed structures
-structureRecognition :: Lens' Discovery (RecognitionState (NonEmptyGrid (Maybe Cell)) Entity)
+structureRecognition :: Lens' Discovery (RecognitionState RecognizableStructureContent Entity)
 
 -- | Map from tags to entities that possess that tag
 tagMembers :: Lens' Discovery (Map Text (NonEmpty EntityName))

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

@@ -17,6 +17,7 @@ module Swarm.Game.Scenario (
   Scenario (..),
   ScenarioLandscape (..),
   ScenarioMetadata (ScenarioMetadata),
+  RecognizableStructureContent,
   staticPlacements,
 
   -- ** Fields
@@ -181,6 +182,8 @@ scenarioSolution :: Lens' ScenarioOperation (Maybe TSyntax)
 --   take during a single tick.
 scenarioStepsPerTick :: Lens' ScenarioOperation (Maybe Int)
 
+type RecognizableStructureContent = NonEmptyGrid (Maybe Cell)
+
 -- | All cosmetic and structural content of the scenario.
 data ScenarioLandscape = ScenarioLandscape
   { _scenarioSeed :: Maybe Int
@@ -190,7 +193,7 @@ data ScenarioLandscape = ScenarioLandscape
   , _scenarioKnown :: Set EntityName
   , _scenarioWorlds :: NonEmpty WorldDescription
   , _scenarioNavigation :: Navigation (M.Map SubworldName) Location
-  , _scenarioStructures :: StaticStructureInfo (NonEmptyGrid (Maybe Cell)) Entity
+  , _scenarioStructures :: StaticStructureInfo RecognizableStructureContent Entity
   , _scenarioRobots :: [TRobot]
   }
 
@@ -219,7 +222,7 @@ scenarioKnown :: Lens' ScenarioLandscape (Set EntityName)
 scenarioWorlds :: Lens' ScenarioLandscape (NonEmpty WorldDescription)
 
 -- | Information required for structure recognition
-scenarioStructures :: Lens' ScenarioLandscape (StaticStructureInfo (NonEmptyGrid (Maybe Cell)) Entity)
+scenarioStructures :: Lens' ScenarioLandscape (StaticStructureInfo RecognizableStructureContent Entity)
 
 -- | Waypoints and inter-world portals
 scenarioNavigation :: Lens' ScenarioLandscape (Navigation (M.Map SubworldName) Location)
@@ -353,12 +356,12 @@ instance FromJSONE ScenarioInputs Scenario where
           namedGrids = map stuffGrid mergedStructures
           recognizableGrids = filter Structure.isRecognizable namedGrids
 
-      -- We exclude empty grids from the recognition engine.
+          -- We exclude empty grids from the recognition engine.
           nonEmptyRecognizableGrids = mapMaybe (traverse getNonEmptyGrid) recognizableGrids
 
       myAutomatons <-
         either (fail . T.unpack) return $
-          mkAutomatons (fmap cellToEntity . Structure.structure) nonEmptyRecognizableGrids
+          mkAutomatons (fmap cellToEntity) nonEmptyRecognizableGrids
 
       let structureInfo =
             StaticStructureInfo myAutomatons

src/swarm-scenario/Swarm/Game/State/Landscape.hs

@@ -65,7 +65,7 @@ data Landscape = Landscape
   { _worldNavigation :: Navigation (M.Map SubworldName) Location
   , _multiWorld :: MultiWorld Int Entity
   , _terrainAndEntities :: TerrainEntityMaps
-  , _recognizerAutomatons :: RecognizerAutomatons (NonEmptyGrid (Maybe Cell)) Entity
+  , _recognizerAutomatons :: RecognizerAutomatons RecognizableStructureContent Entity
   , _worldScrollable :: Bool
   }
 
@@ -85,7 +85,7 @@ multiWorld :: Lens' Landscape (MultiWorld Int Entity)
 terrainAndEntities :: Lens' Landscape TerrainEntityMaps
 
 -- | Recognition engine for predefined structures
-recognizerAutomatons :: Lens' Landscape (RecognizerAutomatons (NonEmptyGrid (Maybe Cell)) Entity)
+recognizerAutomatons :: Lens' Landscape (RecognizerAutomatons RecognizableStructureContent Entity)
 
 -- | Whether the world map is supposed to be scrollable or not.
 worldScrollable :: Lens' Landscape Bool

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

@@ -88,25 +88,25 @@ type GenericEntLocator s a = Cosmic Location -> s (AtomicKeySymbol a)
 -- provided structure definitions
 mkAutomatons ::
   (Ord a, Hashable a) =>
-  (NamedArea b -> NonEmptyGrid (AtomicKeySymbol a)) ->
+  (b -> NonEmptyGrid (AtomicKeySymbol a)) ->
   [NamedArea b] ->
   Either T.Text (RecognizerAutomatons b a)
 mkAutomatons extractor rawGrids = do
   onlyNonempties <- mapM checkSymmetry extractedItems
-  let rotatedGrids = concatMap (extractGrids . namedGrid) onlyNonempties
+  let rotatedGrids = concatMap (extractGrids . grid) onlyNonempties
       infos =
         M.fromList $
-          map ((name . originalItem . namedGrid . annotatedGrid &&& id) . process) onlyNonempties
+          map ((name . originalItem . grid . annotatedGrid &&& id) . process) onlyNonempties
   return $
     RecognizerAutomatons
       infos
       (mkEntityLookup rotatedGrids)
  where
-  extractedItems = map (uncurry ExtractedArea . fmap extractor . dupe) rawGrids
+  extractedItems = map (uncurry ExtractedArea . fmap (extractor . structure) . dupe) rawGrids
 
   process g = StructureInfo g entGrid countsMap
    where
-    entGrid = extractedGrid $ namedGrid g
+    entGrid = extractedGrid $ grid g
     countsMap = histogram . catMaybes . NE.toList $ allMembersNE entGrid
 
 extractOrientedGrid ::
@@ -149,7 +149,7 @@ lookupStaticPlacements (StaticStructureInfo theAutomatons thePlacements) =
       sGrid <- M.lookup theName definitionMap
       return $
         PositionedStructure (Cosmic subworldName loc) $
-          extractOrientedGrid (namedGrid $ annotatedGrid sGrid) d
+          extractOrientedGrid (grid $ annotatedGrid sGrid) d
 
 -- | Matches definitions against the placements.
 -- Fails fast (short-circuits) if a non-matching
@@ -163,10 +163,10 @@ ensureStructureIntact ::
   GenericEntLocator s a ->
   FoundStructure b a ->
   s (Maybe (StructureIntactnessFailure a))
-ensureStructureIntact registry entLoader (PositionedStructure upperLeft (StructureWithGrid _ _ (ExtractedArea _ grid))) = do
+ensureStructureIntact registry entLoader (PositionedStructure upperLeft (StructureWithGrid _ _ (ExtractedArea _ g))) = do
   fmap leftToMaybe . runExceptT $ mapM checkLoc allLocPairs
  where
-  gridArea = getNEGridDimensions grid
+  gridArea = getNEGridDimensions g
   checkLoc (maybeTemplateEntity, loc) =
     forM_ maybeTemplateEntity $ \x -> do
       e <- lift $ entLoader loc
@@ -188,4 +188,4 @@ ensureStructureIntact registry entLoader (PositionedStructure upperLeft (Structu
         . StructureIntactnessFailure (loc ^. planar) gridArea
 
   f = fmap ((upperLeft `offsetBy`) . asVector . coordsToLoc) . swap
-  allLocPairs = mapWithCoordsNE (curry f) grid
+  allLocPairs = mapWithCoordsNE (curry f) g

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

@@ -19,7 +19,7 @@ data RotationalSymmetry
 
 data SymmetryAnnotatedGrid a = SymmetryAnnotatedGrid
   { symmetry :: RotationalSymmetry
-  , namedGrid :: a
+  , grid :: a
   }
   deriving (Show, Functor, Foldable, Traversable)
 

src/swarm-tui/Swarm/TUI/Model/Dialog/Structure.hs

@@ -12,13 +12,12 @@ import Brick.Widgets.List qualified as BL
 import Control.Lens (makeLenses)
 import Data.List.Extra (enumerate)
 import Swarm.Game.Entity (Entity)
-import Swarm.Game.Scenario.Topography.Cell (Cell)
-import Swarm.Game.Scenario.Topography.Grid
+import Swarm.Game.Scenario (RecognizableStructureContent)
 import Swarm.Game.Scenario.Topography.Structure.Recognition.Type
 import Swarm.TUI.Model.Name
 
 data StructureDisplay = StructureDisplay
-  { _structurePanelListWidget :: BL.List Name (StructureInfo (NonEmptyGrid (Maybe Cell)) Entity)
+  { _structurePanelListWidget :: BL.List Name (StructureInfo RecognizableStructureContent Entity)
   -- ^ required for maintaining the selection/navigation
   -- state among list items
   , _structurePanelFocus :: FocusRing Name

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

@@ -69,7 +69,7 @@ structureWidget gs s =
       ]
 
   annotatedStructureGrid = annotatedGrid s
-  theNamedGrid = originalItem $ namedGrid annotatedStructureGrid
+  theNamedGrid = originalItem $ grid annotatedStructureGrid
   supportedOrientations = Set.toList . Structure.recognize $ theNamedGrid
 
   renderSymmetry = \case
@@ -167,4 +167,4 @@ drawSidebarListItem ::
   StructureInfo b a ->
   Widget Name
 drawSidebarListItem _isSelected (StructureInfo annotated _ _) =
-  txt . Structure.getStructureName . Structure.name $ originalItem $ namedGrid annotated
+  txt . Structure.getStructureName . Structure.name $ originalItem $ grid annotated