{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}

-- |
-- SPDX-License-Identifier: BSD-3-Clause
--
-- Types for representing state of the launch dialog,
-- along with conversion functions for validated launch parameters.
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.Failure (SystemFailure)
import Swarm.Game.Scenario.Status (ParameterizableLaunchParams (LaunchParams), ScenarioInfo, ScenarioWith, SerializableLaunchParams)
import Swarm.Game.State (LaunchParams, ValidatedLaunchParams, getRunCodePath, parseCodeFile)
import Swarm.Pretty (prettyText)
import Swarm.TUI.Model.Name
import Swarm.Util.Effect (withThrow)

-- | Use this to store error messages
-- on individual fields
type EditingLaunchParams = LaunchParams (Either Text)

toSerializableParams :: ValidatedLaunchParams -> SerializableLaunchParams
toSerializableParams :: ValidatedLaunchParams -> SerializableLaunchParams
toSerializableParams (LaunchParams Identity (Maybe Seed)
seedValue (Identity Maybe CodeToRun
codeToRun)) =
  Identity (Maybe Seed)
-> Identity (Maybe FilePath) -> SerializableLaunchParams
forall code (f :: * -> *).
f (Maybe Seed)
-> f (Maybe code) -> ParameterizableLaunchParams code f
LaunchParams Identity (Maybe Seed)
seedValue (Identity (Maybe FilePath) -> SerializableLaunchParams)
-> Identity (Maybe FilePath) -> SerializableLaunchParams
forall a b. (a -> b) -> a -> b
$ Maybe FilePath -> Identity (Maybe FilePath)
forall a. a -> Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe FilePath -> Identity (Maybe FilePath))
-> Maybe FilePath -> Identity (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$ CodeToRun -> Maybe FilePath
getRunCodePath (CodeToRun -> Maybe FilePath) -> Maybe CodeToRun -> Maybe FilePath
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 <-
    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
$
      (FilePath -> ThrowC SystemFailure (ThrowC Text IO) CodeToRun)
-> Maybe FilePath
-> 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 FilePath -> ThrowC SystemFailure (ThrowC Text IO) CodeToRun
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (Throw SystemFailure) sig m, Has (Lift IO) sig m) =>
FilePath -> m CodeToRun
parseCodeFile Maybe FilePath
maybeCodePath
  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 Seed)
-> Either Text (Maybe CodeToRun) -> EditingLaunchParams
forall code (f :: * -> *).
f (Maybe Seed)
-> f (Maybe code) -> ParameterizableLaunchParams code f
LaunchParams (Maybe Seed -> Either Text (Maybe Seed)
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

-- | UI elements to configure scenario launch options
data LaunchControls = LaunchControls
  { LaunchControls -> FileBrowserControl
_fileBrowser :: FileBrowserControl
  , LaunchControls -> Editor Text Name
_seedValueEditor :: Editor Text Name
  , LaunchControls -> FocusRing Name
_scenarioConfigFocusRing :: Focus.FocusRing Name
  , LaunchControls -> Maybe (ScenarioWith ScenarioInfo)
_isDisplayedFor :: Maybe (ScenarioWith ScenarioInfo)
  }

makeLenses ''LaunchControls

-- | UI elements to configure scenario launch options
data LaunchOptions = LaunchOptions
  { LaunchOptions -> LaunchControls
_controls :: LaunchControls
  , LaunchOptions -> EditingLaunchParams
_editingParams :: EditingLaunchParams
  }

makeLenses ''LaunchOptions