{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE OverloadedStrings #-}

-- |
-- SPDX-License-Identifier: BSD-3-Clause
module Swarm.Game.Step.Util where

import Control.Applicative (Applicative (..))
import Control.Carrier.State.Lazy
import Control.Effect.Error
import Control.Effect.Lens
import Control.Effect.Lift
import Control.Lens as Lens hiding (Const, distrib, from, parts, use, uses, view, (%=), (+=), (.=), (<+=), (<>=))
import Control.Monad (forM, forM_, guard, join, when)
import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.Maybe (MaybeT (..), runMaybeT)
import Data.Array (bounds, (!))
import Data.IntMap qualified as IM
import Data.List (find)
import Data.Map qualified as M
import Data.Set qualified as S
import Data.Text (Text)
import Data.Text qualified as T
import Linear (zero)
import Swarm.Game.Entity hiding (empty, lookup, singleton, union)
import Swarm.Game.Exception
import Swarm.Game.Location
import Swarm.Game.ResourceLoading (NameGenerator (..))
import Swarm.Game.Robot
import Swarm.Game.State
import Swarm.Game.Universe
import Swarm.Game.World qualified as W
import Swarm.Game.World.Modify qualified as WM
import Swarm.Language.Capability
import Swarm.Language.Requirement qualified as R
import Swarm.Language.Syntax
import Swarm.Util hiding (both)
import System.Clock (TimeSpec)
import System.Clock qualified
import System.Random (UniformRange, uniformR)
import Prelude hiding (Applicative (..), lookup)

-- | All functions that are used for robot step can access 'GameState' and the current 'Robot'.
--
-- They can also throw exception of our custom type, which is handled elsewhere.
-- Because of that the constraint is only 'Throw', but not 'Catch'/'Error'.
type HasRobotStepState sig m = (Has (State GameState) sig m, Has (State Robot) sig m, Has (Throw Exn) sig m)

deriveHeading :: HasRobotStepState sig m => Direction -> m Heading
deriveHeading :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
HasRobotStepState sig m =>
Direction -> m Heading
deriveHeading Direction
d = do
  Maybe Heading
orient <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Lens' Robot (Maybe Heading)
robotOrientation
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Direction -> Bool
isCardinal Direction
d) forall a b. (a -> b) -> a -> b
$ forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (State Robot) sig m, Has (State GameState) sig m,
 Has (Throw Exn) sig m) =>
Capability -> Term -> m ()
hasCapabilityFor Capability
COrient forall a b. (a -> b) -> a -> b
$ forall ty. Direction -> Term' ty
TDir Direction
d
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Direction -> Heading -> Heading
applyTurn Direction
d forall a b. (a -> b) -> a -> b
$ Maybe Heading
orient forall a. Maybe a -> a -> a
? forall (f :: * -> *) a. (Additive f, Num a) => f a
zero

lookInDirection :: HasRobotStepState sig m => Direction -> m (Cosmic Location, Maybe Entity)
lookInDirection :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
HasRobotStepState sig m =>
Direction -> m (Cosmic Location, Maybe Entity)
lookInDirection Direction
d = do
  Heading
newHeading <- forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
HasRobotStepState sig m =>
Direction -> m Heading
deriveHeading Direction
d
  Cosmic Location
loc <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Getter Robot (Cosmic Location)
robotLocation
  let nextLoc :: Cosmic Location
nextLoc = Cosmic Location
loc Cosmic Location -> Heading -> Cosmic Location
`offsetBy` Heading
newHeading
  (Cosmic Location
nextLoc,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
Cosmic Location -> m (Maybe Entity)
entityAt Cosmic Location
nextLoc

-- | Modify the entity (if any) at a given location.
updateEntityAt ::
  (Has (State GameState) sig m) =>
  Cosmic Location ->
  (Maybe Entity -> Maybe Entity) ->
  m ()
updateEntityAt :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
Cosmic Location -> (Maybe Entity -> Maybe Entity) -> m ()
updateEntityAt cLoc :: Cosmic Location
cLoc@(Cosmic SubworldName
subworldName Location
loc) Maybe Entity -> Maybe Entity
upd = do
  Maybe (CellUpdate Entity)
someChange <-
    forall (sig :: (* -> *) -> * -> *) (m :: * -> *) b.
Has (State GameState) sig m =>
SubworldName -> StateC (World Int Entity) Identity b -> m (Maybe b)
zoomWorld SubworldName
subworldName forall a b. (a -> b) -> a -> b
$
      forall t (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (State (World t Entity)) sig m, IArray UArray t) =>
Coords -> (Maybe Entity -> Maybe Entity) -> m (CellUpdate Entity)
W.updateM @Int (Location -> Coords
W.locToCoords Location
loc) Maybe Entity -> Maybe Entity
upd

  forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (forall e. CellUpdate e -> Maybe (CellModification e)
WM.getModification forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe (CellUpdate Entity)
someChange) forall a b. (a -> b) -> a -> b
$ \CellModification Entity
_modType -> do
    forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
Cosmic Location -> m ()
wakeWatchingRobots Cosmic Location
cLoc

-- * Capabilities

-- | Exempts the robot from various command constraints
-- when it is either a system robot or playing in creative mode
isPrivilegedBot :: (Has (State GameState) sig m, Has (State Robot) sig m) => m Bool
isPrivilegedBot :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (State GameState) sig m, Has (State Robot) sig m) =>
m Bool
isPrivilegedBot = Bool -> Bool -> Bool
(||) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Lens' Robot Bool
systemRobot forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Lens' GameState Bool
creativeMode

-- | Test whether the current robot has a given capability (either
--   because it has a device which gives it that capability, or it is a
--   system robot, or we are in creative mode).
hasCapability :: (Has (State Robot) sig m, Has (State GameState) sig m) => Capability -> m Bool
hasCapability :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (State Robot) sig m, Has (State GameState) sig m) =>
Capability -> m Bool
hasCapability Capability
cap = do
  Bool
isPrivileged <- forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (State GameState) sig m, Has (State Robot) sig m) =>
m Bool
isPrivilegedBot
  Set Capability
caps <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Getter Robot (Set Capability)
robotCapabilities
  forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
isPrivileged Bool -> Bool -> Bool
|| Capability
cap forall a. Ord a => a -> Set a -> Bool
`S.member` Set Capability
caps)

-- | Ensure that either a robot has a given capability, OR we are in creative
--   mode.
hasCapabilityFor ::
  (Has (State Robot) sig m, Has (State GameState) sig m, Has (Throw Exn) sig m) => Capability -> Term -> m ()
hasCapabilityFor :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (State Robot) sig m, Has (State GameState) sig m,
 Has (Throw Exn) sig m) =>
Capability -> Term -> m ()
hasCapabilityFor Capability
cap Term
term = do
  Bool
h <- forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (State Robot) sig m, Has (State GameState) sig m) =>
Capability -> m Bool
hasCapability Capability
cap
  Bool
h forall e (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (Throw e) sig m =>
Bool -> e -> m ()
`holdsOr` IncapableFix -> Requirements -> Term -> Exn
Incapable IncapableFix
FixByEquip (Capability -> Requirements
R.singletonCap Capability
cap) Term
term

-- * Exceptions

holdsOrFail' :: (Has (Throw Exn) sig m) => Const -> Bool -> [Text] -> m ()
holdsOrFail' :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (Throw Exn) sig m =>
Const -> Bool -> [Text] -> m ()
holdsOrFail' Const
c Bool
a [Text]
ts = Bool
a forall e (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (Throw e) sig m =>
Bool -> e -> m ()
`holdsOr` Const -> [Text] -> Exn
cmdExn Const
c [Text]
ts

isJustOrFail' :: (Has (Throw Exn) sig m) => Const -> Maybe a -> [Text] -> m a
isJustOrFail' :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Throw Exn) sig m =>
Const -> Maybe a -> [Text] -> m a
isJustOrFail' Const
c Maybe a
a [Text]
ts = Maybe a
a forall e (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Throw e) sig m =>
Maybe a -> e -> m a
`isJustOr` Const -> [Text] -> Exn
cmdExn Const
c [Text]
ts

-- | Create an exception about a command failing.
cmdExn :: Const -> [Text] -> Exn
cmdExn :: Const -> [Text] -> Exn
cmdExn Const
c [Text]
parts = Const -> Text -> Maybe GameplayAchievement -> Exn
CmdFailed Const
c ([Text] -> Text
T.unwords [Text]
parts) forall a. Maybe a
Nothing

-- * Some utility functions

getNow :: Has (Lift IO) sig m => m TimeSpec
getNow :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (Lift IO) sig m =>
m TimeSpec
getNow = forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Lift IO) sig m =>
IO a -> m a
sendIO forall a b. (a -> b) -> a -> b
$ Clock -> IO TimeSpec
System.Clock.getTime Clock
System.Clock.Monotonic

-- | Set a flag telling the UI that the world needs to be redrawn.
flagRedraw :: (Has (State GameState) sig m) => m ()
flagRedraw :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
m ()
flagRedraw = Lens' GameState Bool
needsRedraw forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> b -> m ()
.= Bool
True

-- * World queries

getNeighborLocs :: Cosmic Location -> [Cosmic Location]
getNeighborLocs :: Cosmic Location -> [Cosmic Location]
getNeighborLocs Cosmic Location
loc = forall a b. (a -> b) -> [a] -> [b]
map (Cosmic Location -> Heading -> Cosmic Location
offsetBy Cosmic Location
loc forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip Direction -> Heading -> Heading
applyTurn Heading
north forall b c a. (b -> c) -> (a -> b) -> a -> c
. RelativeDir -> Direction
DRelative forall b c a. (b -> c) -> (a -> b) -> a -> c
. PlanarRelativeDir -> RelativeDir
DPlanar) forall e. (Enum e, Bounded e) => [e]
listEnums

-- | Perform an action requiring a 'W.World' state component in a
--   larger context with a 'GameState'.
zoomWorld ::
  (Has (State GameState) sig m) =>
  SubworldName ->
  StateC (W.World Int Entity) Identity b ->
  m (Maybe b)
zoomWorld :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *) b.
Has (State GameState) sig m =>
SubworldName -> StateC (World Int Entity) Identity b -> m (Maybe b)
zoomWorld SubworldName
swName StateC (World Int Entity) Identity b
n = do
  MultiWorld Int Entity
mw <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use forall a b. (a -> b) -> a -> b
$ Lens' GameState Landscape
landscape forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Landscape (MultiWorld Int Entity)
multiWorld
  forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup SubworldName
swName MultiWorld Int Entity
mw) forall a b. (a -> b) -> a -> b
$ \World Int Entity
w -> do
    let (World Int Entity
w', b
a) = forall a. Identity a -> a
run (forall s (m :: * -> *) a. s -> StateC s m a -> m (s, a)
runState World Int Entity
w StateC (World Int Entity) Identity b
n)
    Lens' GameState Landscape
landscape forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Landscape (MultiWorld Int Entity)
multiWorld forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> (a -> b) -> m ()
%= forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert SubworldName
swName World Int Entity
w'
    forall (m :: * -> *) a. Monad m => a -> m a
return b
a

-- | Get the entity (if any) at a given location.
entityAt :: (Has (State GameState) sig m) => Cosmic Location -> m (Maybe Entity)
entityAt :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
Cosmic Location -> m (Maybe Entity)
entityAt (Cosmic SubworldName
subworldName Location
loc) =
  forall (m :: * -> *) a. Monad m => m (m a) -> m a
join forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (sig :: (* -> *) -> * -> *) (m :: * -> *) b.
Has (State GameState) sig m =>
SubworldName -> StateC (World Int Entity) Identity b -> m (Maybe b)
zoomWorld SubworldName
subworldName (forall t e (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (State (World t e)) sig m, IArray UArray t) =>
Coords -> m (Maybe e)
W.lookupEntityM @Int (Location -> Coords
W.locToCoords Location
loc))

-- | Get the robot with a given ID.
robotWithID :: (Has (State GameState) sig m) => RID -> m (Maybe Robot)
robotWithID :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
Int -> m (Maybe Robot)
robotWithID Int
rid = forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use (Lens' GameState (IntMap Robot)
robotMap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Int
rid)

-- | Get the robot with a given name.
robotWithName :: (Has (State GameState) sig m) => Text -> m (Maybe Robot)
robotWithName :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
Text -> m (Maybe Robot)
robotWithName Text
rname = forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use (Lens' GameState (IntMap Robot)
robotMap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to forall a. IntMap a -> [a]
IM.elems forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find forall a b. (a -> b) -> a -> b
$ \Robot
r -> Robot
r forall s a. s -> Getting a s a -> a
^. Lens' Robot Text
robotName forall a. Eq a => a -> a -> Bool
== Text
rname))

-- * Randomness

-- | Generate a uniformly random number using the random generator in
--   the game state.
uniform :: (Has (State GameState) sig m, UniformRange a) => (a, a) -> m a
uniform :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
(Has (State GameState) sig m, UniformRange a) =>
(a, a) -> m a
uniform (a, a)
bnds = do
  StdGen
rand <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Lens' GameState StdGen
randGen
  let (a
n, StdGen
g) = forall g a. (RandomGen g, UniformRange a) => (a, a) -> g -> (a, g)
uniformR (a, a)
bnds StdGen
rand
  Lens' GameState StdGen
randGen forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> b -> m ()
.= StdGen
g
  forall (m :: * -> *) a. Monad m => a -> m a
return a
n

-- | Given a weighting function and a list of values, choose one of
--   the values randomly (using the random generator in the game
--   state), with the probability of each being proportional to its
--   weight.  Return @Nothing@ if the list is empty.
weightedChoice :: Has (State GameState) sig m => (a -> Integer) -> [a] -> m (Maybe a)
weightedChoice :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (State GameState) sig m =>
(a -> Integer) -> [a] -> m (Maybe a)
weightedChoice a -> Integer
weight [a]
as = do
  Integer
r <- forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
(Has (State GameState) sig m, UniformRange a) =>
(a, a) -> m a
uniform (Integer
0, Integer
total forall a. Num a => a -> a -> a
- Integer
1)
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Integer -> [a] -> Maybe a
go Integer
r [a]
as
 where
  total :: Integer
total = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum (forall a b. (a -> b) -> [a] -> [b]
map a -> Integer
weight [a]
as)

  go :: Integer -> [a] -> Maybe a
go Integer
_ [] = forall a. Maybe a
Nothing
  go !Integer
k (a
x : [a]
xs)
    | Integer
k forall a. Ord a => a -> a -> Bool
< Integer
w = forall a. a -> Maybe a
Just a
x
    | Bool
otherwise = Integer -> [a] -> Maybe a
go (Integer
k forall a. Num a => a -> a -> a
- Integer
w) [a]
xs
   where
    w :: Integer
w = a -> Integer
weight a
x

-- | Generate a random robot name in the form @adjective_name@.
randomName :: Has (State GameState) sig m => m Text
randomName :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
m Text
randomName = do
  NameGenerator Array Int Text
adjs Array Int Text
names <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use forall a b. (a -> b) -> a -> b
$ Lens' GameState RobotNaming
robotNaming forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getter RobotNaming NameGenerator
nameGenerator
  Int
i <- forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
(Has (State GameState) sig m, UniformRange a) =>
(a, a) -> m a
uniform (forall i e. Array i e -> (i, i)
bounds Array Int Text
adjs)
  Int
j <- forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
(Has (State GameState) sig m, UniformRange a) =>
(a, a) -> m a
uniform (forall i e. Array i e -> (i, i)
bounds Array Int Text
names)
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.concat [Array Int Text
adjs forall i e. Ix i => Array i e -> i -> e
! Int
i, Text
"_", Array Int Text
names forall i e. Ix i => Array i e -> i -> e
! Int
j]

-- * Moving

data MoveFailureMode = PathBlocked | PathLiquid
data MoveFailureDetails = MoveFailureDetails Entity MoveFailureMode

-- | Make sure nothing is in the way.
-- No exception for system robots
checkMoveFailureUnprivileged :: HasRobotStepState sig m => Cosmic Location -> m (Maybe MoveFailureDetails)
checkMoveFailureUnprivileged :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
HasRobotStepState sig m =>
Cosmic Location -> m (Maybe MoveFailureDetails)
checkMoveFailureUnprivileged Cosmic Location
nextLoc = do
  Maybe Entity
me <- forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
Cosmic Location -> m (Maybe Entity)
entityAt Cosmic Location
nextLoc
  Set Capability
caps <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Getter Robot (Set Capability)
robotCapabilities
  Set Text
unwalkables <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Lens' Robot (Set Text)
unwalkableEntities
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ do
    Entity
e <- Maybe Entity
me
    Set Capability -> Set Text -> Entity -> Maybe MoveFailureDetails
go Set Capability
caps Set Text
unwalkables Entity
e
 where
  go :: Set Capability -> Set Text -> Entity -> Maybe MoveFailureDetails
go Set Capability
caps Set Text
unwalkables Entity
e
    -- robots can not walk through walls
    | Entity
e Entity -> EntityProperty -> Bool
`hasProperty` EntityProperty
Unwalkable Bool -> Bool -> Bool
|| (Entity
e forall s a. s -> Getting a s a -> a
^. Lens' Entity Text
entityName) forall a. Ord a => a -> Set a -> Bool
`S.member` Set Text
unwalkables = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Entity -> MoveFailureMode -> MoveFailureDetails
MoveFailureDetails Entity
e MoveFailureMode
PathBlocked
    -- robots drown if they walk over liquid without boat
    | Entity
e Entity -> EntityProperty -> Bool
`hasProperty` EntityProperty
Liquid Bool -> Bool -> Bool
&& Capability
CFloat forall a. Ord a => a -> Set a -> Bool
`S.notMember` Set Capability
caps =
        forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Entity -> MoveFailureMode -> MoveFailureDetails
MoveFailureDetails Entity
e MoveFailureMode
PathLiquid
    | Bool
otherwise = forall a. Maybe a
Nothing

-- | Make sure nothing is in the way. Note that system robots implicitly ignore
-- and base throws on failure.
checkMoveFailure :: HasRobotStepState sig m => Cosmic Location -> m (Maybe MoveFailureDetails)
checkMoveFailure :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
HasRobotStepState sig m =>
Cosmic Location -> m (Maybe MoveFailureDetails)
checkMoveFailure Cosmic Location
nextLoc = do
  Bool
systemRob <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Lens' Robot Bool
systemRobot
  forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT forall a b. (a -> b) -> a -> b
$ do
    forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not Bool
systemRob
    Maybe MoveFailureDetails
maybeMoveFailure <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
HasRobotStepState sig m =>
Cosmic Location -> m (Maybe MoveFailureDetails)
checkMoveFailureUnprivileged Cosmic Location
nextLoc
    forall (m :: * -> *) b. Applicative m => Maybe b -> MaybeT m b
hoistMaybe Maybe MoveFailureDetails
maybeMoveFailure