diff --git a/src/swarm-doc/Swarm/Doc/Pedagogy.hs b/src/swarm-doc/Swarm/Doc/Pedagogy.hs index 56e0882a5..2c9d42395 100644 --- a/src/swarm-doc/Swarm/Doc/Pedagogy.hs +++ b/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) = diff --git a/src/swarm-engine/Swarm/Game/ScenarioInfo.hs b/src/swarm-engine/Swarm/Game/ScenarioInfo.hs index 6ce5af143..d0d87563e 100644 --- a/src/swarm-engine/Swarm/Game/ScenarioInfo.hs +++ b/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) diff --git a/src/swarm-engine/Swarm/Game/State/Runtime.hs b/src/swarm-engine/Swarm/Game/State/Runtime.hs index 83f21f190..411153d47 100644 --- a/src/swarm-engine/Swarm/Game/State/Runtime.hs +++ b/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 diff --git a/src/swarm-tui/Swarm/TUI/Controller.hs b/src/swarm-tui/Swarm/TUI/Controller.hs index 3ee647d1f..a8476ec71 100644 --- a/src/swarm-tui/Swarm/TUI/Controller.hs +++ b/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 diff --git a/src/swarm-tui/Swarm/TUI/Controller/SaveScenario.hs b/src/swarm-tui/Swarm/TUI/Controller/SaveScenario.hs index 54bf7e428..26f6b451e 100644 --- a/src/swarm-tui/Swarm/TUI/Controller/SaveScenario.hs +++ b/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 .=) diff --git a/src/swarm-tui/Swarm/TUI/Model/DebugOption.hs b/src/swarm-tui/Swarm/TUI/Model/DebugOption.hs index 84d514c4d..a3faaa981 100644 --- a/src/swarm-tui/Swarm/TUI/Model/DebugOption.hs +++ b/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 diff --git a/src/swarm-tui/Swarm/TUI/Model/Menu.hs b/src/swarm-tui/Swarm/TUI/Model/Menu.hs index a9bfc8fe5..de42f7af6 100644 --- a/src/swarm-tui/Swarm/TUI/Model/Menu.hs +++ b/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 diff --git a/src/swarm-tui/Swarm/TUI/Model/StateUpdate.hs b/src/swarm-tui/Swarm/TUI/Model/StateUpdate.hs index 4c869970e..ab6c9f493 100644 --- a/src/swarm-tui/Swarm/TUI/Model/StateUpdate.hs +++ b/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) diff --git a/test/bench/Benchmark.hs b/test/bench/Benchmark.hs index a5d44bad4..e0cbabae3 100644 --- a/test/bench/Benchmark.hs +++ b/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 diff --git a/test/integration/Main.hs b/test/integration/Main.hs index 33ea4f0d0..9f0fa9c8c 100644 --- a/test/integration/Main.hs +++ b/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