Remove Benchmark dependence on AppState and TUI (#1746)

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

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,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                                --
 -- ----------------------------------------------------------------------------

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

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

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

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)

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
 

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)