{-# LANGUAGE DataKinds #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE ViewPatterns #-}
{-# OPTIONS_GHC -Wno-orphans #-}

-- |
-- SPDX-License-Identifier: BSD-3-Clause
--
-- Support for instantiated robots.
module Swarm.Game.Robot.Concrete (
  -- * Lenses
  machine,
  activityCounts,
  robotLog,
  robotLogUpdated,

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

  -- * Utilities
  instantiateRobot,
) where

import Control.Lens hiding (Const, contains)
import Data.Aeson qualified as Ae (Key, KeyValue, ToJSON (..), object, (.=))
import Data.Maybe (catMaybes, fromMaybe, isNothing)
import Data.Sequence (Seq)
import Data.Sequence qualified as Seq
import Linear
import Servant.Docs (ToSample)
import Servant.Docs qualified as SD
import Swarm.Game.CESK qualified as C
import Swarm.Game.Display (defaultRobotDisplay, invisible)
import Swarm.Game.Entity hiding (empty)
import Swarm.Game.Robot
import Swarm.Game.Robot.Activity
import Swarm.Game.Robot.Walk (emptyExceptions)
import Swarm.Game.Tick
import Swarm.Game.Universe
import Swarm.Language.Pipeline.QQ (tmQ)
import Swarm.Language.Syntax (TSyntax)
import Swarm.Language.Value as V
import Swarm.Log

type instance RobotMachine 'ConcreteRobot = C.CESK
type instance RobotActivity 'ConcreteRobot = ActivityCounts
type instance RobotLogMember 'ConcreteRobot = Seq LogEntry
type instance RobotLogUpdatedMember 'ConcreteRobot = Bool

machine :: Lens' Robot C.CESK
machine :: Lens' Robot CESK
machine = (Robot -> CESK) -> (Robot -> CESK -> Robot) -> Lens' Robot CESK
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Robot -> RobotMachine 'ConcreteRobot
Robot -> CESK
forall (phase :: RobotPhase). RobotR phase -> RobotMachine phase
_machine (\Robot
r CESK
x -> Robot
r {_machine = x})

-- | Diagnostic and operational tracking of CESK steps or other activity
activityCounts :: Lens' Robot ActivityCounts
activityCounts :: Lens' Robot ActivityCounts
activityCounts = (Robot -> ActivityCounts)
-> (Robot -> ActivityCounts -> Robot) -> Lens' Robot ActivityCounts
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Robot -> RobotActivity 'ConcreteRobot
Robot -> ActivityCounts
forall (phase :: RobotPhase). RobotR phase -> RobotActivity phase
_activityCounts (\Robot
r ActivityCounts
x -> Robot
r {_activityCounts = x})

-- | 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 = (Robot -> Seq LogEntry)
-> (Robot -> Seq LogEntry -> Robot) -> Lens' Robot (Seq LogEntry)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Robot -> Seq LogEntry
Robot -> RobotLogMember 'ConcreteRobot
forall (phase :: RobotPhase). RobotR phase -> RobotLogMember phase
_robotLog Robot -> Seq LogEntry -> Robot
forall {phase :: RobotPhase} {phase :: RobotPhase} {a} {a}.
(RobotID phase ~ RobotID phase,
 RobotMachine phase ~ RobotMachine phase,
 RobotLocation phase ~ RobotLocation phase,
 RobotLogUpdatedMember phase ~ Bool,
 RobotLogUpdatedMember phase ~ Bool, RobotLogMember phase ~ Seq a,
 RobotLogMember phase ~ Seq a,
 RobotActivity phase ~ RobotActivity phase) =>
RobotR phase -> Seq a -> RobotR phase
setLog
 where
  setLog :: RobotR phase -> Seq a -> RobotR phase
setLog RobotR phase
r Seq a
newLog =
    RobotR phase
r
      { _robotLog = 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 =
          _robotLogUpdated r || Seq.length (_robotLog r) /= Seq.length newLog
      }

-- | Has the 'robotLog' been updated since the last time it was
--   viewed?
robotLogUpdated :: Lens' Robot Bool
robotLogUpdated :: Lens' Robot Bool
robotLogUpdated = (Robot -> Bool) -> (Robot -> Bool -> Robot) -> Lens' Robot Bool
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Robot -> Bool
Robot -> RobotLogUpdatedMember 'ConcreteRobot
forall (phase :: RobotPhase).
RobotR phase -> RobotLogUpdatedMember phase
_robotLogUpdated (\Robot
r Bool
x -> Robot
r {_robotLogUpdated = x})

instance ToSample Robot where
  toSamples :: Proxy Robot -> [(Text, Robot)]
toSamples Proxy Robot
_ = Robot -> [(Text, Robot)]
forall a. a -> [(Text, a)]
SD.singleSample Robot
sampleBase
   where
    sampleBase :: Robot
    sampleBase :: Robot
sampleBase =
      Maybe CESK -> RID -> TRobot -> Robot
instantiateRobot (CESK -> Maybe CESK
forall a. a -> Maybe a
Just (CESK -> Maybe CESK) -> CESK -> Maybe CESK
forall a b. (a -> b) -> a -> b
$ TSyntax -> CESK
C.initMachine [tmQ| move |]) RID
0 (TRobot -> Robot) -> TRobot -> Robot
forall a b. (a -> b) -> a -> b
$
        Maybe RID
-> Text
-> Document Syntax
-> Maybe (Cosmic Location)
-> Heading
-> Display
-> Maybe TSyntax
-> [Entity]
-> [(RID, Entity)]
-> Bool
-> Bool
-> WalkabilityExceptions Text
-> TimeSpec
-> TRobot
mkRobot
          Maybe RID
forall a. Maybe a
Nothing
          Text
"base"
          Document Syntax
"The starting robot."
          Maybe (Cosmic Location)
forall a. Maybe a
Nothing
          Heading
forall a. Num a => V2 a
forall (f :: * -> *) a. (Additive f, Num a) => f a
zero
          Display
defaultRobotDisplay
          Maybe TSyntax
forall a. Maybe a
Nothing
          []
          []
          Bool
False
          Bool
False
          WalkabilityExceptions Text
forall a. Monoid a => Inclusions a
emptyExceptions
          TimeSpec
0

mkMachine :: Maybe TSyntax -> C.CESK
mkMachine :: Maybe TSyntax -> CESK
mkMachine Maybe TSyntax
Nothing = Value -> Store -> Cont -> CESK
C.Out Value
VUnit Store
C.emptyStore []
mkMachine (Just TSyntax
t) = TSyntax -> CESK
C.initMachine TSyntax
t

-- | 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'.
--
-- If a machine is not supplied (i.e. 'Nothing'), will fallback to any
-- program specified in the template robot.
instantiateRobot :: Maybe C.CESK -> RID -> TRobot -> Robot
instantiateRobot :: Maybe CESK -> RID -> TRobot -> Robot
instantiateRobot Maybe CESK
maybeMachine RID
i TRobot
r =
  TRobot
r
    { _robotID = i
    , _robotLocation = fromMaybe defaultCosmicLocation $ _robotLocation r
    , _activityCounts = emptyActivityCount
    , _machine = fromMaybe (mkMachine $ _machine r) maybeMachine
    , _robotLog = Seq.empty
    , _robotLogUpdated = False
    }

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

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

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

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

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

-- | Is the robot actively in the middle of a computation?
isActive :: Robot -> Bool
{-# INLINE isActive #-}
isActive :: Robot -> Bool
isActive = Maybe Value -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe Value -> Bool) -> (Robot -> Maybe Value) -> Robot -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Robot -> Maybe Value
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 = Bool -> (TickNumber -> Bool) -> Maybe TickNumber -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (TickNumber
now TickNumber -> TickNumber -> Bool
forall a. Ord a => a -> a -> Bool
>=) (Robot -> Maybe TickNumber
waitingUntil Robot
robot)