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
This commit is contained in:
Karl Ostmo 2024-04-22 11:55:06 -07:00 committed by GitHub
parent fd88a4b31a
commit a739b142f3
No known key found for this signature in database
GPG Key ID: B5690EEEBB952194
10 changed files with 44 additions and 17 deletions

1
.gitignore vendored
View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

@ -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.

View File

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

View File

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

View File

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