diff --git a/data/scenarios/03Challenges/02-drill_test.yaml b/data/scenarios/03Challenges/02-drill_test.yaml index 830e291d8..9ce9db7ac 100644 --- a/data/scenarios/03Challenges/02-drill_test.yaml +++ b/data/scenarios/03Challenges/02-drill_test.yaml @@ -49,7 +49,7 @@ robots: - [1, goal] - [2, metal drill] - [1, drill] - - [2, logger] + - [3, logger] world: default: [ice, knownwater] palette: @@ -69,7 +69,7 @@ world: 'I': [stone, iron vein] upperleft: [-1, 1] map: | - ┌──── ~~ + ┌─────┐ ~~ │IAAT~ ~L~ │..AAA│ ~~ │....C│ ~ diff --git a/src/Swarm/Game/Entity.hs b/src/Swarm/Game/Entity.hs index b166a3490..016ae9962 100644 --- a/src/Swarm/Game/Entity.hs +++ b/src/Swarm/Game/Entity.hs @@ -100,7 +100,7 @@ import qualified Data.IntSet as IS import Data.List (foldl') import Data.Map (Map) import qualified Data.Map as M -import Data.Maybe (isJust, listToMaybe) +import Data.Maybe (isJust, listToMaybe, fromMaybe) import Data.Text (Text) import qualified Data.Text as T import GHC.Generics (Generic) @@ -289,7 +289,7 @@ mkEntity disp nm descr props = -- capabilities they provide (if any). data EntityMap = EntityMap { entitiesByName :: Map Text Entity - , entitiesByCap :: Map Capability Entity + , entitiesByCap :: Map Capability [Entity] } instance Semigroup EntityMap where @@ -305,8 +305,8 @@ lookupEntityName nm = M.lookup nm . entitiesByName -- | Find an entity which is a device that provides the given -- capability. -deviceForCap :: Capability -> EntityMap -> Maybe Entity -deviceForCap cap = M.lookup cap . entitiesByCap +deviceForCap :: Capability -> EntityMap -> [Entity] +deviceForCap cap = fromMaybe [] . M.lookup cap . entitiesByCap -- | Build an 'EntityMap' from a list of entities. The idea is that -- this will be called once at startup, when loading the entities @@ -315,7 +315,7 @@ buildEntityMap :: [Entity] -> EntityMap buildEntityMap es = EntityMap { entitiesByName = M.fromList . map (view entityName &&& id) $ es - , entitiesByCap = M.fromList . concatMap (\e -> map (,e) (e ^. entityCapabilities)) $ es + , entitiesByCap = M.fromListWith (<>) . concatMap (\e -> map (,[e]) (e ^. entityCapabilities)) $ es } ------------------------------------------------------------ diff --git a/src/Swarm/Game/Step.hs b/src/Swarm/Game/Step.hs index d6e7faf9a..8da8044ca 100644 --- a/src/Swarm/Game/Step.hs +++ b/src/Swarm/Game/Step.hs @@ -20,7 +20,7 @@ -- interpreter for the Swarm language. module Swarm.Game.Step where -import Control.Lens hiding (Const, from, parts, use, uses, view, (%=), (+=), (.=), (<+=), (<>=)) +import Control.Lens as Lens hiding (Const, from, parts, use, uses, view, (%=), (+=), (.=), (<+=), (<>=)) import Control.Monad (forM_, guard, msum, unless, when) import Data.Array (bounds, (!)) import Data.Bool (bool) @@ -66,6 +66,7 @@ import Control.Effect.Error import Control.Effect.Lens import Control.Effect.Lift import Data.Functor (void) +import Data.Containers.ListUtils (nubOrd) -- | The maximum number of CESK machine evaluation steps each robot is -- allowed during a single game tick. @@ -1176,18 +1177,29 @@ execConst c vs s k = do -- be run on the other robot, and what devices would provide those -- capabilities. (caps, _capCtx) = requiredCaps (r ^. robotContext . defCaps) cmd - capDevices = S.fromList . mapMaybe (`deviceForCap` em) . S.toList $ caps + + -- list of possible devices per capability + capDevices = map (`deviceForCap` em) . S.toList $ caps -- device is ok if it is installed on the childRobot deviceOK d = (childRobot ^. installedDevices) `E.contains` d + ignoreOK ([], miss) = ([], miss) + ignoreOK (ds, _miss) = (ds, []) + + (deviceSets, missingDeviceSets) = + Lens.over _2 (nubOrd . map S.fromList) . unzip $ + map (ignoreOK . L.partition deviceOK) capDevices - missingDevices = S.filter (not . deviceOK) capDevices + formatDevices = T.intercalate " or " . map (^. entityName) . S.toList -- check if robot has all devices to execute new command - (creative || S.null missingDevices) - `holdsOrFail` [ "the target robot does not have required devices:" - , commaList (map (^. entityName) (S.toList missingDevices)) - ] + (creative || all null missingDeviceSets) + `holdsOrFail` ( "the target robot does not have required devices:" : + (("\n - " <>) . formatDevices <$> filter (not . null) missingDeviceSets) + ) + + (creative || not (any null deviceSets)) + `holdsOrFail` ["the target robot cannot perform an impossible task"] -- update other robot's CESK machine, environment and context -- the childRobot inherits the parent robot's environment @@ -1223,7 +1235,7 @@ execConst c vs s k = do -- would return the capabilities needed to *execute* them), -- hopefully without duplicating too much code. [VDelay cmd e] -> do - r <- get + r <- get @Robot em <- use entityMap creative <- use creativeMode @@ -1236,33 +1248,46 @@ execConst c vs s k = do ["treads", "grabber", "solar panel", "scanner", "plasma cutter"] stdDevices = S.fromList $ mapMaybe (`lookupEntityName` em) stdDeviceList - -- Find out what capabilities are required by the program that will - -- be run on the newly constructed robot, and what devices would - -- provide those capabilities. - (caps, _capCtx) = requiredCaps (r ^. robotContext . defCaps) cmd - capDevices = S.fromList . mapMaybe (`deviceForCap` em) . S.toList $ caps + -- Note that _capCtx must be empty: at least at the + -- moment, definitions are only allowed at the top level, + -- so there can't be any inside the argument to build. + -- (Though perhaps there is an argument that this ought to + -- be relaxed specifically in the case of 'Build'.) + -- See #349 - -- Note that _capCtx must be empty: at least at the - -- moment, definitions are only allowed at the top level, - -- so there can't be any inside the argument to build. - -- (Though perhaps there is an argument that this ought to - -- be relaxed specifically in the case of 'Build'.) + let -- Find out what capabilities are required by the program that will + -- be run on the other robot, and what devices would provide those + -- capabilities. + (caps, _capCtx) = requiredCaps (r ^. robotContext . defCaps) cmd - -- The devices that need to be installed on the new robot is the union - -- of these two sets. - devices = stdDevices `S.union` capDevices + -- list of possible devices per capability + capDevices = map (`deviceForCap` em) . S.toList $ caps -- A device is OK to install if it is a standard device, or we have one -- in our inventory. deviceOK d = d `S.member` stdDevices || (r ^. robotInventory) `E.contains` d + ignoreOK ([], miss) = ([], miss) + ignoreOK (ds, _miss) = (ds, []) - missingDevices = S.filter (not . deviceOK) capDevices + (deviceSets, missingDeviceSets) = + Lens.over both (nubOrd . map S.fromList) . unzip $ + map (ignoreOK . L.partition deviceOK) capDevices + + -- if given a choice between required devices giving same capability + devices = + if creative + then S.unions deviceSets -- give them all in creative + else S.unions $ map (S.take 1) deviceSets -- give first one otherwise + formatDevices = T.intercalate " or " . map (^. entityName) . S.toList + + -- check if robot has all devices to execute new command + (creative || all null missingDeviceSets) + `holdsOrFail` ( "this would require installing devices you don't have:" : + (("\n - " <>) . formatDevices <$> filter (not . null) missingDeviceSets) + ) - -- Make sure we're not missing any required devices. - (creative || S.null missingDevices) - `holdsOrFail` [ "this would require installing devices you don't have:" - , commaList (map (^. entityName) (S.toList missingDevices)) - ] + (creative || not (any null deviceSets)) + `holdsOrFail` ["no robot could perform such impossible task"] -- Pick a random display name. displayName <- randomName