Skip to content

Commit

Permalink
Avoid loading testing scenarios
Browse files Browse the repository at this point in the history
  • Loading branch information
xsebek committed Sep 1, 2024
1 parent aeedebf commit fd93b7a
Show file tree
Hide file tree
Showing 10 changed files with 40 additions and 34 deletions.
2 changes: 1 addition & 1 deletion src/swarm-doc/Swarm/Doc/Pedagogy.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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) =
Expand Down
22 changes: 14 additions & 8 deletions src/swarm-engine/Swarm/Game/ScenarioInfo.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand All @@ -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
Expand All @@ -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
Expand All @@ -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.
Expand Down Expand Up @@ -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)
Expand Down
5 changes: 3 additions & 2 deletions src/swarm-engine/Swarm/Game/State/Runtime.hs
Original file line number Diff line number Diff line change
Expand Up @@ -91,10 +91,11 @@ initRuntimeState ::
, Has (Lift IO) sig m
) =>
Bool ->
Bool ->
m RuntimeState
initRuntimeState pause = do
initRuntimeState pause loadTestScenarios = do
gsc <- initGameStateConfig pause
scenarios <- loadScenarios $ gsiScenarioInputs $ initState gsc
scenarios <- loadScenarios (gsiScenarioInputs $ initState gsc) loadTestScenarios

return $
RuntimeState
Expand Down
12 changes: 4 additions & 8 deletions src/swarm-tui/Swarm/TUI/Controller.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down Expand Up @@ -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

Expand Down Expand Up @@ -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
Expand Down
3 changes: 1 addition & 2 deletions src/swarm-tui/Swarm/TUI/Controller/SaveScenario.hs
Original file line number Diff line number Diff line change
Expand Up @@ -118,5 +118,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 .=)
6 changes: 3 additions & 3 deletions src/swarm-tui/Swarm/TUI/Model/DebugOption.hs
Original file line number Diff line number Diff line change
Expand Up @@ -21,7 +21,7 @@ data DebugOption
| ListRobotIDs
| ShowHiddenGoals
| ShowGoalDialogsInAutoPlay
| ShowTestingScenarios
| LoadTestingScenarios
deriving (Eq, Ord, Show, Enum, Bounded)

debugOptionName :: DebugOption -> String
Expand All @@ -33,7 +33,7 @@ debugOptionName = \case
ListRobotIDs -> "robot_id"
ShowHiddenGoals -> "hidden_goals"
ShowGoalDialogsInAutoPlay -> "autoplay_goals"
ShowTestingScenarios -> "testing"
LoadTestingScenarios -> "testing"

debugOptionDescription :: DebugOption -> String
debugOptionDescription = \case
Expand All @@ -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
Expand Down
12 changes: 5 additions & 7 deletions src/swarm-tui/Swarm/TUI/Model/Menu.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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 ->
Expand All @@ -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
Expand Down
4 changes: 3 additions & 1 deletion src/swarm-tui/Swarm/TUI/Model/StateUpdate.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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 (..))
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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 pausedAtStart (Set.member LoadTestingScenarios debugOptions)
ui <- initUIState speed (not (skipMenu opts)) debugOptions
ks <- initKeyHandlingState
return (rs, ui, ks)
Expand Down
2 changes: 1 addition & 1 deletion test/bench/Benchmark.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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 False False
(scenario, _) <- loadStandaloneScenario "classic"
return $ pureScenarioToGameState scenario 0 0 Nothing $ view stdGameConfigInputs initRS

Expand Down
6 changes: 5 additions & 1 deletion test/integration/Main.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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)
Expand All @@ -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
Expand Down

0 comments on commit fd93b7a

Please sign in to comment.