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

-- | 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.
(Ord e2, Enum e1, Bounded e1) =>
(e1 -> e2)
-> (e1 -> (Text, EventM Name AppState ()))
-> [KeyEventHandler e2 (EventM Name AppState)]
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", EventM Name AppState ()
cancelRunningBase)
  REPLEvent
TogglePilotingModeEvent -> (Text
"Toggle piloting mode", EventM Name AppState () -> EventM Name AppState ()
forall (m :: * -> *). MonadState AppState m => m () -> m ()
onlyCreative EventM Name AppState ()
togglePilotingMode)
  REPLEvent
ToggleCustomKeyHandlingEvent -> (Text
"Toggle custom key handling mode", EventM Name AppState ()
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 AppState ()
cancelRunningBase :: EventM Name AppState ()
cancelRunningBase = do
  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 ()
when Bool
working (EventM Name AppState () -> EventM Name AppState ())
-> EventM Name AppState () -> EventM Name AppState ()
forall a b. (a -> b) -> a -> b
$ (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 -> CESK) -> EventM Name AppState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= CESK -> CESK
cancel
  LensLike' (Zoomed (EventM Name REPLState) ()) AppState REPLState
-> EventM Name REPLState () -> EventM Name AppState ()
forall c.
LensLike' (Zoomed (EventM Name REPLState) c) AppState REPLState
-> EventM Name REPLState 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 REPLState) () UIState)
-> AppState -> Zoomed (EventM Name REPLState) () AppState
Lens' AppState UIState
uiState ((UIState -> Zoomed (EventM Name REPLState) () UIState)
 -> AppState -> Zoomed (EventM Name REPLState) () AppState)
-> ((REPLState -> Zoomed (EventM Name REPLState) () REPLState)
    -> UIState -> Zoomed (EventM Name REPLState) () UIState)
-> LensLike' (Zoomed (EventM Name REPLState) ()) AppState REPLState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UIGameplay -> Zoomed (EventM Name REPLState) () UIGameplay)
-> UIState -> Zoomed (EventM Name REPLState) () UIState
Lens' UIState UIGameplay
uiGameplay ((UIGameplay -> Zoomed (EventM Name REPLState) () UIGameplay)
 -> UIState -> Zoomed (EventM Name REPLState) () UIState)
-> ((REPLState -> Zoomed (EventM Name REPLState) () REPLState)
    -> UIGameplay -> Zoomed (EventM Name REPLState) () UIGameplay)
-> (REPLState -> Zoomed (EventM Name REPLState) () REPLState)
-> UIState
-> Zoomed (EventM Name REPLState) () UIState
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 AppState ())
-> EventM Name REPLState () -> EventM Name AppState ()
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 AppState ()
togglePilotingMode :: EventM Name AppState ()
togglePilotingMode = 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
  ReplControlMode
curMode <- Getting ReplControlMode AppState ReplControlMode
-> EventM Name AppState ReplControlMode
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Getting ReplControlMode AppState ReplControlMode
 -> EventM Name AppState ReplControlMode)
-> Getting ReplControlMode AppState ReplControlMode
-> EventM Name AppState ReplControlMode
forall a b. (a -> b) -> a -> b
$ (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
  case ReplControlMode
curMode of
    ReplControlMode
Piloting -> (UIState -> Identity UIState) -> AppState -> Identity AppState
Lens' AppState UIState
uiState ((UIState -> Identity UIState) -> AppState -> Identity AppState)
-> ((ReplControlMode -> Identity ReplControlMode)
    -> UIState -> Identity UIState)
-> (ReplControlMode -> Identity ReplControlMode)
-> 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)
-> ((ReplControlMode -> Identity ReplControlMode)
    -> UIGameplay -> Identity UIGameplay)
-> (ReplControlMode -> Identity ReplControlMode)
-> 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)
-> ((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)
 -> AppState -> Identity AppState)
-> ReplControlMode -> EventM Name AppState ()
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 (UIState -> Identity UIState) -> AppState -> Identity AppState
Lens' AppState UIState
uiState ((UIState -> Identity UIState) -> AppState -> Identity AppState)
-> ((ReplControlMode -> Identity ReplControlMode)
    -> UIState -> Identity UIState)
-> (ReplControlMode -> Identity ReplControlMode)
-> 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)
-> ((ReplControlMode -> Identity ReplControlMode)
    -> UIGameplay -> Identity UIGameplay)
-> (ReplControlMode -> Identity ReplControlMode)
-> 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)
-> ((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)
 -> AppState -> Identity AppState)
-> ReplControlMode -> EventM Name AppState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= ReplControlMode
Piloting
        else do
          REPLHistItem -> EventM Name AppState ()
forall (m :: * -> *). MonadState AppState m => REPLHistItem -> m ()
addREPLHistItem (REPLHistItem -> EventM Name AppState ())
-> REPLHistItem -> EventM Name AppState ()
forall a b. (a -> b) -> a -> b
$ Text -> REPLHistItem
mkREPLError Text
"Please clear the REPL before engaging pilot mode."
          Name -> EventM Name AppState ()
forall n s. Ord n => n -> EventM n s ()
invalidateCacheEntry Name
REPLHistoryCache

toggleCustomKeyHandling :: EventM Name AppState ()
toggleCustomKeyHandling :: EventM Name AppState ()
toggleCustomKeyHandling = do
  AppState
s <- EventM Name AppState AppState
forall s (m :: * -> *). MonadState s m => m s
get
  Bool -> EventM Name AppState () -> EventM Name AppState ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe (Text, Value) -> Bool
forall a. Maybe a -> Bool
isJust (AppState
s AppState
-> Getting (Maybe (Text, Value)) AppState (Maybe (Text, Value))
-> Maybe (Text, Value)
forall s a. s -> Getting a s a -> a
^. (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)) (EventM Name AppState () -> EventM Name AppState ())
-> EventM Name AppState () -> EventM Name AppState ()
forall a b. (a -> b) -> a -> b
$ do
    ReplControlMode
curMode <- Getting ReplControlMode AppState ReplControlMode
-> EventM Name AppState ReplControlMode
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Getting ReplControlMode AppState ReplControlMode
 -> EventM Name AppState ReplControlMode)
-> Getting ReplControlMode AppState ReplControlMode
-> EventM Name AppState ReplControlMode
forall a b. (a -> b) -> a -> b
$ (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
    ((UIState -> Identity UIState) -> AppState -> Identity AppState
Lens' AppState UIState
uiState ((UIState -> Identity UIState) -> AppState -> Identity AppState)
-> ((ReplControlMode -> Identity ReplControlMode)
    -> UIState -> Identity UIState)
-> (ReplControlMode -> Identity ReplControlMode)
-> 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)
-> ((ReplControlMode -> Identity ReplControlMode)
    -> UIGameplay -> Identity UIGameplay)
-> (ReplControlMode -> Identity ReplControlMode)
-> 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)
-> ((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)
 -> AppState -> Identity AppState)
-> ReplControlMode -> EventM Name AppState ()
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