{-# 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

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

  -- ** Runtime robot update
  RobotUpdate (..),

  -- * Robot context
  RobotContext,
  defTypes,
  defReqs,
  defVals,
  defStore,
  emptyRobotContext,

  -- ** Lenses
  robotEntity,
  robotName,
  trobotName,
  unwalkableEntities,
  robotCreatedAt,
  robotDisplay,
  robotLocation,
  unsafeSetRobotLocation,
  trobotLocation,
  robotOrientation,
  robotInventory,
  equippedDevices,
  robotLog,
  robotLogUpdated,
  inventoryHash,
  robotCapabilities,
  robotContext,
  trobotContext,
  robotID,
  robotParentID,
  robotHeavy,
  machine,
  systemRobot,
  selfDestruct,
  runningAtomic,
  activityCounts,
  tickStepBudget,
  tangibleCommandCount,
  commandsHistogram,
  lifetimeStepCount,
  activityWindow,

  -- ** Creation & instantiation
  mkRobot,
  instantiateRobot,

  -- ** Query
  robotKnows,
  isActive,
  wantsToStep,
  waitingUntil,
  getResult,

  -- ** Constants
  hearingDistance,
) where

import Control.Lens hiding (Const, contains)
import Data.Aeson qualified as Ae (FromJSON, Key, KeyValue, ToJSON (..), object, (.=))
import Data.Hashable (hashWithSalt)
import Data.Kind qualified
import Data.Map (Map)
import Data.Maybe (catMaybes, fromMaybe, isNothing)
import Data.Sequence (Seq)
import Data.Sequence qualified as Seq
import Data.Set (Set)
import Data.Text (Text)
import Data.Yaml ((.!=), (.:), (.:?))
import GHC.Generics (Generic)
import Linear
import Servant.Docs (ToSample)
import Servant.Docs qualified as SD
import Swarm.Game.CESK
import Swarm.Game.Display (Display, curOrientation, defaultRobotDisplay, invisible)
import Swarm.Game.Entity hiding (empty)
import Swarm.Game.Location (Heading, Location, toDirection)
import Swarm.Game.Universe
import Swarm.Language.Capability (Capability)
import Swarm.Language.Context qualified as Ctx
import Swarm.Language.Pipeline.QQ (tmQ)
import Swarm.Language.Requirement (ReqCtx)
import Swarm.Language.Syntax (Const, Syntax)
import Swarm.Language.Text.Markdown (Document)
import Swarm.Language.Typed (Typed (..))
import Swarm.Language.Types (TCtx)
import Swarm.Language.Value as V
import Swarm.Log
import Swarm.Util.Lens (makeLensesExcluding, makeLensesNoSigs)
import Swarm.Util.WindowedCounter
import Swarm.Util.Yaml
import System.Clock (TimeSpec)

-- | A record that stores the information
--   for all definitions stored in a 'Robot'
data RobotContext = RobotContext
  { RobotContext -> TCtx
_defTypes :: TCtx
  -- ^ Map definition names to their types.
  , RobotContext -> ReqCtx
_defReqs :: ReqCtx
  -- ^ Map definition names to the capabilities
  --   required to evaluate/execute them.
  , RobotContext -> Env
_defVals :: Env
  -- ^ Map definition names to their values. Note that since
  --   definitions are delayed, the values will just consist of
  --   'VRef's pointing into the store.
  , RobotContext -> Store
_defStore :: Store
  -- ^ A store containing memory cells allocated to hold
  --   definitions.
  }
  deriving (RobotContext -> RobotContext -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RobotContext -> RobotContext -> Bool
$c/= :: RobotContext -> RobotContext -> Bool
== :: RobotContext -> RobotContext -> Bool
$c== :: RobotContext -> RobotContext -> Bool
Eq, Int -> RobotContext -> ShowS
[RobotContext] -> ShowS
RobotContext -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RobotContext] -> ShowS
$cshowList :: [RobotContext] -> ShowS
show :: RobotContext -> String
$cshow :: RobotContext -> String
showsPrec :: Int -> RobotContext -> ShowS
$cshowsPrec :: Int -> RobotContext -> ShowS
Show, forall x. Rep RobotContext x -> RobotContext
forall x. RobotContext -> Rep RobotContext x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RobotContext x -> RobotContext
$cfrom :: forall x. RobotContext -> Rep RobotContext x
Generic, Value -> Parser [RobotContext]
Value -> Parser RobotContext
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [RobotContext]
$cparseJSONList :: Value -> Parser [RobotContext]
parseJSON :: Value -> Parser RobotContext
$cparseJSON :: Value -> Parser RobotContext
Ae.FromJSON, [RobotContext] -> Encoding
[RobotContext] -> Value
RobotContext -> Encoding
RobotContext -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [RobotContext] -> Encoding
$ctoEncodingList :: [RobotContext] -> Encoding
toJSONList :: [RobotContext] -> Value
$ctoJSONList :: [RobotContext] -> Value
toEncoding :: RobotContext -> Encoding
$ctoEncoding :: RobotContext -> Encoding
toJSON :: RobotContext -> Value
$ctoJSON :: RobotContext -> Value
Ae.ToJSON)

makeLenses ''RobotContext

emptyRobotContext :: RobotContext
emptyRobotContext :: RobotContext
emptyRobotContext = TCtx -> ReqCtx -> Env -> Store -> RobotContext
RobotContext forall t. Ctx t
Ctx.empty forall t. Ctx t
Ctx.empty forall t. Ctx t
Ctx.empty Store
emptyStore

type instance Index RobotContext = Ctx.Var
type instance IxValue RobotContext = Typed Value

instance Ixed RobotContext
instance At RobotContext where
  at :: Index RobotContext
-> Lens' RobotContext (Maybe (IxValue RobotContext))
at Index RobotContext
name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens RobotContext -> Maybe (Typed Value)
getter RobotContext -> Maybe (Typed Value) -> RobotContext
setter
   where
    getter :: RobotContext -> Maybe (Typed Value)
getter RobotContext
ctx =
      do
        Poly Type
typ <- forall t. Var -> Ctx t -> Maybe t
Ctx.lookup Index RobotContext
name (RobotContext
ctx forall s a. s -> Getting a s a -> a
^. Lens' RobotContext TCtx
defTypes)
        Value
val <- forall t. Var -> Ctx t -> Maybe t
Ctx.lookup Index RobotContext
name (RobotContext
ctx forall s a. s -> Getting a s a -> a
^. Lens' RobotContext Env
defVals)
        Requirements
req <- forall t. Var -> Ctx t -> Maybe t
Ctx.lookup Index RobotContext
name (RobotContext
ctx forall s a. s -> Getting a s a -> a
^. Lens' RobotContext ReqCtx
defReqs)
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall v. v -> Poly Type -> Requirements -> Typed v
Typed Value
val Poly Type
typ Requirements
req
    setter :: RobotContext -> Maybe (Typed Value) -> RobotContext
setter RobotContext
ctx Maybe (Typed Value)
Nothing =
      RobotContext
ctx
        forall a b. a -> (a -> b) -> b
& Lens' RobotContext TCtx
defTypes forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ forall t. Var -> Ctx t -> Ctx t
Ctx.delete Index RobotContext
name
        forall a b. a -> (a -> b) -> b
& Lens' RobotContext Env
defVals forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ forall t. Var -> Ctx t -> Ctx t
Ctx.delete Index RobotContext
name
        forall a b. a -> (a -> b) -> b
& Lens' RobotContext ReqCtx
defReqs forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ forall t. Var -> Ctx t -> Ctx t
Ctx.delete Index RobotContext
name
    setter RobotContext
ctx (Just (Typed Value
val Poly Type
typ Requirements
req)) =
      RobotContext
ctx
        forall a b. a -> (a -> b) -> b
& Lens' RobotContext TCtx
defTypes forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ forall t. Var -> t -> Ctx t -> Ctx t
Ctx.addBinding Index RobotContext
name Poly Type
typ
        forall a b. a -> (a -> b) -> b
& Lens' RobotContext Env
defVals forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ forall t. Var -> t -> Ctx t -> Ctx t
Ctx.addBinding Index RobotContext
name Value
val
        forall a b. a -> (a -> b) -> b
& Lens' RobotContext ReqCtx
defReqs forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ forall t. Var -> t -> Ctx t -> Ctx t
Ctx.addBinding Index RobotContext
name Requirements
req

-- | 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

data ActivityCounts = ActivityCounts
  { ActivityCounts -> Int
_tickStepBudget :: Int
  , ActivityCounts -> Int
_tangibleCommandCount :: Int
  , ActivityCounts -> Map Const Int
_commandsHistogram :: Map Const Int
  , ActivityCounts -> Int
_lifetimeStepCount :: Int
  , ActivityCounts -> WindowedCounter TickNumber
_activityWindow :: WindowedCounter TickNumber
  }
  deriving (ActivityCounts -> ActivityCounts -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ActivityCounts -> ActivityCounts -> Bool
$c/= :: ActivityCounts -> ActivityCounts -> Bool
== :: ActivityCounts -> ActivityCounts -> Bool
$c== :: ActivityCounts -> ActivityCounts -> Bool
Eq, Int -> ActivityCounts -> ShowS
[ActivityCounts] -> ShowS
ActivityCounts -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ActivityCounts] -> ShowS
$cshowList :: [ActivityCounts] -> ShowS
show :: ActivityCounts -> String
$cshow :: ActivityCounts -> String
showsPrec :: Int -> ActivityCounts -> ShowS
$cshowsPrec :: Int -> ActivityCounts -> ShowS
Show, forall x. Rep ActivityCounts x -> ActivityCounts
forall x. ActivityCounts -> Rep ActivityCounts x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ActivityCounts x -> ActivityCounts
$cfrom :: forall x. ActivityCounts -> Rep ActivityCounts x
Generic, Value -> Parser [ActivityCounts]
Value -> Parser ActivityCounts
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [ActivityCounts]
$cparseJSONList :: Value -> Parser [ActivityCounts]
parseJSON :: Value -> Parser ActivityCounts
$cparseJSON :: Value -> Parser ActivityCounts
Ae.FromJSON, [ActivityCounts] -> Encoding
[ActivityCounts] -> Value
ActivityCounts -> Encoding
ActivityCounts -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [ActivityCounts] -> Encoding
$ctoEncodingList :: [ActivityCounts] -> Encoding
toJSONList :: [ActivityCounts] -> Value
$ctoJSONList :: [ActivityCounts] -> Value
toEncoding :: ActivityCounts -> Encoding
$ctoEncoding :: ActivityCounts -> Encoding
toJSON :: ActivityCounts -> Value
$ctoJSON :: ActivityCounts -> Value
Ae.ToJSON)

emptyActivityCount :: ActivityCounts
emptyActivityCount :: ActivityCounts
emptyActivityCount =
  ActivityCounts
    { _tickStepBudget :: Int
_tickStepBudget = Int
0
    , _tangibleCommandCount :: Int
_tangibleCommandCount = Int
0
    , _commandsHistogram :: Map Const Int
_commandsHistogram = forall a. Monoid a => a
mempty
    , _lifetimeStepCount :: Int
_lifetimeStepCount = Int
0
    , -- NOTE: This value was chosen experimentally.
      -- TODO(#1341): Make this dynamic based on game speed.
      _activityWindow :: WindowedCounter TickNumber
_activityWindow = forall a. Int -> WindowedCounter a
mkWindow Int
64
    }

makeLensesNoSigs ''ActivityCounts

-- | A counter that is decremented upon each step of the robot within the
--   CESK machine. Initially set to 'Swarm.Game.State.robotStepsPerTick'
--   at each new tick.
--
--   The need for 'tickStepBudget' is a bit technical, and I hope I can
--   eventually find a different, better way to accomplish it.
--   Ideally, we would want each robot to execute a single
--   /command/ at every game tick, so that /e.g./ two robots
--   executing @move;move;move@ and @repeat 3 move@ (given a
--   suitable definition of @repeat@) will move in lockstep.
--   However, the second robot actually has to do more computation
--   than the first (it has to look up the definition of @repeat@,
--   reduce its application to the number 3, etc.), so its CESK
--   machine will take more steps.  It won't do to simply let each
--   robot run until executing a command---because robot programs
--   can involve arbitrary recursion, it is very easy to write a
--   program that evaluates forever without ever executing a
--   command, which in this scenario would completely freeze the
--   UI. (It also wouldn't help to ensure all programs are
--   terminating---it would still be possible to effectively do
--   the same thing by making a program that takes a very, very
--   long time to terminate.)  So instead, we allocate each robot
--   a certain maximum number of computation steps per tick
--   (defined in 'Swarm.Game.Step.evalStepsPerTick'), and it
--   suspends computation when it either executes a command or
--   reaches the maximum number of steps, whichever comes first.
--
--   It seems like this really isn't something the robot should be
--   keeping track of itself, but that seemed the most technically
--   convenient way to do it at the time.  The robot needs some
--   way to signal when it has executed a command, which it
--   currently does by setting tickStepBudget to zero.  However, that
--   has the disadvantage that when tickStepBudget becomes zero, we
--   can't tell whether that happened because the robot ran out of
--   steps, or because it executed a command and set it to zero
--   manually.
--
--   Perhaps instead, each robot should keep a counter saying how
--   many commands it has executed.  The loop stepping the robot
--   can tell when the counter increments.
tickStepBudget :: Lens' ActivityCounts Int

-- | Total number of tangible commands executed over robot's lifetime
tangibleCommandCount :: Lens' ActivityCounts Int

-- | Histogram of commands executed over robot's lifetime
commandsHistogram :: Lens' ActivityCounts (Map Const Int)

-- | Total number of CESK steps executed over robot's lifetime.
-- This could be thought of as "CPU cycles" consumed, and is labeled
-- as "cycles" in the F2 dialog in the UI.
lifetimeStepCount :: Lens' ActivityCounts Int

-- | Sliding window over a span of ticks indicating ratio of activity
activityWindow :: Lens' ActivityCounts (WindowedCounter TickNumber)

-- | 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

-- | 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 -> Set Capability
_robotCapabilities :: Set Capability
  -- ^ A cached view of the capabilities this robot has.
  --   Automatically generated from '_equippedDevices'.
  , forall (phase :: RobotPhase). RobotR phase -> Seq LogEntry
_robotLog :: Seq LogEntry
  , forall (phase :: RobotPhase). RobotR phase -> Bool
_robotLogUpdated :: Bool
  , forall (phase :: RobotPhase). RobotR phase -> RobotLocation phase
_robotLocation :: RobotLocation phase
  , forall (phase :: RobotPhase). RobotR phase -> RobotContext
_robotContext :: RobotContext
  , forall (phase :: RobotPhase). RobotR phase -> RobotID phase
_robotID :: RobotID phase
  , forall (phase :: RobotPhase). RobotR phase -> Maybe Int
_robotParentID :: Maybe RID
  , forall (phase :: RobotPhase). RobotR phase -> Bool
_robotHeavy :: Bool
  , forall (phase :: RobotPhase). RobotR phase -> CESK
_machine :: CESK
  , forall (phase :: RobotPhase). RobotR phase -> Bool
_systemRobot :: Bool
  , forall (phase :: RobotPhase). RobotR phase -> Bool
_selfDestruct :: Bool
  , forall (phase :: RobotPhase). RobotR phase -> ActivityCounts
_activityCounts :: ActivityCounts
  , forall (phase :: RobotPhase). RobotR phase -> Bool
_runningAtomic :: Bool
  , forall (phase :: RobotPhase). RobotR phase -> Set Var
_unwalkableEntities :: Set EntityName
  , forall (phase :: RobotPhase). RobotR phase -> TimeSpec
_robotCreatedAt :: TimeSpec
  }
  deriving (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
$cto :: forall (phase :: RobotPhase) x.
Rep (RobotR phase) x -> RobotR phase
$cfrom :: forall (phase :: RobotPhase) x.
RobotR phase -> Rep (RobotR phase) x
Generic)

deriving instance (Show (RobotLocation phase), Show (RobotID phase)) => Show (RobotR phase)
deriving instance (Eq (RobotLocation phase), Eq (RobotID 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] ''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

instance ToSample Robot where
  toSamples :: Proxy Robot -> [(Var, Robot)]
toSamples Proxy Robot
_ = forall a. a -> [(Var, a)]
SD.singleSample Robot
sampleBase
   where
    sampleBase :: Robot
    sampleBase :: Robot
sampleBase =
      forall (phase :: RobotPhase).
RobotID phase
-> Maybe Int
-> Var
-> Document Syntax
-> RobotLocation phase
-> Heading
-> Display
-> CESK
-> [Entity]
-> [(Int, Entity)]
-> Bool
-> Bool
-> Set Var
-> TimeSpec
-> RobotR phase
mkRobot
        Int
0
        forall a. Maybe a
Nothing
        Var
"base"
        Document Syntax
"The starting robot."
        Cosmic Location
defaultCosmicLocation
        forall (f :: * -> *) a. (Additive f, Num a) => f a
zero
        Display
defaultRobotDisplay
        (ProcessedTerm -> Env -> Store -> CESK
initMachine [tmQ| move |] forall a. Monoid a => a
mempty Store
emptyStore)
        []
        []
        Bool
False
        Bool
False
        forall a. Monoid a => a
mempty
        TimeSpec
0

-- 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 (Set 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 Var
robotName = forall (phase :: RobotPhase). Lens' (RobotR phase) Entity
robotEntity forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Entity Var
entityName

-- | The name of a robot template.
trobotName :: Lens' TRobot Text
trobotName :: Lens' TRobot Var
trobotName = forall (phase :: RobotPhase). Lens' (RobotR phase) Entity
robotEntity forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Entity Var
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 = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Robot -> Display
getDisplay forall {phase :: RobotPhase}.
RobotR phase -> Display -> RobotR phase
setDisplay
 where
  getDisplay :: Robot -> Display
getDisplay Robot
r =
    (Robot
r forall s a. s -> Getting a s a -> a
^. forall (phase :: RobotPhase). Lens' (RobotR phase) Entity
robotEntity forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Entity Display
entityDisplay)
      forall a b. a -> (a -> b) -> b
& Lens' Display (Maybe Direction)
curOrientation forall s t a b. ASetter s t a b -> b -> s -> t
.~ ((Robot
r forall s a. s -> Getting a s a -> a
^. Lens' Robot (Maybe Heading)
robotOrientation) 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 forall a b. a -> (a -> b) -> b
& forall (phase :: RobotPhase). Lens' (RobotR phase) Entity
robotEntity forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Entity Display
entityDisplay 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 :: RobotLocation 'ConcreteRobot
_robotLocation = Cosmic Location
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 = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens forall (phase :: RobotPhase). RobotR phase -> RobotLocation phase
_robotLocation (\TRobot
r Maybe (Cosmic Location)
l -> TRobot
r {_robotLocation :: RobotLocation 'TemplateRobot
_robotLocation = Maybe (Cosmic Location)
l})

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

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

-- | The robot's context.
robotContext :: Lens' Robot RobotContext

-- | The robot's context.
trobotContext :: Lens' TRobot RobotContext
trobotContext :: Lens' TRobot RobotContext
trobotContext = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens forall (phase :: RobotPhase). RobotR phase -> RobotContext
_robotContext (\TRobot
r RobotContext
c -> TRobot
r {_robotContext :: RobotContext
_robotContext = RobotContext
c})

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

-- | Instantiate a robot template to make it into a concrete robot, by
--    providing a robot ID. Concrete robots also require a location;
--    if the robot template didn't have a location already, just set
--    the location to (0,0) by default.  If you want a different location,
--    set it via 'trobotLocation' before calling 'instantiateRobot'.
instantiateRobot :: RID -> TRobot -> Robot
instantiateRobot :: Int -> TRobot -> Robot
instantiateRobot Int
i TRobot
r =
  TRobot
r
    { _robotID :: RobotID 'ConcreteRobot
_robotID = Int
i
    , _robotLocation :: RobotLocation 'ConcreteRobot
_robotLocation = forall a. a -> Maybe a -> a
fromMaybe Cosmic Location
defaultCosmicLocation forall a b. (a -> b) -> a -> b
$ forall (phase :: RobotPhase). RobotR phase -> RobotLocation phase
_robotLocation TRobot
r
    }

-- | 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 = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens forall (phase :: RobotPhase). RobotR phase -> Inventory
_equippedDevices forall {phase :: RobotPhase}.
RobotR phase -> Inventory -> RobotR phase
setEquipped
 where
  setEquipped :: RobotR phase -> Inventory -> RobotR phase
setEquipped RobotR phase
r Inventory
inst =
    RobotR phase
r
      { _equippedDevices :: Inventory
_equippedDevices = Inventory
inst
      , _robotCapabilities :: Set Capability
_robotCapabilities = Inventory -> Set Capability
inventoryCapabilities Inventory
inst
      }

-- | The robot's own private message log, most recent message last.
--   Messages can be added both by explicit use of the 'Swarm.Language.Syntax.Log' command,
--   and by uncaught exceptions.  Stored as a 'Seq' so that
--   we can efficiently add to the end and also process from beginning
--   to end.  Note that updating via this lens will also set the
--   'robotLogUpdated'.
robotLog :: Lens' Robot (Seq LogEntry)
robotLog :: Lens' Robot (Seq LogEntry)
robotLog = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens forall (phase :: RobotPhase). RobotR phase -> Seq LogEntry
_robotLog forall {phase :: RobotPhase}.
RobotR phase -> Seq LogEntry -> RobotR phase
setLog
 where
  setLog :: RobotR phase -> Seq LogEntry -> RobotR phase
setLog RobotR phase
r Seq LogEntry
newLog =
    RobotR phase
r
      { _robotLog :: Seq LogEntry
_robotLog = Seq LogEntry
newLog
      , -- Flag the log as updated if (1) if already was, or (2) the new
        -- log is a different length than the old.  (This would not
        -- catch updates that merely modify an entry, but we don't want
        -- to have to compare the entire logs, and we only ever append
        -- to logs anyway.)
        _robotLogUpdated :: Bool
_robotLogUpdated =
          forall (phase :: RobotPhase). RobotR phase -> Bool
_robotLogUpdated RobotR phase
r Bool -> Bool -> Bool
|| forall a. Seq a -> Int
Seq.length (forall (phase :: RobotPhase). RobotR phase -> Seq LogEntry
_robotLog RobotR phase
r) forall a. Eq a => a -> a -> Bool
/= forall a. Seq a -> Int
Seq.length Seq LogEntry
newLog
      }

-- | Has the 'robotLog' been updated since the last time it was
--   viewed?
robotLogUpdated :: Lens' Robot Bool

-- | 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 Int
inventoryHash = forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to (\Robot
r -> Int
17 forall a. Hashable a => Int -> a -> Int
`hashWithSalt` (Robot
r forall s a. s -> Getting a s a -> a
^. (forall (phase :: RobotPhase). Lens' (RobotR phase) Entity
robotEntity forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getter Entity Int
entityHash)) forall a. Hashable a => Int -> a -> Int
`hashWithSalt` (Robot
r forall s a. s -> Getting a s a -> a
^. 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 forall s a. s -> Getting a s a -> a
^. Lens' Robot Inventory
robotInventory) Bool -> Bool -> Bool
|| Entity -> Inventory -> Bool
contains0plus Entity
e (Robot
r forall s a. s -> Getting a s a -> a
^. Lens' Robot Inventory
equippedDevices)

-- | 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 (Set Capability)
robotCapabilities :: Getter Robot (Set Capability)
robotCapabilities = forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to forall (phase :: RobotPhase). RobotR phase -> Set Capability
_robotCapabilities

-- | The robot's current CEK machine state.
machine :: Lens' Robot CESK

-- | 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

-- | Diagnostic and operational tracking of CESK steps or other activity
activityCounts :: Lens' Robot ActivityCounts

-- | Is the robot currently running an atomic block?
runningAtomic :: Lens' Robot Bool

-- | A general function for creating robots.
mkRobot ::
  -- | ID number of the robot.
  RobotID phase ->
  -- | ID number of the robot's parent, if it has one.
  Maybe Int ->
  -- | Name of the robot.
  Text ->
  -- | Description of the robot.
  Document Syntax ->
  -- | Initial location.
  RobotLocation phase ->
  -- | Initial heading/direction.
  Heading ->
  -- | Robot display.
  Display ->
  -- | Initial CESK machine.
  CESK ->
  -- | Equipped devices.
  [Entity] ->
  -- | Initial inventory.
  [(Count, Entity)] ->
  -- | Should this be a system robot?
  Bool ->
  -- | Is this robot heavy?
  Bool ->
  -- | Unwalkable entities
  Set EntityName ->
  -- | Creation date
  TimeSpec ->
  RobotR phase
mkRobot :: forall (phase :: RobotPhase).
RobotID phase
-> Maybe Int
-> Var
-> Document Syntax
-> RobotLocation phase
-> Heading
-> Display
-> CESK
-> [Entity]
-> [(Int, Entity)]
-> Bool
-> Bool
-> Set Var
-> TimeSpec
-> RobotR phase
mkRobot RobotID phase
rid Maybe Int
pid Var
name Document Syntax
descr RobotLocation phase
loc Heading
dir Display
disp CESK
m [Entity]
devs [(Int, Entity)]
inv Bool
sys Bool
heavy Set Var
unwalkables TimeSpec
ts =
  RobotR
    { _robotEntity :: Entity
_robotEntity =
        Display
-> Var
-> Document Syntax
-> [EntityProperty]
-> [Capability]
-> Entity
mkEntity Display
disp Var
name Document Syntax
descr [] []
          forall a b. a -> (a -> b) -> b
& Lens' Entity (Maybe Heading)
entityOrientation forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Heading
dir
          forall a b. a -> (a -> b) -> b
& Lens' Entity Inventory
entityInventory forall s t a b. ASetter s t a b -> b -> s -> t
.~ [(Int, Entity)] -> Inventory
fromElems [(Int, Entity)]
inv
    , _equippedDevices :: Inventory
_equippedDevices = Inventory
inst
    , _robotCapabilities :: Set Capability
_robotCapabilities = Inventory -> Set Capability
inventoryCapabilities Inventory
inst
    , _robotLog :: Seq LogEntry
_robotLog = forall a. Seq a
Seq.empty
    , _robotLogUpdated :: Bool
_robotLogUpdated = Bool
False
    , _robotLocation :: RobotLocation phase
_robotLocation = RobotLocation phase
loc
    , _robotContext :: RobotContext
_robotContext = RobotContext
emptyRobotContext
    , _robotID :: RobotID phase
_robotID = RobotID phase
rid
    , _robotParentID :: Maybe Int
_robotParentID = Maybe Int
pid
    , _robotHeavy :: Bool
_robotHeavy = Bool
heavy
    , _robotCreatedAt :: TimeSpec
_robotCreatedAt = TimeSpec
ts
    , _machine :: CESK
_machine = CESK
m
    , _systemRobot :: Bool
_systemRobot = Bool
sys
    , _selfDestruct :: Bool
_selfDestruct = Bool
False
    , _activityCounts :: ActivityCounts
_activityCounts = ActivityCounts
emptyActivityCount
    , _runningAtomic :: Bool
_runningAtomic = Bool
False
    , _unwalkableEntities :: Set Var
_unwalkableEntities = Set Var
unwalkables
    }
 where
  inst :: Inventory
inst = [Entity] -> Inventory
fromList [Entity]
devs

-- | 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 EntityMap TRobot where
  parseJSONE :: Value -> ParserE EntityMap TRobot
parseJSONE = forall e a.
String -> (Object -> ParserE e a) -> Value -> ParserE e a
withObjectE String
"robot" 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 <- forall (f :: * -> *) a e. Functor f => f a -> With e f a
liftE forall a b. (a -> b) -> a -> b
$ Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"system" forall a. Parser (Maybe a) -> a -> Parser a
.!= Bool
False
    let defDisplay :: Display
defDisplay = Display
defaultRobotDisplay forall a b. a -> (a -> b) -> b
& Lens' Display Bool
invisible forall s t a b. ASetter s t a b -> b -> s -> t
.~ Bool
sys

    forall (phase :: RobotPhase).
RobotID phase
-> Maybe Int
-> Var
-> Document Syntax
-> RobotLocation phase
-> Heading
-> Display
-> CESK
-> [Entity]
-> [(Int, Entity)]
-> Bool
-> Bool
-> Set Var
-> TimeSpec
-> RobotR phase
mkRobot () forall a. Maybe a
Nothing
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a e. Functor f => f a -> With e f a
liftE (Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a e. Functor f => f a -> With e f a
liftE (Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"description" forall a. Parser (Maybe a) -> a -> Parser a
.!= forall a. Monoid a => a
mempty)
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a e. Functor f => f a -> With e f a
liftE (Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"loc")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a e. Functor f => f a -> With e f a
liftE (Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"dir" forall a. Parser (Maybe a) -> a -> Parser a
.!= forall (f :: * -> *) a. (Additive f, Num a) => f a
zero)
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall e' e (f :: * -> *) a. (e' -> e) -> With e f a -> With e' f a
localE (forall a b. a -> b -> a
const Display
defDisplay) (Object
v forall e a. FromJSONE e a => Object -> Var -> ParserE e (Maybe a)
..:? Var
"display" forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
..!= Display
defDisplay)
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a e. Functor f => f a -> With e f a
liftE (Maybe ProcessedTerm -> CESK
mkMachine forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"program"))
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall e a. FromJSONE e a => Object -> Var -> ParserE e (Maybe a)
..:? Var
"devices" forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
..!= []
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall e a. FromJSONE e a => Object -> Var -> ParserE e (Maybe a)
..:? Var
"inventory" forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
..!= []
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
sys
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a e. Functor f => f a -> With e f a
liftE (Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"heavy" forall a. Parser (Maybe a) -> a -> Parser a
.!= Bool
False)
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a e. Functor f => f a -> With e f a
liftE (Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"unwalkable" forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
..!= forall a. Monoid a => a
mempty)
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure TimeSpec
0
   where
    mkMachine :: Maybe ProcessedTerm -> CESK
mkMachine Maybe ProcessedTerm
Nothing = Value -> Store -> Cont -> CESK
Out Value
VUnit Store
emptyStore []
    mkMachine (Just ProcessedTerm
pt) = ProcessedTerm -> Env -> Store -> CESK
initMachine ProcessedTerm
pt forall a. Monoid a => a
mempty Store
emptyStore

(.=?) :: (Ae.KeyValue a, Ae.ToJSON v, Eq v) => Ae.Key -> v -> v -> Maybe a
.=? :: forall a v.
(KeyValue a, ToJSON v, Eq v) =>
Key -> v -> v -> Maybe a
(.=?) Key
n v
v v
defaultVal = if v
defaultVal forall a. Eq a => a -> a -> Bool
/= v
v then forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Key
n forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Ae..= v
v else forall a. Maybe a
Nothing

(.==) :: (Ae.KeyValue a, Ae.ToJSON v) => Ae.Key -> v -> Maybe a
.== :: forall a v. (KeyValue a, ToJSON v) => Key -> v -> Maybe a
(.==) Key
n v
v = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Key
n forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Ae..= v
v

instance Ae.ToJSON Robot where
  toJSON :: Robot -> Value
toJSON Robot
r =
    [Pair] -> Value
Ae.object forall a b. (a -> b) -> a -> b
$
      forall a. [Maybe a] -> [a]
catMaybes
        [ Key
"id" forall a v. (KeyValue a, ToJSON v) => Key -> v -> Maybe a
.== (Robot
r forall s a. s -> Getting a s a -> a
^. Getter Robot Int
robotID)
        , Key
"name" forall a v. (KeyValue a, ToJSON v) => Key -> v -> Maybe a
.== (Robot
r forall s a. s -> Getting a s a -> a
^. forall (phase :: RobotPhase). Lens' (RobotR phase) Entity
robotEntity forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Entity Display
entityDisplay)
        , Key
"description" forall a v.
(KeyValue a, ToJSON v, Eq v) =>
Key -> v -> v -> Maybe a
.=? (Robot
r forall s a. s -> Getting a s a -> a
^. forall (phase :: RobotPhase). Lens' (RobotR phase) Entity
robotEntity forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Entity (Document Syntax)
entityDescription) forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => a
mempty
        , Key
"loc" forall a v. (KeyValue a, ToJSON v) => Key -> v -> Maybe a
.== (Robot
r forall s a. s -> Getting a s a -> a
^. Getter Robot (Cosmic Location)
robotLocation)
        , Key
"dir" forall a v.
(KeyValue a, ToJSON v, Eq v) =>
Key -> v -> v -> Maybe a
.=? (Robot
r forall s a. s -> Getting a s a -> a
^. forall (phase :: RobotPhase). Lens' (RobotR phase) Entity
robotEntity forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Entity (Maybe Heading)
entityOrientation) forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. (Additive f, Num a) => f a
zero
        , Key
"display" forall a v.
(KeyValue a, ToJSON v, Eq v) =>
Key -> v -> v -> Maybe a
.=? (Robot
r forall s a. s -> Getting a s a -> a
^. Lens' Robot Display
robotDisplay) forall a b. (a -> b) -> a -> b
$ (Display
defaultRobotDisplay forall a b. a -> (a -> b) -> b
& Lens' Display Bool
invisible forall s t a b. ASetter s t a b -> b -> s -> t
.~ Bool
sys)
        , Key
"program" forall a v. (KeyValue a, ToJSON v) => Key -> v -> Maybe a
.== (Robot
r forall s a. s -> Getting a s a -> a
^. Lens' Robot CESK
machine)
        , Key
"devices" forall a v.
(KeyValue a, ToJSON v, Eq v) =>
Key -> v -> v -> Maybe a
.=? (forall a b. (a -> b) -> [a] -> [b]
map (forall s a. s -> Getting a s a -> a
^. forall s t a b. Field2 s t a b => Lens s t a b
_2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Entity Var
entityName) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inventory -> [(Int, Entity)]
elems forall a b. (a -> b) -> a -> b
$ Robot
r forall s a. s -> Getting a s a -> a
^. Lens' Robot Inventory
equippedDevices) forall a b. (a -> b) -> a -> b
$ []
        , Key
"inventory" forall a v.
(KeyValue a, ToJSON v, Eq v) =>
Key -> v -> v -> Maybe a
.=? (forall a b. (a -> b) -> [a] -> [b]
map (forall s t a b. Field2 s t a b => Lens s t a b
_2 forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Entity Var
entityName) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inventory -> [(Int, Entity)]
elems forall a b. (a -> b) -> a -> b
$ Robot
r forall s a. s -> Getting a s a -> a
^. Lens' Robot Inventory
robotInventory) forall a b. (a -> b) -> a -> b
$ []
        , Key
"system" forall a v.
(KeyValue a, ToJSON v, Eq v) =>
Key -> v -> v -> Maybe a
.=? Bool
sys forall a b. (a -> b) -> a -> b
$ Bool
False
        , Key
"heavy" forall a v.
(KeyValue a, ToJSON v, Eq v) =>
Key -> v -> v -> Maybe a
.=? (Robot
r forall s a. s -> Getting a s a -> a
^. Lens' Robot Bool
robotHeavy) forall a b. (a -> b) -> a -> b
$ Bool
False
        , Key
"log" forall a v.
(KeyValue a, ToJSON v, Eq v) =>
Key -> v -> v -> Maybe a
.=? (Robot
r forall s a. s -> Getting a s a -> a
^. Lens' Robot (Seq LogEntry)
robotLog) forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => a
mempty
        , -- debug
          Key
"capabilities" forall a v.
(KeyValue a, ToJSON v, Eq v) =>
Key -> v -> v -> Maybe a
.=? (Robot
r forall s a. s -> Getting a s a -> a
^. Getter Robot (Set Capability)
robotCapabilities) forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => a
mempty
        , Key
"logUpdated" forall a v.
(KeyValue a, ToJSON v, Eq v) =>
Key -> v -> v -> Maybe a
.=? (Robot
r forall s a. s -> Getting a s a -> a
^. Lens' Robot Bool
robotLogUpdated) forall a b. (a -> b) -> a -> b
$ Bool
False
        , Key
"context" forall a v.
(KeyValue a, ToJSON v, Eq v) =>
Key -> v -> v -> Maybe a
.=? (Robot
r forall s a. s -> Getting a s a -> a
^. Lens' Robot RobotContext
robotContext) forall a b. (a -> b) -> a -> b
$ RobotContext
emptyRobotContext
        , Key
"parent" forall a v.
(KeyValue a, ToJSON v, Eq v) =>
Key -> v -> v -> Maybe a
.=? (Robot
r forall s a. s -> Getting a s a -> a
^. Lens' Robot (Maybe Int)
robotParentID) forall a b. (a -> b) -> a -> b
$ forall a. Maybe a
Nothing
        , Key
"createdAt" forall a v.
(KeyValue a, ToJSON v, Eq v) =>
Key -> v -> v -> Maybe a
.=? (Robot
r forall s a. s -> Getting a s a -> a
^. Lens' Robot TimeSpec
robotCreatedAt) forall a b. (a -> b) -> a -> b
$ TimeSpec
0
        , Key
"selfDestruct" forall a v.
(KeyValue a, ToJSON v, Eq v) =>
Key -> v -> v -> Maybe a
.=? (Robot
r forall s a. s -> Getting a s a -> a
^. Lens' Robot Bool
selfDestruct) forall a b. (a -> b) -> a -> b
$ Bool
False
        , Key
"activity" forall a v.
(KeyValue a, ToJSON v, Eq v) =>
Key -> v -> v -> Maybe a
.=? (Robot
r forall s a. s -> Getting a s a -> a
^. Lens' Robot ActivityCounts
activityCounts) forall a b. (a -> b) -> a -> b
$ ActivityCounts
emptyActivityCount
        , Key
"runningAtomic" forall a v.
(KeyValue a, ToJSON v, Eq v) =>
Key -> v -> v -> Maybe a
.=? (Robot
r forall s a. s -> Getting a s a -> a
^. Lens' Robot Bool
runningAtomic) forall a b. (a -> b) -> a -> b
$ Bool
False
        ]
   where
    sys :: Bool
sys = Robot
r forall s a. s -> Getting a s a -> a
^. Lens' Robot Bool
systemRobot

-- | Is the robot actively in the middle of a computation?
isActive :: Robot -> Bool
{-# INLINE isActive #-}
isActive :: Robot -> Bool
isActive = forall a. Maybe a -> Bool
isNothing forall b c a. (b -> c) -> (a -> b) -> a -> c
. Robot -> Maybe (Value, Store)
getResult

-- | "Active" robots include robots that are waiting; 'wantsToStep' is
--   true if the robot actually wants to take another step right now
--   (this is a /subset/ of active robots).
wantsToStep :: TickNumber -> Robot -> Bool
wantsToStep :: TickNumber -> Robot -> Bool
wantsToStep TickNumber
now Robot
robot
  | Bool -> Bool
not (Robot -> Bool
isActive Robot
robot) = Bool
False
  | Bool
otherwise = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (TickNumber
now forall a. Ord a => a -> a -> Bool
>=) (Robot -> Maybe TickNumber
waitingUntil Robot
robot)

-- | The time until which the robot is waiting, if any.
waitingUntil :: Robot -> Maybe TickNumber
waitingUntil :: Robot -> Maybe TickNumber
waitingUntil Robot
robot =
  case forall (phase :: RobotPhase). RobotR phase -> CESK
_machine Robot
robot of
    Waiting TickNumber
time CESK
_ -> forall a. a -> Maybe a
Just TickNumber
time
    CESK
_ -> forall a. Maybe a
Nothing

-- | Get the result of the robot's computation if it is finished.
getResult :: Robot -> Maybe (Value, Store)
{-# INLINE getResult #-}
getResult :: Robot -> Maybe (Value, Store)
getResult = CESK -> Maybe (Value, Store)
finalValue forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Robot CESK
machine

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