refactoring towards tournament server

.gitignore

@@ -16,6 +16,7 @@ stan.html
 
 .swarm_history
 
+*.db
 *.orig
 *.aux
 *.log

scripts/gen/list-sublibraries.sh

@@ -0,0 +1,5 @@
+#!/bin/bash
+
+cd $(git rev-parse --show-toplevel)
+
+grep '^library \w' swarm.cabal | cut -d' ' -f2

src/Swarm/TUI/Controller.hs

@@ -81,6 +81,7 @@ import Swarm.Game.ResourceLoading (getSwarmHistoryPath)
 import Swarm.Game.Robot
 import Swarm.Game.Robot.Concrete
 import Swarm.Game.Robot.Context
+import Swarm.Game.Scenario.Status (updateScenarioInfoOnFinish)
 import Swarm.Game.Scenario.Topography.Structure.Recognition (automatons)
 import Swarm.Game.Scenario.Topography.Structure.Recognition.Type (originalStructureDefinitions)
 import Swarm.Game.ScenarioInfo
@@ -319,7 +320,7 @@ handleMainEvent ev = do
     -- ctrl-q works everywhere
     ControlChar 'q' ->
       case s ^. gameState . winCondition of
-        WinConditions (Won _) _ -> toggleModal $ ScenarioEndModal WinModal
+        WinConditions (Won _ _) _ -> toggleModal $ ScenarioEndModal WinModal
         WinConditions (Unwinnable _) _ -> toggleModal $ ScenarioEndModal LoseModal
         _ -> toggleModal QuitModal
     VtyEvent (V.EvResize _ _) -> invalidateCache
@@ -547,7 +548,7 @@ saveScenarioInfoOnFinish p = do
   t <- liftIO getZonedTime
   wc <- use $ gameState . winCondition
   let won = case wc of
-        WinConditions (Won _) _ -> True
+        WinConditions (Won _ _) _ -> True
         _ -> False
   ts <- use $ gameState . temporal . ticks
 
@@ -640,7 +641,7 @@ quitGame = do
   -- player has won the current one.
   wc <- use $ gameState . winCondition
   case wc of
-    WinConditions (Won _) _ -> uiState . uiMenu %= advanceMenu
+    WinConditions (Won _ _) _ -> uiState . uiMenu %= advanceMenu
     _ -> return ()
 
   -- Either quit the entire app (if the scenario was chosen directly
@@ -932,9 +933,9 @@ doGoalUpdates = do
       openModal $ ScenarioEndModal LoseModal
       saveScenarioInfoOnFinishNocheat
       return True
-    WinConditions (Won False) x -> do
+    WinConditions (Won False ts) x -> do
       -- This clears the "flag" that the Win dialog needs to pop up
-      gameState . winCondition .= WinConditions (Won True) x
+      gameState . winCondition .= WinConditions (Won True ts) x
       openModal $ ScenarioEndModal WinModal
       saveScenarioInfoOnFinishNocheat
       -- We do NOT advance the New Game menu to the next item here (we

src/swarm-engine/Swarm/Game/Scenario/Scoring/CodeSize.hs

@@ -7,6 +7,7 @@ module Swarm.Game.Scenario.Scoring.CodeSize where
 
 import Control.Monad (guard)
 import Data.Aeson
+import Data.Data (Data)
 import GHC.Generics (Generic)
 import Swarm.Language.Module
 import Swarm.Language.Pipeline
@@ -24,12 +25,19 @@ data ScenarioCodeMetrics = ScenarioCodeMetrics
   }
   deriving (Eq, Ord, Show, Read, Generic, ToJSON, FromJSON)
 
-codeSizeFromDeterminator :: CodeSizeDeterminators -> Maybe ScenarioCodeMetrics
-codeSizeFromDeterminator (CodeSizeDeterminators maybeInitialCode usedRepl) = do
-  guard $ not usedRepl
-  ProcessedTerm (Module s@(Syntax' srcLoc _ _) _) _ _ <- maybeInitialCode
-  return $ ScenarioCodeMetrics (charCount srcLoc) (measureAstSize s)
+codeMetricsFromSyntax ::
+  Data a =>
+  Syntax' a ->
+  ScenarioCodeMetrics
+codeMetricsFromSyntax s@(Syntax' srcLoc _ _) =
+  ScenarioCodeMetrics (charCount srcLoc) (measureAstSize s)
  where
   charCount :: SrcLoc -> Int
   charCount NoLoc = 0
   charCount (SrcLoc start end) = end - start
+
+codeSizeFromDeterminator :: CodeSizeDeterminators -> Maybe ScenarioCodeMetrics
+codeSizeFromDeterminator (CodeSizeDeterminators maybeInitialCode usedRepl) = do
+  guard $ not usedRepl
+  ProcessedTerm (Module s _) _ _ <- maybeInitialCode
+  return $ codeMetricsFromSyntax s

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

@@ -15,7 +15,6 @@ module Swarm.Game.ScenarioInfo (
   scenarioPath,
   scenarioStatus,
   CodeSizeDeterminators (CodeSizeDeterminators),
-  updateScenarioInfoOnFinish,
   ScenarioInfoPair,
 
   -- * Scenario collection

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

@@ -76,6 +76,7 @@ import Control.Effect.State (State)
 import Control.Effect.Throw
 import Control.Lens hiding (Const, use, uses, view, (%=), (+=), (.=), (<+=), (<<.=))
 import Control.Monad (forM, join)
+import Data.Aeson (ToJSON)
 import Data.Digest.Pure.SHA (sha1, showDigest)
 import Data.Foldable (toList)
 import Data.Foldable.Extra (allM)
@@ -97,6 +98,7 @@ import Data.Text qualified as T (drop, take)
 import Data.Text.IO qualified as TIO
 import Data.Text.Lazy qualified as TL
 import Data.Text.Lazy.Encoding qualified as TL
+import GHC.Generics (Generic)
 import Linear (V2 (..))
 import Swarm.Game.CESK (emptyStore, finalValue, initMachine)
 import Swarm.Game.Entity
@@ -140,6 +142,7 @@ import System.Clock qualified as Clock
 import System.Random (mkStdGen)
 
 newtype Sha1 = Sha1 String
+  deriving (Show, Eq, Ord, Generic, ToJSON)
 
 data SolutionSource
   = ScenarioSuggested

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

@@ -140,7 +140,7 @@ data WinStatus
   | -- | The player has won.
     -- The boolean indicates whether they have
     -- already been congratulated.
-    Won Bool
+    Won Bool TickNumber
   | -- | The player has completed certain "goals" that preclude
     -- (via negative prerequisites) the completion of all of the
     -- required goals.

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

@@ -333,8 +333,9 @@ hypotheticalWinCheck em g ws oc = do
     foldM foldFunc initialAccumulator $
       reverse incompleteGoals
 
+  ts <- use $ temporal . ticks
   let newWinState = case ws of
-        Ongoing -> getNextWinState $ completions finalAccumulator
+        Ongoing -> getNextWinState ts $ completions finalAccumulator
         _ -> ws
 
   winCondition .= WinConditions newWinState (completions finalAccumulator)
@@ -347,8 +348,8 @@ hypotheticalWinCheck em g ws oc = do
 
   mapM_ handleException $ exceptions finalAccumulator
  where
-  getNextWinState completedObjs
-    | WC.didWin completedObjs = Won False
+  getNextWinState ts completedObjs
+    | WC.didWin completedObjs = Won False ts
     | WC.didLose completedObjs = Unwinnable False
     | otherwise = Ongoing
 

src/swarm-scenario/Swarm/Game/Scenario.hs

@@ -24,6 +24,7 @@ module Swarm.Game.Scenario (
   Scenario (..),
   ScenarioLandscape (..),
   StaticStructureInfo (..),
+  ScenarioMetadata (ScenarioMetadata),
   staticPlacements,
   structureDefs,
 
@@ -79,6 +80,7 @@ import Data.Set (Set)
 import Data.Set qualified as Set
 import Data.Text (Text)
 import Data.Text qualified as T
+import GHC.Generics (Generic)
 import Swarm.Game.Entity
 import Swarm.Game.Entity.Cosmetic
 import Swarm.Game.Entity.Cosmetic.Assignment (worldAttributes)
@@ -141,7 +143,14 @@ data ScenarioMetadata = ScenarioMetadata
   , _scenarioName :: Text
   , _scenarioAuthor :: Maybe Text
   }
-  deriving (Show)
+  deriving (Show, Generic)
+
+instance ToJSON ScenarioMetadata where
+  toEncoding =
+    genericToEncoding
+      defaultOptions
+        { fieldLabelModifier = drop 1 -- drops leading underscore
+        }
 
 makeLensesNoSigs ''ScenarioMetadata
 

test/integration/Main.hs

@@ -517,7 +517,7 @@ testScenarioSolutions rs ui =
     w <- use winCondition
     b <- gets badErrorsInLogs
     when (null b) $ case w of
-      WinConditions (Won _) _ -> return ()
+      WinConditions (Won _ _) _ -> return ()
       _ -> runTimeIO gameTick >> playUntilWin
 
 noBadErrors :: GameState -> Assertion