From a739b142f3694a1147279830278a0de36c28820c Mon Sep 17 00:00:00 2001 From: Karl Ostmo Date: Mon, 22 Apr 2024 11:55:06 -0700 Subject: [PATCH] refactoring towards tournament server (#1801) Prerequisite to #1798 ## Changes * Pass the final `TickNumber` count as a member of `Won` constructor so that it can be used in scoring submitted solutions * Extract a helper function `codeMetricsFromSyntax` that can be reused by tournament server * `ToJSON` instance for `ScenarioMetadata` * New script `list-sublibraries.sh` to list the sublibraries defined in a package --- .gitignore | 1 + scripts/gen/list-sublibraries.sh | 5 +++++ src/Swarm/TUI/Controller.hs | 11 ++++++----- .../Swarm/Game/Scenario/Scoring/CodeSize.hs | 18 +++++++++++++----- src/swarm-engine/Swarm/Game/ScenarioInfo.hs | 1 - src/swarm-engine/Swarm/Game/State.hs | 3 +++ src/swarm-engine/Swarm/Game/State/Substate.hs | 2 +- src/swarm-engine/Swarm/Game/Step.hs | 7 ++++--- src/swarm-scenario/Swarm/Game/Scenario.hs | 11 ++++++++++- test/integration/Main.hs | 2 +- 10 files changed, 44 insertions(+), 17 deletions(-) create mode 100755 scripts/gen/list-sublibraries.sh diff --git a/.gitignore b/.gitignore index e8e8e452..a61330eb 100644 --- a/.gitignore +++ b/.gitignore @@ -16,6 +16,7 @@ stan.html .swarm_history +*.db *.orig *.aux *.log diff --git a/scripts/gen/list-sublibraries.sh b/scripts/gen/list-sublibraries.sh new file mode 100755 index 00000000..367c2a32 --- /dev/null +++ b/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 diff --git a/src/Swarm/TUI/Controller.hs b/src/Swarm/TUI/Controller.hs index 1638a23b..d8db1387 100644 --- a/src/Swarm/TUI/Controller.hs +++ b/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 diff --git a/src/swarm-engine/Swarm/Game/Scenario/Scoring/CodeSize.hs b/src/swarm-engine/Swarm/Game/Scenario/Scoring/CodeSize.hs index f3f04eda..6bbfc9ce 100644 --- a/src/swarm-engine/Swarm/Game/Scenario/Scoring/CodeSize.hs +++ b/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 diff --git a/src/swarm-engine/Swarm/Game/ScenarioInfo.hs b/src/swarm-engine/Swarm/Game/ScenarioInfo.hs index cdff333e..af8171e5 100644 --- a/src/swarm-engine/Swarm/Game/ScenarioInfo.hs +++ b/src/swarm-engine/Swarm/Game/ScenarioInfo.hs @@ -15,7 +15,6 @@ module Swarm.Game.ScenarioInfo ( scenarioPath, scenarioStatus, CodeSizeDeterminators (CodeSizeDeterminators), - updateScenarioInfoOnFinish, ScenarioInfoPair, -- * Scenario collection diff --git a/src/swarm-engine/Swarm/Game/State.hs b/src/swarm-engine/Swarm/Game/State.hs index 0adb59ee..15927070 100644 --- a/src/swarm-engine/Swarm/Game/State.hs +++ b/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 diff --git a/src/swarm-engine/Swarm/Game/State/Substate.hs b/src/swarm-engine/Swarm/Game/State/Substate.hs index 8a253158..ae91d47c 100644 --- a/src/swarm-engine/Swarm/Game/State/Substate.hs +++ b/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. diff --git a/src/swarm-engine/Swarm/Game/Step.hs b/src/swarm-engine/Swarm/Game/Step.hs index ed3c1f46..a59dee95 100644 --- a/src/swarm-engine/Swarm/Game/Step.hs +++ b/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 diff --git a/src/swarm-scenario/Swarm/Game/Scenario.hs b/src/swarm-scenario/Swarm/Game/Scenario.hs index f334dcff..ff7e2a3a 100644 --- a/src/swarm-scenario/Swarm/Game/Scenario.hs +++ b/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 diff --git a/test/integration/Main.hs b/test/integration/Main.hs index 2cd0463f..413187cd 100644 --- a/test/integration/Main.hs +++ b/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