{-# 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,

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

  -- ** 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.Array (Array, listArray)
import Data.List (findIndex)
import Data.List.NonEmpty (NonEmpty (..))
import Data.Map (Map)
import Data.Map qualified as M
import Data.Maybe (fromMaybe)
import Data.Sequence (Seq)
import Data.Text (Text)
import Data.Text qualified as T (lines)
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 (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.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 System.FilePath ((<.>))
import Text.Fuzzy qualified as Fuzzy
import Witch (into)

------------------------------------------------------------
-- 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

-- ----------------------------------------------------------------------------
--                                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 -> Array Int Text
_stdAdjList :: Array Int Text
  , RuntimeState -> Array Int Text
_stdNameList :: Array Int Text
  }

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

  let getDataLines :: Text -> m [Text]
getDataLines Text
f = case forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
f Map Text Text
appDataMap of
        Maybe Text
Nothing ->
          forall e (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Throw e) sig m =>
e -> m a
throwError forall a b. (a -> b) -> a -> b
$
            Asset -> String -> LoadingFailure -> SystemFailure
AssetNotLoaded (AssetData -> Asset
Data AssetData
NameGeneration) (forall target source. From source target => source -> target
into @FilePath Text
f String -> ShowS
<.> String
".txt") (Entry -> LoadingFailure
DoesNotExist Entry
File)
        Just Text
content -> forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
tail forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
T.lines forall a b. (a -> b) -> a -> b
$ Text
content
  [Text]
adjs <- forall {sig :: (* -> *) -> * -> *} {m :: * -> *}.
(Member (Throw SystemFailure) sig, Algebra sig m) =>
Text -> m [Text]
getDataLines Text
"adjectives"
  [Text]
names <- forall {sig :: (* -> *) -> * -> *} {m :: * -> *}.
(Member (Throw SystemFailure) sig, Algebra sig m) =>
Text -> m [Text]
getDataLines Text
"names"

  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
      , _stdAdjList :: Array Int Text
_stdAdjList = forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Int
0, forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
adjs forall a. Num a => a -> a -> a
- Int
1) [Text]
adjs
      , _stdNameList :: Array Int Text
_stdNameList = forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Int
0, forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
names forall a. Num a => a -> a -> a
- Int
1) [Text]
names
      }

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)

-- | List of words for use in building random robot names.
stdAdjList :: Lens' RuntimeState (Array Int Text)

-- | List of words for use in building random robot names.
stdNameList :: Lens' RuntimeState (Array Int Text)

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

-- | Simply log to the runtime event log.
logEvent :: LogSource -> (Text, RID) -> Text -> Notifications LogEntry -> Notifications LogEntry
logEvent :: LogSource
-> (Text, Int)
-> Text
-> Notifications LogEntry
-> Notifications LogEntry
logEvent LogSource
src (Text
who, Int
rid) 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
-> Text
-> Int
-> LogLocation (Cosmic Location)
-> Text
-> LogEntry
LogEntry (Integer -> TickNumber
TickNumber Integer
0) LogSource
src Text
who Int
rid forall a. LogLocation a
Omnipresent Text
msg

-- | Create a 'GameStateConfig' record from the 'RuntimeState'.
mkGameStateConfig :: RuntimeState -> GameStateConfig
mkGameStateConfig :: RuntimeState -> GameStateConfig
mkGameStateConfig RuntimeState
rs =
  GameStateConfig
    { initAdjList :: Array Int Text
initAdjList = RuntimeState
rs forall s a. s -> Getting a s a -> a
^. Lens' RuntimeState (Array Int Text)
stdAdjList
    , initNameList :: Array Int Text
initNameList = RuntimeState
rs forall s a. s -> Getting a s a -> a
^. Lens' RuntimeState (Array Int Text)
stdNameList
    , 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 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