{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE ViewPatterns #-}
module Swarm.TUI.Model (
AppEvent (..),
FocusablePanel (..),
Name (..),
ModalType (..),
Button (..),
ButtonAction (..),
Modal (..),
modalType,
modalDialog,
MainMenuEntry (..),
mainMenu,
Menu (..),
_NewGameMenu,
mkScenarioList,
mkNewGameMenu,
REPLHistItem (..),
replItemText,
isREPLEntry,
getREPLEntry,
REPLHistory,
replIndex,
replLength,
replSeq,
newREPLHistory,
addREPLItem,
restartREPLHistory,
getLatestREPLHistoryItems,
moveReplHistIndex,
getCurrentItemText,
replIndexIsAtInput,
TimeDir (..),
REPLPrompt (..),
removeEntry,
InventoryListEntry (..),
_Separator,
_InventoryEntry,
_EquippedEntry,
REPLState,
ReplControlMode (..),
replPromptType,
replPromptEditor,
replPromptText,
replValid,
replLast,
replType,
replControlMode,
replHistory,
newREPLEditor,
populateInventoryList,
infoScroll,
modalScroll,
RuntimeState,
webPort,
upstreamRelease,
eventLog,
logEvent,
AppState (AppState),
gameState,
uiState,
runtimeState,
AppOpts (..),
Seed,
ColorMode (..),
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))
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
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
webPort :: Lens' RuntimeState (Maybe Port)
upstreamRelease :: Lens' RuntimeState (Either NewReleaseFailure String)
eventLog :: Lens' RuntimeState (Notifications LogEntry)
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
data AppState = AppState
{ AppState -> GameState
_gameState :: GameState
, AppState -> UIState
_uiState :: UIState
, AppState -> RuntimeState
_runtimeState :: RuntimeState
}
makeLensesWith (lensRules & generateSignatures .~ False) ''AppState
gameState :: Lens' AppState GameState
uiState :: Lens' AppState UIState
runtimeState :: Lens' AppState RuntimeState
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
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
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
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"))
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
idx :: Int
idx = case Maybe (Int, InventoryListEntry)
sel of
Maybe (Int, InventoryListEntry)
Nothing -> Int
1
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
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
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)
data AppOpts = AppOpts
{ AppOpts -> Maybe Int
userSeed :: Maybe Seed
, AppOpts -> Maybe String
userScenario :: Maybe FilePath
, AppOpts -> Maybe String
scriptToRun :: Maybe FilePath
, AppOpts -> Bool
autoPlay :: Bool
, AppOpts -> Bool
cheatMode :: Bool
, AppOpts -> Maybe ColorMode
colorMode :: Maybe ColorMode
, AppOpts -> Maybe Int
userWebPort :: Maybe Port
, AppOpts -> Maybe GitInfo
repoGitInfo :: Maybe GitInfo
}
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
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