Scenario launch configuration dialog

Towards #358

src/Swarm/Game/Scenario/Status.hs

@@ -28,7 +28,11 @@ import Swarm.Game.Scenario.Scoring.GenericMetrics
 --   The "Played" status has two sub-states: "Attempted" or "Completed".
 data ScenarioStatus
   = NotStarted
-  | Played ProgressMetric BestRecords
+  | Played
+      (Maybe FilePath)
+      -- ^ initial script to run
+      ProgressMetric
+      BestRecords
   deriving (Eq, Ord, Show, Read, Generic)
 
 instance FromJSON ScenarioStatus where
@@ -38,6 +42,11 @@ instance ToJSON ScenarioStatus where
   toEncoding = genericToEncoding scenarioOptions
   toJSON = genericToJSON scenarioOptions
 
+getPlayedScript :: ScenarioStatus -> Maybe FilePath
+getPlayedScript = \case
+  NotStarted -> Nothing
+  Played s _ _ -> s
+
 -- | A "ScenarioInfo" record stores metadata about a scenario: its
 -- canonical path and status.
 -- By way of the "ScenarioStatus" record, it stores the
@@ -83,9 +92,9 @@ updateScenarioInfoOnFinish
   ticks
   completed
   si@(ScenarioInfo p prevPlayState) = case prevPlayState of
-    Played (Metric _ (ProgressStats start _currentPlayMetrics)) prevBestRecords ->
+    Played initialScript (Metric _ (ProgressStats start _currentPlayMetrics)) prevBestRecords ->
       ScenarioInfo p $
-        Played newPlayMetric $
+        Played initialScript newPlayMetric $
           updateBest newPlayMetric prevBestRecords
      where
       el = (diffUTCTime `on` zonedTimeToUTC) z start

src/Swarm/Game/State.hs

@@ -90,6 +90,7 @@ module Swarm.Game.State (
   CodeToRun (..),
   Sha1 (..),
   SolutionSource (..),
+  parseCodeFile,
   getParsedInitialCode,
 
   -- * Utilities
@@ -114,6 +115,7 @@ module Swarm.Game.State (
   toggleRunStatus,
   messageIsRecent,
   messageIsFromNearby,
+  getRunCodePath,
 ) where
 
 import Control.Algebra (Has)
@@ -289,29 +291,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
 ------------------------------------------------------------
@@ -1230,7 +1236,7 @@ initGameStateForScenario sceneName userSeed toRun = do
     gs
       & currentScenarioPath ?~ normalPath
       & scenarios . scenarioItemByPath normalPath . _SISingle . _2 . scenarioStatus
-        .~ Played (Metric Attempted $ ProgressStats t emptyAttemptMetric) (emptyBest t)
+        .~ Played toRun (Metric Attempted $ ProgressStats t emptyAttemptMetric) (emptyBest t)
 
 -- | For convenience, the 'GameState' corresponding to the classic
 --   game with seed 0.

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

@@ -43,6 +43,7 @@ import Brick qualified
 import Brick.Focus
 import Brick.Widgets.Dialog
 import Brick.Widgets.Edit (handleEditorEvent)
+import Brick.Widgets.FileBrowser (setWorkingDirectory)
 import Brick.Widgets.List (handleListEvent)
 import Brick.Widgets.List qualified as BL
 import Control.Carrier.Lift qualified as Fused
@@ -74,6 +75,7 @@ import Swarm.Game.Entity hiding (empty)
 import Swarm.Game.Location
 import Swarm.Game.ResourceLoading (getSwarmHistoryPath)
 import Swarm.Game.Robot
+import Swarm.Game.Scenario.Status (getPlayedScript)
 import Swarm.Game.ScenarioInfo
 import Swarm.Game.State
 import Swarm.Game.Step (finishGameTick, gameTick)
@@ -93,6 +95,8 @@ 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.List
 import Swarm.TUI.Model
 import Swarm.TUI.Model.Goal
@@ -105,7 +109,7 @@ import Swarm.TUI.View.Objective qualified as GR
 import Swarm.Util hiding (both, (<<.=))
 import Swarm.Version (NewReleaseFailure (..))
 import System.Clock
-import System.FilePath (splitDirectories)
+import System.FilePath (splitDirectories, takeDirectory)
 import Witch (into)
 
 tutorialsDirname :: FilePath
@@ -133,7 +137,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 +231,26 @@ handleMainMessagesEvent = \case
  where
   returnToMainMenu = uiState . uiMenu .= MainMenu (mainMenu Messages)
 
-handleNewGameMenuEvent :: NonEmpty (BL.List Name ScenarioItem) -> BrickEvent Name AppEvent -> EventM Name AppState ()
+-- | If the selected scenario has been launched with an initial script before,
+-- set the file browser to initially open that script's directory.
+--
+-- Then set the launch dialog to be displayed.
+prepareLaunchDialog ::
+  ScenarioInfoPair ->
+  EventM Name AppState ()
+prepareLaunchDialog siPair@(_, si) = do
+  let maybePlayedScript = getPlayedScript $ si ^. scenarioStatus
+  fb <- use $ uiState . uiLaunchConfig . controls . fileBrowser . fbWidget
+  forM_ maybePlayedScript $ \playedScript -> do
+    newFb <- liftIO $ setWorkingDirectory (takeDirectory playedScript) fb
+    uiState . uiLaunchConfig . controls . fileBrowser . fbWidget .= newFb
+
+  uiState . uiLaunchConfig . controls . isDisplayedFor .= Just siPair
+
+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,6 +259,9 @@ handleNewGameMenuEvent scenarioStack@(curMenu :| rest) = \case
       Just (SICollection _ c) -> do
         cheat <- use $ uiState . uiCheatMode
         uiState . uiMenu .= NewGameMenu (NE.cons (mkScenarioList cheat c) scenarioStack)
+  CharKey 'o' -> case snd <$> BL.listSelectedElement curMenu of
+    Just (SISingle siPair) -> prepareLaunchDialog siPair
+    _ -> continueWithoutRedraw
   Key V.KEsc -> exitNewGameMenu scenarioStack
   CharKey 'q' -> exitNewGameMenu scenarioStack
   ControlChar 'q' -> halt
@@ -456,7 +487,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
@@ -471,7 +502,7 @@ saveScenarioInfoOnFinish p = do
       currentScenarioInfo = gameState . 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

src/Swarm/TUI/Launch/Controller.hs

@@ -0,0 +1,80 @@
+module Swarm.TUI.Launch.Controller where
+
+import Brick hiding (Direction, Location)
+import Brick.Focus
+import Brick.Widgets.Edit (handleEditorEvent)
+import Brick.Widgets.FileBrowser
+import Control.Lens
+import Control.Monad.Except (forM_, liftIO)
+import Graphics.Vty qualified as V
+import Swarm.Game.ScenarioInfo
+import Swarm.TUI.Controller.Util
+import Swarm.TUI.Launch.Model
+import Swarm.TUI.Launch.Prep (toValidatedParms)
+import Swarm.TUI.Model
+import Swarm.TUI.Model.Name
+import Swarm.TUI.Model.StateUpdate
+import Swarm.TUI.Model.UI
+
+cacheValidatedInputs :: EventM Name AppState ()
+cacheValidatedInputs = do
+  launchControls <- use $ uiState . uiLaunchConfig . controls
+  eitherLaunchParams <- liftIO $ toValidatedParms launchControls
+  uiState . uiLaunchConfig . validatedParams .= eitherLaunchParams
+
+handleFBEvent ::
+  BrickEvent Name AppEvent ->
+  EventM Name AppState ()
+handleFBEvent = \case
+  Key V.KEsc -> closeModal
+  CharKey 'q' -> closeModal
+  ControlChar 'q' -> closeModal
+  VtyEvent e ->
+    Brick.zoom (uiState . uiLaunchConfig . controls . fileBrowser . fbWidget) (handleFileBrowserEvent e)
+  _ -> return ()
+ where
+  closeModal = do
+    uiState . uiLaunchConfig . controls . fileBrowser . fbIsDisplayed .= False
+    cacheValidatedInputs
+
+handleLaunchOptionsEvent ::
+  ScenarioInfoPair ->
+  BrickEvent Name AppEvent ->
+  EventM Name AppState ()
+handleLaunchOptionsEvent siPair = \case
+  Key V.KBackTab ->
+    uiState . uiLaunchConfig . controls . scenarioConfigFocusRing %= focusPrev
+  Key V.KUp ->
+    uiState . uiLaunchConfig . controls . scenarioConfigFocusRing %= focusPrev
+  CharKey '\t' ->
+    uiState . uiLaunchConfig . controls . scenarioConfigFocusRing %= focusNext
+  Key V.KDown ->
+    uiState . uiLaunchConfig . controls . scenarioConfigFocusRing %= focusNext
+  CharKey ' ' -> activateControl
+  Key V.KEnter -> activateControl
+  Key V.KEsc -> closeModal
+  CharKey 'q' -> closeModal
+  ControlChar 'q' -> closeModal
+  ev -> do
+    fr <- use $ uiState . uiLaunchConfig . controls . scenarioConfigFocusRing
+    case focusGetCurrent fr of
+      Just (ScenarioConfigControl (ScenarioConfigPanelControl SeedSelector)) -> do
+        Brick.zoom (uiState . uiLaunchConfig . controls . seedValueEditor) (handleEditorEvent ev)
+        cacheValidatedInputs
+      _ -> return ()
+ where
+  activateControl = do
+    fr <- use $ uiState . uiLaunchConfig . controls . scenarioConfigFocusRing
+    case focusGetCurrent fr of
+      Just (ScenarioConfigControl (ScenarioConfigPanelControl item)) -> case item of
+        SeedSelector -> return ()
+        ScriptSelector ->
+          uiState . uiLaunchConfig . controls . fileBrowser . fbIsDisplayed .= True
+        StartGameButton -> do
+          eitherLaunchParams <- use $ uiState . uiLaunchConfig . validatedParams
+          forM_ eitherLaunchParams $ \launchParams -> do
+            closeModal
+            startGameWithSeed siPair launchParams
+      _ -> return ()
+
+  closeModal = uiState . uiLaunchConfig . controls . isDisplayedFor .= Nothing

src/Swarm/TUI/Launch/Model.hs

@@ -0,0 +1,49 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TemplateHaskell #-}
+
+module Swarm.TUI.Launch.Model where
+
+import Brick.Focus qualified as Focus
+import Brick.Widgets.Edit
+import Brick.Widgets.FileBrowser qualified as FB
+import Control.Lens (makeLenses)
+import Data.Text (Text)
+import Swarm.Game.ScenarioInfo
+import Swarm.Game.State (CodeToRun)
+import Swarm.Game.WorldGen (Seed)
+import Swarm.TUI.Model.Name
+
+data ValidatedLaunchParms = ValidatedLaunchParms
+  { seedVal :: Maybe Seed
+  , initialCode :: Maybe CodeToRun
+  }
+
+data FileBrowserControl = FileBrowserControl
+  { _fbWidget :: FB.FileBrowser Name
+  , _fbIsDisplayed :: Bool
+  }
+
+makeLenses ''FileBrowserControl
+
+-- | UI elements to configure scenario launch options
+data LaunchControls = LaunchControls
+  { _fileBrowser :: FileBrowserControl
+  , _seedValueEditor :: Editor Text Name
+  , _scenarioConfigFocusRing :: Focus.FocusRing Name
+  , _isDisplayedFor :: Maybe ScenarioInfoPair
+  }
+
+makeLenses ''LaunchControls
+
+data LaunchFormError = LaunchFormError
+  { widget :: ScenarioConfigPanelFocusable
+  , message :: Text
+  }
+
+-- | UI elements to configure scenario launch options
+data LaunchOptions = LaunchOptions
+  { _controls :: LaunchControls
+  , _validatedParams :: Either LaunchFormError ValidatedLaunchParms
+  }
+
+makeLenses ''LaunchOptions