Merge branch 'main' into xsebek/refactor-capabilities

.github/mergify.yml

@@ -1,6 +1,11 @@
 queue_rules:
   - name: default
-    conditions:
+    merge_method: squash
+    commit_message_template: |
+      {{ title }} (#{{ number }})
+
+      {{ body }}
+    queue_conditions:
       - or:
         - and:
           - -files~=\.hs$
@@ -30,11 +35,6 @@ pull_request_rules:
 - actions:
     queue:
       name: default
-      method: squash
-      commit_message_template: |
-        {{ title }} (#{{ number }})
-
-        {{ body }}
 
   name: Automatically merge pull requests
   conditions:

app/game/Main.hs

@@ -67,6 +67,7 @@ cliParser =
     scriptToRun <- run
     pausedAtStart <- paused
     autoPlay <- autoplay
+    autoShowObjectives <- not <$> hideGoal
     speed <- speedFactor
     debugOptions <- debug
     cheatMode <- cheat
@@ -127,6 +128,8 @@ cliParser =
   paused = switch (long "paused" <> short 'p' <> help "Pause the game at start.")
   autoplay :: Parser Bool
   autoplay = switch (long "autoplay" <> short 'a' <> help "Automatically run the solution defined in the scenario, if there is one. Mutually exclusive with --run.")
+  hideGoal :: Parser Bool
+  hideGoal = switch (long "hide-goal" <> help "Do not show goal modal window that pauses the game.")
   speedFactor :: Parser Int
   speedFactor = option auto (long "speed" <> short 'm' <> metavar "N" <> value defaultInitLgTicksPerSecond <> help speedFactorHelp)
   speedFactorHelp =

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

@@ -461,7 +461,9 @@ initGameState :: GameStateConfig -> GameState
 initGameState gsc =
   GameState
     { _creativeMode = False
-    , _temporal = initTemporalState $ startPaused gsc
+    , _temporal =
+        initTemporalState (startPaused gsc)
+          & pauseOnObjective .~ (if pauseOnObjectiveCompletion gsc then PauseOnAnyObjective else PauseOnWin)
     , _winCondition = NoWinCondition
     , _winSolution = Nothing
     , _robotInfo = initRobots gsc

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

@@ -79,17 +79,18 @@ initGameStateConfig ::
   , Has (Accum (Seq SystemFailure)) sig m
   , Has (Lift IO) sig m
   ) =>
-  Bool ->
+  RuntimeOptions ->
   m GameStateConfig
-initGameStateConfig pause = do
-  gsi <- initGameStateInputs
-  appDataMap <- readAppData
-  nameGen <- initNameGenerator appDataMap
-  return $ GameStateConfig appDataMap nameGen pause gsi
+initGameStateConfig RuntimeOptions {..} = do
+  initAppDataMap <- readAppData
+  nameParts <- initNameGenerator initAppDataMap
+  initState <- initGameStateInputs
+  return $ GameStateConfig {..}
 
 -- | Runtime state initialization options.
 data RuntimeOptions = RuntimeOptions
-  { gamePausedAtStart :: Bool
+  { startPaused :: Bool
+  , pauseOnObjectiveCompletion :: Bool
   , loadTestScenarios :: Bool
   }
   deriving (Eq, Show)
@@ -101,10 +102,9 @@ initRuntimeState ::
   ) =>
   RuntimeOptions ->
   m RuntimeState
-initRuntimeState RuntimeOptions {..} = do
-  gsc <- initGameStateConfig gamePausedAtStart
-  scenarios <- loadScenarios (gsiScenarioInputs $ initState gsc) loadTestScenarios
-
+initRuntimeState opts = do
+  gsc <- initGameStateConfig opts
+  scenarios <- loadScenarios (gsiScenarioInputs $ initState gsc) (loadTestScenarios opts)
   return $
     RuntimeState
       { _webPort = Nothing

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

@@ -27,12 +27,14 @@ module Swarm.Game.State.Substate (
 
   -- *** Temporal state
   TemporalState,
+  PauseOnObjective (..),
   initTemporalState,
   gameStep,
   runStatus,
   ticks,
   robotStepsPerTick,
   paused,
+  pauseOnObjective,
 
   -- *** Recipes
   Recipes,
@@ -146,7 +148,7 @@ data WinStatus
     -- The boolean indicates whether they have
     -- already been informed.
     Unwinnable Bool
-  deriving (Show, Generic, FromJSON, ToJSON)
+  deriving (Eq, Show, Generic, FromJSON, ToJSON)
 
 data WinCondition
   = -- | There is no winning condition.
@@ -274,11 +276,15 @@ data SingleStep
 -- | Game step mode - we use the single step mode when debugging robot 'CESK' machine.
 data Step = WorldTick | RobotStep SingleStep
 
+data PauseOnObjective = PauseOnWin | PauseOnAnyObjective
+  deriving (Eq, Ord, Show, Enum, Bounded)
+
 data TemporalState = TemporalState
   { _gameStep :: Step
   , _runStatus :: RunStatus
   , _ticks :: TickNumber
   , _robotStepsPerTick :: Int
+  , _pauseOnObjective :: PauseOnObjective
   }
 
 makeLensesNoSigs ''TemporalState
@@ -300,6 +306,9 @@ ticks :: Lens' TemporalState TickNumber
 --   a single tick.
 robotStepsPerTick :: Lens' TemporalState Int
 
+-- | Whether to pause the game after an objective is completed.
+pauseOnObjective :: Lens' TemporalState PauseOnObjective
+
 data GameControls = GameControls
   { _replStatus :: REPLStatus
   , _replNextValueIndex :: Integer
@@ -406,6 +415,7 @@ initTemporalState pausedAtStart =
     , _runStatus = if pausedAtStart then ManualPause else Running
     , _ticks = TickNumber 0
     , _robotStepsPerTick = defaultRobotStepsPerTick
+    , _pauseOnObjective = PauseOnAnyObjective
     }
 
 initGameControls :: GameControls

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

@@ -28,6 +28,7 @@ import Control.Effect.Lens
 import Control.Effect.Lift
 import Control.Lens as Lens hiding (Const, distrib, from, parts, use, uses, view, (%=), (+=), (.=), (<+=), (<>=))
 import Control.Monad (foldM, forM_, unless, when)
+import Data.Foldable.Extra (notNull)
 import Data.Functor (void)
 import Data.IntMap qualified as IM
 import Data.IntSet qualified as IS
@@ -338,7 +339,13 @@ hypotheticalWinCheck em g ws oc = do
     Unwinnable _ -> grantAchievement LoseScenario
     _ -> return ()
 
-  messageInfo . announcementQueue %= (>< Seq.fromList (map ObjectiveCompleted $ completionAnnouncementQueue finalAccumulator))
+  queue <- messageInfo . announcementQueue Swarm.Util.<%= (>< Seq.fromList (map ObjectiveCompleted $ completionAnnouncementQueue finalAccumulator))
+  shouldPause <- use $ temporal . pauseOnObjective
+
+  let gameFinished = newWinState /= Ongoing
+  let finishedObjectives = notNull queue
+  when (gameFinished || (finishedObjectives && shouldPause == PauseOnAnyObjective)) $
+    temporal . runStatus .= AutoPause
 
   mapM_ handleException $ exceptions finalAccumulator
  where

src/swarm-scenario/Swarm/Game/State/Config.hs

@@ -18,5 +18,7 @@ data GameStateConfig = GameStateConfig
   -- ^ Lists of words/adjectives for use in building random robot names.
   , startPaused :: Bool
   -- ^ Start the game paused - useful for debugging or competitive play.
+  , pauseOnObjectiveCompletion :: Bool
+  -- ^ Pause the game when any objective is completed.
   , initState :: GameStateInputs
   }

src/swarm-tournament/Swarm/Web/Tournament/Validate.hs

@@ -30,7 +30,7 @@ import Swarm.Game.Scenario.Scoring.CodeSize (codeMetricsFromSyntax)
 import Swarm.Game.Scenario.Status (emptyLaunchParams)
 import Swarm.Game.State
 import Swarm.Game.State.Initialize (scenarioToGameState)
-import Swarm.Game.State.Runtime (initGameStateConfig, initScenarioInputs)
+import Swarm.Game.State.Runtime (RuntimeOptions (..), initGameStateConfig, initScenarioInputs, pauseOnObjectiveCompletion)
 import Swarm.Game.State.Substate (initState, seed)
 import Swarm.Game.Step.Validate (playUntilWin)
 import Swarm.Language.Pipeline
@@ -184,7 +184,12 @@ gamestateFromScenarioText content = do
       . ExceptT
       . runThrow
       . evalAccum (mempty :: Seq SystemFailure)
-      $ initGameStateConfig False
+      . initGameStateConfig
+      $ RuntimeOptions
+        { startPaused = False
+        , pauseOnObjectiveCompletion = False
+        , loadTestScenarios = False
+        }
 
   let scenarioInputs = gsiScenarioInputs $ initState gsc
   scenarioObject <- initScenarioObject scenarioInputs content

src/swarm-tui/Swarm/TUI/Controller.hs

@@ -96,12 +96,10 @@ import Swarm.TUI.Launch.Model
 import Swarm.TUI.Launch.Prep (prepareLaunchDialog)
 import Swarm.TUI.List
 import Swarm.TUI.Model
-import Swarm.TUI.Model.Goal
+import Swarm.TUI.Model.Dialog
 import Swarm.TUI.Model.Name
-import Swarm.TUI.Model.Popup (progressPopups)
 import Swarm.TUI.Model.Repl
 import Swarm.TUI.Model.StateUpdate
-import Swarm.TUI.Model.Structure
 import Swarm.TUI.Model.UI
 import Swarm.Util hiding (both, (<<.=))
 
@@ -294,14 +292,14 @@ handleMainEvent forceRedraw ev = do
       Web (RunWebCode e r) -> runBaseWebCode e r
       UpstreamVersion _ -> error "version event should be handled by top-level handler"
     VtyEvent (V.EvResize _ _) -> invalidateCache
-    EscapeKey | Just m <- s ^. uiState . uiGameplay . uiModal -> closeModal m
+    EscapeKey | Just m <- s ^. uiState . uiGameplay . uiDialogs . uiModal -> closeModal m
     -- Pass to key handler (allows users to configure bindings)
     -- See Note [how Swarm event handlers work]
     VtyEvent (V.EvKey k m)
       | isJust (B.lookupVtyEvent k m keyHandler) -> void $ B.handleKey keyHandler k m
     -- pass keys on to modal event handler if a modal is open
     VtyEvent vev
-      | isJust (s ^. uiState . uiGameplay . uiModal) -> handleModalEvent vev
+      | isJust (s ^. uiState . uiGameplay . uiDialogs . uiModal) -> handleModalEvent vev
     MouseDown (TerrainListItem pos) V.BLeft _ _ ->
       uiState . uiGameplay . uiWorldEditor . terrainList %= BL.listMoveTo pos
     MouseDown (EntityPaintListItem pos) V.BLeft _ _ ->
@@ -367,7 +365,7 @@ handleMainEvent forceRedraw ev = do
 closeModal :: Modal -> EventM Name AppState ()
 closeModal m = do
   safeAutoUnpause
-  uiState . uiGameplay . uiModal .= Nothing
+  uiState . uiGameplay . uiDialogs . uiModal .= Nothing
   -- message modal is not autopaused, so update notifications when leaving it
   when ((m ^. modalType) == MessagesModal) $ do
     t <- use $ gameState . temporal . ticks
@@ -377,7 +375,7 @@ closeModal m = do
 handleModalEvent :: V.Event -> EventM Name AppState ()
 handleModalEvent = \case
   V.EvKey V.KEnter [] -> do
-    mdialog <- preuse $ uiState . uiGameplay . uiModal . _Just . modalDialog
+    mdialog <- preuse $ uiState . uiGameplay . uiDialogs . uiModal . _Just . modalDialog
     toggleModal QuitModal
     case dialogSelection =<< mdialog of
       Just (Button QuitButton, _) -> quitGame
@@ -391,33 +389,33 @@ handleModalEvent = \case
         startGame siPair Nothing
       _ -> return ()
   ev -> do
-    Brick.zoom (uiState . uiGameplay . uiModal . _Just . modalDialog) (handleDialogEvent ev)
-    modal <- preuse $ uiState . uiGameplay . uiModal . _Just . modalType
+    Brick.zoom (uiState . uiGameplay . uiDialogs . uiModal . _Just . modalDialog) (handleDialogEvent ev)
+    modal <- preuse $ uiState . uiGameplay . uiDialogs . uiModal . _Just . modalType
     case modal of
       Just TerrainPaletteModal ->
         refreshList $ uiState . uiGameplay . uiWorldEditor . terrainList
       Just EntityPaletteModal -> do
         refreshList $ uiState . uiGameplay . uiWorldEditor . entityPaintList
       Just GoalModal -> case ev of
-        V.EvKey (V.KChar '\t') [] -> uiState . uiGameplay . uiGoal . focus %= focusNext
+        V.EvKey (V.KChar '\t') [] -> uiState . uiGameplay . uiDialogs . uiGoal . focus %= focusNext
         _ -> do
-          focused <- use $ uiState . uiGameplay . uiGoal . focus
+          focused <- use $ uiState . uiGameplay . uiDialogs . uiGoal . focus
           case focusGetCurrent focused of
             Just (GoalWidgets w) -> case w of
               ObjectivesList -> do
-                lw <- use $ uiState . uiGameplay . uiGoal . listWidget
+                lw <- use $ uiState . uiGameplay . uiDialogs . uiGoal . listWidget
                 newList <- refreshGoalList lw
-                uiState . uiGameplay . uiGoal . listWidget .= newList
+                uiState . uiGameplay . uiDialogs . uiGoal . listWidget .= newList
               GoalSummary -> handleInfoPanelEvent modalScroll (VtyEvent ev)
             _ -> handleInfoPanelEvent modalScroll (VtyEvent ev)
       Just StructuresModal -> case ev of
-        V.EvKey (V.KChar '\t') [] -> uiState . uiGameplay . uiStructure . structurePanelFocus %= focusNext
+        V.EvKey (V.KChar '\t') [] -> uiState . uiGameplay . uiDialogs . uiStructure . structurePanelFocus %= focusNext
         _ -> do
-          focused <- use $ uiState . uiGameplay . uiStructure . structurePanelFocus
+          focused <- use $ uiState . uiGameplay . uiDialogs . uiStructure . structurePanelFocus
           case focusGetCurrent focused of
             Just (StructureWidgets w) -> case w of
               StructuresList ->
-                refreshList $ uiState . uiGameplay . uiStructure . structurePanelListWidget
+                refreshList $ uiState . uiGameplay . uiDialogs . uiStructure . structurePanelListWidget
               StructureSummary -> handleInfoPanelEvent modalScroll (VtyEvent ev)
             _ -> handleInfoPanelEvent modalScroll (VtyEvent ev)
       _ -> handleInfoPanelEvent modalScroll (VtyEvent ev)

src/swarm-tui/Swarm/TUI/Controller/EventHandlers/Main.hs

@@ -24,8 +24,8 @@ import Swarm.TUI.Controller.Util
 import Swarm.TUI.Editor.Model (isWorldEditorEnabled, worldOverdraw)
 import Swarm.TUI.Model
 import Swarm.TUI.Model.DebugOption (DebugOption (ToggleCreative, ToggleWorldEditor))
+import Swarm.TUI.Model.Dialog.Goal
 import Swarm.TUI.Model.Event (MainEvent (..), SwarmEvent (..))
-import Swarm.TUI.Model.Goal
 import Swarm.TUI.Model.UI
 import System.Clock (Clock (..), TimeSpec (..), getTime)
 
@@ -88,7 +88,7 @@ toggleMessagesModal = do
 viewGoal :: EventM Name AppState ()
 viewGoal = do
   s <- get
-  if hasAnythingToShow $ s ^. uiState . uiGameplay . uiGoal . goalsContent
+  if hasAnythingToShow $ s ^. uiState . uiGameplay . uiDialogs . uiGoal . goalsContent
     then toggleModal GoalModal
     else continueWithoutRedraw
 
@@ -144,7 +144,7 @@ toggleREPLVisibility = do
 
 isRunning :: EventM Name AppState Bool
 isRunning = do
-  mt <- preuse $ uiState . uiGameplay . uiModal . _Just . modalType
+  mt <- preuse $ uiState . uiGameplay . uiDialogs . uiModal . _Just . modalType
   return $ maybe True isRunningModal mt
 
 whenRunning :: EventM Name AppState () -> EventM Name AppState ()

src/swarm-tui/Swarm/TUI/Controller/EventHandlers/Robot.hs

@@ -69,7 +69,7 @@ showEntityDescription = gets focusedEntity >>= maybe continueWithoutRedraw descr
   descriptionModal e = do
     s <- get
     resetViewport modalScroll
-    uiState . uiGameplay . uiModal ?= generateModal s (DescriptionModal e)
+    uiState . uiGameplay . uiDialogs . uiModal ?= generateModal s (DescriptionModal e)
 
 -- | Attempt to make an entity selected from the inventory, if the
 --   base is not currently busy.

src/swarm-tui/Swarm/TUI/Controller/UpdateUI.hs

@@ -37,9 +37,9 @@ import Swarm.TUI.Controller.SaveScenario (saveScenarioInfoOnFinishNocheat)
 import Swarm.TUI.Controller.Util
 import Swarm.TUI.Model
 import Swarm.TUI.Model.DebugOption (DebugOption (..))
-import Swarm.TUI.Model.Goal
+import Swarm.TUI.Model.Dialog.Goal
+import Swarm.TUI.Model.Dialog.Popup (Popup (..), addPopup)
 import Swarm.TUI.Model.Name
-import Swarm.TUI.Model.Popup (Popup (..), addPopup)
 import Swarm.TUI.Model.Repl
 import Swarm.TUI.Model.UI
 import Swarm.TUI.View.Objective qualified as GR
@@ -188,10 +188,9 @@ updateUI = do
 -- * shows the player more "optional" goals they can continue to pursue
 doGoalUpdates :: EventM Name AppState Bool
 doGoalUpdates = do
-  curGoal <- use (uiState . uiGameplay . uiGoal . goalsContent)
+  curGoal <- use (uiState . uiGameplay . uiDialogs . uiGoal . goalsContent)
   curWinCondition <- use (gameState . winCondition)
-  announcementsSeq <- use (gameState . messageInfo . announcementQueue)
-  let announcementsList = toList announcementsSeq
+  announcementsList <- use (gameState . messageInfo . announcementQueue . to toList)
 
   -- Decide whether we need to update the current goal text and pop
   -- up a modal dialog.
@@ -218,7 +217,7 @@ doGoalUpdates = do
       return True
     WinConditions _ oc -> do
       showHiddenGoals <- use $ uiState . uiDebugOptions . Lens.contains ShowHiddenGoals
-      currentModal <- preuse $ uiState . uiGameplay . uiModal . _Just . modalType
+      currentModal <- preuse $ uiState . uiGameplay . uiDialogs . uiModal . _Just . modalType
       let newGoalTracking = GoalTracking announcementsList $ constructGoalMap showHiddenGoals oc
           -- The "uiGoal" field is initialized with empty members, so we know that
           -- this will be the first time showing it if it will be nonempty after previously
@@ -232,16 +231,14 @@ doGoalUpdates = do
       when (goalWasUpdated && not isEnding) $ do
         -- The "uiGoal" field is necessary at least to "persist" the data that is needed
         -- if the player chooses to later "recall" the goals dialog with CTRL+g.
-        uiState . uiGameplay . uiGoal .= goalDisplay newGoalTracking
+        uiState . uiGameplay . uiDialogs . uiGoal .= goalDisplay newGoalTracking
 
         -- This clears the "flag" that indicate that the goals dialog needs to be
         -- automatically popped up.
         gameState . messageInfo . announcementQueue .= mempty
 
-        isAutoPlay <- use $ uiState . uiGameplay . uiIsAutoPlay
-        showGoalsAnyway <- use $ uiState . uiDebugOptions . Lens.contains ShowGoalDialogsInAutoPlay
-        unless (isAutoPlay && not showGoalsAnyway) $
-          openModal GoalModal
+        showObjectives <- use $ uiState . uiGameplay . uiAutoShowObjectives
+        when showObjectives $ openModal GoalModal
 
       return goalWasUpdated
  where