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
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
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
(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
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)
[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)
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