-- |
-- SPDX-License-Identifier: BSD-3-Clause
--
-- Event handling for the scenario launch configuration dialog.
module Swarm.TUI.Launch.Controller where

import Brick hiding (Direction, Location)
import Brick.Focus
import Brick.Widgets.Edit (handleEditorEvent)
import Brick.Widgets.FileBrowser
import Brick.Widgets.FileBrowser qualified as FB
import Control.Lens
import Control.Monad (forM_, when)
import Control.Monad.IO.Class (liftIO)
import Data.Maybe (listToMaybe)
import Graphics.Vty qualified as V
import Swarm.Game.Scenario.Status (ParameterizableLaunchParams (LaunchParams))
import Swarm.Game.ScenarioInfo
import Swarm.TUI.Controller.Util
import Swarm.TUI.Launch.Model
import Swarm.TUI.Launch.Prep (initFileBrowserWidget, makeFocusRingWith, parseSeedInput, parseWidgetParams, toValidatedParams)
import Swarm.TUI.Model
import Swarm.TUI.Model.Name
import Swarm.TUI.Model.StateUpdate
import Swarm.TUI.Model.UI
import Swarm.Util (listEnums)

updateFocusRing :: EditingLaunchParams -> EventM Name LaunchOptions ()
updateFocusRing :: EditingLaunchParams -> EventM Name LaunchOptions ()
updateFocusRing EditingLaunchParams
parsedParams = do
  FocusRing Name
currentRing <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use forall a b. (a -> b) -> a -> b
$ Lens' LaunchOptions LaunchControls
controls forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' LaunchControls (FocusRing Name)
scenarioConfigFocusRing
  let eitherLaunchParams :: Either Text ValidatedLaunchParams
eitherLaunchParams = EditingLaunchParams -> Either Text ValidatedLaunchParams
toValidatedParams EditingLaunchParams
parsedParams
      modifyRingMembers :: [ScenarioConfigPanelFocusable] -> [ScenarioConfigPanelFocusable]
modifyRingMembers = case Either Text ValidatedLaunchParams
eitherLaunchParams of
        Left Text
_ -> forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => a -> a -> Bool
/= ScenarioConfigPanelFocusable
StartGameButton)
        Right ValidatedLaunchParams
_ -> forall a. a -> a
id
      maybeCurrentFocus :: Maybe Name
maybeCurrentFocus = forall n. FocusRing n -> Maybe n
focusGetCurrent FocusRing Name
currentRing
      refocusRing :: FocusRing Name -> FocusRing Name
refocusRing = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id forall n. Eq n => n -> FocusRing n -> FocusRing n
focusSetCurrent Maybe Name
maybeCurrentFocus

  Lens' LaunchOptions LaunchControls
controls forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' LaunchControls (FocusRing Name)
scenarioConfigFocusRing forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= FocusRing Name -> FocusRing Name
refocusRing ([ScenarioConfigPanelFocusable] -> FocusRing Name
makeFocusRingWith forall a b. (a -> b) -> a -> b
$ [ScenarioConfigPanelFocusable] -> [ScenarioConfigPanelFocusable]
modifyRingMembers forall e. (Enum e, Bounded e) => [e]
listEnums)

cacheValidatedInputs :: EventM Name LaunchOptions ()
cacheValidatedInputs :: EventM Name LaunchOptions ()
cacheValidatedInputs = do
  LaunchControls
launchControls <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Lens' LaunchOptions LaunchControls
controls
  EditingLaunchParams
parsedParams <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ LaunchControls -> IO EditingLaunchParams
parseWidgetParams LaunchControls
launchControls
  Lens' LaunchOptions EditingLaunchParams
editingParams forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= EditingLaunchParams
parsedParams
  EditingLaunchParams -> EventM Name LaunchOptions ()
updateFocusRing EditingLaunchParams
parsedParams

-- | This is split out from the combined parameter-validation function
-- because validating the seed is cheap, and shouldn't have to pay
-- the cost of re-parsing script code as the user types in the seed
-- selection field.
cacheValidatedSeedInput :: EventM Name LaunchOptions ()
cacheValidatedSeedInput :: EventM Name LaunchOptions ()
cacheValidatedSeedInput = do
  Editor Text Name
seedEditor <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use forall a b. (a -> b) -> a -> b
$ Lens' LaunchOptions LaunchControls
controls forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' LaunchControls (Editor Text Name)
seedValueEditor
  let eitherMaybeSeed :: Either Text (Maybe Seed)
eitherMaybeSeed = Editor Text Name -> Either Text (Maybe Seed)
parseSeedInput Editor Text Name
seedEditor
  LaunchParams Either Text (Maybe Seed)
_ Either Text (Maybe CodeToRun)
eitherParsedCode <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Lens' LaunchOptions EditingLaunchParams
editingParams
  let newParams :: EditingLaunchParams
newParams = forall code (f :: * -> *).
f (Maybe Seed)
-> f (Maybe code) -> ParameterizableLaunchParams code f
LaunchParams Either Text (Maybe Seed)
eitherMaybeSeed Either Text (Maybe CodeToRun)
eitherParsedCode
  Lens' LaunchOptions EditingLaunchParams
editingParams forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= EditingLaunchParams
newParams
  EditingLaunchParams -> EventM Name LaunchOptions ()
updateFocusRing EditingLaunchParams
newParams

-- | If the 'FileBrowser' is in "search mode", then we allow
-- more of the key events to pass through. Otherwise,
-- we intercept things like "q" (for quit) and Space (so that
-- we can restrict file selection to at most one).
handleFBEvent ::
  BrickEvent Name AppEvent ->
  EventM Name AppState ()
handleFBEvent :: BrickEvent Name AppEvent -> EventM Name AppState ()
handleFBEvent BrickEvent Name AppEvent
ev = do
  FileBrowser Name
fb <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use forall a b. (a -> b) -> a -> b
$ Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState LaunchOptions
uiLaunchConfig forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' LaunchOptions LaunchControls
controls forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' LaunchControls FileBrowserControl
fileBrowser forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' FileBrowserControl (FileBrowser Name)
fbWidget
  let isSearching :: Bool
isSearching = forall n. FileBrowser n -> Bool
fileBrowserIsSearching FileBrowser Name
fb
  case (Bool
isSearching, BrickEvent Name AppEvent
ev) of
    (Bool
False, Key Key
V.KEsc) -> EventM Name AppState ()
closeModal
    (Bool
False, CharKey Char
'q') -> EventM Name AppState ()
closeModal
    (Bool
False, ControlChar Char
'q') -> EventM Name AppState ()
closeModal
    -- Intercept the "space" key so that it cannot be used to select files
    -- (see note below).
    (Bool
False, CharKey Char
' ') -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
    (Bool
_, VtyEvent Event
e) -> do
      (Bool
shouldClose, Maybe FilePath
maybeSingleFile) <- forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
Brick.zoom (Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState LaunchOptions
uiLaunchConfig forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' LaunchOptions LaunchControls
controls forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' LaunchControls FileBrowserControl
fileBrowser forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' FileBrowserControl (FileBrowser Name)
fbWidget) forall a b. (a -> b) -> a -> b
$ do
        forall n. Ord n => Event -> EventM n (FileBrowser n) ()
handleFileBrowserEvent Event
e
        -- If the browser has a selected file after handling the
        -- event (because the user pressed Enter), close the dialog.
        case Event
e of
          V.EvKey Key
V.KEnter [] -> do
            FileBrowser Name
b' <- forall s (m :: * -> *). MonadState s m => m s
get
            case forall n. FileBrowser n -> [FileInfo]
FB.fileBrowserSelection FileBrowser Name
b' of
              [] -> forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
False, forall a. Maybe a
Nothing)
              -- We only allow one file to be selected
              -- by closing immediately.
              -- This is a hack illustrated in the Brick FileBrowser demo:
              -- https://github.com/jtdaugherty/brick/blob/4b40476d5d58c40720170d21503c11596bc9ee39/programs/FileBrowserDemo.hs#L68-L69
              -- It is not foolproof on its own, so we also intercept
              -- the "Space" key above.
              [FileInfo]
xs -> forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
True, FileInfo -> FilePath
FB.fileInfoFilePath forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. [a] -> Maybe a
listToMaybe [FileInfo]
xs)
          -- NOTE: The "Space" key also selects a file.
          -- Apparently, even when directories are specified as
          -- non-selectable via "FB.selectNonDirectories", the internal state
          -- of the FileBrowser dialog
          -- briefly adds a directory to its "fileBrowserSelection" list
          -- when the "space" key is pressed.
          -- So it is not enough to simply check whether the selection list
          -- is nonempty after *any* keypress; we specifically have to listen for "Enter".
          --
          -- WARNING: There is still a bug when one presses the "space" key to mark
          -- a directory, then presses "Enter" right afterward.
          -- The directory will get selected, and then swarm will crash.
          -- This is why we prevent the Space key from being handled by the FileBrowser
          -- unless we are in file searching mode.
          Event
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
False, forall a. Maybe a
Nothing)

      forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
shouldClose forall a b. (a -> b) -> a -> b
$ do
        Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState LaunchOptions
uiLaunchConfig forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' LaunchOptions LaunchControls
controls forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' LaunchControls FileBrowserControl
fileBrowser forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' FileBrowserControl (Maybe FilePath)
maybeSelectedFile forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Maybe FilePath
maybeSingleFile
        EventM Name AppState ()
closeModal
    (Bool, BrickEvent Name AppEvent)
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
 where
  closeModal :: EventM Name AppState ()
closeModal = forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
Brick.zoom (Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState LaunchOptions
uiLaunchConfig) forall a b. (a -> b) -> a -> b
$ do
    Lens' LaunchOptions LaunchControls
controls forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' LaunchControls FileBrowserControl
fileBrowser forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' FileBrowserControl Bool
fbIsDisplayed forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Bool
False
    EventM Name LaunchOptions ()
cacheValidatedInputs

handleLaunchOptionsEvent ::
  ScenarioInfoPair ->
  BrickEvent Name AppEvent ->
  EventM Name AppState ()
handleLaunchOptionsEvent :: ScenarioInfoPair
-> BrickEvent Name AppEvent -> EventM Name AppState ()
handleLaunchOptionsEvent ScenarioInfoPair
siPair = \case
  Key Key
V.KBackTab ->
    Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState LaunchOptions
uiLaunchConfig forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' LaunchOptions LaunchControls
controls forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' LaunchControls (FocusRing Name)
scenarioConfigFocusRing forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= forall n. FocusRing n -> FocusRing n
focusPrev
  Key Key
V.KUp ->
    Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState LaunchOptions
uiLaunchConfig forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' LaunchOptions LaunchControls
controls forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' LaunchControls (FocusRing Name)
scenarioConfigFocusRing forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= forall n. FocusRing n -> FocusRing n
focusPrev
  CharKey Char
'\t' ->
    Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState LaunchOptions
uiLaunchConfig forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' LaunchOptions LaunchControls
controls forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' LaunchControls (FocusRing Name)
scenarioConfigFocusRing forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= forall n. FocusRing n -> FocusRing n
focusNext
  Key Key
V.KDown ->
    Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState LaunchOptions
uiLaunchConfig forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' LaunchOptions LaunchControls
controls forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' LaunchControls (FocusRing Name)
scenarioConfigFocusRing forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= forall n. FocusRing n -> FocusRing n
focusNext
  MouseDown Name
n Button
_ [Modifier]
_ Location
_ ->
    case Name
n of
      ScenarioConfigControl (ScenarioConfigPanelControl ScenarioConfigPanelFocusable
x) -> do
        Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState LaunchOptions
uiLaunchConfig forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' LaunchOptions LaunchControls
controls forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' LaunchControls (FocusRing Name)
scenarioConfigFocusRing forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= forall n. Eq n => n -> FocusRing n -> FocusRing n
focusSetCurrent Name
n
        forall {m :: * -> *}.
(Zoom m (EventM Name AppState) FileBrowserControl AppState,
 MonadIO m, Functor (Zoomed m ())) =>
ScenarioConfigPanelFocusable -> EventM Name AppState ()
activateFocusedControl ScenarioConfigPanelFocusable
x
      Name
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
  CharKey Char
' ' -> EventM Name AppState ()
activateControl
  Key Key
V.KEnter -> EventM Name AppState ()
activateControl
  Key Key
V.KEsc -> EventM Name AppState ()
closeModal
  CharKey Char
'q' -> EventM Name AppState ()
closeModal
  ControlChar Char
'q' -> EventM Name AppState ()
closeModal
  BrickEvent Name AppEvent
ev -> do
    FocusRing Name
fr <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use forall a b. (a -> b) -> a -> b
$ Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState LaunchOptions
uiLaunchConfig forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' LaunchOptions LaunchControls
controls forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' LaunchControls (FocusRing Name)
scenarioConfigFocusRing
    case forall n. FocusRing n -> Maybe n
focusGetCurrent FocusRing Name
fr of
      Just (ScenarioConfigControl (ScenarioConfigPanelControl ScenarioConfigPanelFocusable
SeedSelector)) -> forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
Brick.zoom (Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState LaunchOptions
uiLaunchConfig) forall a b. (a -> b) -> a -> b
$ do
        forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
Brick.zoom (Lens' LaunchOptions LaunchControls
controls forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' LaunchControls (Editor Text Name)
seedValueEditor) (forall n t e.
(Eq n, DecodeUtf8 t, Eq t, GenericTextZipper t) =>
BrickEvent n e -> EventM n (Editor t n) ()
handleEditorEvent BrickEvent Name AppEvent
ev)
        EventM Name LaunchOptions ()
cacheValidatedSeedInput
      Maybe Name
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
 where
  activateControl :: EventM Name AppState ()
activateControl = do
    FocusRing Name
fr <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use forall a b. (a -> b) -> a -> b
$ Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState LaunchOptions
uiLaunchConfig forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' LaunchOptions LaunchControls
controls forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' LaunchControls (FocusRing Name)
scenarioConfigFocusRing
    case forall n. FocusRing n -> Maybe n
focusGetCurrent FocusRing Name
fr of
      Just (ScenarioConfigControl (ScenarioConfigPanelControl ScenarioConfigPanelFocusable
item)) ->
        forall {m :: * -> *}.
(Zoom m (EventM Name AppState) FileBrowserControl AppState,
 MonadIO m, Functor (Zoomed m ())) =>
ScenarioConfigPanelFocusable -> EventM Name AppState ()
activateFocusedControl ScenarioConfigPanelFocusable
item
      Maybe Name
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()

  activateFocusedControl :: ScenarioConfigPanelFocusable -> EventM Name AppState ()
activateFocusedControl ScenarioConfigPanelFocusable
item = case ScenarioConfigPanelFocusable
item of
    ScenarioConfigPanelFocusable
SeedSelector -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
    ScenarioConfigPanelFocusable
ScriptSelector -> forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
Brick.zoom (Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState LaunchOptions
uiLaunchConfig forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' LaunchOptions LaunchControls
controls forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' LaunchControls FileBrowserControl
fileBrowser) forall a b. (a -> b) -> a -> b
$ do
      Maybe FilePath
maybeSingleFile <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Lens' FileBrowserControl (Maybe FilePath)
maybeSelectedFile
      FileBrowser Name
configuredFB <- forall (m :: * -> *).
MonadIO m =>
Maybe FilePath -> m (FileBrowser Name)
initFileBrowserWidget Maybe FilePath
maybeSingleFile
      Lens' FileBrowserControl (FileBrowser Name)
fbWidget forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= FileBrowser Name
configuredFB
      Lens' FileBrowserControl Bool
fbIsDisplayed forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Bool
True
    ScenarioConfigPanelFocusable
StartGameButton -> do
      EditingLaunchParams
params <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use forall a b. (a -> b) -> a -> b
$ Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState LaunchOptions
uiLaunchConfig forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' LaunchOptions EditingLaunchParams
editingParams
      let eitherLaunchParams :: Either Text ValidatedLaunchParams
eitherLaunchParams = EditingLaunchParams -> Either Text ValidatedLaunchParams
toValidatedParams EditingLaunchParams
params
      forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Either Text ValidatedLaunchParams
eitherLaunchParams forall a b. (a -> b) -> a -> b
$ \ValidatedLaunchParams
launchParams -> do
        EventM Name AppState ()
closeModal
        forall (m :: * -> *).
(MonadIO m, MonadState AppState m) =>
ScenarioInfoPair -> ValidatedLaunchParams -> m ()
startGameWithSeed ScenarioInfoPair
siPair ValidatedLaunchParams
launchParams

  closeModal :: EventM Name AppState ()
closeModal = Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' UIState LaunchOptions
uiLaunchConfig forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' LaunchOptions LaunchControls
controls forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' LaunchControls (Maybe ScenarioInfoPair)
isDisplayedFor forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= forall a. Maybe a
Nothing