Log watch command

src/swarm-engine/Swarm/Game/State/Robot.hs

@@ -23,6 +23,7 @@ module Swarm.Game.State.Robot (
   robotMap,
   robotsByLocation,
   robotsWatching,
+  wakeLog,
   activeRobots,
   waitingRobots,
   viewCenterRule,
@@ -72,6 +73,7 @@ import Swarm.Game.Location
 import Swarm.Game.ResourceLoading (NameGenerator)
 import Swarm.Game.Robot
 import Swarm.Game.State.Config
+import Swarm.Game.Step.WakeLog
 import Swarm.Game.Universe as U
 import Swarm.Util (binTuples, surfaceEmpty, (<+=), (<<.=))
 import Swarm.Util.Lens (makeLensesExcluding)
@@ -122,6 +124,7 @@ data Robots = Robots
     -- that we do not have to iterate over all "waiting" robots,
     -- since there may be many.
     _robotsWatching :: Map (Cosmic Location) (S.Set RID)
+  , _wakeLog :: [WakeLogEvent]
   , _robotNaming :: RobotNaming
   , _viewCenterRule :: ViewCenterRule
   , _viewCenter :: Cosmic Location
@@ -164,6 +167,7 @@ robotsByLocation :: Lens' Robots (Map SubworldName (Map Location IntSet))
 
 -- | Get a list of all the robots that are \"watching\" by location.
 robotsWatching :: Lens' Robots (Map (Cosmic Location) (S.Set RID))
+wakeLog :: Lens' Robots [WakeLogEvent]
 
 -- | State and data for assigning identifiers to robots
 robotNaming :: Lens' Robots RobotNaming
@@ -195,6 +199,7 @@ initRobots gsc =
     , _waitingRobots = M.empty
     , _robotsByLocation = M.empty
     , _robotsWatching = mempty
+    , _wakeLog = mempty
     , _robotNaming =
         RobotNaming
           { _nameGenerator = initNameParts gsc
@@ -301,6 +306,9 @@ wakeUpRobotsDoneSleeping time = do
       let aliveRids = filter (`IM.member` robots) rids
       internalActiveRobots %= IS.union (IS.fromList aliveRids)
 
+      forM_ aliveRids $ \rid ->
+        wakeLog %= (WakeLogEvent rid time DoneSleeping :)
+
       -- These robots' wake times may have been moved "forward"
       -- by 'wakeWatchingRobots'.
       clearWatchingRobots rids
@@ -311,7 +319,7 @@ clearWatchingRobots ::
   (Has (State Robots) sig m) =>
   [RID] ->
   m ()
-clearWatchingRobots rids = do
+clearWatchingRobots rids =
   robotsWatching %= M.map (`S.difference` S.fromList rids)
 
 -- | Iterates through all of the currently @wait@-ing robots,
@@ -358,6 +366,9 @@ wakeWatchingRobots currentTick loc = do
       newWakeTime = addTicks 1 currentTick
       newInsertions = M.singleton newWakeTime wakeableBotIds
 
+  forM_ wakeableBotIds $ \rid ->
+    wakeLog %= (WakeLogEvent rid newWakeTime ScheduledWakeup :)
+
   -- NOTE: There are two "sources of truth" for the waiting state of robots:
   -- 1. In the GameState via "internalWaitingRobots"
   -- 2. In each robot, via the CESK machine state

src/swarm-engine/Swarm/Game/Step/Const.hs

@@ -76,6 +76,7 @@ import Swarm.Game.Step.RobotStepState
 import Swarm.Game.Step.Util
 import Swarm.Game.Step.Util.Command
 import Swarm.Game.Step.Util.Inspect
+import Swarm.Game.Step.WakeLog
 import Swarm.Game.Universe
 import Swarm.Game.Value
 import Swarm.Game.World (locToCoords)
@@ -136,6 +137,10 @@ execConst runChildProg c vs s k = do
       [VInt d] -> do
         time <- use $ temporal . ticks
         purgeFarAwayWatches
+
+        rid <- use robotID
+        robotInfo . wakeLog %= (WakeLogEvent rid time CalledWaitCommand :)
+
         return $ Waiting (addTicks (fromIntegral d) time) (mkReturn ())
       _ -> badConst
     Selfdestruct -> do
@@ -283,6 +288,10 @@ execConst runChildProg c vs s k = do
       _ -> badConst
     Swap -> case vs of
       [VText name] -> do
+        time <- use $ temporal . ticks
+        rid <- use robotID
+        robotInfo . wakeLog %= (WakeLogEvent rid time CalledSwapCommand :)
+
         loc <- use robotLocation
         -- Make sure the robot has the thing in its inventory
         e <- hasInInventoryOrFail name

src/swarm-engine/Swarm/Game/Step/WakeLog.hs

@@ -0,0 +1,32 @@
+-- |
+-- SPDX-License-Identifier: BSD-3-Clause
+module Swarm.Game.Step.WakeLog where
+
+import Data.Aeson (ToJSON (..))
+import GHC.Generics (Generic)
+import Servant.Docs (ToSample)
+import Servant.Docs qualified as SD
+import Swarm.Game.CESK (TickNumber)
+import Swarm.Game.Robot (RID)
+
+data WakeLogEvent = WakeLogEvent
+  { targetRobotID :: RID
+  , thisEventTime :: TickNumber
+  , thisEventType :: WakeLogEventType
+  }
+  deriving (Show, Eq, Generic, ToJSON)
+
+data WakeLogEventType
+  = ScheduledWakeup
+  | CalledWaitCommand
+  | CalledSwapCommand
+  | DoneSleeping
+  deriving (Show, Eq, Generic, ToJSON)
+
+-- instance ToJSON WakeLogEventType where
+--   toJSON = genericToJSON $ defaultOptions
+--     { sumEncoding = ObjectWithSingleField
+--     }
+
+instance ToSample WakeLogEvent where
+  toSamples _ = SD.noSamples

src/swarm-web/Swarm/Web.hs

@@ -75,6 +75,7 @@ import Swarm.Game.State
 import Swarm.Game.State.Robot
 import Swarm.Game.State.Substate
 import Swarm.Game.Step.Path.Type
+import Swarm.Game.Step.WakeLog
 import Swarm.Language.Module
 import Swarm.Language.Pipeline
 import Swarm.Language.Pretty (prettyTextLine)
@@ -99,6 +100,7 @@ newtype RobotID = RobotID Int
 type SwarmAPI =
   "robots" :> Get '[JSON] [Robot]
     :<|> "robot" :> Capture "id" RobotID :> Get '[JSON] (Maybe Robot)
+    :<|> "sleep" :> Get '[JSON] [WakeLogEvent]
     :<|> "goals" :> "prereqs" :> Get '[JSON] [PrereqSatisfaction]
     :<|> "goals" :> "active" :> Get '[JSON] [Objective]
     :<|> "goals" :> "graph" :> Get '[JSON] (Maybe GraphInfo)
@@ -154,6 +156,7 @@ mkApp ::
 mkApp state events =
   robotsHandler state
     :<|> robotHandler state
+    :<|> sleepHandler state
     :<|> prereqsHandler state
     :<|> activeGoalsHandler state
     :<|> goalsGraphHandler state
@@ -177,6 +180,11 @@ robotHandler appStateRef (RobotID rid) = do
   appState <- liftIO (readIORef appStateRef)
   pure $ IM.lookup rid (appState ^. gameState . robotInfo . robotMap)
 
+sleepHandler :: ReadableIORef AppState -> Handler [WakeLogEvent]
+sleepHandler appStateRef = do
+  appState <- liftIO (readIORef appStateRef)
+  pure $ appState ^. gameState . robotInfo . wakeLog
+
 prereqsHandler :: ReadableIORef AppState -> Handler [PrereqSatisfaction]
 prereqsHandler appStateRef = do
   appState <- liftIO (readIORef appStateRef)

swarm.cabal

@@ -226,6 +226,7 @@ library swarm-engine
                       Swarm.Game.Step.Util
                       Swarm.Game.Step.Util.Command
                       Swarm.Game.Step.Util.Inspect
+                      Swarm.Game.Step.WakeLog
                       Swarm.Game.Terrain
                       Swarm.Game.Value
                       Swarm.Game.World
@@ -492,6 +493,7 @@ library
                       , Swarm.Game.Step.Util
                       , Swarm.Game.Step.Util.Command
                       , Swarm.Game.Step.Util.Inspect
+                      , Swarm.Game.Step.WakeLog
                       , Swarm.Game.Terrain
                       , Swarm.Game.Value
                       , Swarm.Game.World