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

-- |
-- Module      :  Swarm.TUI.Model
-- Copyright   :  Brent Yorgey
-- Maintainer  :  byorgey@gmail.com
--
-- SPDX-License-Identifier: BSD-3-Clause
--
-- Application state for the @brick@-based Swarm TUI.
module Swarm.TUI.Model (
  -- * Custom UI label types
  -- $uilabel
  AppEvent (..),
  FocusablePanel (..),
  Name (..),

  -- * Menus and dialogs
  ModalType (..),
  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,
  logEvent,

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

  -- ** Initialization
  AppOpts (..),
  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.Lens hiding (from, (<.>))
import Control.Monad.Except
import Control.Monad.State
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 Linear (zero)
import Network.Wai.Handler.Warp (Port)
import Swarm.Game.Entity as E
import Swarm.Game.Robot
import Swarm.Game.ScenarioInfo (
  ScenarioInfoPair,
  _SISingle,
 )
import Swarm.Game.State
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.Version (NewReleaseFailure (NoMainUpstreamRelease))

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

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

-- | 'Swarm.TUI.Model.AppEvent' represents a type for custom event types our app can
--   receive.  At the moment, we only have one custom event, but it's
--   very important: a separate thread sends 'Frame' events as fast as
--   it can, telling the TUI to render a new frame.
data AppEvent
  = Frame
  | 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
  }

initRuntimeState :: RuntimeState
initRuntimeState :: RuntimeState
initRuntimeState =
  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
    }

makeLensesWith (lensRules & generateSignatures .~ False) ''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)

-- | 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 = Integer -> LogSource -> Text -> Int -> Location -> Text -> LogEntry
LogEntry Integer
0 LogSource
src Text
who Int
rid forall (f :: * -> *) a. (Additive f, Num a) => f a
zero Text
msg

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

makeLensesWith (lensRules & generateSignatures .~ False) ''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
  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 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)

      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
"Inventory"))
          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 -> 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).
  }

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