{-# LANGUAGE OverloadedStrings #-}

-- |
-- SPDX-License-Identifier: BSD-3-Clause
--
-- Here is the REPL player configurable key event handler.
module Swarm.TUI.Controller.EventHandlers.REPL (
  replEventHandlers,
) where

import Brick
import Brick.Keybindings qualified as B
import Control.Lens as Lens
import Control.Monad (when)
import Data.Maybe (isJust)
import Data.Text qualified as T
import Swarm.Game.CESK (cancel)
import Swarm.Game.Robot.Concrete
import Swarm.Game.State
import Swarm.Game.State.Substate
import Swarm.TUI.Controller.Util
import Swarm.TUI.Model
import Swarm.TUI.Model.Event
import Swarm.TUI.Model.Repl
import Swarm.TUI.Model.UI.Gameplay

-- | Handle a user input key event for the REPL.
--
-- See 'Swarm.TUI.Controller.handleREPLEvent'.
replEventHandlers :: [B.KeyEventHandler SwarmEvent (EventM Name AppState)]
replEventHandlers :: [KeyEventHandler SwarmEvent (EventM Name AppState)]
replEventHandlers = (REPLEvent -> SwarmEvent)
-> (REPLEvent -> (Text, EventM Name AppState ()))
-> [KeyEventHandler SwarmEvent (EventM Name AppState)]
forall e2 e1 s.
(Ord e2, Enum e1, Bounded e1) =>
(e1 -> e2)
-> (e1 -> (Text, EventM Name s ()))
-> [KeyEventHandler e2 (EventM Name s)]
allHandlers REPLEvent -> SwarmEvent
REPL ((REPLEvent -> (Text, EventM Name AppState ()))
 -> [KeyEventHandler SwarmEvent (EventM Name AppState)])
-> (REPLEvent -> (Text, EventM Name AppState ()))
-> [KeyEventHandler SwarmEvent (EventM Name AppState)]
forall a b. (a -> b) -> a -> b
$ \case
  REPLEvent
CancelRunningProgramEvent -> (Text
"Cancel running base robot program", LensLike'
  (Zoomed (EventM Name ScenarioState) ()) AppState ScenarioState
-> EventM Name ScenarioState () -> EventM Name AppState ()
forall c.
LensLike'
  (Zoomed (EventM Name ScenarioState) c) AppState ScenarioState
-> EventM Name ScenarioState 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 ((PlayState -> Focusing (StateT (EventState Name) IO) () PlayState)
-> AppState -> Focusing (StateT (EventState Name) IO) () AppState
Lens' AppState PlayState
playState ((PlayState -> Focusing (StateT (EventState Name) IO) () PlayState)
 -> AppState -> Focusing (StateT (EventState Name) IO) () AppState)
-> ((ScenarioState
     -> Focusing (StateT (EventState Name) IO) () ScenarioState)
    -> PlayState
    -> Focusing (StateT (EventState Name) IO) () PlayState)
-> (ScenarioState
    -> Focusing (StateT (EventState Name) IO) () ScenarioState)
-> AppState
-> Focusing (StateT (EventState Name) IO) () AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ScenarioState
 -> Focusing (StateT (EventState Name) IO) () ScenarioState)
-> PlayState -> Focusing (StateT (EventState Name) IO) () PlayState
Lens' PlayState ScenarioState
scenarioState) EventM Name ScenarioState ()
cancelRunningBase)
  REPLEvent
TogglePilotingModeEvent -> (Text
"Toggle piloting mode", LensLike'
  (Zoomed (EventM Name ScenarioState) ()) AppState ScenarioState
-> EventM Name ScenarioState () -> EventM Name AppState ()
forall c.
LensLike'
  (Zoomed (EventM Name ScenarioState) c) AppState ScenarioState
-> EventM Name ScenarioState 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 ((PlayState -> Focusing (StateT (EventState Name) IO) () PlayState)
-> AppState -> Focusing (StateT (EventState Name) IO) () AppState
Lens' AppState PlayState
playState ((PlayState -> Focusing (StateT (EventState Name) IO) () PlayState)
 -> AppState -> Focusing (StateT (EventState Name) IO) () AppState)
-> ((ScenarioState
     -> Focusing (StateT (EventState Name) IO) () ScenarioState)
    -> PlayState
    -> Focusing (StateT (EventState Name) IO) () PlayState)
-> (ScenarioState
    -> Focusing (StateT (EventState Name) IO) () ScenarioState)
-> AppState
-> Focusing (StateT (EventState Name) IO) () AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ScenarioState
 -> Focusing (StateT (EventState Name) IO) () ScenarioState)
-> PlayState -> Focusing (StateT (EventState Name) IO) () PlayState
Lens' PlayState ScenarioState
scenarioState) (EventM Name ScenarioState () -> EventM Name AppState ())
-> EventM Name ScenarioState () -> EventM Name AppState ()
forall a b. (a -> b) -> a -> b
$ EventM Name ScenarioState () -> EventM Name ScenarioState ()
forall (m :: * -> *). MonadState ScenarioState m => m () -> m ()
onlyCreative EventM Name ScenarioState ()
togglePilotingMode)
  REPLEvent
ToggleCustomKeyHandlingEvent -> (Text
"Toggle custom key handling mode", LensLike'
  (Zoomed (EventM Name ScenarioState) ()) AppState ScenarioState
-> EventM Name ScenarioState () -> EventM Name AppState ()
forall c.
LensLike'
  (Zoomed (EventM Name ScenarioState) c) AppState ScenarioState
-> EventM Name ScenarioState 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 ((PlayState -> Focusing (StateT (EventState Name) IO) () PlayState)
-> AppState -> Focusing (StateT (EventState Name) IO) () AppState
Lens' AppState PlayState
playState ((PlayState -> Focusing (StateT (EventState Name) IO) () PlayState)
 -> AppState -> Focusing (StateT (EventState Name) IO) () AppState)
-> ((ScenarioState
     -> Focusing (StateT (EventState Name) IO) () ScenarioState)
    -> PlayState
    -> Focusing (StateT (EventState Name) IO) () PlayState)
-> (ScenarioState
    -> Focusing (StateT (EventState Name) IO) () ScenarioState)
-> AppState
-> Focusing (StateT (EventState Name) IO) () AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ScenarioState
 -> Focusing (StateT (EventState Name) IO) () ScenarioState)
-> PlayState -> Focusing (StateT (EventState Name) IO) () PlayState
Lens' PlayState ScenarioState
scenarioState) EventM Name ScenarioState ()
toggleCustomKeyHandling)

-- | Cancel the running base CESK machine and clear REPL input text.
--
-- It is handled in top REPL handler so we can always cancel the currently running
-- base program no matter what REPL control mode we are in.
cancelRunningBase :: EventM Name ScenarioState ()
cancelRunningBase :: EventM Name ScenarioState ()
cancelRunningBase = do
  Bool
working <- Getting Bool ScenarioState Bool -> EventM Name ScenarioState Bool
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Getting Bool ScenarioState Bool -> EventM Name ScenarioState Bool)
-> Getting Bool ScenarioState Bool
-> EventM Name ScenarioState Bool
forall a b. (a -> b) -> a -> b
$ (GameState -> Const Bool GameState)
-> ScenarioState -> Const Bool ScenarioState
Lens' ScenarioState GameState
gameState ((GameState -> Const Bool GameState)
 -> ScenarioState -> Const Bool ScenarioState)
-> ((Bool -> Const Bool Bool) -> GameState -> Const Bool GameState)
-> Getting Bool ScenarioState 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 ScenarioState () -> EventM Name ScenarioState ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
working (EventM Name ScenarioState () -> EventM Name ScenarioState ())
-> EventM Name ScenarioState () -> EventM Name ScenarioState ()
forall a b. (a -> b) -> a -> b
$ (GameState -> Identity GameState)
-> ScenarioState -> Identity ScenarioState
Lens' ScenarioState GameState
gameState ((GameState -> Identity GameState)
 -> ScenarioState -> Identity ScenarioState)
-> ((CESK -> Identity CESK) -> GameState -> Identity GameState)
-> (CESK -> Identity CESK)
-> ScenarioState
-> Identity ScenarioState
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)
 -> ScenarioState -> Identity ScenarioState)
-> (CESK -> CESK) -> EventM Name ScenarioState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= CESK -> CESK
cancel
  LensLike'
  (Zoomed (EventM Name REPLState) ()) ScenarioState REPLState
-> EventM Name REPLState () -> EventM Name ScenarioState ()
forall c.
LensLike'
  (Zoomed (EventM Name REPLState) c) ScenarioState REPLState
-> EventM Name REPLState c -> EventM Name ScenarioState c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
Brick.zoom ((UIGameplay -> Zoomed (EventM Name REPLState) () UIGameplay)
-> ScenarioState -> Zoomed (EventM Name REPLState) () ScenarioState
Lens' ScenarioState UIGameplay
uiGameplay ((UIGameplay -> Zoomed (EventM Name REPLState) () UIGameplay)
 -> ScenarioState
 -> Zoomed (EventM Name REPLState) () ScenarioState)
-> ((REPLState -> Zoomed (EventM Name REPLState) () REPLState)
    -> UIGameplay -> Zoomed (EventM Name REPLState) () UIGameplay)
-> LensLike'
     (Zoomed (EventM Name REPLState) ()) ScenarioState REPLState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (REPLState -> Zoomed (EventM Name REPLState) () REPLState)
-> UIGameplay -> Zoomed (EventM Name REPLState) () UIGameplay
Lens' UIGameplay REPLState
uiREPL) (EventM Name REPLState () -> EventM Name ScenarioState ())
-> EventM Name REPLState () -> EventM Name ScenarioState ()
forall a b. (a -> b) -> a -> b
$ do
    (REPLPrompt -> Identity REPLPrompt)
-> REPLState -> Identity REPLState
Lens' REPLState REPLPrompt
replPromptType ((REPLPrompt -> Identity REPLPrompt)
 -> REPLState -> Identity REPLState)
-> REPLPrompt -> EventM Name REPLState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= [Text] -> REPLPrompt
CmdPrompt []
    (Text -> Identity Text) -> REPLState -> Identity REPLState
Lens' REPLState Text
replPromptText ((Text -> Identity Text) -> REPLState -> Identity REPLState)
-> Text -> EventM Name REPLState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Text
""

togglePilotingMode :: EventM Name ScenarioState ()
togglePilotingMode :: EventM Name ScenarioState ()
togglePilotingMode = do
  ScenarioState
s <- EventM Name ScenarioState ScenarioState
forall s (m :: * -> *). MonadState s m => m s
get
  let theRepl :: REPLState
theRepl = ScenarioState
s ScenarioState
-> Getting REPLState ScenarioState REPLState -> REPLState
forall s a. s -> Getting a s a -> a
^. (UIGameplay -> Const REPLState UIGameplay)
-> ScenarioState -> Const REPLState ScenarioState
Lens' ScenarioState UIGameplay
uiGameplay ((UIGameplay -> Const REPLState UIGameplay)
 -> ScenarioState -> Const REPLState ScenarioState)
-> ((REPLState -> Const REPLState REPLState)
    -> UIGameplay -> Const REPLState UIGameplay)
-> Getting REPLState ScenarioState REPLState
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
      curMode :: ReplControlMode
curMode = REPLState
theRepl REPLState
-> Getting ReplControlMode REPLState ReplControlMode
-> ReplControlMode
forall s a. s -> Getting a s a -> a
^. Getting ReplControlMode REPLState ReplControlMode
Lens' REPLState ReplControlMode
replControlMode
  case ReplControlMode
curMode of
    ReplControlMode
Piloting -> (UIGameplay -> Identity UIGameplay)
-> ScenarioState -> Identity ScenarioState
Lens' ScenarioState UIGameplay
uiGameplay ((UIGameplay -> Identity UIGameplay)
 -> ScenarioState -> Identity ScenarioState)
-> ((ReplControlMode -> Identity ReplControlMode)
    -> UIGameplay -> Identity UIGameplay)
-> (ReplControlMode -> Identity ReplControlMode)
-> ScenarioState
-> Identity ScenarioState
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)
-> ((ReplControlMode -> Identity ReplControlMode)
    -> REPLState -> Identity REPLState)
-> (ReplControlMode -> Identity ReplControlMode)
-> UIGameplay
-> Identity UIGameplay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ReplControlMode -> Identity ReplControlMode)
-> REPLState -> Identity REPLState
Lens' REPLState ReplControlMode
replControlMode ((ReplControlMode -> Identity ReplControlMode)
 -> ScenarioState -> Identity ScenarioState)
-> ReplControlMode -> EventM Name ScenarioState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= ReplControlMode
Typing
    ReplControlMode
_ ->
      if Text -> Bool
T.null Text
uinput
        then (UIGameplay -> Identity UIGameplay)
-> ScenarioState -> Identity ScenarioState
Lens' ScenarioState UIGameplay
uiGameplay ((UIGameplay -> Identity UIGameplay)
 -> ScenarioState -> Identity ScenarioState)
-> ((ReplControlMode -> Identity ReplControlMode)
    -> UIGameplay -> Identity UIGameplay)
-> (ReplControlMode -> Identity ReplControlMode)
-> ScenarioState
-> Identity ScenarioState
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)
-> ((ReplControlMode -> Identity ReplControlMode)
    -> REPLState -> Identity REPLState)
-> (ReplControlMode -> Identity ReplControlMode)
-> UIGameplay
-> Identity UIGameplay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ReplControlMode -> Identity ReplControlMode)
-> REPLState -> Identity REPLState
Lens' REPLState ReplControlMode
replControlMode ((ReplControlMode -> Identity ReplControlMode)
 -> ScenarioState -> Identity ScenarioState)
-> ReplControlMode -> EventM Name ScenarioState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= ReplControlMode
Piloting
        else do
          REPLHistItemType -> Text -> EventM Name ScenarioState ()
forall (m :: * -> *).
MonadState ScenarioState m =>
REPLHistItemType -> Text -> m ()
addREPLHistItem REPLHistItemType
REPLError Text
"Please clear the REPL before engaging pilot mode."
          Name -> EventM Name ScenarioState ()
forall n s. Ord n => n -> EventM n s ()
invalidateCacheEntry Name
REPLHistoryCache

toggleCustomKeyHandling :: EventM Name ScenarioState ()
toggleCustomKeyHandling :: EventM Name ScenarioState ()
toggleCustomKeyHandling = do
  ScenarioState
s <- EventM Name ScenarioState ScenarioState
forall s (m :: * -> *). MonadState s m => m s
get
  Bool
-> EventM Name ScenarioState () -> EventM Name ScenarioState ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe (Text, Value) -> Bool
forall a. Maybe a -> Bool
isJust (ScenarioState
s ScenarioState
-> Getting
     (Maybe (Text, Value)) ScenarioState (Maybe (Text, Value))
-> Maybe (Text, Value)
forall s a. s -> Getting a s a -> a
^. (GameState -> Const (Maybe (Text, Value)) GameState)
-> ScenarioState -> Const (Maybe (Text, Value)) ScenarioState
Lens' ScenarioState GameState
gameState ((GameState -> Const (Maybe (Text, Value)) GameState)
 -> ScenarioState -> Const (Maybe (Text, Value)) ScenarioState)
-> ((Maybe (Text, Value)
     -> Const (Maybe (Text, Value)) (Maybe (Text, Value)))
    -> GameState -> Const (Maybe (Text, Value)) GameState)
-> Getting
     (Maybe (Text, Value)) ScenarioState (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)) (EventM Name ScenarioState () -> EventM Name ScenarioState ())
-> EventM Name ScenarioState () -> EventM Name ScenarioState ()
forall a b. (a -> b) -> a -> b
$ do
    ReplControlMode
curMode <- Getting ReplControlMode ScenarioState ReplControlMode
-> EventM Name ScenarioState ReplControlMode
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Getting ReplControlMode ScenarioState ReplControlMode
 -> EventM Name ScenarioState ReplControlMode)
-> Getting ReplControlMode ScenarioState ReplControlMode
-> EventM Name ScenarioState ReplControlMode
forall a b. (a -> b) -> a -> b
$ (UIGameplay -> Const ReplControlMode UIGameplay)
-> ScenarioState -> Const ReplControlMode ScenarioState
Lens' ScenarioState UIGameplay
uiGameplay ((UIGameplay -> Const ReplControlMode UIGameplay)
 -> ScenarioState -> Const ReplControlMode ScenarioState)
-> ((ReplControlMode -> Const ReplControlMode ReplControlMode)
    -> UIGameplay -> Const ReplControlMode UIGameplay)
-> Getting ReplControlMode ScenarioState ReplControlMode
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)
-> Getting ReplControlMode REPLState ReplControlMode
-> (ReplControlMode -> Const ReplControlMode ReplControlMode)
-> UIGameplay
-> Const ReplControlMode UIGameplay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting ReplControlMode REPLState ReplControlMode
Lens' REPLState ReplControlMode
replControlMode
    ((UIGameplay -> Identity UIGameplay)
-> ScenarioState -> Identity ScenarioState
Lens' ScenarioState UIGameplay
uiGameplay ((UIGameplay -> Identity UIGameplay)
 -> ScenarioState -> Identity ScenarioState)
-> ((ReplControlMode -> Identity ReplControlMode)
    -> UIGameplay -> Identity UIGameplay)
-> (ReplControlMode -> Identity ReplControlMode)
-> ScenarioState
-> Identity ScenarioState
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)
-> ((ReplControlMode -> Identity ReplControlMode)
    -> REPLState -> Identity REPLState)
-> (ReplControlMode -> Identity ReplControlMode)
-> UIGameplay
-> Identity UIGameplay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ReplControlMode -> Identity ReplControlMode)
-> REPLState -> Identity REPLState
Lens' REPLState ReplControlMode
replControlMode) ((ReplControlMode -> Identity ReplControlMode)
 -> ScenarioState -> Identity ScenarioState)
-> ReplControlMode -> EventM Name ScenarioState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= case ReplControlMode
curMode of ReplControlMode
Handling -> ReplControlMode
Typing; ReplControlMode
_ -> ReplControlMode
Handling