topography sublibrary (#1836)

Towards #1043.

The eventual goal of this sublibrary split is to have a self contained library that can compose 2D grids of arbitrary content (perhaps colored pixels, or boolean values).  This could be useful outside of the `swarm` game.

I would also like to write unit tests for the structure recognizer that are independent of the `Entity` type.

# Major Changes

## Direction module
* Moved `Swarm.Language.Syntax.Direction` to `swarm-util`, since both `swarm-lang` and `swarm-topology` depend on it, but not on each other.
* Removed the re-export of direction things from `Swarm.Language.Syntax`

## Structure module

The `Swarm.Game.Scenario.Topography.Structure` module has been split into two:
* `Swarm.Game.Scenario.Topography.Structure`
* `Swarm.Game.Scenario.Topography.Structure.Type`

The former retains the YAML parsing logic.  The latter is agnostic of `Enitiy` type and the palette .
At some future point, I might want to move the YAML parsing to this sublibrary while still retaining independence of `Entity` type.

## Structure recognizer

The structure recognizer is independent of the content of Cells (i.e. it does not need to know what an `Entity` is), except:
1. during initialization
2. when retrieving the original cell content after recognition

Type parameters for three kinds of data have been added to the recognizer:
1. `Cell`/`PCell`
2. `Entity`
3. `EntityName`

Eventually it may be possible to eliminate one or two of these type parameters, with some refactoring.

scripts/test/run-benchmarks.sh

@@ -1,7 +1,5 @@
 #!/bin/bash -xe
 
+cd $(git rev-parse --show-toplevel)
 
-SCRIPT_DIR=$( cd -- "$( dirname -- "${BASH_SOURCE[0]}" )" &> /dev/null && pwd )
-cd $SCRIPT_DIR/..
-
-STACK_WORK=.stack-work-bench stack bench swarm:benchmark --benchmark-arguments "--color always $@"
+cabal bench --benchmark-options "--color always $@"

src/swarm-doc/Swarm/Doc/Keyword.hs

@@ -19,7 +19,7 @@ module Swarm.Doc.Keyword (
 import Data.Text (Text)
 import Data.Text qualified as T
 import Swarm.Doc.Util
-import Swarm.Language.Syntax qualified as Syntax
+import Swarm.Language.Syntax.Direction
 import Swarm.Util (quote)
 
 -- | An enumeration of the editors supported by Swarm (currently,
@@ -42,7 +42,7 @@ keywordsCommands e = editorList e $ map constSyntax commands
 
 -- | Get formatted list of directions.
 keywordsDirections :: EditorType -> Text
-keywordsDirections e = editorList e $ map Syntax.directionSyntax Syntax.allDirs
+keywordsDirections e = editorList e $ map directionSyntax allDirs
 
 -- | A list of the names of all the operators in the language.
 operatorNames :: Text

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

@@ -26,11 +26,12 @@ import Data.Set qualified as S
 import Linear (V2 (..))
 import Swarm.Game.Entity
 import Swarm.Game.Location
-import Swarm.Game.Scenario.Topography.Structure qualified as Structure
+import Swarm.Game.Scenario (Cell)
 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.Scenario.Topography.Structure.Type qualified as Structure
 import Swarm.Game.State
 import Swarm.Game.State.Substate
 import Swarm.Game.Universe
@@ -124,7 +125,7 @@ getWorldRow participatingEnts cLoc (InspectionOffsets (Min offsetLeft) (Max offs
 registerRowMatches ::
   (Has (State GameState) sig m) =>
   Cosmic Location ->
-  AutomatonInfo AtomicKeySymbol StructureSearcher ->
+  AutomatonInfo EntityName (AtomicKeySymbol Entity) (StructureSearcher Cell EntityName Entity) ->
   m ()
 registerRowMatches cLoc (AutomatonInfo participatingEnts horizontalOffsets sm) = do
   entitiesRow <- getWorldRow participatingEnts cLoc horizontalOffsets 0
@@ -150,8 +151,8 @@ checkVerticalMatch ::
   Cosmic Location ->
   -- | Horizontal search offsets
   InspectionOffsets ->
-  Position StructureSearcher ->
-  m [FoundStructure]
+  Position (StructureSearcher Cell EntityName Entity) ->
+  m [FoundStructure Cell Entity]
 checkVerticalMatch cLoc (InspectionOffsets (Min searchOffsetLeft) _) foundRow =
   getMatches2D cLoc horizontalFoundOffsets $ automaton2D $ pVal foundRow
  where
@@ -163,9 +164,9 @@ getFoundStructures ::
   Hashable keySymb =>
   (Int32, Int32) ->
   Cosmic Location ->
-  StateMachine keySymb StructureWithGrid ->
+  StateMachine keySymb (StructureWithGrid Cell Entity) ->
   [keySymb] ->
-  [FoundStructure]
+  [FoundStructure Cell Entity]
 getFoundStructures (offsetTop, offsetLeft) cLoc sm entityRows =
   map mkFound candidates
  where
@@ -181,8 +182,8 @@ getMatches2D ::
   Cosmic Location ->
   -- | Horizontal found offsets (inclusive indices)
   InspectionOffsets ->
-  AutomatonInfo SymbolSequence StructureWithGrid ->
-  m [FoundStructure]
+  AutomatonInfo EntityName (SymbolSequence Entity) (StructureWithGrid Cell Entity) ->
+  m [FoundStructure Cell Entity]
 getMatches2D
   cLoc
   horizontalFoundOffsets@(InspectionOffsets (Min offsetLeft) _)
@@ -199,7 +200,7 @@ getMatches2D
 -- The largest structure (by area) shall win.
 registerStructureMatches ::
   (Has (State GameState) sig m) =>
-  [FoundStructure] ->
+  [FoundStructure Cell Entity] ->
   m ()
 registerStructureMatches unrankedCandidates = do
   discovery . structureRecognition . recognitionLog %= (newMsg :)

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

@@ -117,11 +117,11 @@ import Swarm.Game.Robot.Concrete
 import Swarm.Game.Scenario
 import Swarm.Game.Scenario.Objective
 import Swarm.Game.Scenario.Status
-import Swarm.Game.Scenario.Topography.Structure qualified as Structure
 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.Type
+import Swarm.Game.Scenario.Topography.Structure.Type qualified as Structure
 import Swarm.Game.State.Landscape
 import Swarm.Game.State.Robot
 import Swarm.Game.State.Substate
@@ -525,7 +525,7 @@ zoomWorld swName n = do
 -- cell is encountered.
 ensureStructureIntact ::
   (Has (State GameState) sig m) =>
-  FoundStructure ->
+  FoundStructure Cell Entity ->
   m Bool
 ensureStructureIntact (FoundStructure (StructureWithGrid _ _ grid) upperLeft) =
   allM outer $ zip [0 ..] grid
@@ -541,7 +541,7 @@ ensureStructureIntact (FoundStructure (StructureWithGrid _ _ grid) upperLeft) =
 mkRecognizer ::
   (Has (State GameState) sig m) =>
   StaticStructureInfo ->
-  m StructureRecognizer
+  m (StructureRecognizer Cell EntityName Entity)
 mkRecognizer structInfo@(StaticStructureInfo structDefs _) = do
   foundIntact <- mapM (sequenceA . (id &&& ensureStructureIntact)) allPlaced
   let fs = populateStaticFoundStructures . map fst . filter snd $ foundIntact

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

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

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

@@ -44,6 +44,7 @@ import Swarm.Language.Context (empty)
 import Swarm.Language.Pipeline (ProcessedTerm)
 import Swarm.Language.Pipeline.QQ (tmQ)
 import Swarm.Language.Syntax
+import Swarm.Language.Syntax.Direction (Direction)
 import Swarm.Language.Text.Markdown qualified as Markdown
 import Swarm.Util hiding (both)
 import System.Clock (TimeSpec)