Avoid loading testing scenarios (#2129)

* closes #2125

src/swarm-doc/Swarm/Doc/Pedagogy.hs

@@ -180,7 +180,7 @@ loadScenarioCollection = simpleErrorHandle $ do
   -- all the scenarios via the usual code path; we do not need to do
   -- anything with them here while simply rendering pedagogy info.
   worlds <- ignoreWarnings @(Seq SystemFailure) $ loadWorlds tem
-  ignoreWarnings @(Seq SystemFailure) $ loadScenarios $ ScenarioInputs worlds tem
+  ignoreWarnings @(Seq SystemFailure) $ loadScenarios (ScenarioInputs worlds tem) True
 
 renderUsagesMarkdown :: CoverageInfo -> Text
 renderUsagesMarkdown (CoverageInfo (TutorialInfo (s, si) idx _sCmds dCmds) novelCmds) =

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

@@ -148,20 +148,24 @@ flatten (SICollection _ c) = concatMap flatten $ scenarioCollectionToList c
 loadScenarios ::
   (Has (Accum (Seq SystemFailure)) sig m, Has (Lift IO) sig m) =>
   ScenarioInputs ->
+  Bool ->
   m ScenarioCollection
-loadScenarios scenarioInputs = do
+loadScenarios scenarioInputs loadTestScenarios = do
   res <- runThrow @SystemFailure $ getDataDirSafe Scenarios "scenarios"
   case res of
     Left err -> do
       warn err
       return $ SC mempty mempty
-    Right dataDir -> loadScenarioDir scenarioInputs dataDir
+    Right dataDir -> loadScenarioDir scenarioInputs loadTestScenarios dataDir
 
 -- | The name of the special file which indicates the order of
 --   scenarios in a folder.
 orderFileName :: FilePath
 orderFileName = "00-ORDER.txt"
 
+testingDirectory :: FilePath
+testingDirectory = "Testing"
+
 readOrderFile :: (Has (Lift IO) sig m) => FilePath -> m [String]
 readOrderFile orderFile =
   filter (not . null) . lines <$> sendIO (readFile orderFile)
@@ -171,15 +175,16 @@ readOrderFile orderFile =
 loadScenarioDir ::
   (Has (Accum (Seq SystemFailure)) sig m, Has (Lift IO) sig m) =>
   ScenarioInputs ->
+  Bool ->
   FilePath ->
   m ScenarioCollection
-loadScenarioDir scenarioInputs dir = do
+loadScenarioDir scenarioInputs loadTestScenarios dir = do
   let orderFile = dir </> orderFileName
       dirName = takeBaseName dir
   orderExists <- sendIO $ doesFileExist orderFile
   morder <- case orderExists of
     False -> do
-      when (dirName /= "Testing") . warn $
+      when (dirName /= testingDirectory) . warn $
         OrderFileWarning (dirName </> orderFileName) NoOrderFile
       return Nothing
     True -> Just <$> readOrderFile orderFile
@@ -204,7 +209,7 @@ loadScenarioDir scenarioInputs dir = do
   -- Only keep the files from 00-ORDER.txt that actually exist.
   let morder' = filter (`elem` itemPaths) <$> morder
       loadItem filepath = do
-        item <- loadScenarioItem scenarioInputs (dir </> filepath)
+        item <- loadScenarioItem scenarioInputs loadTestScenarios (dir </> filepath)
         return (filepath, item)
   scenarios <- mapM (runThrow @SystemFailure . loadItem) itemPaths
   let (failures, successes) = partitionEithers scenarios
@@ -224,7 +229,7 @@ loadScenarioDir scenarioInputs dir = do
     isDir <- doesDirectoryExist $ d </> f
     return $
       if isDir
-        then not $ "_" `isPrefixOf` f
+        then not ("_" `isPrefixOf` f) && (loadTestScenarios || f /= testingDirectory)
         else takeExtensions f == ".yaml"
 
 -- | How to transform scenario path to save path.
@@ -266,13 +271,14 @@ loadScenarioItem ::
   , Has (Lift IO) sig m
   ) =>
   ScenarioInputs ->
+  Bool ->
   FilePath ->
   m ScenarioItem
-loadScenarioItem scenarioInputs path = do
+loadScenarioItem scenarioInputs loadTestScenarios path = do
   isDir <- sendIO $ doesDirectoryExist path
   let collectionName = into @Text . dropWhile isSpace . takeBaseName $ path
   case isDir of
-    True -> SICollection collectionName <$> loadScenarioDir scenarioInputs path
+    True -> SICollection collectionName <$> loadScenarioDir scenarioInputs loadTestScenarios path
     False -> do
       s <- loadScenarioFile scenarioInputs path
       eitherSi <- runThrow @SystemFailure (loadScenarioInfo path)

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

@@ -1,4 +1,5 @@
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE TemplateHaskell #-}
 
 -- |
@@ -7,6 +8,8 @@
 -- Runtime state and utility functions
 module Swarm.Game.State.Runtime (
   RuntimeState,
+  RuntimeOptions (..),
+  initRuntimeState,
 
   -- ** Lenses
   webPort,
@@ -18,7 +21,6 @@ module Swarm.Game.State.Runtime (
 
   -- ** Utility
   initScenarioInputs,
-  initRuntimeState,
   initGameStateConfig,
 )
 where
@@ -85,16 +87,23 @@ initGameStateConfig pause = do
   nameGen <- initNameGenerator appDataMap
   return $ GameStateConfig appDataMap nameGen pause gsi
 
+-- | Runtime state initialization options.
+data RuntimeOptions = RuntimeOptions
+  { gamePausedAtStart :: Bool
+  , loadTestScenarios :: Bool
+  }
+  deriving (Eq, Show)
+
 initRuntimeState ::
   ( Has (Throw SystemFailure) sig m
   , Has (Accum (Seq SystemFailure)) sig m
   , Has (Lift IO) sig m
   ) =>
-  Bool ->
+  RuntimeOptions ->
   m RuntimeState
-initRuntimeState pause = do
-  gsc <- initGameStateConfig pause
-  scenarios <- loadScenarios $ gsiScenarioInputs $ initState gsc
+initRuntimeState RuntimeOptions {..} = do
+  gsc <- initGameStateConfig gamePausedAtStart
+  scenarios <- loadScenarios (gsiScenarioInputs $ initState gsc) loadTestScenarios
 
   return $
     RuntimeState

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

@@ -96,7 +96,6 @@ import Swarm.TUI.Launch.Model
 import Swarm.TUI.Launch.Prep (prepareLaunchDialog)
 import Swarm.TUI.List
 import Swarm.TUI.Model
-import Swarm.TUI.Model.DebugOption (DebugOption (..))
 import Swarm.TUI.Model.Goal
 import Swarm.TUI.Model.Name
 import Swarm.TUI.Model.Popup (progressPopups)
@@ -174,19 +173,17 @@ handleMainMenuEvent menu = \case
       Nothing -> pure ()
       Just x0 -> case x0 of
         NewGame -> do
-          showTesting <- use $ uiState . uiDebugOptions . Lens.contains ShowTestingScenarios
           ss <- use $ runtimeState . scenarios
-          uiState . uiMenu .= NewGameMenu (pure $ mkScenarioList showTesting ss)
+          uiState . uiMenu .= NewGameMenu (pure $ mkScenarioList ss)
         Tutorial -> do
           -- Set up the menu stack as if the user had chosen "New Game > Tutorials"
-          showTesting <- use $ uiState . uiDebugOptions . Lens.contains ShowTestingScenarios
           ss <- use $ runtimeState . scenarios
           let tutorialCollection = getTutorials ss
               topMenu =
                 BL.listFindBy
                   ((== tutorialsDirname) . T.unpack . scenarioItemName)
-                  (mkScenarioList showTesting ss)
-              tutorialMenu = mkScenarioList showTesting tutorialCollection
+                  (mkScenarioList ss)
+              tutorialMenu = mkScenarioList tutorialCollection
               menuStack = tutorialMenu :| pure topMenu
           uiState . uiMenu .= NewGameMenu menuStack
 
@@ -255,8 +252,7 @@ handleNewGameMenuEvent scenarioStack@(curMenu :| rest) = \case
       Nothing -> pure ()
       Just (SISingle siPair) -> invalidateCache >> startGame siPair Nothing
       Just (SICollection _ c) -> do
-        showTesting <- use $ uiState . uiDebugOptions . Lens.contains ShowTestingScenarios
-        uiState . uiMenu .= NewGameMenu (NE.cons (mkScenarioList showTesting c) scenarioStack)
+        uiState . uiMenu .= NewGameMenu (NE.cons (mkScenarioList c) scenarioStack)
   CharKey 'o' -> showLaunchDialog
   CharKey 'O' -> showLaunchDialog
   Key V.KEsc -> exitNewGameMenu scenarioStack

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

@@ -24,7 +24,6 @@ import Swarm.Game.State.Runtime
 import Swarm.Game.State.Substate
 import Swarm.TUI.Model
 import Swarm.TUI.Model.Achievements (attainAchievement')
-import Swarm.TUI.Model.DebugOption (DebugOption (..))
 import Swarm.TUI.Model.Repl
 import Swarm.TUI.Model.UI
 import System.FilePath (splitDirectories)
@@ -118,5 +117,4 @@ saveScenarioInfoOnQuit =
         -- Now rebuild the NewGameMenu so it gets the updated ScenarioInfo,
         -- being sure to preserve the same focused scenario.
         sc <- use $ runtimeState . scenarios
-        showTesting <- use $ uiState . uiDebugOptions . contains ShowTestingScenarios
-        forM_ (mkNewGameMenu showTesting sc (fromMaybe p curPath)) (uiState . uiMenu .=)
+        forM_ (mkNewGameMenu sc (fromMaybe p curPath)) (uiState . uiMenu .=)

src/swarm-tui/Swarm/TUI/Model/DebugOption.hs

@@ -21,7 +21,7 @@ data DebugOption
   | ListRobotIDs
   | ShowHiddenGoals
   | ShowGoalDialogsInAutoPlay
-  | ShowTestingScenarios
+  | LoadTestingScenarios
   deriving (Eq, Ord, Show, Enum, Bounded)
 
 debugOptionName :: DebugOption -> String
@@ -33,7 +33,7 @@ debugOptionName = \case
   ListRobotIDs -> "robot_id"
   ShowHiddenGoals -> "hidden_goals"
   ShowGoalDialogsInAutoPlay -> "autoplay_goals"
-  ShowTestingScenarios -> "testing"
+  LoadTestingScenarios -> "testing"
 
 debugOptionDescription :: DebugOption -> String
 debugOptionDescription = \case
@@ -44,7 +44,7 @@ debugOptionDescription = \case
   ListRobotIDs -> "list robot IDs in the robot panel"
   ShowHiddenGoals -> "show hidden objectives in the goal dialog"
   ShowGoalDialogsInAutoPlay -> "show goal dialogs when running in autoplay"
-  ShowTestingScenarios -> "show Testing folder in scenarios menu"
+  LoadTestingScenarios -> "load Testing folder in scenarios menu"
 
 readDebugOption :: String -> Maybe DebugOption
 readDebugOption name = find ((trim name ==) . debugOptionName) enumerate

src/swarm-tui/Swarm/TUI/Model/Menu.hs

@@ -101,16 +101,14 @@ mainMenu e = BL.list MenuList (V.fromList enumerate) 1 & BL.listMoveToElement e
 makePrisms ''Menu
 
 -- | Create a brick 'BL.List' of scenario items from a 'ScenarioCollection'.
-mkScenarioList :: Bool -> ScenarioCollection -> BL.List Name ScenarioItem
-mkScenarioList showTesting = flip (BL.list ScenarioList) 1 . V.fromList . filterTest . scenarioCollectionToList
- where
-  filterTest = if showTesting then id else filter (\case SICollection n _ -> n /= "Testing"; _ -> True)
+mkScenarioList :: ScenarioCollection -> BL.List Name ScenarioItem
+mkScenarioList = flip (BL.list ScenarioList) 1 . V.fromList . scenarioCollectionToList
 
 -- | Given a 'ScenarioCollection' and a 'FilePath' which is the canonical
 --   path to some folder or scenario, construct a 'NewGameMenu' stack
 --   focused on the given item, if possible.
-mkNewGameMenu :: Bool -> ScenarioCollection -> FilePath -> Maybe Menu
-mkNewGameMenu showTesting sc path = fmap NewGameMenu $ NE.nonEmpty =<< go (Just sc) (splitPath path) []
+mkNewGameMenu :: ScenarioCollection -> FilePath -> Maybe Menu
+mkNewGameMenu sc path = fmap NewGameMenu $ NE.nonEmpty =<< go (Just sc) (splitPath path) []
  where
   go ::
     Maybe ScenarioCollection ->
@@ -125,7 +123,7 @@ mkNewGameMenu showTesting sc path = fmap NewGameMenu $ NE.nonEmpty =<< go (Just
     hasName (SISingle (_, ScenarioInfo pth _)) = takeFileName pth == thing
     hasName (SICollection nm _) = nm == into @Text (dropTrailingPathSeparator thing)
 
-    lst = BL.listFindBy hasName (mkScenarioList showTesting curSC)
+    lst = BL.listFindBy hasName (mkScenarioList curSC)
 
     nextSC = case M.lookup (dropTrailingPathSeparator thing) (scMap curSC) of
       Just (SICollection _ c) -> Just c

src/swarm-tui/Swarm/TUI/Model/StateUpdate.hs

@@ -40,6 +40,7 @@ import Data.List.NonEmpty qualified as NE
 import Data.Map qualified as M
 import Data.Maybe (fromMaybe, isJust)
 import Data.Sequence (Seq)
+import Data.Set qualified as Set
 import Data.Text (Text)
 import Data.Time (getZonedTime)
 import Swarm.Game.Failure (SystemFailure (..))
@@ -80,6 +81,7 @@ import Swarm.TUI.Inventory.Sorting
 import Swarm.TUI.Launch.Model (toSerializableParams)
 import Swarm.TUI.Model
 import Swarm.TUI.Model.Achievements
+import Swarm.TUI.Model.DebugOption (DebugOption (LoadTestingScenarios))
 import Swarm.TUI.Model.Goal (emptyGoalDisplay)
 import Swarm.TUI.Model.KeyBindings
 import Swarm.TUI.Model.Name
@@ -125,7 +127,7 @@ initPersistentState ::
   m (RuntimeState, UIState, KeyEventHandlingState)
 initPersistentState opts@(AppOpts {..}) = do
   (warnings :: Seq SystemFailure, (initRS, initUI, initKs)) <- runAccum mempty $ do
-    rs <- initRuntimeState pausedAtStart
+    rs <- initRuntimeState $ RuntimeOptions pausedAtStart (Set.member LoadTestingScenarios debugOptions)
     ui <- initUIState speed (not (skipMenu opts)) debugOptions
     ks <- initKeyHandlingState
     return (rs, ui, ks)

test/bench/Benchmark.hs

@@ -25,7 +25,7 @@ import Swarm.Game.State (GameState, creativeMode, landscape, zoomRobots)
 import Swarm.Game.State.Initialize (pureScenarioToGameState)
 import Swarm.Game.State.Landscape (multiWorld)
 import Swarm.Game.State.Robot (addTRobot)
-import Swarm.Game.State.Runtime (initRuntimeState, stdGameConfigInputs)
+import Swarm.Game.State.Runtime (RuntimeOptions (..), initRuntimeState, stdGameConfigInputs)
 import Swarm.Game.Step (gameTick)
 import Swarm.Game.Terrain (blankTerrainIndex)
 import Swarm.Game.Universe (Cosmic (..), SubworldName (DefaultRootSubworld))
@@ -142,7 +142,7 @@ mkGameState prog robotMaker numRobots = do
 
   -- NOTE: This replaces "classicGame0", which is still used by unit tests.
   gs <- simpleErrorHandle $ do
-    (_ :: Seq SystemFailure, initRS) <- runAccum mempty $ initRuntimeState False
+    (_ :: Seq SystemFailure, initRS) <- runAccum mempty $ initRuntimeState $ RuntimeOptions False False
     (scenario, _) <- loadStandaloneScenario "classic"
     return $ pureScenarioToGameState scenario 0 0 Nothing $ view stdGameConfigInputs initRS
 

test/integration/Main.hs

@@ -21,6 +21,7 @@ import Data.IntSet qualified as IS
 import Data.List (partition)
 import Data.Map qualified as M
 import Data.Maybe (isJust)
+import Data.Set qualified as S
 import Data.Text (Text)
 import Data.Text qualified as T
 import Data.Text.IO qualified as T
@@ -70,11 +71,13 @@ import Swarm.Language.Pretty (prettyString)
 import Swarm.Log
 import Swarm.TUI.Model (
   KeyEventHandlingState,
+  debugOptions,
   defaultAppOpts,
   gameState,
   runtimeState,
   userScenario,
  )
+import Swarm.TUI.Model.DebugOption (DebugOption (LoadTestingScenarios))
 import Swarm.TUI.Model.StateUpdate (constructAppState, initPersistentState)
 import Swarm.TUI.Model.UI (UIState)
 import Swarm.Util (findAllWithExt)
@@ -98,7 +101,8 @@ main = do
   let (unparseableScenarios, parseableScenarios) = partition isUnparseableTest scenarioPaths
   scenarioPrograms <- findAllWithExt "data/scenarios" "sw"
   (rs, ui, key) <- do
-    out <- runM . runThrow @SystemFailure $ initPersistentState defaultAppOpts
+    let testingOptions = defaultAppOpts {debugOptions = S.singleton LoadTestingScenarios}
+    out <- runM . runThrow @SystemFailure $ initPersistentState testingOptions
     either (assertFailure . prettyString) return out
   let scenarioInputs = gsiScenarioInputs $ initState $ rs ^. stdGameConfigInputs
       rs' = rs & eventLog .~ mempty