{-# LANGUAGE OverloadedStrings #-}
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)
initConfigPanel :: IO LaunchOptions
initConfigPanel :: IO LaunchOptions
initConfigPanel = do
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
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)
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
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