-- |
-- 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
  = -- | If the robot has a path Whitelist,
    -- then the absence of an entity could prevent walkability (represented by `PathBlockedBy Nothing`).
    PathBlockedBy (Maybe Entity)
  | PathLiquid Entity

-- | Pure logic used inside of
-- 'Swarm.Game.Step.Util.checkMoveFailureUnprivileged'
checkUnwalkable ::
  WalkabilityContext ->
  Maybe Entity ->
  Maybe MoveFailureMode
checkUnwalkable :: WalkabilityContext -> Maybe Entity -> Maybe MoveFailureMode
checkUnwalkable (WalkabilityContext Set Capability
_ WalkabilityExceptions EntityName
walkExceptions) Maybe Entity
Nothing =
  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)
  -- robots can not walk through walls
  | 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 boat
  | 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
  isUnwalkableEntity :: Bool
isUnwalkableEntity = case WalkabilityExceptions EntityName
walkExceptions of
    Whitelist Set EntityName
onlyWalkables -> EntityName
eName EntityName -> Set EntityName -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.notMember` Set EntityName
onlyWalkables
    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