-- |
-- SPDX-License-Identifier: BSD-3-Clause
--
-- Walkability logic
module Swarm.Game.Step.Path.Walkability where

import Control.Lens
import Data.Set qualified as S
import Swarm.Game.Entity hiding (empty, lookup, singleton, union)
import Swarm.Game.Robot.Walk
import Swarm.Language.Capability

data MoveFailureMode
  = -- | Can't move due to something blocking the path.  Note that if
    --   the robot has a path Whitelist, then the /absence/ of an entity
    --   could block the path (represented by `PathBlockedBy
    --   Nothing`).
    PathBlockedBy (Maybe Entity)
  | -- | Some liquid entity is in the path.
    PathLiquid Entity

-- | Pure logic used inside of
--   'Swarm.Game.Step.Util.checkMoveFailureUnprivileged'.  Given a
--   (possibly empty) walkable entity whitelist or blacklist, and the
--   entity (or lack thereof) in the cell we are trying to move to,
--   determine whether there is some kind of movement failure.
checkUnwalkable ::
  WalkabilityContext ->
  Maybe Entity ->
  Maybe MoveFailureMode
checkUnwalkable :: WalkabilityContext -> Maybe Entity -> Maybe MoveFailureMode
checkUnwalkable (WalkabilityContext Set Capability
_ WalkabilityExceptions EntityName
walkExceptions) Maybe Entity
Nothing =
  -- If there's no entity in the path, we are blocked only if a
  -- whitelist of walkable entities is specified
  case WalkabilityExceptions EntityName
walkExceptions of
    Whitelist Set EntityName
_ -> MoveFailureMode -> Maybe MoveFailureMode
forall a. a -> Maybe a
Just (MoveFailureMode -> Maybe MoveFailureMode)
-> MoveFailureMode -> Maybe MoveFailureMode
forall a b. (a -> b) -> a -> b
$ Maybe Entity -> MoveFailureMode
PathBlockedBy Maybe Entity
forall a. Maybe a
Nothing
    Blacklist Set EntityName
_ -> Maybe MoveFailureMode
forall a. Maybe a
Nothing
checkUnwalkable (WalkabilityContext Set Capability
caps WalkabilityExceptions EntityName
walkExceptions) (Just Entity
e)
  | Bool
isUnwalkableEntity =
      MoveFailureMode -> Maybe MoveFailureMode
forall a. a -> Maybe a
Just (MoveFailureMode -> Maybe MoveFailureMode)
-> MoveFailureMode -> Maybe MoveFailureMode
forall a b. (a -> b) -> a -> b
$ Maybe Entity -> MoveFailureMode
PathBlockedBy (Maybe Entity -> MoveFailureMode)
-> Maybe Entity -> MoveFailureMode
forall a b. (a -> b) -> a -> b
$ Entity -> Maybe Entity
forall a. a -> Maybe a
Just Entity
e
  -- Robots drown if they walk over liquid without the Float capability
  | Entity
e Entity -> EntityProperty -> Bool
`hasProperty` EntityProperty
Liquid Bool -> Bool -> Bool
&& Capability
CFloat Capability -> Set Capability -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.notMember` Set Capability
caps =
      MoveFailureMode -> Maybe MoveFailureMode
forall a. a -> Maybe a
Just (MoveFailureMode -> Maybe MoveFailureMode)
-> MoveFailureMode -> Maybe MoveFailureMode
forall a b. (a -> b) -> a -> b
$ Entity -> MoveFailureMode
PathLiquid Entity
e
  | Bool
otherwise = Maybe MoveFailureMode
forall a. Maybe a
Nothing
 where
  eName :: EntityName
eName = Entity
e Entity -> Getting EntityName Entity EntityName -> EntityName
forall s a. s -> Getting a s a -> a
^. Getting EntityName Entity EntityName
Lens' Entity EntityName
entityName
  -- An entity blocks a robot if...
  isUnwalkableEntity :: Bool
isUnwalkableEntity = case WalkabilityExceptions EntityName
walkExceptions of
    -- ...it's not one of the whitelisted entities...
    Whitelist Set EntityName
onlyWalkables -> EntityName
eName EntityName -> Set EntityName -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.notMember` Set EntityName
onlyWalkables
    -- ...OR if it is inherently unwalkable, or is blacklisted.
    Blacklist Set EntityName
unwalkables -> Entity
e Entity -> EntityProperty -> Bool
`hasProperty` EntityProperty
Unwalkable Bool -> Bool -> Bool
|| EntityName
eName EntityName -> Set EntityName -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` Set EntityName
unwalkables