{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}

-- |
-- SPDX-License-Identifier: BSD-3-Clause
--
-- Event handlers for the TUI.
module Swarm.TUI.Controller (
  -- * Event handling
  handleEvent,
  quitGame,

  -- ** Handling 'Swarm.TUI.Model.Frame' events
  runFrameUI,
  ticksPerFrameCap,
  runGameTickUI,

  -- ** REPL panel
  runBaseWebCode,
  handleREPLEvent,
  validateREPLForm,
  adjReplHistIndex,
  TimeDir (..),

  -- ** Info panel
  handleInfoPanelEvent,
) where

-- See Note [liftA2 re-export from Prelude]
import Prelude hiding (Applicative (..))

import Brick hiding (Direction, Location)
import Brick.Focus
import Brick.Keybindings qualified as B
import Brick.Widgets.Dialog
import Brick.Widgets.Edit (Editor, applyEdit, handleEditorEvent)
import Brick.Widgets.List (handleListEvent)
import Brick.Widgets.List qualified as BL
import Control.Applicative (pure)
import Control.Category ((>>>))
import Control.Lens as Lens
import Control.Monad (unless, void, when)
import Control.Monad.Extra (whenJust)
import Control.Monad.IO.Class (MonadIO (liftIO))
import Control.Monad.State (MonadState, execState)
import Data.List.NonEmpty (NonEmpty (..))
import Data.List.NonEmpty qualified as NE
import Data.Map qualified as M
import Data.Maybe (fromMaybe, isJust, mapMaybe)
import Data.Set (Set)
import Data.Set qualified as S
import Data.Text (Text)
import Data.Text qualified as T
import Data.Text.IO qualified as T
import Data.Text.Zipper qualified as TZ
import Data.Text.Zipper.Generic.Words qualified as TZ
import Data.Vector qualified as V
import Graphics.Vty qualified as V
import Swarm.Game.Achievement.Definitions
import Swarm.Game.CESK (CESK (Out), Frame (FApp, FExec, FSuspend))
import Swarm.Game.Entity hiding (empty)
import Swarm.Game.Land
import Swarm.Game.ResourceLoading (getSwarmHistoryPath)
import Swarm.Game.Robot.Concrete
import Swarm.Game.ScenarioInfo
import Swarm.Game.State
import Swarm.Game.State.Landscape
import Swarm.Game.State.Robot
import Swarm.Game.State.Runtime
import Swarm.Game.State.Substate
import Swarm.Language.Capability (
  Capability (CGod),
  constCaps,
 )
import Swarm.Language.Context
import Swarm.Language.Key (KeyCombo, mkKeyCombo)
import Swarm.Language.Parser (readTerm')
import Swarm.Language.Parser.Core (defaultParserConfig)
import Swarm.Language.Parser.Lex (reservedWords)
import Swarm.Language.Parser.Util (showErrorPos)
import Swarm.Language.Pipeline (processParsedTerm', processTerm')
import Swarm.Language.Syntax hiding (Key)
import Swarm.Language.Typecheck (
  ContextualTypeErr (..),
 )
import Swarm.Language.Value (Value (VKey), envTypes)
import Swarm.Log
import Swarm.TUI.Controller.EventHandlers
import Swarm.TUI.Controller.SaveScenario (saveScenarioInfoOnQuit)
import Swarm.TUI.Controller.Util
import Swarm.TUI.Editor.Controller qualified as EC
import Swarm.TUI.Editor.Model
import Swarm.TUI.Launch.Controller
import Swarm.TUI.Launch.Model
import Swarm.TUI.Launch.Prep (prepareLaunchDialog)
import Swarm.TUI.List
import Swarm.TUI.Model
import Swarm.TUI.Model.Goal
import Swarm.TUI.Model.Name
import Swarm.TUI.Model.Popup (progressPopups)
import Swarm.TUI.Model.Repl
import Swarm.TUI.Model.StateUpdate
import Swarm.TUI.Model.Structure
import Swarm.TUI.Model.UI
import Swarm.Util hiding (both, (<<.=))
import Swarm.Version (NewReleaseFailure (..))

-- ~~~~ Note [liftA2 re-export from Prelude]
--
-- As of base-4.18 (GHC 9.6), liftA2 is re-exported from Prelude.  See
-- https://github.com/haskell/core-libraries-committee/issues/50 .  In
-- order to compile warning-free on both GHC 9.6 and older versions,
-- we hide the import of Applicative functions from Prelude and import
-- explicitly from Control.Applicative.  In theory, if at some point
-- in the distant future we end up dropping support for GHC < 9.6 then
-- we could get rid of both explicit imports and just get liftA2 and
-- pure implicitly from Prelude.

-- | The top-level event handler for the TUI.
handleEvent :: BrickEvent Name AppEvent -> EventM Name AppState ()
handleEvent :: BrickEvent Name AppEvent -> EventM Name AppState ()
handleEvent = \case
  -- the query for upstream version could finish at any time, so we have to handle it here
  AppEvent (UpstreamVersion Either NewReleaseFailure String
ev) -> do
    let logReleaseEvent :: LogSource -> Severity -> a -> m ()
logReleaseEvent LogSource
l Severity
sev a
e = (RuntimeState -> Identity RuntimeState)
-> AppState -> Identity AppState
Lens' AppState RuntimeState
runtimeState ((RuntimeState -> Identity RuntimeState)
 -> AppState -> Identity AppState)
-> ((Notifications LogEntry -> Identity (Notifications LogEntry))
    -> RuntimeState -> Identity RuntimeState)
-> (Notifications LogEntry -> Identity (Notifications LogEntry))
-> AppState
-> Identity AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Notifications LogEntry -> Identity (Notifications LogEntry))
-> RuntimeState -> Identity RuntimeState
Lens' RuntimeState (Notifications LogEntry)
eventLog ((Notifications LogEntry -> Identity (Notifications LogEntry))
 -> AppState -> Identity AppState)
-> (Notifications LogEntry -> Notifications LogEntry) -> m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= LogSource
-> Severity
-> Text
-> Text
-> Notifications LogEntry
-> Notifications LogEntry
logEvent LogSource
l Severity
sev Text
"Release" (String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ a -> String
forall a. Show a => a -> String
show a
e)
    case Either NewReleaseFailure String
ev of
      Left NewReleaseFailure
e ->
        let sev :: Severity
sev = case NewReleaseFailure
e of
              FailedReleaseQuery {} -> Severity
Error
              OnDevelopmentBranch {} -> Severity
Info
              NewReleaseFailure
_ -> Severity
Warning
         in LogSource
-> Severity -> NewReleaseFailure -> EventM Name AppState ()
forall {m :: * -> *} {a}.
(MonadState AppState m, Show a) =>
LogSource -> Severity -> a -> m ()
logReleaseEvent LogSource
SystemLog Severity
sev NewReleaseFailure
e
      Right String
_ -> () -> EventM Name AppState ()
forall a. a -> EventM Name AppState a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    (RuntimeState -> Identity RuntimeState)
-> AppState -> Identity AppState
Lens' AppState RuntimeState
runtimeState ((RuntimeState -> Identity RuntimeState)
 -> AppState -> Identity AppState)
-> ((Either NewReleaseFailure String
     -> Identity (Either NewReleaseFailure String))
    -> RuntimeState -> Identity RuntimeState)
-> (Either NewReleaseFailure String
    -> Identity (Either NewReleaseFailure String))
-> AppState
-> Identity AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Either NewReleaseFailure String
 -> Identity (Either NewReleaseFailure String))
-> RuntimeState -> Identity RuntimeState
Lens' RuntimeState (Either NewReleaseFailure String)
upstreamRelease ((Either NewReleaseFailure String
  -> Identity (Either NewReleaseFailure String))
 -> AppState -> Identity AppState)
-> Either NewReleaseFailure String -> EventM Name AppState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Either NewReleaseFailure String
ev
  BrickEvent Name AppEvent
e -> do
    -- Handle popup display at the very top level, so it is
    -- unaffected by any other state, e.g. even when starting or
    -- quitting a game, moving around the menu, the popup
    -- display will continue as normal.
    Bool
upd <- case BrickEvent Name AppEvent
e of
      AppEvent AppEvent
Frame -> LensLike'
  (Zoomed (EventM Name PopupState) Bool) AppState PopupState
-> EventM Name PopupState Bool -> EventM Name AppState Bool
forall c.
LensLike' (Zoomed (EventM Name PopupState) c) AppState PopupState
-> EventM Name PopupState c -> EventM Name AppState c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
Brick.zoom ((UIState -> Zoomed (EventM Name PopupState) Bool UIState)
-> AppState -> Zoomed (EventM Name PopupState) Bool AppState
Lens' AppState UIState
uiState ((UIState -> Zoomed (EventM Name PopupState) Bool UIState)
 -> AppState -> Zoomed (EventM Name PopupState) Bool AppState)
-> ((PopupState -> Zoomed (EventM Name PopupState) Bool PopupState)
    -> UIState -> Zoomed (EventM Name PopupState) Bool UIState)
-> LensLike'
     (Zoomed (EventM Name PopupState) Bool) AppState PopupState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PopupState -> Zoomed (EventM Name PopupState) Bool PopupState)
-> UIState -> Zoomed (EventM Name PopupState) Bool UIState
Lens' UIState PopupState
uiPopups) EventM Name PopupState Bool
forall (m :: * -> *). MonadState PopupState m => m Bool
progressPopups
      BrickEvent Name AppEvent
_ -> Bool -> EventM Name AppState Bool
forall a. a -> EventM Name AppState a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False

    AppState
s <- EventM Name AppState AppState
forall s (m :: * -> *). MonadState s m => m s
get
    if AppState
s AppState -> Getting Bool AppState Bool -> Bool
forall s a. s -> Getting a s a -> a
^. (UIState -> Const Bool UIState) -> AppState -> Const Bool AppState
Lens' AppState UIState
uiState ((UIState -> Const Bool UIState)
 -> AppState -> Const Bool AppState)
-> ((Bool -> Const Bool Bool) -> UIState -> Const Bool UIState)
-> Getting Bool AppState Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Const Bool Bool) -> UIState -> Const Bool UIState
Lens' UIState Bool
uiPlaying
      then Bool -> BrickEvent Name AppEvent -> EventM Name AppState ()
handleMainEvent Bool
upd BrickEvent Name AppEvent
e
      else do
        BrickEvent Name AppEvent
e BrickEvent Name AppEvent
-> (BrickEvent Name AppEvent -> EventM Name AppState ())
-> EventM Name AppState ()
forall a b. a -> (a -> b) -> b
& case AppState
s AppState -> Getting Menu AppState Menu -> Menu
forall s a. s -> Getting a s a -> a
^. (UIState -> Const Menu UIState) -> AppState -> Const Menu AppState
Lens' AppState UIState
uiState ((UIState -> Const Menu UIState)
 -> AppState -> Const Menu AppState)
-> ((Menu -> Const Menu Menu) -> UIState -> Const Menu UIState)
-> Getting Menu AppState Menu
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Menu -> Const Menu Menu) -> UIState -> Const Menu UIState
Lens' UIState Menu
uiMenu of
          -- If we reach the NoMenu case when uiPlaying is False, just
          -- quit the app.  We should actually never reach this code (the
          -- quitGame function would have already halted the app).
          Menu
NoMenu -> EventM Name AppState ()
-> BrickEvent Name AppEvent -> EventM Name AppState ()
forall a b. a -> b -> a
const EventM Name AppState ()
forall n s. EventM n s ()
halt
          MainMenu List Name MainMenuEntry
l -> List Name MainMenuEntry
-> BrickEvent Name AppEvent -> EventM Name AppState ()
handleMainMenuEvent List Name MainMenuEntry
l
          NewGameMenu NonEmpty (List Name ScenarioItem)
l ->
            if AppState
s AppState -> Getting Bool AppState Bool -> Bool
forall s a. s -> Getting a s a -> a
^. (UIState -> Const Bool UIState) -> AppState -> Const Bool AppState
Lens' AppState UIState
uiState ((UIState -> Const Bool UIState)
 -> AppState -> Const Bool AppState)
-> ((Bool -> Const Bool Bool) -> UIState -> Const Bool UIState)
-> Getting Bool AppState Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LaunchOptions -> Const Bool LaunchOptions)
-> UIState -> Const Bool UIState
Lens' UIState LaunchOptions
uiLaunchConfig ((LaunchOptions -> Const Bool LaunchOptions)
 -> UIState -> Const Bool UIState)
-> ((Bool -> Const Bool Bool)
    -> LaunchOptions -> Const Bool LaunchOptions)
-> (Bool -> Const Bool Bool)
-> UIState
-> Const Bool UIState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LaunchControls -> Const Bool LaunchControls)
-> LaunchOptions -> Const Bool LaunchOptions
Lens' LaunchOptions LaunchControls
controls ((LaunchControls -> Const Bool LaunchControls)
 -> LaunchOptions -> Const Bool LaunchOptions)
-> ((Bool -> Const Bool Bool)
    -> LaunchControls -> Const Bool LaunchControls)
-> (Bool -> Const Bool Bool)
-> LaunchOptions
-> Const Bool LaunchOptions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FileBrowserControl -> Const Bool FileBrowserControl)
-> LaunchControls -> Const Bool LaunchControls
Lens' LaunchControls FileBrowserControl
fileBrowser ((FileBrowserControl -> Const Bool FileBrowserControl)
 -> LaunchControls -> Const Bool LaunchControls)
-> ((Bool -> Const Bool Bool)
    -> FileBrowserControl -> Const Bool FileBrowserControl)
-> (Bool -> Const Bool Bool)
-> LaunchControls
-> Const Bool LaunchControls
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Const Bool Bool)
-> FileBrowserControl -> Const Bool FileBrowserControl
Lens' FileBrowserControl Bool
fbIsDisplayed
              then BrickEvent Name AppEvent -> EventM Name AppState ()
handleFBEvent
              else case AppState
s AppState
-> Getting
     (Maybe ScenarioInfoPair) AppState (Maybe ScenarioInfoPair)
-> Maybe ScenarioInfoPair
forall s a. s -> Getting a s a -> a
^. (UIState -> Const (Maybe ScenarioInfoPair) UIState)
-> AppState -> Const (Maybe ScenarioInfoPair) AppState
Lens' AppState UIState
uiState ((UIState -> Const (Maybe ScenarioInfoPair) UIState)
 -> AppState -> Const (Maybe ScenarioInfoPair) AppState)
-> ((Maybe ScenarioInfoPair
     -> Const (Maybe ScenarioInfoPair) (Maybe ScenarioInfoPair))
    -> UIState -> Const (Maybe ScenarioInfoPair) UIState)
-> Getting
     (Maybe ScenarioInfoPair) AppState (Maybe ScenarioInfoPair)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LaunchOptions -> Const (Maybe ScenarioInfoPair) LaunchOptions)
-> UIState -> Const (Maybe ScenarioInfoPair) UIState
Lens' UIState LaunchOptions
uiLaunchConfig ((LaunchOptions -> Const (Maybe ScenarioInfoPair) LaunchOptions)
 -> UIState -> Const (Maybe ScenarioInfoPair) UIState)
-> ((Maybe ScenarioInfoPair
     -> Const (Maybe ScenarioInfoPair) (Maybe ScenarioInfoPair))
    -> LaunchOptions -> Const (Maybe ScenarioInfoPair) LaunchOptions)
-> (Maybe ScenarioInfoPair
    -> Const (Maybe ScenarioInfoPair) (Maybe ScenarioInfoPair))
-> UIState
-> Const (Maybe ScenarioInfoPair) UIState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LaunchControls -> Const (Maybe ScenarioInfoPair) LaunchControls)
-> LaunchOptions -> Const (Maybe ScenarioInfoPair) LaunchOptions
Lens' LaunchOptions LaunchControls
controls ((LaunchControls -> Const (Maybe ScenarioInfoPair) LaunchControls)
 -> LaunchOptions -> Const (Maybe ScenarioInfoPair) LaunchOptions)
-> ((Maybe ScenarioInfoPair
     -> Const (Maybe ScenarioInfoPair) (Maybe ScenarioInfoPair))
    -> LaunchControls -> Const (Maybe ScenarioInfoPair) LaunchControls)
-> (Maybe ScenarioInfoPair
    -> Const (Maybe ScenarioInfoPair) (Maybe ScenarioInfoPair))
-> LaunchOptions
-> Const (Maybe ScenarioInfoPair) LaunchOptions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe ScenarioInfoPair
 -> Const (Maybe ScenarioInfoPair) (Maybe ScenarioInfoPair))
-> LaunchControls -> Const (Maybe ScenarioInfoPair) LaunchControls
Lens' LaunchControls (Maybe ScenarioInfoPair)
isDisplayedFor of
                Maybe ScenarioInfoPair
Nothing -> NonEmpty (List Name ScenarioItem)
-> BrickEvent Name AppEvent -> EventM Name AppState ()
handleNewGameMenuEvent NonEmpty (List Name ScenarioItem)
l
                Just ScenarioInfoPair
siPair -> ScenarioInfoPair
-> BrickEvent Name AppEvent -> EventM Name AppState ()
handleLaunchOptionsEvent ScenarioInfoPair
siPair
          Menu
MessagesMenu -> BrickEvent Name AppEvent -> EventM Name AppState ()
handleMainMessagesEvent
          AchievementsMenu List Name CategorizedAchievement
l -> List Name CategorizedAchievement
-> BrickEvent Name AppEvent -> EventM Name AppState ()
handleMainAchievementsEvent List Name CategorizedAchievement
l
          Menu
AboutMenu -> Menu -> BrickEvent Name AppEvent -> EventM Name AppState ()
pressAnyKey (List Name MainMenuEntry -> Menu
MainMenu (MainMenuEntry -> List Name MainMenuEntry
mainMenu MainMenuEntry
About))

-- | The event handler for the main menu.
--
-- TODO: #2010 Finish porting Controller to KeyEventHandlers
handleMainMenuEvent ::
  BL.List Name MainMenuEntry -> BrickEvent Name AppEvent -> EventM Name AppState ()
handleMainMenuEvent :: List Name MainMenuEntry
-> BrickEvent Name AppEvent -> EventM Name AppState ()
handleMainMenuEvent List Name MainMenuEntry
menu = \case
  Key Key
V.KEnter ->
    case (Int, MainMenuEntry) -> MainMenuEntry
forall a b. (a, b) -> b
snd ((Int, MainMenuEntry) -> MainMenuEntry)
-> Maybe (Int, MainMenuEntry) -> Maybe MainMenuEntry
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> List Name MainMenuEntry -> Maybe (Int, MainMenuEntry)
forall (t :: * -> *) e n.
(Splittable t, Traversable t, Semigroup (t e)) =>
GenericList n t e -> Maybe (Int, e)
BL.listSelectedElement List Name MainMenuEntry
menu of
      Maybe MainMenuEntry
Nothing -> () -> EventM Name AppState ()
forall a. a -> EventM Name AppState a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      Just MainMenuEntry
x0 -> case MainMenuEntry
x0 of
        MainMenuEntry
NewGame -> do
          Bool
cheat <- Getting Bool AppState Bool -> EventM Name AppState Bool
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Getting Bool AppState Bool -> EventM Name AppState Bool)
-> Getting Bool AppState Bool -> EventM Name AppState Bool
forall a b. (a -> b) -> a -> b
$ (UIState -> Const Bool UIState) -> AppState -> Const Bool AppState
Lens' AppState UIState
uiState ((UIState -> Const Bool UIState)
 -> AppState -> Const Bool AppState)
-> ((Bool -> Const Bool Bool) -> UIState -> Const Bool UIState)
-> Getting Bool AppState Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Const Bool Bool) -> UIState -> Const Bool UIState
Lens' UIState Bool
uiCheatMode
          ScenarioCollection
ss <- Getting ScenarioCollection AppState ScenarioCollection
-> EventM Name AppState ScenarioCollection
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Getting ScenarioCollection AppState ScenarioCollection
 -> EventM Name AppState ScenarioCollection)
-> Getting ScenarioCollection AppState ScenarioCollection
-> EventM Name AppState ScenarioCollection
forall a b. (a -> b) -> a -> b
$ (RuntimeState -> Const ScenarioCollection RuntimeState)
-> AppState -> Const ScenarioCollection AppState
Lens' AppState RuntimeState
runtimeState ((RuntimeState -> Const ScenarioCollection RuntimeState)
 -> AppState -> Const ScenarioCollection AppState)
-> ((ScenarioCollection
     -> Const ScenarioCollection ScenarioCollection)
    -> RuntimeState -> Const ScenarioCollection RuntimeState)
-> Getting ScenarioCollection AppState ScenarioCollection
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ScenarioCollection -> Const ScenarioCollection ScenarioCollection)
-> RuntimeState -> Const ScenarioCollection RuntimeState
Lens' RuntimeState ScenarioCollection
scenarios
          (UIState -> Identity UIState) -> AppState -> Identity AppState
Lens' AppState UIState
uiState ((UIState -> Identity UIState) -> AppState -> Identity AppState)
-> ((Menu -> Identity Menu) -> UIState -> Identity UIState)
-> (Menu -> Identity Menu)
-> AppState
-> Identity AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Menu -> Identity Menu) -> UIState -> Identity UIState
Lens' UIState Menu
uiMenu ((Menu -> Identity Menu) -> AppState -> Identity AppState)
-> Menu -> EventM Name AppState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= NonEmpty (List Name ScenarioItem) -> Menu
NewGameMenu (List Name ScenarioItem -> NonEmpty (List Name ScenarioItem)
forall a. a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (List Name ScenarioItem -> NonEmpty (List Name ScenarioItem))
-> List Name ScenarioItem -> NonEmpty (List Name ScenarioItem)
forall a b. (a -> b) -> a -> b
$ Bool -> ScenarioCollection -> List Name ScenarioItem
mkScenarioList Bool
cheat ScenarioCollection
ss)
        MainMenuEntry
Tutorial -> do
          -- Set up the menu stack as if the user had chosen "New Game > Tutorials"
          Bool
cheat <- Getting Bool AppState Bool -> EventM Name AppState Bool
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Getting Bool AppState Bool -> EventM Name AppState Bool)
-> Getting Bool AppState Bool -> EventM Name AppState Bool
forall a b. (a -> b) -> a -> b
$ (UIState -> Const Bool UIState) -> AppState -> Const Bool AppState
Lens' AppState UIState
uiState ((UIState -> Const Bool UIState)
 -> AppState -> Const Bool AppState)
-> ((Bool -> Const Bool Bool) -> UIState -> Const Bool UIState)
-> Getting Bool AppState Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Const Bool Bool) -> UIState -> Const Bool UIState
Lens' UIState Bool
uiCheatMode
          ScenarioCollection
ss <- Getting ScenarioCollection AppState ScenarioCollection
-> EventM Name AppState ScenarioCollection
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Getting ScenarioCollection AppState ScenarioCollection
 -> EventM Name AppState ScenarioCollection)
-> Getting ScenarioCollection AppState ScenarioCollection
-> EventM Name AppState ScenarioCollection
forall a b. (a -> b) -> a -> b
$ (RuntimeState -> Const ScenarioCollection RuntimeState)
-> AppState -> Const ScenarioCollection AppState
Lens' AppState RuntimeState
runtimeState ((RuntimeState -> Const ScenarioCollection RuntimeState)
 -> AppState -> Const ScenarioCollection AppState)
-> ((ScenarioCollection
     -> Const ScenarioCollection ScenarioCollection)
    -> RuntimeState -> Const ScenarioCollection RuntimeState)
-> Getting ScenarioCollection AppState ScenarioCollection
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ScenarioCollection -> Const ScenarioCollection ScenarioCollection)
-> RuntimeState -> Const ScenarioCollection RuntimeState
Lens' RuntimeState ScenarioCollection
scenarios
          let tutorialCollection :: ScenarioCollection
tutorialCollection = ScenarioCollection -> ScenarioCollection
getTutorials ScenarioCollection
ss
              topMenu :: List Name ScenarioItem
topMenu =
                (ScenarioItem -> Bool)
-> List Name ScenarioItem -> List Name ScenarioItem
forall (t :: * -> *) e n.
(Foldable t, Splittable t) =>
(e -> Bool) -> GenericList n t e -> GenericList n t e
BL.listFindBy
                  ((String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
tutorialsDirname) (String -> Bool)
-> (ScenarioItem -> String) -> ScenarioItem -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> String)
-> (ScenarioItem -> Text) -> ScenarioItem -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScenarioItem -> Text
scenarioItemName)
                  (Bool -> ScenarioCollection -> List Name ScenarioItem
mkScenarioList Bool
cheat ScenarioCollection
ss)
              tutorialMenu :: List Name ScenarioItem
tutorialMenu = Bool -> ScenarioCollection -> List Name ScenarioItem
mkScenarioList Bool
cheat ScenarioCollection
tutorialCollection
              menuStack :: NonEmpty (List Name ScenarioItem)
menuStack = List Name ScenarioItem
tutorialMenu List Name ScenarioItem
-> [List Name ScenarioItem] -> NonEmpty (List Name ScenarioItem)
forall a. a -> [a] -> NonEmpty a
:| List Name ScenarioItem -> [List Name ScenarioItem]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure List Name ScenarioItem
topMenu
          (UIState -> Identity UIState) -> AppState -> Identity AppState
Lens' AppState UIState
uiState ((UIState -> Identity UIState) -> AppState -> Identity AppState)
-> ((Menu -> Identity Menu) -> UIState -> Identity UIState)
-> (Menu -> Identity Menu)
-> AppState
-> Identity AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Menu -> Identity Menu) -> UIState -> Identity UIState
Lens' UIState Menu
uiMenu ((Menu -> Identity Menu) -> AppState -> Identity AppState)
-> Menu -> EventM Name AppState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= NonEmpty (List Name ScenarioItem) -> Menu
NewGameMenu NonEmpty (List Name ScenarioItem)
menuStack

          -- Extract the first tutorial challenge and run it
          let firstTutorial :: ScenarioInfoPair
firstTutorial = case ScenarioCollection -> Maybe [String]
scOrder ScenarioCollection
tutorialCollection of
                Just (String
t : [String]
_) -> case String -> Map String ScenarioItem -> Maybe ScenarioItem
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup String
t (ScenarioCollection -> Map String ScenarioItem
scMap ScenarioCollection
tutorialCollection) of
                  Just (SISingle ScenarioInfoPair
siPair) -> ScenarioInfoPair
siPair
                  Maybe ScenarioItem
_ -> String -> ScenarioInfoPair
forall a. HasCallStack => String -> a
error String
"No first tutorial found!"
                Maybe [String]
_ -> String -> ScenarioInfoPair
forall a. HasCallStack => String -> a
error String
"No first tutorial found!"
          ScenarioInfoPair -> Maybe CodeToRun -> EventM Name AppState ()
forall (m :: * -> *).
(MonadIO m, MonadState AppState m) =>
ScenarioInfoPair -> Maybe CodeToRun -> m ()
startGame ScenarioInfoPair
firstTutorial Maybe CodeToRun
forall a. Maybe a
Nothing
        MainMenuEntry
Achievements -> (UIState -> Identity UIState) -> AppState -> Identity AppState
Lens' AppState UIState
uiState ((UIState -> Identity UIState) -> AppState -> Identity AppState)
-> ((Menu -> Identity Menu) -> UIState -> Identity UIState)
-> (Menu -> Identity Menu)
-> AppState
-> Identity AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Menu -> Identity Menu) -> UIState -> Identity UIState
Lens' UIState Menu
uiMenu ((Menu -> Identity Menu) -> AppState -> Identity AppState)
-> Menu -> EventM Name AppState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= List Name CategorizedAchievement -> Menu
AchievementsMenu (Name
-> Vector CategorizedAchievement
-> Int
-> List Name CategorizedAchievement
forall (t :: * -> *) n e.
Foldable t =>
n -> t e -> Int -> GenericList n t e
BL.list Name
AchievementList ([CategorizedAchievement] -> Vector CategorizedAchievement
forall a. [a] -> Vector a
V.fromList [CategorizedAchievement]
listAchievements) Int
1)
        MainMenuEntry
Messages -> do
          (RuntimeState -> Identity RuntimeState)
-> AppState -> Identity AppState
Lens' AppState RuntimeState
runtimeState ((RuntimeState -> Identity RuntimeState)
 -> AppState -> Identity AppState)
-> ((Int -> Identity Int) -> RuntimeState -> Identity RuntimeState)
-> (Int -> Identity Int)
-> AppState
-> Identity AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Notifications LogEntry -> Identity (Notifications LogEntry))
-> RuntimeState -> Identity RuntimeState
Lens' RuntimeState (Notifications LogEntry)
eventLog ((Notifications LogEntry -> Identity (Notifications LogEntry))
 -> RuntimeState -> Identity RuntimeState)
-> ((Int -> Identity Int)
    -> Notifications LogEntry -> Identity (Notifications LogEntry))
-> (Int -> Identity Int)
-> RuntimeState
-> Identity RuntimeState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (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) -> AppState -> Identity AppState)
-> Int -> EventM Name AppState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Int
0
          (UIState -> Identity UIState) -> AppState -> Identity AppState
Lens' AppState UIState
uiState ((UIState -> Identity UIState) -> AppState -> Identity AppState)
-> ((Menu -> Identity Menu) -> UIState -> Identity UIState)
-> (Menu -> Identity Menu)
-> AppState
-> Identity AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Menu -> Identity Menu) -> UIState -> Identity UIState
Lens' UIState Menu
uiMenu ((Menu -> Identity Menu) -> AppState -> Identity AppState)
-> Menu -> EventM Name AppState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Menu
MessagesMenu
        MainMenuEntry
About -> do
          (UIState -> Identity UIState) -> AppState -> Identity AppState
Lens' AppState UIState
uiState ((UIState -> Identity UIState) -> AppState -> Identity AppState)
-> ((Menu -> Identity Menu) -> UIState -> Identity UIState)
-> (Menu -> Identity Menu)
-> AppState
-> Identity AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Menu -> Identity Menu) -> UIState -> Identity UIState
Lens' UIState Menu
uiMenu ((Menu -> Identity Menu) -> AppState -> Identity AppState)
-> Menu -> EventM Name AppState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Menu
AboutMenu
          CategorizedAchievement -> EventM Name AppState ()
forall (m :: * -> *).
(MonadIO m, MonadState AppState m) =>
CategorizedAchievement -> m ()
attainAchievement (CategorizedAchievement -> EventM Name AppState ())
-> CategorizedAchievement -> EventM Name AppState ()
forall a b. (a -> b) -> a -> b
$ GlobalAchievement -> CategorizedAchievement
GlobalAchievement GlobalAchievement
LookedAtAboutScreen
        MainMenuEntry
Quit -> EventM Name AppState ()
forall n s. EventM n s ()
halt
  CharKey Char
'q' -> EventM Name AppState ()
forall n s. EventM n s ()
halt
  ControlChar Char
'q' -> EventM Name AppState ()
forall n s. EventM n s ()
halt
  VtyEvent Event
ev -> do
    List Name MainMenuEntry
menu' <- List Name MainMenuEntry
-> EventM Name (List Name MainMenuEntry) ()
-> EventM Name AppState (List Name MainMenuEntry)
forall a n b s. a -> EventM n a b -> EventM n s a
nestEventM' List Name MainMenuEntry
menu (Event -> EventM Name (List Name MainMenuEntry) ()
forall (t :: * -> *) n e.
(Foldable t, Splittable t, Ord n) =>
Event -> EventM n (GenericList n t e) ()
handleListEvent Event
ev)
    (UIState -> Identity UIState) -> AppState -> Identity AppState
Lens' AppState UIState
uiState ((UIState -> Identity UIState) -> AppState -> Identity AppState)
-> ((Menu -> Identity Menu) -> UIState -> Identity UIState)
-> (Menu -> Identity Menu)
-> AppState
-> Identity AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Menu -> Identity Menu) -> UIState -> Identity UIState
Lens' UIState Menu
uiMenu ((Menu -> Identity Menu) -> AppState -> Identity AppState)
-> Menu -> EventM Name AppState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= List Name MainMenuEntry -> Menu
MainMenu List Name MainMenuEntry
menu'
  BrickEvent Name AppEvent
_ -> () -> EventM Name AppState ()
forall a. a -> EventM Name AppState a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

-- | If we are in a New Game menu, advance the menu to the next item in order.
--
--   NOTE: be careful to maintain the invariant that the currently selected
--   menu item is always the same as the currently played scenario!  `quitGame`
--   is the only place this function should be called.
advanceMenu :: Menu -> Menu
advanceMenu :: Menu -> Menu
advanceMenu = (NonEmpty (List Name ScenarioItem)
 -> Identity (NonEmpty (List Name ScenarioItem)))
-> Menu -> Identity Menu
Prism' Menu (NonEmpty (List Name ScenarioItem))
_NewGameMenu ((NonEmpty (List Name ScenarioItem)
  -> Identity (NonEmpty (List Name ScenarioItem)))
 -> Menu -> Identity Menu)
-> ((List Name ScenarioItem -> Identity (List Name ScenarioItem))
    -> NonEmpty (List Name ScenarioItem)
    -> Identity (NonEmpty (List Name ScenarioItem)))
-> (List Name ScenarioItem -> Identity (List Name ScenarioItem))
-> Menu
-> Identity Menu
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (NonEmpty (List Name ScenarioItem))
-> Traversal'
     (NonEmpty (List Name ScenarioItem))
     (IxValue (NonEmpty (List Name ScenarioItem)))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Int
Index (NonEmpty (List Name ScenarioItem))
0 ((List Name ScenarioItem -> Identity (List Name ScenarioItem))
 -> Menu -> Identity Menu)
-> (List Name ScenarioItem -> List Name ScenarioItem)
-> Menu
-> Menu
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ List Name ScenarioItem -> List Name ScenarioItem
forall (t :: * -> *) n e.
(Foldable t, Splittable t) =>
GenericList n t e -> GenericList n t e
BL.listMoveDown

handleMainAchievementsEvent ::
  BL.List Name CategorizedAchievement ->
  BrickEvent Name AppEvent ->
  EventM Name AppState ()
handleMainAchievementsEvent :: List Name CategorizedAchievement
-> BrickEvent Name AppEvent -> EventM Name AppState ()
handleMainAchievementsEvent List Name CategorizedAchievement
l BrickEvent Name AppEvent
e = case BrickEvent Name AppEvent
e of
  Key Key
V.KEsc -> EventM Name AppState ()
returnToMainMenu
  CharKey Char
'q' -> EventM Name AppState ()
returnToMainMenu
  ControlChar Char
'q' -> EventM Name AppState ()
returnToMainMenu
  VtyEvent Event
ev -> do
    List Name CategorizedAchievement
l' <- List Name CategorizedAchievement
-> EventM Name (List Name CategorizedAchievement) ()
-> EventM Name AppState (List Name CategorizedAchievement)
forall a n b s. a -> EventM n a b -> EventM n s a
nestEventM' List Name CategorizedAchievement
l (Event -> EventM Name (List Name CategorizedAchievement) ()
forall (t :: * -> *) n e.
(Foldable t, Splittable t, Ord n) =>
Event -> EventM n (GenericList n t e) ()
handleListEvent Event
ev)
    (UIState -> Identity UIState) -> AppState -> Identity AppState
Lens' AppState UIState
uiState ((UIState -> Identity UIState) -> AppState -> Identity AppState)
-> ((Menu -> Identity Menu) -> UIState -> Identity UIState)
-> (Menu -> Identity Menu)
-> AppState
-> Identity AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Menu -> Identity Menu) -> UIState -> Identity UIState
Lens' UIState Menu
uiMenu ((Menu -> Identity Menu) -> AppState -> Identity AppState)
-> Menu -> EventM Name AppState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= List Name CategorizedAchievement -> Menu
AchievementsMenu List Name CategorizedAchievement
l'
  BrickEvent Name AppEvent
_ -> () -> EventM Name AppState ()
forall a. a -> EventM Name AppState a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
 where
  returnToMainMenu :: EventM Name AppState ()
returnToMainMenu = (UIState -> Identity UIState) -> AppState -> Identity AppState
Lens' AppState UIState
uiState ((UIState -> Identity UIState) -> AppState -> Identity AppState)
-> ((Menu -> Identity Menu) -> UIState -> Identity UIState)
-> (Menu -> Identity Menu)
-> AppState
-> Identity AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Menu -> Identity Menu) -> UIState -> Identity UIState
Lens' UIState Menu
uiMenu ((Menu -> Identity Menu) -> AppState -> Identity AppState)
-> Menu -> EventM Name AppState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= List Name MainMenuEntry -> Menu
MainMenu (MainMenuEntry -> List Name MainMenuEntry
mainMenu MainMenuEntry
Messages)

handleMainMessagesEvent :: BrickEvent Name AppEvent -> EventM Name AppState ()
handleMainMessagesEvent :: BrickEvent Name AppEvent -> EventM Name AppState ()
handleMainMessagesEvent = \case
  Key Key
V.KEsc -> EventM Name AppState ()
returnToMainMenu
  CharKey Char
'q' -> EventM Name AppState ()
returnToMainMenu
  ControlChar Char
'q' -> EventM Name AppState ()
returnToMainMenu
  BrickEvent Name AppEvent
_ -> () -> EventM Name AppState ()
forall a. a -> EventM Name AppState a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
 where
  returnToMainMenu :: EventM Name AppState ()
returnToMainMenu = (UIState -> Identity UIState) -> AppState -> Identity AppState
Lens' AppState UIState
uiState ((UIState -> Identity UIState) -> AppState -> Identity AppState)
-> ((Menu -> Identity Menu) -> UIState -> Identity UIState)
-> (Menu -> Identity Menu)
-> AppState
-> Identity AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Menu -> Identity Menu) -> UIState -> Identity UIState
Lens' UIState Menu
uiMenu ((Menu -> Identity Menu) -> AppState -> Identity AppState)
-> Menu -> EventM Name AppState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= List Name MainMenuEntry -> Menu
MainMenu (MainMenuEntry -> List Name MainMenuEntry
mainMenu MainMenuEntry
Messages)

-- TODO: #2010 Finish porting Controller to KeyEventHandlers
handleNewGameMenuEvent ::
  NonEmpty (BL.List Name ScenarioItem) ->
  BrickEvent Name AppEvent ->
  EventM Name AppState ()
handleNewGameMenuEvent :: NonEmpty (List Name ScenarioItem)
-> BrickEvent Name AppEvent -> EventM Name AppState ()
handleNewGameMenuEvent scenarioStack :: NonEmpty (List Name ScenarioItem)
scenarioStack@(List Name ScenarioItem
curMenu :| [List Name ScenarioItem]
rest) = \case
  Key Key
V.KEnter ->
    case (Int, ScenarioItem) -> ScenarioItem
forall a b. (a, b) -> b
snd ((Int, ScenarioItem) -> ScenarioItem)
-> Maybe (Int, ScenarioItem) -> Maybe ScenarioItem
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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
curMenu of
      Maybe ScenarioItem
Nothing -> () -> EventM Name AppState ()
forall a. a -> EventM Name AppState a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      Just (SISingle ScenarioInfoPair
siPair) -> EventM Name AppState ()
forall n s. Ord n => EventM n s ()
invalidateCache EventM Name AppState ()
-> EventM Name AppState () -> EventM Name AppState ()
forall a b.
EventM Name AppState a
-> EventM Name AppState b -> EventM Name AppState b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ScenarioInfoPair -> Maybe CodeToRun -> EventM Name AppState ()
forall (m :: * -> *).
(MonadIO m, MonadState AppState m) =>
ScenarioInfoPair -> Maybe CodeToRun -> m ()
startGame ScenarioInfoPair
siPair Maybe CodeToRun
forall a. Maybe a
Nothing
      Just (SICollection Text
_ ScenarioCollection
c) -> do
        Bool
cheat <- Getting Bool AppState Bool -> EventM Name AppState Bool
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Getting Bool AppState Bool -> EventM Name AppState Bool)
-> Getting Bool AppState Bool -> EventM Name AppState Bool
forall a b. (a -> b) -> a -> b
$ (UIState -> Const Bool UIState) -> AppState -> Const Bool AppState
Lens' AppState UIState
uiState ((UIState -> Const Bool UIState)
 -> AppState -> Const Bool AppState)
-> ((Bool -> Const Bool Bool) -> UIState -> Const Bool UIState)
-> Getting Bool AppState Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Const Bool Bool) -> UIState -> Const Bool UIState
Lens' UIState Bool
uiCheatMode
        (UIState -> Identity UIState) -> AppState -> Identity AppState
Lens' AppState UIState
uiState ((UIState -> Identity UIState) -> AppState -> Identity AppState)
-> ((Menu -> Identity Menu) -> UIState -> Identity UIState)
-> (Menu -> Identity Menu)
-> AppState
-> Identity AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Menu -> Identity Menu) -> UIState -> Identity UIState
Lens' UIState Menu
uiMenu ((Menu -> Identity Menu) -> AppState -> Identity AppState)
-> Menu -> EventM Name AppState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= NonEmpty (List Name ScenarioItem) -> Menu
NewGameMenu (List Name ScenarioItem
-> NonEmpty (List Name ScenarioItem)
-> NonEmpty (List Name ScenarioItem)
forall a. a -> NonEmpty a -> NonEmpty a
NE.cons (Bool -> ScenarioCollection -> List Name ScenarioItem
mkScenarioList Bool
cheat ScenarioCollection
c) NonEmpty (List Name ScenarioItem)
scenarioStack)
  CharKey Char
'o' -> EventM Name AppState ()
showLaunchDialog
  CharKey Char
'O' -> EventM Name AppState ()
showLaunchDialog
  Key Key
V.KEsc -> NonEmpty (List Name ScenarioItem) -> EventM Name AppState ()
exitNewGameMenu NonEmpty (List Name ScenarioItem)
scenarioStack
  CharKey Char
'q' -> NonEmpty (List Name ScenarioItem) -> EventM Name AppState ()
exitNewGameMenu NonEmpty (List Name ScenarioItem)
scenarioStack
  ControlChar Char
'q' -> EventM Name AppState ()
forall n s. EventM n s ()
halt
  VtyEvent Event
ev -> do
    List Name ScenarioItem
menu' <- List Name ScenarioItem
-> EventM Name (List Name ScenarioItem) ()
-> EventM Name AppState (List Name ScenarioItem)
forall a n b s. a -> EventM n a b -> EventM n s a
nestEventM' List Name ScenarioItem
curMenu (Event -> EventM Name (List Name ScenarioItem) ()
forall (t :: * -> *) n e.
(Foldable t, Splittable t, Ord n) =>
Event -> EventM n (GenericList n t e) ()
handleListEvent Event
ev)
    (UIState -> Identity UIState) -> AppState -> Identity AppState
Lens' AppState UIState
uiState ((UIState -> Identity UIState) -> AppState -> Identity AppState)
-> ((Menu -> Identity Menu) -> UIState -> Identity UIState)
-> (Menu -> Identity Menu)
-> AppState
-> Identity AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Menu -> Identity Menu) -> UIState -> Identity UIState
Lens' UIState Menu
uiMenu ((Menu -> Identity Menu) -> AppState -> Identity AppState)
-> Menu -> EventM Name AppState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= NonEmpty (List Name ScenarioItem) -> Menu
NewGameMenu (List Name ScenarioItem
menu' List Name ScenarioItem
-> [List Name ScenarioItem] -> NonEmpty (List Name ScenarioItem)
forall a. a -> [a] -> NonEmpty a
:| [List Name ScenarioItem]
rest)
  BrickEvent Name AppEvent
_ -> () -> EventM Name AppState ()
forall a. a -> EventM Name AppState a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
 where
  showLaunchDialog :: EventM Name AppState ()
showLaunchDialog = case (Int, ScenarioItem) -> ScenarioItem
forall a b. (a, b) -> b
snd ((Int, ScenarioItem) -> ScenarioItem)
-> Maybe (Int, ScenarioItem) -> Maybe ScenarioItem
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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
curMenu of
    Just (SISingle ScenarioInfoPair
siPair) -> LensLike'
  (Zoomed (EventM Name LaunchOptions) ()) AppState LaunchOptions
-> EventM Name LaunchOptions () -> EventM Name AppState ()
forall c.
LensLike'
  (Zoomed (EventM Name LaunchOptions) c) AppState LaunchOptions
-> EventM Name LaunchOptions c -> EventM Name AppState c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
Brick.zoom ((UIState -> Focusing (StateT (EventState Name) IO) () UIState)
-> AppState -> Focusing (StateT (EventState Name) IO) () AppState
Lens' AppState UIState
uiState ((UIState -> Focusing (StateT (EventState Name) IO) () UIState)
 -> AppState -> Focusing (StateT (EventState Name) IO) () AppState)
-> ((LaunchOptions
     -> Focusing (StateT (EventState Name) IO) () LaunchOptions)
    -> UIState -> Focusing (StateT (EventState Name) IO) () UIState)
-> (LaunchOptions
    -> Focusing (StateT (EventState Name) IO) () LaunchOptions)
-> AppState
-> Focusing (StateT (EventState Name) IO) () AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LaunchOptions
 -> Focusing (StateT (EventState Name) IO) () LaunchOptions)
-> UIState -> Focusing (StateT (EventState Name) IO) () UIState
Lens' UIState LaunchOptions
uiLaunchConfig) (EventM Name LaunchOptions () -> EventM Name AppState ())
-> EventM Name LaunchOptions () -> EventM Name AppState ()
forall a b. (a -> b) -> a -> b
$ ScenarioInfoPair -> EventM Name LaunchOptions ()
prepareLaunchDialog ScenarioInfoPair
siPair
    Maybe ScenarioItem
_ -> () -> EventM Name AppState ()
forall a. a -> EventM Name AppState a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

exitNewGameMenu :: NonEmpty (BL.List Name ScenarioItem) -> EventM Name AppState ()
exitNewGameMenu :: NonEmpty (List Name ScenarioItem) -> EventM Name AppState ()
exitNewGameMenu NonEmpty (List Name ScenarioItem)
stk = do
  (UIState -> Identity UIState) -> AppState -> Identity AppState
Lens' AppState UIState
uiState
    ((UIState -> Identity UIState) -> AppState -> Identity AppState)
-> ((Menu -> Identity Menu) -> UIState -> Identity UIState)
-> (Menu -> Identity Menu)
-> AppState
-> Identity AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Menu -> Identity Menu) -> UIState -> Identity UIState
Lens' UIState Menu
uiMenu
    ((Menu -> Identity Menu) -> AppState -> Identity AppState)
-> Menu -> EventM Name AppState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= case (List Name ScenarioItem, Maybe (NonEmpty (List Name ScenarioItem)))
-> Maybe (NonEmpty (List Name ScenarioItem))
forall a b. (a, b) -> b
snd (NonEmpty (List Name ScenarioItem)
-> (List Name ScenarioItem,
    Maybe (NonEmpty (List Name ScenarioItem)))
forall a. NonEmpty a -> (a, Maybe (NonEmpty a))
NE.uncons NonEmpty (List Name ScenarioItem)
stk) of
      Maybe (NonEmpty (List Name ScenarioItem))
Nothing -> List Name MainMenuEntry -> Menu
MainMenu (MainMenuEntry -> List Name MainMenuEntry
mainMenu MainMenuEntry
NewGame)
      Just NonEmpty (List Name ScenarioItem)
stk' -> NonEmpty (List Name ScenarioItem) -> Menu
NewGameMenu NonEmpty (List Name ScenarioItem)
stk'

pressAnyKey :: Menu -> BrickEvent Name AppEvent -> EventM Name AppState ()
pressAnyKey :: Menu -> BrickEvent Name AppEvent -> EventM Name AppState ()
pressAnyKey Menu
m (VtyEvent (V.EvKey Key
_ [Modifier]
_)) = (UIState -> Identity UIState) -> AppState -> Identity AppState
Lens' AppState UIState
uiState ((UIState -> Identity UIState) -> AppState -> Identity AppState)
-> ((Menu -> Identity Menu) -> UIState -> Identity UIState)
-> (Menu -> Identity Menu)
-> AppState
-> Identity AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Menu -> Identity Menu) -> UIState -> Identity UIState
Lens' UIState Menu
uiMenu ((Menu -> Identity Menu) -> AppState -> Identity AppState)
-> Menu -> EventM Name AppState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Menu
m
pressAnyKey Menu
_ BrickEvent Name AppEvent
_ = () -> EventM Name AppState ()
forall a. a -> EventM Name AppState a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

-- | The top-level event handler while we are running the game itself.
handleMainEvent :: Bool -> BrickEvent Name AppEvent -> EventM Name AppState ()
handleMainEvent :: Bool -> BrickEvent Name AppEvent -> EventM Name AppState ()
handleMainEvent Bool
forceRedraw BrickEvent Name AppEvent
ev = do
  AppState
s <- EventM Name AppState AppState
forall s (m :: * -> *). MonadState s m => m s
get
  let keyHandler :: KeyDispatcher SwarmEvent (EventM Name AppState)
keyHandler = AppState
s AppState
-> Getting
     (KeyDispatcher SwarmEvent (EventM Name AppState))
     AppState
     (KeyDispatcher SwarmEvent (EventM Name AppState))
-> KeyDispatcher SwarmEvent (EventM Name AppState)
forall s a. s -> Getting a s a -> a
^. (KeyEventHandlingState
 -> Const
      (KeyDispatcher SwarmEvent (EventM Name AppState))
      KeyEventHandlingState)
-> AppState
-> Const (KeyDispatcher SwarmEvent (EventM Name AppState)) AppState
Lens' AppState KeyEventHandlingState
keyEventHandling ((KeyEventHandlingState
  -> Const
       (KeyDispatcher SwarmEvent (EventM Name AppState))
       KeyEventHandlingState)
 -> AppState
 -> Const
      (KeyDispatcher SwarmEvent (EventM Name AppState)) AppState)
-> ((KeyDispatcher SwarmEvent (EventM Name AppState)
     -> Const
          (KeyDispatcher SwarmEvent (EventM Name AppState))
          (KeyDispatcher SwarmEvent (EventM Name AppState)))
    -> KeyEventHandlingState
    -> Const
         (KeyDispatcher SwarmEvent (EventM Name AppState))
         KeyEventHandlingState)
-> Getting
     (KeyDispatcher SwarmEvent (EventM Name AppState))
     AppState
     (KeyDispatcher SwarmEvent (EventM Name AppState))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SwarmKeyDispatchers
 -> Const
      (KeyDispatcher SwarmEvent (EventM Name AppState))
      SwarmKeyDispatchers)
-> KeyEventHandlingState
-> Const
     (KeyDispatcher SwarmEvent (EventM Name AppState))
     KeyEventHandlingState
Lens' KeyEventHandlingState SwarmKeyDispatchers
keyDispatchers ((SwarmKeyDispatchers
  -> Const
       (KeyDispatcher SwarmEvent (EventM Name AppState))
       SwarmKeyDispatchers)
 -> KeyEventHandlingState
 -> Const
      (KeyDispatcher SwarmEvent (EventM Name AppState))
      KeyEventHandlingState)
-> ((KeyDispatcher SwarmEvent (EventM Name AppState)
     -> Const
          (KeyDispatcher SwarmEvent (EventM Name AppState))
          (KeyDispatcher SwarmEvent (EventM Name AppState)))
    -> SwarmKeyDispatchers
    -> Const
         (KeyDispatcher SwarmEvent (EventM Name AppState))
         SwarmKeyDispatchers)
-> (KeyDispatcher SwarmEvent (EventM Name AppState)
    -> Const
         (KeyDispatcher SwarmEvent (EventM Name AppState))
         (KeyDispatcher SwarmEvent (EventM Name AppState)))
-> KeyEventHandlingState
-> Const
     (KeyDispatcher SwarmEvent (EventM Name AppState))
     KeyEventHandlingState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SwarmKeyDispatchers
 -> KeyDispatcher SwarmEvent (EventM Name AppState))
-> (KeyDispatcher SwarmEvent (EventM Name AppState)
    -> Const
         (KeyDispatcher SwarmEvent (EventM Name AppState))
         (KeyDispatcher SwarmEvent (EventM Name AppState)))
-> SwarmKeyDispatchers
-> Const
     (KeyDispatcher SwarmEvent (EventM Name AppState))
     SwarmKeyDispatchers
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to SwarmKeyDispatchers
-> KeyDispatcher SwarmEvent (EventM Name AppState)
mainGameDispatcher
  case BrickEvent Name AppEvent
ev of
    AppEvent AppEvent
ae -> case AppEvent
ae of
      AppEvent
Frame
        -- If the game is paused, don't run any game ticks, but do redraw the screen
        -- if a redraw is forced.
        | AppState
s AppState -> Getting Bool AppState Bool -> Bool
forall s a. s -> Getting a s a -> a
^. (GameState -> Const Bool GameState)
-> AppState -> Const Bool AppState
Lens' AppState GameState
gameState ((GameState -> Const Bool GameState)
 -> AppState -> Const Bool AppState)
-> ((Bool -> Const Bool Bool) -> GameState -> Const Bool GameState)
-> Getting Bool AppState Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TemporalState -> Const Bool TemporalState)
-> GameState -> Const Bool GameState
Lens' GameState TemporalState
temporal ((TemporalState -> Const Bool TemporalState)
 -> GameState -> Const Bool GameState)
-> ((Bool -> Const Bool Bool)
    -> TemporalState -> Const Bool TemporalState)
-> (Bool -> Const Bool Bool)
-> GameState
-> Const Bool GameState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Const Bool Bool)
-> TemporalState -> Const Bool TemporalState
Getter TemporalState Bool
paused -> Bool -> EventM Name AppState () -> EventM Name AppState ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
forceRedraw EventM Name AppState ()
forall n s. EventM n s ()
continueWithoutRedraw
        | Bool
otherwise -> Bool -> EventM Name AppState ()
runFrameUI Bool
forceRedraw
      Web (RunWebCode Text
c) -> Text -> EventM Name AppState ()
forall (m :: * -> *). MonadState AppState m => Text -> m ()
runBaseWebCode Text
c
      AppEvent
_ -> EventM Name AppState ()
forall n s. EventM n s ()
continueWithoutRedraw
    VtyEvent (V.EvResize Int
_ Int
_) -> EventM Name AppState ()
forall n s. Ord n => EventM n s ()
invalidateCache
    BrickEvent Name AppEvent
EscapeKey | Just Modal
m <- AppState
s AppState
-> Getting (Maybe Modal) AppState (Maybe Modal) -> Maybe Modal
forall s a. s -> Getting a s a -> a
^. (UIState -> Const (Maybe Modal) UIState)
-> AppState -> Const (Maybe Modal) AppState
Lens' AppState UIState
uiState ((UIState -> Const (Maybe Modal) UIState)
 -> AppState -> Const (Maybe Modal) AppState)
-> ((Maybe Modal -> Const (Maybe Modal) (Maybe Modal))
    -> UIState -> Const (Maybe Modal) UIState)
-> Getting (Maybe Modal) AppState (Maybe Modal)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UIGameplay -> Const (Maybe Modal) UIGameplay)
-> UIState -> Const (Maybe Modal) UIState
Lens' UIState UIGameplay
uiGameplay ((UIGameplay -> Const (Maybe Modal) UIGameplay)
 -> UIState -> Const (Maybe Modal) UIState)
-> ((Maybe Modal -> Const (Maybe Modal) (Maybe Modal))
    -> UIGameplay -> Const (Maybe Modal) UIGameplay)
-> (Maybe Modal -> Const (Maybe Modal) (Maybe Modal))
-> UIState
-> Const (Maybe Modal) UIState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Modal -> Const (Maybe Modal) (Maybe Modal))
-> UIGameplay -> Const (Maybe Modal) UIGameplay
Lens' UIGameplay (Maybe Modal)
uiModal -> Modal -> EventM Name AppState ()
closeModal Modal
m
    -- Pass to key handler (allows users to configure bindings)
    -- See Note [how Swarm event handlers work]
    VtyEvent (V.EvKey Key
k [Modifier]
m)
      | Maybe (KeyHandler SwarmEvent (EventM Name AppState)) -> Bool
forall a. Maybe a -> Bool
isJust (Key
-> [Modifier]
-> KeyDispatcher SwarmEvent (EventM Name AppState)
-> Maybe (KeyHandler SwarmEvent (EventM Name AppState))
forall k (m :: * -> *).
Key -> [Modifier] -> KeyDispatcher k m -> Maybe (KeyHandler k m)
B.lookupVtyEvent Key
k [Modifier]
m KeyDispatcher SwarmEvent (EventM Name AppState)
keyHandler) -> EventM Name AppState Bool -> EventM Name AppState ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (EventM Name AppState Bool -> EventM Name AppState ())
-> EventM Name AppState Bool -> EventM Name AppState ()
forall a b. (a -> b) -> a -> b
$ KeyDispatcher SwarmEvent (EventM Name AppState)
-> Key -> [Modifier] -> EventM Name AppState Bool
forall (m :: * -> *) k.
Monad m =>
KeyDispatcher k m -> Key -> [Modifier] -> m Bool
B.handleKey KeyDispatcher SwarmEvent (EventM Name AppState)
keyHandler Key
k [Modifier]
m
    -- pass keys on to modal event handler if a modal is open
    VtyEvent Event
vev
      | Maybe Modal -> Bool
forall a. Maybe a -> Bool
isJust (AppState
s AppState
-> Getting (Maybe Modal) AppState (Maybe Modal) -> Maybe Modal
forall s a. s -> Getting a s a -> a
^. (UIState -> Const (Maybe Modal) UIState)
-> AppState -> Const (Maybe Modal) AppState
Lens' AppState UIState
uiState ((UIState -> Const (Maybe Modal) UIState)
 -> AppState -> Const (Maybe Modal) AppState)
-> ((Maybe Modal -> Const (Maybe Modal) (Maybe Modal))
    -> UIState -> Const (Maybe Modal) UIState)
-> Getting (Maybe Modal) AppState (Maybe Modal)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UIGameplay -> Const (Maybe Modal) UIGameplay)
-> UIState -> Const (Maybe Modal) UIState
Lens' UIState UIGameplay
uiGameplay ((UIGameplay -> Const (Maybe Modal) UIGameplay)
 -> UIState -> Const (Maybe Modal) UIState)
-> ((Maybe Modal -> Const (Maybe Modal) (Maybe Modal))
    -> UIGameplay -> Const (Maybe Modal) UIGameplay)
-> (Maybe Modal -> Const (Maybe Modal) (Maybe Modal))
-> UIState
-> Const (Maybe Modal) UIState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Modal -> Const (Maybe Modal) (Maybe Modal))
-> UIGameplay -> Const (Maybe Modal) UIGameplay
Lens' UIGameplay (Maybe Modal)
uiModal) -> Event -> EventM Name AppState ()
handleModalEvent Event
vev
    MouseDown (TerrainListItem Int
pos) Button
V.BLeft [Modifier]
_ Location
_ ->
      (UIState -> Identity UIState) -> AppState -> Identity AppState
Lens' AppState UIState
uiState ((UIState -> Identity UIState) -> AppState -> Identity AppState)
-> ((List Name TerrainType -> Identity (List Name TerrainType))
    -> UIState -> Identity UIState)
-> (List Name TerrainType -> Identity (List Name TerrainType))
-> AppState
-> Identity AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UIGameplay -> Identity UIGameplay) -> UIState -> Identity UIState
Lens' UIState UIGameplay
uiGameplay ((UIGameplay -> Identity UIGameplay)
 -> UIState -> Identity UIState)
-> ((List Name TerrainType -> Identity (List Name TerrainType))
    -> UIGameplay -> Identity UIGameplay)
-> (List Name TerrainType -> Identity (List Name TerrainType))
-> UIState
-> Identity UIState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WorldEditor Name -> Identity (WorldEditor Name))
-> UIGameplay -> Identity UIGameplay
Lens' UIGameplay (WorldEditor Name)
uiWorldEditor ((WorldEditor Name -> Identity (WorldEditor Name))
 -> UIGameplay -> Identity UIGameplay)
-> ((List Name TerrainType -> Identity (List Name TerrainType))
    -> WorldEditor Name -> Identity (WorldEditor Name))
-> (List Name TerrainType -> Identity (List Name TerrainType))
-> UIGameplay
-> Identity UIGameplay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (List Name TerrainType -> Identity (List Name TerrainType))
-> WorldEditor Name -> Identity (WorldEditor Name)
forall n (f :: * -> *).
Functor f =>
(List n TerrainType -> f (List n TerrainType))
-> WorldEditor n -> f (WorldEditor n)
terrainList ((List Name TerrainType -> Identity (List Name TerrainType))
 -> AppState -> Identity AppState)
-> (List Name TerrainType -> List Name TerrainType)
-> EventM Name AppState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= Int -> List Name TerrainType -> List Name TerrainType
forall (t :: * -> *) n e.
(Foldable t, Splittable t) =>
Int -> GenericList n t e -> GenericList n t e
BL.listMoveTo Int
pos
    MouseDown (EntityPaintListItem Int
pos) Button
V.BLeft [Modifier]
_ Location
_ ->
      (UIState -> Identity UIState) -> AppState -> Identity AppState
Lens' AppState UIState
uiState ((UIState -> Identity UIState) -> AppState -> Identity AppState)
-> ((List Name EntityFacade -> Identity (List Name EntityFacade))
    -> UIState -> Identity UIState)
-> (List Name EntityFacade -> Identity (List Name EntityFacade))
-> AppState
-> Identity AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UIGameplay -> Identity UIGameplay) -> UIState -> Identity UIState
Lens' UIState UIGameplay
uiGameplay ((UIGameplay -> Identity UIGameplay)
 -> UIState -> Identity UIState)
-> ((List Name EntityFacade -> Identity (List Name EntityFacade))
    -> UIGameplay -> Identity UIGameplay)
-> (List Name EntityFacade -> Identity (List Name EntityFacade))
-> UIState
-> Identity UIState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WorldEditor Name -> Identity (WorldEditor Name))
-> UIGameplay -> Identity UIGameplay
Lens' UIGameplay (WorldEditor Name)
uiWorldEditor ((WorldEditor Name -> Identity (WorldEditor Name))
 -> UIGameplay -> Identity UIGameplay)
-> ((List Name EntityFacade -> Identity (List Name EntityFacade))
    -> WorldEditor Name -> Identity (WorldEditor Name))
-> (List Name EntityFacade -> Identity (List Name EntityFacade))
-> UIGameplay
-> Identity UIGameplay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (List Name EntityFacade -> Identity (List Name EntityFacade))
-> WorldEditor Name -> Identity (WorldEditor Name)
forall n (f :: * -> *).
Functor f =>
(List n EntityFacade -> f (List n EntityFacade))
-> WorldEditor n -> f (WorldEditor n)
entityPaintList ((List Name EntityFacade -> Identity (List Name EntityFacade))
 -> AppState -> Identity AppState)
-> (List Name EntityFacade -> List Name EntityFacade)
-> EventM Name AppState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= Int -> List Name EntityFacade -> List Name EntityFacade
forall (t :: * -> *) n e.
(Foldable t, Splittable t) =>
Int -> GenericList n t e -> GenericList n t e
BL.listMoveTo Int
pos
    MouseDown Name
WorldPositionIndicator Button
_ [Modifier]
_ Location
_ -> (UIState -> Identity UIState) -> AppState -> Identity AppState
Lens' AppState UIState
uiState ((UIState -> Identity UIState) -> AppState -> Identity AppState)
-> ((Maybe (Cosmic Coords) -> Identity (Maybe (Cosmic Coords)))
    -> UIState -> Identity UIState)
-> (Maybe (Cosmic Coords) -> Identity (Maybe (Cosmic Coords)))
-> AppState
-> Identity AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UIGameplay -> Identity UIGameplay) -> UIState -> Identity UIState
Lens' UIState UIGameplay
uiGameplay ((UIGameplay -> Identity UIGameplay)
 -> UIState -> Identity UIState)
-> ((Maybe (Cosmic Coords) -> Identity (Maybe (Cosmic Coords)))
    -> UIGameplay -> Identity UIGameplay)
-> (Maybe (Cosmic Coords) -> Identity (Maybe (Cosmic Coords)))
-> UIState
-> Identity UIState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe (Cosmic Coords) -> Identity (Maybe (Cosmic Coords)))
-> UIGameplay -> Identity UIGameplay
Lens' UIGameplay (Maybe (Cosmic Coords))
uiWorldCursor ((Maybe (Cosmic Coords) -> Identity (Maybe (Cosmic Coords)))
 -> AppState -> Identity AppState)
-> Maybe (Cosmic Coords) -> EventM Name AppState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Maybe (Cosmic Coords)
forall a. Maybe a
Nothing
    MouseDown (FocusablePanel FocusablePanel
WorldPanel) Button
V.BMiddle [Modifier]
_ Location
mouseLoc ->
      -- Eye Dropper tool
      Location -> EventM Name AppState ()
EC.handleMiddleClick Location
mouseLoc
    MouseDown (FocusablePanel FocusablePanel
WorldPanel) Button
V.BRight [Modifier]
_ Location
mouseLoc ->
      -- Eraser tool
      Location -> EventM Name AppState ()
EC.handleRightClick Location
mouseLoc
    MouseDown (FocusablePanel FocusablePanel
WorldPanel) Button
V.BLeft [Modifier
V.MCtrl] Location
mouseLoc ->
      -- Paint with the World Editor
      Location -> EventM Name AppState ()
EC.handleCtrlLeftClick Location
mouseLoc
    MouseDown Name
n Button
_ [Modifier]
_ Location
mouseLoc ->
      case Name
n of
        FocusablePanel FocusablePanel
WorldPanel -> do
          Maybe (Cosmic Coords)
mouseCoordsM <- LensLike'
  (Zoomed (EventM Name GameState) (Maybe (Cosmic Coords)))
  AppState
  GameState
-> EventM Name GameState (Maybe (Cosmic Coords))
-> EventM Name AppState (Maybe (Cosmic Coords))
forall c.
LensLike' (Zoomed (EventM Name GameState) c) AppState GameState
-> EventM Name GameState c -> EventM Name AppState c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
Brick.zoom (GameState
 -> Focusing
      (StateT (EventState Name) IO) (Maybe (Cosmic Coords)) GameState)
-> AppState
-> Focusing
     (StateT (EventState Name) IO) (Maybe (Cosmic Coords)) AppState
LensLike'
  (Zoomed (EventM Name GameState) (Maybe (Cosmic Coords)))
  AppState
  GameState
Lens' AppState GameState
gameState (EventM Name GameState (Maybe (Cosmic Coords))
 -> EventM Name AppState (Maybe (Cosmic Coords)))
-> EventM Name GameState (Maybe (Cosmic Coords))
-> EventM Name AppState (Maybe (Cosmic Coords))
forall a b. (a -> b) -> a -> b
$ Location -> EventM Name GameState (Maybe (Cosmic Coords))
mouseLocToWorldCoords Location
mouseLoc
          Bool
shouldUpdateCursor <- Maybe (Cosmic Coords) -> EventM Name AppState Bool
EC.updateAreaBounds Maybe (Cosmic Coords)
mouseCoordsM
          Bool -> EventM Name AppState () -> EventM Name AppState ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
shouldUpdateCursor (EventM Name AppState () -> EventM Name AppState ())
-> EventM Name AppState () -> EventM Name AppState ()
forall a b. (a -> b) -> a -> b
$
            (UIState -> Identity UIState) -> AppState -> Identity AppState
Lens' AppState UIState
uiState ((UIState -> Identity UIState) -> AppState -> Identity AppState)
-> ((Maybe (Cosmic Coords) -> Identity (Maybe (Cosmic Coords)))
    -> UIState -> Identity UIState)
-> (Maybe (Cosmic Coords) -> Identity (Maybe (Cosmic Coords)))
-> AppState
-> Identity AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UIGameplay -> Identity UIGameplay) -> UIState -> Identity UIState
Lens' UIState UIGameplay
uiGameplay ((UIGameplay -> Identity UIGameplay)
 -> UIState -> Identity UIState)
-> ((Maybe (Cosmic Coords) -> Identity (Maybe (Cosmic Coords)))
    -> UIGameplay -> Identity UIGameplay)
-> (Maybe (Cosmic Coords) -> Identity (Maybe (Cosmic Coords)))
-> UIState
-> Identity UIState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe (Cosmic Coords) -> Identity (Maybe (Cosmic Coords)))
-> UIGameplay -> Identity UIGameplay
Lens' UIGameplay (Maybe (Cosmic Coords))
uiWorldCursor ((Maybe (Cosmic Coords) -> Identity (Maybe (Cosmic Coords)))
 -> AppState -> Identity AppState)
-> Maybe (Cosmic Coords) -> EventM Name AppState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Maybe (Cosmic Coords)
mouseCoordsM
        Name
REPLInput -> BrickEvent Name AppEvent -> EventM Name AppState ()
handleREPLEvent BrickEvent Name AppEvent
ev
        Name
_ -> EventM Name AppState ()
forall n s. EventM n s ()
continueWithoutRedraw
    MouseUp Name
n Maybe Button
_ Location
_mouseLoc -> do
      case Name
n of
        InventoryListItem Int
pos -> (UIState -> Identity UIState) -> AppState -> Identity AppState
Lens' AppState UIState
uiState ((UIState -> Identity UIState) -> AppState -> Identity AppState)
-> ((List Name InventoryListEntry
     -> Identity (List Name InventoryListEntry))
    -> UIState -> Identity UIState)
-> (List Name InventoryListEntry
    -> Identity (List Name InventoryListEntry))
-> AppState
-> Identity AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UIGameplay -> Identity UIGameplay) -> UIState -> Identity UIState
Lens' UIState UIGameplay
uiGameplay ((UIGameplay -> Identity UIGameplay)
 -> UIState -> Identity UIState)
-> ((List Name InventoryListEntry
     -> Identity (List Name InventoryListEntry))
    -> UIGameplay -> Identity UIGameplay)
-> (List Name InventoryListEntry
    -> Identity (List Name InventoryListEntry))
-> UIState
-> Identity UIState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UIInventory -> Identity UIInventory)
-> UIGameplay -> Identity UIGameplay
Lens' UIGameplay UIInventory
uiInventory ((UIInventory -> Identity UIInventory)
 -> UIGameplay -> Identity UIGameplay)
-> ((List Name InventoryListEntry
     -> Identity (List Name InventoryListEntry))
    -> UIInventory -> Identity UIInventory)
-> (List Name InventoryListEntry
    -> Identity (List Name InventoryListEntry))
-> UIGameplay
-> Identity UIGameplay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe (Int, List Name InventoryListEntry)
 -> Identity (Maybe (Int, List Name InventoryListEntry)))
-> UIInventory -> Identity UIInventory
Lens' UIInventory (Maybe (Int, List Name InventoryListEntry))
uiInventoryList ((Maybe (Int, List Name InventoryListEntry)
  -> Identity (Maybe (Int, List Name InventoryListEntry)))
 -> UIInventory -> Identity UIInventory)
-> ((List Name InventoryListEntry
     -> Identity (List Name InventoryListEntry))
    -> Maybe (Int, List Name InventoryListEntry)
    -> Identity (Maybe (Int, List Name InventoryListEntry)))
-> (List Name InventoryListEntry
    -> Identity (List Name InventoryListEntry))
-> UIInventory
-> Identity UIInventory
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, List Name InventoryListEntry)
 -> Identity (Int, List Name InventoryListEntry))
-> Maybe (Int, List Name InventoryListEntry)
-> Identity (Maybe (Int, List Name InventoryListEntry))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse (((Int, List Name InventoryListEntry)
  -> Identity (Int, List Name InventoryListEntry))
 -> Maybe (Int, List Name InventoryListEntry)
 -> Identity (Maybe (Int, List Name InventoryListEntry)))
-> ((List Name InventoryListEntry
     -> Identity (List Name InventoryListEntry))
    -> (Int, List Name InventoryListEntry)
    -> Identity (Int, List Name InventoryListEntry))
-> (List Name InventoryListEntry
    -> Identity (List Name InventoryListEntry))
-> Maybe (Int, List Name InventoryListEntry)
-> Identity (Maybe (Int, List Name InventoryListEntry))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (List Name InventoryListEntry
 -> Identity (List Name InventoryListEntry))
-> (Int, List Name InventoryListEntry)
-> Identity (Int, List Name InventoryListEntry)
forall s t a b. Field2 s t a b => Lens s t a b
Lens
  (Int, List Name InventoryListEntry)
  (Int, List Name InventoryListEntry)
  (List Name InventoryListEntry)
  (List Name InventoryListEntry)
_2 ((List Name InventoryListEntry
  -> Identity (List Name InventoryListEntry))
 -> AppState -> Identity AppState)
-> (List Name InventoryListEntry -> List Name InventoryListEntry)
-> EventM Name AppState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= Int -> List Name InventoryListEntry -> List Name InventoryListEntry
forall (t :: * -> *) n e.
(Foldable t, Splittable t) =>
Int -> GenericList n t e -> GenericList n t e
BL.listMoveTo Int
pos
        x :: Name
x@(WorldEditorPanelControl WorldEditorFocusable
y) -> do
          (UIState -> Identity UIState) -> AppState -> Identity AppState
Lens' AppState UIState
uiState ((UIState -> Identity UIState) -> AppState -> Identity AppState)
-> ((FocusRing Name -> Identity (FocusRing Name))
    -> UIState -> Identity UIState)
-> (FocusRing Name -> Identity (FocusRing Name))
-> AppState
-> Identity AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UIGameplay -> Identity UIGameplay) -> UIState -> Identity UIState
Lens' UIState UIGameplay
uiGameplay ((UIGameplay -> Identity UIGameplay)
 -> UIState -> Identity UIState)
-> ((FocusRing Name -> Identity (FocusRing Name))
    -> UIGameplay -> Identity UIGameplay)
-> (FocusRing Name -> Identity (FocusRing Name))
-> UIState
-> Identity UIState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WorldEditor Name -> Identity (WorldEditor Name))
-> UIGameplay -> Identity UIGameplay
Lens' UIGameplay (WorldEditor Name)
uiWorldEditor ((WorldEditor Name -> Identity (WorldEditor Name))
 -> UIGameplay -> Identity UIGameplay)
-> ((FocusRing Name -> Identity (FocusRing Name))
    -> WorldEditor Name -> Identity (WorldEditor Name))
-> (FocusRing Name -> Identity (FocusRing Name))
-> UIGameplay
-> Identity UIGameplay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FocusRing Name -> Identity (FocusRing Name))
-> WorldEditor Name -> Identity (WorldEditor Name)
forall n (f :: * -> *).
Functor f =>
(FocusRing n -> f (FocusRing n))
-> WorldEditor n -> f (WorldEditor n)
editorFocusRing ((FocusRing Name -> Identity (FocusRing Name))
 -> AppState -> Identity AppState)
-> (FocusRing Name -> FocusRing Name) -> EventM Name AppState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= Name -> FocusRing Name -> FocusRing Name
forall n. Eq n => n -> FocusRing n -> FocusRing n
focusSetCurrent Name
x
          WorldEditorFocusable -> EventM Name AppState ()
EC.activateWorldEditorFunction WorldEditorFocusable
y
        Name
_ -> () -> EventM Name AppState ()
forall a. a -> EventM Name AppState a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      (Maybe FocusablePanel
 -> (FocusablePanel -> EventM Name AppState ())
 -> EventM Name AppState ())
-> (FocusablePanel -> EventM Name AppState ())
-> Maybe FocusablePanel
-> EventM Name AppState ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip Maybe FocusablePanel
-> (FocusablePanel -> EventM Name AppState ())
-> EventM Name AppState ()
forall (m :: * -> *) a.
Applicative m =>
Maybe a -> (a -> m ()) -> m ()
whenJust FocusablePanel -> EventM Name AppState ()
setFocus (Maybe FocusablePanel -> EventM Name AppState ())
-> Maybe FocusablePanel -> EventM Name AppState ()
forall a b. (a -> b) -> a -> b
$ case Name
n of
        -- Adapt click event origin to the right panel.  For the world
        -- view, we just use 'Brick.Widgets.Core.clickable'.  However,
        -- the other panels all have a viewport, requiring us to
        -- explicitly set their focus here.
        Name
InventoryList -> FocusablePanel -> Maybe FocusablePanel
forall a. a -> Maybe a
Just FocusablePanel
RobotPanel
        InventoryListItem Int
_ -> FocusablePanel -> Maybe FocusablePanel
forall a. a -> Maybe a
Just FocusablePanel
RobotPanel
        Name
InfoViewport -> FocusablePanel -> Maybe FocusablePanel
forall a. a -> Maybe a
Just FocusablePanel
InfoPanel
        Name
REPLViewport -> FocusablePanel -> Maybe FocusablePanel
forall a. a -> Maybe a
Just FocusablePanel
REPLPanel
        Name
REPLInput -> FocusablePanel -> Maybe FocusablePanel
forall a. a -> Maybe a
Just FocusablePanel
REPLPanel
        WorldEditorPanelControl WorldEditorFocusable
_ -> FocusablePanel -> Maybe FocusablePanel
forall a. a -> Maybe a
Just FocusablePanel
WorldEditorPanel
        Name
_ -> Maybe FocusablePanel
forall a. Maybe a
Nothing
      case Name
n of
        FocusablePanel FocusablePanel
x -> FocusablePanel -> EventM Name AppState ()
setFocus FocusablePanel
x
        Name
_ -> () -> EventM Name AppState ()
forall a. a -> EventM Name AppState a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    -- dispatch any other events to the focused panel handler
    BrickEvent Name AppEvent
_ev -> do
      FocusRing Name
fring <- Getting (FocusRing Name) AppState (FocusRing Name)
-> EventM Name AppState (FocusRing Name)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Getting (FocusRing Name) AppState (FocusRing Name)
 -> EventM Name AppState (FocusRing Name))
-> Getting (FocusRing Name) AppState (FocusRing Name)
-> EventM Name AppState (FocusRing Name)
forall a b. (a -> b) -> a -> b
$ (UIState -> Const (FocusRing Name) UIState)
-> AppState -> Const (FocusRing Name) AppState
Lens' AppState UIState
uiState ((UIState -> Const (FocusRing Name) UIState)
 -> AppState -> Const (FocusRing Name) AppState)
-> ((FocusRing Name -> Const (FocusRing Name) (FocusRing Name))
    -> UIState -> Const (FocusRing Name) UIState)
-> Getting (FocusRing Name) AppState (FocusRing Name)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UIGameplay -> Const (FocusRing Name) UIGameplay)
-> UIState -> Const (FocusRing Name) UIState
Lens' UIState UIGameplay
uiGameplay ((UIGameplay -> Const (FocusRing Name) UIGameplay)
 -> UIState -> Const (FocusRing Name) UIState)
-> ((FocusRing Name -> Const (FocusRing Name) (FocusRing Name))
    -> UIGameplay -> Const (FocusRing Name) UIGameplay)
-> (FocusRing Name -> Const (FocusRing Name) (FocusRing Name))
-> UIState
-> Const (FocusRing Name) UIState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FocusRing Name -> Const (FocusRing Name) (FocusRing Name))
-> UIGameplay -> Const (FocusRing Name) UIGameplay
Lens' UIGameplay (FocusRing Name)
uiFocusRing
      case FocusRing Name -> Maybe Name
forall n. FocusRing n -> Maybe n
focusGetCurrent FocusRing Name
fring of
        Just (FocusablePanel FocusablePanel
x) -> case FocusablePanel
x of
          FocusablePanel
REPLPanel -> BrickEvent Name AppEvent -> EventM Name AppState ()
handleREPLEvent BrickEvent Name AppEvent
ev
          -- Pass to key handler (allows users to configure bindings)
          -- See Note [how Swarm event handlers work]
          FocusablePanel
WorldPanel | VtyEvent (V.EvKey Key
k [Modifier]
m) <- BrickEvent Name AppEvent
ev -> do
            KeyDispatcher SwarmEvent (EventM Name AppState)
wh <- Getting
  (KeyDispatcher SwarmEvent (EventM Name AppState))
  AppState
  (KeyDispatcher SwarmEvent (EventM Name AppState))
-> EventM
     Name AppState (KeyDispatcher SwarmEvent (EventM Name AppState))
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Getting
   (KeyDispatcher SwarmEvent (EventM Name AppState))
   AppState
   (KeyDispatcher SwarmEvent (EventM Name AppState))
 -> EventM
      Name AppState (KeyDispatcher SwarmEvent (EventM Name AppState)))
-> Getting
     (KeyDispatcher SwarmEvent (EventM Name AppState))
     AppState
     (KeyDispatcher SwarmEvent (EventM Name AppState))
-> EventM
     Name AppState (KeyDispatcher SwarmEvent (EventM Name AppState))
forall a b. (a -> b) -> a -> b
$ (KeyEventHandlingState
 -> Const
      (KeyDispatcher SwarmEvent (EventM Name AppState))
      KeyEventHandlingState)
-> AppState
-> Const (KeyDispatcher SwarmEvent (EventM Name AppState)) AppState
Lens' AppState KeyEventHandlingState
keyEventHandling ((KeyEventHandlingState
  -> Const
       (KeyDispatcher SwarmEvent (EventM Name AppState))
       KeyEventHandlingState)
 -> AppState
 -> Const
      (KeyDispatcher SwarmEvent (EventM Name AppState)) AppState)
-> ((KeyDispatcher SwarmEvent (EventM Name AppState)
     -> Const
          (KeyDispatcher SwarmEvent (EventM Name AppState))
          (KeyDispatcher SwarmEvent (EventM Name AppState)))
    -> KeyEventHandlingState
    -> Const
         (KeyDispatcher SwarmEvent (EventM Name AppState))
         KeyEventHandlingState)
-> Getting
     (KeyDispatcher SwarmEvent (EventM Name AppState))
     AppState
     (KeyDispatcher SwarmEvent (EventM Name AppState))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SwarmKeyDispatchers
 -> Const
      (KeyDispatcher SwarmEvent (EventM Name AppState))
      SwarmKeyDispatchers)
-> KeyEventHandlingState
-> Const
     (KeyDispatcher SwarmEvent (EventM Name AppState))
     KeyEventHandlingState
Lens' KeyEventHandlingState SwarmKeyDispatchers
keyDispatchers ((SwarmKeyDispatchers
  -> Const
       (KeyDispatcher SwarmEvent (EventM Name AppState))
       SwarmKeyDispatchers)
 -> KeyEventHandlingState
 -> Const
      (KeyDispatcher SwarmEvent (EventM Name AppState))
      KeyEventHandlingState)
-> ((KeyDispatcher SwarmEvent (EventM Name AppState)
     -> Const
          (KeyDispatcher SwarmEvent (EventM Name AppState))
          (KeyDispatcher SwarmEvent (EventM Name AppState)))
    -> SwarmKeyDispatchers
    -> Const
         (KeyDispatcher SwarmEvent (EventM Name AppState))
         SwarmKeyDispatchers)
-> (KeyDispatcher SwarmEvent (EventM Name AppState)
    -> Const
         (KeyDispatcher SwarmEvent (EventM Name AppState))
         (KeyDispatcher SwarmEvent (EventM Name AppState)))
-> KeyEventHandlingState
-> Const
     (KeyDispatcher SwarmEvent (EventM Name AppState))
     KeyEventHandlingState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SwarmKeyDispatchers
 -> KeyDispatcher SwarmEvent (EventM Name AppState))
-> (KeyDispatcher SwarmEvent (EventM Name AppState)
    -> Const
         (KeyDispatcher SwarmEvent (EventM Name AppState))
         (KeyDispatcher SwarmEvent (EventM Name AppState)))
-> SwarmKeyDispatchers
-> Const
     (KeyDispatcher SwarmEvent (EventM Name AppState))
     SwarmKeyDispatchers
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to SwarmKeyDispatchers
-> KeyDispatcher SwarmEvent (EventM Name AppState)
worldDispatcher
            EventM Name AppState Bool -> EventM Name AppState ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (EventM Name AppState Bool -> EventM Name AppState ())
-> EventM Name AppState Bool -> EventM Name AppState ()
forall a b. (a -> b) -> a -> b
$ KeyDispatcher SwarmEvent (EventM Name AppState)
-> Key -> [Modifier] -> EventM Name AppState Bool
forall (m :: * -> *) k.
Monad m =>
KeyDispatcher k m -> Key -> [Modifier] -> m Bool
B.handleKey KeyDispatcher SwarmEvent (EventM Name AppState)
wh Key
k [Modifier]
m
          FocusablePanel
WorldPanel | Bool
otherwise -> EventM Name AppState ()
forall n s. EventM n s ()
continueWithoutRedraw
          FocusablePanel
WorldEditorPanel -> BrickEvent Name AppEvent -> EventM Name AppState ()
EC.handleWorldEditorPanelEvent BrickEvent Name AppEvent
ev
          FocusablePanel
RobotPanel -> BrickEvent Name AppEvent -> EventM Name AppState ()
handleRobotPanelEvent BrickEvent Name AppEvent
ev
          FocusablePanel
InfoPanel -> ViewportScroll Name
-> BrickEvent Name AppEvent -> EventM Name AppState ()
handleInfoPanelEvent ViewportScroll Name
infoScroll BrickEvent Name AppEvent
ev
        Maybe Name
_ -> EventM Name AppState ()
forall n s. EventM n s ()
continueWithoutRedraw

closeModal :: Modal -> EventM Name AppState ()
closeModal :: Modal -> EventM Name AppState ()
closeModal Modal
m = do
  EventM Name AppState ()
safeAutoUnpause
  (UIState -> Identity UIState) -> AppState -> Identity AppState
Lens' AppState UIState
uiState ((UIState -> Identity UIState) -> AppState -> Identity AppState)
-> ((Maybe Modal -> Identity (Maybe Modal))
    -> UIState -> Identity UIState)
-> (Maybe Modal -> Identity (Maybe Modal))
-> AppState
-> Identity AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UIGameplay -> Identity UIGameplay) -> UIState -> Identity UIState
Lens' UIState UIGameplay
uiGameplay ((UIGameplay -> Identity UIGameplay)
 -> UIState -> Identity UIState)
-> ((Maybe Modal -> Identity (Maybe Modal))
    -> UIGameplay -> Identity UIGameplay)
-> (Maybe Modal -> Identity (Maybe Modal))
-> UIState
-> Identity UIState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Modal -> Identity (Maybe Modal))
-> UIGameplay -> Identity UIGameplay
Lens' UIGameplay (Maybe Modal)
uiModal ((Maybe Modal -> Identity (Maybe Modal))
 -> AppState -> Identity AppState)
-> Maybe Modal -> EventM Name AppState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Maybe Modal
forall a. Maybe a
Nothing
  -- message modal is not autopaused, so update notifications when leaving it
  Bool -> EventM Name AppState () -> EventM Name AppState ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ((Modal
m Modal -> Getting ModalType Modal ModalType -> ModalType
forall s a. s -> Getting a s a -> a
^. Getting ModalType Modal ModalType
Lens' Modal ModalType
modalType) ModalType -> ModalType -> Bool
forall a. Eq a => a -> a -> Bool
== ModalType
MessagesModal) (EventM Name AppState () -> EventM Name AppState ())
-> EventM Name AppState () -> EventM Name AppState ()
forall a b. (a -> b) -> a -> b
$ do
    TickNumber
t <- Getting TickNumber AppState TickNumber
-> EventM Name AppState TickNumber
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Getting TickNumber AppState TickNumber
 -> EventM Name AppState TickNumber)
-> Getting TickNumber AppState TickNumber
-> EventM Name AppState TickNumber
forall a b. (a -> b) -> a -> b
$ (GameState -> Const TickNumber GameState)
-> AppState -> Const TickNumber AppState
Lens' AppState GameState
gameState ((GameState -> Const TickNumber GameState)
 -> AppState -> Const TickNumber AppState)
-> ((TickNumber -> Const TickNumber TickNumber)
    -> GameState -> Const TickNumber GameState)
-> Getting TickNumber AppState TickNumber
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TemporalState -> Const TickNumber TemporalState)
-> GameState -> Const TickNumber GameState
Lens' GameState TemporalState
temporal ((TemporalState -> Const TickNumber TemporalState)
 -> GameState -> Const TickNumber GameState)
-> ((TickNumber -> Const TickNumber TickNumber)
    -> TemporalState -> Const TickNumber TemporalState)
-> (TickNumber -> Const TickNumber TickNumber)
-> GameState
-> Const TickNumber GameState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TickNumber -> Const TickNumber TickNumber)
-> TemporalState -> Const TickNumber TemporalState
Lens' TemporalState TickNumber
ticks
    (GameState -> Identity GameState) -> AppState -> Identity AppState
Lens' AppState GameState
gameState ((GameState -> Identity GameState)
 -> AppState -> Identity AppState)
-> ((TickNumber -> Identity TickNumber)
    -> GameState -> Identity GameState)
-> (TickNumber -> Identity TickNumber)
-> AppState
-> Identity AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Messages -> Identity Messages) -> GameState -> Identity GameState
Lens' GameState Messages
messageInfo ((Messages -> Identity Messages)
 -> GameState -> Identity GameState)
-> ((TickNumber -> Identity TickNumber)
    -> Messages -> Identity Messages)
-> (TickNumber -> Identity TickNumber)
-> GameState
-> Identity GameState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TickNumber -> Identity TickNumber)
-> Messages -> Identity Messages
Lens' Messages TickNumber
lastSeenMessageTime ((TickNumber -> Identity TickNumber)
 -> AppState -> Identity AppState)
-> TickNumber -> EventM Name AppState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= TickNumber
t

-- TODO: #2010 Finish porting Controller to KeyEventHandlers
handleModalEvent :: V.Event -> EventM Name AppState ()
handleModalEvent :: Event -> EventM Name AppState ()
handleModalEvent = \case
  V.EvKey Key
V.KEnter [] -> do
    Maybe (Dialog ButtonAction Name)
mdialog <- Getting
  (First (Dialog ButtonAction Name))
  AppState
  (Dialog ButtonAction Name)
-> EventM Name AppState (Maybe (Dialog ButtonAction Name))
forall s (m :: * -> *) a.
MonadState s m =>
Getting (First a) s a -> m (Maybe a)
preuse (Getting
   (First (Dialog ButtonAction Name))
   AppState
   (Dialog ButtonAction Name)
 -> EventM Name AppState (Maybe (Dialog ButtonAction Name)))
-> Getting
     (First (Dialog ButtonAction Name))
     AppState
     (Dialog ButtonAction Name)
-> EventM Name AppState (Maybe (Dialog ButtonAction Name))
forall a b. (a -> b) -> a -> b
$ (UIState -> Const (First (Dialog ButtonAction Name)) UIState)
-> AppState -> Const (First (Dialog ButtonAction Name)) AppState
Lens' AppState UIState
uiState ((UIState -> Const (First (Dialog ButtonAction Name)) UIState)
 -> AppState -> Const (First (Dialog ButtonAction Name)) AppState)
-> ((Dialog ButtonAction Name
     -> Const
          (First (Dialog ButtonAction Name)) (Dialog ButtonAction Name))
    -> UIState -> Const (First (Dialog ButtonAction Name)) UIState)
-> Getting
     (First (Dialog ButtonAction Name))
     AppState
     (Dialog ButtonAction Name)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UIGameplay -> Const (First (Dialog ButtonAction Name)) UIGameplay)
-> UIState -> Const (First (Dialog ButtonAction Name)) UIState
Lens' UIState UIGameplay
uiGameplay ((UIGameplay
  -> Const (First (Dialog ButtonAction Name)) UIGameplay)
 -> UIState -> Const (First (Dialog ButtonAction Name)) UIState)
-> ((Dialog ButtonAction Name
     -> Const
          (First (Dialog ButtonAction Name)) (Dialog ButtonAction Name))
    -> UIGameplay
    -> Const (First (Dialog ButtonAction Name)) UIGameplay)
-> (Dialog ButtonAction Name
    -> Const
         (First (Dialog ButtonAction Name)) (Dialog ButtonAction Name))
-> UIState
-> Const (First (Dialog ButtonAction Name)) UIState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Modal
 -> Const (First (Dialog ButtonAction Name)) (Maybe Modal))
-> UIGameplay
-> Const (First (Dialog ButtonAction Name)) UIGameplay
Lens' UIGameplay (Maybe Modal)
uiModal ((Maybe Modal
  -> Const (First (Dialog ButtonAction Name)) (Maybe Modal))
 -> UIGameplay
 -> Const (First (Dialog ButtonAction Name)) UIGameplay)
-> ((Dialog ButtonAction Name
     -> Const
          (First (Dialog ButtonAction Name)) (Dialog ButtonAction Name))
    -> Maybe Modal
    -> Const (First (Dialog ButtonAction Name)) (Maybe Modal))
-> (Dialog ButtonAction Name
    -> Const
         (First (Dialog ButtonAction Name)) (Dialog ButtonAction Name))
-> UIGameplay
-> Const (First (Dialog ButtonAction Name)) UIGameplay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Modal -> Const (First (Dialog ButtonAction Name)) Modal)
-> Maybe Modal
-> Const (First (Dialog ButtonAction Name)) (Maybe Modal)
forall a b (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p a (f b) -> p (Maybe a) (f (Maybe b))
_Just ((Modal -> Const (First (Dialog ButtonAction Name)) Modal)
 -> Maybe Modal
 -> Const (First (Dialog ButtonAction Name)) (Maybe Modal))
-> ((Dialog ButtonAction Name
     -> Const
          (First (Dialog ButtonAction Name)) (Dialog ButtonAction Name))
    -> Modal -> Const (First (Dialog ButtonAction Name)) Modal)
-> (Dialog ButtonAction Name
    -> Const
         (First (Dialog ButtonAction Name)) (Dialog ButtonAction Name))
-> Maybe Modal
-> Const (First (Dialog ButtonAction Name)) (Maybe Modal)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Dialog ButtonAction Name
 -> Const
      (First (Dialog ButtonAction Name)) (Dialog ButtonAction Name))
-> Modal -> Const (First (Dialog ButtonAction Name)) Modal
Lens' Modal (Dialog ButtonAction Name)
modalDialog
    ModalType -> EventM Name AppState ()
toggleModal ModalType
QuitModal
    case Dialog ButtonAction Name -> Maybe (Name, ButtonAction)
forall n a. Eq n => Dialog a n -> Maybe (n, a)
dialogSelection (Dialog ButtonAction Name -> Maybe (Name, ButtonAction))
-> Maybe (Dialog ButtonAction Name) -> Maybe (Name, ButtonAction)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe (Dialog ButtonAction Name)
mdialog of
      Just (Button Button
QuitButton, ButtonAction
_) -> EventM Name AppState ()
quitGame
      Just (Button Button
KeepPlayingButton, ButtonAction
_) -> ModalType -> EventM Name AppState ()
toggleModal ModalType
KeepPlayingModal
      Just (Button Button
StartOverButton, StartOver Int
currentSeed ScenarioInfoPair
siPair) -> do
        EventM Name AppState ()
forall n s. Ord n => EventM n s ()
invalidateCache
        Int -> ScenarioInfoPair -> EventM Name AppState ()
forall (m :: * -> *).
(MonadIO m, MonadState AppState m) =>
Int -> ScenarioInfoPair -> m ()
restartGame Int
currentSeed ScenarioInfoPair
siPair
      Just (Button Button
NextButton, Next ScenarioInfoPair
siPair) -> do
        EventM Name AppState ()
quitGame
        EventM Name AppState ()
forall n s. Ord n => EventM n s ()
invalidateCache
        ScenarioInfoPair -> Maybe CodeToRun -> EventM Name AppState ()
forall (m :: * -> *).
(MonadIO m, MonadState AppState m) =>
ScenarioInfoPair -> Maybe CodeToRun -> m ()
startGame ScenarioInfoPair
siPair Maybe CodeToRun
forall a. Maybe a
Nothing
      Maybe (Name, ButtonAction)
_ -> () -> EventM Name AppState ()
forall a. a -> EventM Name AppState a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  Event
ev -> do
    LensLike'
  (Zoomed (EventM Name (Dialog ButtonAction Name)) ())
  AppState
  (Dialog ButtonAction Name)
-> EventM Name (Dialog ButtonAction Name) ()
-> EventM Name AppState ()
forall c.
LensLike'
  (Zoomed (EventM Name (Dialog ButtonAction Name)) c)
  AppState
  (Dialog ButtonAction Name)
-> EventM Name (Dialog ButtonAction Name) c
-> EventM Name AppState c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
Brick.zoom ((UIState -> Focusing (StateT (EventState Name) IO) () UIState)
-> AppState -> Focusing (StateT (EventState Name) IO) () AppState
Lens' AppState UIState
uiState ((UIState -> Focusing (StateT (EventState Name) IO) () UIState)
 -> AppState -> Focusing (StateT (EventState Name) IO) () AppState)
-> ((Dialog ButtonAction Name
     -> Focusing
          (StateT (EventState Name) IO) () (Dialog ButtonAction Name))
    -> UIState -> Focusing (StateT (EventState Name) IO) () UIState)
-> (Dialog ButtonAction Name
    -> Focusing
         (StateT (EventState Name) IO) () (Dialog ButtonAction Name))
-> AppState
-> Focusing (StateT (EventState Name) IO) () AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UIGameplay
 -> Focusing (StateT (EventState Name) IO) () UIGameplay)
-> UIState -> Focusing (StateT (EventState Name) IO) () UIState
Lens' UIState UIGameplay
uiGameplay ((UIGameplay
  -> Focusing (StateT (EventState Name) IO) () UIGameplay)
 -> UIState -> Focusing (StateT (EventState Name) IO) () UIState)
-> ((Dialog ButtonAction Name
     -> Focusing
          (StateT (EventState Name) IO) () (Dialog ButtonAction Name))
    -> UIGameplay
    -> Focusing (StateT (EventState Name) IO) () UIGameplay)
-> (Dialog ButtonAction Name
    -> Focusing
         (StateT (EventState Name) IO) () (Dialog ButtonAction Name))
-> UIState
-> Focusing (StateT (EventState Name) IO) () UIState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Modal
 -> Focusing (StateT (EventState Name) IO) () (Maybe Modal))
-> UIGameplay
-> Focusing (StateT (EventState Name) IO) () UIGameplay
Lens' UIGameplay (Maybe Modal)
uiModal ((Maybe Modal
  -> Focusing (StateT (EventState Name) IO) () (Maybe Modal))
 -> UIGameplay
 -> Focusing (StateT (EventState Name) IO) () UIGameplay)
-> ((Dialog ButtonAction Name
     -> Focusing
          (StateT (EventState Name) IO) () (Dialog ButtonAction Name))
    -> Maybe Modal
    -> Focusing (StateT (EventState Name) IO) () (Maybe Modal))
-> (Dialog ButtonAction Name
    -> Focusing
         (StateT (EventState Name) IO) () (Dialog ButtonAction Name))
-> UIGameplay
-> Focusing (StateT (EventState Name) IO) () UIGameplay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Modal -> Focusing (StateT (EventState Name) IO) () Modal)
-> Maybe Modal
-> Focusing (StateT (EventState Name) IO) () (Maybe Modal)
forall a b (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p a (f b) -> p (Maybe a) (f (Maybe b))
_Just ((Modal -> Focusing (StateT (EventState Name) IO) () Modal)
 -> Maybe Modal
 -> Focusing (StateT (EventState Name) IO) () (Maybe Modal))
-> ((Dialog ButtonAction Name
     -> Focusing
          (StateT (EventState Name) IO) () (Dialog ButtonAction Name))
    -> Modal -> Focusing (StateT (EventState Name) IO) () Modal)
-> (Dialog ButtonAction Name
    -> Focusing
         (StateT (EventState Name) IO) () (Dialog ButtonAction Name))
-> Maybe Modal
-> Focusing (StateT (EventState Name) IO) () (Maybe Modal)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Dialog ButtonAction Name
 -> Focusing
      (StateT (EventState Name) IO) () (Dialog ButtonAction Name))
-> Modal -> Focusing (StateT (EventState Name) IO) () Modal
Lens' Modal (Dialog ButtonAction Name)
modalDialog) (Event -> EventM Name (Dialog ButtonAction Name) ()
forall n a. Event -> EventM n (Dialog a n) ()
handleDialogEvent Event
ev)
    Maybe ModalType
modal <- Getting (First ModalType) AppState ModalType
-> EventM Name AppState (Maybe ModalType)
forall s (m :: * -> *) a.
MonadState s m =>
Getting (First a) s a -> m (Maybe a)
preuse (Getting (First ModalType) AppState ModalType
 -> EventM Name AppState (Maybe ModalType))
-> Getting (First ModalType) AppState ModalType
-> EventM Name AppState (Maybe ModalType)
forall a b. (a -> b) -> a -> b
$ (UIState -> Const (First ModalType) UIState)
-> AppState -> Const (First ModalType) AppState
Lens' AppState UIState
uiState ((UIState -> Const (First ModalType) UIState)
 -> AppState -> Const (First ModalType) AppState)
-> ((ModalType -> Const (First ModalType) ModalType)
    -> UIState -> Const (First ModalType) UIState)
-> Getting (First ModalType) AppState ModalType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UIGameplay -> Const (First ModalType) UIGameplay)
-> UIState -> Const (First ModalType) UIState
Lens' UIState UIGameplay
uiGameplay ((UIGameplay -> Const (First ModalType) UIGameplay)
 -> UIState -> Const (First ModalType) UIState)
-> ((ModalType -> Const (First ModalType) ModalType)
    -> UIGameplay -> Const (First ModalType) UIGameplay)
-> (ModalType -> Const (First ModalType) ModalType)
-> UIState
-> Const (First ModalType) UIState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Modal -> Const (First ModalType) (Maybe Modal))
-> UIGameplay -> Const (First ModalType) UIGameplay
Lens' UIGameplay (Maybe Modal)
uiModal ((Maybe Modal -> Const (First ModalType) (Maybe Modal))
 -> UIGameplay -> Const (First ModalType) UIGameplay)
-> ((ModalType -> Const (First ModalType) ModalType)
    -> Maybe Modal -> Const (First ModalType) (Maybe Modal))
-> (ModalType -> Const (First ModalType) ModalType)
-> UIGameplay
-> Const (First ModalType) UIGameplay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Modal -> Const (First ModalType) Modal)
-> Maybe Modal -> Const (First ModalType) (Maybe Modal)
forall a b (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p a (f b) -> p (Maybe a) (f (Maybe b))
_Just ((Modal -> Const (First ModalType) Modal)
 -> Maybe Modal -> Const (First ModalType) (Maybe Modal))
-> ((ModalType -> Const (First ModalType) ModalType)
    -> Modal -> Const (First ModalType) Modal)
-> (ModalType -> Const (First ModalType) ModalType)
-> Maybe Modal
-> Const (First ModalType) (Maybe Modal)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ModalType -> Const (First ModalType) ModalType)
-> Modal -> Const (First ModalType) Modal
Lens' Modal ModalType
modalType
    case Maybe ModalType
modal of
      Just ModalType
TerrainPaletteModal ->
        ((List Name TerrainType
  -> Focusing
       (StateT (EventState Name) IO) () (List Name TerrainType))
 -> AppState -> Focusing (StateT (EventState Name) IO) () AppState)
-> EventM Name AppState ()
forall {t :: * -> *} {n} {e} {t}.
(Foldable t, Splittable t, Ord n) =>
((GenericList n t e
  -> Focusing (StateT (EventState n) IO) () (GenericList n t e))
 -> t -> Focusing (StateT (EventState n) IO) () t)
-> EventM n t ()
refreshList (((List Name TerrainType
   -> Focusing
        (StateT (EventState Name) IO) () (List Name TerrainType))
  -> AppState -> Focusing (StateT (EventState Name) IO) () AppState)
 -> EventM Name AppState ())
-> ((List Name TerrainType
     -> Focusing
          (StateT (EventState Name) IO) () (List Name TerrainType))
    -> AppState -> Focusing (StateT (EventState Name) IO) () AppState)
-> EventM Name AppState ()
forall a b. (a -> b) -> a -> b
$ (UIState -> Focusing (StateT (EventState Name) IO) () UIState)
-> AppState -> Focusing (StateT (EventState Name) IO) () AppState
Lens' AppState UIState
uiState ((UIState -> Focusing (StateT (EventState Name) IO) () UIState)
 -> AppState -> Focusing (StateT (EventState Name) IO) () AppState)
-> ((List Name TerrainType
     -> Focusing
          (StateT (EventState Name) IO) () (List Name TerrainType))
    -> UIState -> Focusing (StateT (EventState Name) IO) () UIState)
-> (List Name TerrainType
    -> Focusing
         (StateT (EventState Name) IO) () (List Name TerrainType))
-> AppState
-> Focusing (StateT (EventState Name) IO) () AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UIGameplay
 -> Focusing (StateT (EventState Name) IO) () UIGameplay)
-> UIState -> Focusing (StateT (EventState Name) IO) () UIState
Lens' UIState UIGameplay
uiGameplay ((UIGameplay
  -> Focusing (StateT (EventState Name) IO) () UIGameplay)
 -> UIState -> Focusing (StateT (EventState Name) IO) () UIState)
-> ((List Name TerrainType
     -> Focusing
          (StateT (EventState Name) IO) () (List Name TerrainType))
    -> UIGameplay
    -> Focusing (StateT (EventState Name) IO) () UIGameplay)
-> (List Name TerrainType
    -> Focusing
         (StateT (EventState Name) IO) () (List Name TerrainType))
-> UIState
-> Focusing (StateT (EventState Name) IO) () UIState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WorldEditor Name
 -> Focusing (StateT (EventState Name) IO) () (WorldEditor Name))
-> UIGameplay
-> Focusing (StateT (EventState Name) IO) () UIGameplay
Lens' UIGameplay (WorldEditor Name)
uiWorldEditor ((WorldEditor Name
  -> Focusing (StateT (EventState Name) IO) () (WorldEditor Name))
 -> UIGameplay
 -> Focusing (StateT (EventState Name) IO) () UIGameplay)
-> ((List Name TerrainType
     -> Focusing
          (StateT (EventState Name) IO) () (List Name TerrainType))
    -> WorldEditor Name
    -> Focusing (StateT (EventState Name) IO) () (WorldEditor Name))
-> (List Name TerrainType
    -> Focusing
         (StateT (EventState Name) IO) () (List Name TerrainType))
-> UIGameplay
-> Focusing (StateT (EventState Name) IO) () UIGameplay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (List Name TerrainType
 -> Focusing
      (StateT (EventState Name) IO) () (List Name TerrainType))
-> WorldEditor Name
-> Focusing (StateT (EventState Name) IO) () (WorldEditor Name)
forall n (f :: * -> *).
Functor f =>
(List n TerrainType -> f (List n TerrainType))
-> WorldEditor n -> f (WorldEditor n)
terrainList
      Just ModalType
EntityPaletteModal -> do
        ((List Name EntityFacade
  -> Focusing
       (StateT (EventState Name) IO) () (List Name EntityFacade))
 -> AppState -> Focusing (StateT (EventState Name) IO) () AppState)
-> EventM Name AppState ()
forall {t :: * -> *} {n} {e} {t}.
(Foldable t, Splittable t, Ord n) =>
((GenericList n t e
  -> Focusing (StateT (EventState n) IO) () (GenericList n t e))
 -> t -> Focusing (StateT (EventState n) IO) () t)
-> EventM n t ()
refreshList (((List Name EntityFacade
   -> Focusing
        (StateT (EventState Name) IO) () (List Name EntityFacade))
  -> AppState -> Focusing (StateT (EventState Name) IO) () AppState)
 -> EventM Name AppState ())
-> ((List Name EntityFacade
     -> Focusing
          (StateT (EventState Name) IO) () (List Name EntityFacade))
    -> AppState -> Focusing (StateT (EventState Name) IO) () AppState)
-> EventM Name AppState ()
forall a b. (a -> b) -> a -> b
$ (UIState -> Focusing (StateT (EventState Name) IO) () UIState)
-> AppState -> Focusing (StateT (EventState Name) IO) () AppState
Lens' AppState UIState
uiState ((UIState -> Focusing (StateT (EventState Name) IO) () UIState)
 -> AppState -> Focusing (StateT (EventState Name) IO) () AppState)
-> ((List Name EntityFacade
     -> Focusing
          (StateT (EventState Name) IO) () (List Name EntityFacade))
    -> UIState -> Focusing (StateT (EventState Name) IO) () UIState)
-> (List Name EntityFacade
    -> Focusing
         (StateT (EventState Name) IO) () (List Name EntityFacade))
-> AppState
-> Focusing (StateT (EventState Name) IO) () AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UIGameplay
 -> Focusing (StateT (EventState Name) IO) () UIGameplay)
-> UIState -> Focusing (StateT (EventState Name) IO) () UIState
Lens' UIState UIGameplay
uiGameplay ((UIGameplay
  -> Focusing (StateT (EventState Name) IO) () UIGameplay)
 -> UIState -> Focusing (StateT (EventState Name) IO) () UIState)
-> ((List Name EntityFacade
     -> Focusing
          (StateT (EventState Name) IO) () (List Name EntityFacade))
    -> UIGameplay
    -> Focusing (StateT (EventState Name) IO) () UIGameplay)
-> (List Name EntityFacade
    -> Focusing
         (StateT (EventState Name) IO) () (List Name EntityFacade))
-> UIState
-> Focusing (StateT (EventState Name) IO) () UIState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WorldEditor Name
 -> Focusing (StateT (EventState Name) IO) () (WorldEditor Name))
-> UIGameplay
-> Focusing (StateT (EventState Name) IO) () UIGameplay
Lens' UIGameplay (WorldEditor Name)
uiWorldEditor ((WorldEditor Name
  -> Focusing (StateT (EventState Name) IO) () (WorldEditor Name))
 -> UIGameplay
 -> Focusing (StateT (EventState Name) IO) () UIGameplay)
-> ((List Name EntityFacade
     -> Focusing
          (StateT (EventState Name) IO) () (List Name EntityFacade))
    -> WorldEditor Name
    -> Focusing (StateT (EventState Name) IO) () (WorldEditor Name))
-> (List Name EntityFacade
    -> Focusing
         (StateT (EventState Name) IO) () (List Name EntityFacade))
-> UIGameplay
-> Focusing (StateT (EventState Name) IO) () UIGameplay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (List Name EntityFacade
 -> Focusing
      (StateT (EventState Name) IO) () (List Name EntityFacade))
-> WorldEditor Name
-> Focusing (StateT (EventState Name) IO) () (WorldEditor Name)
forall n (f :: * -> *).
Functor f =>
(List n EntityFacade -> f (List n EntityFacade))
-> WorldEditor n -> f (WorldEditor n)
entityPaintList
      Just ModalType
GoalModal -> case Event
ev of
        V.EvKey (V.KChar Char
'\t') [] -> (UIState -> Identity UIState) -> AppState -> Identity AppState
Lens' AppState UIState
uiState ((UIState -> Identity UIState) -> AppState -> Identity AppState)
-> ((FocusRing Name -> Identity (FocusRing Name))
    -> UIState -> Identity UIState)
-> (FocusRing Name -> Identity (FocusRing Name))
-> AppState
-> Identity AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UIGameplay -> Identity UIGameplay) -> UIState -> Identity UIState
Lens' UIState UIGameplay
uiGameplay ((UIGameplay -> Identity UIGameplay)
 -> UIState -> Identity UIState)
-> ((FocusRing Name -> Identity (FocusRing Name))
    -> UIGameplay -> Identity UIGameplay)
-> (FocusRing Name -> Identity (FocusRing Name))
-> UIState
-> Identity UIState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GoalDisplay -> Identity GoalDisplay)
-> UIGameplay -> Identity UIGameplay
Lens' UIGameplay GoalDisplay
uiGoal ((GoalDisplay -> Identity GoalDisplay)
 -> UIGameplay -> Identity UIGameplay)
-> ((FocusRing Name -> Identity (FocusRing Name))
    -> GoalDisplay -> Identity GoalDisplay)
-> (FocusRing Name -> Identity (FocusRing Name))
-> UIGameplay
-> Identity UIGameplay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FocusRing Name -> Identity (FocusRing Name))
-> GoalDisplay -> Identity GoalDisplay
Lens' GoalDisplay (FocusRing Name)
focus ((FocusRing Name -> Identity (FocusRing Name))
 -> AppState -> Identity AppState)
-> (FocusRing Name -> FocusRing Name) -> EventM Name AppState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= FocusRing Name -> FocusRing Name
forall n. FocusRing n -> FocusRing n
focusNext
        Event
_ -> do
          FocusRing Name
focused <- Getting (FocusRing Name) AppState (FocusRing Name)
-> EventM Name AppState (FocusRing Name)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Getting (FocusRing Name) AppState (FocusRing Name)
 -> EventM Name AppState (FocusRing Name))
-> Getting (FocusRing Name) AppState (FocusRing Name)
-> EventM Name AppState (FocusRing Name)
forall a b. (a -> b) -> a -> b
$ (UIState -> Const (FocusRing Name) UIState)
-> AppState -> Const (FocusRing Name) AppState
Lens' AppState UIState
uiState ((UIState -> Const (FocusRing Name) UIState)
 -> AppState -> Const (FocusRing Name) AppState)
-> ((FocusRing Name -> Const (FocusRing Name) (FocusRing Name))
    -> UIState -> Const (FocusRing Name) UIState)
-> Getting (FocusRing Name) AppState (FocusRing Name)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UIGameplay -> Const (FocusRing Name) UIGameplay)
-> UIState -> Const (FocusRing Name) UIState
Lens' UIState UIGameplay
uiGameplay ((UIGameplay -> Const (FocusRing Name) UIGameplay)
 -> UIState -> Const (FocusRing Name) UIState)
-> ((FocusRing Name -> Const (FocusRing Name) (FocusRing Name))
    -> UIGameplay -> Const (FocusRing Name) UIGameplay)
-> (FocusRing Name -> Const (FocusRing Name) (FocusRing Name))
-> UIState
-> Const (FocusRing Name) UIState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GoalDisplay -> Const (FocusRing Name) GoalDisplay)
-> UIGameplay -> Const (FocusRing Name) UIGameplay
Lens' UIGameplay GoalDisplay
uiGoal ((GoalDisplay -> Const (FocusRing Name) GoalDisplay)
 -> UIGameplay -> Const (FocusRing Name) UIGameplay)
-> ((FocusRing Name -> Const (FocusRing Name) (FocusRing Name))
    -> GoalDisplay -> Const (FocusRing Name) GoalDisplay)
-> (FocusRing Name -> Const (FocusRing Name) (FocusRing Name))
-> UIGameplay
-> Const (FocusRing Name) UIGameplay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FocusRing Name -> Const (FocusRing Name) (FocusRing Name))
-> GoalDisplay -> Const (FocusRing Name) GoalDisplay
Lens' GoalDisplay (FocusRing Name)
focus
          case FocusRing Name -> Maybe Name
forall n. FocusRing n -> Maybe n
focusGetCurrent FocusRing Name
focused of
            Just (GoalWidgets GoalWidget
w) -> case GoalWidget
w of
              GoalWidget
ObjectivesList -> do
                List Name GoalEntry
lw <- Getting (List Name GoalEntry) AppState (List Name GoalEntry)
-> EventM Name AppState (List Name GoalEntry)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Getting (List Name GoalEntry) AppState (List Name GoalEntry)
 -> EventM Name AppState (List Name GoalEntry))
-> Getting (List Name GoalEntry) AppState (List Name GoalEntry)
-> EventM Name AppState (List Name GoalEntry)
forall a b. (a -> b) -> a -> b
$ (UIState -> Const (List Name GoalEntry) UIState)
-> AppState -> Const (List Name GoalEntry) AppState
Lens' AppState UIState
uiState ((UIState -> Const (List Name GoalEntry) UIState)
 -> AppState -> Const (List Name GoalEntry) AppState)
-> ((List Name GoalEntry
     -> Const (List Name GoalEntry) (List Name GoalEntry))
    -> UIState -> Const (List Name GoalEntry) UIState)
-> Getting (List Name GoalEntry) AppState (List Name GoalEntry)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UIGameplay -> Const (List Name GoalEntry) UIGameplay)
-> UIState -> Const (List Name GoalEntry) UIState
Lens' UIState UIGameplay
uiGameplay ((UIGameplay -> Const (List Name GoalEntry) UIGameplay)
 -> UIState -> Const (List Name GoalEntry) UIState)
-> ((List Name GoalEntry
     -> Const (List Name GoalEntry) (List Name GoalEntry))
    -> UIGameplay -> Const (List Name GoalEntry) UIGameplay)
-> (List Name GoalEntry
    -> Const (List Name GoalEntry) (List Name GoalEntry))
-> UIState
-> Const (List Name GoalEntry) UIState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GoalDisplay -> Const (List Name GoalEntry) GoalDisplay)
-> UIGameplay -> Const (List Name GoalEntry) UIGameplay
Lens' UIGameplay GoalDisplay
uiGoal ((GoalDisplay -> Const (List Name GoalEntry) GoalDisplay)
 -> UIGameplay -> Const (List Name GoalEntry) UIGameplay)
-> ((List Name GoalEntry
     -> Const (List Name GoalEntry) (List Name GoalEntry))
    -> GoalDisplay -> Const (List Name GoalEntry) GoalDisplay)
-> (List Name GoalEntry
    -> Const (List Name GoalEntry) (List Name GoalEntry))
-> UIGameplay
-> Const (List Name GoalEntry) UIGameplay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (List Name GoalEntry
 -> Const (List Name GoalEntry) (List Name GoalEntry))
-> GoalDisplay -> Const (List Name GoalEntry) GoalDisplay
Lens' GoalDisplay (List Name GoalEntry)
listWidget
                List Name GoalEntry
newList <- List Name GoalEntry -> EventM Name AppState (List Name GoalEntry)
forall {t :: * -> *} {n} {s}.
(Foldable t, Splittable t, Ord n, Searchable t) =>
GenericList n t GoalEntry -> EventM n s (GenericList n t GoalEntry)
refreshGoalList List Name GoalEntry
lw
                (UIState -> Identity UIState) -> AppState -> Identity AppState
Lens' AppState UIState
uiState ((UIState -> Identity UIState) -> AppState -> Identity AppState)
-> ((List Name GoalEntry -> Identity (List Name GoalEntry))
    -> UIState -> Identity UIState)
-> (List Name GoalEntry -> Identity (List Name GoalEntry))
-> AppState
-> Identity AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UIGameplay -> Identity UIGameplay) -> UIState -> Identity UIState
Lens' UIState UIGameplay
uiGameplay ((UIGameplay -> Identity UIGameplay)
 -> UIState -> Identity UIState)
-> ((List Name GoalEntry -> Identity (List Name GoalEntry))
    -> UIGameplay -> Identity UIGameplay)
-> (List Name GoalEntry -> Identity (List Name GoalEntry))
-> UIState
-> Identity UIState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GoalDisplay -> Identity GoalDisplay)
-> UIGameplay -> Identity UIGameplay
Lens' UIGameplay GoalDisplay
uiGoal ((GoalDisplay -> Identity GoalDisplay)
 -> UIGameplay -> Identity UIGameplay)
-> ((List Name GoalEntry -> Identity (List Name GoalEntry))
    -> GoalDisplay -> Identity GoalDisplay)
-> (List Name GoalEntry -> Identity (List Name GoalEntry))
-> UIGameplay
-> Identity UIGameplay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (List Name GoalEntry -> Identity (List Name GoalEntry))
-> GoalDisplay -> Identity GoalDisplay
Lens' GoalDisplay (List Name GoalEntry)
listWidget ((List Name GoalEntry -> Identity (List Name GoalEntry))
 -> AppState -> Identity AppState)
-> List Name GoalEntry -> EventM Name AppState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= List Name GoalEntry
newList
              GoalWidget
GoalSummary -> ViewportScroll Name
-> BrickEvent Name AppEvent -> EventM Name AppState ()
handleInfoPanelEvent ViewportScroll Name
modalScroll (Event -> BrickEvent Name AppEvent
forall n e. Event -> BrickEvent n e
VtyEvent Event
ev)
            Maybe Name
_ -> ViewportScroll Name
-> BrickEvent Name AppEvent -> EventM Name AppState ()
handleInfoPanelEvent ViewportScroll Name
modalScroll (Event -> BrickEvent Name AppEvent
forall n e. Event -> BrickEvent n e
VtyEvent Event
ev)
      Just ModalType
StructuresModal -> case Event
ev of
        V.EvKey (V.KChar Char
'\t') [] -> (UIState -> Identity UIState) -> AppState -> Identity AppState
Lens' AppState UIState
uiState ((UIState -> Identity UIState) -> AppState -> Identity AppState)
-> ((FocusRing Name -> Identity (FocusRing Name))
    -> UIState -> Identity UIState)
-> (FocusRing Name -> Identity (FocusRing Name))
-> AppState
-> Identity AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UIGameplay -> Identity UIGameplay) -> UIState -> Identity UIState
Lens' UIState UIGameplay
uiGameplay ((UIGameplay -> Identity UIGameplay)
 -> UIState -> Identity UIState)
-> ((FocusRing Name -> Identity (FocusRing Name))
    -> UIGameplay -> Identity UIGameplay)
-> (FocusRing Name -> Identity (FocusRing Name))
-> UIState
-> Identity UIState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StructureDisplay -> Identity StructureDisplay)
-> UIGameplay -> Identity UIGameplay
Lens' UIGameplay StructureDisplay
uiStructure ((StructureDisplay -> Identity StructureDisplay)
 -> UIGameplay -> Identity UIGameplay)
-> ((FocusRing Name -> Identity (FocusRing Name))
    -> StructureDisplay -> Identity StructureDisplay)
-> (FocusRing Name -> Identity (FocusRing Name))
-> UIGameplay
-> Identity UIGameplay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FocusRing Name -> Identity (FocusRing Name))
-> StructureDisplay -> Identity StructureDisplay
Lens' StructureDisplay (FocusRing Name)
structurePanelFocus ((FocusRing Name -> Identity (FocusRing Name))
 -> AppState -> Identity AppState)
-> (FocusRing Name -> FocusRing Name) -> EventM Name AppState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= FocusRing Name -> FocusRing Name
forall n. FocusRing n -> FocusRing n
focusNext
        Event
_ -> do
          FocusRing Name
focused <- Getting (FocusRing Name) AppState (FocusRing Name)
-> EventM Name AppState (FocusRing Name)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Getting (FocusRing Name) AppState (FocusRing Name)
 -> EventM Name AppState (FocusRing Name))
-> Getting (FocusRing Name) AppState (FocusRing Name)
-> EventM Name AppState (FocusRing Name)
forall a b. (a -> b) -> a -> b
$ (UIState -> Const (FocusRing Name) UIState)
-> AppState -> Const (FocusRing Name) AppState
Lens' AppState UIState
uiState ((UIState -> Const (FocusRing Name) UIState)
 -> AppState -> Const (FocusRing Name) AppState)
-> ((FocusRing Name -> Const (FocusRing Name) (FocusRing Name))
    -> UIState -> Const (FocusRing Name) UIState)
-> Getting (FocusRing Name) AppState (FocusRing Name)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UIGameplay -> Const (FocusRing Name) UIGameplay)
-> UIState -> Const (FocusRing Name) UIState
Lens' UIState UIGameplay
uiGameplay ((UIGameplay -> Const (FocusRing Name) UIGameplay)
 -> UIState -> Const (FocusRing Name) UIState)
-> ((FocusRing Name -> Const (FocusRing Name) (FocusRing Name))
    -> UIGameplay -> Const (FocusRing Name) UIGameplay)
-> (FocusRing Name -> Const (FocusRing Name) (FocusRing Name))
-> UIState
-> Const (FocusRing Name) UIState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StructureDisplay -> Const (FocusRing Name) StructureDisplay)
-> UIGameplay -> Const (FocusRing Name) UIGameplay
Lens' UIGameplay StructureDisplay
uiStructure ((StructureDisplay -> Const (FocusRing Name) StructureDisplay)
 -> UIGameplay -> Const (FocusRing Name) UIGameplay)
-> ((FocusRing Name -> Const (FocusRing Name) (FocusRing Name))
    -> StructureDisplay -> Const (FocusRing Name) StructureDisplay)
-> (FocusRing Name -> Const (FocusRing Name) (FocusRing Name))
-> UIGameplay
-> Const (FocusRing Name) UIGameplay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FocusRing Name -> Const (FocusRing Name) (FocusRing Name))
-> StructureDisplay -> Const (FocusRing Name) StructureDisplay
Lens' StructureDisplay (FocusRing Name)
structurePanelFocus
          case FocusRing Name -> Maybe Name
forall n. FocusRing n -> Maybe n
focusGetCurrent FocusRing Name
focused of
            Just (StructureWidgets StructureWidget
w) -> case StructureWidget
w of
              StructureWidget
StructuresList ->
                ((GenericList Name Vector (StructureInfo StructureCells Entity)
  -> Focusing
       (StateT (EventState Name) IO)
       ()
       (GenericList Name Vector (StructureInfo StructureCells Entity)))
 -> AppState -> Focusing (StateT (EventState Name) IO) () AppState)
-> EventM Name AppState ()
forall {t :: * -> *} {n} {e} {t}.
(Foldable t, Splittable t, Ord n) =>
((GenericList n t e
  -> Focusing (StateT (EventState n) IO) () (GenericList n t e))
 -> t -> Focusing (StateT (EventState n) IO) () t)
-> EventM n t ()
refreshList (((GenericList Name Vector (StructureInfo StructureCells Entity)
   -> Focusing
        (StateT (EventState Name) IO)
        ()
        (GenericList Name Vector (StructureInfo StructureCells Entity)))
  -> AppState -> Focusing (StateT (EventState Name) IO) () AppState)
 -> EventM Name AppState ())
-> ((GenericList Name Vector (StructureInfo StructureCells Entity)
     -> Focusing
          (StateT (EventState Name) IO)
          ()
          (GenericList Name Vector (StructureInfo StructureCells Entity)))
    -> AppState -> Focusing (StateT (EventState Name) IO) () AppState)
-> EventM Name AppState ()
forall a b. (a -> b) -> a -> b
$ (UIState -> Focusing (StateT (EventState Name) IO) () UIState)
-> AppState -> Focusing (StateT (EventState Name) IO) () AppState
Lens' AppState UIState
uiState ((UIState -> Focusing (StateT (EventState Name) IO) () UIState)
 -> AppState -> Focusing (StateT (EventState Name) IO) () AppState)
-> ((GenericList Name Vector (StructureInfo StructureCells Entity)
     -> Focusing
          (StateT (EventState Name) IO)
          ()
          (GenericList Name Vector (StructureInfo StructureCells Entity)))
    -> UIState -> Focusing (StateT (EventState Name) IO) () UIState)
-> (GenericList Name Vector (StructureInfo StructureCells Entity)
    -> Focusing
         (StateT (EventState Name) IO)
         ()
         (GenericList Name Vector (StructureInfo StructureCells Entity)))
-> AppState
-> Focusing (StateT (EventState Name) IO) () AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UIGameplay
 -> Focusing (StateT (EventState Name) IO) () UIGameplay)
-> UIState -> Focusing (StateT (EventState Name) IO) () UIState
Lens' UIState UIGameplay
uiGameplay ((UIGameplay
  -> Focusing (StateT (EventState Name) IO) () UIGameplay)
 -> UIState -> Focusing (StateT (EventState Name) IO) () UIState)
-> ((GenericList Name Vector (StructureInfo StructureCells Entity)
     -> Focusing
          (StateT (EventState Name) IO)
          ()
          (GenericList Name Vector (StructureInfo StructureCells Entity)))
    -> UIGameplay
    -> Focusing (StateT (EventState Name) IO) () UIGameplay)
-> (GenericList Name Vector (StructureInfo StructureCells Entity)
    -> Focusing
         (StateT (EventState Name) IO)
         ()
         (GenericList Name Vector (StructureInfo StructureCells Entity)))
-> UIState
-> Focusing (StateT (EventState Name) IO) () UIState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StructureDisplay
 -> Focusing (StateT (EventState Name) IO) () StructureDisplay)
-> UIGameplay
-> Focusing (StateT (EventState Name) IO) () UIGameplay
Lens' UIGameplay StructureDisplay
uiStructure ((StructureDisplay
  -> Focusing (StateT (EventState Name) IO) () StructureDisplay)
 -> UIGameplay
 -> Focusing (StateT (EventState Name) IO) () UIGameplay)
-> ((GenericList Name Vector (StructureInfo StructureCells Entity)
     -> Focusing
          (StateT (EventState Name) IO)
          ()
          (GenericList Name Vector (StructureInfo StructureCells Entity)))
    -> StructureDisplay
    -> Focusing (StateT (EventState Name) IO) () StructureDisplay)
-> (GenericList Name Vector (StructureInfo StructureCells Entity)
    -> Focusing
         (StateT (EventState Name) IO)
         ()
         (GenericList Name Vector (StructureInfo StructureCells Entity)))
-> UIGameplay
-> Focusing (StateT (EventState Name) IO) () UIGameplay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GenericList Name Vector (StructureInfo StructureCells Entity)
 -> Focusing
      (StateT (EventState Name) IO)
      ()
      (GenericList Name Vector (StructureInfo StructureCells Entity)))
-> StructureDisplay
-> Focusing (StateT (EventState Name) IO) () StructureDisplay
Lens'
  StructureDisplay
  (GenericList Name Vector (StructureInfo StructureCells Entity))
structurePanelListWidget
              StructureWidget
StructureSummary -> ViewportScroll Name
-> BrickEvent Name AppEvent -> EventM Name AppState ()
handleInfoPanelEvent ViewportScroll Name
modalScroll (Event -> BrickEvent Name AppEvent
forall n e. Event -> BrickEvent n e
VtyEvent Event
ev)
            Maybe Name
_ -> ViewportScroll Name
-> BrickEvent Name AppEvent -> EventM Name AppState ()
handleInfoPanelEvent ViewportScroll Name
modalScroll (Event -> BrickEvent Name AppEvent
forall n e. Event -> BrickEvent n e
VtyEvent Event
ev)
      Maybe ModalType
_ -> ViewportScroll Name
-> BrickEvent Name AppEvent -> EventM Name AppState ()
handleInfoPanelEvent ViewportScroll Name
modalScroll (Event -> BrickEvent Name AppEvent
forall n e. Event -> BrickEvent n e
VtyEvent Event
ev)
   where
    refreshGoalList :: GenericList n t GoalEntry -> EventM n s (GenericList n t GoalEntry)
refreshGoalList GenericList n t GoalEntry
lw = GenericList n t GoalEntry
-> EventM n (GenericList n t GoalEntry) ()
-> EventM n s (GenericList n t GoalEntry)
forall a n b s. a -> EventM n a b -> EventM n s a
nestEventM' GenericList n t GoalEntry
lw (EventM n (GenericList n t GoalEntry) ()
 -> EventM n s (GenericList n t GoalEntry))
-> EventM n (GenericList n t GoalEntry) ()
-> EventM n s (GenericList n t GoalEntry)
forall a b. (a -> b) -> a -> b
$ Event
-> (GoalEntry -> Bool) -> EventM n (GenericList n t GoalEntry) ()
forall (t :: * -> *) n e.
(Foldable t, Splittable t, Ord n, Searchable t) =>
Event -> (e -> Bool) -> EventM n (GenericList n t e) ()
handleListEventWithSeparators Event
ev GoalEntry -> Bool
shouldSkipSelection
    refreshList :: ((GenericList n t e
  -> Focusing (StateT (EventState n) IO) () (GenericList n t e))
 -> t -> Focusing (StateT (EventState n) IO) () t)
-> EventM n t ()
refreshList (GenericList n t e
 -> Focusing (StateT (EventState n) IO) () (GenericList n t e))
-> t -> Focusing (StateT (EventState n) IO) () t
z = LensLike'
  (Zoomed (EventM n (GenericList n t e)) ()) t (GenericList n t e)
-> EventM n (GenericList n t e) () -> EventM n t ()
forall c.
LensLike'
  (Zoomed (EventM n (GenericList n t e)) c) t (GenericList n t e)
-> EventM n (GenericList n t e) c -> EventM n t c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
Brick.zoom (GenericList n t e
 -> Focusing (StateT (EventState n) IO) () (GenericList n t e))
-> t -> Focusing (StateT (EventState n) IO) () t
LensLike'
  (Zoomed (EventM n (GenericList n t e)) ()) t (GenericList n t e)
z (EventM n (GenericList n t e) () -> EventM n t ())
-> EventM n (GenericList n t e) () -> EventM n t ()
forall a b. (a -> b) -> a -> b
$ Event -> EventM n (GenericList n t e) ()
forall (t :: * -> *) n e.
(Foldable t, Splittable t, Ord n) =>
Event -> EventM n (GenericList n t e) ()
BL.handleListEvent Event
ev

-- | Quit a game.
--
-- * writes out the updated REPL history to a @.swarm_history@ file
-- * saves current scenario status (InProgress/Completed)
-- * advances the menu to the next scenario IF the current one was won
-- * returns to the previous menu
quitGame :: EventM Name AppState ()
quitGame :: EventM Name AppState ()
quitGame = do
  -- Write out REPL history.
  REPLHistory
history <- Getting REPLHistory AppState REPLHistory
-> EventM Name AppState REPLHistory
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Getting REPLHistory AppState REPLHistory
 -> EventM Name AppState REPLHistory)
-> Getting REPLHistory AppState REPLHistory
-> EventM Name AppState REPLHistory
forall a b. (a -> b) -> a -> b
$ (UIState -> Const REPLHistory UIState)
-> AppState -> Const REPLHistory AppState
Lens' AppState UIState
uiState ((UIState -> Const REPLHistory UIState)
 -> AppState -> Const REPLHistory AppState)
-> ((REPLHistory -> Const REPLHistory REPLHistory)
    -> UIState -> Const REPLHistory UIState)
-> Getting REPLHistory AppState REPLHistory
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UIGameplay -> Const REPLHistory UIGameplay)
-> UIState -> Const REPLHistory UIState
Lens' UIState UIGameplay
uiGameplay ((UIGameplay -> Const REPLHistory UIGameplay)
 -> UIState -> Const REPLHistory UIState)
-> ((REPLHistory -> Const REPLHistory REPLHistory)
    -> UIGameplay -> Const REPLHistory UIGameplay)
-> (REPLHistory -> Const REPLHistory REPLHistory)
-> UIState
-> Const REPLHistory UIState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (REPLState -> Const REPLHistory REPLState)
-> UIGameplay -> Const REPLHistory UIGameplay
Lens' UIGameplay REPLState
uiREPL ((REPLState -> Const REPLHistory REPLState)
 -> UIGameplay -> Const REPLHistory UIGameplay)
-> ((REPLHistory -> Const REPLHistory REPLHistory)
    -> REPLState -> Const REPLHistory REPLState)
-> (REPLHistory -> Const REPLHistory REPLHistory)
-> UIGameplay
-> Const REPLHistory UIGameplay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (REPLHistory -> Const REPLHistory REPLHistory)
-> REPLState -> Const REPLHistory REPLState
Lens' REPLState REPLHistory
replHistory
  let hist :: [Text]
hist = (REPLHistItem -> Maybe Text) -> [REPLHistItem] -> [Text]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe REPLHistItem -> Maybe Text
getREPLSubmitted ([REPLHistItem] -> [Text]) -> [REPLHistItem] -> [Text]
forall a b. (a -> b) -> a -> b
$ Int -> REPLHistory -> [REPLHistItem]
getLatestREPLHistoryItems Int
forall a. Bounded a => a
maxBound REPLHistory
history
  IO () -> EventM Name AppState ()
forall a. IO a -> EventM Name AppState a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EventM Name AppState ())
-> IO () -> EventM Name AppState ()
forall a b. (a -> b) -> a -> b
$ (String -> Text -> IO ()
`T.appendFile` [Text] -> Text
T.unlines [Text]
hist) (String -> IO ()) -> IO String -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Bool -> IO String
getSwarmHistoryPath Bool
True

  -- Save scenario status info.
  EventM Name AppState ()
forall (m :: * -> *). (MonadIO m, MonadState AppState m) => m ()
saveScenarioInfoOnQuit

  -- Automatically advance the menu to the next scenario iff the
  -- player has won the current one.
  WinCondition
wc <- Getting WinCondition AppState WinCondition
-> EventM Name AppState WinCondition
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Getting WinCondition AppState WinCondition
 -> EventM Name AppState WinCondition)
-> Getting WinCondition AppState WinCondition
-> EventM Name AppState WinCondition
forall a b. (a -> b) -> a -> b
$ (GameState -> Const WinCondition GameState)
-> AppState -> Const WinCondition AppState
Lens' AppState GameState
gameState ((GameState -> Const WinCondition GameState)
 -> AppState -> Const WinCondition AppState)
-> ((WinCondition -> Const WinCondition WinCondition)
    -> GameState -> Const WinCondition GameState)
-> Getting WinCondition AppState WinCondition
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WinCondition -> Const WinCondition WinCondition)
-> GameState -> Const WinCondition GameState
Lens' GameState WinCondition
winCondition
  case WinCondition
wc of
    WinConditions (Won Bool
_ TickNumber
_) ObjectiveCompletion
_ -> (UIState -> Identity UIState) -> AppState -> Identity AppState
Lens' AppState UIState
uiState ((UIState -> Identity UIState) -> AppState -> Identity AppState)
-> ((Menu -> Identity Menu) -> UIState -> Identity UIState)
-> (Menu -> Identity Menu)
-> AppState
-> Identity AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Menu -> Identity Menu) -> UIState -> Identity UIState
Lens' UIState Menu
uiMenu ((Menu -> Identity Menu) -> AppState -> Identity AppState)
-> (Menu -> Menu) -> EventM Name AppState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= Menu -> Menu
advanceMenu
    WinCondition
_ -> () -> EventM Name AppState ()
forall a. a -> EventM Name AppState a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

  -- Either quit the entire app (if the scenario was chosen directly
  -- from the command line) or return to the menu (if the scenario was
  -- chosen from the menu).
  Menu
menu <- Getting Menu AppState Menu -> EventM Name AppState Menu
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Getting Menu AppState Menu -> EventM Name AppState Menu)
-> Getting Menu AppState Menu -> EventM Name AppState Menu
forall a b. (a -> b) -> a -> b
$ (UIState -> Const Menu UIState) -> AppState -> Const Menu AppState
Lens' AppState UIState
uiState ((UIState -> Const Menu UIState)
 -> AppState -> Const Menu AppState)
-> ((Menu -> Const Menu Menu) -> UIState -> Const Menu UIState)
-> Getting Menu AppState Menu
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Menu -> Const Menu Menu) -> UIState -> Const Menu UIState
Lens' UIState Menu
uiMenu
  case Menu
menu of
    Menu
NoMenu -> EventM Name AppState ()
forall n s. EventM n s ()
halt
    Menu
_ -> (UIState -> Identity UIState) -> AppState -> Identity AppState
Lens' AppState UIState
uiState ((UIState -> Identity UIState) -> AppState -> Identity AppState)
-> ((Bool -> Identity Bool) -> UIState -> Identity UIState)
-> (Bool -> Identity Bool)
-> AppState
-> Identity AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Identity Bool) -> UIState -> Identity UIState
Lens' UIState Bool
uiPlaying ((Bool -> Identity Bool) -> AppState -> Identity AppState)
-> Bool -> EventM Name AppState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Bool
False

------------------------------------------------------------
-- REPL events
------------------------------------------------------------

-- | Handle a user input event for the REPL.
handleREPLEvent :: BrickEvent Name AppEvent -> EventM Name AppState ()
handleREPLEvent :: BrickEvent Name AppEvent -> EventM Name AppState ()
handleREPLEvent BrickEvent Name AppEvent
x = do
  AppState
s <- EventM Name AppState AppState
forall s (m :: * -> *). MonadState s m => m s
get
  let controlMode :: ReplControlMode
controlMode = AppState
s AppState
-> Getting ReplControlMode AppState ReplControlMode
-> ReplControlMode
forall s a. s -> Getting a s a -> a
^. (UIState -> Const ReplControlMode UIState)
-> AppState -> Const ReplControlMode AppState
Lens' AppState UIState
uiState ((UIState -> Const ReplControlMode UIState)
 -> AppState -> Const ReplControlMode AppState)
-> ((ReplControlMode -> Const ReplControlMode ReplControlMode)
    -> UIState -> Const ReplControlMode UIState)
-> Getting ReplControlMode AppState ReplControlMode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UIGameplay -> Const ReplControlMode UIGameplay)
-> UIState -> Const ReplControlMode UIState
Lens' UIState UIGameplay
uiGameplay ((UIGameplay -> Const ReplControlMode UIGameplay)
 -> UIState -> Const ReplControlMode UIState)
-> ((ReplControlMode -> Const ReplControlMode ReplControlMode)
    -> UIGameplay -> Const ReplControlMode UIGameplay)
-> (ReplControlMode -> Const ReplControlMode ReplControlMode)
-> UIState
-> Const ReplControlMode UIState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (REPLState -> Const ReplControlMode REPLState)
-> UIGameplay -> Const ReplControlMode UIGameplay
Lens' UIGameplay REPLState
uiREPL ((REPLState -> Const ReplControlMode REPLState)
 -> UIGameplay -> Const ReplControlMode UIGameplay)
-> ((ReplControlMode -> Const ReplControlMode ReplControlMode)
    -> REPLState -> Const ReplControlMode REPLState)
-> (ReplControlMode -> Const ReplControlMode ReplControlMode)
-> UIGameplay
-> Const ReplControlMode UIGameplay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ReplControlMode -> Const ReplControlMode ReplControlMode)
-> REPLState -> Const ReplControlMode REPLState
Lens' REPLState ReplControlMode
replControlMode
  let keyHandler :: KeyDispatcher SwarmEvent (EventM Name AppState)
keyHandler = AppState
s AppState
-> Getting
     (KeyDispatcher SwarmEvent (EventM Name AppState))
     AppState
     (KeyDispatcher SwarmEvent (EventM Name AppState))
-> KeyDispatcher SwarmEvent (EventM Name AppState)
forall s a. s -> Getting a s a -> a
^. (KeyEventHandlingState
 -> Const
      (KeyDispatcher SwarmEvent (EventM Name AppState))
      KeyEventHandlingState)
-> AppState
-> Const (KeyDispatcher SwarmEvent (EventM Name AppState)) AppState
Lens' AppState KeyEventHandlingState
keyEventHandling ((KeyEventHandlingState
  -> Const
       (KeyDispatcher SwarmEvent (EventM Name AppState))
       KeyEventHandlingState)
 -> AppState
 -> Const
      (KeyDispatcher SwarmEvent (EventM Name AppState)) AppState)
-> ((KeyDispatcher SwarmEvent (EventM Name AppState)
     -> Const
          (KeyDispatcher SwarmEvent (EventM Name AppState))
          (KeyDispatcher SwarmEvent (EventM Name AppState)))
    -> KeyEventHandlingState
    -> Const
         (KeyDispatcher SwarmEvent (EventM Name AppState))
         KeyEventHandlingState)
-> Getting
     (KeyDispatcher SwarmEvent (EventM Name AppState))
     AppState
     (KeyDispatcher SwarmEvent (EventM Name AppState))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SwarmKeyDispatchers
 -> Const
      (KeyDispatcher SwarmEvent (EventM Name AppState))
      SwarmKeyDispatchers)
-> KeyEventHandlingState
-> Const
     (KeyDispatcher SwarmEvent (EventM Name AppState))
     KeyEventHandlingState
Lens' KeyEventHandlingState SwarmKeyDispatchers
keyDispatchers ((SwarmKeyDispatchers
  -> Const
       (KeyDispatcher SwarmEvent (EventM Name AppState))
       SwarmKeyDispatchers)
 -> KeyEventHandlingState
 -> Const
      (KeyDispatcher SwarmEvent (EventM Name AppState))
      KeyEventHandlingState)
-> ((KeyDispatcher SwarmEvent (EventM Name AppState)
     -> Const
          (KeyDispatcher SwarmEvent (EventM Name AppState))
          (KeyDispatcher SwarmEvent (EventM Name AppState)))
    -> SwarmKeyDispatchers
    -> Const
         (KeyDispatcher SwarmEvent (EventM Name AppState))
         SwarmKeyDispatchers)
-> (KeyDispatcher SwarmEvent (EventM Name AppState)
    -> Const
         (KeyDispatcher SwarmEvent (EventM Name AppState))
         (KeyDispatcher SwarmEvent (EventM Name AppState)))
-> KeyEventHandlingState
-> Const
     (KeyDispatcher SwarmEvent (EventM Name AppState))
     KeyEventHandlingState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SwarmKeyDispatchers
 -> KeyDispatcher SwarmEvent (EventM Name AppState))
-> (KeyDispatcher SwarmEvent (EventM Name AppState)
    -> Const
         (KeyDispatcher SwarmEvent (EventM Name AppState))
         (KeyDispatcher SwarmEvent (EventM Name AppState)))
-> SwarmKeyDispatchers
-> Const
     (KeyDispatcher SwarmEvent (EventM Name AppState))
     SwarmKeyDispatchers
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to SwarmKeyDispatchers
-> KeyDispatcher SwarmEvent (EventM Name AppState)
replDispatcher
  case BrickEvent Name AppEvent
x of
    -- Pass to key handler (allows users to configure bindings)
    -- See Note [how Swarm event handlers work]
    VtyEvent (V.EvKey Key
k [Modifier]
m)
      | Maybe (KeyHandler SwarmEvent (EventM Name AppState)) -> Bool
forall a. Maybe a -> Bool
isJust (Key
-> [Modifier]
-> KeyDispatcher SwarmEvent (EventM Name AppState)
-> Maybe (KeyHandler SwarmEvent (EventM Name AppState))
forall k (m :: * -> *).
Key -> [Modifier] -> KeyDispatcher k m -> Maybe (KeyHandler k m)
B.lookupVtyEvent Key
k [Modifier]
m KeyDispatcher SwarmEvent (EventM Name AppState)
keyHandler) ->
          EventM Name AppState Bool -> EventM Name AppState ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (EventM Name AppState Bool -> EventM Name AppState ())
-> EventM Name AppState Bool -> EventM Name AppState ()
forall a b. (a -> b) -> a -> b
$ KeyDispatcher SwarmEvent (EventM Name AppState)
-> Key -> [Modifier] -> EventM Name AppState Bool
forall (m :: * -> *) k.
Monad m =>
KeyDispatcher k m -> Key -> [Modifier] -> m Bool
B.handleKey KeyDispatcher SwarmEvent (EventM Name AppState)
keyHandler Key
k [Modifier]
m
    -- Handle other events in a way appropriate to the current REPL
    -- control mode.
    BrickEvent Name AppEvent
_ -> case ReplControlMode
controlMode of
      ReplControlMode
Typing -> BrickEvent Name AppEvent -> EventM Name AppState ()
handleREPLEventTyping BrickEvent Name AppEvent
x
      ReplControlMode
Piloting -> BrickEvent Name AppEvent -> EventM Name AppState ()
handleREPLEventPiloting BrickEvent Name AppEvent
x
      ReplControlMode
Handling -> case BrickEvent Name AppEvent
x of
        -- Handle keypresses using the custom installed handler
        VtyEvent (V.EvKey Key
k [Modifier]
mods) -> KeyCombo -> EventM Name AppState ()
runInputHandler ([Modifier] -> Key -> KeyCombo
mkKeyCombo [Modifier]
mods Key
k)
        -- Handle all other events normally
        BrickEvent Name AppEvent
_ -> BrickEvent Name AppEvent -> EventM Name AppState ()
handleREPLEventTyping BrickEvent Name AppEvent
x

-- | Run the installed input handler on a key combo entered by the user.
runInputHandler :: KeyCombo -> EventM Name AppState ()
runInputHandler :: KeyCombo -> EventM Name AppState ()
runInputHandler KeyCombo
kc = do
  Maybe (Text, Value)
mhandler <- Getting (Maybe (Text, Value)) AppState (Maybe (Text, Value))
-> EventM Name AppState (Maybe (Text, Value))
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Getting (Maybe (Text, Value)) AppState (Maybe (Text, Value))
 -> EventM Name AppState (Maybe (Text, Value)))
-> Getting (Maybe (Text, Value)) AppState (Maybe (Text, Value))
-> EventM Name AppState (Maybe (Text, Value))
forall a b. (a -> b) -> a -> b
$ (GameState -> Const (Maybe (Text, Value)) GameState)
-> AppState -> Const (Maybe (Text, Value)) AppState
Lens' AppState GameState
gameState ((GameState -> Const (Maybe (Text, Value)) GameState)
 -> AppState -> Const (Maybe (Text, Value)) AppState)
-> ((Maybe (Text, Value)
     -> Const (Maybe (Text, Value)) (Maybe (Text, Value)))
    -> GameState -> Const (Maybe (Text, Value)) GameState)
-> Getting (Maybe (Text, Value)) AppState (Maybe (Text, Value))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GameControls -> Const (Maybe (Text, Value)) GameControls)
-> GameState -> Const (Maybe (Text, Value)) GameState
Lens' GameState GameControls
gameControls ((GameControls -> Const (Maybe (Text, Value)) GameControls)
 -> GameState -> Const (Maybe (Text, Value)) GameState)
-> ((Maybe (Text, Value)
     -> Const (Maybe (Text, Value)) (Maybe (Text, Value)))
    -> GameControls -> Const (Maybe (Text, Value)) GameControls)
-> (Maybe (Text, Value)
    -> Const (Maybe (Text, Value)) (Maybe (Text, Value)))
-> GameState
-> Const (Maybe (Text, Value)) GameState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe (Text, Value)
 -> Const (Maybe (Text, Value)) (Maybe (Text, Value)))
-> GameControls -> Const (Maybe (Text, Value)) GameControls
Lens' GameControls (Maybe (Text, Value))
inputHandler
  case Maybe (Text, Value)
mhandler of
    -- Shouldn't be possible to get here if there is no input handler, but
    -- if we do somehow, just do nothing.
    Maybe (Text, Value)
Nothing -> () -> EventM Name AppState ()
forall a. a -> EventM Name AppState a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    Just (Text
_, Value
handler) -> do
      -- Make sure the base is currently idle; if so, apply the
      -- installed input handler function to a `key` value
      -- representing the typed input.
      Bool
working <- Getting Bool AppState Bool -> EventM Name AppState Bool
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Getting Bool AppState Bool -> EventM Name AppState Bool)
-> Getting Bool AppState Bool -> EventM Name AppState Bool
forall a b. (a -> b) -> a -> b
$ (GameState -> Const Bool GameState)
-> AppState -> Const Bool AppState
Lens' AppState GameState
gameState ((GameState -> Const Bool GameState)
 -> AppState -> Const Bool AppState)
-> ((Bool -> Const Bool Bool) -> GameState -> Const Bool GameState)
-> Getting Bool AppState Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GameControls -> Const Bool GameControls)
-> GameState -> Const Bool GameState
Lens' GameState GameControls
gameControls ((GameControls -> Const Bool GameControls)
 -> GameState -> Const Bool GameState)
-> ((Bool -> Const Bool Bool)
    -> GameControls -> Const Bool GameControls)
-> (Bool -> Const Bool Bool)
-> GameState
-> Const Bool GameState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Const Bool Bool)
-> GameControls -> Const Bool GameControls
Getter GameControls Bool
replWorking
      Bool -> EventM Name AppState () -> EventM Name AppState ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
working (EventM Name AppState () -> EventM Name AppState ())
-> EventM Name AppState () -> EventM Name AppState ()
forall a b. (a -> b) -> a -> b
$ do
        AppState
s <- EventM Name AppState AppState
forall s (m :: * -> *). MonadState s m => m s
get
        let env :: Env
env = AppState
s AppState -> Getting Env AppState Env -> Env
forall s a. s -> Getting a s a -> a
^. (GameState -> Const Env GameState)
-> AppState -> Const Env AppState
Lens' AppState GameState
gameState ((GameState -> Const Env GameState)
 -> AppState -> Const Env AppState)
-> ((Env -> Const Env Env) -> GameState -> Const Env GameState)
-> Getting Env AppState Env
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Env -> Const Env Env) -> GameState -> Const Env GameState
Traversal' GameState Env
baseEnv
            store :: Store
store = AppState
s AppState -> Getting Store AppState Store -> Store
forall s a. s -> Getting a s a -> a
^. (GameState -> Const Store GameState)
-> AppState -> Const Store AppState
Lens' AppState GameState
gameState ((GameState -> Const Store GameState)
 -> AppState -> Const Store AppState)
-> ((Store -> Const Store Store)
    -> GameState -> Const Store GameState)
-> Getting Store AppState Store
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Store -> Const Store Store) -> GameState -> Const Store GameState
Getter GameState Store
baseStore
            handlerCESK :: CESK
handlerCESK = Value -> Store -> Cont -> CESK
Out (KeyCombo -> Value
VKey KeyCombo
kc) Store
store [Value -> Frame
FApp Value
handler, Frame
FExec, Env -> Frame
FSuspend Env
env]
        (GameState -> Identity GameState) -> AppState -> Identity AppState
Lens' AppState GameState
gameState ((GameState -> Identity GameState)
 -> AppState -> Identity AppState)
-> ((CESK -> Identity CESK) -> GameState -> Identity GameState)
-> (CESK -> Identity CESK)
-> AppState
-> Identity AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Robot -> Identity Robot) -> GameState -> Identity GameState
Traversal' GameState Robot
baseRobot ((Robot -> Identity Robot) -> GameState -> Identity GameState)
-> ((CESK -> Identity CESK) -> Robot -> Identity Robot)
-> (CESK -> Identity CESK)
-> GameState
-> Identity GameState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CESK -> Identity CESK) -> Robot -> Identity Robot
Lens' Robot CESK
machine ((CESK -> Identity CESK) -> AppState -> Identity AppState)
-> CESK -> EventM Name AppState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= CESK
handlerCESK
        (GameState -> Identity GameState) -> AppState -> Identity AppState
Lens' AppState GameState
gameState ((GameState -> Identity GameState)
 -> AppState -> Identity AppState)
-> (GameState -> GameState) -> EventM Name AppState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= State GameState () -> GameState -> GameState
forall s a. State s a -> s -> s
execState (StateC Robots Identity () -> State GameState ()
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) b.
Has (State GameState) sig m =>
StateC Robots Identity b -> m b
zoomRobots (StateC Robots Identity () -> State GameState ())
-> StateC Robots Identity () -> State GameState ()
forall a b. (a -> b) -> a -> b
$ Int -> StateC Robots Identity ()
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State Robots) sig m =>
Int -> m ()
activateRobot Int
0)

-- | Handle a user "piloting" input event for the REPL.
--
-- TODO: #2010 Finish porting Controller to KeyEventHandlers
handleREPLEventPiloting :: BrickEvent Name AppEvent -> EventM Name AppState ()
handleREPLEventPiloting :: BrickEvent Name AppEvent -> EventM Name AppState ()
handleREPLEventPiloting BrickEvent Name AppEvent
x = case BrickEvent Name AppEvent
x of
  Key Key
V.KUp -> Text -> EventM Name AppState ()
inputCmd Text
"move"
  Key Key
V.KDown -> Text -> EventM Name AppState ()
inputCmd Text
"turn back"
  Key Key
V.KLeft -> Text -> EventM Name AppState ()
inputCmd Text
"turn left"
  Key Key
V.KRight -> Text -> EventM Name AppState ()
inputCmd Text
"turn right"
  ShiftKey Key
V.KUp -> Text -> EventM Name AppState ()
inputCmd Text
"turn north"
  ShiftKey Key
V.KDown -> Text -> EventM Name AppState ()
inputCmd Text
"turn south"
  ShiftKey Key
V.KLeft -> Text -> EventM Name AppState ()
inputCmd Text
"turn west"
  ShiftKey Key
V.KRight -> Text -> EventM Name AppState ()
inputCmd Text
"turn east"
  Key Key
V.KDel -> Text -> EventM Name AppState ()
inputCmd Text
"selfdestruct"
  CharKey Char
'g' -> Text -> EventM Name AppState ()
inputCmd Text
"grab"
  CharKey Char
'h' -> Text -> EventM Name AppState ()
inputCmd Text
"harvest"
  CharKey Char
'd' -> Text -> EventM Name AppState ()
inputCmd Text
"drill forward"
  CharKey Char
'x' -> Text -> EventM Name AppState ()
inputCmd Text
"drill down"
  CharKey Char
's' -> Text -> EventM Name AppState ()
inputCmd Text
"scan forward"
  CharKey Char
'b' -> Text -> EventM Name AppState ()
inputCmd Text
"blocked"
  CharKey Char
'u' -> Text -> EventM Name AppState ()
inputCmd Text
"upload base"
  CharKey Char
'p' -> Text -> EventM Name AppState ()
inputCmd Text
"push"
  BrickEvent Name AppEvent
_ -> Text -> EventM Name AppState ()
inputCmd Text
"noop"
 where
  inputCmd :: Text -> EventM Name AppState ()
inputCmd Text
cmdText = do
    (UIState -> Identity UIState) -> AppState -> Identity AppState
Lens' AppState UIState
uiState ((UIState -> Identity UIState) -> AppState -> Identity AppState)
-> ((REPLState -> Identity REPLState)
    -> UIState -> Identity UIState)
-> (REPLState -> Identity REPLState)
-> AppState
-> Identity AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UIGameplay -> Identity UIGameplay) -> UIState -> Identity UIState
Lens' UIState UIGameplay
uiGameplay ((UIGameplay -> Identity UIGameplay)
 -> UIState -> Identity UIState)
-> ((REPLState -> Identity REPLState)
    -> UIGameplay -> Identity UIGameplay)
-> (REPLState -> Identity REPLState)
-> UIState
-> Identity UIState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (REPLState -> Identity REPLState)
-> UIGameplay -> Identity UIGameplay
Lens' UIGameplay REPLState
uiREPL ((REPLState -> Identity REPLState)
 -> AppState -> Identity AppState)
-> (REPLState -> REPLState) -> EventM Name AppState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= Text -> REPLState -> REPLState
setCmd (Text
cmdText Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
";")
    (AppState -> AppState) -> EventM Name AppState ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify AppState -> AppState
validateREPLForm
    BrickEvent Name AppEvent -> EventM Name AppState ()
handleREPLEventTyping (BrickEvent Name AppEvent -> EventM Name AppState ())
-> BrickEvent Name AppEvent -> EventM Name AppState ()
forall a b. (a -> b) -> a -> b
$ Key -> BrickEvent Name AppEvent
forall n e. Key -> BrickEvent n e
Key Key
V.KEnter

  setCmd :: Text -> REPLState -> REPLState
setCmd Text
nt REPLState
theRepl =
    REPLState
theRepl
      REPLState -> (REPLState -> REPLState) -> REPLState
forall a b. a -> (a -> b) -> b
& (Text -> Identity Text) -> REPLState -> Identity REPLState
Lens' REPLState Text
replPromptText ((Text -> Identity Text) -> REPLState -> Identity REPLState)
-> Text -> REPLState -> REPLState
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Text
nt
      REPLState -> (REPLState -> REPLState) -> REPLState
forall a b. a -> (a -> b) -> b
& (REPLPrompt -> Identity REPLPrompt)
-> REPLState -> Identity REPLState
Lens' REPLState REPLPrompt
replPromptType ((REPLPrompt -> Identity REPLPrompt)
 -> REPLState -> Identity REPLState)
-> REPLPrompt -> REPLState -> REPLState
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Text] -> REPLPrompt
CmdPrompt []

runBaseWebCode :: (MonadState AppState m) => T.Text -> m ()
runBaseWebCode :: forall (m :: * -> *). MonadState AppState m => Text -> m ()
runBaseWebCode Text
uinput = do
  AppState
s <- m AppState
forall s (m :: * -> *). MonadState s m => m s
get
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (AppState
s AppState -> Getting Bool AppState Bool -> Bool
forall s a. s -> Getting a s a -> a
^. (GameState -> Const Bool GameState)
-> AppState -> Const Bool AppState
Lens' AppState GameState
gameState ((GameState -> Const Bool GameState)
 -> AppState -> Const Bool AppState)
-> ((Bool -> Const Bool Bool) -> GameState -> Const Bool GameState)
-> Getting Bool AppState Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GameControls -> Const Bool GameControls)
-> GameState -> Const Bool GameState
Lens' GameState GameControls
gameControls ((GameControls -> Const Bool GameControls)
 -> GameState -> Const Bool GameState)
-> ((Bool -> Const Bool Bool)
    -> GameControls -> Const Bool GameControls)
-> (Bool -> Const Bool Bool)
-> GameState
-> Const Bool GameState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Const Bool Bool)
-> GameControls -> Const Bool GameControls
Getter GameControls Bool
replWorking) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
    Text -> m ()
forall (m :: * -> *). MonadState AppState m => Text -> m ()
runBaseCode Text
uinput

runBaseCode :: (MonadState AppState m) => T.Text -> m ()
runBaseCode :: forall (m :: * -> *). MonadState AppState m => Text -> m ()
runBaseCode Text
uinput = do
  REPLHistItem -> m ()
forall (m :: * -> *). MonadState AppState m => REPLHistItem -> m ()
addREPLHistItem (Text -> REPLHistItem
mkREPLSubmission Text
uinput)
  Text -> REPLPrompt -> m ()
forall (m :: * -> *).
MonadState AppState m =>
Text -> REPLPrompt -> m ()
resetREPL Text
"" ([Text] -> REPLPrompt
CmdPrompt [])
  Env
env <- Getting Env AppState Env -> m Env
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Getting Env AppState Env -> m Env)
-> Getting Env AppState Env -> m Env
forall a b. (a -> b) -> a -> b
$ (GameState -> Const Env GameState)
-> AppState -> Const Env AppState
Lens' AppState GameState
gameState ((GameState -> Const Env GameState)
 -> AppState -> Const Env AppState)
-> ((Env -> Const Env Env) -> GameState -> Const Env GameState)
-> Getting Env AppState Env
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Env -> Const Env Env) -> GameState -> Const Env GameState
Traversal' GameState Env
baseEnv
  case Env -> Text -> Either Text (Maybe TSyntax)
processTerm' Env
env Text
uinput of
    Right Maybe TSyntax
mt -> do
      (UIState -> Identity UIState) -> AppState -> Identity AppState
Lens' AppState UIState
uiState ((UIState -> Identity UIState) -> AppState -> Identity AppState)
-> ((Bool -> Identity Bool) -> UIState -> Identity UIState)
-> (Bool -> Identity Bool)
-> AppState
-> Identity AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UIGameplay -> Identity UIGameplay) -> UIState -> Identity UIState
Lens' UIState UIGameplay
uiGameplay ((UIGameplay -> Identity UIGameplay)
 -> UIState -> Identity UIState)
-> ((Bool -> Identity Bool) -> UIGameplay -> Identity UIGameplay)
-> (Bool -> Identity Bool)
-> UIState
-> Identity UIState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (REPLState -> Identity REPLState)
-> UIGameplay -> Identity UIGameplay
Lens' UIGameplay REPLState
uiREPL ((REPLState -> Identity REPLState)
 -> UIGameplay -> Identity UIGameplay)
-> ((Bool -> Identity Bool) -> REPLState -> Identity REPLState)
-> (Bool -> Identity Bool)
-> UIGameplay
-> Identity UIGameplay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (REPLHistory -> Identity REPLHistory)
-> REPLState -> Identity REPLState
Lens' REPLState REPLHistory
replHistory ((REPLHistory -> Identity REPLHistory)
 -> REPLState -> Identity REPLState)
-> ((Bool -> Identity Bool) -> REPLHistory -> Identity REPLHistory)
-> (Bool -> Identity Bool)
-> REPLState
-> Identity REPLState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Identity Bool) -> REPLHistory -> Identity REPLHistory
Lens' REPLHistory Bool
replHasExecutedManualInput ((Bool -> Identity Bool) -> AppState -> Identity AppState)
-> Bool -> m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Bool
True
      Maybe TSyntax -> m ()
forall (m :: * -> *).
MonadState AppState m =>
Maybe TSyntax -> m ()
runBaseTerm Maybe TSyntax
mt
    Left Text
err -> do
      REPLHistItem -> m ()
forall (m :: * -> *). MonadState AppState m => REPLHistItem -> m ()
addREPLHistItem (Text -> REPLHistItem
mkREPLError Text
err)

-- | Handle a user input event for the REPL.
--
-- TODO: #2010 Finish porting Controller to KeyEventHandlers
handleREPLEventTyping :: BrickEvent Name AppEvent -> EventM Name AppState ()
handleREPLEventTyping :: BrickEvent Name AppEvent -> EventM Name AppState ()
handleREPLEventTyping = \case
  -- Scroll the REPL on PageUp or PageDown
  Key Key
V.KPageUp -> ViewportScroll Name -> forall s. Direction -> EventM Name s ()
forall n. ViewportScroll n -> forall s. Direction -> EventM n s ()
vScrollPage ViewportScroll Name
replScroll Direction
Brick.Up
  Key Key
V.KPageDown -> ViewportScroll Name -> forall s. Direction -> EventM Name s ()
forall n. ViewportScroll n -> forall s. Direction -> EventM n s ()
vScrollPage ViewportScroll Name
replScroll Direction
Brick.Down
  BrickEvent Name AppEvent
k -> do
    -- On any other key event, jump to the bottom of the REPL then handle the event
    ViewportScroll Name -> forall s. EventM Name s ()
forall n. ViewportScroll n -> forall s. EventM n s ()
vScrollToEnd ViewportScroll Name
replScroll
    case BrickEvent Name AppEvent
k of
      Key Key
V.KEnter -> do
        AppState
s <- EventM Name AppState AppState
forall s (m :: * -> *). MonadState s m => m s
get
        let theRepl :: REPLState
theRepl = AppState
s AppState -> Getting REPLState AppState REPLState -> REPLState
forall s a. s -> Getting a s a -> a
^. (UIState -> Const REPLState UIState)
-> AppState -> Const REPLState AppState
Lens' AppState UIState
uiState ((UIState -> Const REPLState UIState)
 -> AppState -> Const REPLState AppState)
-> ((REPLState -> Const REPLState REPLState)
    -> UIState -> Const REPLState UIState)
-> Getting REPLState AppState REPLState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UIGameplay -> Const REPLState UIGameplay)
-> UIState -> Const REPLState UIState
Lens' UIState UIGameplay
uiGameplay ((UIGameplay -> Const REPLState UIGameplay)
 -> UIState -> Const REPLState UIState)
-> ((REPLState -> Const REPLState REPLState)
    -> UIGameplay -> Const REPLState UIGameplay)
-> (REPLState -> Const REPLState REPLState)
-> UIState
-> Const REPLState UIState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (REPLState -> Const REPLState REPLState)
-> UIGameplay -> Const REPLState UIGameplay
Lens' UIGameplay REPLState
uiREPL
            uinput :: Text
uinput = REPLState
theRepl REPLState -> Getting Text REPLState Text -> Text
forall s a. s -> Getting a s a -> a
^. Getting Text REPLState Text
Lens' REPLState Text
replPromptText

        if Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ AppState
s AppState -> Getting Bool AppState Bool -> Bool
forall s a. s -> Getting a s a -> a
^. (GameState -> Const Bool GameState)
-> AppState -> Const Bool AppState
Lens' AppState GameState
gameState ((GameState -> Const Bool GameState)
 -> AppState -> Const Bool AppState)
-> ((Bool -> Const Bool Bool) -> GameState -> Const Bool GameState)
-> Getting Bool AppState Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GameControls -> Const Bool GameControls)
-> GameState -> Const Bool GameState
Lens' GameState GameControls
gameControls ((GameControls -> Const Bool GameControls)
 -> GameState -> Const Bool GameState)
-> ((Bool -> Const Bool Bool)
    -> GameControls -> Const Bool GameControls)
-> (Bool -> Const Bool Bool)
-> GameState
-> Const Bool GameState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Const Bool Bool)
-> GameControls -> Const Bool GameControls
Getter GameControls Bool
replWorking
          then case REPLState
theRepl REPLState -> Getting REPLPrompt REPLState REPLPrompt -> REPLPrompt
forall s a. s -> Getting a s a -> a
^. Getting REPLPrompt REPLState REPLPrompt
Lens' REPLState REPLPrompt
replPromptType of
            CmdPrompt [Text]
_ -> do
              Text -> EventM Name AppState ()
forall (m :: * -> *). MonadState AppState m => Text -> m ()
runBaseCode Text
uinput
              Name -> EventM Name AppState ()
forall n s. Ord n => n -> EventM n s ()
invalidateCacheEntry Name
REPLHistoryCache
            SearchPrompt REPLHistory
hist ->
              case Text -> REPLHistory -> Maybe Text
lastEntry Text
uinput REPLHistory
hist of
                Maybe Text
Nothing -> Text -> REPLPrompt -> EventM Name AppState ()
forall (m :: * -> *).
MonadState AppState m =>
Text -> REPLPrompt -> m ()
resetREPL Text
"" ([Text] -> REPLPrompt
CmdPrompt [])
                Just Text
found
                  | Text -> Bool
T.null Text
uinput -> Text -> REPLPrompt -> EventM Name AppState ()
forall (m :: * -> *).
MonadState AppState m =>
Text -> REPLPrompt -> m ()
resetREPL Text
"" ([Text] -> REPLPrompt
CmdPrompt [])
                  | Bool
otherwise -> do
                      Text -> REPLPrompt -> EventM Name AppState ()
forall (m :: * -> *).
MonadState AppState m =>
Text -> REPLPrompt -> m ()
resetREPL Text
found ([Text] -> REPLPrompt
CmdPrompt [])
                      (AppState -> AppState) -> EventM Name AppState ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify AppState -> AppState
validateREPLForm
          else EventM Name AppState ()
forall n s. EventM n s ()
continueWithoutRedraw
      Key Key
V.KUp -> (AppState -> AppState) -> EventM Name AppState ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((AppState -> AppState) -> EventM Name AppState ())
-> (AppState -> AppState) -> EventM Name AppState ()
forall a b. (a -> b) -> a -> b
$ TimeDir -> AppState -> AppState
adjReplHistIndex TimeDir
Older
      Key Key
V.KDown -> do
        REPLState
repl <- Getting REPLState AppState REPLState
-> EventM Name AppState REPLState
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Getting REPLState AppState REPLState
 -> EventM Name AppState REPLState)
-> Getting REPLState AppState REPLState
-> EventM Name AppState REPLState
forall a b. (a -> b) -> a -> b
$ (UIState -> Const REPLState UIState)
-> AppState -> Const REPLState AppState
Lens' AppState UIState
uiState ((UIState -> Const REPLState UIState)
 -> AppState -> Const REPLState AppState)
-> ((REPLState -> Const REPLState REPLState)
    -> UIState -> Const REPLState UIState)
-> Getting REPLState AppState REPLState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UIGameplay -> Const REPLState UIGameplay)
-> UIState -> Const REPLState UIState
Lens' UIState UIGameplay
uiGameplay ((UIGameplay -> Const REPLState UIGameplay)
 -> UIState -> Const REPLState UIState)
-> ((REPLState -> Const REPLState REPLState)
    -> UIGameplay -> Const REPLState UIGameplay)
-> (REPLState -> Const REPLState REPLState)
-> UIState
-> Const REPLState UIState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (REPLState -> Const REPLState REPLState)
-> UIGameplay -> Const REPLState UIGameplay
Lens' UIGameplay REPLState
uiREPL
        let hist :: REPLHistory
hist = REPLState
repl REPLState
-> ((REPLHistory -> Const REPLHistory REPLHistory)
    -> REPLState -> Const REPLHistory REPLState)
-> REPLHistory
forall s a. s -> Getting a s a -> a
^. (REPLHistory -> Const REPLHistory REPLHistory)
-> REPLState -> Const REPLHistory REPLState
Lens' REPLState REPLHistory
replHistory
            uinput :: Text
uinput = REPLState
repl REPLState -> Getting Text REPLState Text -> Text
forall s a. s -> Getting a s a -> a
^. Getting Text REPLState Text
Lens' REPLState Text
replPromptText
        case REPLState
repl REPLState -> Getting REPLPrompt REPLState REPLPrompt -> REPLPrompt
forall s a. s -> Getting a s a -> a
^. Getting REPLPrompt REPLState REPLPrompt
Lens' REPLState REPLPrompt
replPromptType of
          CmdPrompt {}
            | REPLHistory
hist REPLHistory -> Getting Int REPLHistory Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int REPLHistory Int
Lens' REPLHistory Int
replIndex Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== REPLHistory -> Int
replLength REPLHistory
hist Bool -> Bool -> Bool
&& Bool -> Bool
not (Text -> Bool
T.null Text
uinput) ->
                -- Special case for hitting "Down" arrow while entering a new non-empty input:
                -- save the input in the history and make the REPL blank.
                do
                  REPLHistItem -> EventM Name AppState ()
forall (m :: * -> *). MonadState AppState m => REPLHistItem -> m ()
addREPLHistItem (Text -> REPLHistItem
mkREPLSaved Text
uinput)
                  Text -> REPLPrompt -> EventM Name AppState ()
forall (m :: * -> *).
MonadState AppState m =>
Text -> REPLPrompt -> m ()
resetREPL Text
"" ([Text] -> REPLPrompt
CmdPrompt [])
                  (AppState -> AppState) -> EventM Name AppState ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify AppState -> AppState
validateREPLForm
          -- Otherwise, just move around in the history as normal.
          REPLPrompt
_ -> (AppState -> AppState) -> EventM Name AppState ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((AppState -> AppState) -> EventM Name AppState ())
-> (AppState -> AppState) -> EventM Name AppState ()
forall a b. (a -> b) -> a -> b
$ TimeDir -> AppState -> AppState
adjReplHistIndex TimeDir
Newer
      ControlChar Char
'r' -> do
        AppState
s <- EventM Name AppState AppState
forall s (m :: * -> *). MonadState s m => m s
get
        let uinput :: Text
uinput = AppState
s AppState -> Getting Text AppState Text -> Text
forall s a. s -> Getting a s a -> a
^. (UIState -> Const Text UIState) -> AppState -> Const Text AppState
Lens' AppState UIState
uiState ((UIState -> Const Text UIState)
 -> AppState -> Const Text AppState)
-> ((Text -> Const Text Text) -> UIState -> Const Text UIState)
-> Getting Text AppState Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UIGameplay -> Const Text UIGameplay)
-> UIState -> Const Text UIState
Lens' UIState UIGameplay
uiGameplay ((UIGameplay -> Const Text UIGameplay)
 -> UIState -> Const Text UIState)
-> ((Text -> Const Text Text)
    -> UIGameplay -> Const Text UIGameplay)
-> (Text -> Const Text Text)
-> UIState
-> Const Text UIState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (REPLState -> Const Text REPLState)
-> UIGameplay -> Const Text UIGameplay
Lens' UIGameplay REPLState
uiREPL ((REPLState -> Const Text REPLState)
 -> UIGameplay -> Const Text UIGameplay)
-> Getting Text REPLState Text
-> (Text -> Const Text Text)
-> UIGameplay
-> Const Text UIGameplay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting Text REPLState Text
Lens' REPLState Text
replPromptText
        case AppState
s AppState -> Getting REPLPrompt AppState REPLPrompt -> REPLPrompt
forall s a. s -> Getting a s a -> a
^. (UIState -> Const REPLPrompt UIState)
-> AppState -> Const REPLPrompt AppState
Lens' AppState UIState
uiState ((UIState -> Const REPLPrompt UIState)
 -> AppState -> Const REPLPrompt AppState)
-> ((REPLPrompt -> Const REPLPrompt REPLPrompt)
    -> UIState -> Const REPLPrompt UIState)
-> Getting REPLPrompt AppState REPLPrompt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UIGameplay -> Const REPLPrompt UIGameplay)
-> UIState -> Const REPLPrompt UIState
Lens' UIState UIGameplay
uiGameplay ((UIGameplay -> Const REPLPrompt UIGameplay)
 -> UIState -> Const REPLPrompt UIState)
-> ((REPLPrompt -> Const REPLPrompt REPLPrompt)
    -> UIGameplay -> Const REPLPrompt UIGameplay)
-> (REPLPrompt -> Const REPLPrompt REPLPrompt)
-> UIState
-> Const REPLPrompt UIState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (REPLState -> Const REPLPrompt REPLState)
-> UIGameplay -> Const REPLPrompt UIGameplay
Lens' UIGameplay REPLState
uiREPL ((REPLState -> Const REPLPrompt REPLState)
 -> UIGameplay -> Const REPLPrompt UIGameplay)
-> Getting REPLPrompt REPLState REPLPrompt
-> (REPLPrompt -> Const REPLPrompt REPLPrompt)
-> UIGameplay
-> Const REPLPrompt UIGameplay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting REPLPrompt REPLState REPLPrompt
Lens' REPLState REPLPrompt
replPromptType of
          CmdPrompt [Text]
_ -> (UIState -> Identity UIState) -> AppState -> Identity AppState
Lens' AppState UIState
uiState ((UIState -> Identity UIState) -> AppState -> Identity AppState)
-> ((REPLPrompt -> Identity REPLPrompt)
    -> UIState -> Identity UIState)
-> (REPLPrompt -> Identity REPLPrompt)
-> AppState
-> Identity AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UIGameplay -> Identity UIGameplay) -> UIState -> Identity UIState
Lens' UIState UIGameplay
uiGameplay ((UIGameplay -> Identity UIGameplay)
 -> UIState -> Identity UIState)
-> ((REPLPrompt -> Identity REPLPrompt)
    -> UIGameplay -> Identity UIGameplay)
-> (REPLPrompt -> Identity REPLPrompt)
-> UIState
-> Identity UIState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (REPLState -> Identity REPLState)
-> UIGameplay -> Identity UIGameplay
Lens' UIGameplay REPLState
uiREPL ((REPLState -> Identity REPLState)
 -> UIGameplay -> Identity UIGameplay)
-> ((REPLPrompt -> Identity REPLPrompt)
    -> REPLState -> Identity REPLState)
-> (REPLPrompt -> Identity REPLPrompt)
-> UIGameplay
-> Identity UIGameplay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (REPLPrompt -> Identity REPLPrompt)
-> REPLState -> Identity REPLState
Lens' REPLState REPLPrompt
replPromptType ((REPLPrompt -> Identity REPLPrompt)
 -> AppState -> Identity AppState)
-> REPLPrompt -> EventM Name AppState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= REPLHistory -> REPLPrompt
SearchPrompt (AppState
s AppState -> Getting REPLHistory AppState REPLHistory -> REPLHistory
forall s a. s -> Getting a s a -> a
^. (UIState -> Const REPLHistory UIState)
-> AppState -> Const REPLHistory AppState
Lens' AppState UIState
uiState ((UIState -> Const REPLHistory UIState)
 -> AppState -> Const REPLHistory AppState)
-> ((REPLHistory -> Const REPLHistory REPLHistory)
    -> UIState -> Const REPLHistory UIState)
-> Getting REPLHistory AppState REPLHistory
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UIGameplay -> Const REPLHistory UIGameplay)
-> UIState -> Const REPLHistory UIState
Lens' UIState UIGameplay
uiGameplay ((UIGameplay -> Const REPLHistory UIGameplay)
 -> UIState -> Const REPLHistory UIState)
-> ((REPLHistory -> Const REPLHistory REPLHistory)
    -> UIGameplay -> Const REPLHistory UIGameplay)
-> (REPLHistory -> Const REPLHistory REPLHistory)
-> UIState
-> Const REPLHistory UIState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (REPLState -> Const REPLHistory REPLState)
-> UIGameplay -> Const REPLHistory UIGameplay
Lens' UIGameplay REPLState
uiREPL ((REPLState -> Const REPLHistory REPLState)
 -> UIGameplay -> Const REPLHistory UIGameplay)
-> ((REPLHistory -> Const REPLHistory REPLHistory)
    -> REPLState -> Const REPLHistory REPLState)
-> (REPLHistory -> Const REPLHistory REPLHistory)
-> UIGameplay
-> Const REPLHistory UIGameplay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (REPLHistory -> Const REPLHistory REPLHistory)
-> REPLState -> Const REPLHistory REPLState
Lens' REPLState REPLHistory
replHistory)
          SearchPrompt REPLHistory
rh -> case Text -> REPLHistory -> Maybe Text
lastEntry Text
uinput REPLHistory
rh of
            Maybe Text
Nothing -> () -> EventM Name AppState ()
forall a. a -> EventM Name AppState a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
            Just Text
found -> (UIState -> Identity UIState) -> AppState -> Identity AppState
Lens' AppState UIState
uiState ((UIState -> Identity UIState) -> AppState -> Identity AppState)
-> ((REPLPrompt -> Identity REPLPrompt)
    -> UIState -> Identity UIState)
-> (REPLPrompt -> Identity REPLPrompt)
-> AppState
-> Identity AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UIGameplay -> Identity UIGameplay) -> UIState -> Identity UIState
Lens' UIState UIGameplay
uiGameplay ((UIGameplay -> Identity UIGameplay)
 -> UIState -> Identity UIState)
-> ((REPLPrompt -> Identity REPLPrompt)
    -> UIGameplay -> Identity UIGameplay)
-> (REPLPrompt -> Identity REPLPrompt)
-> UIState
-> Identity UIState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (REPLState -> Identity REPLState)
-> UIGameplay -> Identity UIGameplay
Lens' UIGameplay REPLState
uiREPL ((REPLState -> Identity REPLState)
 -> UIGameplay -> Identity UIGameplay)
-> ((REPLPrompt -> Identity REPLPrompt)
    -> REPLState -> Identity REPLState)
-> (REPLPrompt -> Identity REPLPrompt)
-> UIGameplay
-> Identity UIGameplay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (REPLPrompt -> Identity REPLPrompt)
-> REPLState -> Identity REPLState
Lens' REPLState REPLPrompt
replPromptType ((REPLPrompt -> Identity REPLPrompt)
 -> AppState -> Identity AppState)
-> REPLPrompt -> EventM Name AppState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= REPLHistory -> REPLPrompt
SearchPrompt (Text -> REPLHistory -> REPLHistory
removeEntry Text
found REPLHistory
rh)
      CharKey Char
'\t' -> do
        AppState
s <- EventM Name AppState AppState
forall s (m :: * -> *). MonadState s m => m s
get
        let names :: [Text]
names = AppState
s AppState -> Getting (Endo [Text]) AppState Text -> [Text]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. (GameState -> Const (Endo [Text]) GameState)
-> AppState -> Const (Endo [Text]) AppState
Lens' AppState GameState
gameState ((GameState -> Const (Endo [Text]) GameState)
 -> AppState -> Const (Endo [Text]) AppState)
-> ((Text -> Const (Endo [Text]) Text)
    -> GameState -> Const (Endo [Text]) GameState)
-> Getting (Endo [Text]) AppState Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Env -> Const (Endo [Text]) Env)
-> GameState -> Const (Endo [Text]) GameState
Traversal' GameState Env
baseEnv ((Env -> Const (Endo [Text]) Env)
 -> GameState -> Const (Endo [Text]) GameState)
-> ((Text -> Const (Endo [Text]) Text)
    -> Env -> Const (Endo [Text]) Env)
-> (Text -> Const (Endo [Text]) Text)
-> GameState
-> Const (Endo [Text]) GameState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TCtx -> Const (Endo [Text]) TCtx)
-> Env -> Const (Endo [Text]) Env
Lens' Env TCtx
envTypes ((TCtx -> Const (Endo [Text]) TCtx)
 -> Env -> Const (Endo [Text]) Env)
-> ((Text -> Const (Endo [Text]) Text)
    -> TCtx -> Const (Endo [Text]) TCtx)
-> (Text -> Const (Endo [Text]) Text)
-> Env
-> Const (Endo [Text]) Env
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TCtx -> [(Text, Polytype)])
-> ([(Text, Polytype)] -> Const (Endo [Text]) [(Text, Polytype)])
-> TCtx
-> Const (Endo [Text]) TCtx
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to TCtx -> [(Text, Polytype)]
forall t. Ctx t -> [(Text, t)]
assocs (([(Text, Polytype)] -> Const (Endo [Text]) [(Text, Polytype)])
 -> TCtx -> Const (Endo [Text]) TCtx)
-> ((Text -> Const (Endo [Text]) Text)
    -> [(Text, Polytype)] -> Const (Endo [Text]) [(Text, Polytype)])
-> (Text -> Const (Endo [Text]) Text)
-> TCtx
-> Const (Endo [Text]) TCtx
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Text, Polytype) -> Const (Endo [Text]) (Text, Polytype))
-> [(Text, Polytype)] -> Const (Endo [Text]) [(Text, Polytype)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (((Text, Polytype) -> Const (Endo [Text]) (Text, Polytype))
 -> [(Text, Polytype)] -> Const (Endo [Text]) [(Text, Polytype)])
-> ((Text -> Const (Endo [Text]) Text)
    -> (Text, Polytype) -> Const (Endo [Text]) (Text, Polytype))
-> (Text -> Const (Endo [Text]) Text)
-> [(Text, Polytype)]
-> Const (Endo [Text]) [(Text, Polytype)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Const (Endo [Text]) Text)
-> (Text, Polytype) -> Const (Endo [Text]) (Text, Polytype)
forall s t a b. Field1 s t a b => Lens s t a b
Lens (Text, Polytype) (Text, Polytype) Text Text
_1
        (UIState -> Identity UIState) -> AppState -> Identity AppState
Lens' AppState UIState
uiState ((UIState -> Identity UIState) -> AppState -> Identity AppState)
-> ((REPLState -> Identity REPLState)
    -> UIState -> Identity UIState)
-> (REPLState -> Identity REPLState)
-> AppState
-> Identity AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UIGameplay -> Identity UIGameplay) -> UIState -> Identity UIState
Lens' UIState UIGameplay
uiGameplay ((UIGameplay -> Identity UIGameplay)
 -> UIState -> Identity UIState)
-> ((REPLState -> Identity REPLState)
    -> UIGameplay -> Identity UIGameplay)
-> (REPLState -> Identity REPLState)
-> UIState
-> Identity UIState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (REPLState -> Identity REPLState)
-> UIGameplay -> Identity UIGameplay
Lens' UIGameplay REPLState
uiREPL ((REPLState -> Identity REPLState)
 -> AppState -> Identity AppState)
-> (REPLState -> REPLState) -> EventM Name AppState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= CompletionContext -> [Text] -> EntityMap -> REPLState -> REPLState
tabComplete (Bool -> CompletionContext
CompletionContext (AppState
s AppState -> Getting Bool AppState Bool -> Bool
forall s a. s -> Getting a s a -> a
^. (GameState -> Const Bool GameState)
-> AppState -> Const Bool AppState
Lens' AppState GameState
gameState ((GameState -> Const Bool GameState)
 -> AppState -> Const Bool AppState)
-> ((Bool -> Const Bool Bool) -> GameState -> Const Bool GameState)
-> Getting Bool AppState Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Const Bool Bool) -> GameState -> Const Bool GameState
Lens' GameState Bool
creativeMode)) [Text]
names (AppState
s AppState -> Getting EntityMap AppState EntityMap -> EntityMap
forall s a. s -> Getting a s a -> a
^. (GameState -> Const EntityMap GameState)
-> AppState -> Const EntityMap AppState
Lens' AppState GameState
gameState ((GameState -> Const EntityMap GameState)
 -> AppState -> Const EntityMap AppState)
-> ((EntityMap -> Const EntityMap EntityMap)
    -> GameState -> Const EntityMap GameState)
-> Getting EntityMap AppState EntityMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Landscape -> Const EntityMap Landscape)
-> GameState -> Const EntityMap GameState
Lens' GameState Landscape
landscape ((Landscape -> Const EntityMap Landscape)
 -> GameState -> Const EntityMap GameState)
-> ((EntityMap -> Const EntityMap EntityMap)
    -> Landscape -> Const EntityMap Landscape)
-> (EntityMap -> Const EntityMap EntityMap)
-> GameState
-> Const EntityMap GameState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TerrainEntityMaps -> Const EntityMap TerrainEntityMaps)
-> Landscape -> Const EntityMap Landscape
Lens' Landscape TerrainEntityMaps
terrainAndEntities ((TerrainEntityMaps -> Const EntityMap TerrainEntityMaps)
 -> Landscape -> Const EntityMap Landscape)
-> ((EntityMap -> Const EntityMap EntityMap)
    -> TerrainEntityMaps -> Const EntityMap TerrainEntityMaps)
-> (EntityMap -> Const EntityMap EntityMap)
-> Landscape
-> Const EntityMap Landscape
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (EntityMap -> Const EntityMap EntityMap)
-> TerrainEntityMaps -> Const EntityMap TerrainEntityMaps
Lens' TerrainEntityMaps EntityMap
entityMap)
        (AppState -> AppState) -> EventM Name AppState ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify AppState -> AppState
validateREPLForm
      BrickEvent Name AppEvent
EscapeKey -> do
        REPLPrompt
formSt <- Getting REPLPrompt AppState REPLPrompt
-> EventM Name AppState REPLPrompt
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Getting REPLPrompt AppState REPLPrompt
 -> EventM Name AppState REPLPrompt)
-> Getting REPLPrompt AppState REPLPrompt
-> EventM Name AppState REPLPrompt
forall a b. (a -> b) -> a -> b
$ (UIState -> Const REPLPrompt UIState)
-> AppState -> Const REPLPrompt AppState
Lens' AppState UIState
uiState ((UIState -> Const REPLPrompt UIState)
 -> AppState -> Const REPLPrompt AppState)
-> ((REPLPrompt -> Const REPLPrompt REPLPrompt)
    -> UIState -> Const REPLPrompt UIState)
-> Getting REPLPrompt AppState REPLPrompt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UIGameplay -> Const REPLPrompt UIGameplay)
-> UIState -> Const REPLPrompt UIState
Lens' UIState UIGameplay
uiGameplay ((UIGameplay -> Const REPLPrompt UIGameplay)
 -> UIState -> Const REPLPrompt UIState)
-> ((REPLPrompt -> Const REPLPrompt REPLPrompt)
    -> UIGameplay -> Const REPLPrompt UIGameplay)
-> (REPLPrompt -> Const REPLPrompt REPLPrompt)
-> UIState
-> Const REPLPrompt UIState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (REPLState -> Const REPLPrompt REPLState)
-> UIGameplay -> Const REPLPrompt UIGameplay
Lens' UIGameplay REPLState
uiREPL ((REPLState -> Const REPLPrompt REPLState)
 -> UIGameplay -> Const REPLPrompt UIGameplay)
-> Getting REPLPrompt REPLState REPLPrompt
-> (REPLPrompt -> Const REPLPrompt REPLPrompt)
-> UIGameplay
-> Const REPLPrompt UIGameplay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting REPLPrompt REPLState REPLPrompt
Lens' REPLState REPLPrompt
replPromptType
        case REPLPrompt
formSt of
          CmdPrompt {} -> EventM Name AppState ()
forall n s. EventM n s ()
continueWithoutRedraw
          SearchPrompt REPLHistory
_ -> Text -> REPLPrompt -> EventM Name AppState ()
forall (m :: * -> *).
MonadState AppState m =>
Text -> REPLPrompt -> m ()
resetREPL Text
"" ([Text] -> REPLPrompt
CmdPrompt [])
      ControlChar Char
'd' -> do
        Text
text <- Getting Text AppState Text -> EventM Name AppState Text
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Getting Text AppState Text -> EventM Name AppState Text)
-> Getting Text AppState Text -> EventM Name AppState Text
forall a b. (a -> b) -> a -> b
$ (UIState -> Const Text UIState) -> AppState -> Const Text AppState
Lens' AppState UIState
uiState ((UIState -> Const Text UIState)
 -> AppState -> Const Text AppState)
-> ((Text -> Const Text Text) -> UIState -> Const Text UIState)
-> Getting Text AppState Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UIGameplay -> Const Text UIGameplay)
-> UIState -> Const Text UIState
Lens' UIState UIGameplay
uiGameplay ((UIGameplay -> Const Text UIGameplay)
 -> UIState -> Const Text UIState)
-> ((Text -> Const Text Text)
    -> UIGameplay -> Const Text UIGameplay)
-> (Text -> Const Text Text)
-> UIState
-> Const Text UIState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (REPLState -> Const Text REPLState)
-> UIGameplay -> Const Text UIGameplay
Lens' UIGameplay REPLState
uiREPL ((REPLState -> Const Text REPLState)
 -> UIGameplay -> Const Text UIGameplay)
-> Getting Text REPLState Text
-> (Text -> Const Text Text)
-> UIGameplay
-> Const Text UIGameplay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting Text REPLState Text
Lens' REPLState Text
replPromptText
        if Text
text Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
T.empty
          then ModalType -> EventM Name AppState ()
toggleModal ModalType
QuitModal
          else EventM Name AppState ()
forall n s. EventM n s ()
continueWithoutRedraw
      MetaKey Key
V.KBS ->
        (UIState -> Identity UIState) -> AppState -> Identity AppState
Lens' AppState UIState
uiState ((UIState -> Identity UIState) -> AppState -> Identity AppState)
-> ((Editor Text Name -> Identity (Editor Text Name))
    -> UIState -> Identity UIState)
-> (Editor Text Name -> Identity (Editor Text Name))
-> AppState
-> Identity AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UIGameplay -> Identity UIGameplay) -> UIState -> Identity UIState
Lens' UIState UIGameplay
uiGameplay ((UIGameplay -> Identity UIGameplay)
 -> UIState -> Identity UIState)
-> ((Editor Text Name -> Identity (Editor Text Name))
    -> UIGameplay -> Identity UIGameplay)
-> (Editor Text Name -> Identity (Editor Text Name))
-> UIState
-> Identity UIState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (REPLState -> Identity REPLState)
-> UIGameplay -> Identity UIGameplay
Lens' UIGameplay REPLState
uiREPL ((REPLState -> Identity REPLState)
 -> UIGameplay -> Identity UIGameplay)
-> ((Editor Text Name -> Identity (Editor Text Name))
    -> REPLState -> Identity REPLState)
-> (Editor Text Name -> Identity (Editor Text Name))
-> UIGameplay
-> Identity UIGameplay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Editor Text Name -> Identity (Editor Text Name))
-> REPLState -> Identity REPLState
Lens' REPLState (Editor Text Name)
replPromptEditor ((Editor Text Name -> Identity (Editor Text Name))
 -> AppState -> Identity AppState)
-> (Editor Text Name -> Editor Text Name)
-> EventM Name AppState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (TextZipper Text -> TextZipper Text)
-> Editor Text Name -> Editor Text Name
forall t n.
(TextZipper t -> TextZipper t) -> Editor t n -> Editor t n
applyEdit TextZipper Text -> TextZipper Text
forall a.
(Eq a, GenericTextZipper a) =>
TextZipper a -> TextZipper a
TZ.deletePrevWord
      -- finally if none match pass the event to the editor
      BrickEvent Name AppEvent
ev -> do
        LensLike'
  (Zoomed (EventM Name (Editor Text Name)) ())
  AppState
  (Editor Text Name)
-> EventM Name (Editor Text Name) () -> EventM Name AppState ()
forall c.
LensLike'
  (Zoomed (EventM Name (Editor Text Name)) c)
  AppState
  (Editor Text Name)
-> EventM Name (Editor Text Name) c -> EventM Name AppState c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
Brick.zoom ((UIState -> Focusing (StateT (EventState Name) IO) () UIState)
-> AppState -> Focusing (StateT (EventState Name) IO) () AppState
Lens' AppState UIState
uiState ((UIState -> Focusing (StateT (EventState Name) IO) () UIState)
 -> AppState -> Focusing (StateT (EventState Name) IO) () AppState)
-> ((Editor Text Name
     -> Focusing (StateT (EventState Name) IO) () (Editor Text Name))
    -> UIState -> Focusing (StateT (EventState Name) IO) () UIState)
-> (Editor Text Name
    -> Focusing (StateT (EventState Name) IO) () (Editor Text Name))
-> AppState
-> Focusing (StateT (EventState Name) IO) () AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UIGameplay
 -> Focusing (StateT (EventState Name) IO) () UIGameplay)
-> UIState -> Focusing (StateT (EventState Name) IO) () UIState
Lens' UIState UIGameplay
uiGameplay ((UIGameplay
  -> Focusing (StateT (EventState Name) IO) () UIGameplay)
 -> UIState -> Focusing (StateT (EventState Name) IO) () UIState)
-> ((Editor Text Name
     -> Focusing (StateT (EventState Name) IO) () (Editor Text Name))
    -> UIGameplay
    -> Focusing (StateT (EventState Name) IO) () UIGameplay)
-> (Editor Text Name
    -> Focusing (StateT (EventState Name) IO) () (Editor Text Name))
-> UIState
-> Focusing (StateT (EventState Name) IO) () UIState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (REPLState -> Focusing (StateT (EventState Name) IO) () REPLState)
-> UIGameplay
-> Focusing (StateT (EventState Name) IO) () UIGameplay
Lens' UIGameplay REPLState
uiREPL ((REPLState -> Focusing (StateT (EventState Name) IO) () REPLState)
 -> UIGameplay
 -> Focusing (StateT (EventState Name) IO) () UIGameplay)
-> ((Editor Text Name
     -> Focusing (StateT (EventState Name) IO) () (Editor Text Name))
    -> REPLState
    -> Focusing (StateT (EventState Name) IO) () REPLState)
-> (Editor Text Name
    -> Focusing (StateT (EventState Name) IO) () (Editor Text Name))
-> UIGameplay
-> Focusing (StateT (EventState Name) IO) () UIGameplay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Editor Text Name
 -> Focusing (StateT (EventState Name) IO) () (Editor Text Name))
-> REPLState -> Focusing (StateT (EventState Name) IO) () REPLState
Lens' REPLState (Editor Text Name)
replPromptEditor) (EventM Name (Editor Text Name) () -> EventM Name AppState ())
-> EventM Name (Editor Text Name) () -> EventM Name AppState ()
forall a b. (a -> b) -> a -> b
$ case BrickEvent Name AppEvent
ev of
          CharKey Char
c | Char
c Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (String
"([{" :: String) -> Char -> EventM Name (Editor Text Name) ()
insertMatchingPair Char
c
          BrickEvent Name AppEvent
_ -> BrickEvent Name AppEvent -> EventM Name (Editor Text Name) ()
forall n t e.
(Eq n, DecodeUtf8 t, Eq t, GenericTextZipper t) =>
BrickEvent n e -> EventM n (Editor t n) ()
handleEditorEvent BrickEvent Name AppEvent
ev
        (UIState -> Identity UIState) -> AppState -> Identity AppState
Lens' AppState UIState
uiState ((UIState -> Identity UIState) -> AppState -> Identity AppState)
-> ((REPLPrompt -> Identity REPLPrompt)
    -> UIState -> Identity UIState)
-> (REPLPrompt -> Identity REPLPrompt)
-> AppState
-> Identity AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UIGameplay -> Identity UIGameplay) -> UIState -> Identity UIState
Lens' UIState UIGameplay
uiGameplay ((UIGameplay -> Identity UIGameplay)
 -> UIState -> Identity UIState)
-> ((REPLPrompt -> Identity REPLPrompt)
    -> UIGameplay -> Identity UIGameplay)
-> (REPLPrompt -> Identity REPLPrompt)
-> UIState
-> Identity UIState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (REPLState -> Identity REPLState)
-> UIGameplay -> Identity UIGameplay
Lens' UIGameplay REPLState
uiREPL ((REPLState -> Identity REPLState)
 -> UIGameplay -> Identity UIGameplay)
-> ((REPLPrompt -> Identity REPLPrompt)
    -> REPLState -> Identity REPLState)
-> (REPLPrompt -> Identity REPLPrompt)
-> UIGameplay
-> Identity UIGameplay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (REPLPrompt -> Identity REPLPrompt)
-> REPLState -> Identity REPLState
Lens' REPLState REPLPrompt
replPromptType ((REPLPrompt -> Identity REPLPrompt)
 -> AppState -> Identity AppState)
-> (REPLPrompt -> REPLPrompt) -> EventM Name AppState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= \case
          CmdPrompt [Text]
_ -> [Text] -> REPLPrompt
CmdPrompt [] -- reset completions on any event passed to editor
          SearchPrompt REPLHistory
a -> REPLHistory -> REPLPrompt
SearchPrompt REPLHistory
a
        (AppState -> AppState) -> EventM Name AppState ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify AppState -> AppState
validateREPLForm

insertMatchingPair :: Char -> EventM Name (Editor Text Name) ()
insertMatchingPair :: Char -> EventM Name (Editor Text Name) ()
insertMatchingPair Char
c = (Editor Text Name -> Editor Text Name)
-> EventM Name (Editor Text Name) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((Editor Text Name -> Editor Text Name)
 -> EventM Name (Editor Text Name) ())
-> ((TextZipper Text -> TextZipper Text)
    -> Editor Text Name -> Editor Text Name)
-> (TextZipper Text -> TextZipper Text)
-> EventM Name (Editor Text Name) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TextZipper Text -> TextZipper Text)
-> Editor Text Name -> Editor Text Name
forall t n.
(TextZipper t -> TextZipper t) -> Editor t n -> Editor t n
applyEdit ((TextZipper Text -> TextZipper Text)
 -> EventM Name (Editor Text Name) ())
-> (TextZipper Text -> TextZipper Text)
-> EventM Name (Editor Text Name) ()
forall a b. (a -> b) -> a -> b
$ Char -> TextZipper Text -> TextZipper Text
forall a. Monoid a => Char -> TextZipper a -> TextZipper a
TZ.insertChar Char
c (TextZipper Text -> TextZipper Text)
-> (TextZipper Text -> TextZipper Text)
-> TextZipper Text
-> TextZipper Text
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Char -> TextZipper Text -> TextZipper Text
forall a. Monoid a => Char -> TextZipper a -> TextZipper a
TZ.insertChar (Char -> Char
close Char
c) (TextZipper Text -> TextZipper Text)
-> (TextZipper Text -> TextZipper Text)
-> TextZipper Text
-> TextZipper Text
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> TextZipper Text -> TextZipper Text
forall a. Monoid a => TextZipper a -> TextZipper a
TZ.moveLeft
 where
  close :: Char -> Char
close = \case
    Char
'(' -> Char
')'
    Char
'[' -> Char
']'
    Char
'{' -> Char
'}'
    Char
_ -> Char
c

data CompletionType
  = FunctionName
  | EntityName
  deriving (CompletionType -> CompletionType -> Bool
(CompletionType -> CompletionType -> Bool)
-> (CompletionType -> CompletionType -> Bool) -> Eq CompletionType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CompletionType -> CompletionType -> Bool
== :: CompletionType -> CompletionType -> Bool
$c/= :: CompletionType -> CompletionType -> Bool
/= :: CompletionType -> CompletionType -> Bool
Eq)

newtype CompletionContext = CompletionContext {CompletionContext -> Bool
ctxCreativeMode :: Bool}
  deriving (CompletionContext -> CompletionContext -> Bool
(CompletionContext -> CompletionContext -> Bool)
-> (CompletionContext -> CompletionContext -> Bool)
-> Eq CompletionContext
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CompletionContext -> CompletionContext -> Bool
== :: CompletionContext -> CompletionContext -> Bool
$c/= :: CompletionContext -> CompletionContext -> Bool
/= :: CompletionContext -> CompletionContext -> Bool
Eq)

-- | Reserved words corresponding to commands that can only be used in
--   creative mode.  We only autocomplete to these when in creative mode.
creativeWords :: Set Text
creativeWords :: Set Text
creativeWords =
  [Text] -> Set Text
forall a. Ord a => [a] -> Set a
S.fromList
    ([Text] -> Set Text) -> ([Const] -> [Text]) -> [Const] -> Set Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Const -> Text) -> [Const] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (ConstInfo -> Text
syntax (ConstInfo -> Text) -> (Const -> ConstInfo) -> Const -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Const -> ConstInfo
constInfo)
    ([Const] -> [Text]) -> ([Const] -> [Const]) -> [Const] -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Const -> Bool) -> [Const] -> [Const]
forall a. (a -> Bool) -> [a] -> [a]
filter (\Const
w -> Const -> Maybe Capability
constCaps Const
w Maybe Capability -> Maybe Capability -> Bool
forall a. Eq a => a -> a -> Bool
== Capability -> Maybe Capability
forall a. a -> Maybe a
Just Capability
CGod)
    ([Const] -> Set Text) -> [Const] -> Set Text
forall a b. (a -> b) -> a -> b
$ [Const]
allConst

-- | Try to complete the last word in a partially-entered REPL prompt using
--   reserved words and names in scope (in the case of function names) or
--   entity names (in the case of string literals).
tabComplete :: CompletionContext -> [Var] -> EntityMap -> REPLState -> REPLState
tabComplete :: CompletionContext -> [Text] -> EntityMap -> REPLState -> REPLState
tabComplete CompletionContext {Bool
ctxCreativeMode :: CompletionContext -> Bool
ctxCreativeMode :: Bool
..} [Text]
names EntityMap
em REPLState
theRepl = case REPLState
theRepl REPLState -> Getting REPLPrompt REPLState REPLPrompt -> REPLPrompt
forall s a. s -> Getting a s a -> a
^. Getting REPLPrompt REPLState REPLPrompt
Lens' REPLState REPLPrompt
replPromptType of
  SearchPrompt REPLHistory
_ -> REPLState
theRepl
  CmdPrompt [Text]
mms
    -- Case 1: If completion candidates have already been
    -- populated via case (3), cycle through them.
    -- Note that tabbing through the candidates *does* update the value
    -- of "t", which one might think would narrow the candidate list
    -- to only that match and therefore halt the cycling.
    -- However, the candidate list only gets recomputed (repopulated)
    -- if the user subsequently presses a non-Tab key. Thus the current
    -- value of "t" is ignored for all Tab presses subsequent to the
    -- first.
    | (Text
m : [Text]
ms) <- [Text]
mms -> Text -> [Text] -> REPLState
setCmd (Text -> Text
replacementFunc Text
m) ([Text]
ms [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text
m])
    -- Case 2: Require at least one letter to be typed in order to offer completions for
    -- function names.
    -- We allow suggestions for Entity Name strings without anything having been typed.
    | Text -> Bool
T.null Text
lastWord Bool -> Bool -> Bool
&& CompletionType
completionType CompletionType -> CompletionType -> Bool
forall a. Eq a => a -> a -> Bool
== CompletionType
FunctionName -> Text -> [Text] -> REPLState
setCmd Text
t []
    -- Case 3: Typing another character in the REPL clears the completion candidates from
    -- the CmdPrompt, so when Tab is pressed again, this case then gets executed and
    -- repopulates them.
    | Bool
otherwise -> case [Text]
candidateMatches of
        [] -> Text -> [Text] -> REPLState
setCmd Text
t []
        [Text
m] -> Text -> [Text] -> REPLState
setCmd (Text -> Text
completeWith Text
m) []
        -- Perform completion with the first candidate, then populate the list
        -- of all candidates with the current completion moved to the back
        -- of the queue.
        (Text
m : [Text]
ms) -> Text -> [Text] -> REPLState
setCmd (Text -> Text
completeWith Text
m) ([Text]
ms [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text
m])
 where
  -- checks the "parity" of the number of quotes. If odd, then there is an open quote.
  hasOpenQuotes :: Text -> Bool
hasOpenQuotes = (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1) (Int -> Bool) -> (Text -> Int) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
2) (Int -> Int) -> (Text -> Int) -> Text -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => Text -> Text -> Int
Text -> Text -> Int
T.count Text
"\""

  completionType :: CompletionType
completionType =
    if Text -> Bool
hasOpenQuotes Text
t
      then CompletionType
EntityName
      else CompletionType
FunctionName

  replacementFunc :: Text -> Text
replacementFunc = Text -> Text -> Text
T.append (Text -> Text -> Text) -> Text -> Text -> Text
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Text -> Text
T.dropWhileEnd Char -> Bool
replacementBoundaryPredicate Text
t
  completeWith :: Text -> Text
completeWith Text
m = Text -> Text -> Text
T.append Text
t (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
T.drop (Text -> Int
T.length Text
lastWord) Text
m
  lastWord :: Text
lastWord = (Char -> Bool) -> Text -> Text
T.takeWhileEnd Char -> Bool
replacementBoundaryPredicate Text
t
  candidateMatches :: [Text]
candidateMatches = (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Text
lastWord Text -> Text -> Bool
`T.isPrefixOf`) [Text]
replacementCandidates

  ([Text]
replacementCandidates, Char -> Bool
replacementBoundaryPredicate) = case CompletionType
completionType of
    CompletionType
EntityName -> ([Text]
entityNames, (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'"'))
    CompletionType
FunctionName -> ([Text]
possibleWords, Char -> Bool
isIdentChar)

  possibleWords :: [Text]
possibleWords =
    [Text]
names [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> case Bool
ctxCreativeMode of
      Bool
True -> Set Text -> [Text]
forall a. Set a -> [a]
S.toList Set Text
reservedWords
      Bool
False -> Set Text -> [Text]
forall a. Set a -> [a]
S.toList (Set Text -> [Text]) -> Set Text -> [Text]
forall a b. (a -> b) -> a -> b
$ Set Text
reservedWords Set Text -> Set Text -> Set Text
forall a. Ord a => Set a -> Set a -> Set a
`S.difference` Set Text
creativeWords

  entityNames :: [Text]
entityNames = Map Text Entity -> [Text]
forall k a. Map k a -> [k]
M.keys (Map Text Entity -> [Text]) -> Map Text Entity -> [Text]
forall a b. (a -> b) -> a -> b
$ EntityMap -> Map Text Entity
entitiesByName EntityMap
em

  t :: Text
t = REPLState
theRepl REPLState -> Getting Text REPLState Text -> Text
forall s a. s -> Getting a s a -> a
^. Getting Text REPLState Text
Lens' REPLState Text
replPromptText
  setCmd :: Text -> [Text] -> REPLState
setCmd Text
nt [Text]
ms =
    REPLState
theRepl
      REPLState -> (REPLState -> REPLState) -> REPLState
forall a b. a -> (a -> b) -> b
& (Text -> Identity Text) -> REPLState -> Identity REPLState
Lens' REPLState Text
replPromptText ((Text -> Identity Text) -> REPLState -> Identity REPLState)
-> Text -> REPLState -> REPLState
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Text
nt
      REPLState -> (REPLState -> REPLState) -> REPLState
forall a b. a -> (a -> b) -> b
& (REPLPrompt -> Identity REPLPrompt)
-> REPLState -> Identity REPLState
Lens' REPLState REPLPrompt
replPromptType ((REPLPrompt -> Identity REPLPrompt)
 -> REPLState -> Identity REPLState)
-> REPLPrompt -> REPLState -> REPLState
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Text] -> REPLPrompt
CmdPrompt [Text]
ms

-- | Validate the REPL input when it changes: see if it parses and
--   typechecks, and set the color accordingly.
validateREPLForm :: AppState -> AppState
validateREPLForm :: AppState -> AppState
validateREPLForm AppState
s =
  case REPLPrompt
replPrompt of
    CmdPrompt [Text]
_
      | Text -> Bool
T.null Text
uinput ->
          let theType :: Maybe Polytype
theType = AppState
s AppState
-> Getting (Maybe Polytype) AppState (Maybe Polytype)
-> Maybe Polytype
forall s a. s -> Getting a s a -> a
^. (GameState -> Const (Maybe Polytype) GameState)
-> AppState -> Const (Maybe Polytype) AppState
Lens' AppState GameState
gameState ((GameState -> Const (Maybe Polytype) GameState)
 -> AppState -> Const (Maybe Polytype) AppState)
-> ((Maybe Polytype -> Const (Maybe Polytype) (Maybe Polytype))
    -> GameState -> Const (Maybe Polytype) GameState)
-> Getting (Maybe Polytype) AppState (Maybe Polytype)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GameControls -> Const (Maybe Polytype) GameControls)
-> GameState -> Const (Maybe Polytype) GameState
Lens' GameState GameControls
gameControls ((GameControls -> Const (Maybe Polytype) GameControls)
 -> GameState -> Const (Maybe Polytype) GameState)
-> ((Maybe Polytype -> Const (Maybe Polytype) (Maybe Polytype))
    -> GameControls -> Const (Maybe Polytype) GameControls)
-> (Maybe Polytype -> Const (Maybe Polytype) (Maybe Polytype))
-> GameState
-> Const (Maybe Polytype) GameState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (REPLStatus -> Const (Maybe Polytype) REPLStatus)
-> GameControls -> Const (Maybe Polytype) GameControls
Lens' GameControls REPLStatus
replStatus ((REPLStatus -> Const (Maybe Polytype) REPLStatus)
 -> GameControls -> Const (Maybe Polytype) GameControls)
-> ((Maybe Polytype -> Const (Maybe Polytype) (Maybe Polytype))
    -> REPLStatus -> Const (Maybe Polytype) REPLStatus)
-> (Maybe Polytype -> Const (Maybe Polytype) (Maybe Polytype))
-> GameControls
-> Const (Maybe Polytype) GameControls
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Polytype -> Const (Maybe Polytype) (Maybe Polytype))
-> REPLStatus -> Const (Maybe Polytype) REPLStatus
Getter REPLStatus (Maybe Polytype)
replActiveType
           in AppState
s AppState -> (AppState -> AppState) -> AppState
forall a b. a -> (a -> b) -> b
& (UIState -> Identity UIState) -> AppState -> Identity AppState
Lens' AppState UIState
uiState ((UIState -> Identity UIState) -> AppState -> Identity AppState)
-> ((Maybe Polytype -> Identity (Maybe Polytype))
    -> UIState -> Identity UIState)
-> (Maybe Polytype -> Identity (Maybe Polytype))
-> AppState
-> Identity AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UIGameplay -> Identity UIGameplay) -> UIState -> Identity UIState
Lens' UIState UIGameplay
uiGameplay ((UIGameplay -> Identity UIGameplay)
 -> UIState -> Identity UIState)
-> ((Maybe Polytype -> Identity (Maybe Polytype))
    -> UIGameplay -> Identity UIGameplay)
-> (Maybe Polytype -> Identity (Maybe Polytype))
-> UIState
-> Identity UIState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (REPLState -> Identity REPLState)
-> UIGameplay -> Identity UIGameplay
Lens' UIGameplay REPLState
uiREPL ((REPLState -> Identity REPLState)
 -> UIGameplay -> Identity UIGameplay)
-> ((Maybe Polytype -> Identity (Maybe Polytype))
    -> REPLState -> Identity REPLState)
-> (Maybe Polytype -> Identity (Maybe Polytype))
-> UIGameplay
-> Identity UIGameplay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Polytype -> Identity (Maybe Polytype))
-> REPLState -> Identity REPLState
Lens' REPLState (Maybe Polytype)
replType ((Maybe Polytype -> Identity (Maybe Polytype))
 -> AppState -> Identity AppState)
-> Maybe Polytype -> AppState -> AppState
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe Polytype
theType
    CmdPrompt [Text]
_
      | Bool
otherwise ->
          let env :: Env
env = AppState
s AppState -> Getting Env AppState Env -> Env
forall s a. s -> Getting a s a -> a
^. (GameState -> Const Env GameState)
-> AppState -> Const Env AppState
Lens' AppState GameState
gameState ((GameState -> Const Env GameState)
 -> AppState -> Const Env AppState)
-> ((Env -> Const Env Env) -> GameState -> Const Env GameState)
-> Getting Env AppState Env
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Env -> Const Env Env) -> GameState -> Const Env GameState
Traversal' GameState Env
baseEnv
              (Maybe Polytype
theType, Either SrcLoc ()
errSrcLoc) = case ParserConfig -> Text -> Either ParserError (Maybe Syntax)
readTerm' ParserConfig
defaultParserConfig Text
uinput of
                Left ParserError
err ->
                  let ((Int
_y1, Int
x1), (Int
_y2, Int
x2), Text
_msg) = ParserError -> ((Int, Int), (Int, Int), Text)
showErrorPos ParserError
err
                   in (Maybe Polytype
forall a. Maybe a
Nothing, SrcLoc -> Either SrcLoc ()
forall a b. a -> Either a b
Left (Int -> Int -> SrcLoc
SrcLoc Int
x1 Int
x2))
                Right Maybe Syntax
Nothing -> (Maybe Polytype
forall a. Maybe a
Nothing, () -> Either SrcLoc ()
forall a b. b -> Either a b
Right ())
                Right (Just Syntax
theTerm) -> case Env -> Syntax -> Either ContextualTypeErr TSyntax
processParsedTerm' Env
env Syntax
theTerm of
                  Right TSyntax
t -> (Polytype -> Maybe Polytype
forall a. a -> Maybe a
Just (TSyntax
t TSyntax -> Getting Polytype TSyntax Polytype -> Polytype
forall s a. s -> Getting a s a -> a
^. Getting Polytype TSyntax Polytype
forall ty (f :: * -> *).
Functor f =>
(ty -> f ty) -> Syntax' ty -> f (Syntax' ty)
sType), () -> Either SrcLoc ()
forall a b. b -> Either a b
Right ())
                  Left ContextualTypeErr
err -> (Maybe Polytype
forall a. Maybe a
Nothing, SrcLoc -> Either SrcLoc ()
forall a b. a -> Either a b
Left (ContextualTypeErr -> SrcLoc
cteSrcLoc ContextualTypeErr
err))
           in AppState
s
                AppState -> (AppState -> AppState) -> AppState
forall a b. a -> (a -> b) -> b
& (UIState -> Identity UIState) -> AppState -> Identity AppState
Lens' AppState UIState
uiState ((UIState -> Identity UIState) -> AppState -> Identity AppState)
-> ((Either SrcLoc () -> Identity (Either SrcLoc ()))
    -> UIState -> Identity UIState)
-> (Either SrcLoc () -> Identity (Either SrcLoc ()))
-> AppState
-> Identity AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UIGameplay -> Identity UIGameplay) -> UIState -> Identity UIState
Lens' UIState UIGameplay
uiGameplay ((UIGameplay -> Identity UIGameplay)
 -> UIState -> Identity UIState)
-> ((Either SrcLoc () -> Identity (Either SrcLoc ()))
    -> UIGameplay -> Identity UIGameplay)
-> (Either SrcLoc () -> Identity (Either SrcLoc ()))
-> UIState
-> Identity UIState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (REPLState -> Identity REPLState)
-> UIGameplay -> Identity UIGameplay
Lens' UIGameplay REPLState
uiREPL ((REPLState -> Identity REPLState)
 -> UIGameplay -> Identity UIGameplay)
-> ((Either SrcLoc () -> Identity (Either SrcLoc ()))
    -> REPLState -> Identity REPLState)
-> (Either SrcLoc () -> Identity (Either SrcLoc ()))
-> UIGameplay
-> Identity UIGameplay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Either SrcLoc () -> Identity (Either SrcLoc ()))
-> REPLState -> Identity REPLState
Lens' REPLState (Either SrcLoc ())
replValid ((Either SrcLoc () -> Identity (Either SrcLoc ()))
 -> AppState -> Identity AppState)
-> Either SrcLoc () -> AppState -> AppState
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Either SrcLoc ()
errSrcLoc
                AppState -> (AppState -> AppState) -> AppState
forall a b. a -> (a -> b) -> b
& (UIState -> Identity UIState) -> AppState -> Identity AppState
Lens' AppState UIState
uiState ((UIState -> Identity UIState) -> AppState -> Identity AppState)
-> ((Maybe Polytype -> Identity (Maybe Polytype))
    -> UIState -> Identity UIState)
-> (Maybe Polytype -> Identity (Maybe Polytype))
-> AppState
-> Identity AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UIGameplay -> Identity UIGameplay) -> UIState -> Identity UIState
Lens' UIState UIGameplay
uiGameplay ((UIGameplay -> Identity UIGameplay)
 -> UIState -> Identity UIState)
-> ((Maybe Polytype -> Identity (Maybe Polytype))
    -> UIGameplay -> Identity UIGameplay)
-> (Maybe Polytype -> Identity (Maybe Polytype))
-> UIState
-> Identity UIState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (REPLState -> Identity REPLState)
-> UIGameplay -> Identity UIGameplay
Lens' UIGameplay REPLState
uiREPL ((REPLState -> Identity REPLState)
 -> UIGameplay -> Identity UIGameplay)
-> ((Maybe Polytype -> Identity (Maybe Polytype))
    -> REPLState -> Identity REPLState)
-> (Maybe Polytype -> Identity (Maybe Polytype))
-> UIGameplay
-> Identity UIGameplay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Polytype -> Identity (Maybe Polytype))
-> REPLState -> Identity REPLState
Lens' REPLState (Maybe Polytype)
replType ((Maybe Polytype -> Identity (Maybe Polytype))
 -> AppState -> Identity AppState)
-> Maybe Polytype -> AppState -> AppState
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe Polytype
theType
    SearchPrompt REPLHistory
_ -> AppState
s
 where
  uinput :: Text
uinput = AppState
s AppState -> Getting Text AppState Text -> Text
forall s a. s -> Getting a s a -> a
^. (UIState -> Const Text UIState) -> AppState -> Const Text AppState
Lens' AppState UIState
uiState ((UIState -> Const Text UIState)
 -> AppState -> Const Text AppState)
-> ((Text -> Const Text Text) -> UIState -> Const Text UIState)
-> Getting Text AppState Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UIGameplay -> Const Text UIGameplay)
-> UIState -> Const Text UIState
Lens' UIState UIGameplay
uiGameplay ((UIGameplay -> Const Text UIGameplay)
 -> UIState -> Const Text UIState)
-> ((Text -> Const Text Text)
    -> UIGameplay -> Const Text UIGameplay)
-> (Text -> Const Text Text)
-> UIState
-> Const Text UIState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (REPLState -> Const Text REPLState)
-> UIGameplay -> Const Text UIGameplay
Lens' UIGameplay REPLState
uiREPL ((REPLState -> Const Text REPLState)
 -> UIGameplay -> Const Text UIGameplay)
-> Getting Text REPLState Text
-> (Text -> Const Text Text)
-> UIGameplay
-> Const Text UIGameplay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting Text REPLState Text
Lens' REPLState Text
replPromptText
  replPrompt :: REPLPrompt
replPrompt = AppState
s AppState -> Getting REPLPrompt AppState REPLPrompt -> REPLPrompt
forall s a. s -> Getting a s a -> a
^. (UIState -> Const REPLPrompt UIState)
-> AppState -> Const REPLPrompt AppState
Lens' AppState UIState
uiState ((UIState -> Const REPLPrompt UIState)
 -> AppState -> Const REPLPrompt AppState)
-> ((REPLPrompt -> Const REPLPrompt REPLPrompt)
    -> UIState -> Const REPLPrompt UIState)
-> Getting REPLPrompt AppState REPLPrompt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UIGameplay -> Const REPLPrompt UIGameplay)
-> UIState -> Const REPLPrompt UIState
Lens' UIState UIGameplay
uiGameplay ((UIGameplay -> Const REPLPrompt UIGameplay)
 -> UIState -> Const REPLPrompt UIState)
-> ((REPLPrompt -> Const REPLPrompt REPLPrompt)
    -> UIGameplay -> Const REPLPrompt UIGameplay)
-> (REPLPrompt -> Const REPLPrompt REPLPrompt)
-> UIState
-> Const REPLPrompt UIState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (REPLState -> Const REPLPrompt REPLState)
-> UIGameplay -> Const REPLPrompt UIGameplay
Lens' UIGameplay REPLState
uiREPL ((REPLState -> Const REPLPrompt REPLState)
 -> UIGameplay -> Const REPLPrompt UIGameplay)
-> Getting REPLPrompt REPLState REPLPrompt
-> (REPLPrompt -> Const REPLPrompt REPLPrompt)
-> UIGameplay
-> Const REPLPrompt UIGameplay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting REPLPrompt REPLState REPLPrompt
Lens' REPLState REPLPrompt
replPromptType

-- | Update our current position in the REPL history.
adjReplHistIndex :: TimeDir -> AppState -> AppState
adjReplHistIndex :: TimeDir -> AppState -> AppState
adjReplHistIndex TimeDir
d AppState
s =
  AppState
s
    AppState -> (AppState -> AppState) -> AppState
forall a b. a -> (a -> b) -> b
& (UIState -> Identity UIState) -> AppState -> Identity AppState
Lens' AppState UIState
uiState ((UIState -> Identity UIState) -> AppState -> Identity AppState)
-> ((REPLState -> Identity REPLState)
    -> UIState -> Identity UIState)
-> (REPLState -> Identity REPLState)
-> AppState
-> Identity AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UIGameplay -> Identity UIGameplay) -> UIState -> Identity UIState
Lens' UIState UIGameplay
uiGameplay ((UIGameplay -> Identity UIGameplay)
 -> UIState -> Identity UIState)
-> ((REPLState -> Identity REPLState)
    -> UIGameplay -> Identity UIGameplay)
-> (REPLState -> Identity REPLState)
-> UIState
-> Identity UIState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (REPLState -> Identity REPLState)
-> UIGameplay -> Identity UIGameplay
Lens' UIGameplay REPLState
uiREPL ((REPLState -> Identity REPLState)
 -> AppState -> Identity AppState)
-> (REPLState -> REPLState) -> AppState -> AppState
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ REPLState -> REPLState
moveREPL
    AppState -> (AppState -> AppState) -> AppState
forall a b. a -> (a -> b) -> b
& AppState -> AppState
validateREPLForm
 where
  moveREPL :: REPLState -> REPLState
  moveREPL :: REPLState -> REPLState
moveREPL REPLState
theRepl =
    REPLState
newREPL
      REPLState -> (REPLState -> REPLState) -> REPLState
forall a b. a -> (a -> b) -> b
& (if REPLHistory -> Bool
replIndexIsAtInput (REPLState
theRepl REPLState
-> ((REPLHistory -> Const REPLHistory REPLHistory)
    -> REPLState -> Const REPLHistory REPLState)
-> REPLHistory
forall s a. s -> Getting a s a -> a
^. (REPLHistory -> Const REPLHistory REPLHistory)
-> REPLState -> Const REPLHistory REPLState
Lens' REPLState REPLHistory
replHistory) then REPLState -> REPLState
saveLastEntry else REPLState -> REPLState
forall a. a -> a
id)
      REPLState -> (REPLState -> REPLState) -> REPLState
forall a b. a -> (a -> b) -> b
& (if Text
oldEntry Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
newEntry then REPLState -> REPLState
showNewEntry else REPLState -> REPLState
forall a. a -> a
id)
   where
    -- new AppState after moving the repl index
    newREPL :: REPLState
    newREPL :: REPLState
newREPL = REPLState
theRepl REPLState -> (REPLState -> REPLState) -> REPLState
forall a b. a -> (a -> b) -> b
& (REPLHistory -> Identity REPLHistory)
-> REPLState -> Identity REPLState
Lens' REPLState REPLHistory
replHistory ((REPLHistory -> Identity REPLHistory)
 -> REPLState -> Identity REPLState)
-> (REPLHistory -> REPLHistory) -> REPLState -> REPLState
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ TimeDir -> Text -> REPLHistory -> REPLHistory
moveReplHistIndex TimeDir
d Text
oldEntry

    saveLastEntry :: REPLState -> REPLState
saveLastEntry = (Text -> Identity Text) -> REPLState -> Identity REPLState
Lens' REPLState Text
replLast ((Text -> Identity Text) -> REPLState -> Identity REPLState)
-> Text -> REPLState -> REPLState
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (REPLState
theRepl REPLState -> Getting Text REPLState Text -> Text
forall s a. s -> Getting a s a -> a
^. Getting Text REPLState Text
Lens' REPLState Text
replPromptText)
    showNewEntry :: REPLState -> REPLState
showNewEntry = ((Editor Text Name -> Identity (Editor Text Name))
-> REPLState -> Identity REPLState
Lens' REPLState (Editor Text Name)
replPromptEditor ((Editor Text Name -> Identity (Editor Text Name))
 -> REPLState -> Identity REPLState)
-> Editor Text Name -> REPLState -> REPLState
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Text -> Editor Text Name
newREPLEditor Text
newEntry) (REPLState -> REPLState)
-> (REPLState -> REPLState) -> REPLState -> REPLState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((REPLPrompt -> Identity REPLPrompt)
-> REPLState -> Identity REPLState
Lens' REPLState REPLPrompt
replPromptType ((REPLPrompt -> Identity REPLPrompt)
 -> REPLState -> Identity REPLState)
-> REPLPrompt -> REPLState -> REPLState
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Text] -> REPLPrompt
CmdPrompt [])
    -- get REPL data
    getCurrEntry :: REPLState -> Text
getCurrEntry = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe (REPLState
theRepl REPLState -> Getting Text REPLState Text -> Text
forall s a. s -> Getting a s a -> a
^. Getting Text REPLState Text
Lens' REPLState Text
replLast) (Maybe Text -> Text)
-> (REPLState -> Maybe Text) -> REPLState -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. REPLHistory -> Maybe Text
getCurrentItemText (REPLHistory -> Maybe Text)
-> (REPLState -> REPLHistory) -> REPLState -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((REPLHistory -> Const REPLHistory REPLHistory)
 -> REPLState -> Const REPLHistory REPLState)
-> REPLState -> REPLHistory
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (REPLHistory -> Const REPLHistory REPLHistory)
-> REPLState -> Const REPLHistory REPLState
Lens' REPLState REPLHistory
replHistory
    oldEntry :: Text
oldEntry = REPLState -> Text
getCurrEntry REPLState
theRepl
    newEntry :: Text
newEntry = REPLState -> Text
getCurrEntry REPLState
newREPL

------------------------------------------------------------
-- Info panel events
------------------------------------------------------------

-- | Handle user events in the info panel (just scrolling).
--
-- TODO: #2010 Finish porting Controller to KeyEventHandlers
handleInfoPanelEvent :: ViewportScroll Name -> BrickEvent Name AppEvent -> EventM Name AppState ()
handleInfoPanelEvent :: ViewportScroll Name
-> BrickEvent Name AppEvent -> EventM Name AppState ()
handleInfoPanelEvent ViewportScroll Name
vs = \case
  Key Key
V.KDown -> ViewportScroll Name -> forall s. Int -> EventM Name s ()
forall n. ViewportScroll n -> forall s. Int -> EventM n s ()
vScrollBy ViewportScroll Name
vs Int
1
  Key Key
V.KUp -> ViewportScroll Name -> forall s. Int -> EventM Name s ()
forall n. ViewportScroll n -> forall s. Int -> EventM n s ()
vScrollBy ViewportScroll Name
vs (-Int
1)
  CharKey Char
'k' -> ViewportScroll Name -> forall s. Int -> EventM Name s ()
forall n. ViewportScroll n -> forall s. Int -> EventM n s ()
vScrollBy ViewportScroll Name
vs Int
1
  CharKey Char
'j' -> ViewportScroll Name -> forall s. Int -> EventM Name s ()
forall n. ViewportScroll n -> forall s. Int -> EventM n s ()
vScrollBy ViewportScroll Name
vs (-Int
1)
  Key Key
V.KPageDown -> ViewportScroll Name -> forall s. Direction -> EventM Name s ()
forall n. ViewportScroll n -> forall s. Direction -> EventM n s ()
vScrollPage ViewportScroll Name
vs Direction
Brick.Down
  Key Key
V.KPageUp -> ViewportScroll Name -> forall s. Direction -> EventM Name s ()
forall n. ViewportScroll n -> forall s. Direction -> EventM n s ()
vScrollPage ViewportScroll Name
vs Direction
Brick.Up
  Key Key
V.KHome -> ViewportScroll Name -> forall s. EventM Name s ()
forall n. ViewportScroll n -> forall s. EventM n s ()
vScrollToBeginning ViewportScroll Name
vs
  Key Key
V.KEnd -> ViewportScroll Name -> forall s. EventM Name s ()
forall n. ViewportScroll n -> forall s. EventM n s ()
vScrollToEnd ViewportScroll Name
vs
  BrickEvent Name AppEvent
_ -> () -> EventM Name AppState ()
forall a. a -> EventM Name AppState a
forall (m :: * -> *) a. Monad m => a -> m a
return ()