fix tournament server + benchmarks

Author: byorgey

src/swarm-tournament/Swarm/Web/Tournament/Validate.hs

@@ -9,6 +9,7 @@ module Swarm.Web.Tournament.Validate where
 
 import Control.Arrow (left)
 import Control.Carrier.Accum.Strict (evalAccum)
+import Control.Carrier.Error.Either (runError)
 import Control.Carrier.Throw.Either (runThrow)
 import Control.Lens
 import Control.Monad (unless)
@@ -17,6 +18,7 @@ import Control.Monad.State (evalStateT)
 import Control.Monad.Trans.Except
 import Data.ByteString.Lazy qualified as LBS
 import Data.Either.Extra (maybeToEither)
+import Data.Map qualified as M
 import Data.Sequence (Seq)
 import Data.Text qualified as T
 import Data.Text.Encoding (decodeUtf8')
@@ -34,7 +36,8 @@ import Swarm.Game.State.Runtime (RuntimeOptions (..), initRuntimeState, initScen
 import Swarm.Game.State.Substate (initState, seed)
 import Swarm.Game.Step.Validate (playUntilWin)
 import Swarm.Language.Pipeline
-import Swarm.Language.Syntax (TSyntax)
+import Swarm.Language.Syntax (Phase (..), Syntax)
+import Swarm.Pretty (prettyString, prettyText)
 import Swarm.Util.Yaml
 import Swarm.Web.Tournament.Database.Query
 import Swarm.Web.Tournament.Type
@@ -128,8 +131,8 @@ validateSubmittedSolution (CommonValidationArgs solnTimeout persistenceArgs) sce
         . decodeUtf8'
         . LBS.toStrict
         $ fileContent file
-    soln <- withExceptT SolutionParseError . except $ processTermEither solText
-
+    res <- liftIO $ processTermEither solText
+    (_srcMap, soln) <- withExceptT (SolutionParseError . prettyText) . except $ res
     gs <- withExceptT ScenarioRetrievalFailure $ do
       scenarioContent <-
         withExceptT DatabaseRetrievalFailure $
@@ -155,7 +158,7 @@ validateSubmittedSolution (CommonValidationArgs solnTimeout persistenceArgs) sce
 
 initScenarioObjectWithEnv ::
   LBS.ByteString ->
-  ExceptT ScenarioInstantiationFailure IO Scenario
+  ExceptT ScenarioInstantiationFailure IO (Scenario Elaborated)
 initScenarioObjectWithEnv content = do
   scenarioInputs <-
     withExceptT (ScenarioEnvironmentFailure . ContextInitializationFailure)
@@ -168,16 +171,18 @@ initScenarioObjectWithEnv content = do
 initScenarioObject ::
   ScenarioInputs ->
   LBS.ByteString ->
-  ExceptT ScenarioInstantiationFailure IO Scenario
+  ExceptT ScenarioInstantiationFailure IO (Scenario Elaborated)
 initScenarioObject scenarioInputs content = do
   rawYaml <- withExceptT YamlDecodeError . except . decodeEither' $ LBS.toStrict content
-  withExceptT ScenarioParseFailure $
+  rawScenario <- withExceptT ScenarioParseFailure $
     except $
       parseEither (parseJSONE' scenarioInputs) rawYaml
+  res <- runError @SystemFailure $ process (rawScenario :: Scenario Raw)
+  withExceptT (ScenarioParseFailure . prettyString) (except res)
 
 gamestateFromScenarioText ::
   LBS.ByteString ->
-  ExceptT ScenarioInstantiationFailure IO (GameState, Scenario)
+  ExceptT ScenarioInstantiationFailure IO (GameState, Scenario Elaborated)
 gamestateFromScenarioText content = do
   rs <-
     withExceptT (ScenarioEnvironmentFailure . ContextInitializationFailure)
@@ -198,7 +203,7 @@ gamestateFromScenarioText content = do
 
 verifySolution ::
   SolutionTimeout ->
-  TSyntax ->
+  Syntax Elaborated ->
   GameState ->
   ExceptT SolutionEvaluationFailure IO SolutionCharacterization
 verifySolution (SolutionTimeout timeoutSeconds) sol gs = do
@@ -219,4 +224,4 @@ verifySolution (SolutionTimeout timeoutSeconds) sol gs = do
       codeMetrics
  where
   codeMetrics = codeMetricsFromSyntax sol
-  gs' = gs & baseRobot . machine %~ continue sol
+  gs' = gs & baseRobot . machine %~ continue M.empty sol

test/bench/Benchmark.hs

@@ -18,7 +18,7 @@ import Swarm.Failure (SystemFailure, simpleErrorHandle)
 import Swarm.Game.CESK (initMachine)
 import Swarm.Game.Cosmetic.Display (defaultRobotDisplay)
 import Swarm.Game.Location
-import Swarm.Game.Robot (TRobot, mkRobot)
+import Swarm.Game.Robot (Robot, mkRobot)
 import Swarm.Game.Robot.Walk (emptyExceptions)
 import Swarm.Game.Scenario (loadStandaloneScenario)
 import Swarm.Game.Scenario.Status
@@ -38,13 +38,13 @@ import Swarm.Util.Erasable
 import Test.Tasty.Bench (Benchmark, bcompare, bench, bgroup, defaultMain, whnfAppIO)
 
 -- | The program of a robot that does nothing.
-idleProgram :: TSyntax
+idleProgram :: Syntax Elaborated
 idleProgram = [tmQ| {} |]
 
 -- | The program of a robot which waits a random number of ticks, changes its
 --   appearance, then waits another random number of ticks, places a tree, and
 --   then self-destructs.
-treeProgram :: TSyntax
+treeProgram :: Syntax Elaborated
 treeProgram =
   [tmQ|
   {
@@ -59,15 +59,15 @@ treeProgram =
   |]
 
 -- | The program of a robot that moves forward forever.
-moverProgram :: TSyntax
+moverProgram :: Syntax Elaborated
 moverProgram =
   [tmQ|
     let forever : Cmd Unit -> Cmd Unit = \c. c; forever c
     in forever move
   |]
 
 -- | The program of a robot that moves in circles forever.
-circlerProgram :: TSyntax
+circlerProgram :: Syntax Elaborated
 circlerProgram =
   [tmQ|
     let forever : Cmd Unit -> Cmd Unit = \c. c; forever c
@@ -91,13 +91,13 @@ circlerProgram =
 -- This is used to compare the performance degradation caused
 -- by using definitions and chains of ifs. Ideally there should
 -- not be cost if the code is inlined and simplified. TODO: #1557
-waveProgram :: Bool -> TSyntax
+waveProgram :: Bool -> Syntax Elaborated
 waveProgram manualInline =
-  let inlineDef = if manualInline then (1 :: Integer) else 0
+  let _inlineDef = if manualInline then (1 :: Integer) else 0
    in [tmQ|
     def doN = \n. \f. if (n > 0) {f; doN (n - 1) f} {}; end;
     def crossPath =
-        if ($int:inlineDef == 0) {
+        if ($int:_inlineDef == 0) {
           doN 6 move;
         } {
           move; move; move; move; move; move;
@@ -119,7 +119,7 @@ waveProgram manualInline =
   |]
 
 -- | Initializes a robot with program prog at location loc facing north.
-initRobot :: TSyntax -> Location -> TRobot
+initRobot :: Syntax Elaborated -> Location -> Robot Elaborated
 initRobot prog loc =
   mkRobot
     Nothing
@@ -138,7 +138,7 @@ initRobot prog loc =
 
 -- | Creates a GameState with numRobot copies of robot on a blank map, aligned
 --   in a row starting at (0,0) and spreading east.
-mkGameState :: TSyntax -> (Location -> TRobot) -> Int -> IO GameState
+mkGameState :: Syntax Elaborated -> (Location -> Robot Elaborated) -> Int -> IO GameState
 mkGameState prog robotMaker numRobots = do
   let robots = [robotMaker (Location (fromIntegral x) 0) | x <- [0 .. numRobots - 1]]
 
@@ -208,7 +208,7 @@ main = do
   robotNumbers = [10, 20 .. 40]
   largeRobotNumbers = take 4 $ iterate (* 2) 100
 
-  mkGameStates :: [Int] -> TSyntax -> IO [(Int, GameState)]
+  mkGameStates :: [Int] -> Syntax Elaborated -> IO [(Int, GameState)]
   mkGameStates botCounts prog = mapM (traverse (mkGameState prog $ initRobot prog) . dupe) botCounts
 
   toBenchmarks :: Int -> [(Int, GameState)] -> [Benchmark]