Use common code for incapable exception

- fixes swarm-game#342

src/Swarm/Game/CESK.hs

@@ -320,7 +320,7 @@ prettyCESK (Out v _ k) =
     ]
 prettyCESK (Up e _ k) =
   unlines
-    [ "! " ++ from (formatExn e)
+    [ "! " ++ from (formatExn mempty e)
     , "  " ++ prettyCont k
     ]
 prettyCESK (Waiting t cek) =

src/Swarm/Game/Exception.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE OverloadedStrings #-}
 
 -- |
@@ -10,18 +11,29 @@
 -- Runtime exceptions for the Swarm language interpreter.
 module Swarm.Game.Exception (
   Exn (..),
+  IncapableFix (..),
   formatExn,
 ) where
 
 import Data.Set (Set)
 import Data.Text (Text)
 import qualified Data.Text as T
 
+import Control.Lens ((^.))
+import qualified Data.Set as S
+import Swarm.Game.Entity (EntityMap, deviceForCap, entityName)
 import Swarm.Language.Capability
 import Swarm.Language.Pretty (prettyText)
 import Swarm.Language.Syntax
 import Swarm.Util
 
+-- | Suggested way to fix incapable error.
+data IncapableFix
+  = FixByInstall -- ^ install the missing device on yourself/target
+  | FixByObtain -- ^ add the missing device to your inventory
+  deriving (Eq, Show)
+
+
 -- | The type of exceptions that can be thrown by robot programs.
 data Exn
   = -- | Something went very wrong.  This is a bug in Swarm and cannot
@@ -34,7 +46,7 @@ data Exn
   | -- | A robot tried to do something for which it does not have some
     --   of the required capabilities.  This cannot be caught by a
     --   @try@ block.
-    Incapable (Set Capability) Term
+    Incapable IncapableFix (Set Capability) Term
   | -- | A command failed in some "normal" way (/e.g./ a 'Move'
     --   command could not move, or a 'Grab' command found nothing to
     --   grab, /etc./).
@@ -43,18 +55,55 @@ data Exn
     User Text
   deriving (Eq, Show)
 
--- | Pretty-print an exception for displaying to the user.
-formatExn :: Exn -> Text
-formatExn (Fatal t) =
-  T.unlines
-    [ T.append "fatal error: " t
-    , "Please report this as a bug at https://github.com/swarm-game/swarm/issues/new ."
-    ]
-formatExn InfiniteLoop = "Infinite loop detected!"
-formatExn (Incapable _caps tm) =
-  T.concat
-    [ "missing device(s) needed to execute command "
-    , squote (prettyText tm)
-    ]
-formatExn (CmdFailed c t) = T.concat [prettyText c, ": ", t]
-formatExn (User t) = T.concat ["user exception: ", t]
+-- | Pretty-print an exception for displaying to the player.
+formatExn :: EntityMap -> Exn -> Text
+formatExn em = \case
+  Fatal t ->
+    T.unlines
+      [ "Fatal error: " <> t
+      , "Please report this as a bug at"
+      , "<https://github.com/swarm-game/swarm/issues/new>."
+      ]
+  InfiniteLoop -> "Infinite loop detected!"
+  (CmdFailed c t) -> T.concat [prettyText c, ": ", t]
+  (User t) -> "Player exception: " <> t
+  (Incapable f caps tm) -> formatIncapable em f caps tm
+
+-- ------------------------------------------------------------------
+-- INCAPABLE HELPERS
+-- ------------------------------------------------------------------
+
+formatIncapableFix :: IncapableFix -> Text
+formatIncapableFix = \case
+  FixByInstall -> "Install"
+  FixByObtain -> "Obtain"
+
+-- | Pretty print the incapable exception with actionable suggestion
+--   on what to install to fix it.
+formatIncapable :: EntityMap -> IncapableFix -> Set Capability -> Term -> Text
+formatIncapable em f caps tm
+  | CGod `S.member` caps = "Can not perform an impossible task:\n" <> prettyText tm
+  | not (null capsNone) =
+      T.unlines
+        [ "Missing the " <> capMsg <> " required for:"
+        , prettyText tm
+        , "because no device can provide it."
+        , "See https://github.com/swarm-game/swarm/issues/26."
+        ]
+  | otherwise =
+      T.unlines
+        ( "You do not have the devices required for:" :
+          prettyText tm :
+          formatIncapableFix f <>":" :
+          (("  - " <>) . formatDevices <$> filter (not . null) deviceSets)
+        )
+ where
+  capList = S.toList caps
+  deviceSets = map (`deviceForCap` em) capList
+  devicePerCap = zip capList deviceSets
+  -- capabilities not provided by any device
+  capsNone = map (capabilityName . fst) $ filter (null . snd) devicePerCap
+  capMsg = case capsNone of
+    [ca] -> ca <> " capability"
+    cas -> "capabilities " <> T.intercalate ", " (map squote cas)
+  formatDevices = T.intercalate " or " . map (^. entityName)

src/Swarm/Game/Step.hs

@@ -281,7 +281,7 @@ ensureCanExecute c = do
   robotCaps <- use robotCapabilities
   let missingCaps = constCaps c `S.difference` robotCaps
   (sys || creative || S.null missingCaps)
-    `holdsOr` Incapable missingCaps (TConst c)
+    `holdsOr` Incapable FixByInstall missingCaps (TConst c)
 
 -- | Test whether the current robot has a given capability (either
 --   because it has a device which gives it that capability, or it is a
@@ -299,7 +299,7 @@ hasCapabilityFor ::
   (Has (State Robot) sig m, Has (State GameState) sig m, Has (Throw Exn) sig m) => Capability -> Term -> m ()
 hasCapabilityFor cap term = do
   h <- hasCapability cap
-  h `holdsOr` Incapable (S.singleton cap) term
+  h `holdsOr` Incapable FixByInstall (S.singleton cap) term
 
 -- | Create an exception about a command failing.
 cmdExn :: Const -> [Text] -> Exn
@@ -566,8 +566,9 @@ stepCESK cesk = case cesk of
   Up exn s [] -> do
     let s' = resetBlackholes s
     h <- hasCapability CLog
+    em <- use entityMap
     case h of
-      True -> return $ In (TApp (TConst Log) (TString (formatExn exn))) empty s' [FExec]
+      True -> return $ In (TApp (TConst Log) (TString (formatExn em exn))) empty s' [FExec]
       False -> return $ Out VUnit s' []
   -- Fatal errors, capability errors, and infinite loop errors can't
   -- be caught; just throw away the continuation stack.
@@ -1173,7 +1174,7 @@ execConst c vs s k = do
         (creative || (childRobot ^. robotLocation) `manhattan` loc <= 1)
           `holdsOrFail` ["You can only program adjacent robot"]
 
-        _ <- checkRequiredDevices (childRobot ^. robotInventory) cmd "The target robot"
+        _ <- checkRequiredDevices (childRobot ^. robotInventory) cmd "The target robot" FixByInstall
 
         -- update other robot's CESK machine, environment and context
         -- the childRobot inherits the parent robot's environment
@@ -1223,7 +1224,7 @@ execConst c vs s k = do
             stdDevices = S.fromList $ mapMaybe (`lookupEntityName` em) stdDeviceList
             addStdDevs i = foldr insert i stdDevices
 
-        deviceSets <- checkRequiredDevices (addStdDevs $ r ^. robotInventory) cmd "You"
+        deviceSets <- checkRequiredDevices (addStdDevs $ r ^. robotInventory) cmd "You" FixByObtain
 
         let devices =
               if creative -- if given a choice between required devices giving same capability
@@ -1408,8 +1409,9 @@ execConst c vs s k = do
     Inventory ->
     Term ->
     Text ->
+    IncapableFix ->
     m [S.Set Entity]
-  checkRequiredDevices inventory cmd subject = do
+  checkRequiredDevices inventory cmd subject fixI = do
     currentContext <- use $ robotContext . defCaps
     em <- use entityMap
     creative <- use creativeMode
@@ -1436,29 +1438,19 @@ execConst c vs s k = do
             map (ignoreOK . L.partition deviceOK) capDevices
 
         formatDevices = T.intercalate " or " . map (^. entityName) . S.toList
+        -- capabilities not provided by any device in inventory
+        missingCaps = S.fromList . map fst . filter (null . snd) $ zip caps deviceSets
+
+    unless creative $ do
+      -- check if robot has all devices to execute new command
+      all null missingDeviceSets
+        `holdsOrFail` ( singularSubjectVerb subject "do" :
+                        "not have required devices:" :
+                        (("\n  - " <>) . formatDevices <$> filter (not . null) missingDeviceSets)
+                      )
+      -- check that there are in fact devices to provide every required capability
+      not (any null deviceSets) `holdsOr` Incapable fixI missingCaps cmd
 
-    -- check that the capability is not restricted to system robots
-    (creative || CGod `notElem` caps)
-      `holdsOrFail` [singularSubjectVerb subject "can", "not perform an impossible task"]
-    -- check if robot has all devices to execute new command
-    (creative || all null missingDeviceSets)
-      `holdsOrFail` ( singularSubjectVerb subject "do" :
-                      "not have required devices:" :
-                      (("\n  - " <>) . formatDevices <$> filter (not . null) missingDeviceSets)
-                    )
-    -- check that there are in fact devices to provide every required capability
-    let capsNone = map (capabilityName . fst) . filter (null . snd) $ zip caps deviceSets
-        capMsg = case capsNone of
-          [ca] -> indefiniteQ ca <> "capability"
-          cas -> "the capabilities " <> T.intercalate ", " (map squote cas)
-
-    (creative || not (any null deviceSets))
-      `holdsOrFail` [ singularSubjectVerb subject "do"
-                    , "not have"
-                    , capMsg
-                    , ", because no device can provide it."
-                    , "\nSee https://github.com/swarm-game/swarm/issues/26."
-                    ]
     -- give back the devices required per capability
     return deviceSets