Scenario launch options selection (#1010)

Closes #358 and closes #866.

Allows specification of a seed value and/or the path of a script to run.  Specifying a script to run in advance allows eligibility for code size scoring.

Some effort was invested into integrating the Brick `FileBrowser` widget and discovering its idiosyncrasies.  This paves the way for more applications of `FileBrowser` within Swarm.

## Usage

From the scenario selection menu, press the `o` key to pop up a dialog for launch options.

![Screenshot from 2023-06-06 01-38-25](https://github.com/swarm-game/swarm/assets/261693/e306f2ce-db30-4906-9b02-db8e44bc5e99)

Any manually-selected initial-script or seed are persisted to disk and will pre-populate the launch configuration dialog upon the next play.  If a certain scenario is subsequently launched the normal way (i.e. by pressing `Enter` instead of `o`), then this clears the saved script path/seed, and the next pop-up of the launch configuration dialog will not see its fields pre-populated.

## Warning: Save format changed

This PR changes the `ScenarioStatus` datatype, and therefore game status/progress saved previously to this PR will not be recognized.  See #974 (comment) for discussion about this situation.

src/Swarm/Game/Scenario/Status.hs

@@ -22,14 +22,38 @@ import Swarm.Game.Scenario.Scoring.Best
 import Swarm.Game.Scenario.Scoring.CodeSize
 import Swarm.Game.Scenario.Scoring.ConcreteMetrics
 import Swarm.Game.Scenario.Scoring.GenericMetrics
+import Swarm.Game.WorldGen (Seed)
 import Swarm.Util.Lens (makeLensesNoSigs)
 
+-- | These launch parameters are used in a number of ways:
+-- * Serializing the seed/script path for saves
+-- * Holding parse status from form fields, including Error info
+-- * Carrying fully-validated launch parameters.
+--
+-- Type parameters are utilized to support all of these use cases.
+data ParameterizableLaunchParams code f = LaunchParams
+  { seedVal :: f (Maybe Seed)
+  , initialCode :: f (Maybe code)
+  }
+
+type SerializableLaunchParams = ParameterizableLaunchParams FilePath Identity
+deriving instance Eq SerializableLaunchParams
+deriving instance Ord SerializableLaunchParams
+deriving instance Show SerializableLaunchParams
+deriving instance Read SerializableLaunchParams
+deriving instance Generic SerializableLaunchParams
+deriving instance FromJSON SerializableLaunchParams
+deriving instance ToJSON SerializableLaunchParams
+
 -- | A "ScenarioStatus" stores the status of a scenario along with
 --   appropriate metadata: "NotStarted", or "Played".
 --   The "Played" status has two sub-states: "Attempted" or "Completed".
 data ScenarioStatus
   = NotStarted
-  | Played ProgressMetric BestRecords
+  | Played
+      SerializableLaunchParams
+      ProgressMetric
+      BestRecords
   deriving (Eq, Ord, Show, Read, Generic)
 
 instance FromJSON ScenarioStatus where
@@ -39,6 +63,11 @@ instance ToJSON ScenarioStatus where
   toEncoding = genericToEncoding scenarioOptions
   toJSON = genericToJSON scenarioOptions
 
+getLaunchParams :: ScenarioStatus -> SerializableLaunchParams
+getLaunchParams = \case
+  NotStarted -> LaunchParams (pure Nothing) (pure Nothing)
+  Played x _ _ -> x
+
 -- | A "ScenarioInfo" record stores metadata about a scenario: its
 -- canonical path and status.
 -- By way of the "ScenarioStatus" record, it stores the
@@ -84,9 +113,9 @@ updateScenarioInfoOnFinish
   ticks
   completed
   si@(ScenarioInfo p prevPlayState) = case prevPlayState of
-    Played (Metric _ (ProgressStats start _currentPlayMetrics)) prevBestRecords ->
+    Played launchParams (Metric _ (ProgressStats start _currentPlayMetrics)) prevBestRecords ->
       ScenarioInfo p $
-        Played newPlayMetric $
+        Played launchParams newPlayMetric $
           updateBest newPlayMetric prevBestRecords
      where
       el = (diffUTCTime `on` zonedTimeToUTC) z start

src/Swarm/Game/State.hs

@@ -88,6 +88,7 @@ module Swarm.Game.State (
   CodeToRun (..),
   Sha1 (..),
   SolutionSource (..),
+  parseCodeFile,
   getParsedInitialCode,
 
   -- * Utilities
@@ -112,6 +113,7 @@ module Swarm.Game.State (
   toggleRunStatus,
   messageIsRecent,
   messageIsFromNearby,
+  getRunCodePath,
 ) where
 
 import Control.Algebra (Has)
@@ -277,29 +279,33 @@ data SolutionSource
   | -- | Includes the SHA1 of the program text
     -- for the purpose of corroborating solutions
     -- on a leaderboard.
-    PlayerAuthored Sha1
+    PlayerAuthored FilePath Sha1
 
 data CodeToRun = CodeToRun SolutionSource ProcessedTerm
 
-getParsedInitialCode :: Maybe FilePath -> ExceptT Text IO (Maybe CodeToRun)
-getParsedInitialCode toRun = case toRun of
-  Nothing -> return Nothing
-  Just filepath -> do
-    contents <- liftIO $ TIO.readFile filepath
+getRunCodePath :: CodeToRun -> Maybe FilePath
+getRunCodePath (CodeToRun solutionSource _) = case solutionSource of
+  ScenarioSuggested -> Nothing
+  PlayerAuthored fp _ -> Just fp
+
+parseCodeFile :: FilePath -> IO (Either Text CodeToRun)
+parseCodeFile filepath = do
+  contents <- TIO.readFile filepath
+  return $ do
     pt@(ProcessedTerm (Module (Syntax' srcLoc _ _) _) _ _) <-
-      ExceptT
-        . return
-        . left T.pack
-        $ processTermEither contents
+      left T.pack $ processTermEither contents
     let strippedText = stripSrc srcLoc contents
         programBytestring = TL.encodeUtf8 $ TL.fromStrict strippedText
         sha1Hash = showDigest $ sha1 programBytestring
-    return $ Just $ CodeToRun (PlayerAuthored $ Sha1 sha1Hash) pt
+    return $ CodeToRun (PlayerAuthored filepath $ Sha1 sha1Hash) pt
  where
   stripSrc :: SrcLoc -> Text -> Text
   stripSrc (SrcLoc start end) txt = T.drop start $ T.take end txt
   stripSrc NoLoc txt = txt
 
+getParsedInitialCode :: Maybe FilePath -> ExceptT Text IO (Maybe CodeToRun)
+getParsedInitialCode = traverse $ ExceptT . parseCodeFile
+
 ------------------------------------------------------------
 -- The main GameState record type
 ------------------------------------------------------------
@@ -784,7 +790,7 @@ focusedRange g = computedRange <$ focusedRobot g
   (minRadius, maxRadius) = over both (gain baseInv . gain focInv) (16, 64)
 
 -- | Clear the 'robotLogUpdated' flag of the focused robot.
-clearFocusedRobotLogUpdated :: Has (State GameState) sig m => m ()
+clearFocusedRobotLogUpdated :: (Has (State GameState) sig m) => m ()
 clearFocusedRobotLogUpdated = do
   n <- use focusedRobotID
   robotMap . ix n . robotLogUpdated .= False
@@ -793,7 +799,7 @@ clearFocusedRobotLogUpdated = do
 --   first, generate a unique ID number for it.  Then, add it to the
 --   main robot map, the active robot set, and to to the index of
 --   robots by location. Return the updated robot.
-addTRobot :: Has (State GameState) sig m => TRobot -> m Robot
+addTRobot :: (Has (State GameState) sig m) => TRobot -> m Robot
 addTRobot r = do
   rid <- gensym <+= 1
   let r' = instantiateRobot rid r
@@ -803,7 +809,7 @@ addTRobot r = do
 -- | Add a robot to the game state, adding it to the main robot map,
 --   the active robot set, and to to the index of robots by
 --   location.
-addRobot :: Has (State GameState) sig m => Robot -> m ()
+addRobot :: (Has (State GameState) sig m) => Robot -> m ()
 addRobot r = do
   let rid = r ^. robotID
 
@@ -816,7 +822,7 @@ maxMessageQueueSize :: Int
 maxMessageQueueSize = 1000
 
 -- | Add a message to the message queue.
-emitMessage :: Has (State GameState) sig m => LogEntry -> m ()
+emitMessage :: (Has (State GameState) sig m) => LogEntry -> m ()
 emitMessage msg = messageQueue %= (|> msg) . dropLastIfLong
  where
   tooLong s = Seq.length s >= maxMessageQueueSize
@@ -825,23 +831,23 @@ emitMessage msg = messageQueue %= (|> msg) . dropLastIfLong
 
 -- | Takes a robot out of the activeRobots set and puts it in the waitingRobots
 --   queue.
-sleepUntil :: Has (State GameState) sig m => RID -> TickNumber -> m ()
+sleepUntil :: (Has (State GameState) sig m) => RID -> TickNumber -> m ()
 sleepUntil rid time = do
   internalActiveRobots %= IS.delete rid
   internalWaitingRobots . at time . non [] %= (rid :)
 
 -- | Takes a robot out of the activeRobots set.
-sleepForever :: Has (State GameState) sig m => RID -> m ()
+sleepForever :: (Has (State GameState) sig m) => RID -> m ()
 sleepForever rid = internalActiveRobots %= IS.delete rid
 
 -- | Adds a robot to the activeRobots set.
-activateRobot :: Has (State GameState) sig m => RID -> m ()
+activateRobot :: (Has (State GameState) sig m) => RID -> m ()
 activateRobot rid = internalActiveRobots %= IS.insert rid
 
 -- | Removes robots whose wake up time matches the current game ticks count
 --   from the waitingRobots queue and put them back in the activeRobots set
 --   if they still exist in the keys of robotMap.
-wakeUpRobotsDoneSleeping :: Has (State GameState) sig m => m ()
+wakeUpRobotsDoneSleeping :: (Has (State GameState) sig m) => m ()
 wakeUpRobotsDoneSleeping = do
   time <- use ticks
   mrids <- internalWaitingRobots . at time <<.= Nothing
@@ -859,7 +865,7 @@ wakeUpRobotsDoneSleeping = do
 -- | Clear the "watch" state of all of the
 -- awakened robots
 clearWatchingRobots ::
-  Has (State GameState) sig m =>
+  (Has (State GameState) sig m) =>
   [RID] ->
   m ()
 clearWatchingRobots rids = do
@@ -870,7 +876,7 @@ clearWatchingRobots rids = do
 --
 -- NOTE: Clearing "TickNumber" map entries from "internalWaitingRobots"
 -- upon wakeup is handled by "wakeUpRobotsDoneSleeping" in State.hs
-wakeWatchingRobots :: Has (State GameState) sig m => Location -> m ()
+wakeWatchingRobots :: (Has (State GameState) sig m) => Location -> m ()
 wakeWatchingRobots loc = do
   currentTick <- use ticks
   waitingMap <- use waitingRobots
@@ -923,7 +929,7 @@ wakeWatchingRobots loc = do
       Waiting _ c -> Waiting newWakeTime c
       x -> x
 
-deleteRobot :: Has (State GameState) sig m => RID -> m ()
+deleteRobot :: (Has (State GameState) sig m) => RID -> m ()
 deleteRobot rn = do
   internalActiveRobots %= IS.delete rn
   mrobot <- robotMap . at rn <<.= Nothing

src/Swarm/TUI/Attr.hs

@@ -44,11 +44,13 @@ module Swarm.TUI.Attr (
   greenAttr,
   redAttr,
   defAttr,
+  customEditFocusedAttr,
 ) where
 
 import Brick
 import Brick.Forms
 import Brick.Widgets.Dialog
+import Brick.Widgets.Edit qualified as E
 import Brick.Widgets.List
 import Data.Bifunctor (bimap)
 import Data.Text (unpack)
@@ -77,6 +79,7 @@ swarmAttrMap =
            (highlightAttr, fg V.cyan)
          , (invalidFormInputAttr, fg V.red)
          , (focusedFormInputAttr, V.defAttr)
+         , (customEditFocusedAttr, V.black `on` V.yellow)
          , (listSelectedFocusedAttr, bg V.blue)
          , (infoAttr, fg (V.rgbColor @Int 50 50 50))
          , (buttonSelectedAttr, bg V.blue)
@@ -168,6 +171,9 @@ boldAttr = attrName "bold"
 dimAttr = attrName "dim"
 defAttr = attrName "def"
 
+customEditFocusedAttr :: AttrName
+customEditFocusedAttr = attrName "custom" <> E.editFocusedAttr
+
 -- | Some basic colors used in TUI.
 redAttr, greenAttr, blueAttr, yellowAttr, cyanAttr, lightCyanAttr, magentaAttr :: AttrName
 redAttr = attrName "red"

src/Swarm/TUI/Controller.hs

@@ -93,6 +93,9 @@ import Swarm.Language.Types
 import Swarm.Language.Value (Value (VKey, VUnit), prettyValue, stripVResult)
 import Swarm.TUI.Controller.Util
 import Swarm.TUI.Inventory.Sorting (cycleSortDirection, cycleSortOrder)
+import Swarm.TUI.Launch.Controller
+import Swarm.TUI.Launch.Model
+import Swarm.TUI.Launch.Prep (prepareLaunchDialog)
 import Swarm.TUI.List
 import Swarm.TUI.Model
 import Swarm.TUI.Model.Goal
@@ -133,7 +136,12 @@ handleEvent = \case
           -- quitGame function would have already halted the app).
           NoMenu -> const halt
           MainMenu l -> handleMainMenuEvent l
-          NewGameMenu l -> handleNewGameMenuEvent l
+          NewGameMenu l ->
+            if s ^. uiState . uiLaunchConfig . controls . fileBrowser . fbIsDisplayed
+              then handleFBEvent
+              else case s ^. uiState . uiLaunchConfig . controls . isDisplayedFor of
+                Nothing -> handleNewGameMenuEvent l
+                Just siPair -> handleLaunchOptionsEvent siPair
           MessagesMenu -> handleMainMessagesEvent
           AchievementsMenu l -> handleMainAchievementsEvent l
           AboutMenu -> pressAnyKey (MainMenu (mainMenu About))
@@ -222,7 +230,10 @@ handleMainMessagesEvent = \case
  where
   returnToMainMenu = uiState . uiMenu .= MainMenu (mainMenu Messages)
 
-handleNewGameMenuEvent :: NonEmpty (BL.List Name ScenarioItem) -> BrickEvent Name AppEvent -> EventM Name AppState ()
+handleNewGameMenuEvent ::
+  NonEmpty (BL.List Name ScenarioItem) ->
+  BrickEvent Name AppEvent ->
+  EventM Name AppState ()
 handleNewGameMenuEvent scenarioStack@(curMenu :| rest) = \case
   Key V.KEnter ->
     case snd <$> BL.listSelectedElement curMenu of
@@ -231,13 +242,19 @@ handleNewGameMenuEvent scenarioStack@(curMenu :| rest) = \case
       Just (SICollection _ c) -> do
         cheat <- use $ uiState . uiCheatMode
         uiState . uiMenu .= NewGameMenu (NE.cons (mkScenarioList cheat c) scenarioStack)
+  CharKey 'o' -> showLaunchDialog
+  CharKey 'O' -> showLaunchDialog
   Key V.KEsc -> exitNewGameMenu scenarioStack
   CharKey 'q' -> exitNewGameMenu scenarioStack
   ControlChar 'q' -> halt
   VtyEvent ev -> do
     menu' <- nestEventM' curMenu (handleListEvent ev)
     uiState . uiMenu .= NewGameMenu (menu' :| rest)
   _ -> continueWithoutRedraw
+ where
+  showLaunchDialog = case snd <$> BL.listSelectedElement curMenu of
+    Just (SISingle siPair) -> Brick.zoom (uiState . uiLaunchConfig) $ prepareLaunchDialog siPair
+    _ -> continueWithoutRedraw
 
 exitNewGameMenu :: NonEmpty (BL.List Name ScenarioItem) -> EventM Name AppState ()
 exitNewGameMenu stk = do
@@ -460,7 +477,7 @@ getNormalizedCurrentScenarioPath =
 
 saveScenarioInfoOnFinish :: (MonadIO m, MonadState AppState m) => FilePath -> m (Maybe ScenarioInfo)
 saveScenarioInfoOnFinish p = do
-  initialCode <- use $ gameState . initiallyRunCode
+  initialRunCode <- use $ gameState . initiallyRunCode
   t <- liftIO getZonedTime
   wc <- use $ gameState . winCondition
   let won = case wc of
@@ -475,7 +492,7 @@ saveScenarioInfoOnFinish p = do
       currentScenarioInfo = runtimeState . scenarios . scenarioItemByPath p . _SISingle . _2
 
   replHist <- use $ uiState . uiREPL . replHistory
-  let determinator = CodeSizeDeterminators initialCode $ replHist ^. replHasExecutedManualInput
+  let determinator = CodeSizeDeterminators initialRunCode $ replHist ^. replHasExecutedManualInput
   currentScenarioInfo
     %= updateScenarioInfoOnFinish determinator t ts won
   status <- preuse currentScenarioInfo
@@ -1033,14 +1050,14 @@ handleREPLEventPiloting x = case x of
       & replPromptText .~ nt
       & replPromptType .~ CmdPrompt []
 
-runBaseWebCode :: MonadState AppState m => T.Text -> m ()
+runBaseWebCode :: (MonadState AppState m) => T.Text -> m ()
 runBaseWebCode uinput = do
   s <- get
   let topCtx = topContext s
   unless (s ^. gameState . replWorking) $
     runBaseCode topCtx uinput
 
-runBaseCode :: MonadState AppState m => RobotContext -> T.Text -> m ()
+runBaseCode :: (MonadState AppState m) => RobotContext -> T.Text -> m ()
 runBaseCode topCtx uinput =
   case processTerm' (topCtx ^. defTypes) (topCtx ^. defReqs) uinput of
     Right mt -> do
@@ -1051,7 +1068,7 @@ runBaseCode topCtx uinput =
     Left err -> do
       uiState . uiError ?= err
 
-runBaseTerm :: MonadState AppState m => RobotContext -> Maybe ProcessedTerm -> m ()
+runBaseTerm :: (MonadState AppState m) => RobotContext -> Maybe ProcessedTerm -> m ()
 runBaseTerm topCtx =
   modify . maybe id startBaseProgram
  where
@@ -1253,7 +1270,7 @@ adjReplHistIndex d s =
 worldScrollDist :: Int32
 worldScrollDist = 8
 
-onlyCreative :: MonadState AppState m => m () -> m ()
+onlyCreative :: (MonadState AppState m) => m () -> m ()
 onlyCreative a = do
   c <- use $ gameState . creativeMode
   when c a