{-# LANGUAGE DataKinds #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE ViewPatterns #-}

-- |
-- SPDX-License-Identifier: BSD-3-Clause
--
-- A data type to represent robots.
module Swarm.Game.Robot (
  -- * Robots data
  _robotID,
  _robotLocation,
  RobotMachine,
  _machine,
  RobotActivity,
  _activityCounts,
  RobotLogMember,
  _robotLog,
  RobotLogUpdatedMember,
  _robotLogUpdated,

  -- * Robots
  RobotPhase (..),
  RID,
  RobotR,
  Robot,
  TRobot,

  -- ** Lenses
  robotEntity,
  robotName,
  trobotName,
  unwalkableEntities,
  robotCreatedAt,
  robotDisplay,
  robotLocation,
  unsafeSetRobotLocation,
  trobotLocation,
  robotOrientation,
  robotInventory,
  trobotInventory,
  equippedDevices,
  tequippedDevices,
  inventoryHash,
  robotCapabilities,
  walkabilityContext,
  robotID,
  robotParentID,
  robotHeavy,
  systemRobot,
  selfDestruct,
  runningAtomic,

  -- ** Creation & instantiation
  mkRobot,

  -- ** Query
  robotKnows,
  isInteractive,

  -- ** Constants
  hearingDistance,
) where

import Control.Applicative ((<|>))
import Control.Lens hiding (Const, contains)
import Data.Hashable (hashWithSalt)
import Data.Kind qualified
import Data.Text (Text)
import Data.Yaml (FromJSON (parseJSON), (.!=), (.:), (.:?))
import GHC.Generics (Generic)
import Linear
import Swarm.Game.Device
import Swarm.Game.Display (Display, curOrientation, defaultRobotDisplay, invisible)
import Swarm.Game.Entity hiding (empty)
import Swarm.Game.Ingredients
import Swarm.Game.Land
import Swarm.Game.Location (Heading, Location, toDirection, toHeading)
import Swarm.Game.Robot.Walk
import Swarm.Game.Universe
import Swarm.Language.JSON ()
import Swarm.Language.Syntax (Syntax, TSyntax)
import Swarm.Language.Text.Markdown (Document)
import Swarm.Util.Lens (makeLensesExcluding)
import Swarm.Util.Yaml
import System.Clock (TimeSpec)

-- | A unique identifier for a robot.
type RID = Int

-- | The phase of a robot description record.
data RobotPhase
  = -- | The robot record has just been read in from a scenario
    --   description; it represents a /template/ that may later be
    --   instantiated as one or more concrete robots.
    TemplateRobot
  | -- | The robot record represents a concrete robot in the world.
    ConcreteRobot

-- | With a robot template, we may or may not have a location.  With a
--   concrete robot we must have a location.
type family RobotLocation (phase :: RobotPhase) :: Data.Kind.Type where
  RobotLocation 'TemplateRobot = Maybe (Cosmic Location)
  RobotLocation 'ConcreteRobot = Cosmic Location

-- | Robot templates have no ID; concrete robots definitely do.
type family RobotID (phase :: RobotPhase) :: Data.Kind.Type where
  RobotID 'TemplateRobot = ()
  RobotID 'ConcreteRobot = RID

type family RobotMachine (phase :: RobotPhase) :: Data.Kind.Type
type instance RobotMachine 'TemplateRobot = Maybe TSyntax

type family RobotActivity (phase :: RobotPhase) :: Data.Kind.Type
type instance RobotActivity 'TemplateRobot = ()

type family RobotLogMember (phase :: RobotPhase) :: Data.Kind.Type
type instance RobotLogMember 'TemplateRobot = ()

type family RobotLogUpdatedMember (phase :: RobotPhase) :: Data.Kind.Type
type instance RobotLogUpdatedMember 'TemplateRobot = ()

-- | A value of type 'RobotR' is a record representing the state of a
--   single robot.  The @f@ parameter is for tracking whether or not
--   the robot has been assigned a unique ID.
data RobotR (phase :: RobotPhase) = RobotR
  { forall (phase :: RobotPhase). RobotR phase -> Entity
_robotEntity :: Entity
  , forall (phase :: RobotPhase). RobotR phase -> Inventory
_equippedDevices :: Inventory
  , forall (phase :: RobotPhase).
RobotR phase -> MultiEntityCapabilities Entity EntityName
_robotCapabilities :: MultiEntityCapabilities Entity EntityName
  -- ^ A cached view of the capabilities this robot has.
  --   Automatically generated from '_equippedDevices'.
  , forall (phase :: RobotPhase). RobotR phase -> RobotLogMember phase
_robotLog :: RobotLogMember phase
  , forall (phase :: RobotPhase).
RobotR phase -> RobotLogUpdatedMember phase
_robotLogUpdated :: RobotLogUpdatedMember phase
  , forall (phase :: RobotPhase). RobotR phase -> RobotLocation phase
_robotLocation :: RobotLocation phase
  , forall (phase :: RobotPhase). RobotR phase -> RobotID phase
_robotID :: RobotID phase
  , forall (phase :: RobotPhase). RobotR phase -> Maybe RID
_robotParentID :: Maybe RID
  , forall (phase :: RobotPhase). RobotR phase -> Bool
_robotHeavy :: Bool
  , forall (phase :: RobotPhase). RobotR phase -> RobotMachine phase
_machine :: RobotMachine phase
  , forall (phase :: RobotPhase). RobotR phase -> Bool
_systemRobot :: Bool
  , forall (phase :: RobotPhase). RobotR phase -> Bool
_selfDestruct :: Bool
  , forall (phase :: RobotPhase). RobotR phase -> RobotActivity phase
_activityCounts :: RobotActivity phase
  , forall (phase :: RobotPhase). RobotR phase -> Bool
_runningAtomic :: Bool
  , forall (phase :: RobotPhase).
RobotR phase -> WalkabilityExceptions EntityName
_unwalkableEntities :: WalkabilityExceptions EntityName
  , forall (phase :: RobotPhase). RobotR phase -> TimeSpec
_robotCreatedAt :: TimeSpec
  }
  deriving ((forall x. RobotR phase -> Rep (RobotR phase) x)
-> (forall x. Rep (RobotR phase) x -> RobotR phase)
-> Generic (RobotR phase)
forall x. Rep (RobotR phase) x -> RobotR phase
forall x. RobotR phase -> Rep (RobotR phase) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (phase :: RobotPhase) x.
Rep (RobotR phase) x -> RobotR phase
forall (phase :: RobotPhase) x.
RobotR phase -> Rep (RobotR phase) x
$cfrom :: forall (phase :: RobotPhase) x.
RobotR phase -> Rep (RobotR phase) x
from :: forall x. RobotR phase -> Rep (RobotR phase) x
$cto :: forall (phase :: RobotPhase) x.
Rep (RobotR phase) x -> RobotR phase
to :: forall x. Rep (RobotR phase) x -> RobotR phase
Generic)

deriving instance (Show (RobotLocation phase), Show (RobotID phase), Show (RobotMachine phase), Show (RobotActivity phase), Show (RobotLogMember phase), Show (RobotLogUpdatedMember phase)) => Show (RobotR phase)
deriving instance (Eq (RobotLocation phase), Eq (RobotID phase), Eq (RobotMachine phase), Eq (RobotActivity phase), Eq (RobotLogMember phase), Eq (RobotLogUpdatedMember phase)) => Eq (RobotR phase)

-- See https://byorgey.wordpress.com/2021/09/17/automatically-updated-cached-views-with-lens/
-- for the approach used here with lenses.

makeLensesExcluding ['_robotCapabilities, '_equippedDevices, '_robotLog, '_robotLogUpdated, '_machine, '_activityCounts] ''RobotR

-- | A template robot, i.e. a template robot record without a unique ID number,
--   and possibly without a location.
type TRobot = RobotR 'TemplateRobot

-- | A concrete robot, with a unique ID number and a specific location.
type Robot = RobotR 'ConcreteRobot

-- In theory we could make all these lenses over (RobotR phase), but
-- that leads to lots of type ambiguity problems later.  In practice
-- we only need lenses for Robots.

-- | Robots are not entities, but they have almost all the
--   characteristics of one (or perhaps we could think of robots as
--   very special sorts of entities), so for convenience each robot
--   carries an 'Entity' record to store all the information it has in
--   common with any 'Entity'.
--
--   Note there are various lenses provided for convenience that
--   directly reference fields inside this record; for example, one
--   can use 'robotName' instead of writing @'robotEntity'
--   . 'entityName'@.
robotEntity :: Lens' (RobotR phase) Entity

-- | Entities that the robot cannot move onto
unwalkableEntities :: Lens' Robot (WalkabilityExceptions EntityName)

-- | The creation date of the robot.
robotCreatedAt :: Lens' Robot TimeSpec

-- robotName and trobotName could be generalized to
-- @robotName' :: Lens' (RobotR phase) Text@.
-- However, type inference does not work
-- very well with the polymorphic version, so we export both
-- monomorphic versions instead.

-- | The name of a robot.
robotName :: Lens' Robot Text
robotName :: Lens' Robot EntityName
robotName = (Entity -> f Entity) -> Robot -> f Robot
forall (phase :: RobotPhase) (f :: * -> *).
Functor f =>
(Entity -> f Entity) -> RobotR phase -> f (RobotR phase)
robotEntity ((Entity -> f Entity) -> Robot -> f Robot)
-> ((EntityName -> f EntityName) -> Entity -> f Entity)
-> (EntityName -> f EntityName)
-> Robot
-> f Robot
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (EntityName -> f EntityName) -> Entity -> f Entity
Lens' Entity EntityName
entityName

-- | The name of a robot template.
trobotName :: Lens' TRobot Text
trobotName :: Lens' TRobot EntityName
trobotName = (Entity -> f Entity) -> TRobot -> f TRobot
forall (phase :: RobotPhase) (f :: * -> *).
Functor f =>
(Entity -> f Entity) -> RobotR phase -> f (RobotR phase)
robotEntity ((Entity -> f Entity) -> TRobot -> f TRobot)
-> ((EntityName -> f EntityName) -> Entity -> f Entity)
-> (EntityName -> f EntityName)
-> TRobot
-> f TRobot
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (EntityName -> f EntityName) -> Entity -> f Entity
Lens' Entity EntityName
entityName

-- | The 'Display' of a robot.  This is a special lens that
--   automatically sets the 'curOrientation' to the orientation of the
--   robot every time you do a @get@ operation.  Technically this does
--   not satisfy the lens laws---in particular, the get/put law does
--   not hold.  But we should think of the 'curOrientation' as being
--   simply a cache of the displayed entity's direction.
robotDisplay :: Lens' Robot Display
robotDisplay :: Lens' Robot Display
robotDisplay = (Robot -> Display)
-> (Robot -> Display -> Robot) -> Lens' Robot Display
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Robot -> Display
getDisplay Robot -> Display -> Robot
forall {phase :: RobotPhase}.
RobotR phase -> Display -> RobotR phase
setDisplay
 where
  getDisplay :: Robot -> Display
getDisplay Robot
r =
    (Robot
r Robot -> Getting Display Robot Display -> Display
forall s a. s -> Getting a s a -> a
^. (Entity -> Const Display Entity) -> Robot -> Const Display Robot
forall (phase :: RobotPhase) (f :: * -> *).
Functor f =>
(Entity -> f Entity) -> RobotR phase -> f (RobotR phase)
robotEntity ((Entity -> Const Display Entity) -> Robot -> Const Display Robot)
-> ((Display -> Const Display Display)
    -> Entity -> Const Display Entity)
-> Getting Display Robot Display
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Display -> Const Display Display)
-> Entity -> Const Display Entity
Lens' Entity Display
entityDisplay)
      Display -> (Display -> Display) -> Display
forall a b. a -> (a -> b) -> b
& (Maybe Direction -> Identity (Maybe Direction))
-> Display -> Identity Display
Lens' Display (Maybe Direction)
curOrientation ((Maybe Direction -> Identity (Maybe Direction))
 -> Display -> Identity Display)
-> Maybe Direction -> Display -> Display
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ((Robot
r Robot
-> Getting (Maybe Heading) Robot (Maybe Heading) -> Maybe Heading
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Heading) Robot (Maybe Heading)
Lens' Robot (Maybe Heading)
robotOrientation) Maybe Heading -> (Heading -> Maybe Direction) -> Maybe Direction
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Heading -> Maybe Direction
toDirection)
  setDisplay :: RobotR phase -> Display -> RobotR phase
setDisplay RobotR phase
r Display
d = RobotR phase
r RobotR phase -> (RobotR phase -> RobotR phase) -> RobotR phase
forall a b. a -> (a -> b) -> b
& (Entity -> Identity Entity)
-> RobotR phase -> Identity (RobotR phase)
forall (phase :: RobotPhase) (f :: * -> *).
Functor f =>
(Entity -> f Entity) -> RobotR phase -> f (RobotR phase)
robotEntity ((Entity -> Identity Entity)
 -> RobotR phase -> Identity (RobotR phase))
-> ((Display -> Identity Display) -> Entity -> Identity Entity)
-> (Display -> Identity Display)
-> RobotR phase
-> Identity (RobotR phase)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Display -> Identity Display) -> Entity -> Identity Entity
Lens' Entity Display
entityDisplay ((Display -> Identity Display)
 -> RobotR phase -> Identity (RobotR phase))
-> Display -> RobotR phase -> RobotR phase
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Display
d

-- | The robot's current location, represented as @(x,y)@.  This is only
--   a getter, since when changing a robot's location we must remember
--   to update the 'Swarm.Game.State.robotsByLocation' map as well.  You can use the
--   'Swarm.Game.Step.updateRobotLocation' function for this purpose.
robotLocation :: Getter Robot (Cosmic Location)

-- | Set a robot's location.  This is unsafe and should never be
--   called directly except by the 'Swarm.Game.Step.updateRobotLocation' function.
--   The reason is that we need to make sure the 'Swarm.Game.State.robotsByLocation'
--   map stays in sync.
unsafeSetRobotLocation :: Cosmic Location -> Robot -> Robot
unsafeSetRobotLocation :: Cosmic Location -> Robot -> Robot
unsafeSetRobotLocation Cosmic Location
loc Robot
r = Robot
r {_robotLocation = loc}

-- | A template robot's location.  Unlike 'robotLocation', this is a
--   lens, since when dealing with robot templates there is as yet no
--   'Swarm.Game.State.robotsByLocation' map to keep up-to-date.
trobotLocation :: Lens' TRobot (Maybe (Cosmic Location))
trobotLocation :: Lens' TRobot (Maybe (Cosmic Location))
trobotLocation = (TRobot -> Maybe (Cosmic Location))
-> (TRobot -> Maybe (Cosmic Location) -> TRobot)
-> Lens' TRobot (Maybe (Cosmic Location))
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens TRobot -> Maybe (Cosmic Location)
TRobot -> RobotLocation 'TemplateRobot
forall (phase :: RobotPhase). RobotR phase -> RobotLocation phase
_robotLocation (\TRobot
r Maybe (Cosmic Location)
l -> TRobot
r {_robotLocation = l})

-- | Which way the robot is currently facing.
robotOrientation :: Lens' Robot (Maybe Heading)
robotOrientation :: Lens' Robot (Maybe Heading)
robotOrientation = (Entity -> f Entity) -> Robot -> f Robot
forall (phase :: RobotPhase) (f :: * -> *).
Functor f =>
(Entity -> f Entity) -> RobotR phase -> f (RobotR phase)
robotEntity ((Entity -> f Entity) -> Robot -> f Robot)
-> ((Maybe Heading -> f (Maybe Heading)) -> Entity -> f Entity)
-> (Maybe Heading -> f (Maybe Heading))
-> Robot
-> f Robot
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Heading -> f (Maybe Heading)) -> Entity -> f Entity
Lens' Entity (Maybe Heading)
entityOrientation

-- | The robot's inventory.
robotInventory :: Lens' Robot Inventory
robotInventory :: Lens' Robot Inventory
robotInventory = (Entity -> f Entity) -> Robot -> f Robot
forall (phase :: RobotPhase) (f :: * -> *).
Functor f =>
(Entity -> f Entity) -> RobotR phase -> f (RobotR phase)
robotEntity ((Entity -> f Entity) -> Robot -> f Robot)
-> ((Inventory -> f Inventory) -> Entity -> f Entity)
-> (Inventory -> f Inventory)
-> Robot
-> f Robot
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Inventory -> f Inventory) -> Entity -> f Entity
Lens' Entity Inventory
entityInventory

-- | A robot template's inventory.
trobotInventory :: Lens' TRobot Inventory
trobotInventory :: Lens' TRobot Inventory
trobotInventory = (Entity -> f Entity) -> TRobot -> f TRobot
forall (phase :: RobotPhase) (f :: * -> *).
Functor f =>
(Entity -> f Entity) -> RobotR phase -> f (RobotR phase)
robotEntity ((Entity -> f Entity) -> TRobot -> f TRobot)
-> ((Inventory -> f Inventory) -> Entity -> f Entity)
-> (Inventory -> f Inventory)
-> TRobot
-> f TRobot
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Inventory -> f Inventory) -> Entity -> f Entity
Lens' Entity Inventory
entityInventory

-- | The (unique) ID number of the robot.  This is only a Getter since
--   the robot ID is immutable.
robotID :: Getter Robot RID

-- | The ID number of the robot's parent, that is, the robot that
--   built (or most recently reprogrammed) this robot, if there is
--   one.
robotParentID :: Lens' Robot (Maybe RID)

-- | Is this robot extra heavy (thus requiring tank treads to move)?
robotHeavy :: Lens' Robot Bool

-- | A separate inventory for equipped devices, which provide the
--   robot with certain capabilities.
--
--   Note that every time the inventory of equipped devices is
--   modified, this lens recomputes a cached set of the capabilities
--   the equipped devices provide, to speed up subsequent lookups to
--   see whether the robot has a certain capability (see 'robotCapabilities')
equippedDevices :: Lens' Robot Inventory
equippedDevices :: Lens' Robot Inventory
equippedDevices = (Robot -> Inventory)
-> (Robot -> Inventory -> Robot) -> Lens' Robot Inventory
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Robot -> Inventory
forall (phase :: RobotPhase). RobotR phase -> Inventory
_equippedDevices Robot -> Inventory -> Robot
forall {phase :: RobotPhase} {phase :: RobotPhase}.
(RobotID phase ~ RobotID phase,
 RobotLogMember phase ~ RobotLogMember phase,
 RobotMachine phase ~ RobotMachine phase,
 RobotLocation phase ~ RobotLocation phase,
 RobotLogUpdatedMember phase ~ RobotLogUpdatedMember phase,
 RobotActivity phase ~ RobotActivity phase) =>
RobotR phase -> Inventory -> RobotR phase
setEquipped
 where
  setEquipped :: RobotR phase -> Inventory -> RobotR phase
setEquipped RobotR phase
r Inventory
inst =
    RobotR phase
r
      { _equippedDevices = inst
      , _robotCapabilities = inventoryCapabilities inst
      }

-- | A robot template's equipped devices.
tequippedDevices :: Getter TRobot Inventory
tequippedDevices :: Getter TRobot Inventory
tequippedDevices = (TRobot -> Inventory)
-> (Inventory -> f Inventory) -> TRobot -> f TRobot
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to TRobot -> Inventory
forall (phase :: RobotPhase). RobotR phase -> Inventory
_equippedDevices

-- | A hash of a robot's entity record and equipped devices, to
--   facilitate quickly deciding whether we need to redraw the robot
--   info panel.
inventoryHash :: Getter Robot Int
inventoryHash :: Getter Robot RID
inventoryHash = (Robot -> RID) -> (RID -> f RID) -> Robot -> f Robot
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to (\Robot
r -> RID
17 RID -> RID -> RID
forall a. Hashable a => RID -> a -> RID
`hashWithSalt` (Robot
r Robot -> Getting RID Robot RID -> RID
forall s a. s -> Getting a s a -> a
^. ((Entity -> Const RID Entity) -> Robot -> Const RID Robot
forall (phase :: RobotPhase) (f :: * -> *).
Functor f =>
(Entity -> f Entity) -> RobotR phase -> f (RobotR phase)
robotEntity ((Entity -> Const RID Entity) -> Robot -> Const RID Robot)
-> ((RID -> Const RID RID) -> Entity -> Const RID Entity)
-> Getting RID Robot RID
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RID -> Const RID RID) -> Entity -> Const RID Entity
Getter Entity RID
entityHash)) RID -> Inventory -> RID
forall a. Hashable a => RID -> a -> RID
`hashWithSalt` (Robot
r Robot -> Getting Inventory Robot Inventory -> Inventory
forall s a. s -> Getting a s a -> a
^. Getting Inventory Robot Inventory
Lens' Robot Inventory
equippedDevices))

-- | Does a robot know of an entity's existence?
robotKnows :: Robot -> Entity -> Bool
robotKnows :: Robot -> Entity -> Bool
robotKnows Robot
r Entity
e = Entity -> Inventory -> Bool
contains0plus Entity
e (Robot
r Robot -> Getting Inventory Robot Inventory -> Inventory
forall s a. s -> Getting a s a -> a
^. Getting Inventory Robot Inventory
Lens' Robot Inventory
robotInventory) Bool -> Bool -> Bool
|| Entity -> Inventory -> Bool
contains0plus Entity
e (Robot
r Robot -> Getting Inventory Robot Inventory -> Inventory
forall s a. s -> Getting a s a -> a
^. Getting Inventory Robot Inventory
Lens' Robot Inventory
equippedDevices)

isInteractive :: Robot -> Bool
isInteractive :: Robot -> Bool
isInteractive Robot
r = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Robot
r Robot -> Getting Bool Robot Bool -> Bool
forall s a. s -> Getting a s a -> a
^. (Display -> Const Bool Display) -> Robot -> Const Bool Robot
Lens' Robot Display
robotDisplay ((Display -> Const Bool Display) -> Robot -> Const Bool Robot)
-> ((Bool -> Const Bool Bool) -> Display -> Const Bool Display)
-> Getting Bool Robot Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Const Bool Bool) -> Display -> Const Bool Display
Lens' Display Bool
invisible Bool -> Bool -> Bool
&& Robot
r Robot -> Getting Bool Robot Bool -> Bool
forall s a. s -> Getting a s a -> a
^. Getting Bool Robot Bool
Lens' Robot Bool
systemRobot

-- | Get the set of capabilities this robot possesses.  This is only a
--   getter, not a lens, because it is automatically generated from
--   the 'equippedDevices'.  The only way to change a robot's
--   capabilities is to modify its 'equippedDevices'.
robotCapabilities :: Getter Robot (MultiEntityCapabilities Entity EntityName)
robotCapabilities :: Getter Robot (MultiEntityCapabilities Entity EntityName)
robotCapabilities = (Robot -> MultiEntityCapabilities Entity EntityName)
-> (MultiEntityCapabilities Entity EntityName
    -> f (MultiEntityCapabilities Entity EntityName))
-> Robot
-> f Robot
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to Robot -> MultiEntityCapabilities Entity EntityName
forall (phase :: RobotPhase).
RobotR phase -> MultiEntityCapabilities Entity EntityName
_robotCapabilities

-- | Is this robot a "system robot"?  System robots are generated by
--   the system (as opposed to created by the user) and are not
--   subject to the usual capability restrictions.
systemRobot :: Lens' Robot Bool

-- | Does this robot wish to self destruct?
selfDestruct :: Lens' Robot Bool

-- | Is the robot currently running an atomic block?
runningAtomic :: Lens' Robot Bool
walkabilityContext :: Getter Robot WalkabilityContext
walkabilityContext :: Getter Robot WalkabilityContext
walkabilityContext = (Robot -> WalkabilityContext)
-> Optic' (->) f Robot WalkabilityContext
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to ((Robot -> WalkabilityContext)
 -> Optic' (->) f Robot WalkabilityContext)
-> (Robot -> WalkabilityContext)
-> Optic' (->) f Robot WalkabilityContext
forall a b. (a -> b) -> a -> b
$
  \Robot
x -> Set Capability
-> WalkabilityExceptions EntityName -> WalkabilityContext
WalkabilityContext (MultiEntityCapabilities Entity EntityName -> Set Capability
forall e. Capabilities e -> Set Capability
getCapabilitySet (MultiEntityCapabilities Entity EntityName -> Set Capability)
-> MultiEntityCapabilities Entity EntityName -> Set Capability
forall a b. (a -> b) -> a -> b
$ Robot -> MultiEntityCapabilities Entity EntityName
forall (phase :: RobotPhase).
RobotR phase -> MultiEntityCapabilities Entity EntityName
_robotCapabilities Robot
x) (Robot -> WalkabilityExceptions EntityName
forall (phase :: RobotPhase).
RobotR phase -> WalkabilityExceptions EntityName
_unwalkableEntities Robot
x)

-- | A general function for creating robots.
mkRobot ::
  Maybe Int ->
  -- | Name of the robot.
  Text ->
  -- | Description of the robot.
  Document Syntax ->
  -- | Initial location.
  Maybe (Cosmic Location) ->
  -- | Initial heading/direction.
  Heading ->
  -- | Robot display.
  Display ->
  -- | Initial CESK machine.
  Maybe TSyntax ->
  -- | Equipped devices.
  [Entity] ->
  -- | Initial inventory.
  [(Count, Entity)] ->
  -- | Should this be a system robot?
  Bool ->
  -- | Is this robot heavy?
  Bool ->
  -- | Unwalkable entities
  WalkabilityExceptions EntityName ->
  -- | Creation date
  TimeSpec ->
  TRobot
mkRobot :: Maybe RID
-> EntityName
-> Document Syntax
-> Maybe (Cosmic Location)
-> Heading
-> Display
-> Maybe TSyntax
-> [Entity]
-> [(RID, Entity)]
-> Bool
-> Bool
-> WalkabilityExceptions EntityName
-> TimeSpec
-> TRobot
mkRobot Maybe RID
pid EntityName
name Document Syntax
descr Maybe (Cosmic Location)
loc Heading
dir Display
disp Maybe TSyntax
m [Entity]
devs [(RID, Entity)]
inv Bool
sys Bool
heavy WalkabilityExceptions EntityName
unwalkables TimeSpec
ts =
  RobotR
    { _robotEntity :: Entity
_robotEntity =
        Display
-> EntityName
-> Document Syntax
-> [EntityProperty]
-> Set Capability
-> Entity
mkEntity Display
disp EntityName
name Document Syntax
descr [] Set Capability
forall a. Monoid a => a
mempty
          Entity -> (Entity -> Entity) -> Entity
forall a b. a -> (a -> b) -> b
& (Maybe Heading -> Identity (Maybe Heading))
-> Entity -> Identity Entity
Lens' Entity (Maybe Heading)
entityOrientation ((Maybe Heading -> Identity (Maybe Heading))
 -> Entity -> Identity Entity)
-> Heading -> Entity -> Entity
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Heading
dir
          Entity -> (Entity -> Entity) -> Entity
forall a b. a -> (a -> b) -> b
& (Inventory -> Identity Inventory) -> Entity -> Identity Entity
Lens' Entity Inventory
entityInventory ((Inventory -> Identity Inventory) -> Entity -> Identity Entity)
-> Inventory -> Entity -> Entity
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [(RID, Entity)] -> Inventory
fromElems [(RID, Entity)]
inv
    , _equippedDevices :: Inventory
_equippedDevices = Inventory
inst
    , _robotCapabilities :: MultiEntityCapabilities Entity EntityName
_robotCapabilities = Inventory -> MultiEntityCapabilities Entity EntityName
inventoryCapabilities Inventory
inst
    , _robotLog :: RobotLogMember 'TemplateRobot
_robotLog = ()
    , _robotLogUpdated :: RobotLogUpdatedMember 'TemplateRobot
_robotLogUpdated = ()
    , _robotLocation :: RobotLocation 'TemplateRobot
_robotLocation = Maybe (Cosmic Location)
RobotLocation 'TemplateRobot
loc
    , _robotID :: RobotID 'TemplateRobot
_robotID = ()
    , _robotParentID :: Maybe RID
_robotParentID = Maybe RID
pid
    , _robotHeavy :: Bool
_robotHeavy = Bool
heavy
    , _robotCreatedAt :: TimeSpec
_robotCreatedAt = TimeSpec
ts
    , _machine :: RobotMachine 'TemplateRobot
_machine = Maybe TSyntax
RobotMachine 'TemplateRobot
m
    , _systemRobot :: Bool
_systemRobot = Bool
sys
    , _selfDestruct :: Bool
_selfDestruct = Bool
False
    , _activityCounts :: RobotActivity 'TemplateRobot
_activityCounts = ()
    , _runningAtomic :: Bool
_runningAtomic = Bool
False
    , _unwalkableEntities :: WalkabilityExceptions EntityName
_unwalkableEntities = WalkabilityExceptions EntityName
unwalkables
    }
 where
  inst :: Inventory
inst = [Entity] -> Inventory
fromList [Entity]
devs

newtype HeadingSpec = HeadingSpec
  { HeadingSpec -> Heading
getHeading :: Heading
  }

instance FromJSON HeadingSpec where
  parseJSON :: Value -> Parser HeadingSpec
parseJSON Value
x = (Heading -> HeadingSpec) -> Parser Heading -> Parser HeadingSpec
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Heading -> HeadingSpec
HeadingSpec (Parser Heading -> Parser HeadingSpec)
-> Parser Heading -> Parser HeadingSpec
forall a b. (a -> b) -> a -> b
$ (AbsoluteDir -> Heading
toHeading (AbsoluteDir -> Heading) -> Parser AbsoluteDir -> Parser Heading
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser AbsoluteDir
forall a. FromJSON a => Value -> Parser a
parseJSON Value
x) Parser Heading -> Parser Heading -> Parser Heading
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Value -> Parser Heading
forall a. FromJSON a => Value -> Parser a
parseJSON Value
x

-- | We can parse a robot from a YAML file if we have access to an
--   'EntityMap' in which we can look up the names of entities.
instance FromJSONE TerrainEntityMaps TRobot where
  parseJSONE :: Value -> ParserE TerrainEntityMaps TRobot
parseJSONE = String
-> (Object -> ParserE TerrainEntityMaps TRobot)
-> Value
-> ParserE TerrainEntityMaps TRobot
forall e a.
String -> (Object -> ParserE e a) -> Value -> ParserE e a
withObjectE String
"robot" ((Object -> ParserE TerrainEntityMaps TRobot)
 -> Value -> ParserE TerrainEntityMaps TRobot)
-> (Object -> ParserE TerrainEntityMaps TRobot)
-> Value
-> ParserE TerrainEntityMaps TRobot
forall a b. (a -> b) -> a -> b
$ \Object
v -> do
    -- Note we can't generate a unique ID here since we don't have
    -- access to a 'State GameState' effect; a unique ID will be
    -- filled in later when adding the robot to the world.
    Bool
sys <- Parser Bool -> With TerrainEntityMaps Parser Bool
forall (f :: * -> *) a e. Functor f => f a -> With e f a
liftE (Parser Bool -> With TerrainEntityMaps Parser Bool)
-> Parser Bool -> With TerrainEntityMaps Parser Bool
forall a b. (a -> b) -> a -> b
$ Object
v Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"system" Parser (Maybe Bool) -> Bool -> Parser Bool
forall a. Parser (Maybe a) -> a -> Parser a
.!= Bool
False
    let defDisplay :: Display
defDisplay = Display
defaultRobotDisplay Display -> (Display -> Display) -> Display
forall a b. a -> (a -> b) -> b
& (Bool -> Identity Bool) -> Display -> Identity Display
Lens' Display Bool
invisible ((Bool -> Identity Bool) -> Display -> Identity Display)
-> Bool -> Display -> Display
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Bool
sys

    Maybe RID
-> EntityName
-> Document Syntax
-> Maybe (Cosmic Location)
-> Heading
-> Display
-> Maybe TSyntax
-> [Entity]
-> [(RID, Entity)]
-> Bool
-> Bool
-> WalkabilityExceptions EntityName
-> TimeSpec
-> TRobot
mkRobot Maybe RID
forall a. Maybe a
Nothing
      (EntityName
 -> Document Syntax
 -> Maybe (Cosmic Location)
 -> Heading
 -> Display
 -> Maybe TSyntax
 -> [Entity]
 -> [(RID, Entity)]
 -> Bool
 -> Bool
 -> WalkabilityExceptions EntityName
 -> TimeSpec
 -> TRobot)
-> With TerrainEntityMaps Parser EntityName
-> With
     TerrainEntityMaps
     Parser
     (Document Syntax
      -> Maybe (Cosmic Location)
      -> Heading
      -> Display
      -> Maybe TSyntax
      -> [Entity]
      -> [(RID, Entity)]
      -> Bool
      -> Bool
      -> WalkabilityExceptions EntityName
      -> TimeSpec
      -> TRobot)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser EntityName -> With TerrainEntityMaps Parser EntityName
forall (f :: * -> *) a e. Functor f => f a -> With e f a
liftE (Object
v Object -> Key -> Parser EntityName
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name")
      With
  TerrainEntityMaps
  Parser
  (Document Syntax
   -> Maybe (Cosmic Location)
   -> Heading
   -> Display
   -> Maybe TSyntax
   -> [Entity]
   -> [(RID, Entity)]
   -> Bool
   -> Bool
   -> WalkabilityExceptions EntityName
   -> TimeSpec
   -> TRobot)
-> With TerrainEntityMaps Parser (Document Syntax)
-> With
     TerrainEntityMaps
     Parser
     (Maybe (Cosmic Location)
      -> Heading
      -> Display
      -> Maybe TSyntax
      -> [Entity]
      -> [(RID, Entity)]
      -> Bool
      -> Bool
      -> WalkabilityExceptions EntityName
      -> TimeSpec
      -> TRobot)
forall a b.
With TerrainEntityMaps Parser (a -> b)
-> With TerrainEntityMaps Parser a
-> With TerrainEntityMaps Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Document Syntax)
-> With TerrainEntityMaps Parser (Document Syntax)
forall (f :: * -> *) a e. Functor f => f a -> With e f a
liftE (Object
v Object -> Key -> Parser (Maybe (Document Syntax))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"description" Parser (Maybe (Document Syntax))
-> Document Syntax -> Parser (Document Syntax)
forall a. Parser (Maybe a) -> a -> Parser a
.!= Document Syntax
forall a. Monoid a => a
mempty)
      With
  TerrainEntityMaps
  Parser
  (Maybe (Cosmic Location)
   -> Heading
   -> Display
   -> Maybe TSyntax
   -> [Entity]
   -> [(RID, Entity)]
   -> Bool
   -> Bool
   -> WalkabilityExceptions EntityName
   -> TimeSpec
   -> TRobot)
-> With TerrainEntityMaps Parser (Maybe (Cosmic Location))
-> With
     TerrainEntityMaps
     Parser
     (Heading
      -> Display
      -> Maybe TSyntax
      -> [Entity]
      -> [(RID, Entity)]
      -> Bool
      -> Bool
      -> WalkabilityExceptions EntityName
      -> TimeSpec
      -> TRobot)
forall a b.
With TerrainEntityMaps Parser (a -> b)
-> With TerrainEntityMaps Parser a
-> With TerrainEntityMaps Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe (Cosmic Location))
-> With TerrainEntityMaps Parser (Maybe (Cosmic Location))
forall (f :: * -> *) a e. Functor f => f a -> With e f a
liftE (Object
v Object -> Key -> Parser (Maybe (Cosmic Location))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"loc")
      With
  TerrainEntityMaps
  Parser
  (Heading
   -> Display
   -> Maybe TSyntax
   -> [Entity]
   -> [(RID, Entity)]
   -> Bool
   -> Bool
   -> WalkabilityExceptions EntityName
   -> TimeSpec
   -> TRobot)
-> With TerrainEntityMaps Parser Heading
-> With
     TerrainEntityMaps
     Parser
     (Display
      -> Maybe TSyntax
      -> [Entity]
      -> [(RID, Entity)]
      -> Bool
      -> Bool
      -> WalkabilityExceptions EntityName
      -> TimeSpec
      -> TRobot)
forall a b.
With TerrainEntityMaps Parser (a -> b)
-> With TerrainEntityMaps Parser a
-> With TerrainEntityMaps Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Heading -> With TerrainEntityMaps Parser Heading
forall (f :: * -> *) a e. Functor f => f a -> With e f a
liftE ((HeadingSpec -> Heading) -> Parser HeadingSpec -> Parser Heading
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap HeadingSpec -> Heading
getHeading (Parser HeadingSpec -> Parser Heading)
-> Parser HeadingSpec -> Parser Heading
forall a b. (a -> b) -> a -> b
$ Object
v Object -> Key -> Parser (Maybe HeadingSpec)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"dir" Parser (Maybe HeadingSpec) -> HeadingSpec -> Parser HeadingSpec
forall a. Parser (Maybe a) -> a -> Parser a
.!= Heading -> HeadingSpec
HeadingSpec Heading
forall a. Num a => V2 a
forall (f :: * -> *) a. (Additive f, Num a) => f a
zero)
      With
  TerrainEntityMaps
  Parser
  (Display
   -> Maybe TSyntax
   -> [Entity]
   -> [(RID, Entity)]
   -> Bool
   -> Bool
   -> WalkabilityExceptions EntityName
   -> TimeSpec
   -> TRobot)
-> With TerrainEntityMaps Parser Display
-> With
     TerrainEntityMaps
     Parser
     (Maybe TSyntax
      -> [Entity]
      -> [(RID, Entity)]
      -> Bool
      -> Bool
      -> WalkabilityExceptions EntityName
      -> TimeSpec
      -> TRobot)
forall a b.
With TerrainEntityMaps Parser (a -> b)
-> With TerrainEntityMaps Parser a
-> With TerrainEntityMaps Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (TerrainEntityMaps -> Display)
-> With Display Parser Display
-> With TerrainEntityMaps Parser Display
forall e' e (f :: * -> *) a. (e' -> e) -> With e f a -> With e' f a
localE (Display -> TerrainEntityMaps -> Display
forall a b. a -> b -> a
const Display
defDisplay) (Object
v Object -> EntityName -> ParserE Display (Maybe Display)
forall e a.
FromJSONE e a =>
Object -> EntityName -> ParserE e (Maybe a)
..:? EntityName
"display" ParserE Display (Maybe Display)
-> Display -> With Display Parser Display
forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
..!= Display
defDisplay)
      With
  TerrainEntityMaps
  Parser
  (Maybe TSyntax
   -> [Entity]
   -> [(RID, Entity)]
   -> Bool
   -> Bool
   -> WalkabilityExceptions EntityName
   -> TimeSpec
   -> TRobot)
-> With TerrainEntityMaps Parser (Maybe TSyntax)
-> With
     TerrainEntityMaps
     Parser
     ([Entity]
      -> [(RID, Entity)]
      -> Bool
      -> Bool
      -> WalkabilityExceptions EntityName
      -> TimeSpec
      -> TRobot)
forall a b.
With TerrainEntityMaps Parser (a -> b)
-> With TerrainEntityMaps Parser a
-> With TerrainEntityMaps Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe TSyntax)
-> With TerrainEntityMaps Parser (Maybe TSyntax)
forall (f :: * -> *) a e. Functor f => f a -> With e f a
liftE (Object
v Object -> Key -> Parser (Maybe TSyntax)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"program")
      With
  TerrainEntityMaps
  Parser
  ([Entity]
   -> [(RID, Entity)]
   -> Bool
   -> Bool
   -> WalkabilityExceptions EntityName
   -> TimeSpec
   -> TRobot)
-> With TerrainEntityMaps Parser [Entity]
-> With
     TerrainEntityMaps
     Parser
     ([(RID, Entity)]
      -> Bool
      -> Bool
      -> WalkabilityExceptions EntityName
      -> TimeSpec
      -> TRobot)
forall a b.
With TerrainEntityMaps Parser (a -> b)
-> With TerrainEntityMaps Parser a
-> With TerrainEntityMaps Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (TerrainEntityMaps -> EntityMap)
-> With EntityMap Parser [Entity]
-> With TerrainEntityMaps Parser [Entity]
forall e' e (f :: * -> *) a. (e' -> e) -> With e f a -> With e' f a
localE (Getting EntityMap TerrainEntityMaps EntityMap
-> TerrainEntityMaps -> EntityMap
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting EntityMap TerrainEntityMaps EntityMap
Lens' TerrainEntityMaps EntityMap
entityMap) (Object
v Object -> EntityName -> ParserE EntityMap (Maybe [Entity])
forall e a.
FromJSONE e a =>
Object -> EntityName -> ParserE e (Maybe a)
..:? EntityName
"devices" ParserE EntityMap (Maybe [Entity])
-> [Entity] -> With EntityMap Parser [Entity]
forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
..!= [])
      With
  TerrainEntityMaps
  Parser
  ([(RID, Entity)]
   -> Bool
   -> Bool
   -> WalkabilityExceptions EntityName
   -> TimeSpec
   -> TRobot)
-> With TerrainEntityMaps Parser [(RID, Entity)]
-> With
     TerrainEntityMaps
     Parser
     (Bool
      -> Bool -> WalkabilityExceptions EntityName -> TimeSpec -> TRobot)
forall a b.
With TerrainEntityMaps Parser (a -> b)
-> With TerrainEntityMaps Parser a
-> With TerrainEntityMaps Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (TerrainEntityMaps -> EntityMap)
-> With EntityMap Parser [(RID, Entity)]
-> With TerrainEntityMaps Parser [(RID, Entity)]
forall e' e (f :: * -> *) a. (e' -> e) -> With e f a -> With e' f a
localE (Getting EntityMap TerrainEntityMaps EntityMap
-> TerrainEntityMaps -> EntityMap
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting EntityMap TerrainEntityMaps EntityMap
Lens' TerrainEntityMaps EntityMap
entityMap) (Object
v Object -> EntityName -> ParserE EntityMap (Maybe [(RID, Entity)])
forall e a.
FromJSONE e a =>
Object -> EntityName -> ParserE e (Maybe a)
..:? EntityName
"inventory" ParserE EntityMap (Maybe [(RID, Entity)])
-> [(RID, Entity)] -> With EntityMap Parser [(RID, Entity)]
forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
..!= [])
      With
  TerrainEntityMaps
  Parser
  (Bool
   -> Bool -> WalkabilityExceptions EntityName -> TimeSpec -> TRobot)
-> With TerrainEntityMaps Parser Bool
-> With
     TerrainEntityMaps
     Parser
     (Bool -> WalkabilityExceptions EntityName -> TimeSpec -> TRobot)
forall a b.
With TerrainEntityMaps Parser (a -> b)
-> With TerrainEntityMaps Parser a
-> With TerrainEntityMaps Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Bool -> With TerrainEntityMaps Parser Bool
forall a. a -> With TerrainEntityMaps Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
sys
      With
  TerrainEntityMaps
  Parser
  (Bool -> WalkabilityExceptions EntityName -> TimeSpec -> TRobot)
-> With TerrainEntityMaps Parser Bool
-> With
     TerrainEntityMaps
     Parser
     (WalkabilityExceptions EntityName -> TimeSpec -> TRobot)
forall a b.
With TerrainEntityMaps Parser (a -> b)
-> With TerrainEntityMaps Parser a
-> With TerrainEntityMaps Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Bool -> With TerrainEntityMaps Parser Bool
forall (f :: * -> *) a e. Functor f => f a -> With e f a
liftE (Object
v Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"heavy" Parser (Maybe Bool) -> Bool -> Parser Bool
forall a. Parser (Maybe a) -> a -> Parser a
.!= Bool
False)
      With
  TerrainEntityMaps
  Parser
  (WalkabilityExceptions EntityName -> TimeSpec -> TRobot)
-> With TerrainEntityMaps Parser (WalkabilityExceptions EntityName)
-> With TerrainEntityMaps Parser (TimeSpec -> TRobot)
forall a b.
With TerrainEntityMaps Parser (a -> b)
-> With TerrainEntityMaps Parser a
-> With TerrainEntityMaps Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (WalkabilityExceptions EntityName)
-> With TerrainEntityMaps Parser (WalkabilityExceptions EntityName)
forall (f :: * -> *) a e. Functor f => f a -> With e f a
liftE (Object
v Object -> Key -> Parser (Maybe (WalkabilityExceptions EntityName))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"walkable" Parser (Maybe (WalkabilityExceptions EntityName))
-> WalkabilityExceptions EntityName
-> Parser (WalkabilityExceptions EntityName)
forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
..!= WalkabilityExceptions EntityName
forall a. Monoid a => Inclusions a
emptyExceptions)
      With TerrainEntityMaps Parser (TimeSpec -> TRobot)
-> With TerrainEntityMaps Parser TimeSpec
-> ParserE TerrainEntityMaps TRobot
forall a b.
With TerrainEntityMaps Parser (a -> b)
-> With TerrainEntityMaps Parser a
-> With TerrainEntityMaps Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TimeSpec -> With TerrainEntityMaps Parser TimeSpec
forall a. a -> With TerrainEntityMaps Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TimeSpec
0

hearingDistance :: (Num i) => i
hearingDistance :: forall i. Num i => i
hearingDistance = i
32