{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE ViewPatterns #-}

-- |
-- SPDX-License-Identifier: BSD-3-Clause
--
-- Application state for the @brick@-based Swarm TUI.
module Swarm.TUI.Model (
  -- * Custom UI label types
  -- $uilabel
  AppEvent (..),
  WebCommand (..),
  FocusablePanel (..),
  Name (..),

  -- * Menus and dialogs
  ModalType (..),
  ScenarioOutcome (..),
  Button (..),
  ButtonAction (..),
  Modal (..),
  modalType,
  modalDialog,
  MainMenuEntry (..),
  mainMenu,
  Menu (..),
  _NewGameMenu,
  mkScenarioList,
  mkNewGameMenu,

  -- * UI state

  -- ** REPL
  REPLHistItem (..),
  replItemText,
  isREPLEntry,
  getREPLEntry,
  REPLHistory,
  replIndex,
  replLength,
  replSeq,
  newREPLHistory,
  addREPLItem,
  restartREPLHistory,
  getLatestREPLHistoryItems,
  moveReplHistIndex,
  getCurrentItemText,
  replIndexIsAtInput,
  TimeDir (..),

  -- ** Prompt utils
  REPLPrompt (..),
  removeEntry,

  -- ** Inventory
  InventoryListEntry (..),
  _Separator,
  _InventoryEntry,
  _EquippedEntry,

  -- *** REPL Panel Model
  REPLState,
  ReplControlMode (..),
  replPromptType,
  replPromptEditor,
  replPromptText,
  replValid,
  replLast,
  replType,
  replControlMode,
  replHistory,
  newREPLEditor,

  -- ** Updating
  populateInventoryList,
  infoScroll,
  modalScroll,
  replScroll,

  -- * Runtime state
  RuntimeState,
  webPort,
  upstreamRelease,
  eventLog,
  worlds,
  scenarios,
  stdEntityMap,
  stdRecipes,
  appData,
  nameParts,

  -- ** Utility
  logEvent,
  mkGameStateConfig,

  -- * App state
  AppState (AppState),
  gameState,
  uiState,
  runtimeState,

  -- ** Initialization
  AppOpts (..),
  defaultAppOpts,
  Seed,

  -- *** Re-exported types used in options
  ColorMode (..),

  -- ** Utility
  topContext,
  focusedItem,
  focusedEntity,
  nextScenario,
  initRuntimeState,
) where

import Brick
import Brick.Widgets.List qualified as BL
import Control.Effect.Accum
import Control.Effect.Lift
import Control.Effect.Throw
import Control.Lens hiding (from, (<.>))
import Control.Monad ((>=>))
import Control.Monad.State (MonadState)
import Data.List (findIndex)
import Data.List.NonEmpty (NonEmpty (..))
import Data.Map (Map)
import Data.Maybe (fromMaybe)
import Data.Sequence (Seq)
import Data.Text (Text)
import Data.Vector qualified as V
import GitHash (GitInfo)
import Graphics.Vty (ColorMode (..))
import Network.Wai.Handler.Warp (Port)
import Swarm.Game.CESK (TickNumber (..))
import Swarm.Game.Entity as E
import Swarm.Game.Failure
import Swarm.Game.Recipe (Recipe, loadRecipes)
import Swarm.Game.ResourceLoading (NameGenerator, initNameGenerator, readAppData)
import Swarm.Game.Robot
import Swarm.Game.Scenario.Status
import Swarm.Game.ScenarioInfo (ScenarioCollection, loadScenarios, _SISingle)
import Swarm.Game.State
import Swarm.Game.World.Load (loadWorlds)
import Swarm.Game.World.Typecheck (WorldMap)
import Swarm.Log
import Swarm.TUI.Inventory.Sorting
import Swarm.TUI.Model.Menu
import Swarm.TUI.Model.Name
import Swarm.TUI.Model.Repl
import Swarm.TUI.Model.UI
import Swarm.Util.Lens (makeLensesNoSigs)
import Swarm.Version (NewReleaseFailure (NoMainUpstreamRelease))
import Text.Fuzzy qualified as Fuzzy

------------------------------------------------------------
-- Custom UI label types
------------------------------------------------------------

-- $uilabel These types are used as parameters to various @brick@
-- types.

newtype WebCommand = RunWebCode Text
  deriving (Int -> WebCommand -> ShowS
[WebCommand] -> ShowS
WebCommand -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WebCommand] -> ShowS
$cshowList :: [WebCommand] -> ShowS
show :: WebCommand -> String
$cshow :: WebCommand -> String
showsPrec :: Int -> WebCommand -> ShowS
$cshowsPrec :: Int -> WebCommand -> ShowS
Show)

-- | 'Swarm.TUI.Model.AppEvent' represents a type for custom event types our app can
--   receive. The primary custom event 'Frame' is sent by a separate thread as fast as
--   it can, telling the TUI to render a new frame.
data AppEvent
  = Frame
  | Web WebCommand
  | UpstreamVersion (Either NewReleaseFailure String)
  deriving (Int -> AppEvent -> ShowS
[AppEvent] -> ShowS
AppEvent -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AppEvent] -> ShowS
$cshowList :: [AppEvent] -> ShowS
show :: AppEvent -> String
$cshow :: AppEvent -> String
showsPrec :: Int -> AppEvent -> ShowS
$cshowsPrec :: Int -> AppEvent -> ShowS
Show)

infoScroll :: ViewportScroll Name
infoScroll :: ViewportScroll Name
infoScroll = forall n. n -> ViewportScroll n
viewportScroll Name
InfoViewport

modalScroll :: ViewportScroll Name
modalScroll :: ViewportScroll Name
modalScroll = forall n. n -> ViewportScroll n
viewportScroll Name
ModalViewport

replScroll :: ViewportScroll Name
replScroll :: ViewportScroll Name
replScroll = forall n. n -> ViewportScroll n
viewportScroll Name
REPLViewport

-- ----------------------------------------------------------------------------
--                                Runtime state                              --
-- ----------------------------------------------------------------------------

data RuntimeState = RuntimeState
  { RuntimeState -> Maybe Int
_webPort :: Maybe Port
  , RuntimeState -> Either NewReleaseFailure String
_upstreamRelease :: Either NewReleaseFailure String
  , RuntimeState -> Notifications LogEntry
_eventLog :: Notifications LogEntry
  , RuntimeState -> WorldMap
_worlds :: WorldMap
  , RuntimeState -> ScenarioCollection
_scenarios :: ScenarioCollection
  , RuntimeState -> EntityMap
_stdEntityMap :: EntityMap
  , RuntimeState -> [Recipe Entity]
_stdRecipes :: [Recipe Entity]
  , RuntimeState -> Map Text Text
_appData :: Map Text Text
  , RuntimeState -> NameGenerator
_nameParts :: NameGenerator
  }

initRuntimeState ::
  ( Has (Throw SystemFailure) sig m
  , Has (Accum (Seq SystemFailure)) sig m
  , Has (Lift IO) sig m
  ) =>
  m RuntimeState
initRuntimeState :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (Throw SystemFailure) sig m,
 Has (Accum (Seq SystemFailure)) sig m, Has (Lift IO) sig m) =>
m RuntimeState
initRuntimeState = do
  EntityMap
entities <- forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (Throw SystemFailure) sig m, Has (Lift IO) sig m) =>
m EntityMap
loadEntities
  [Recipe Entity]
recipes <- forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (Throw SystemFailure) sig m, Has (Lift IO) sig m) =>
EntityMap -> m [Recipe Entity]
loadRecipes EntityMap
entities
  WorldMap
worlds <- forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (Accum (Seq SystemFailure)) sig m, Has (Lift IO) sig m) =>
EntityMap -> m WorldMap
loadWorlds EntityMap
entities
  ScenarioCollection
scenarios <- forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (Accum (Seq SystemFailure)) sig m, Has (Lift IO) sig m) =>
EntityMap -> WorldMap -> m ScenarioCollection
loadScenarios EntityMap
entities WorldMap
worlds
  Map Text Text
appDataMap <- forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (Throw SystemFailure) sig m, Has (Lift IO) sig m) =>
m (Map Text Text)
readAppData
  NameGenerator
nameGen <- forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (Throw SystemFailure) sig m =>
Map Text Text -> m NameGenerator
initNameGenerator Map Text Text
appDataMap
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
    RuntimeState
      { _webPort :: Maybe Int
_webPort = forall a. Maybe a
Nothing
      , _upstreamRelease :: Either NewReleaseFailure String
_upstreamRelease = forall a b. a -> Either a b
Left ([String] -> NewReleaseFailure
NoMainUpstreamRelease [])
      , _eventLog :: Notifications LogEntry
_eventLog = forall a. Monoid a => a
mempty
      , _worlds :: WorldMap
_worlds = WorldMap
worlds
      , _scenarios :: ScenarioCollection
_scenarios = ScenarioCollection
scenarios
      , _stdEntityMap :: EntityMap
_stdEntityMap = EntityMap
entities
      , _stdRecipes :: [Recipe Entity]
_stdRecipes = [Recipe Entity]
recipes
      , _appData :: Map Text Text
_appData = Map Text Text
appDataMap
      , _nameParts :: NameGenerator
_nameParts = NameGenerator
nameGen
      }

makeLensesNoSigs ''RuntimeState

-- | The port on which the HTTP debug service is running.
webPort :: Lens' RuntimeState (Maybe Port)

-- | The upstream release version.
upstreamRelease :: Lens' RuntimeState (Either NewReleaseFailure String)

-- | A log of runtime events.
--
-- This logging is separate from the logging done during game-play.
-- If some error happens before a game is even selected, this is the
-- place to log it.
eventLog :: Lens' RuntimeState (Notifications LogEntry)

-- | A collection of typechecked world DSL terms that are available to
--   be used in scenario definitions.
worlds :: Lens' RuntimeState WorldMap

-- | The collection of scenarios that comes with the game.
scenarios :: Lens' RuntimeState ScenarioCollection

-- | The standard entity map loaded from disk.  Individual scenarios
--   may define additional entities which will get added to this map
--   when loading the scenario.
stdEntityMap :: Lens' RuntimeState EntityMap

-- | The standard list of recipes loaded from disk.  Individual scenarios
--   may define additional recipes which will get added to this list
--   when loading the scenario.
stdRecipes :: Lens' RuntimeState [Recipe Entity]

-- | Free-form data loaded from the @data@ directory, for things like
--   the logo, about page, tutorial story, etc.
appData :: Lens' RuntimeState (Map Text Text)

-- | Lists of words/adjectives for use in building random robot names.
nameParts :: Lens' RuntimeState NameGenerator

--------------------------------------------------
-- Utility

-- | Simply log to the runtime event log.
logEvent :: LogSource -> Severity -> Text -> Text -> Notifications LogEntry -> Notifications LogEntry
logEvent :: LogSource
-> Severity
-> Text
-> Text
-> Notifications LogEntry
-> Notifications LogEntry
logEvent LogSource
src Severity
sev Text
who Text
msg Notifications LogEntry
el =
  Notifications LogEntry
el
    forall a b. a -> (a -> b) -> b
& forall a. Lens' (Notifications a) Int
notificationsCount forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ forall a. Enum a => a -> a
succ
    forall a b. a -> (a -> b) -> b
& forall a1 a2. Lens (Notifications a1) (Notifications a2) [a1] [a2]
notificationsContent forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (LogEntry
l forall a. a -> [a] -> [a]
:)
 where
  l :: LogEntry
l = TickNumber -> LogSource -> Severity -> Text -> Text -> LogEntry
LogEntry (Int64 -> TickNumber
TickNumber Int64
0) LogSource
src Severity
sev Text
who Text
msg

-- | Create a 'GameStateConfig' record from the 'RuntimeState'.
mkGameStateConfig :: RuntimeState -> GameStateConfig
mkGameStateConfig :: RuntimeState -> GameStateConfig
mkGameStateConfig RuntimeState
rs =
  GameStateConfig
    { initNameParts :: NameGenerator
initNameParts = RuntimeState
rs forall s a. s -> Getting a s a -> a
^. Lens' RuntimeState NameGenerator
nameParts
    , initEntities :: EntityMap
initEntities = RuntimeState
rs forall s a. s -> Getting a s a -> a
^. Lens' RuntimeState EntityMap
stdEntityMap
    , initRecipes :: [Recipe Entity]
initRecipes = RuntimeState
rs forall s a. s -> Getting a s a -> a
^. Lens' RuntimeState [Recipe Entity]
stdRecipes
    , initWorldMap :: WorldMap
initWorldMap = RuntimeState
rs forall s a. s -> Getting a s a -> a
^. Lens' RuntimeState WorldMap
worlds
    }

-- ----------------------------------------------------------------------------
--                                   APPSTATE                                --
-- ----------------------------------------------------------------------------

-- | The 'AppState' just stores together the other states.
--
-- This is so you can use a smaller state when e.g. writing some game logic
-- or updating the UI. Also consider that GameState can change when loading
-- a new scenario - if the state should persist games, use RuntimeState.
data AppState = AppState
  { AppState -> GameState
_gameState :: GameState
  , AppState -> UIState
_uiState :: UIState
  , AppState -> RuntimeState
_runtimeState :: RuntimeState
  }

--------------------------------------------------
-- Lenses for AppState

makeLensesNoSigs ''AppState

-- | The 'GameState' record.
gameState :: Lens' AppState GameState

-- | The 'UIState' record.
uiState :: Lens' AppState UIState

-- | The 'RuntimeState' record
runtimeState :: Lens' AppState RuntimeState

--------------------------------------------------
-- Utility functions

-- | Get the currently focused 'InventoryListEntry' from the robot
--   info panel (if any).
focusedItem :: AppState -> Maybe InventoryListEntry
focusedItem :: AppState -> Maybe InventoryListEntry
focusedItem AppState
s = do
  GenericList Name Vector InventoryListEntry
list <- AppState
s forall s a. s -> Getting (First a) s a -> Maybe a
^? Lens' AppState UIState
uiState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens'
  UIState (Maybe (Int, GenericList Name Vector InventoryListEntry))
uiInventory forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Prism (Maybe a) (Maybe b) a b
_Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s t a b. Field2 s t a b => Lens s t a b
_2
  (Int
_, InventoryListEntry
entry) <- forall (t :: * -> *) e n.
(Splittable t, Traversable t, Semigroup (t e)) =>
GenericList n t e -> Maybe (Int, e)
BL.listSelectedElement GenericList Name Vector InventoryListEntry
list
  forall (m :: * -> *) a. Monad m => a -> m a
return InventoryListEntry
entry

-- | Get the currently focused entity from the robot info panel (if
--   any).  This is just like 'focusedItem' but forgets the
--   distinction between plain inventory items and equipped devices.
focusedEntity :: AppState -> Maybe Entity
focusedEntity :: AppState -> Maybe Entity
focusedEntity =
  AppState -> Maybe InventoryListEntry
focusedItem forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> \case
    Separator Text
_ -> forall a. Maybe a
Nothing
    InventoryEntry Int
_ Entity
e -> forall a. a -> Maybe a
Just Entity
e
    EquippedEntry Entity
e -> forall a. a -> Maybe a
Just Entity
e

------------------------------------------------------------
-- Functions for updating the UI state
------------------------------------------------------------

-- | Given the focused robot, populate the UI inventory list in the info
--   panel with information about its inventory.
populateInventoryList :: (MonadState UIState m) => Maybe Robot -> m ()
populateInventoryList :: forall (m :: * -> *). MonadState UIState m => Maybe Robot -> m ()
populateInventoryList Maybe Robot
Nothing = Lens'
  UIState (Maybe (Int, GenericList Name Vector InventoryListEntry))
uiInventory forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= forall a. Maybe a
Nothing
populateInventoryList (Just Robot
r) = do
  Maybe (GenericList Name Vector InventoryListEntry)
mList <- forall s (m :: * -> *) a.
MonadState s m =>
Getting (First a) s a -> m (Maybe a)
preuse (Lens'
  UIState (Maybe (Int, GenericList Name Vector InventoryListEntry))
uiInventory forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Prism (Maybe a) (Maybe b) a b
_Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s t a b. Field2 s t a b => Lens s t a b
_2)
  Bool
showZero <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Lens' UIState Bool
uiShowZero
  InventorySortOptions
sortOptions <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Lens' UIState InventorySortOptions
uiInventorySort
  Maybe Text
search <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Lens' UIState (Maybe Text)
uiInventorySearch
  let mkInvEntry :: (Int, Entity) -> InventoryListEntry
mkInvEntry (Int
n, Entity
e) = Int -> Entity -> InventoryListEntry
InventoryEntry Int
n Entity
e
      mkInstEntry :: (a, Entity) -> InventoryListEntry
mkInstEntry (a
_, Entity
e) = Entity -> InventoryListEntry
EquippedEntry Entity
e
      itemList :: Bool
-> ((Int, Entity) -> InventoryListEntry)
-> Text
-> Inventory
-> [InventoryListEntry]
itemList Bool
isInventoryDisplay (Int, Entity) -> InventoryListEntry
mk Text
label =
        (\case [] -> []; [InventoryListEntry]
xs -> Text -> InventoryListEntry
Separator Text
label forall a. a -> [a] -> [a]
: [InventoryListEntry]
xs)
          forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (Int, Entity) -> InventoryListEntry
mk
          forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a.
Ord a =>
InventorySortOptions -> [(a, Entity)] -> [(a, Entity)]
sortInventory InventorySortOptions
sortOptions
          forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool -> Bool
(&&) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int, Entity) -> Bool
matchesSearch forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall {a}. (Ord a, Num a) => (a, Entity) -> Bool
shouldDisplay)
          forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inventory -> [(Int, Entity)]
elems
       where
        -- Display items if we have a positive number of them, or they
        -- aren't an equipped device.  In other words we don't need to
        -- display equipped devices twice unless we actually have some
        -- in our inventory in addition to being equipped.
        shouldDisplay :: (a, Entity) -> Bool
shouldDisplay (a
n, Entity
e) =
          a
n forall a. Ord a => a -> a -> Bool
> a
0
            Bool -> Bool -> Bool
|| Bool
isInventoryDisplay
              Bool -> Bool -> Bool
&& Bool
showZero
              Bool -> Bool -> Bool
&& Bool -> Bool
not ((Robot
r forall s a. s -> Getting a s a -> a
^. Lens' Robot Inventory
equippedDevices) Inventory -> Entity -> Bool
`E.contains` Entity
e)

      matchesSearch :: (Count, Entity) -> Bool
      matchesSearch :: (Int, Entity) -> Bool
matchesSearch (Int
_, Entity
e) = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a b. a -> b -> a
const Bool
True) forall s. TextualMonoid s => s -> s -> Bool
Fuzzy.test Maybe Text
search (Entity
e forall s a. s -> Getting a s a -> a
^. Lens' Entity Text
E.entityName)

      items :: [InventoryListEntry]
items =
        (Robot
r forall s a. s -> Getting a s a -> a
^. Lens' Robot Inventory
robotInventory forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to (Bool
-> ((Int, Entity) -> InventoryListEntry)
-> Text
-> Inventory
-> [InventoryListEntry]
itemList Bool
True (Int, Entity) -> InventoryListEntry
mkInvEntry Text
"Compendium"))
          forall a. [a] -> [a] -> [a]
++ (Robot
r forall s a. s -> Getting a s a -> a
^. Lens' Robot Inventory
equippedDevices forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to (Bool
-> ((Int, Entity) -> InventoryListEntry)
-> Text
-> Inventory
-> [InventoryListEntry]
itemList Bool
False forall {a}. (a, Entity) -> InventoryListEntry
mkInstEntry Text
"Equipped devices"))

      -- Attempt to keep the selected element steady.
      sel :: Maybe (Int, InventoryListEntry)
sel = Maybe (GenericList Name Vector InventoryListEntry)
mList forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (t :: * -> *) e n.
(Splittable t, Traversable t, Semigroup (t e)) =>
GenericList n t e -> Maybe (Int, e)
BL.listSelectedElement -- Get the currently selected element+index.
      idx :: Int
idx = case Maybe (Int, InventoryListEntry)
sel of
        -- If there is no currently selected element, just focus on
        -- index 1 (not 0, to avoid the separator).
        Maybe (Int, InventoryListEntry)
Nothing -> Int
1
        -- Otherwise, try to find the same entry in the list;
        -- if it's not there, keep the index the same.
        Just (Int
selIdx, InventoryEntry Int
_ Entity
e) ->
          forall a. a -> Maybe a -> a
fromMaybe Int
selIdx (forall a. (a -> Bool) -> [a] -> Maybe Int
findIndex ((forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just Entity
e) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview (Prism' InventoryListEntry (Int, Entity)
_InventoryEntry forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s t a b. Field2 s t a b => Lens s t a b
_2)) [InventoryListEntry]
items)
        Just (Int
selIdx, EquippedEntry Entity
e) ->
          forall a. a -> Maybe a -> a
fromMaybe Int
selIdx (forall a. (a -> Bool) -> [a] -> Maybe Int
findIndex ((forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just Entity
e) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview Prism' InventoryListEntry Entity
_EquippedEntry) [InventoryListEntry]
items)
        Just (Int
selIdx, InventoryListEntry
_) -> Int
selIdx

      -- Create the new list, focused at the desired index.
      lst :: GenericList Name Vector InventoryListEntry
lst = forall (t :: * -> *) n e.
(Foldable t, Splittable t) =>
Int -> GenericList n t e -> GenericList n t e
BL.listMoveTo Int
idx forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) n e.
Foldable t =>
n -> t e -> Int -> GenericList n t e
BL.list Name
InventoryList (forall a. [a] -> Vector a
V.fromList [InventoryListEntry]
items) Int
1

  -- Finally, populate the newly created list in the UI, and remember
  -- the hash of the current robot.
  Lens'
  UIState (Maybe (Int, GenericList Name Vector InventoryListEntry))
uiInventory forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= forall a. a -> Maybe a
Just (Robot
r forall s a. s -> Getting a s a -> a
^. Getter Robot Int
inventoryHash, GenericList Name Vector InventoryListEntry
lst)

------------------------------------------------------------
-- App state (= UI state + game state) initialization
------------------------------------------------------------

-- | Command-line options for configuring the app.
data AppOpts = AppOpts
  { AppOpts -> Maybe Int
userSeed :: Maybe Seed
  -- ^ Explicit seed chosen by the user.
  , AppOpts -> Maybe String
userScenario :: Maybe FilePath
  -- ^ Scenario the user wants to play.
  , AppOpts -> Maybe String
scriptToRun :: Maybe FilePath
  -- ^ Code to be run on base.
  , AppOpts -> Bool
autoPlay :: Bool
  -- ^ Automatically run the solution defined in the scenario file
  , AppOpts -> Int
speed :: Int
  -- ^ Initial game speed (logarithm)
  , AppOpts -> Bool
cheatMode :: Bool
  -- ^ Should cheat mode be enabled?
  , AppOpts -> Maybe ColorMode
colorMode :: Maybe ColorMode
  -- ^ What colour mode should be used?
  , AppOpts -> Maybe Int
userWebPort :: Maybe Port
  -- ^ Explicit port on which to run the web API
  , AppOpts -> Maybe GitInfo
repoGitInfo :: Maybe GitInfo
  -- ^ Information about the Git repository (not present in release).
  }

-- | A default/empty 'AppOpts' record.
defaultAppOpts :: AppOpts
defaultAppOpts :: AppOpts
defaultAppOpts =
  AppOpts
    { userSeed :: Maybe Int
userSeed = forall a. Maybe a
Nothing
    , userScenario :: Maybe String
userScenario = forall a. Maybe a
Nothing
    , scriptToRun :: Maybe String
scriptToRun = forall a. Maybe a
Nothing
    , autoPlay :: Bool
autoPlay = Bool
False
    , speed :: Int
speed = Int
defaultInitLgTicksPerSecond
    , cheatMode :: Bool
cheatMode = Bool
False
    , colorMode :: Maybe ColorMode
colorMode = forall a. Maybe a
Nothing
    , userWebPort :: Maybe Int
userWebPort = forall a. Maybe a
Nothing
    , repoGitInfo :: Maybe GitInfo
repoGitInfo = forall a. Maybe a
Nothing
    }

-- | Extract the scenario which would come next in the menu from the
--   currently selected scenario (if any).  Can return @Nothing@ if
--   either we are not in the @NewGameMenu@, or the current scenario
--   is the last among its siblings.
nextScenario :: Menu -> Maybe ScenarioInfoPair
nextScenario :: Menu -> Maybe ScenarioInfoPair
nextScenario = \case
  NewGameMenu (List Name ScenarioItem
curMenu :| [List Name ScenarioItem]
_) ->
    let nextMenuList :: List Name ScenarioItem
nextMenuList = forall (t :: * -> *) n e.
(Foldable t, Splittable t) =>
GenericList n t e -> GenericList n t e
BL.listMoveDown List Name ScenarioItem
curMenu
        isLastScenario :: Bool
isLastScenario = forall n (t :: * -> *) e. GenericList n t e -> Maybe Int
BL.listSelected List Name ScenarioItem
curMenu forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just (forall (t :: * -> *) a. Foldable t => t a -> Int
length (forall n (t :: * -> *) e. GenericList n t e -> t e
BL.listElements List Name ScenarioItem
curMenu) forall a. Num a => a -> a -> a
- Int
1)
     in if Bool
isLastScenario
          then forall a. Maybe a
Nothing
          else forall (t :: * -> *) e n.
(Splittable t, Traversable t, Semigroup (t e)) =>
GenericList n t e -> Maybe (Int, e)
BL.listSelectedElement List Name ScenarioItem
nextMenuList forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview Prism' ScenarioItem ScenarioInfoPair
_SISingle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd
  Menu
_ -> forall a. Maybe a
Nothing

-- | Context for the REPL commands to execute in. Contains the base
--   robot context plus the `it` variable that refer to the previously
--   computed values. (Note that `it{n}` variables are set in the
--   base robot context; we only set `it` here because it's so transient)
topContext :: AppState -> RobotContext
topContext :: AppState -> RobotContext
topContext AppState
s = RobotContext
ctxPossiblyWithIt
 where
  ctx :: RobotContext
ctx = forall a. a -> Maybe a -> a
fromMaybe RobotContext
emptyRobotContext forall a b. (a -> b) -> a -> b
$ AppState
s forall s a. s -> Getting (First a) s a -> Maybe a
^? Lens' AppState GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Traversal' GameState Robot
baseRobot forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Robot RobotContext
robotContext

  ctxPossiblyWithIt :: RobotContext
ctxPossiblyWithIt = case AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState GameState
gameState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GameState GameControls
gameControls forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GameControls REPLStatus
replStatus of
    REPLDone (Just Typed Value
p) -> RobotContext
ctx forall a b. a -> (a -> b) -> b
& forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Text
"it" forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Typed Value
p
    REPLStatus
_ -> RobotContext
ctx