diff --git a/src/Swarm/TUI/Model/StateUpdate.hs b/src/Swarm/TUI/Model/StateUpdate.hs index 56a69f455..7afbed9a0 100644 --- a/src/Swarm/TUI/Model/StateUpdate.hs +++ b/src/Swarm/TUI/Model/StateUpdate.hs @@ -5,6 +5,8 @@ -- SPDX-License-Identifier: BSD-3-Clause module Swarm.TUI.Model.StateUpdate ( initAppState, + initPersistentState, + constructAppState, initAppStateForScenario, classicGame0, startGame, @@ -31,6 +33,7 @@ import Data.Time (ZonedTime, getZonedTime) import Swarm.Game.Achievement.Attainment import Swarm.Game.Achievement.Definitions import Swarm.Game.Achievement.Persistence +import Swarm.Game.Failure (SystemFailure) import Swarm.Game.Failure.Render (prettyFailure) import Swarm.Game.Log (ErrorLevel (..), LogSource (ErrorTrace)) import Swarm.Game.Scenario (loadScenario, scenarioAttrs, scenarioWorld) @@ -58,18 +61,43 @@ import Swarm.TUI.Model.UI import Swarm.TUI.View.CustomStyling (toAttrPair) import System.Clock --- | Initialize the 'AppState'. +-- | Initialize the 'AppState' from scratch. initAppState :: AppOpts -> ExceptT Text IO AppState -initAppState AppOpts {..} = do - let isRunningInitialProgram = isJust scriptToRun || autoPlay - skipMenu = isJust userScenario || isRunningInitialProgram || isJust userSeed +initAppState opts = do + (rs, ui) <- initPersistentState opts + constructAppState rs ui opts + +-- | Add some system failures to the list of messages in the +-- 'RuntimeState'. +addWarnings :: RuntimeState -> [SystemFailure] -> RuntimeState +addWarnings = List.foldl' logWarning + where + logWarning rs' w = rs' & eventLog %~ logEvent (ErrorTrace Error) ("UI Loading", -8) (prettyFailure w) + +-- | Based on the command line options, should we skip displaying the +-- menu? +skipMenu :: AppOpts -> Bool +skipMenu AppOpts {..} = isJust userScenario || isRunningInitialProgram || isJust userSeed + where + isRunningInitialProgram = isJust scriptToRun || autoPlay + +-- | Initialize the more persistent parts of the app state, /i.e./ the +-- 'RuntimeState' and 'UIState'. This is split out into a separate +-- function so that in the integration test suite we can call this +-- once and reuse the resulting states for all tests. +initPersistentState :: AppOpts -> ExceptT Text IO (RuntimeState, UIState) +initPersistentState opts@(AppOpts {..}) = do (rsWarnings, initRS) <- initRuntimeState - let gs = initGameState (mkGameStateConfig initRS) - (uiWarnings, ui) <- initUIState speed (not skipMenu) (cheatMode || autoPlay) - let logWarning rs' w = rs' & eventLog %~ logEvent (ErrorTrace Error) ("UI Loading", -8) (prettyFailure w) - addWarnings = List.foldl' logWarning - rs = addWarnings initRS $ rsWarnings <> uiWarnings - case skipMenu of + (uiWarnings, ui) <- initUIState speed (not (skipMenu opts)) (cheatMode || autoPlay) + let rs = addWarnings initRS $ rsWarnings <> uiWarnings + return (rs, ui) + +-- | Construct an 'AppState' from an already-loaded 'RuntimeState' and +-- 'UIState', given the 'AppOpts' the app was started with. +constructAppState :: RuntimeState -> UIState -> AppOpts -> ExceptT Text IO AppState +constructAppState rs ui opts@(AppOpts {..}) = do + let gs = initGameState (mkGameStateConfig rs) + case skipMenu opts of False -> return $ AppState gs (ui & lgTicksPerSecond .~ defaultInitLgTicksPerSecond) rs True -> do (scenario, path) <- loadScenario (fromMaybe "classic" userScenario) (gs ^. entityMap) diff --git a/test/integration/Main.hs b/test/integration/Main.hs index 933677b1b..d07607a59 100644 --- a/test/integration/Main.hs +++ b/test/integration/Main.hs @@ -47,8 +47,9 @@ import Swarm.Game.State ( import Swarm.Game.Step (gameTick) import Swarm.Language.Context qualified as Ctx import Swarm.Language.Pipeline (ProcessedTerm (..), processTerm) -import Swarm.TUI.Model (gameState) -import Swarm.TUI.Model.StateUpdate (initAppStateForScenario) +import Swarm.TUI.Model (RuntimeState, defaultAppOpts, gameState, userScenario) +import Swarm.TUI.Model.StateUpdate (constructAppState, initPersistentState) +import Swarm.TUI.Model.UI (UIState) import Swarm.Util.Yaml (decodeFileEitherE) import System.Directory (doesDirectoryExist, doesFileExist, listDirectory) import System.Environment (getEnvironment) @@ -70,6 +71,11 @@ main = do scenarioPrograms <- acquire "data/scenarios" "sw" ci <- any (("CI" ==) . fst) <$> getEnvironment entities <- loadEntities + (rs, ui) <- do + out <- runExceptT $ initPersistentState defaultAppOpts + case out of + Left x -> assertFailure $ unwords ["Failure in initPersistentState:", T.unpack x] + Right res -> return res case entities of Left t -> fail $ "Couldn't load entities: " <> into @String t Right em -> do @@ -80,7 +86,7 @@ main = do , exampleTests scenarioPrograms , scenarioParseTests em parseableScenarios , scenarioParseInvalidTests em unparseableScenarios - , testScenarioSolution ci em + , testScenarioSolution rs ui ci em , testEditorFiles ] @@ -154,8 +160,8 @@ time = \case data ShouldCheckBadErrors = CheckForBadErrors | AllowBadErrors deriving (Eq, Show) -testScenarioSolution :: Bool -> EntityMap -> TestTree -testScenarioSolution _ci _em = +testScenarioSolution :: RuntimeState -> UIState -> Bool -> EntityMap -> TestTree +testScenarioSolution rs ui _ci _em = testGroup "Test scenario solutions" [ testGroup @@ -171,9 +177,9 @@ testScenarioSolution _ci _em = , testTutorialSolution Default "Tutorials/build" , testTutorialSolution Default "Tutorials/bind2" , testTutorialSolution' Default "Tutorials/crash" CheckForBadErrors $ \g -> do - let rs = toList $ g ^. robotMap + let robots = toList $ g ^. robotMap let hints = any (T.isInfixOf "you will win" . view leText) . toList . view robotLog - let win = isJust $ find hints rs + let win = isJust $ find hints robots assertBool "Could not find a robot with winning instructions!" win , testTutorialSolution Default "Tutorials/scan" , testTutorialSolution Default "Tutorials/give" @@ -308,9 +314,9 @@ testScenarioSolution _ci _em = testSolution' :: Time -> FilePath -> ShouldCheckBadErrors -> (GameState -> Assertion) -> TestTree testSolution' s p shouldCheckBadErrors verify = testCase p $ do - out <- runExceptT $ initAppStateForScenario p Nothing Nothing + out <- runExceptT $ constructAppState rs ui $ defaultAppOpts {userScenario = Just p} case out of - Left x -> assertFailure $ unwords ["Failure in initAppStateForScenario:", T.unpack x] + Left x -> assertFailure $ unwords ["Failure in constructAppState:", T.unpack x] Right (view gameState -> gs) -> case gs ^. winSolution of Nothing -> assertFailure "No solution to test!" Just sol@(ProcessedTerm _ _ reqCtx) -> do