{-# LANGUAGE OverloadedStrings #-}

{- HLINT ignore "Use <$>" -}

-- |
-- SPDX-License-Identifier: BSD-3-Clause
--
-- Prepares and validates scenario launch parameters
module Swarm.TUI.Launch.Prep where

import Brick (EventM)
import Brick.Focus qualified as Focus
import Brick.Widgets.Edit
import Brick.Widgets.FileBrowser qualified as FB
import Control.Arrow (left)
import Control.Carrier.Throw.Either (runThrow)
import Control.Lens ((.=), (^.))
import Control.Monad.IO.Class (MonadIO, liftIO)
import Data.Functor.Identity (runIdentity)
import Data.List.Extra (enumerate)
import Data.Text qualified as T
import Swarm.Failure (SystemFailure)
import Swarm.Game.Scenario.Status (ParameterizableLaunchParams (..), ScenarioInfo, ScenarioWith (..), getLaunchParams, scenarioStatus)
import Swarm.Game.State (ValidatedLaunchParams, getRunCodePath, parseCodeFile)
import Swarm.Game.World.Gen (Seed)
import Swarm.Pretty (prettyText)
import Swarm.TUI.Launch.Model
import Swarm.TUI.Model.Name
import Swarm.Util.Effect (withThrow)
import System.FilePath (takeDirectory)
import Text.Read (readEither)

swarmLangFileExtension :: String
swarmLangFileExtension :: String
swarmLangFileExtension = String
"sw"

toValidatedParams :: EditingLaunchParams -> Either T.Text ValidatedLaunchParams
toValidatedParams :: EditingLaunchParams -> Either Text ValidatedLaunchParams
toValidatedParams (LaunchParams Either Text (Maybe Int)
eitherSeedVal Either Text (Maybe CodeToRun)
eitherInitialCode) = do
  Maybe Int
maybeSeed <- Either Text (Maybe Int)
eitherSeedVal
  Maybe CodeToRun
maybeParsedCode <- Either Text (Maybe CodeToRun)
eitherInitialCode
  ValidatedLaunchParams -> Either Text ValidatedLaunchParams
forall a. a -> Either Text a
forall (m :: * -> *) a. Monad m => a -> m a
return (ValidatedLaunchParams -> Either Text ValidatedLaunchParams)
-> ValidatedLaunchParams -> Either Text ValidatedLaunchParams
forall a b. (a -> b) -> a -> b
$ Identity (Maybe Int)
-> Identity (Maybe CodeToRun) -> ValidatedLaunchParams
forall code (f :: * -> *).
f (Maybe Int)
-> f (Maybe code) -> ParameterizableLaunchParams code f
LaunchParams (Maybe Int -> Identity (Maybe Int)
forall a. a -> Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Int
maybeSeed) (Maybe CodeToRun -> Identity (Maybe CodeToRun)
forall a. a -> Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe CodeToRun
maybeParsedCode)

parseSeedInput :: Editor T.Text Name -> Either T.Text (Maybe Seed)
parseSeedInput :: Editor Text Name -> Either Text (Maybe Int)
parseSeedInput Editor Text Name
seedEditor =
  if Text -> Bool
T.null Text
seedFieldText
    then Maybe Int -> Either Text (Maybe Int)
forall a b. b -> Either a b
Right Maybe Int
forall a. Maybe a
Nothing
    else
      (Int -> Maybe Int) -> Either Text Int -> Either Text (Maybe Int)
forall a b. (a -> b) -> Either Text a -> Either Text b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> Maybe Int
forall a. a -> Maybe a
Just
        (Either Text Int -> Either Text (Maybe Int))
-> (Text -> Either Text Int) -> Text -> Either Text (Maybe Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Text) -> Either String Int -> Either Text Int
forall b c d. (b -> c) -> Either b d -> Either c d
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
left String -> Text
T.pack
        (Either String Int -> Either Text Int)
-> (Text -> Either String Int) -> Text -> Either Text Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Either String Int
forall a. Read a => String -> Either String a
readEither
        (String -> Either String Int)
-> (Text -> String) -> Text -> Either String Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack
        (Text -> Either Text (Maybe Int))
-> Text -> Either Text (Maybe Int)
forall a b. (a -> b) -> a -> b
$ Text
seedFieldText
 where
  seedFieldText :: Text
seedFieldText = [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ Editor Text Name -> [Text]
forall t n. Monoid t => Editor t n -> [t]
getEditContents Editor Text Name
seedEditor

parseWidgetParams :: LaunchControls -> IO EditingLaunchParams
parseWidgetParams :: LaunchControls -> IO EditingLaunchParams
parseWidgetParams (LaunchControls (FileBrowserControl FileBrowser Name
_fb Maybe String
maybeSelectedScript Bool
_) Editor Text Name
seedEditor FocusRing Name
_ Maybe (ScenarioWith ScenarioInfo)
_) = do
  Either Text (Maybe CodeToRun)
eitherParsedCode <-
    ThrowC Text IO (Maybe CodeToRun)
-> IO (Either Text (Maybe CodeToRun))
forall e (m :: * -> *) a. ThrowC e m a -> m (Either e a)
runThrow (ThrowC Text IO (Maybe CodeToRun)
 -> IO (Either Text (Maybe CodeToRun)))
-> (ThrowC SystemFailure (ThrowC Text IO) (Maybe CodeToRun)
    -> ThrowC Text IO (Maybe CodeToRun))
-> ThrowC SystemFailure (ThrowC Text IO) (Maybe CodeToRun)
-> IO (Either Text (Maybe CodeToRun))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SystemFailure -> Text)
-> ThrowC SystemFailure (ThrowC Text IO) (Maybe CodeToRun)
-> ThrowC Text IO (Maybe CodeToRun)
forall e2 (sig :: (* -> *) -> * -> *) (m :: * -> *) e1 a.
Has (Throw e2) sig m =>
(e1 -> e2) -> ThrowC e1 m a -> m a
withThrow (forall a. PrettyPrec a => a -> Text
prettyText @SystemFailure) (ThrowC SystemFailure (ThrowC Text IO) (Maybe CodeToRun)
 -> IO (Either Text (Maybe CodeToRun)))
-> ThrowC SystemFailure (ThrowC Text IO) (Maybe CodeToRun)
-> IO (Either Text (Maybe CodeToRun))
forall a b. (a -> b) -> a -> b
$
      (String -> ThrowC SystemFailure (ThrowC Text IO) CodeToRun)
-> Maybe String
-> ThrowC SystemFailure (ThrowC Text IO) (Maybe CodeToRun)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse String -> ThrowC SystemFailure (ThrowC Text IO) CodeToRun
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (Throw SystemFailure) sig m, Has (Lift IO) sig m) =>
String -> m CodeToRun
parseCodeFile Maybe String
maybeSelectedScript
  EditingLaunchParams -> IO EditingLaunchParams
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (EditingLaunchParams -> IO EditingLaunchParams)
-> EditingLaunchParams -> IO EditingLaunchParams
forall a b. (a -> b) -> a -> b
$ Either Text (Maybe Int)
-> Either Text (Maybe CodeToRun) -> EditingLaunchParams
forall code (f :: * -> *).
f (Maybe Int)
-> f (Maybe code) -> ParameterizableLaunchParams code f
LaunchParams Either Text (Maybe Int)
eitherMaybeSeed Either Text (Maybe CodeToRun)
eitherParsedCode
 where
  eitherMaybeSeed :: Either Text (Maybe Int)
eitherMaybeSeed = Editor Text Name -> Either Text (Maybe Int)
parseSeedInput Editor Text Name
seedEditor

makeFocusRingWith :: [ScenarioConfigPanelFocusable] -> Focus.FocusRing Name
makeFocusRingWith :: [ScenarioConfigPanelFocusable] -> FocusRing Name
makeFocusRingWith = [Name] -> FocusRing Name
forall n. [n] -> FocusRing n
Focus.focusRing ([Name] -> FocusRing Name)
-> ([ScenarioConfigPanelFocusable] -> [Name])
-> [ScenarioConfigPanelFocusable]
-> FocusRing Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ScenarioConfigPanelFocusable -> Name)
-> [ScenarioConfigPanelFocusable] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map (ScenarioConfigPanel -> Name
ScenarioConfigControl (ScenarioConfigPanel -> Name)
-> (ScenarioConfigPanelFocusable -> ScenarioConfigPanel)
-> ScenarioConfigPanelFocusable
-> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScenarioConfigPanelFocusable -> ScenarioConfigPanel
ScenarioConfigPanelControl)

initEditorWidget :: T.Text -> Editor T.Text Name
initEditorWidget :: Text -> Editor Text Name
initEditorWidget =
  Name -> Maybe Int -> Text -> Editor Text Name
forall n. n -> Maybe Int -> Text -> Editor Text n
editorText
    (ScenarioConfigPanel -> Name
ScenarioConfigControl (ScenarioConfigPanel -> Name) -> ScenarioConfigPanel -> Name
forall a b. (a -> b) -> a -> b
$ ScenarioConfigPanelFocusable -> ScenarioConfigPanel
ScenarioConfigPanelControl ScenarioConfigPanelFocusable
SeedSelector)
    (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
1) -- only allow a single line

-- | Called before any particular scenario is selected, so we
-- supply some 'Nothing's as defaults to the 'ValidatedLaunchParams'.
initConfigPanel :: IO LaunchOptions
initConfigPanel :: IO LaunchOptions
initConfigPanel = do
  -- NOTE: This is kind of pointless, because we must re-instantiate the 'FB.FileBrowser'
  -- when it is first displayed, anyway.
  FileBrowser Name
fb <-
    (FileInfo -> Bool) -> Name -> Maybe String -> IO (FileBrowser Name)
forall n.
(FileInfo -> Bool) -> n -> Maybe String -> IO (FileBrowser n)
FB.newFileBrowser
      FileInfo -> Bool
FB.selectNonDirectories
      (ScenarioConfigPanel -> Name
ScenarioConfigControl (ScenarioConfigPanel -> Name) -> ScenarioConfigPanel -> Name
forall a b. (a -> b) -> a -> b
$ ScenarioConfigPanelFocusable -> ScenarioConfigPanel
ScenarioConfigPanelControl ScenarioConfigPanelFocusable
ScriptSelector)
      Maybe String
forall a. Maybe a
Nothing -- Initial working directory to display
  LaunchOptions -> IO LaunchOptions
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (LaunchOptions -> IO LaunchOptions)
-> LaunchOptions -> IO LaunchOptions
forall a b. (a -> b) -> a -> b
$
    LaunchControls -> EditingLaunchParams -> LaunchOptions
LaunchOptions
      (FileBrowserControl
-> Editor Text Name
-> FocusRing Name
-> Maybe (ScenarioWith ScenarioInfo)
-> LaunchControls
LaunchControls (FileBrowser Name -> Maybe String -> Bool -> FileBrowserControl
FileBrowserControl FileBrowser Name
fb Maybe String
forall a. Maybe a
Nothing Bool
False) Editor Text Name
myForm FocusRing Name
ring Maybe (ScenarioWith ScenarioInfo)
forall a. Maybe a
Nothing)
      (Either Text (Maybe Int)
-> Either Text (Maybe CodeToRun) -> EditingLaunchParams
forall code (f :: * -> *).
f (Maybe Int)
-> f (Maybe code) -> ParameterizableLaunchParams code f
LaunchParams (Maybe Int -> Either Text (Maybe Int)
forall a b. b -> Either a b
Right Maybe Int
forall a. Maybe a
Nothing) (Maybe CodeToRun -> Either Text (Maybe CodeToRun)
forall a b. b -> Either a b
Right Maybe CodeToRun
forall a. Maybe a
Nothing))
 where
  myForm :: Editor Text Name
myForm = Text -> Editor Text Name
initEditorWidget Text
""
  ring :: FocusRing Name
ring = [ScenarioConfigPanelFocusable] -> FocusRing Name
makeFocusRingWith [ScenarioConfigPanelFocusable]
forall a. (Enum a, Bounded a) => [a]
enumerate

initFileBrowserWidget ::
  (MonadIO m) =>
  Maybe FilePath ->
  m (FB.FileBrowser Name)
initFileBrowserWidget :: forall (m :: * -> *).
MonadIO m =>
Maybe String -> m (FileBrowser Name)
initFileBrowserWidget Maybe String
maybePlayedScript = do
  FileBrowser Name
fb <-
    IO (FileBrowser Name) -> m (FileBrowser Name)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (FileBrowser Name) -> m (FileBrowser Name))
-> IO (FileBrowser Name) -> m (FileBrowser Name)
forall a b. (a -> b) -> a -> b
$
      (FileInfo -> Bool) -> Name -> Maybe String -> IO (FileBrowser Name)
forall n.
(FileInfo -> Bool) -> n -> Maybe String -> IO (FileBrowser n)
FB.newFileBrowser
        FileInfo -> Bool
FB.selectNonDirectories
        (ScenarioConfigPanel -> Name
ScenarioConfigControl (ScenarioConfigPanel -> Name) -> ScenarioConfigPanel -> Name
forall a b. (a -> b) -> a -> b
$ ScenarioConfigPanelFocusable -> ScenarioConfigPanel
ScenarioConfigPanelControl ScenarioConfigPanelFocusable
ScriptSelector)
        (String -> String
takeDirectory (String -> String) -> Maybe String -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe String
maybePlayedScript) -- Initial working directory to display
  FileBrowser Name -> m (FileBrowser Name)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (FileBrowser Name -> m (FileBrowser Name))
-> FileBrowser Name -> m (FileBrowser Name)
forall a b. (a -> b) -> a -> b
$ Maybe (FileInfo -> Bool) -> FileBrowser Name -> FileBrowser Name
forall n.
Maybe (FileInfo -> Bool) -> FileBrowser n -> FileBrowser n
FB.setFileBrowserEntryFilter ((FileInfo -> Bool) -> Maybe (FileInfo -> Bool)
forall a. a -> Maybe a
Just ((FileInfo -> Bool) -> Maybe (FileInfo -> Bool))
-> (FileInfo -> Bool) -> Maybe (FileInfo -> Bool)
forall a b. (a -> b) -> a -> b
$ String -> FileInfo -> Bool
FB.fileExtensionMatch String
swarmLangFileExtension) FileBrowser Name
fb

-- | 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.
--
-- Note that the 'FB.FileBrowser' widget normally allows multiple selections ("marked" files).
-- However, there do not exist any public "setters" set the marked files, so we have
-- some workarounds:
--
-- * When the user marks the first file, we immediately close the 'FB.FileBrowser' widget.
-- * We re-instantiate the 'FB.FileBrowser' from scratch every time it is opened, so that
--   it is not possible to mark more than one file.
-- * The "marked file" is persisted outside of the 'FB.FileBrowser' state, and the
--   "initial directory" is set upon instantiation from that external state.
prepareLaunchDialog ::
  ScenarioWith ScenarioInfo ->
  EventM Name LaunchOptions ()
prepareLaunchDialog :: ScenarioWith ScenarioInfo -> EventM Name LaunchOptions ()
prepareLaunchDialog siPair :: ScenarioWith ScenarioInfo
siPair@(ScenarioWith Scenario
_ ScenarioInfo
si) = do
  let serializableLaunchParams :: SerializableLaunchParams
serializableLaunchParams = ScenarioStatus -> SerializableLaunchParams
getLaunchParams (ScenarioStatus -> SerializableLaunchParams)
-> ScenarioStatus -> SerializableLaunchParams
forall a b. (a -> b) -> a -> b
$ ScenarioInfo
si ScenarioInfo
-> Getting ScenarioStatus ScenarioInfo ScenarioStatus
-> ScenarioStatus
forall s a. s -> Getting a s a -> a
^. Getting ScenarioStatus ScenarioInfo ScenarioStatus
Lens' ScenarioInfo ScenarioStatus
scenarioStatus
  EditingLaunchParams
launchEditingParams <- IO EditingLaunchParams
-> EventM Name LaunchOptions EditingLaunchParams
forall a. IO a -> EventM Name LaunchOptions a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO EditingLaunchParams
 -> EventM Name LaunchOptions EditingLaunchParams)
-> IO EditingLaunchParams
-> EventM Name LaunchOptions EditingLaunchParams
forall a b. (a -> b) -> a -> b
$ SerializableLaunchParams -> IO EditingLaunchParams
fromSerializableParams SerializableLaunchParams
serializableLaunchParams
  (EditingLaunchParams -> Identity EditingLaunchParams)
-> LaunchOptions -> Identity LaunchOptions
Lens' LaunchOptions EditingLaunchParams
editingParams ((EditingLaunchParams -> Identity EditingLaunchParams)
 -> LaunchOptions -> Identity LaunchOptions)
-> EditingLaunchParams -> EventM Name LaunchOptions ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= EditingLaunchParams
launchEditingParams

  let maybePlayedScript :: Maybe String
maybePlayedScript = case EditingLaunchParams -> Either Text (Maybe CodeToRun)
forall code (f :: * -> *).
ParameterizableLaunchParams code f -> f (Maybe code)
initialCode EditingLaunchParams
launchEditingParams of
        Right Maybe CodeToRun
codeToRun -> CodeToRun -> Maybe String
getRunCodePath (CodeToRun -> Maybe String) -> Maybe CodeToRun -> Maybe String
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe CodeToRun
codeToRun
        Left Text
_ -> Maybe String
forall a. Maybe a
Nothing

  (LaunchControls -> Identity LaunchControls)
-> LaunchOptions -> Identity LaunchOptions
Lens' LaunchOptions LaunchControls
controls ((LaunchControls -> Identity LaunchControls)
 -> LaunchOptions -> Identity LaunchOptions)
-> ((Maybe String -> Identity (Maybe String))
    -> LaunchControls -> Identity LaunchControls)
-> (Maybe String -> Identity (Maybe String))
-> LaunchOptions
-> Identity LaunchOptions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FileBrowserControl -> Identity FileBrowserControl)
-> LaunchControls -> Identity LaunchControls
Lens' LaunchControls FileBrowserControl
fileBrowser ((FileBrowserControl -> Identity FileBrowserControl)
 -> LaunchControls -> Identity LaunchControls)
-> ((Maybe String -> Identity (Maybe String))
    -> FileBrowserControl -> Identity FileBrowserControl)
-> (Maybe String -> Identity (Maybe String))
-> LaunchControls
-> Identity LaunchControls
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe String -> Identity (Maybe String))
-> FileBrowserControl -> Identity FileBrowserControl
Lens' FileBrowserControl (Maybe String)
maybeSelectedFile ((Maybe String -> Identity (Maybe String))
 -> LaunchOptions -> Identity LaunchOptions)
-> Maybe String -> EventM Name LaunchOptions ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Maybe String
maybePlayedScript
  (LaunchControls -> Identity LaunchControls)
-> LaunchOptions -> Identity LaunchOptions
Lens' LaunchOptions LaunchControls
controls ((LaunchControls -> Identity LaunchControls)
 -> LaunchOptions -> Identity LaunchOptions)
-> ((Editor Text Name -> Identity (Editor Text Name))
    -> LaunchControls -> Identity LaunchControls)
-> (Editor Text Name -> Identity (Editor Text Name))
-> LaunchOptions
-> Identity LaunchOptions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Editor Text Name -> Identity (Editor Text Name))
-> LaunchControls -> Identity LaunchControls
Lens' LaunchControls (Editor Text Name)
seedValueEditor ((Editor Text Name -> Identity (Editor Text Name))
 -> LaunchOptions -> Identity LaunchOptions)
-> Editor Text Name -> EventM Name LaunchOptions ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Text -> Editor Text Name
initEditorWidget (Text -> (Int -> Text) -> Maybe Int -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" (String -> Text
T.pack (String -> Text) -> (Int -> String) -> Int -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
forall a. Show a => a -> String
show) (Maybe Int -> Text) -> Maybe Int -> Text
forall a b. (a -> b) -> a -> b
$ Identity (Maybe Int) -> Maybe Int
forall a. Identity a -> a
runIdentity (Identity (Maybe Int) -> Maybe Int)
-> Identity (Maybe Int) -> Maybe Int
forall a b. (a -> b) -> a -> b
$ SerializableLaunchParams -> Identity (Maybe Int)
forall code (f :: * -> *).
ParameterizableLaunchParams code f -> f (Maybe Int)
seedVal SerializableLaunchParams
serializableLaunchParams)
  (LaunchControls -> Identity LaunchControls)
-> LaunchOptions -> Identity LaunchOptions
Lens' LaunchOptions LaunchControls
controls ((LaunchControls -> Identity LaunchControls)
 -> LaunchOptions -> Identity LaunchOptions)
-> ((Maybe (ScenarioWith ScenarioInfo)
     -> Identity (Maybe (ScenarioWith ScenarioInfo)))
    -> LaunchControls -> Identity LaunchControls)
-> (Maybe (ScenarioWith ScenarioInfo)
    -> Identity (Maybe (ScenarioWith ScenarioInfo)))
-> LaunchOptions
-> Identity LaunchOptions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe (ScenarioWith ScenarioInfo)
 -> Identity (Maybe (ScenarioWith ScenarioInfo)))
-> LaunchControls -> Identity LaunchControls
Lens' LaunchControls (Maybe (ScenarioWith ScenarioInfo))
isDisplayedFor ((Maybe (ScenarioWith ScenarioInfo)
  -> Identity (Maybe (ScenarioWith ScenarioInfo)))
 -> LaunchOptions -> Identity LaunchOptions)
-> Maybe (ScenarioWith ScenarioInfo)
-> EventM Name LaunchOptions ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= ScenarioWith ScenarioInfo -> Maybe (ScenarioWith ScenarioInfo)
forall a. a -> Maybe a
Just ScenarioWith ScenarioInfo
siPair