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

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

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

  -- ** Utility
  logEvent,
  SwarmKeyDispatcher,
  KeyEventHandlingState (KeyEventHandlingState),
  SwarmKeyDispatchers (..),
  keyConfig,
  keyDispatchers,

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

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

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

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

import Brick (EventM, ViewportScroll, viewportScroll)
import Brick.Keybindings as BK
import Brick.Widgets.List qualified as BL
import Control.Lens hiding (from, (<.>))
import Control.Monad ((>=>))
import Control.Monad.State (MonadState)
import Data.List (findIndex)
import Data.List.NonEmpty (NonEmpty (..))
import Data.Maybe (fromMaybe)
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.Entity as E
import Swarm.Game.Ingredients
import Swarm.Game.Robot
import Swarm.Game.Scenario.Status
import Swarm.Game.ScenarioInfo (_SISingle)
import Swarm.Game.State
import Swarm.Game.State.Runtime
import Swarm.Game.State.Substate
import Swarm.Game.Tick (TickNumber (..))
import Swarm.Game.World.Gen (Seed)
import Swarm.Log
import Swarm.TUI.Inventory.Sorting
import Swarm.TUI.Model.Event (SwarmEvent)
import Swarm.TUI.Model.Menu
import Swarm.TUI.Model.Name
import Swarm.TUI.Model.UI
import Swarm.Util.Lens (makeLensesNoSigs)
import Swarm.Version (NewReleaseFailure)
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
(Int -> WebCommand -> ShowS)
-> (WebCommand -> String)
-> ([WebCommand] -> ShowS)
-> Show WebCommand
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> WebCommand -> ShowS
showsPrec :: Int -> WebCommand -> ShowS
$cshow :: WebCommand -> String
show :: WebCommand -> String
$cshowList :: [WebCommand] -> ShowS
showList :: [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
(Int -> AppEvent -> ShowS)
-> (AppEvent -> String) -> ([AppEvent] -> ShowS) -> Show AppEvent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AppEvent -> ShowS
showsPrec :: Int -> AppEvent -> ShowS
$cshow :: AppEvent -> String
show :: AppEvent -> String
$cshowList :: [AppEvent] -> ShowS
showList :: [AppEvent] -> ShowS
Show)

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

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

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

--------------------------------------------------
-- 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
    Notifications LogEntry
-> (Notifications LogEntry -> Notifications LogEntry)
-> Notifications LogEntry
forall a b. a -> (a -> b) -> b
& (Int -> Identity Int)
-> Notifications LogEntry -> Identity (Notifications LogEntry)
forall a (f :: * -> *).
Functor f =>
(Int -> f Int) -> Notifications a -> f (Notifications a)
notificationsCount ((Int -> Identity Int)
 -> Notifications LogEntry -> Identity (Notifications LogEntry))
-> (Int -> Int) -> Notifications LogEntry -> Notifications LogEntry
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Int -> Int
forall a. Enum a => a -> a
succ
    Notifications LogEntry
-> (Notifications LogEntry -> Notifications LogEntry)
-> Notifications LogEntry
forall a b. a -> (a -> b) -> b
& ([LogEntry] -> Identity [LogEntry])
-> Notifications LogEntry -> Identity (Notifications LogEntry)
forall a1 a2 (f :: * -> *).
Functor f =>
([a1] -> f [a2]) -> Notifications a1 -> f (Notifications a2)
notificationsContent (([LogEntry] -> Identity [LogEntry])
 -> Notifications LogEntry -> Identity (Notifications LogEntry))
-> ([LogEntry] -> [LogEntry])
-> Notifications LogEntry
-> Notifications LogEntry
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (LogEntry
l LogEntry -> [LogEntry] -> [LogEntry]
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

data KeyEventHandlingState = KeyEventHandlingState
  { KeyEventHandlingState -> KeyConfig SwarmEvent
_keyConfig :: KeyConfig SwarmEvent
  , KeyEventHandlingState -> SwarmKeyDispatchers
_keyDispatchers :: SwarmKeyDispatchers
  }

type SwarmKeyDispatcher = KeyDispatcher SwarmEvent (EventM Name AppState)

data SwarmKeyDispatchers = SwarmKeyDispatchers
  { SwarmKeyDispatchers -> SwarmKeyDispatcher
mainGameDispatcher :: SwarmKeyDispatcher
  , SwarmKeyDispatchers -> SwarmKeyDispatcher
replDispatcher :: SwarmKeyDispatcher
  , SwarmKeyDispatchers -> SwarmKeyDispatcher
worldDispatcher :: SwarmKeyDispatcher
  , SwarmKeyDispatchers -> SwarmKeyDispatcher
robotDispatcher :: SwarmKeyDispatcher
  }

-- ----------------------------------------------------------------------------
--                                   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 -> KeyEventHandlingState
_keyEventHandling :: KeyEventHandlingState
  , AppState -> RuntimeState
_runtimeState :: RuntimeState
  }

------------------------------------------------------------
-- 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 UIInventory m) => Maybe Robot -> m ()
populateInventoryList :: forall (m :: * -> *).
MonadState UIInventory m =>
Maybe Robot -> m ()
populateInventoryList Maybe Robot
Nothing = (Maybe (Int, GenericList Name Vector InventoryListEntry)
 -> Identity
      (Maybe (Int, GenericList Name Vector InventoryListEntry)))
-> UIInventory -> Identity UIInventory
Lens'
  UIInventory
  (Maybe (Int, GenericList Name Vector InventoryListEntry))
uiInventoryList ((Maybe (Int, GenericList Name Vector InventoryListEntry)
  -> Identity
       (Maybe (Int, GenericList Name Vector InventoryListEntry)))
 -> UIInventory -> Identity UIInventory)
-> Maybe (Int, GenericList Name Vector InventoryListEntry) -> m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Maybe (Int, GenericList Name Vector InventoryListEntry)
forall a. Maybe a
Nothing
populateInventoryList (Just Robot
r) = do
  Maybe (GenericList Name Vector InventoryListEntry)
mList <- Getting
  (First (GenericList Name Vector InventoryListEntry))
  UIInventory
  (GenericList Name Vector InventoryListEntry)
-> m (Maybe (GenericList Name Vector InventoryListEntry))
forall s (m :: * -> *) a.
MonadState s m =>
Getting (First a) s a -> m (Maybe a)
preuse (Getting
   (First (GenericList Name Vector InventoryListEntry))
   UIInventory
   (GenericList Name Vector InventoryListEntry)
 -> m (Maybe (GenericList Name Vector InventoryListEntry)))
-> Getting
     (First (GenericList Name Vector InventoryListEntry))
     UIInventory
     (GenericList Name Vector InventoryListEntry)
-> m (Maybe (GenericList Name Vector InventoryListEntry))
forall a b. (a -> b) -> a -> b
$ (Maybe (Int, GenericList Name Vector InventoryListEntry)
 -> Const
      (First (GenericList Name Vector InventoryListEntry))
      (Maybe (Int, GenericList Name Vector InventoryListEntry)))
-> UIInventory
-> Const
     (First (GenericList Name Vector InventoryListEntry)) UIInventory
Lens'
  UIInventory
  (Maybe (Int, GenericList Name Vector InventoryListEntry))
uiInventoryList ((Maybe (Int, GenericList Name Vector InventoryListEntry)
  -> Const
       (First (GenericList Name Vector InventoryListEntry))
       (Maybe (Int, GenericList Name Vector InventoryListEntry)))
 -> UIInventory
 -> Const
      (First (GenericList Name Vector InventoryListEntry)) UIInventory)
-> ((GenericList Name Vector InventoryListEntry
     -> Const
          (First (GenericList Name Vector InventoryListEntry))
          (GenericList Name Vector InventoryListEntry))
    -> Maybe (Int, GenericList Name Vector InventoryListEntry)
    -> Const
         (First (GenericList Name Vector InventoryListEntry))
         (Maybe (Int, GenericList Name Vector InventoryListEntry)))
-> Getting
     (First (GenericList Name Vector InventoryListEntry))
     UIInventory
     (GenericList Name Vector InventoryListEntry)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, GenericList Name Vector InventoryListEntry)
 -> Const
      (First (GenericList Name Vector InventoryListEntry))
      (Int, GenericList Name Vector InventoryListEntry))
-> Maybe (Int, GenericList Name Vector InventoryListEntry)
-> Const
     (First (GenericList Name Vector InventoryListEntry))
     (Maybe (Int, GenericList Name Vector InventoryListEntry))
forall a b (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p a (f b) -> p (Maybe a) (f (Maybe b))
_Just (((Int, GenericList Name Vector InventoryListEntry)
  -> Const
       (First (GenericList Name Vector InventoryListEntry))
       (Int, GenericList Name Vector InventoryListEntry))
 -> Maybe (Int, GenericList Name Vector InventoryListEntry)
 -> Const
      (First (GenericList Name Vector InventoryListEntry))
      (Maybe (Int, GenericList Name Vector InventoryListEntry)))
-> ((GenericList Name Vector InventoryListEntry
     -> Const
          (First (GenericList Name Vector InventoryListEntry))
          (GenericList Name Vector InventoryListEntry))
    -> (Int, GenericList Name Vector InventoryListEntry)
    -> Const
         (First (GenericList Name Vector InventoryListEntry))
         (Int, GenericList Name Vector InventoryListEntry))
-> (GenericList Name Vector InventoryListEntry
    -> Const
         (First (GenericList Name Vector InventoryListEntry))
         (GenericList Name Vector InventoryListEntry))
-> Maybe (Int, GenericList Name Vector InventoryListEntry)
-> Const
     (First (GenericList Name Vector InventoryListEntry))
     (Maybe (Int, GenericList Name Vector InventoryListEntry))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GenericList Name Vector InventoryListEntry
 -> Const
      (First (GenericList Name Vector InventoryListEntry))
      (GenericList Name Vector InventoryListEntry))
-> (Int, GenericList Name Vector InventoryListEntry)
-> Const
     (First (GenericList Name Vector InventoryListEntry))
     (Int, GenericList Name Vector InventoryListEntry)
forall s t a b. Field2 s t a b => Lens s t a b
Lens
  (Int, GenericList Name Vector InventoryListEntry)
  (Int, GenericList Name Vector InventoryListEntry)
  (GenericList Name Vector InventoryListEntry)
  (GenericList Name Vector InventoryListEntry)
_2
  Bool
showZero <- Getting Bool UIInventory Bool -> m Bool
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting Bool UIInventory Bool
Lens' UIInventory Bool
uiShowZero
  InventorySortOptions
sortOptions <- Getting InventorySortOptions UIInventory InventorySortOptions
-> m InventorySortOptions
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting InventorySortOptions UIInventory InventorySortOptions
Lens' UIInventory InventorySortOptions
uiInventorySort
  Maybe Text
search <- Getting (Maybe Text) UIInventory (Maybe Text) -> m (Maybe Text)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting (Maybe Text) UIInventory (Maybe Text)
Lens' UIInventory (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 InventoryListEntry -> [InventoryListEntry] -> [InventoryListEntry]
forall a. a -> [a] -> [a]
: [InventoryListEntry]
xs)
          ([InventoryListEntry] -> [InventoryListEntry])
-> (Inventory -> [InventoryListEntry])
-> Inventory
-> [InventoryListEntry]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, Entity) -> InventoryListEntry)
-> [(Int, Entity)] -> [InventoryListEntry]
forall a b. (a -> b) -> [a] -> [b]
map (Int, Entity) -> InventoryListEntry
mk
          ([(Int, Entity)] -> [InventoryListEntry])
-> (Inventory -> [(Int, Entity)])
-> Inventory
-> [InventoryListEntry]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InventorySortOptions -> [(Int, Entity)] -> [(Int, Entity)]
forall a.
Ord a =>
InventorySortOptions -> [(a, Entity)] -> [(a, Entity)]
sortInventory InventorySortOptions
sortOptions
          ([(Int, Entity)] -> [(Int, Entity)])
-> (Inventory -> [(Int, Entity)]) -> Inventory -> [(Int, Entity)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, Entity) -> Bool) -> [(Int, Entity)] -> [(Int, Entity)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool -> Bool
(&&) (Bool -> Bool -> Bool)
-> ((Int, Entity) -> Bool) -> (Int, Entity) -> Bool -> Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int, Entity) -> Bool
matchesSearch ((Int, Entity) -> Bool -> Bool)
-> ((Int, Entity) -> Bool) -> (Int, Entity) -> Bool
forall a b.
((Int, Entity) -> a -> b)
-> ((Int, Entity) -> a) -> (Int, Entity) -> b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Int, Entity) -> Bool
forall {a}. (Ord a, Num a) => (a, Entity) -> Bool
shouldDisplay)
          ([(Int, Entity)] -> [(Int, Entity)])
-> (Inventory -> [(Int, Entity)]) -> Inventory -> [(Int, Entity)]
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 a -> a -> Bool
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 Robot -> Getting Inventory Robot Inventory -> Inventory
forall s a. s -> Getting a s a -> a
^. Getting Inventory Robot Inventory
Lens' Robot Inventory
equippedDevices) Inventory -> Entity -> Bool
`E.contains` Entity
e)

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

      items :: [InventoryListEntry]
items =
        (Robot
r Robot
-> Getting [InventoryListEntry] Robot [InventoryListEntry]
-> [InventoryListEntry]
forall s a. s -> Getting a s a -> a
^. (Inventory -> Const [InventoryListEntry] Inventory)
-> Robot -> Const [InventoryListEntry] Robot
Lens' Robot Inventory
robotInventory ((Inventory -> Const [InventoryListEntry] Inventory)
 -> Robot -> Const [InventoryListEntry] Robot)
-> (([InventoryListEntry]
     -> Const [InventoryListEntry] [InventoryListEntry])
    -> Inventory -> Const [InventoryListEntry] Inventory)
-> Getting [InventoryListEntry] Robot [InventoryListEntry]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Inventory -> [InventoryListEntry])
-> ([InventoryListEntry]
    -> Const [InventoryListEntry] [InventoryListEntry])
-> Inventory
-> Const [InventoryListEntry] Inventory
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"))
          [InventoryListEntry]
-> [InventoryListEntry] -> [InventoryListEntry]
forall a. [a] -> [a] -> [a]
++ (Robot
r Robot
-> Getting [InventoryListEntry] Robot [InventoryListEntry]
-> [InventoryListEntry]
forall s a. s -> Getting a s a -> a
^. (Inventory -> Const [InventoryListEntry] Inventory)
-> Robot -> Const [InventoryListEntry] Robot
Lens' Robot Inventory
equippedDevices ((Inventory -> Const [InventoryListEntry] Inventory)
 -> Robot -> Const [InventoryListEntry] Robot)
-> (([InventoryListEntry]
     -> Const [InventoryListEntry] [InventoryListEntry])
    -> Inventory -> Const [InventoryListEntry] Inventory)
-> Getting [InventoryListEntry] Robot [InventoryListEntry]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Inventory -> [InventoryListEntry])
-> ([InventoryListEntry]
    -> Const [InventoryListEntry] [InventoryListEntry])
-> Inventory
-> Const [InventoryListEntry] Inventory
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 (Int, Entity) -> InventoryListEntry
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 Maybe (GenericList Name Vector InventoryListEntry)
-> (GenericList Name Vector InventoryListEntry
    -> Maybe (Int, InventoryListEntry))
-> Maybe (Int, InventoryListEntry)
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= GenericList Name Vector InventoryListEntry
-> Maybe (Int, InventoryListEntry)
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) ->
          Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
selIdx ((InventoryListEntry -> Bool) -> [InventoryListEntry] -> Maybe Int
forall a. (a -> Bool) -> [a] -> Maybe Int
findIndex ((Maybe Entity -> Maybe Entity -> Bool
forall a. Eq a => a -> a -> Bool
== Entity -> Maybe Entity
forall a. a -> Maybe a
Just Entity
e) (Maybe Entity -> Bool)
-> (InventoryListEntry -> Maybe Entity)
-> InventoryListEntry
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (First Entity) InventoryListEntry Entity
-> InventoryListEntry -> Maybe Entity
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview (((Int, Entity) -> Const (First Entity) (Int, Entity))
-> InventoryListEntry -> Const (First Entity) InventoryListEntry
Prism' InventoryListEntry (Int, Entity)
_InventoryEntry (((Int, Entity) -> Const (First Entity) (Int, Entity))
 -> InventoryListEntry -> Const (First Entity) InventoryListEntry)
-> ((Entity -> Const (First Entity) Entity)
    -> (Int, Entity) -> Const (First Entity) (Int, Entity))
-> Getting (First Entity) InventoryListEntry Entity
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Entity -> Const (First Entity) Entity)
-> (Int, Entity) -> Const (First Entity) (Int, Entity)
forall s t a b. Field2 s t a b => Lens s t a b
Lens (Int, Entity) (Int, Entity) Entity Entity
_2)) [InventoryListEntry]
items)
        Just (Int
selIdx, EquippedEntry Entity
e) ->
          Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
selIdx ((InventoryListEntry -> Bool) -> [InventoryListEntry] -> Maybe Int
forall a. (a -> Bool) -> [a] -> Maybe Int
findIndex ((Maybe Entity -> Maybe Entity -> Bool
forall a. Eq a => a -> a -> Bool
== Entity -> Maybe Entity
forall a. a -> Maybe a
Just Entity
e) (Maybe Entity -> Bool)
-> (InventoryListEntry -> Maybe Entity)
-> InventoryListEntry
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (First Entity) InventoryListEntry Entity
-> InventoryListEntry -> Maybe Entity
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview Getting (First Entity) InventoryListEntry Entity
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 = Int
-> GenericList Name Vector InventoryListEntry
-> GenericList Name Vector InventoryListEntry
forall (t :: * -> *) n e.
(Foldable t, Splittable t) =>
Int -> GenericList n t e -> GenericList n t e
BL.listMoveTo Int
idx (GenericList Name Vector InventoryListEntry
 -> GenericList Name Vector InventoryListEntry)
-> GenericList Name Vector InventoryListEntry
-> GenericList Name Vector InventoryListEntry
forall a b. (a -> b) -> a -> b
$ Name
-> Vector InventoryListEntry
-> Int
-> GenericList Name Vector InventoryListEntry
forall (t :: * -> *) n e.
Foldable t =>
n -> t e -> Int -> GenericList n t e
BL.list Name
InventoryList ([InventoryListEntry] -> Vector InventoryListEntry
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.
  (Maybe (Int, GenericList Name Vector InventoryListEntry)
 -> Identity
      (Maybe (Int, GenericList Name Vector InventoryListEntry)))
-> UIInventory -> Identity UIInventory
Lens'
  UIInventory
  (Maybe (Int, GenericList Name Vector InventoryListEntry))
uiInventoryList ((Maybe (Int, GenericList Name Vector InventoryListEntry)
  -> Identity
       (Maybe (Int, GenericList Name Vector InventoryListEntry)))
 -> UIInventory -> Identity UIInventory)
-> Maybe (Int, GenericList Name Vector InventoryListEntry) -> m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= (Int, GenericList Name Vector InventoryListEntry)
-> Maybe (Int, GenericList Name Vector InventoryListEntry)
forall a. a -> Maybe a
Just (Robot
r Robot -> Getting Int Robot Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int Robot Int
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 = Maybe Int
forall a. Maybe a
Nothing
    , userScenario :: Maybe String
userScenario = Maybe String
forall a. Maybe a
Nothing
    , scriptToRun :: Maybe String
scriptToRun = Maybe String
forall a. Maybe a
Nothing
    , autoPlay :: Bool
autoPlay = Bool
False
    , speed :: Int
speed = Int
defaultInitLgTicksPerSecond
    , cheatMode :: Bool
cheatMode = Bool
False
    , colorMode :: Maybe ColorMode
colorMode = Maybe ColorMode
forall a. Maybe a
Nothing
    , userWebPort :: Maybe Int
userWebPort = Maybe Int
forall a. Maybe a
Nothing
    , repoGitInfo :: Maybe GitInfo
repoGitInfo = Maybe GitInfo
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 = List Name ScenarioItem -> List Name ScenarioItem
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 = List Name ScenarioItem -> Maybe Int
forall n (t :: * -> *) e. GenericList n t e -> Maybe Int
BL.listSelected List Name ScenarioItem
curMenu Maybe Int -> Maybe Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> Maybe Int
forall a. a -> Maybe a
Just (Vector ScenarioItem -> Int
forall a. Vector a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (List Name ScenarioItem -> Vector ScenarioItem
forall n (t :: * -> *) e. GenericList n t e -> t e
BL.listElements List Name ScenarioItem
curMenu) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
     in if Bool
isLastScenario
          then Maybe ScenarioInfoPair
forall a. Maybe a
Nothing
          else List Name ScenarioItem -> Maybe (Int, ScenarioItem)
forall (t :: * -> *) e n.
(Splittable t, Traversable t, Semigroup (t e)) =>
GenericList n t e -> Maybe (Int, e)
BL.listSelectedElement List Name ScenarioItem
nextMenuList Maybe (Int, ScenarioItem)
-> ((Int, ScenarioItem) -> Maybe ScenarioInfoPair)
-> Maybe ScenarioInfoPair
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Getting (First ScenarioInfoPair) ScenarioItem ScenarioInfoPair
-> ScenarioItem -> Maybe ScenarioInfoPair
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview Getting (First ScenarioInfoPair) ScenarioItem ScenarioInfoPair
Prism' ScenarioItem ScenarioInfoPair
_SISingle (ScenarioItem -> Maybe ScenarioInfoPair)
-> ((Int, ScenarioItem) -> ScenarioItem)
-> (Int, ScenarioItem)
-> Maybe ScenarioInfoPair
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, ScenarioItem) -> ScenarioItem
forall a b. (a, b) -> b
snd
  Menu
_ -> Maybe ScenarioInfoPair
forall a. Maybe a
Nothing

--------------------------------------------------
-- Lenses for KeyEventHandlingState

makeLensesNoSigs ''KeyEventHandlingState

-- | Keybindings (possibly customized by player) for 'SwarmEvent's.
keyConfig :: Lens' KeyEventHandlingState (KeyConfig SwarmEvent)

-- | Dispatchers that will call handler on key combo.
keyDispatchers :: Lens' KeyEventHandlingState SwarmKeyDispatchers

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

makeLensesNoSigs ''AppState

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

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

-- | The key event handling configuration.
keyEventHandling :: Lens' AppState KeyEventHandlingState

-- | 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 AppState
-> Getting
     (First (GenericList Name Vector InventoryListEntry))
     AppState
     (GenericList Name Vector InventoryListEntry)
-> Maybe (GenericList Name Vector InventoryListEntry)
forall s a. s -> Getting (First a) s a -> Maybe a
^? (UIState
 -> Const
      (First (GenericList Name Vector InventoryListEntry)) UIState)
-> AppState
-> Const
     (First (GenericList Name Vector InventoryListEntry)) AppState
Lens' AppState UIState
uiState ((UIState
  -> Const
       (First (GenericList Name Vector InventoryListEntry)) UIState)
 -> AppState
 -> Const
      (First (GenericList Name Vector InventoryListEntry)) AppState)
-> ((GenericList Name Vector InventoryListEntry
     -> Const
          (First (GenericList Name Vector InventoryListEntry))
          (GenericList Name Vector InventoryListEntry))
    -> UIState
    -> Const
         (First (GenericList Name Vector InventoryListEntry)) UIState)
-> Getting
     (First (GenericList Name Vector InventoryListEntry))
     AppState
     (GenericList Name Vector InventoryListEntry)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UIGameplay
 -> Const
      (First (GenericList Name Vector InventoryListEntry)) UIGameplay)
-> UIState
-> Const
     (First (GenericList Name Vector InventoryListEntry)) UIState
Lens' UIState UIGameplay
uiGameplay ((UIGameplay
  -> Const
       (First (GenericList Name Vector InventoryListEntry)) UIGameplay)
 -> UIState
 -> Const
      (First (GenericList Name Vector InventoryListEntry)) UIState)
-> ((GenericList Name Vector InventoryListEntry
     -> Const
          (First (GenericList Name Vector InventoryListEntry))
          (GenericList Name Vector InventoryListEntry))
    -> UIGameplay
    -> Const
         (First (GenericList Name Vector InventoryListEntry)) UIGameplay)
-> (GenericList Name Vector InventoryListEntry
    -> Const
         (First (GenericList Name Vector InventoryListEntry))
         (GenericList Name Vector InventoryListEntry))
-> UIState
-> Const
     (First (GenericList Name Vector InventoryListEntry)) UIState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UIInventory
 -> Const
      (First (GenericList Name Vector InventoryListEntry)) UIInventory)
-> UIGameplay
-> Const
     (First (GenericList Name Vector InventoryListEntry)) UIGameplay
Lens' UIGameplay UIInventory
uiInventory ((UIInventory
  -> Const
       (First (GenericList Name Vector InventoryListEntry)) UIInventory)
 -> UIGameplay
 -> Const
      (First (GenericList Name Vector InventoryListEntry)) UIGameplay)
-> Getting
     (First (GenericList Name Vector InventoryListEntry))
     UIInventory
     (GenericList Name Vector InventoryListEntry)
-> (GenericList Name Vector InventoryListEntry
    -> Const
         (First (GenericList Name Vector InventoryListEntry))
         (GenericList Name Vector InventoryListEntry))
-> UIGameplay
-> Const
     (First (GenericList Name Vector InventoryListEntry)) UIGameplay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe (Int, GenericList Name Vector InventoryListEntry)
 -> Const
      (First (GenericList Name Vector InventoryListEntry))
      (Maybe (Int, GenericList Name Vector InventoryListEntry)))
-> UIInventory
-> Const
     (First (GenericList Name Vector InventoryListEntry)) UIInventory
Lens'
  UIInventory
  (Maybe (Int, GenericList Name Vector InventoryListEntry))
uiInventoryList ((Maybe (Int, GenericList Name Vector InventoryListEntry)
  -> Const
       (First (GenericList Name Vector InventoryListEntry))
       (Maybe (Int, GenericList Name Vector InventoryListEntry)))
 -> UIInventory
 -> Const
      (First (GenericList Name Vector InventoryListEntry)) UIInventory)
-> ((GenericList Name Vector InventoryListEntry
     -> Const
          (First (GenericList Name Vector InventoryListEntry))
          (GenericList Name Vector InventoryListEntry))
    -> Maybe (Int, GenericList Name Vector InventoryListEntry)
    -> Const
         (First (GenericList Name Vector InventoryListEntry))
         (Maybe (Int, GenericList Name Vector InventoryListEntry)))
-> Getting
     (First (GenericList Name Vector InventoryListEntry))
     UIInventory
     (GenericList Name Vector InventoryListEntry)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, GenericList Name Vector InventoryListEntry)
 -> Const
      (First (GenericList Name Vector InventoryListEntry))
      (Int, GenericList Name Vector InventoryListEntry))
-> Maybe (Int, GenericList Name Vector InventoryListEntry)
-> Const
     (First (GenericList Name Vector InventoryListEntry))
     (Maybe (Int, GenericList Name Vector InventoryListEntry))
forall a b (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p a (f b) -> p (Maybe a) (f (Maybe b))
_Just (((Int, GenericList Name Vector InventoryListEntry)
  -> Const
       (First (GenericList Name Vector InventoryListEntry))
       (Int, GenericList Name Vector InventoryListEntry))
 -> Maybe (Int, GenericList Name Vector InventoryListEntry)
 -> Const
      (First (GenericList Name Vector InventoryListEntry))
      (Maybe (Int, GenericList Name Vector InventoryListEntry)))
-> ((GenericList Name Vector InventoryListEntry
     -> Const
          (First (GenericList Name Vector InventoryListEntry))
          (GenericList Name Vector InventoryListEntry))
    -> (Int, GenericList Name Vector InventoryListEntry)
    -> Const
         (First (GenericList Name Vector InventoryListEntry))
         (Int, GenericList Name Vector InventoryListEntry))
-> (GenericList Name Vector InventoryListEntry
    -> Const
         (First (GenericList Name Vector InventoryListEntry))
         (GenericList Name Vector InventoryListEntry))
-> Maybe (Int, GenericList Name Vector InventoryListEntry)
-> Const
     (First (GenericList Name Vector InventoryListEntry))
     (Maybe (Int, GenericList Name Vector InventoryListEntry))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GenericList Name Vector InventoryListEntry
 -> Const
      (First (GenericList Name Vector InventoryListEntry))
      (GenericList Name Vector InventoryListEntry))
-> (Int, GenericList Name Vector InventoryListEntry)
-> Const
     (First (GenericList Name Vector InventoryListEntry))
     (Int, GenericList Name Vector InventoryListEntry)
forall s t a b. Field2 s t a b => Lens s t a b
Lens
  (Int, GenericList Name Vector InventoryListEntry)
  (Int, GenericList Name Vector InventoryListEntry)
  (GenericList Name Vector InventoryListEntry)
  (GenericList Name Vector InventoryListEntry)
_2
  (Int
_, InventoryListEntry
entry) <- GenericList Name Vector InventoryListEntry
-> Maybe (Int, InventoryListEntry)
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
  InventoryListEntry -> Maybe InventoryListEntry
forall a. a -> Maybe a
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 (AppState -> Maybe InventoryListEntry)
-> (InventoryListEntry -> Maybe Entity) -> AppState -> Maybe Entity
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> \case
    Separator Text
_ -> Maybe Entity
forall a. Maybe a
Nothing
    InventoryEntry Int
_ Entity
e -> Entity -> Maybe Entity
forall a. a -> Maybe a
Just Entity
e
    EquippedEntry Entity
e -> Entity -> Maybe Entity
forall a. a -> Maybe a
Just Entity
e