From 1994ab227f2429b8c4e5da15d43b5dfd00308aa6 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ond=C5=99ej=20=C5=A0ebek?= <44544735+xsebek@users.noreply.github.com> Date: Thu, 15 Aug 2024 19:54:21 +0200 Subject: [PATCH 1/5] Reply to Web API run with result (#2108) MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * make Web API `code/run` pass `webReply :: WebInvocationState -> IO ()` to TUI * send InProgress or Rejected * once REPLDone send Complete * add remote REPL shell script * closes #1426 This uses the "IO wrapper" trick from #2098 - thus we can be sure that TUI will be the producer and Web API the consumer. Example: ```bash cabal run swarm -O0 -- --scenario blank # in another terminal curl -XGET --header "Content-Type: text/plain;charset=utf-8" localhost:5357/code/run --data "1 + 1" ``` ```JSON {"InProgress":[]} {"Complete":"it1 : Int = 2"} ``` You can also test it with the shell script, that tries to act as a REPL and strips the JSON unless it gets an error: ``` ❯ scripts/remote-repl.sh > move > scan down it0 : Unit + Text = inl () > grab // exception written to log is not shown here > grob { "ParseError": "1:1: Unbound variable grob\n" } > ``` --- scripts/remote-repl.sh | 79 ++++++++++++ src/swarm-engine/Swarm/Game/State/Substate.hs | 7 ++ src/swarm-tui/Swarm/TUI/Controller.hs | 114 ++++++++++-------- .../Swarm/TUI/Controller/UpdateUI.hs | 5 + src/swarm-tui/Swarm/TUI/Model.hs | 11 +- src/swarm-tui/Swarm/TUI/Model/WebCommand.hs | 39 ++++++ src/swarm-web/Swarm/Web.hs | 40 +++++- swarm.cabal | 4 +- 8 files changed, 240 insertions(+), 59 deletions(-) create mode 100755 scripts/remote-repl.sh create mode 100644 src/swarm-tui/Swarm/TUI/Model/WebCommand.hs diff --git a/scripts/remote-repl.sh b/scripts/remote-repl.sh new file mode 100755 index 000000000..9d34a341b --- /dev/null +++ b/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 "$@" \ No newline at end of file diff --git a/src/swarm-engine/Swarm/Game/State/Substate.hs b/src/swarm-engine/Swarm/Game/State/Substate.hs index da4100a9b..f271b33fe 100644 --- a/src/swarm-engine/Swarm/Game/State/Substate.hs +++ b/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 } diff --git a/src/swarm-tui/Swarm/TUI/Controller.hs b/src/swarm-tui/Swarm/TUI/Controller.hs index 167e4e59d..d037259e8 100644 --- a/src/swarm-tui/Swarm/TUI/Controller.hs +++ b/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 diff --git a/src/swarm-tui/Swarm/TUI/Controller/UpdateUI.hs b/src/swarm-tui/Swarm/TUI/Controller/UpdateUI.hs index 7839c88d7..4c24d73d9 100644 --- a/src/swarm-tui/Swarm/TUI/Controller/UpdateUI.hs +++ b/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)) diff --git a/src/swarm-tui/Swarm/TUI/Model.hs b/src/swarm-tui/Swarm/TUI/Model.hs index 0ac7dce16..9b10ed2e6 100644 --- a/src/swarm-tui/Swarm/TUI/Model.hs +++ b/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,9 +121,6 @@ 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. @@ -126,7 +128,6 @@ data AppEvent = Frame | Web WebCommand | UpstreamVersion (Either NewReleaseFailure String) - deriving (Show) infoScroll :: ViewportScroll Name infoScroll = viewportScroll InfoViewport diff --git a/src/swarm-tui/Swarm/TUI/Model/WebCommand.hs b/src/swarm-tui/Swarm/TUI/Model/WebCommand.hs new file mode 100644 index 000000000..d46ee62fe --- /dev/null +++ b/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 diff --git a/src/swarm-web/Swarm/Web.hs b/src/swarm-web/Swarm/Web.hs index b6b4a577b..320fb3335 100644 --- a/src/swarm-web/Swarm/Web.hs +++ b/src/swarm-web/Swarm/Web.hs @@ -62,6 +62,7 @@ import Servant import Servant.Docs (ToCapture) import Servant.Docs qualified as SD import Servant.Docs.Internal qualified as SD (renderCurlBasePath) +import Servant.Types.SourceT qualified as S import Swarm.Game.Entity (EntityName, entityName) import Swarm.Game.Robot import Swarm.Game.Scenario.Objective @@ -105,7 +106,7 @@ type SwarmAPI = :<|> "recognize" :> "log" :> Get '[JSON] [SearchLog EntityName] :<|> "recognize" :> "found" :> Get '[JSON] [StructureLocation] :<|> "code" :> "render" :> ReqBody '[PlainText] T.Text :> Post '[PlainText] T.Text - :<|> "code" :> "run" :> ReqBody '[PlainText] T.Text :> Post '[PlainText] T.Text + :<|> "code" :> "run" :> ReqBody '[PlainText] T.Text :> StreamGet NewlineFraming JSON (SourceIO WebInvocationState) :<|> "paths" :> "log" :> Get '[JSON] (RingBuffer CacheLogEntry) :<|> "repl" :> "history" :> "full" :> Get '[JSON] [REPLHistItem] :<|> "map" :> Capture "size" AreaDimensions :> Get '[JSON] GridResponse @@ -232,10 +233,41 @@ codeRenderHandler contents = do into @Text . drawTree . fmap (T.unpack . prettyTextLine) . para Node $ t Left x -> x -codeRunHandler :: BChan AppEvent -> Text -> Handler Text +{- Note [How to stream back responses as we get results] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +Servant has a builtin simple streaming: +https://docs.servant.dev/en/stable/cookbook/basic-streaming/Streaming.html + +What we need is to: +1. run IO with 'Effect' +2. send the result with 'Yield' +3. if we are done 'Stop' +4. otherwise continue recursively + +With the endpoint type 'StreamGet NewlineFraming JSON', servant will send each +result as a JSON on a separate line. That is not a valid JSON document, but +it's commonly used because it works well with line-oriented tools. + +This gives the user an immediate feedback (did the code parse) and would +be well suited for streaming large collections of data like the logs +while consuming constant memory. +-} + +codeRunHandler :: BChan AppEvent -> Text -> Handler (S.SourceT IO WebInvocationState) codeRunHandler chan contents = do - liftIO . writeBChan chan . Web $ RunWebCode contents - return $ T.pack "Sent\n" + replyVar <- liftIO newEmptyMVar + let putReplyForce r = do + void $ tryTakeMVar replyVar + putMVar replyVar r + liftIO . writeBChan chan . Web $ RunWebCode contents putReplyForce + -- See note [How to stream back responses as we get results] + let waitForReply = S.Effect $ do + reply <- takeMVar replyVar + return . S.Yield reply $ case reply of + InProgress -> waitForReply + _ -> S.Stop + return $ S.fromStepT waitForReply pathsLogHandler :: IO AppState -> Handler (RingBuffer CacheLogEntry) pathsLogHandler appStateRef = do diff --git a/swarm.cabal b/swarm.cabal index 551a0fc94..7d07dda95 100644 --- a/swarm.cabal +++ b/swarm.cabal @@ -492,8 +492,9 @@ library swarm-web lens, nonempty-containers, palette, + servant >=0.19 && <0.22, servant-docs, - servant-server >=0.19 && <0.21, + servant-server >=0.19 && <0.22, text, wai >=3.2 && <3.3, wai-app-static >=3.1.8 && <3.2, @@ -726,6 +727,7 @@ library swarm-tui Swarm.TUI.Model.StateUpdate Swarm.TUI.Model.Structure Swarm.TUI.Model.UI + Swarm.TUI.Model.WebCommand Swarm.TUI.Panel Swarm.TUI.View Swarm.TUI.View.Achievement From a24b6a8413965890ce801f8b8f489f7b6c7cf314 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ond=C5=99ej=20=C5=A0ebek?= <44544735+xsebek@users.noreply.github.com> Date: Thu, 15 Aug 2024 22:38:19 +0200 Subject: [PATCH 2/5] Remove Brick dependency from Web (#2120) * use the IO wrapper trick again for fun and profit :tm: * part of #2109 --- app/game/Swarm/App.hs | 4 ++-- src/swarm-web/Swarm/Web.hs | 13 +++++++------ swarm.cabal | 1 - 3 files changed, 9 insertions(+), 9 deletions(-) diff --git a/app/game/Swarm/App.hs b/app/game/Swarm/App.hs index c999b64ef..558c529d9 100644 --- a/app/game/Swarm/App.hs +++ b/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" diff --git a/src/swarm-web/Swarm/Web.hs b/src/swarm-web/Swarm/Web.hs index 320fb3335..4668876bf 100644 --- a/src/swarm-web/Swarm/Web.hs +++ b/src/swarm-web/Swarm/Web.hs @@ -33,7 +33,6 @@ module Swarm.Web ( webMain, ) where -import Brick.BChan import Commonmark qualified as Mark (commonmark, renderHtml) import Control.Arrow (left) import Control.Concurrent (forkIO) @@ -149,7 +148,7 @@ mkApp :: -- | Read-only access to the current AppState IO AppState -> -- | Writable channel to send events to the game - BChan AppEvent -> + EventChannel -> Servant.Server SwarmAPI mkApp state events = robotsHandler state @@ -254,13 +253,13 @@ be well suited for streaming large collections of data like the logs while consuming constant memory. -} -codeRunHandler :: BChan AppEvent -> Text -> Handler (S.SourceT IO WebInvocationState) +codeRunHandler :: EventChannel -> Text -> Handler (S.SourceT IO WebInvocationState) codeRunHandler chan contents = do replyVar <- liftIO newEmptyMVar let putReplyForce r = do void $ tryTakeMVar replyVar putMVar replyVar r - liftIO . writeBChan chan . Web $ RunWebCode contents putReplyForce + liftIO . chan . Web $ RunWebCode contents putReplyForce -- See note [How to stream back responses as we get results] let waitForReply = S.Effect $ do reply <- takeMVar replyVar @@ -300,13 +299,15 @@ mapViewHandler appStateRef areaSize = do -- | Simple result type to report errors from forked startup thread. data WebStartResult = WebStarted | WebStartError String +type EventChannel = AppEvent -> IO () + webMain :: Maybe (MVar WebStartResult) -> Warp.Port -> -- | Read-only reference to the application state. IO AppState -> -- | Writable channel to send events to the game - BChan AppEvent -> + EventChannel -> IO () webMain baton port appStateRef chan = catch (Warp.runSettings settings app) handleErr where @@ -351,7 +352,7 @@ startWebThread :: -- | Read-only reference to the application state. IO AppState -> -- | Writable channel to send events to the game - BChan AppEvent -> + EventChannel -> IO (Either String Warp.Port) -- User explicitly provided port '0': don't run the web server startWebThread (Just 0) _ _ = pure $ Left "The web port has been turned off." diff --git a/swarm.cabal b/swarm.cabal index 7d07dda95..a576c31b2 100644 --- a/swarm.cabal +++ b/swarm.cabal @@ -483,7 +483,6 @@ library swarm-web build-depends: aeson, base, - brick, bytestring, colour, commonmark, From 76e6202bf8909f307a3df50a98b566aef337beb9 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ond=C5=99ej=20=C5=A0ebek?= <44544735+xsebek@users.noreply.github.com> Date: Fri, 16 Aug 2024 14:17:20 +0200 Subject: [PATCH 3/5] Do not show goal when ScenarioEnd is shown (#2119) * check for open quit game modal dialog and do not overwrite it with goal modal * refactor the win condition path to make it easier to see * closes #2117 --- .../Swarm/TUI/Controller/UpdateUI.hs | 46 ++++++++++--------- 1 file changed, 25 insertions(+), 21 deletions(-) diff --git a/src/swarm-tui/Swarm/TUI/Controller/UpdateUI.hs b/src/swarm-tui/Swarm/TUI/Controller/UpdateUI.hs index 4c24d73d9..5083e1d5b 100644 --- a/src/swarm-tui/Swarm/TUI/Controller/UpdateUI.hs +++ b/src/swarm-tui/Swarm/TUI/Controller/UpdateUI.hs @@ -218,38 +218,21 @@ doGoalUpdates = do return True WinConditions _ oc -> do showHiddenGoals <- use $ uiState . uiDebugOptions . Lens.contains ShowHiddenGoals + currentModal <- preuse $ uiState . uiGameplay . uiModal . _Just . modalType let newGoalTracking = GoalTracking announcementsList $ constructGoalMap showHiddenGoals oc -- The "uiGoal" field is initialized with empty members, so we know that -- this will be the first time showing it if it will be nonempty after previously -- being empty. isFirstGoalDisplay = hasAnythingToShow newGoalTracking && not (hasAnythingToShow curGoal) goalWasUpdated = isFirstGoalDisplay || not (null announcementsList) + isEnding = maybe False isEndingModal currentModal -- Decide whether to show a pop-up modal congratulating the user on -- successfully completing the current challenge. - when goalWasUpdated $ do - let hasMultiple = hasMultipleGoals newGoalTracking - defaultFocus = - if hasMultiple - then ObjectivesList - else GoalSummary - - ring = - focusRing $ - map GoalWidgets $ - if hasMultiple - then enumerate - else [GoalSummary] - + when (goalWasUpdated && not isEnding) $ do -- The "uiGoal" field is necessary at least to "persist" the data that is needed -- if the player chooses to later "recall" the goals dialog with CTRL+g. - uiState - . uiGameplay - . uiGoal - .= GoalDisplay - newGoalTracking - (GR.makeListWidget newGoalTracking) - (focusSetCurrent (GoalWidgets defaultFocus) ring) + uiState . uiGameplay . uiGoal .= goalDisplay newGoalTracking -- This clears the "flag" that indicate that the goals dialog needs to be -- automatically popped up. @@ -261,6 +244,27 @@ doGoalUpdates = do openModal GoalModal return goalWasUpdated + where + goalDisplay :: GoalTracking -> GoalDisplay + goalDisplay newGoalTracking = + let multiple = hasMultipleGoals newGoalTracking + in GoalDisplay + newGoalTracking + (GR.makeListWidget newGoalTracking) + (focusSetCurrent (GoalWidgets $ goalFocus multiple) (goalFocusRing multiple)) + + goalFocus :: Bool -> GoalWidget + goalFocus hasMultiple = if hasMultiple then ObjectivesList else GoalSummary + + goalFocusRing :: Bool -> FocusRing Name + goalFocusRing hasMultiple = focusRing $ GoalWidgets <$> if hasMultiple then enumerate else [GoalSummary] + + isEndingModal :: ModalType -> Bool + isEndingModal = \case + ScenarioEndModal {} -> True + QuitModal -> True + KeepPlayingModal -> True + _ -> False -- | Pops up notifications when new recipes or commands are unlocked. generateNotificationPopups :: EventM Name AppState Bool From 403c9a9382dc7108f01a72c29e68a91301bcfd49 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ond=C5=99ej=20=C5=A0ebek?= <44544735+xsebek@users.noreply.github.com> Date: Fri, 16 Aug 2024 14:39:47 +0200 Subject: [PATCH 4/5] Remove warp dependency from engine (#2122) ...just for one type-alias: ```Haskell type Port = Int ``` * part of #2109 --- src/swarm-engine/Swarm/Game/State/Runtime.hs | 5 ++--- swarm.cabal | 1 - 2 files changed, 2 insertions(+), 4 deletions(-) diff --git a/src/swarm-engine/Swarm/Game/State/Runtime.hs b/src/swarm-engine/Swarm/Game/State/Runtime.hs index d76d151a5..4afad74f4 100644 --- a/src/swarm-engine/Swarm/Game/State/Runtime.hs +++ b/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) diff --git a/swarm.cabal b/swarm.cabal index a576c31b2..5b4ad22d3 100644 --- a/swarm.cabal +++ b/swarm.cabal @@ -450,7 +450,6 @@ library swarm-engine time >=1.9 && <1.15, transformers >=0.5 && <0.7, unordered-containers >=0.2.14 && <0.3, - warp, witch >=1.1.1.0 && <1.3, yaml >=0.11 && <0.11.12.0, From 268876f815d04cd64ad94bcc34960bda91b7eeb2 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ond=C5=99ej=20=C5=A0ebek?= <44544735+xsebek@users.noreply.github.com> Date: Fri, 16 Aug 2024 14:55:14 +0200 Subject: [PATCH 5/5] Move CHANGELOG to extra-doc-files (#2123) * part of #2109 --- swarm.cabal | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/swarm.cabal b/swarm.cabal index 5b4ad22d3..125578b97 100644 --- a/swarm.cabal +++ b/swarm.cabal @@ -38,8 +38,10 @@ bug-reports: https://github.com/swarm-game/swarm/issues copyright: Brent Yorgey 2021 category: Game tested-with: ghc ==9.2.8 || ==9.4.8 || ==9.6.5 || ==9.8.2 -extra-source-files: +extra-doc-files: CHANGELOG.md + +extra-source-files: editors/emacs/*.el editors/vim/*.lua editors/vim/*.vim