{-# LANGUAGE OverloadedStrings #-}

-- |
-- SPDX-License-Identifier: BSD-3-Clause
--
-- Rendering of the scenario launch configuration dialog.
module Swarm.TUI.Launch.View where

import Brick
import Brick.Focus
import Brick.Forms qualified as BF
import Brick.Widgets.Border
import Brick.Widgets.Center (centerLayer, hCenter)
import Brick.Widgets.Edit
import Brick.Widgets.Edit qualified as E
import Brick.Widgets.FileBrowser qualified as FB
import Control.Exception qualified as E
import Control.Lens
import Data.Either (isRight)
import Data.Text (Text)
import Data.Text qualified as T
import Swarm.Game.Scenario (scenarioSeed)
import Swarm.Game.Scenario.Status (ParameterizableLaunchParams (..))
import Swarm.Game.State (getRunCodePath)
import Swarm.TUI.Launch.Model
import Swarm.TUI.Launch.Prep
import Swarm.TUI.Model.Name
import Swarm.TUI.View.Attribute.Attr
import Swarm.TUI.View.Util (EllipsisSide (Beginning), withEllipsis)
import Swarm.Util (brackets, parens)

drawFileBrowser :: FB.FileBrowser Name -> Widget Name
drawFileBrowser :: FileBrowser Name -> Widget Name
drawFileBrowser FileBrowser Name
b =
  forall n. Widget n -> Widget n
centerLayer forall a b. (a -> b) -> a -> b
$ forall n. Int -> Widget n -> Widget n
hLimit Int
50 forall a b. (a -> b) -> a -> b
$ Widget Name
ui forall n. Widget n -> Widget n -> Widget n
<=> forall {n}. Widget n
help
 where
  ui :: Widget Name
ui =
    forall n. Int -> Widget n -> Widget n
vLimit Int
15 forall a b. (a -> b) -> a -> b
$
      forall n. Widget n -> Widget n -> Widget n
borderWithLabel (forall n. Text -> Widget n
txt Text
"Choose a file") forall a b. (a -> b) -> a -> b
$
        forall n. (Show n, Ord n) => Bool -> FileBrowser n -> Widget n
FB.renderFileBrowser Bool
True FileBrowser Name
b

  footerRows :: [Widget n]
footerRows =
    forall a b. (a -> b) -> [a] -> [b]
map
      (forall n. AttrName -> Widget n -> Widget n
withDefAttr AttrName
dimAttr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Widget n -> Widget n
hCenter forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Text -> Widget n
txt)
      [ Text
"Up/Down: navigate"
      , Text
"/: search, Ctrl-C or Esc: cancel search"
      , Text
"Enter: change directory or select file"
      , Text
"Esc: quit"
      ]

  help :: Widget n
help =
    forall n. Padding -> Widget n -> Widget n
padTop (Int -> Padding
Pad Int
1) forall a b. (a -> b) -> a -> b
$
      forall n. [Widget n] -> Widget n
vBox forall a b. (a -> b) -> a -> b
$
        [ case forall n. FileBrowser n -> Maybe IOException
FB.fileBrowserException FileBrowser Name
b of
            Maybe IOException
Nothing -> forall {n}. Widget n
emptyWidget
            Just IOException
e ->
              forall n. Widget n -> Widget n
hCenter
                forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. AttrName -> Widget n -> Widget n
withDefAttr AttrName
BF.invalidFormInputAttr
                forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Text -> Widget n
txt
                forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack
                forall a b. (a -> b) -> a -> b
$ forall e. Exception e => e -> String
E.displayException IOException
e
        ]
          forall a. Semigroup a => a -> a -> a
<> forall {n}. [Widget n]
footerRows

optionDescription :: ScenarioConfigPanelFocusable -> Maybe Text
optionDescription :: ScenarioConfigPanelFocusable -> Maybe Text
optionDescription = \case
  ScenarioConfigPanelFocusable
SeedSelector -> forall a. a -> Maybe a
Just Text
"Leaving this field blank will use the default seed for the scenario."
  ScenarioConfigPanelFocusable
ScriptSelector -> forall a. a -> Maybe a
Just Text
"Selecting a script to be run upon start permits eligibility for code size scoring."
  ScenarioConfigPanelFocusable
StartGameButton -> forall a. Maybe a
Nothing

drawLaunchConfigPanel :: LaunchOptions -> [Widget Name]
drawLaunchConfigPanel :: LaunchOptions -> [Widget Name]
drawLaunchConfigPanel (LaunchOptions LaunchControls
lc EditingLaunchParams
launchParams) =
  [Widget Name] -> [Widget Name]
addFileBrowser [Widget Name
panelWidget]
 where
  validatedOptions :: Either Text ValidatedLaunchParams
validatedOptions = EditingLaunchParams -> Either Text ValidatedLaunchParams
toValidatedParams EditingLaunchParams
launchParams
  LaunchControls (FileBrowserControl FileBrowser Name
fb Maybe String
_ Bool
isFbDisplayed) Editor Text Name
seedEditor FocusRing Name
ring Maybe ScenarioInfoPair
displayedFor = LaunchControls
lc
  addFileBrowser :: [Widget Name] -> [Widget Name]
addFileBrowser =
    if Bool
isFbDisplayed
      then (FileBrowser Name -> Widget Name
drawFileBrowser FileBrowser Name
fb forall a. a -> [a] -> [a]
:)
      else forall a. a -> a
id

  getFocusedConfigPanel :: Maybe ScenarioConfigPanelFocusable
  getFocusedConfigPanel :: Maybe ScenarioConfigPanelFocusable
getFocusedConfigPanel = case forall n. FocusRing n -> Maybe n
focusGetCurrent FocusRing Name
ring of
    Just (ScenarioConfigControl (ScenarioConfigPanelControl ScenarioConfigPanelFocusable
x)) -> forall a. a -> Maybe a
Just ScenarioConfigPanelFocusable
x
    Maybe Name
_ -> forall a. Maybe a
Nothing

  isFocused :: ScenarioConfigPanelFocusable -> Bool
isFocused = (forall a. Eq a => a -> a -> Bool
== Maybe ScenarioConfigPanelFocusable
getFocusedConfigPanel) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just

  highlightIfFocused :: ScenarioConfigPanelFocusable -> Widget n -> Widget n
highlightIfFocused ScenarioConfigPanelFocusable
x =
    if ScenarioConfigPanelFocusable -> Bool
isFocused ScenarioConfigPanelFocusable
x
      then forall n. AttrName -> Widget n -> Widget n
withDefAttr AttrName
highlightAttr
      else forall a. a -> a
id

  mkButton :: ScenarioConfigPanelFocusable -> Text -> Widget Name
mkButton ScenarioConfigPanelFocusable
name Text
label =
    forall n. Ord n => n -> Widget n -> Widget n
clickable (ScenarioConfigPanel -> Name
ScenarioConfigControl forall a b. (a -> b) -> a -> b
$ ScenarioConfigPanelFocusable -> ScenarioConfigPanel
ScenarioConfigPanelControl ScenarioConfigPanelFocusable
name)
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {n}. ScenarioConfigPanelFocusable -> Widget n -> Widget n
highlightIfFocused ScenarioConfigPanelFocusable
name
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
boldAttr
      forall a b. (a -> b) -> a -> b
$ forall n. Text -> Widget n
txt Text
label

  mkSeedEditorWidget :: Widget Name
mkSeedEditorWidget =
    forall n. Int -> Widget n -> Widget n
hLimit Int
10 forall a b. (a -> b) -> a -> b
$
      forall n. AttrName -> AttrName -> Widget n -> Widget n
overrideAttr AttrName
E.editFocusedAttr AttrName
customEditFocusedAttr forall a b. (a -> b) -> a -> b
$
        forall n t.
(Ord n, Show n, Monoid t, TextWidth t, GenericTextZipper t) =>
([t] -> Widget n) -> Bool -> Editor t n -> Widget n
renderEditor (forall n. Text -> Widget n
txt forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat) (ScenarioConfigPanelFocusable -> Bool
isFocused ScenarioConfigPanelFocusable
SeedSelector) Editor Text Name
seedEditor
  seedEntryWidget :: Widget Name
seedEntryWidget = case forall code (f :: * -> *).
ParameterizableLaunchParams code f -> f (Maybe Int)
seedVal EditingLaunchParams
launchParams of
    Left Text
_ -> Widget Name
mkSeedEditorWidget
    Right Maybe Int
x -> forall {a}. Show a => Maybe a -> Widget Name
mkSeedEntryWidget Maybe Int
x

  scenarioSeedText :: String
scenarioSeedText = forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"random" forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Scenario (Maybe Int)
scenarioSeed forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe ScenarioInfoPair
displayedFor
  mkSeedEntryWidget :: Maybe a -> Widget Name
mkSeedEntryWidget Maybe a
seedEntryContent =
    if ScenarioConfigPanelFocusable -> Bool
isFocused ScenarioConfigPanelFocusable
SeedSelector
      then Widget Name
mkSeedEditorWidget
      else case Maybe a
seedEntryContent of
        Just a
x -> forall n. String -> Widget n
str forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show a
x
        Maybe a
Nothing ->
          forall n. AttrName -> Widget n -> Widget n
withDefAttr AttrName
dimAttr forall a b. (a -> b) -> a -> b
$
            forall n. Text -> Widget n
txt forall a b. (a -> b) -> a -> b
$
              [Text] -> Text
T.unwords
                [ Text
"scenario default"
                , Text -> Text
parens forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
scenarioSeedText
                ]

  unspecifiedFileMessage :: Widget n
unspecifiedFileMessage =
    if ScenarioConfigPanelFocusable -> Bool
isFocused ScenarioConfigPanelFocusable
ScriptSelector
      then forall n. String -> Widget n
str String
"<[Enter] to select>"
      else forall n. AttrName -> Widget n -> Widget n
withDefAttr AttrName
dimAttr forall a b. (a -> b) -> a -> b
$ forall n. String -> Widget n
str String
"<none>"

  fileEntryWidget :: Widget Name
fileEntryWidget = case forall code (f :: * -> *).
ParameterizableLaunchParams code f -> f (Maybe code)
initialCode EditingLaunchParams
launchParams of
    Left Text
_ -> forall n. String -> Widget n
str String
"<invalid>"
    Right Maybe CodeToRun
maybeFilepath ->
      forall b a. b -> (a -> b) -> Maybe a -> b
maybe
        forall {n}. Widget n
unspecifiedFileMessage
        (EllipsisSide -> Text -> Widget Name
withEllipsis EllipsisSide
Beginning forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack)
        (CodeToRun -> Maybe String
getRunCodePath forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe CodeToRun
maybeFilepath)

  panelWidget :: Widget Name
panelWidget =
    forall n. Widget n -> Widget n
centerLayer
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Widget n -> Widget n -> Widget n
borderWithLabel (forall n. String -> Widget n
str String
" Configure scenario launch ")
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Int -> Widget n -> Widget n
hLimit Int
60
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Int -> Widget n -> Widget n
padAll Int
1
      forall a b. (a -> b) -> a -> b
$ forall n. [Widget n] -> Widget n
vBox [Widget Name]
widgetMembers
   where
    startButton :: Widget Name
startButton =
      forall n. Widget n -> Widget n
hCenter forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScenarioConfigPanelFocusable -> Text -> Widget Name
mkButton ScenarioConfigPanelFocusable
StartGameButton forall a b. (a -> b) -> a -> b
$
        [Text] -> Text
T.unwords
          [ Text
">>"
          , Text
"Launch with these settings"
          , Text
"<<"
          ]

    widgetMembers :: [Widget Name]
widgetMembers =
      [ Widget Name
controlsBox
      , forall {n}. Widget n
infoBox
      , if forall a b. Either a b -> Bool
isRight Either Text ValidatedLaunchParams
validatedOptions then Widget Name
startButton else forall {n}. Widget n
emptyWidget
      ]

    formatInfo :: Text -> Text -> Widget n
formatInfo Text
header Text
content =
      forall n. [Widget n] -> Widget n
hBox
        [ forall n. Padding -> Widget n -> Widget n
padLeft (Int -> Padding
Pad Int
6) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
boldAttr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Text -> Widget n
txt forall a b. (a -> b) -> a -> b
$ Text -> Text
brackets Text
header
        , forall n. Padding -> Widget n -> Widget n
padLeft (Int -> Padding
Pad Int
1) forall a b. (a -> b) -> a -> b
$ forall n. Text -> Widget n
txtWrap Text
content
        ]

    infoContent :: Widget n
infoContent = case Either Text ValidatedLaunchParams
validatedOptions of
      Left Text
errmsg -> forall n. AttrName -> Widget n -> Widget n
withDefAttr AttrName
BF.invalidFormInputAttr forall a b. (a -> b) -> a -> b
$ forall {n}. Text -> Text -> Widget n
formatInfo Text
"Error" Text
errmsg
      Right ValidatedLaunchParams
_ -> case ScenarioConfigPanelFocusable -> Maybe Text
optionDescription forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe ScenarioConfigPanelFocusable
getFocusedConfigPanel of
        Just Text
desc -> forall n. AttrName -> Widget n -> Widget n
withDefAttr AttrName
dimAttr forall a b. (a -> b) -> a -> b
$ forall {n}. Text -> Text -> Widget n
formatInfo Text
"Info" Text
desc
        Maybe Text
Nothing -> forall n. String -> Widget n
str String
" "

    infoBox :: Widget n
infoBox =
      forall n. Int -> Widget n -> Widget n
vLimit Int
4
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Padding -> Widget n -> Widget n
padBottom Padding
Max
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Padding -> Widget n -> Widget n
padRight (Int -> Padding
Pad Int
2)
        forall a b. (a -> b) -> a -> b
$ forall {n}. Widget n
infoContent

    padControl :: ScenarioConfigPanelFocusable -> Text -> Widget Name -> Widget Name
padControl ScenarioConfigPanelFocusable
widgetName Text
label Widget Name
widgetObj =
      forall n. Padding -> Widget n -> Widget n
padBottom (Int -> Padding
Pad Int
1) forall a b. (a -> b) -> a -> b
$
        forall n. Padding -> Widget n -> Widget n
padLeft (Int -> Padding
Pad Int
2) forall a b. (a -> b) -> a -> b
$
          forall n. [Widget n] -> Widget n
hBox
            [ ScenarioConfigPanelFocusable -> Text -> Widget Name
mkButton ScenarioConfigPanelFocusable
widgetName (Text
label forall a. Semigroup a => a -> a -> a
<> Text
": ")
            , Widget Name
widgetObj
            ]

    controlsBox :: Widget Name
controlsBox =
      forall n. [Widget n] -> Widget n
vBox
        [ ScenarioConfigPanelFocusable -> Text -> Widget Name -> Widget Name
padControl ScenarioConfigPanelFocusable
ScriptSelector Text
"Script" Widget Name
fileEntryWidget
        , ScenarioConfigPanelFocusable -> Text -> Widget Name -> Widget Name
padControl ScenarioConfigPanelFocusable
SeedSelector Text
"Seed" Widget Name
seedEntryWidget
        ]