whitelist walkable entities (#1721)

A walkability "blacklist" had already been implemented in #1536.  The whitelist shall **only** permit walking on the specified entities; blank cells become unwalkable.

This feature would allow use of the `path` command to check for "connectivity" by way of a "trail" of entities.

## Use cases

* system robots or goal conditions can use this to check whether the player has connected two points with a road, cable, aqueduct, etc.
* monkeys, which can only move along `tree`s
* sea life, which should only be able to move in `water`

## Testing

    scripts/run-tests.sh --test-arguments '--pattern "walkable-entities"'

data/scenarios/Challenges/Ranching/gated-paddock.yaml

@@ -224,8 +224,9 @@ robots:
     dir: north
     inventory:
       - [4, wool]
-    unwalkable:
-      - gate
+    walkable:
+      never:
+        - gate
     program: |
       run "scenarios/Challenges/Ranching/_gated-paddock/meandering-sheep.sw";
 entities:

data/scenarios/Testing/00-ORDER.txt

@@ -49,6 +49,8 @@ Achievements
 1399-backup-command.yaml
 1430-built-robot-ownership.yaml
 1536-custom-unwalkable-entities.yaml
+1721-custom-walkable-entities.yaml
+1721-walkability-whitelist-path-cache.yaml
 1535-ping
 1575-structure-recognizer
 1631-tags.yaml

data/scenarios/Testing/1536-custom-unwalkable-entities.yaml

@@ -31,8 +31,9 @@ robots:
       - treads
       - dictionary
       - net
-    unwalkable:
-      - tree
+    walkable:
+      never:
+        - tree
 known: [tree, flower, bitcoin]
 world:
   palette:

data/scenarios/Testing/1721-custom-walkable-entities.yaml

@@ -0,0 +1,86 @@
+version: 1
+name: Custom walkability
+description: |
+  The monkey can only walk on `tree`{=entity}s (and `banana`{=entity}s).
+  The `path` command must fail until the path of `tree`{=entity}s is completed.
+
+  NOTE: In order for the objectives to be evaluated properly for a "Win", they must be
+  ordered strictly with "banana_access" coming before "placed_tree" in the
+  list below.
+objectives:
+  - id: banana_access
+    teaser: Banana access
+    goal:
+      - Give monkey access to `banana`{=entity}
+    condition: |
+      m <- robotnamed "monkey";
+      as m {
+        p <- path (inR 10) (inR "banana");
+        return $ case p (\_. false) (\_. true);
+      };
+  - id: placed_tree
+    teaser: Tree placed
+    prerequisite:
+      not: banana_access
+    goal:
+      - Tree must be placed
+    condition: |
+      x <- as base {has "tree"};
+      return $ not x;
+solution: |
+  move;
+  move;
+  place "tree"
+entities:
+  - name: banana
+    display:
+      char: ')'
+      attr: gold
+    description:
+      - Tasty treat for a monkey
+    properties: [known, pickable]
+robots:
+  - name: base
+    dir: east
+    display:
+      attr: robot
+    devices:
+      - logger
+      - grabber
+      - treads
+      - dictionary
+      - net
+    inventory:
+      - [1, tree]
+  - name: monkey
+    dir: south
+    display:
+      char: M
+      attr: robot
+    devices:
+      - logger
+      - grabber
+      - treads
+      - dictionary
+      - net
+    walkable:
+      only:
+        - tree
+        - banana
+known: [tree]
+world:
+  dsl: |
+    {grass}
+  palette:
+    'B': [grass, null, base]
+    'M': [grass, null, monkey]
+    '.': [grass]
+    'T': [grass, tree]
+    'b': [grass, banana]
+  upperleft: [0, 0]
+  map: |
+    ..M.
+    ..T.
+    B...
+    ..T.
+    ..b.

data/scenarios/Testing/1721-walkability-whitelist-path-cache.yaml

@@ -0,0 +1,101 @@
+version: 1
+name: Custom walkability - whitelist
+description: |
+  Exercise various scenarios of path cache invalidation.
+objectives:
+  - goal:
+      - Get somewhere
+    condition: |
+      as base {ishere "platform"}
+solution: |
+  def goDir = \f. \result.
+    let d = fst result in
+    if (d == down) {return ()} {turn d; move; f;}
+    end;
+
+  def followRoute =
+      nextDir <- path (inL ()) (inR "platform");
+      case nextDir return $ goDir followRoute;
+      end;
+
+  followRoute;
+entities:
+  - name: platform
+    display:
+      char: 'P'
+      attr: ice
+    description:
+      - Goal at the end of the trees
+    properties: [known]
+  - name: wayfinder
+    display:
+      char: 'w'
+    description:
+      - |
+        Enables the `path` command:
+      - |
+        `path : (unit + int) -> ((int * int) + text) -> cmd (unit + (dir * int))`
+      - |
+        Optionally supply a distance limit as the first argument, and
+        supply either a location (`inL`) or an entity (`inR`) as the second argument.
+      - |
+        Example:
+      - |
+        `path (inL ()) (inR "tree");`
+      - If a path exists, returns the direction to proceed along.
+    properties: [known, pickable]
+    capabilities: [path]
+robots:
+  - name: base
+    dir: east
+    display:
+      attr: robot
+    devices:
+      - ADT calculator
+      - branch predictor
+      - comparator
+      - compass
+      - dictionary
+      - grabber
+      - logger
+      - net
+      - treads
+      - wayfinder
+    walkable:
+      only:
+        - tree
+        - platform
+  - name: sysbot
+    dir: east
+    system: true
+    display:
+      attr: robot
+      invisible: false
+    program: |
+      move;
+      t <- grab;
+      move;
+      place t;
+      turn left;
+      move;
+      move;
+      t2 <- grab;
+      turn back;
+      move;
+known: [tree]
+world:
+  dsl: |
+    {grass}
+  palette:
+    'B': [grass, null, base]
+    'S': [grass, null, sysbot]
+    '.': [grass]
+    'T': [grass, tree]
+    'P': [grass, platform]
+  upperleft: [0, 0]
+  map: |
+    ............
+    ......TTT...
+    BTTTTTTTTP..
+    ............
+    .....ST.....

data/schema/robot.json

@@ -77,13 +77,28 @@
             "type": "boolean",
             "description": "Whether the robot is heavy. Heavy robots require `tank treads` to `move` (rather than just `treads` for other robots)."
         },
-        "unwalkable": {
-            "default": [],
-            "type": "array",
-            "items": {
-                "type": "string"
-            },
-            "description": "A list of entities that this robot cannot walk across."
+        "walkable": {
+            "type": "object",
+            "additionalProperties": false,
+            "description": "Blacklist/whitelist of walkable entities",
+            "properties": {
+                "never": {
+                    "default": [],
+                    "type": "array",
+                    "items": {
+                        "type": "string"
+                    },
+                    "description": "A list of entities that this robot cannot walk across."
+                },
+                "only": {
+                    "default": [],
+                    "type": "array",
+                    "items": {
+                        "type": "string"
+                    },
+                    "description": "An exclusive list of entities that this robot can walk across."
+                }
+            }
         }
     },
     "required": [

src/swarm-engine/Swarm/Game/Robot/Concrete.hs

@@ -42,6 +42,7 @@ import Swarm.Game.Entity hiding (empty)
 import Swarm.Game.Robot
 import Swarm.Game.Robot.Activity
 import Swarm.Game.Robot.Context
+import Swarm.Game.Robot.Walk (emptyExceptions)
 import Swarm.Game.Tick
 import Swarm.Game.Universe
 import Swarm.Language.Pipeline (ProcessedTerm)
@@ -109,7 +110,7 @@ instance ToSample Robot where
           []
           False
           False
-          mempty
+          emptyExceptions
           0
 
 mkMachine :: Maybe ProcessedTerm -> C.CESK

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

@@ -53,6 +53,7 @@ import Swarm.Game.Robot
 import Swarm.Game.Robot.Activity
 import Swarm.Game.Robot.Concrete
 import Swarm.Game.Robot.Context
+import Swarm.Game.Robot.Walk (emptyExceptions)
 import Swarm.Game.Scenario.Objective qualified as OB
 import Swarm.Game.Scenario.Objective.WinCheck qualified as WC
 import Swarm.Game.State
@@ -376,7 +377,7 @@ hypotheticalRobot m =
       []
       True
       False
-      mempty
+      emptyExceptions
 
 evaluateCESK ::
   ( Has Effect.Time sig m

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

@@ -31,6 +31,7 @@ import Swarm.Game.Entity qualified as E
 import Swarm.Game.Land
 import Swarm.Game.Location
 import Swarm.Game.Robot
+import Swarm.Game.Robot.Walk (emptyExceptions)
 import Swarm.Game.State
 import Swarm.Game.State.Landscape
 import Swarm.Game.State.Robot
@@ -113,7 +114,7 @@ addCombustionBot inputEntity combustibility ts loc = do
       botInventory
       True
       False
-      mempty
+      emptyExceptions
       ts
   return combustionDurationRand
  where
@@ -225,5 +226,5 @@ addIgnitionBot ignitionDelay inputEntity ts loc =
       []
       True
       False
-      mempty
+      emptyExceptions
       ts

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

@@ -60,6 +60,7 @@ import Swarm.Game.Robot
 import Swarm.Game.Robot.Activity
 import Swarm.Game.Robot.Concrete
 import Swarm.Game.Robot.Context
+import Swarm.Game.Robot.Walk (emptyExceptions)
 import Swarm.Game.Scenario.Topography.Area (getAreaDimensions)
 import Swarm.Game.Scenario.Topography.Navigation.Portal (Navigation (..))
 import Swarm.Game.Scenario.Topography.Navigation.Util
@@ -259,8 +260,8 @@ execConst runChildProg c vs s k = do
         let maybeFirstFailure = asum failureMaybes
 
         applyMoveFailureEffect maybeFirstFailure $ \case
-          PathBlocked -> ThrowExn
-          PathLiquid -> Destroy
+          PathBlockedBy _ -> ThrowExn
+          PathLiquid _ -> Destroy
 
         let maybeLastLoc = do
               guard $ null maybeFirstFailure
@@ -280,8 +281,8 @@ execConst runChildProg c vs s k = do
 
         onTarget rid $ do
           checkMoveAhead nextLoc $ \case
-            PathBlocked -> Destroy
-            PathLiquid -> Destroy
+            PathBlockedBy _ -> Destroy
+            PathLiquid _ -> Destroy
           updateRobotLocation oldLoc nextLoc
 
         -- Privileged robots can teleport without causing any
@@ -1105,7 +1106,7 @@ execConst runChildProg c vs s k = do
               []
               isSystemRobot
               False
-              mempty
+              emptyExceptions
               createdAt
 
         -- Provision the new robot with the necessary devices and inventory.
@@ -1611,28 +1612,30 @@ execConst runChildProg c vs s k = do
     loc <- use robotLocation
     let nextLoc = loc `offsetBy` orientation
     checkMoveAhead nextLoc $ \case
-      PathBlocked -> ThrowExn
-      PathLiquid -> Destroy
+      PathBlockedBy _ -> ThrowExn
+      PathLiquid _ -> Destroy
     updateRobotLocation loc nextLoc
     return $ mkReturn ()
 
   applyMoveFailureEffect ::
     (HasRobotStepState sig m, Has (Lift IO) sig m) =>
-    Maybe MoveFailureDetails ->
+    Maybe MoveFailureMode ->
     MoveFailureHandler ->
     m ()
   applyMoveFailureEffect maybeFailure failureHandler =
     case maybeFailure of
       Nothing -> return ()
-      Just (MoveFailureDetails e failureMode) -> case failureHandler failureMode of
+      Just failureMode -> case failureHandler failureMode of
         IgnoreFail -> return ()
         Destroy -> destroyIfNotBase $ \b -> case (b, failureMode) of
-          (True, PathLiquid) -> Just RobotIntoWater -- achievement for drowning
+          (True, PathLiquid _) -> Just RobotIntoWater -- achievement for drowning
           _ -> Nothing
         ThrowExn -> throwError . cmdExn c $
           case failureMode of
-            PathBlocked -> ["There is a", e ^. entityName, "in the way!"]
-            PathLiquid -> ["There is a dangerous liquid", e ^. entityName, "in the way!"]
+            PathBlockedBy ent -> case ent of
+              Just e -> ["There is a", e ^. entityName, "in the way!"]
+              Nothing -> ["There is nothing to travel on!"]
+            PathLiquid e -> ["There is a dangerous liquid", e ^. entityName, "in the way!"]
 
   -- Determine the move failure mode and apply the corresponding effect.
   checkMoveAhead ::