Convert device capabilities from Set to Map

app/doc/Swarm/Doc/Schema/Render.hs

@@ -25,7 +25,6 @@ import Swarm.Doc.Schema.Arrangement
 import Swarm.Doc.Schema.Parse
 import Swarm.Doc.Schema.Refined
 import Swarm.Doc.Schema.SchemaType
-import Swarm.Doc.Util
 import Swarm.Doc.Wiki.Util
 import Swarm.Util (applyWhen, brackets, quote, showT)
 import System.Directory (listDirectory)
@@ -77,7 +76,7 @@ makePandocTable titleMap (SchemaData _ (ToplevelSchema theTitle theDescription _
     ItemList xs ->
       makePropsTable False listColumnHeadings titleMap
         . M.fromList
-        $ zip (map tshow [0 :: Int ..]) xs
+        $ zip (map showT [0 :: Int ..]) xs
 
   mkTable x = doc $ case x of
     ObjectProperties props -> makePropsTable True propertyColumnHeadings titleMap props

app/doc/Swarm/Doc/Wiki/Cheatsheet.hs

@@ -18,15 +18,15 @@ import Control.Lens.Combinators (to)
 import Data.Foldable (find, toList)
 import Data.List (transpose)
 import Data.Map.Lazy qualified as Map
-import Data.Maybe (fromMaybe, isJust)
-import Data.Set qualified as Set
+import Data.Maybe (isJust)
 import Data.Text (Text)
 import Data.Text qualified as T
 import Data.Text.IO qualified as T
 import Swarm.Doc.Schema.Render
 import Swarm.Doc.Util
 import Swarm.Doc.Wiki.Matrix
 import Swarm.Doc.Wiki.Util
+import Swarm.Game.Device qualified as D
 import Swarm.Game.Display (displayChar)
 import Swarm.Game.Entity (Entity, EntityMap (entitiesByName), entityDisplay, entityName, loadEntities)
 import Swarm.Game.Entity qualified as E
@@ -38,7 +38,7 @@ import Swarm.Language.Syntax (Const (..))
 import Swarm.Language.Syntax qualified as Syntax
 import Swarm.Language.Text.Markdown as Markdown (docToMark)
 import Swarm.Language.Typecheck (inferConst)
-import Swarm.Util (listEnums)
+import Swarm.Util (listEnums, showT)
 import Swarm.Util.Effect (simpleErrorHandle)
 
 -- * Types
@@ -106,7 +106,7 @@ commandToList :: Const -> [Text]
 commandToList c =
   map
     escapeTable
-    [ addLink ("#" <> tshow c) . codeQuote $ constSyntax c
+    [ addLink ("#" <> showT c) . codeQuote $ constSyntax c
     , codeQuote . prettyTextLine $ inferConst c
     , maybe "" Capability.capabilityName $ Capability.constCaps c
     , Syntax.briefDoc . Syntax.constDoc $ Syntax.constInfo c
@@ -168,13 +168,13 @@ capabilityRow PageAddress {..} em cap =
   linkCommand c =
     ( if T.null commandsAddress
         then id
-        else addLink (commandsAddress <> "#" <> tshow c)
+        else addLink (commandsAddress <> "#" <> showT c)
     )
       . codeQuote
       $ constSyntax c
 
   cs = [c | c <- Syntax.allConst, let mcap = Capability.constCaps c, isJust $ find (== cap) mcap]
-  es = fromMaybe [] $ E.entitiesByCap em Map.!? cap
+  es = maybe [] (map D.device) $ E.entitiesByCap em Map.!? cap
 
 capabilityTable :: PageAddress -> EntityMap -> [Capability] -> Text
 capabilityTable a em cs = T.unlines $ header <> map (listToRow mw) capabilityRows
@@ -197,8 +197,8 @@ entityToList e =
     escapeTable
     [ codeQuote . T.singleton $ e ^. entityDisplay . to displayChar
     , addLink ("#" <> linkID) $ view entityName e
-    , T.intercalate ", " $ Capability.capabilityName <$> Set.toList (view E.entityCapabilities e)
-    , T.intercalate ", " . map tshow . filter (/= E.Pickable) $ toList props
+    , T.intercalate ", " $ Capability.capabilityName <$> Map.keys (D.getMap $ view E.entityCapabilities e)
+    , T.intercalate ", " . map showT . filter (/= E.Pickable) $ toList props
     , if E.Pickable `elem` props
         then ":heavy_check_mark:"
         else ":negative_squared_cross_mark:"
@@ -221,13 +221,13 @@ entityToSection e =
     , ""
     , " - Char: " <> (codeQuote . T.singleton $ e ^. entityDisplay . to displayChar)
     ]
-      <> [" - Properties: " <> T.intercalate ", " (map tshow $ toList props) | not $ null props]
+      <> [" - Properties: " <> T.intercalate ", " (map showT $ toList props) | not $ null props]
       <> [" - Capabilities: " <> T.intercalate ", " (Capability.capabilityName <$> caps) | not $ null caps]
       <> ["\n"]
       <> [Markdown.docToMark $ view E.entityDescription e]
  where
   props = view E.entityProperties e
-  caps = Set.toList $ view E.entityCapabilities e
+  caps = Map.keys $ D.getMap $ view E.entityCapabilities e
 
 entitiesPage :: PageAddress -> [Entity] -> Text
 entitiesPage _a es =
@@ -251,11 +251,11 @@ recipeRow PageAddress {..} r =
     [ T.intercalate ", " (map formatCE $ view recipeInputs r)
     , T.intercalate ", " (map formatCE $ view recipeOutputs r)
     , T.intercalate ", " (map formatCE $ view recipeCatalysts r)
-    , tshow $ view recipeTime r
-    , tshow $ view recipeWeight r
+    , showT $ view recipeTime r
+    , showT $ view recipeWeight r
     ]
  where
-  formatCE (c, e) = T.unwords [tshow c, linkEntity $ view entityName e]
+  formatCE (c, e) = T.unwords [showT c, linkEntity $ view entityName e]
   linkEntity t =
     if T.null entityAddress
       then t

data/scenarios/Testing/00-ORDER.txt

@@ -55,3 +55,4 @@ Achievements
 1634-message-colors.yaml
 1681-pushable-entity.yaml
 1747-volume-command.yaml
+1777-capability-cost.yaml

data/scenarios/Testing/1777-capability-cost.yaml

@@ -0,0 +1,61 @@
+version: 1
+name: Capability cost
+description: |
+  Consume inventory by exercising device capabilities
+creative: false
+objectives:
+  - goal:
+      - |
+        Eliminate the paper
+    condition: |
+      judge <- robotnamed "judge";
+      as judge {
+        dist <- sniff "paper";
+        return $ dist < 0;
+      }
+solution: |
+  ignite forward;
+robots:
+  - name: base
+    dir: east
+    devices:
+      - treads
+      - Zippo
+    inventory:
+      - [1, lighter fluid]
+  - name: judge
+    dir: east
+    system: true
+entities:
+  - name: lighter fluid
+    display:
+      char: 'f'
+    description:
+      - Fuel for a Zippo
+    properties: [known, pickable]
+  - name: Zippo
+    display:
+      char: 'z'
+    description:
+      - Ignites things
+    properties: [known, pickable]
+    capabilities:
+      - capability: ignite
+        cost:
+          - [1, "lighter fluid"]
+known: [ash]
+world:
+  dsl: |
+    {grass}
+  palette:
+    'B': [grass, null, base]
+    'j': [grass, null, judge]
+    '.': [grass]
+    'c': [grass, paper]
+  upperleft: [-1, 1]
+  map: |
+    ......
+    Bcccc.
+    .j..c.
+    .cccc.
+    ......

data/schema/entity.json

@@ -94,10 +94,30 @@
             "description": "A list of properties of this entity."
         },
         "capabilities": {
+
             "default": [],
             "type": "array",
             "items": {
-                "type": "string"
+                "oneOf": [
+                    {
+                        "type": "string"
+                    },
+                    {
+                        "type": "object",
+                        "additionalProperties": false,
+                        "properties": {
+                            "capability": {
+                                "description": "Capability name",
+                                "type": "string"
+                            },
+                            "cost": {
+                                "$ref": "inventory.json",
+                                "description": "A list of ingredients consumed by the command."
+                            }
+                        }
+                    }
+                ]
+
             },
             "description": "A list of capabilities provided by entity, when it is equipped as a device. See [Capabilities](https://github.com/swarm-game/swarm/wiki/Capabilities-cheat-sheet)."
         }

src/Swarm/Doc/Util.hs

@@ -30,9 +30,6 @@ codeQuote = wrap '`'
 addLink :: Text -> Text -> Text
 addLink l t = T.concat ["[", t, "](", l, ")"]
 
-tshow :: (Show a) => a -> Text
-tshow = T.pack . show
-
 -- * Common symbols
 
 operators :: [Const]

src/Swarm/TUI/Model.hs

@@ -117,6 +117,7 @@ import GitHash (GitInfo)
 import Graphics.Vty (ColorMode (..))
 import Network.Wai.Handler.Warp (Port)
 import Swarm.Game.Entity as E
+import Swarm.Game.Ingredients
 import Swarm.Game.Robot
 import Swarm.Game.Robot.Concrete
 import Swarm.Game.Robot.Context

src/Swarm/TUI/Model/Menu.hs

@@ -21,6 +21,7 @@ import Data.Text (Text)
 import Data.Vector qualified as V
 import Swarm.Game.Achievement.Definitions
 import Swarm.Game.Entity as E
+import Swarm.Game.Ingredients
 import Swarm.Game.ScenarioInfo (
   ScenarioCollection,
   ScenarioInfo (..),

src/Swarm/TUI/View.hs

@@ -73,8 +73,10 @@ import Network.Wai.Handler.Warp (Port)
 import Numeric (showFFloat)
 import Swarm.Constant
 import Swarm.Game.CESK (CESK (..))
+import Swarm.Game.Device (getMap)
 import Swarm.Game.Display
 import Swarm.Game.Entity as E
+import Swarm.Game.Ingredients
 import Swarm.Game.Location
 import Swarm.Game.Recipe
 import Swarm.Game.Robot
@@ -1199,8 +1201,8 @@ explainEntry s e =
     , drawMarkdown (e ^. entityDescription)
     , explainRecipes s e
     ]
-      <> [drawRobotMachine s False | e ^. entityCapabilities . Lens.contains CDebug]
-      <> [drawRobotLog s | e ^. entityCapabilities . Lens.contains CLog]
+      <> [drawRobotMachine s False | CDebug `M.member` getMap (e ^. entityCapabilities)]
+      <> [drawRobotLog s | CLog `M.member` getMap (e ^. entityCapabilities)]
 
 displayProperties :: [EntityProperty] -> Widget Name
 displayProperties = displayList . mapMaybe showProperty
@@ -1349,7 +1351,7 @@ drawRecipe me inv (Recipe ins outs reqs time _weight) =
 
 -- | Ad-hoc entity to represent time - only used in recipe drawing
 timeE :: Entity
-timeE = mkEntity (defaultEntityDisplay '.') "ticks" mempty [] []
+timeE = mkEntity (defaultEntityDisplay '.') "ticks" mempty [] mempty
 
 drawReqs :: IngredientList Entity -> Widget Name
 drawReqs = vBox . map (hCenter . drawReq)

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

@@ -86,8 +86,9 @@ import Data.IntMap.Strict (IntMap)
 import Data.IntMap.Strict qualified as IM
 import GHC.Generics (Generic)
 import Prettyprinter (Doc, Pretty (..), encloseSep, hsep, (<+>))
-import Swarm.Game.Entity (Count, Entity)
+import Swarm.Game.Entity (Entity)
 import Swarm.Game.Exception
+import Swarm.Game.Ingredients (Count)
 import Swarm.Game.Tick
 import Swarm.Game.World (WorldUpdate (..))
 import Swarm.Language.Context

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

@@ -99,6 +99,7 @@ import Data.Text.Lazy qualified as TL
 import Data.Text.Lazy.Encoding qualified as TL
 import Linear (V2 (..))
 import Swarm.Game.CESK (emptyStore, finalValue, initMachine)
+import Swarm.Game.Device (getMap)
 import Swarm.Game.Entity
 import Swarm.Game.Failure (SystemFailure (..))
 import Swarm.Game.Location
@@ -595,7 +596,7 @@ pureScenarioToGameState scenario theSeed now toRun gsc =
 
   em = integrateScenarioEntities (initState gsc) sLandscape
   baseID = 0
-  (things, devices) = partition (null . view entityCapabilities) (M.elems (entitiesByName em))
+  (things, devices) = partition (M.null . getMap . view entityCapabilities) (M.elems (entitiesByName em))
 
   getCodeToRun (CodeToRun _ s) = s
 

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

@@ -32,6 +32,7 @@ import Swarm.Game.Achievement.Attainment
 import Swarm.Game.Achievement.Definitions
 import Swarm.Game.Achievement.Description (getValidityRequirements)
 import Swarm.Game.CESK
+import Swarm.Game.Device (getMap)
 import Swarm.Game.Display
 import Swarm.Game.Entity hiding (empty, lookup, singleton, union)
 import Swarm.Game.Entity qualified as E
@@ -61,12 +62,39 @@ import Swarm.Util hiding (both)
 import System.Clock (TimeSpec)
 import Prelude hiding (Applicative (..), lookup)
 
-data GrabbingCmd = Grab' | Harvest' | Swap' | Push' deriving (Eq, Show)
+data GrabbingCmd
+  = Grab'
+  | Harvest'
+  | Swap'
+  | Push'
+  deriving (Eq, Show)
 
 -- | Ensure that a robot is capable of executing a certain constant
 --   (either because it has a device which gives it that capability,
 --   or it is a system robot, or we are in creative mode).
-ensureCanExecute :: (Has (State Robot) sig m, Has (State GameState) sig m, Has (Throw Exn) sig m) => Const -> m ()
+--
+-- For certain capabilities that require payment of inventory
+-- items in order to be exercised, we pay the toll up front, regardless of
+-- other conditions that may preclude the capability from eventually
+-- being exercised (e.g. an obstacle that ultimately prevents a "move").
+--
+-- Note that there exist some code paths where the "toll"
+-- is bypassed, e.g. see 'hasCapabilityFor'.
+-- We should just try to avoid authoring scenarios that
+-- include toll-gated devices for those particular capabilities.
+--
+-- Since this function has the side-effect of removing items from the
+-- robot's inventory, we must be careful that it is executed exactly
+-- once per command.
+--
+-- TODO: Finish this
+ensureCanExecute ::
+  ( Has (State Robot) sig m
+  , Has (State GameState) sig m
+  , Has (Throw Exn) sig m
+  ) =>
+  Const ->
+  m ()
 ensureCanExecute c =
   gets @Robot (constCapsFor c) >>= \case
     Nothing -> pure ()
@@ -247,9 +275,9 @@ updateAvailableRecipes invs e = do
 
 updateAvailableCommands :: Has (State GameState) sig m => Entity -> m ()
 updateAvailableCommands e = do
-  let newCaps = e ^. entityCapabilities
+  let newCaps = getMap $ e ^. entityCapabilities
       keepConsts = \case
-        Just cap -> cap `S.member` newCaps
+        Just cap -> cap `M.member` newCaps
         Nothing -> False
       entityConsts = filter (keepConsts . constCaps) allConst
   knownCommands <- use $ discovery . availableCommands . notificationsContent