Reply to Web API run with result

scripts/remote-repl.sh

@@ -0,0 +1,79 @@
+#!/usr/bin/env bash
+
+PORT="5357"
+HOST="localhost"
+
+function help {
+  echo "Swarm remote REPL"
+  echo
+  echo "This is a shortcut for sending to Swarm REPL via cURL and recieving responses:"
+  echo "curl -XGET --header \"Content-Type: text/plain;charset=utf-8\" --data \"build {}\" $HOST:$PORT/code/run"
+  echo
+  echo "Options:"
+  echo " -p PORT  --port PORT        Specify the port, default is $PORT."
+  echo " -n NAME  --hostaname NAME   Specify the hostaname, default is $HOST."
+  echo " -h       --help             Show this helpful text."
+}
+
+function parse_args {
+  while [[ $# -gt 0 ]]; do
+    case $1 in
+      -p|--port)
+        PORT="$2"
+        shift # past argument
+        shift # past value
+        ;;
+      -n|--hostname)
+        HOST="$2"
+        shift # past argument
+        shift # past value
+        ;;
+      -h|--help)
+        help
+        exit 0
+        ;;
+      *)
+        echo "Unknown argument $1"
+        shift # past argument
+        ;;
+    esac
+  done
+}
+
+IN_PROGRESS=""
+function print_elipsis {
+  echo -n "..."
+  IN_PROGRESS="\r   \r"
+}
+
+function remove_elipsis {
+  echo -ne "$IN_PROGRESS"
+  IN_PROGRESS=""
+}
+
+function repl {
+  while true; do
+    remove_elipsis
+    read -r -e -p "> " expr
+    curl -N -s -XGET --header "Content-Type: text/plain;charset=utf-8" --data "$expr" "$HOST:$PORT/code/run" | while read -r line ; do
+      remove_elipsis
+      if jq -e 'has("InProgress")' <<< "$line" > /dev/null; then
+        print_elipsis
+      elif jq -e 'has("Complete")' <<< "$line" > /dev/null; then
+        RESULT="$(jq -r '.Complete' <<< "$line")"
+        [ -n "$RESULT" ] && echo "$RESULT";
+      elif jq -e 'has("Rejected")' <<< "$line" > /dev/null; then
+        jq -C '.Rejected' <<< "$line"
+      else
+        echo "$line"
+      fi
+    done
+  done
+}
+
+function main {
+  parse_args "$@"
+  repl
+}
+
+main "$@"

src/swarm-engine/Swarm/Game/State/Substate.hs

@@ -54,6 +54,7 @@ module Swarm.Game.State.Substate (
   initiallyRunCode,
   replStatus,
   replNextValueIndex,
+  replListener,
   inputHandler,
 
   -- *** Discovery
@@ -302,6 +303,7 @@ robotStepsPerTick :: Lens' TemporalState Int
 data GameControls = GameControls
   { _replStatus :: REPLStatus
   , _replNextValueIndex :: Integer
+  , _replListener :: Text -> IO ()
   , _inputHandler :: Maybe (Text, Value)
   , _initiallyRunCode :: Maybe Syntax
   }
@@ -314,6 +316,10 @@ replStatus :: Lens' GameControls REPLStatus
 -- | The index of the next @it{index}@ value
 replNextValueIndex :: Lens' GameControls Integer
 
+-- | The action to be run after transitioning to REPLDone.
+--   This is used to tell Web API the result of run command.
+replListener :: Lens' GameControls (Text -> IO ())
+
 -- | The currently installed input handler and hint text.
 inputHandler :: Lens' GameControls (Maybe (Text, Value))
 
@@ -407,6 +413,7 @@ initGameControls =
   GameControls
     { _replStatus = REPLDone Nothing
     , _replNextValueIndex = 0
+    , _replListener = const $ pure ()
     , _inputHandler = Nothing
     , _initiallyRunCode = Nothing
     }

src/swarm-tui/Swarm/TUI/Controller.hs

@@ -120,47 +120,55 @@ import Swarm.Version (NewReleaseFailure (..))
 
 -- | The top-level event handler for the TUI.
 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 ev) -> do
-    let logReleaseEvent l sev e = runtimeState . eventLog %= logEvent l sev "Release" (T.pack $ show e)
-    case ev of
-      Left e ->
-        let sev = case e of
-              FailedReleaseQuery {} -> Error
-              OnDevelopmentBranch {} -> Info
-              _ -> Warning
-         in logReleaseEvent SystemLog sev e
-      Right _ -> pure ()
-    runtimeState . upstreamRelease .= ev
-  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.
-    upd <- case e of
-      AppEvent Frame -> Brick.zoom (uiState . uiPopups) progressPopups
-      _ -> pure False
-
-    s <- get
-    if s ^. uiState . uiPlaying
-      then handleMainEvent upd e
-      else do
-        e & case s ^. uiState . 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).
-          NoMenu -> const halt
-          MainMenu l -> handleMainMenuEvent l
-          NewGameMenu l ->
-            if s ^. uiState . uiLaunchConfig . controls . fileBrowser . fbIsDisplayed
-              then handleFBEvent
-              else case s ^. uiState . uiLaunchConfig . controls . isDisplayedFor of
-                Nothing -> handleNewGameMenuEvent l
-                Just siPair -> handleLaunchOptionsEvent siPair
-          MessagesMenu -> handleMainMessagesEvent
-          AchievementsMenu l -> handleMainAchievementsEvent l
-          AboutMenu -> pressAnyKey (MainMenu (mainMenu About))
+handleEvent e = do
+  playing <- use $ uiState . uiPlaying
+  case e of
+    -- the query for upstream version could finish at any time, so we have to handle it here
+    AppEvent (UpstreamVersion ev) -> handleUpstreamVersionResponse ev
+    AppEvent (Web (RunWebCode {..})) | not playing -> liftIO . webReply $ Rejected NoActiveGame
+    _ -> 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.
+      upd <- case e of
+        AppEvent Frame -> Brick.zoom (uiState . uiPopups) progressPopups
+        _ -> pure False
+      if playing
+        then handleMainEvent upd e
+        else handleMenuEvent e
+
+handleUpstreamVersionResponse :: Either NewReleaseFailure String -> EventM Name AppState ()
+handleUpstreamVersionResponse ev = do
+  let logReleaseEvent l sev e = runtimeState . eventLog %= logEvent l sev "Release" (T.pack $ show e)
+  case ev of
+    Left e ->
+      let sev = case e of
+            FailedReleaseQuery {} -> Error
+            OnDevelopmentBranch {} -> Info
+            _ -> Warning
+       in logReleaseEvent SystemLog sev e
+    Right _ -> pure ()
+  runtimeState . upstreamRelease .= ev
+
+handleMenuEvent :: BrickEvent Name AppEvent -> EventM Name AppState ()
+handleMenuEvent e =
+  use (uiState . uiMenu) >>= \case
+    -- 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).
+    NoMenu -> halt
+    MainMenu l -> handleMainMenuEvent l e
+    NewGameMenu l -> do
+      launchControls <- use $ uiState . uiLaunchConfig . controls
+      if launchControls ^. fileBrowser . fbIsDisplayed
+        then handleFBEvent e
+        else case launchControls ^. isDisplayedFor of
+          Nothing -> handleNewGameMenuEvent l e
+          Just siPair -> handleLaunchOptionsEvent siPair e
+    MessagesMenu -> handleMainMessagesEvent e
+    AchievementsMenu l -> handleMainAchievementsEvent l e
+    AboutMenu -> pressAnyKey (MainMenu (mainMenu About)) e
 
 -- | The event handler for the main menu.
 --
@@ -294,7 +302,7 @@ handleMainEvent forceRedraw ev = do
         if s ^. gameState . temporal . paused
           then updateAndRedrawUI forceRedraw
           else runFrameUI forceRedraw
-      Web (RunWebCode c) -> runBaseWebCode c
+      Web (RunWebCode e r) -> runBaseWebCode e r
       UpstreamVersion _ -> error "version event should be handled by top-level handler"
     VtyEvent (V.EvResize _ _) -> invalidateCache
     EscapeKey | Just m <- s ^. uiState . uiGameplay . uiModal -> closeModal m
@@ -541,13 +549,19 @@ handleREPLEventPiloting x = case x of
       & replPromptText .~ nt
       & replPromptType .~ CmdPrompt []
 
-runBaseWebCode :: (MonadState AppState m) => T.Text -> m ()
-runBaseWebCode uinput = do
+runBaseWebCode :: (MonadState AppState m, MonadIO m) => T.Text -> (WebInvocationState -> IO ()) -> m ()
+runBaseWebCode uinput ureply = do
   s <- get
-  unless (s ^. gameState . gameControls . replWorking) $
-    runBaseCode uinput
-
-runBaseCode :: (MonadState AppState m) => T.Text -> m ()
+  if s ^. gameState . gameControls . replWorking
+    then liftIO . ureply $ Rejected AlreadyRunning
+    else do
+      gameState . gameControls . replListener .= (ureply . Complete . T.unpack)
+      runBaseCode uinput
+        >>= liftIO . ureply . \case
+          Left err -> Rejected . ParseError $ T.unpack err
+          Right () -> InProgress
+
+runBaseCode :: (MonadState AppState m) => T.Text -> m (Either Text ())
 runBaseCode uinput = do
   addREPLHistItem (mkREPLSubmission uinput)
   resetREPL "" (CmdPrompt [])
@@ -556,8 +570,10 @@ runBaseCode uinput = do
     Right mt -> do
       uiState . uiGameplay . uiREPL . replHistory . replHasExecutedManualInput .= True
       runBaseTerm mt
+      return (Right ())
     Left err -> do
       addREPLHistItem (mkREPLError err)
+      return (Left err)
 
 -- | Handle a user input event for the REPL.
 --
@@ -579,7 +595,7 @@ handleREPLEventTyping = \case
         if not $ s ^. gameState . gameControls . replWorking
           then case theRepl ^. replPromptType of
             CmdPrompt _ -> do
-              runBaseCode uinput
+              void $ runBaseCode uinput
               invalidateCacheEntry REPLHistoryCache
             SearchPrompt hist ->
               case lastEntry uinput hist of

src/swarm-tui/Swarm/TUI/Controller/UpdateUI.hs

@@ -17,6 +17,7 @@ import Brick.Widgets.List qualified as BL
 import Control.Applicative (liftA2, pure)
 import Control.Lens as Lens
 import Control.Monad (unless, when)
+import Control.Monad.IO.Class (liftIO)
 import Data.Foldable (toList)
 import Data.List.Extra (enumerate)
 import Data.Maybe (isNothing)
@@ -99,6 +100,8 @@ updateUI = do
     REPLWorking pty (Just v)
       -- It did, and the result was the unit value or an exception.  Just reset replStatus.
       | v `elem` [VUnit, VExc] -> do
+          listener <- use $ gameState . gameControls . replListener
+          liftIO $ listener ""
           gameState . gameControls . replStatus .= REPLDone (Just (pty, v))
           pure True
 
@@ -112,6 +115,8 @@ updateUI = do
               itName = fromString $ "it" ++ show itIx
               out = T.intercalate " " [itName, ":", prettyText finalType, "=", into (prettyValue v)]
           addREPLHistItem (mkREPLOutput out)
+          listener <- use $ gameState . gameControls . replListener
+          liftIO $ listener out
           invalidateCacheEntry REPLHistoryCache
           vScrollToEnd replScroll
           gameState . gameControls . replStatus .= REPLDone (Just (finalType, v))

src/swarm-tui/Swarm/TUI/Model.hs

@@ -12,10 +12,14 @@ module Swarm.TUI.Model (
   -- * Custom UI label types
   -- $uilabel
   AppEvent (..),
-  WebCommand (..),
   FocusablePanel (..),
   Name (..),
 
+  -- ** Web command
+  WebCommand (..),
+  WebInvocationState (..),
+  RejectionReason (..),
+
   -- * Menus and dialogs
   ModalType (..),
   ScenarioOutcome (..),
@@ -105,6 +109,7 @@ import Swarm.TUI.Model.Event (SwarmEvent)
 import Swarm.TUI.Model.Menu
 import Swarm.TUI.Model.Name
 import Swarm.TUI.Model.UI
+import Swarm.TUI.Model.WebCommand (RejectionReason (..), WebCommand (..), WebInvocationState (..))
 import Swarm.Util.Lens (makeLensesNoSigs)
 import Swarm.Version (NewReleaseFailure)
 import Text.Fuzzy qualified as Fuzzy
@@ -116,17 +121,13 @@ import Text.Fuzzy qualified as Fuzzy
 -- $uilabel These types are used as parameters to various @brick@
 -- types.
 
-newtype WebCommand = RunWebCode Text
-  deriving (Show)
-
 -- | 'Swarm.TUI.Model.AppEvent' represents a type for custom event types our app can
 --   receive. The primary custom event 'Frame' is sent by a separate thread as fast as
 --   it can, telling the TUI to render a new frame.
 data AppEvent
   = Frame
   | Web WebCommand
   | UpstreamVersion (Either NewReleaseFailure String)
-  deriving (Show)
 
 infoScroll :: ViewportScroll Name
 infoScroll = viewportScroll InfoViewport

src/swarm-tui/Swarm/TUI/Model/WebCommand.hs

@@ -0,0 +1,39 @@
+-- |
+-- SPDX-License-Identifier: BSD-3-Clause
+--
+-- The type of commands sent from Web API handlers to the Controller,
+-- and the type of replies.
+module Swarm.TUI.Model.WebCommand (
+  WebCommand (..),
+  WebInvocationState (..),
+  RejectionReason (..),
+) where
+
+import Data.Aeson (FromJSON (..), ToJSON (..), genericParseJSON, genericToJSON)
+import Data.Text (Text)
+import GHC.Generics (Generic)
+import Swarm.Util.JSON (optionsMinimize)
+
+data WebCommand = RunWebCode {webEntry :: Text, webReply :: WebInvocationState -> IO ()}
+
+data RejectionReason = NoActiveGame | AlreadyRunning | ParseError String
+  deriving (Eq, Ord, Show, Generic)
+
+data WebInvocationState = Rejected RejectionReason | InProgress | Complete String
+  deriving (Eq, Ord, Show, Generic)
+
+-- --------------------------
+-- ToJSON/FromJSON Instances
+-- --------------------------
+
+instance ToJSON RejectionReason where
+  toJSON = genericToJSON optionsMinimize
+
+instance FromJSON RejectionReason where
+  parseJSON = genericParseJSON optionsMinimize
+
+instance ToJSON WebInvocationState where
+  toJSON = genericToJSON optionsMinimize
+
+instance FromJSON WebInvocationState where
+  parseJSON = genericParseJSON optionsMinimize