Merge branch 'main' into dev/more-structure-logging

app/game/Swarm/App.hs

@@ -90,7 +90,7 @@ appMain opts = do
         Swarm.Web.startWebThread
           (userWebPort opts)
           (readIORef appStateRef)
-          chan
+          (writeBChan chan)
 
       let logP p = logEvent SystemLog Info "Web API" ("started on :" <> T.pack (show p))
       let logE e = logEvent SystemLog Error "Web API" (T.pack e)
@@ -137,7 +137,7 @@ demoWeb = do
         Nothing
         demoPort
         (readIORef appStateRef)
-        chan
+        (writeBChan chan)
  where
   demoScenario = Just "./data/scenarios/Testing/475-wait-one.yaml"
 

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/Runtime.hs

@@ -29,7 +29,6 @@ import Control.Lens
 import Data.Map (Map)
 import Data.Sequence (Seq)
 import Data.Text (Text)
-import Network.Wai.Handler.Warp (Port)
 import Swarm.Game.Failure (SystemFailure)
 import Swarm.Game.Land
 import Swarm.Game.Recipe (loadRecipes)
@@ -43,7 +42,7 @@ import Swarm.Util.Lens (makeLensesNoSigs)
 import Swarm.Version (NewReleaseFailure (..))
 
 data RuntimeState = RuntimeState
-  { _webPort :: Maybe Port
+  { _webPort :: Maybe Int
   , _upstreamRelease :: Either NewReleaseFailure String
   , _eventLog :: Notifications LogEntry
   , _scenarios :: ScenarioCollection
@@ -110,7 +109,7 @@ initRuntimeState pause = do
 makeLensesNoSigs ''RuntimeState
 
 -- | The port on which the HTTP debug service is running.
-webPort :: Lens' RuntimeState (Maybe Port)
+webPort :: Lens' RuntimeState (Maybe Int)
 
 -- | The upstream release version.
 upstreamRelease :: Lens' RuntimeState (Either NewReleaseFailure String)

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