{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
module Swarm.TUI.Launch.Model where
import Brick.Focus qualified as Focus
import Brick.Widgets.Edit
import Brick.Widgets.FileBrowser qualified as FB
import Control.Carrier.Throw.Either (runThrow)
import Control.Lens (makeLenses)
import Data.Functor.Identity (Identity (Identity))
import Data.Text (Text)
import Swarm.Game.Failure (SystemFailure)
import Swarm.Game.Scenario.Status (ParameterizableLaunchParams (LaunchParams), ScenarioInfoPair, SerializableLaunchParams)
import Swarm.Game.State (LaunchParams, ValidatedLaunchParams, getRunCodePath, parseCodeFile)
import Swarm.Language.Pretty (prettyText)
import Swarm.TUI.Model.Name
import Swarm.Util.Effect (withThrow)
type EditingLaunchParams = LaunchParams (Either Text)
toSerializableParams :: ValidatedLaunchParams -> SerializableLaunchParams
toSerializableParams :: ValidatedLaunchParams -> SerializableLaunchParams
toSerializableParams (LaunchParams Identity (Maybe Seed)
seedValue (Identity Maybe CodeToRun
codeToRun)) =
forall code (f :: * -> *).
f (Maybe Seed)
-> f (Maybe code) -> ParameterizableLaunchParams code f
LaunchParams Identity (Maybe Seed)
seedValue forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ CodeToRun -> Maybe FilePath
getRunCodePath forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe CodeToRun
codeToRun
fromSerializableParams :: SerializableLaunchParams -> IO EditingLaunchParams
fromSerializableParams :: SerializableLaunchParams -> IO EditingLaunchParams
fromSerializableParams (LaunchParams (Identity Maybe Seed
maybeSeedValue) (Identity Maybe FilePath
maybeCodePath)) = do
Either Text (Maybe CodeToRun)
eitherCode <-
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) =>
FilePath -> m CodeToRun
parseCodeFile Maybe FilePath
maybeCodePath
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall code (f :: * -> *).
f (Maybe Seed)
-> f (Maybe code) -> ParameterizableLaunchParams code f
LaunchParams (forall a b. b -> Either a b
Right Maybe Seed
maybeSeedValue) Either Text (Maybe CodeToRun)
eitherCode
data FileBrowserControl = FileBrowserControl
{ FileBrowserControl -> FileBrowser Name
_fbWidget :: FB.FileBrowser Name
, FileBrowserControl -> Maybe FilePath
_maybeSelectedFile :: Maybe FilePath
, FileBrowserControl -> Bool
_fbIsDisplayed :: Bool
}
makeLenses ''FileBrowserControl
data LaunchControls = LaunchControls
{ LaunchControls -> FileBrowserControl
_fileBrowser :: FileBrowserControl
, LaunchControls -> Editor Text Name
_seedValueEditor :: Editor Text Name
, LaunchControls -> FocusRing Name
_scenarioConfigFocusRing :: Focus.FocusRing Name
, LaunchControls -> Maybe ScenarioInfoPair
_isDisplayedFor :: Maybe ScenarioInfoPair
}
makeLenses ''LaunchControls
data LaunchOptions = LaunchOptions
{ LaunchOptions -> LaunchControls
_controls :: LaunchControls
, LaunchOptions -> EditingLaunchParams
_editingParams :: EditingLaunchParams
}
makeLenses ''LaunchOptions