{-# 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.Text qualified as T
import Swarm.Game.Failure (SystemFailure)
import Swarm.Game.Scenario.Status (ParameterizableLaunchParams (..), ScenarioInfoPair, getLaunchParams, scenarioStatus)
import Swarm.Game.State (Seed, ValidatedLaunchParams, getRunCodePath, parseCodeFile)
import Swarm.Language.Pretty (prettyText)
import Swarm.TUI.Launch.Model
import Swarm.TUI.Model.Name
import Swarm.Util (listEnums)
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
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall code (f :: * -> *).
f (Maybe Int)
-> f (Maybe code) -> ParameterizableLaunchParams code f
LaunchParams (forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Int
maybeSeed) (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 forall a b. b -> Either a b
Right forall a. Maybe a
Nothing
    else
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Maybe a
Just
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
left String -> Text
T.pack
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Read a => String -> Either String a
readEither
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack
        forall a b. (a -> b) -> a -> b
$ Text
seedFieldText
 where
  seedFieldText :: Text
seedFieldText = forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ 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 ScenarioInfoPair
_) = do
  Either Text (Maybe CodeToRun)
eitherParsedCode <-
    forall e (m :: * -> *) a. ThrowC e m a -> m (Either e a)
runThrow forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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) forall a b. (a -> b) -> a -> b
$
      forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (Throw SystemFailure) sig m, Has (Lift IO) sig m) =>
String -> m CodeToRun
parseCodeFile Maybe String
maybeSelectedScript
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ 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 = forall n. [n] -> FocusRing n
Focus.focusRing forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (ScenarioConfigPanel -> Name
ScenarioConfigControl 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 =
  forall n. n -> Maybe Int -> Text -> Editor Text n
editorText
    (ScenarioConfigPanel -> Name
ScenarioConfigControl forall a b. (a -> b) -> a -> b
$ ScenarioConfigPanelFocusable -> ScenarioConfigPanel
ScenarioConfigPanelControl ScenarioConfigPanelFocusable
SeedSelector)
    (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 <-
    forall n.
(FileInfo -> Bool) -> n -> Maybe String -> IO (FileBrowser n)
FB.newFileBrowser
      FileInfo -> Bool
FB.selectNonDirectories
      (ScenarioConfigPanel -> Name
ScenarioConfigControl forall a b. (a -> b) -> a -> b
$ ScenarioConfigPanelFocusable -> ScenarioConfigPanel
ScenarioConfigPanelControl ScenarioConfigPanelFocusable
ScriptSelector)
      forall a. Maybe a
Nothing -- Initial working directory to display
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
    LaunchControls -> EditingLaunchParams -> LaunchOptions
LaunchOptions
      (FileBrowserControl
-> Editor Text Name
-> FocusRing Name
-> Maybe ScenarioInfoPair
-> LaunchControls
LaunchControls (FileBrowser Name -> Maybe String -> Bool -> FileBrowserControl
FileBrowserControl FileBrowser Name
fb forall a. Maybe a
Nothing Bool
False) Editor Text Name
myForm FocusRing Name
ring forall a. Maybe a
Nothing)
      (forall code (f :: * -> *).
f (Maybe Int)
-> f (Maybe code) -> ParameterizableLaunchParams code f
LaunchParams (forall a b. b -> Either a b
Right forall a. Maybe a
Nothing) (forall a b. b -> Either a b
Right 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 forall e. (Enum e, Bounded e) => [e]
listEnums

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 <-
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$
      forall n.
(FileInfo -> Bool) -> n -> Maybe String -> IO (FileBrowser n)
FB.newFileBrowser
        FileInfo -> Bool
FB.selectNonDirectories
        (ScenarioConfigPanel -> Name
ScenarioConfigControl forall a b. (a -> b) -> a -> b
$ ScenarioConfigPanelFocusable -> ScenarioConfigPanel
ScenarioConfigPanelControl ScenarioConfigPanelFocusable
ScriptSelector)
        (String -> String
takeDirectory forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe String
maybePlayedScript) -- Initial working directory to display
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall n.
Maybe (FileInfo -> Bool) -> FileBrowser n -> FileBrowser n
FB.setFileBrowserEntryFilter (forall a. a -> Maybe a
Just 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 ::
  ScenarioInfoPair ->
  EventM Name LaunchOptions ()
prepareLaunchDialog :: ScenarioInfoPair -> EventM Name LaunchOptions ()
prepareLaunchDialog siPair :: ScenarioInfoPair
siPair@(Scenario
_, ScenarioInfo
si) = do
  let serializableLaunchParams :: SerializableLaunchParams
serializableLaunchParams = ScenarioStatus -> SerializableLaunchParams
getLaunchParams forall a b. (a -> b) -> a -> b
$ ScenarioInfo
si forall s a. s -> Getting a s a -> a
^. Lens' ScenarioInfo ScenarioStatus
scenarioStatus
  EditingLaunchParams
launchEditingParams <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ SerializableLaunchParams -> IO EditingLaunchParams
fromSerializableParams SerializableLaunchParams
serializableLaunchParams
  Lens' LaunchOptions EditingLaunchParams
editingParams forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= EditingLaunchParams
launchEditingParams

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

  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 String)
maybeSelectedFile forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Maybe String
maybePlayedScript
  Lens' LaunchOptions LaunchControls
controls forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' LaunchControls (Editor Text Name)
seedValueEditor forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Text -> Editor Text Name
initEditorWidget (forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" (String -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show) forall a b. (a -> b) -> a -> b
$ forall a. Identity a -> a
runIdentity forall a b. (a -> b) -> a -> b
$ forall code (f :: * -> *).
ParameterizableLaunchParams code f -> f (Maybe Int)
seedVal SerializableLaunchParams
serializableLaunchParams)
  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. a -> Maybe a
Just ScenarioInfoPair
siPair