diff --git a/app/Swarm/App.hs b/app/Swarm/App.hs index 4a776586..9e075595 100644 --- a/app/Swarm/App.hs +++ b/app/Swarm/App.hs @@ -25,6 +25,7 @@ import Data.Text.IO qualified as T import Graphics.Vty qualified as V import Graphics.Vty.CrossPlatform qualified as V import Swarm.Game.Failure (SystemFailure) +import Swarm.Game.State.Runtime import Swarm.Language.Pretty (prettyText) import Swarm.Log (LogSource (SystemLog), Severity (..)) import Swarm.TUI.Controller diff --git a/scripts/benchmark-against-parent.sh b/scripts/benchmark-against-parent.sh index deb3674b..bc2dfc34 100755 --- a/scripts/benchmark-against-parent.sh +++ b/scripts/benchmark-against-parent.sh @@ -16,7 +16,7 @@ fi BASELINE_OUTPUT=baseline.csv git checkout HEAD~ -stack bench --benchmark-arguments "--csv $BASELINE_OUTPUT --color always" +STACK_WORK=.stack-work-bench stack bench swarm:benchmark --benchmark-arguments "--csv $BASELINE_OUTPUT --color always" git switch - -stack bench --benchmark-arguments "--baseline $BASELINE_OUTPUT --fail-if-slower 3 --color always" \ No newline at end of file +STACK_WORK=.stack-work-bench stack bench swarm:benchmark --benchmark-arguments "--baseline $BASELINE_OUTPUT --fail-if-slower 3 --color always" \ No newline at end of file diff --git a/src/Swarm/TUI/Controller.hs b/src/Swarm/TUI/Controller.hs index 7644d6dd..d1820696 100644 --- a/src/Swarm/TUI/Controller.hs +++ b/src/Swarm/TUI/Controller.hs @@ -85,6 +85,7 @@ import Swarm.Game.Scenario.Topography.Structure.Recognition.Type (originalStruct import Swarm.Game.ScenarioInfo import Swarm.Game.State import Swarm.Game.State.Robot +import Swarm.Game.State.Runtime import Swarm.Game.State.Substate import Swarm.Game.Step (finishGameTick, gameTick) import Swarm.Language.Capability (Capability (CDebug, CGod, CMake), constCaps) diff --git a/src/Swarm/TUI/Model.hs b/src/Swarm/TUI/Model.hs index d7af08a5..1e2abd4b 100644 --- a/src/Swarm/TUI/Model.hs +++ b/src/Swarm/TUI/Model.hs @@ -80,21 +80,8 @@ module Swarm.TUI.Model ( modalScroll, replScroll, - -- * Runtime state - RuntimeState, - webPort, - upstreamRelease, - eventLog, - worlds, - scenarios, - stdEntityMap, - stdRecipes, - appData, - nameParts, - -- ** Utility logEvent, - mkGameStateConfig, -- * App state AppState (AppState), @@ -115,41 +102,31 @@ module Swarm.TUI.Model ( focusedItem, focusedEntity, nextScenario, - initRuntimeState, ) where import Brick import Brick.Widgets.List qualified as BL -import Control.Effect.Accum -import Control.Effect.Lift -import Control.Effect.Throw import Control.Lens hiding (from, (<.>)) import Control.Monad ((>=>)) import Control.Monad.State (MonadState) import Data.List (findIndex) import Data.List.NonEmpty (NonEmpty (..)) -import Data.Map (Map) import Data.Maybe (fromMaybe) -import Data.Sequence (Seq) import Data.Text (Text) import Data.Vector qualified as V import GitHash (GitInfo) import Graphics.Vty (ColorMode (..)) import Network.Wai.Handler.Warp (Port) import Swarm.Game.Entity as E -import Swarm.Game.Failure -import Swarm.Game.Recipe (Recipe, loadRecipes) -import Swarm.Game.ResourceLoading (NameGenerator, initNameGenerator, readAppData) import Swarm.Game.Robot import Swarm.Game.Robot.Concrete import Swarm.Game.Robot.Context import Swarm.Game.Scenario.Status -import Swarm.Game.ScenarioInfo (ScenarioCollection, loadScenarios, _SISingle) +import Swarm.Game.ScenarioInfo (_SISingle) import Swarm.Game.State +import Swarm.Game.State.Runtime import Swarm.Game.State.Substate import Swarm.Game.Tick (TickNumber (..)) -import Swarm.Game.World.Load (loadWorlds) -import Swarm.Game.World.Typecheck (WorldMap) import Swarm.Log import Swarm.TUI.Inventory.Sorting import Swarm.TUI.Model.Menu @@ -157,7 +134,7 @@ import Swarm.TUI.Model.Name import Swarm.TUI.Model.Repl import Swarm.TUI.Model.UI import Swarm.Util.Lens (makeLensesNoSigs) -import Swarm.Version (NewReleaseFailure (NoMainUpstreamRelease)) +import Swarm.Version (NewReleaseFailure) import Text.Fuzzy qualified as Fuzzy ------------------------------------------------------------ @@ -188,87 +165,6 @@ modalScroll = viewportScroll ModalViewport replScroll :: ViewportScroll Name replScroll = viewportScroll REPLViewport --- ---------------------------------------------------------------------------- --- Runtime state -- --- ---------------------------------------------------------------------------- - -data RuntimeState = RuntimeState - { _webPort :: Maybe Port - , _upstreamRelease :: Either NewReleaseFailure String - , _eventLog :: Notifications LogEntry - , _worlds :: WorldMap - , _scenarios :: ScenarioCollection - , _stdEntityMap :: EntityMap - , _stdRecipes :: [Recipe Entity] - , _appData :: Map Text Text - , _nameParts :: NameGenerator - } - -initRuntimeState :: - ( Has (Throw SystemFailure) sig m - , Has (Accum (Seq SystemFailure)) sig m - , Has (Lift IO) sig m - ) => - m RuntimeState -initRuntimeState = do - entities <- loadEntities - recipes <- loadRecipes entities - worlds <- loadWorlds entities - scenarios <- loadScenarios entities worlds - appDataMap <- readAppData - nameGen <- initNameGenerator appDataMap - return $ - RuntimeState - { _webPort = Nothing - , _upstreamRelease = Left (NoMainUpstreamRelease []) - , _eventLog = mempty - , _worlds = worlds - , _scenarios = scenarios - , _stdEntityMap = entities - , _stdRecipes = recipes - , _appData = appDataMap - , _nameParts = nameGen - } - -makeLensesNoSigs ''RuntimeState - --- | The port on which the HTTP debug service is running. -webPort :: Lens' RuntimeState (Maybe Port) - --- | The upstream release version. -upstreamRelease :: Lens' RuntimeState (Either NewReleaseFailure String) - --- | A log of runtime events. --- --- This logging is separate from the logging done during game-play. --- If some error happens before a game is even selected, this is the --- place to log it. -eventLog :: Lens' RuntimeState (Notifications LogEntry) - --- | A collection of typechecked world DSL terms that are available to --- be used in scenario definitions. -worlds :: Lens' RuntimeState WorldMap - --- | The collection of scenarios that comes with the game. -scenarios :: Lens' RuntimeState ScenarioCollection - --- | The standard entity map loaded from disk. Individual scenarios --- may define additional entities which will get added to this map --- when loading the scenario. -stdEntityMap :: Lens' RuntimeState EntityMap - --- | The standard list of recipes loaded from disk. Individual scenarios --- may define additional recipes which will get added to this list --- when loading the scenario. -stdRecipes :: Lens' RuntimeState [Recipe Entity] - --- | Free-form data loaded from the @data@ directory, for things like --- the logo, about page, tutorial story, etc. -appData :: Lens' RuntimeState (Map Text Text) - --- | Lists of words/adjectives for use in building random robot names. -nameParts :: Lens' RuntimeState NameGenerator - -------------------------------------------------- -- Utility @@ -281,16 +177,6 @@ logEvent src sev who msg el = where l = LogEntry (TickNumber 0) src sev who msg --- | Create a 'GameStateConfig' record from the 'RuntimeState'. -mkGameStateConfig :: RuntimeState -> GameStateConfig -mkGameStateConfig rs = - GameStateConfig - { initNameParts = rs ^. nameParts - , initEntities = rs ^. stdEntityMap - , initRecipes = rs ^. stdRecipes - , initWorldMap = rs ^. worlds - } - -- ---------------------------------------------------------------------------- -- APPSTATE -- -- ---------------------------------------------------------------------------- diff --git a/src/Swarm/TUI/Model/StateUpdate.hs b/src/Swarm/TUI/Model/StateUpdate.hs index dd08808c..d887fc98 100644 --- a/src/Swarm/TUI/Model/StateUpdate.hs +++ b/src/Swarm/TUI/Model/StateUpdate.hs @@ -60,6 +60,7 @@ import Swarm.Game.ScenarioInfo ( _SISingle, ) import Swarm.Game.State +import Swarm.Game.State.Runtime import Swarm.Game.State.Substate import Swarm.Language.Pretty (prettyText) import Swarm.Log (LogSource (SystemLog), Severity (..)) diff --git a/src/Swarm/TUI/View.hs b/src/Swarm/TUI/View.hs index 6f9eb245..e024307d 100644 --- a/src/Swarm/TUI/View.hs +++ b/src/Swarm/TUI/View.hs @@ -103,6 +103,7 @@ import Swarm.Game.ScenarioInfo ( ) import Swarm.Game.State import Swarm.Game.State.Robot +import Swarm.Game.State.Runtime import Swarm.Game.State.Substate import Swarm.Game.Tick (TickNumber (..), addTicks) import Swarm.Game.Universe diff --git a/src/swarm-engine/Swarm/Game/State.hs b/src/swarm-engine/Swarm/Game/State.hs index 19c5ddef..296834cc 100644 --- a/src/swarm-engine/Swarm/Game/State.hs +++ b/src/swarm-engine/Swarm/Game/State.hs @@ -35,6 +35,7 @@ module Swarm.Game.State ( -- ** GameState initialization initGameState, scenarioToGameState, + pureScenarioToGameState, CodeToRun (..), Sha1 (..), SolutionSource (..), diff --git a/src/swarm-engine/Swarm/Game/State/Runtime.hs b/src/swarm-engine/Swarm/Game/State/Runtime.hs new file mode 100644 index 00000000..129ba918 --- /dev/null +++ b/src/swarm-engine/Swarm/Game/State/Runtime.hs @@ -0,0 +1,132 @@ +{-# LANGUAGE TemplateHaskell #-} + +-- | +-- SPDX-License-Identifier: BSD-3-Clause +-- +-- Runtime state and utility functions +module Swarm.Game.State.Runtime ( + RuntimeState, + + -- ** Lenses + webPort, + upstreamRelease, + eventLog, + worlds, + scenarios, + stdEntityMap, + stdRecipes, + appData, + nameParts, + + -- ** Utility + initRuntimeState, + mkGameStateConfig, +) +where + +import Control.Effect.Accum +import Control.Effect.Lift +import Control.Effect.Throw +import Control.Lens +import Data.Map (Map) +import Data.Sequence (Seq) +import Data.Text (Text) +import Network.Wai.Handler.Warp (Port) +import Swarm.Game.Entity (Entity, EntityMap, loadEntities) +import Swarm.Game.Failure (SystemFailure) +import Swarm.Game.Recipe (Recipe, loadRecipes) +import Swarm.Game.ResourceLoading (NameGenerator, initNameGenerator, readAppData) +import Swarm.Game.ScenarioInfo (ScenarioCollection, loadScenarios) +import Swarm.Game.State.Substate +import Swarm.Game.World.Load (loadWorlds) +import Swarm.Game.World.Typecheck (WorldMap) +import Swarm.Log +import Swarm.Util.Lens (makeLensesNoSigs) +import Swarm.Version (NewReleaseFailure (..)) + +data RuntimeState = RuntimeState + { _webPort :: Maybe Port + , _upstreamRelease :: Either NewReleaseFailure String + , _eventLog :: Notifications LogEntry + , _worlds :: WorldMap + , _scenarios :: ScenarioCollection + , _stdEntityMap :: EntityMap + , _stdRecipes :: [Recipe Entity] + , _appData :: Map Text Text + , _nameParts :: NameGenerator + } + +initRuntimeState :: + ( Has (Throw SystemFailure) sig m + , Has (Accum (Seq SystemFailure)) sig m + , Has (Lift IO) sig m + ) => + m RuntimeState +initRuntimeState = do + entities <- loadEntities + recipes <- loadRecipes entities + worlds <- loadWorlds entities + scenarios <- loadScenarios entities worlds + appDataMap <- readAppData + nameGen <- initNameGenerator appDataMap + return $ + RuntimeState + { _webPort = Nothing + , _upstreamRelease = Left (NoMainUpstreamRelease []) + , _eventLog = mempty + , _worlds = worlds + , _scenarios = scenarios + , _stdEntityMap = entities + , _stdRecipes = recipes + , _appData = appDataMap + , _nameParts = nameGen + } + +makeLensesNoSigs ''RuntimeState + +-- | The port on which the HTTP debug service is running. +webPort :: Lens' RuntimeState (Maybe Port) + +-- | The upstream release version. +upstreamRelease :: Lens' RuntimeState (Either NewReleaseFailure String) + +-- | A log of runtime events. +-- +-- This logging is separate from the logging done during game-play. +-- If some error happens before a game is even selected, this is the +-- place to log it. +eventLog :: Lens' RuntimeState (Notifications LogEntry) + +-- | A collection of typechecked world DSL terms that are available to +-- be used in scenario definitions. +worlds :: Lens' RuntimeState WorldMap + +-- | The collection of scenarios that comes with the game. +scenarios :: Lens' RuntimeState ScenarioCollection + +-- | The standard entity map loaded from disk. Individual scenarios +-- may define additional entities which will get added to this map +-- when loading the scenario. +stdEntityMap :: Lens' RuntimeState EntityMap + +-- | The standard list of recipes loaded from disk. Individual scenarios +-- may define additional recipes which will get added to this list +-- when loading the scenario. +stdRecipes :: Lens' RuntimeState [Recipe Entity] + +-- | Free-form data loaded from the @data@ directory, for things like +-- the logo, about page, tutorial story, etc. +appData :: Lens' RuntimeState (Map Text Text) + +-- | Lists of words/adjectives for use in building random robot names. +nameParts :: Lens' RuntimeState NameGenerator + +-- | Create a 'GameStateConfig' record from the 'RuntimeState'. +mkGameStateConfig :: RuntimeState -> GameStateConfig +mkGameStateConfig rs = + GameStateConfig + { initNameParts = rs ^. nameParts + , initEntities = rs ^. stdEntityMap + , initRecipes = rs ^. stdRecipes + , initWorldMap = rs ^. worlds + } diff --git a/src/Swarm/Version.hs b/src/swarm-engine/Swarm/Version.hs similarity index 100% rename from src/Swarm/Version.hs rename to src/swarm-engine/Swarm/Version.hs diff --git a/swarm.cabal b/swarm.cabal index 7c856aba..793e6eda 100644 --- a/swarm.cabal +++ b/swarm.cabal @@ -280,6 +280,7 @@ library swarm-engine Swarm.Game.State Swarm.Game.State.Config Swarm.Game.State.Robot + Swarm.Game.State.Runtime Swarm.Game.State.Substate Swarm.Game.Step Swarm.Game.Step.Arithmetic @@ -298,6 +299,7 @@ library swarm-engine Swarm.Game.Value Swarm.Game.World.Render Swarm.Log + Swarm.Version other-modules: Paths_swarm autogen-modules: Paths_swarm build-depends: base >= 4.14 && < 4.19, @@ -332,6 +334,12 @@ library swarm-engine vector >= 0.12 && < 0.14, witch >= 1.1.1.0 && < 1.3, yaml >= 0.11 && < 0.11.12.0, + warp, + http-client >= 0.7 && < 0.8, + http-client-tls >= 0.3 && < 0.4, + http-types >= 0.12 && < 0.13, + bytestring, + githash, build-depends: swarm:swarm-util, swarm:swarm-lang, swarm:swarm-scenario, @@ -462,8 +470,7 @@ library Swarm.TUI.View.Objective Swarm.TUI.View.Structure Swarm.TUI.View.Util - Swarm.Version - + reexported-modules: Control.Carrier.Accum.FixedStrict , Data.BoolExpr.Simplify , Swarm.Constant @@ -523,6 +530,7 @@ library , Swarm.Game.State , Swarm.Game.State.Config , Swarm.Game.State.Robot + , Swarm.Game.State.Runtime , Swarm.Game.State.Substate , Swarm.Game.Step , Swarm.Game.Step.Arithmetic @@ -588,6 +596,7 @@ library , Swarm.Util.WindowedCounter , Swarm.Util.Yaml , Swarm.Language.Capability + , Swarm.Version other-modules: Paths_swarm autogen-modules: Paths_swarm @@ -606,9 +615,6 @@ library fused-effects >= 1.1.1.1 && < 1.2, fuzzy >= 0.1 && < 0.2, githash >= 0.1.6 && < 0.2, - http-client >= 0.7 && < 0.8, - http-client-tls >= 0.3 && < 0.4, - http-types >= 0.12 && < 0.13, lens >= 4.19 && < 5.3, linear >= 1.21.6 && < 1.23, transformers >= 0.5 && < 0.7, @@ -780,7 +786,10 @@ benchmark benchmark base, lens, mtl, - swarm, + swarm:swarm-engine, + swarm:swarm-util, + swarm:swarm-lang, + swarm:swarm-scenario, containers, default-language: Haskell2010 ghc-options: -threaded diff --git a/test/bench/Benchmark.hs b/test/bench/Benchmark.hs index f7da8364..d57b6b1a 100644 --- a/test/bench/Benchmark.hs +++ b/test/bench/Benchmark.hs @@ -5,18 +5,22 @@ -- SPDX-License-Identifier: BSD-3-Clause module Main where -import Control.Lens ((&), (.~), (^.)) +import Control.Carrier.Accum.FixedStrict (runAccum) +import Control.Lens ((&), (.~)) import Control.Monad (replicateM_) -import Control.Monad.Except (runExceptT) import Control.Monad.State (evalStateT, execStateT) import Data.Map qualified as M +import Data.Sequence (Seq) import Swarm.Effect (runTimeIO) import Swarm.Game.CESK (emptyStore, initMachine) import Swarm.Game.Display (defaultRobotDisplay) +import Swarm.Game.Failure (SystemFailure) import Swarm.Game.Location import Swarm.Game.Robot (TRobot, mkRobot) -import Swarm.Game.State (GameState, creativeMode, landscape, zoomRobots) +import Swarm.Game.Scenario (loadStandaloneScenario) +import Swarm.Game.State (GameState, creativeMode, landscape, pureScenarioToGameState, zoomRobots) import Swarm.Game.State.Robot (addTRobot) +import Swarm.Game.State.Runtime (initRuntimeState, mkGameStateConfig) import Swarm.Game.State.Substate (multiWorld) import Swarm.Game.Step (gameTick) import Swarm.Game.Terrain (TerrainType (DirtT)) @@ -26,8 +30,7 @@ import Swarm.Language.Context qualified as Context import Swarm.Language.Pipeline (ProcessedTerm) import Swarm.Language.Pipeline.QQ (tmQ) import Swarm.Language.Syntax -import Swarm.TUI.Model (gameState) -import Swarm.TUI.Model.StateUpdate (classicGame0) +import Swarm.Util.Effect (simpleErrorHandle) import Swarm.Util.Erasable import Test.Tasty.Bench (Benchmark, bcompare, bench, bgroup, defaultMain, whnfAppIO) @@ -134,10 +137,16 @@ initRobot prog loc = mkGameState :: ProcessedTerm -> (Location -> TRobot) -> Int -> IO GameState mkGameState prog robotMaker numRobots = do let robots = [robotMaker (Location (fromIntegral x) 0) | x <- [0 .. numRobots - 1]] - Right initAppState <- runExceptT classicGame0 + + -- NOTE: This replaces "classicGame0", which is still used by unit tests. + gs <- simpleErrorHandle $ do + (_ :: Seq SystemFailure, initRS) <- runAccum mempty initRuntimeState + (scenario, _) <- loadStandaloneScenario "classic" + return $ pureScenarioToGameState scenario 0 0 Nothing $ mkGameStateConfig initRS + execStateT (zoomRobots $ mapM_ (addTRobot $ initMachine prog Context.empty emptyStore) robots) - ( (initAppState ^. gameState) + ( gs & creativeMode .~ True & landscape . multiWorld .~ M.singleton DefaultRootSubworld (newWorld (WF $ const (fromEnum DirtT, ENothing))) ) diff --git a/test/integration/Main.hs b/test/integration/Main.hs index 8e815be6..aeb9e575 100644 --- a/test/integration/Main.hs +++ b/test/integration/Main.hs @@ -54,6 +54,12 @@ import Swarm.Game.State.Robot ( robotMap, waitingRobots, ) +import Swarm.Game.State.Runtime ( + RuntimeState, + eventLog, + stdEntityMap, + worlds, + ) import Swarm.Game.State.Substate ( WinCondition (WinConditions), WinStatus (Won), @@ -71,14 +77,10 @@ import Swarm.Language.Pipeline (ProcessedTerm (..), processTerm) import Swarm.Language.Pretty (prettyString) import Swarm.Log import Swarm.TUI.Model ( - RuntimeState, defaultAppOpts, - eventLog, gameState, runtimeState, - stdEntityMap, userScenario, - worlds, ) import Swarm.TUI.Model.StateUpdate (constructAppState, initPersistentState) import Swarm.TUI.Model.UI (UIState) diff --git a/test/unit/TestPedagogy.hs b/test/unit/TestPedagogy.hs index e903ede8..7234a217 100644 --- a/test/unit/TestPedagogy.hs +++ b/test/unit/TestPedagogy.hs @@ -10,7 +10,7 @@ import Control.Lens (view) import Data.Map qualified as M import Swarm.Doc.Pedagogy import Swarm.Game.ScenarioInfo (scenarioPath) -import Swarm.TUI.Model (RuntimeState, scenarios) +import Swarm.Game.State.Runtime (RuntimeState, scenarios) import Test.Tasty import Test.Tasty.HUnit diff --git a/test/unit/TestRecipeCoverage.hs b/test/unit/TestRecipeCoverage.hs index a6625352..57bbaa42 100644 --- a/test/unit/TestRecipeCoverage.hs +++ b/test/unit/TestRecipeCoverage.hs @@ -13,7 +13,7 @@ import Data.Set qualified as Set import Data.Text qualified as T import Swarm.Game.Entity (EntityMap (entitiesByCap), entityName) import Swarm.Game.Recipe (recipeOutputs) -import Swarm.TUI.Model (RuntimeState, stdEntityMap, stdRecipes) +import Swarm.Game.State.Runtime (RuntimeState, stdEntityMap, stdRecipes) import Swarm.Util (commaList, quote) import Test.Tasty import Test.Tasty.ExpectedFailure (expectFailBecause)