Remove Benchmark dependence on AppState and TUI (#1746)

`stack bench` is now independent of the TUI and `AppState`.

Author: kostmo

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

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"
+STACK_WORK=.stack-work-bench stack bench swarm:benchmark --benchmark-arguments "--baseline $BASELINE_OUTPUT --fail-if-slower 3 --color always"

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)

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,49 +102,39 @@ 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
 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                                --
 -- ----------------------------------------------------------------------------

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 (..))

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

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

@@ -35,6 +35,7 @@ module Swarm.Game.State (
   -- ** GameState initialization
   initGameState,
   scenarioToGameState,
+  pureScenarioToGameState,
   CodeToRun (..),
   Sha1 (..),
   SolutionSource (..),

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
+    }