Refactored handling of toolserver

digitallyinduced · Oct 1, 2022 · 00fb198 · 00fb198
1 parent 4cc5d3c
commit 00fb198
Show file tree

Hide file tree

Showing 3 changed files with 19 additions and 39 deletions.
diff --git a/IHP/IDE/ToolServer.hs b/IHP/IDE/ToolServer.hs
@@ -1,4 +1,4 @@
-module IHP.IDE.ToolServer where
+module IHP.IDE.ToolServer (withToolServer) where
 
 import IHP.Prelude
 import qualified Network.Wai as Wai
@@ -46,18 +46,14 @@ import qualified IHP.Version as Version
 import qualified IHP.IDE.Types
 import qualified IHP.PGListener as PGListener
 
-startToolServer :: (?context :: Context) => IO ()
-startToolServer = do
-    let port = ?context
-            |> get #portConfig
-            |> get #toolServerPort
-            |> fromIntegral
+withToolServer :: (?context :: Context) => IO () -> IO ()
+withToolServer inner = withAsyncBound async (\_ -> inner)
+    where
+        async = do
+            let port = ?context.portConfig.toolServerPort |> fromIntegral
+            let isDebugMode = ?context.isDebugMode
 
-    let isDebugMode = ?context |> get #isDebugMode
-
-    thread <- async (startToolServer' port isDebugMode)
-
-    dispatch (UpdateToolServerState (ToolServerStarted { thread }))
+            startToolServer' port isDebugMode
 
 startToolServer' :: (?context :: Context) => Int -> Bool -> IO ()
 startToolServer' port isDebugMode = do
@@ -108,9 +104,6 @@ startToolServer' port isDebugMode = do
                     (LiveReloadNotificationServer.app liveReloadNotificationServerState)
                     application
 
-stopToolServer ToolServerStarted { thread } = uninterruptibleCancel thread
-stopToolServer ToolServerNotStarted = pure ()
-
 openUrl :: Text -> IO ()
 openUrl url = do
     selectedBrowser <- Env.lookupEnv "IHP_BROWSER"

diff --git a/IHP/IDE/Types.hs b/IHP/IDE/Types.hs
@@ -49,7 +49,6 @@ data Action =
     | SchemaChanged
     | UpdateStatusServerState !StatusServerState
     | UpdateLiveReloadNotificationServerState !LiveReloadNotificationServerState
-    | UpdateToolServerState !ToolServerState
     | PauseApp
     deriving (Show)
 
@@ -101,14 +100,6 @@ instance Show StatusServerState where
     show StatusServerStarted { } = "Started"
     show StatusServerPaused { } = "Paused"
 
-data ToolServerState
-    = ToolServerNotStarted
-    | ToolServerStarted { thread :: !(Async ()) }
-
-instance Show ToolServerState where
-    show ToolServerNotStarted = "NotStarted"
-    show ToolServerStarted {} = "Started"
-
 
 instance Show (IORef x) where show _ = "(..)"
 instance Show ProcessHandle where show _ = "(..)"
@@ -119,7 +110,6 @@ data AppState = AppState
     , appGHCIState :: !AppGHCIState
     , statusServerState :: !StatusServerState
     , liveReloadNotificationServerState :: !LiveReloadNotificationServerState
-    , toolServerState :: !ToolServerState
     , databaseNeedsMigration :: !(IORef Bool)
     , lastSchemaCompilerError :: !(IORef (Maybe SomeException))
     } deriving (Show)
@@ -134,7 +124,6 @@ emptyAppState = do
         , appGHCIState = AppGHCINotStarted
         , statusServerState = StatusServerNotStarted
         , liveReloadNotificationServerState = LiveReloadNotificationServerState { clients }
-        , toolServerState = ToolServerNotStarted
         , databaseNeedsMigration
         , lastSchemaCompilerError
         }

diff --git a/exe/IHP/IDE/DevServer.hs b/exe/IHP/IDE/DevServer.hs
@@ -60,16 +60,17 @@ main = withUtf8 do
 
     start
 
-    withAsync consumeGhciOutput \_ -> do
-        withFileWatcher do
-            async Telemetry.reportTelemetry
-            forever do
-                appState <- readIORef appStateRef
-                when isDebugMode (Log.debug $ " ===> " <> (tshow appState))
-                action <- takeMVar actionVar
-                when isDebugMode (Log.debug $ tshow action)
-                nextAppState <- handleAction appState action
-                writeIORef appStateRef nextAppState
+    withToolServer do
+        withAsync consumeGhciOutput \_ -> do
+            withFileWatcher do
+                async Telemetry.reportTelemetry
+                forever do
+                    appState <- readIORef appStateRef
+                    when isDebugMode (Log.debug $ " ===> " <> (tshow appState))
+                    action <- takeMVar actionVar
+                    when isDebugMode (Log.debug $ tshow action)
+                    nextAppState <- handleAction appState action
+                    writeIORef appStateRef nextAppState
 
 
 handleAction :: (?context :: Context) => AppState -> Action -> IO AppState
@@ -88,7 +89,6 @@ handleAction state@(AppState { appGHCIState }) (UpdatePostgresState postgresStat
                 otherwise -> pure state { postgresState }
         otherwise -> pure state { postgresState }
 handleAction state (UpdateAppGHCIState appGHCIState) = pure state { appGHCIState }
-handleAction state (UpdateToolServerState toolServerState) = pure state { toolServerState }
 handleAction state@(AppState { statusServerState = StatusServerNotStarted }) (UpdateStatusServerState statusServerState) = pure state { statusServerState }
 handleAction state@(AppState { statusServerState = StatusServerStarted { } }) (UpdateStatusServerState StatusServerNotStarted) = pure state { statusServerState = StatusServerNotStarted }
 handleAction state@(AppState { statusServerState = StatusServerPaused { } }) (UpdateStatusServerState statusServerState) = pure state { statusServerState = StatusServerNotStarted }
@@ -186,7 +186,6 @@ handleAction state@(AppState { appGHCIState }) PauseApp =
 
 start :: (?context :: Context) => IO ()
 start = do
-    async startToolServer
     async startStatusServer
     async startAppGHCI
     async startPostgres
@@ -198,7 +197,6 @@ stop AppState { .. } = do
     stopAppGHCI appGHCIState
     stopPostgres postgresState
     stopStatusServer statusServerState
-    stopToolServer toolServerState
 
 startGHCI :: IO ManagedProcess
 startGHCI = do