runInTerminal: Wait for proxy client before launching

hdb/Development/Debug/Adapter/Proxy.hs

@@ -47,8 +47,9 @@
 -- 2.1 Read stdin from the socket and push it to a Chan
 -- 2.1 Read from a stdout Chan and write to the socket
 serverSideHdbProxy :: Recorder (WithSeverity ProxyLog)
+                   -> MVar ()
                    -> DebugAdaptor ()
-serverSideHdbProxy l = do
+serverSideHdbProxy l client_conn_signal = do
   DAS { syncProxyIn = dbIn
       , syncProxyOut = dbOut
       , syncProxyErr = dbErr } <- getDebugSession
@@ -65,6 +66,7 @@
     runTCPServerWithSocket sock $ \scket -> do
 
       logWith l Info $ ProxyLog $ T.pack $ "Connected to client on port " ++ show port ++ "...!"
+      putMVar client_conn_signal () -- signal ready (see #95)
 
       -- -- Read stdout from chan and write to socket
       _ <- forkIO $ ignoreIOException $ do
@@ -122,7 +124,7 @@
         catch (forever $ do
           str <- BS8.hGetLine stdin
           NBS.sendAll sock (str <> BS8.pack "\n")
           ) $ \(e::IOException) -> return () -- connection dropped, just exit.
 
       -- Forward stdout from sock
       catch (forever $ do
@@ -133,9 +135,9 @@
             close sock
             exitSuccess
           else BS8.hPut stdout msg >> hFlush stdout
         ) $ \(e::IOException) -> return () -- connection dropped, just exit.
 
     ) $ \(e::IOException) -> do
       hPutStrLn stderr "Failed to connect to debugger server proxy -- did the debuggee compile and start running successfully?"
 
 -- | Send a 'runInTerminal' reverse request to the DAP client

hdb/Main.hs

@@ -7,6 +7,7 @@ import Data.Maybe
 import Data.Aeson
 import Data.IORef
 import Text.Read
+import Control.Concurrent
 import Control.Monad
 import Control.Monad.IO.Class
 import Control.Monad.Except
@@ -58,8 +59,9 @@ main = do
         let runLogger = loggerFinal hdbOpts l
         init_var <- liftIO (newIORef False{-not supported by default-})
         pid_var  <- liftIO (newIORef Nothing)
+        ccon_var <- liftIO newEmptyMVar
         runDAPServerWithLogger (toCologAction dapLogger) config
-          (talk runLogger init_var pid_var)
+          (talk runLogger init_var pid_var ccon_var)
           (ack runLogger pid_var)
     HdbCLI{..} -> do
         l <- handleLogger stdout
@@ -143,14 +145,22 @@ talk :: Recorder (WithSeverity MainLog)
      -- ^ Whether the client supports runInTerminal
      -> IORef (Maybe Int)
      -- ^ The PID of the runInTerminal proxy process
+     -> MVar ()
+     -- ^ A var to block on waiting for the proxy client to connect, if a proxy
+     -- connection is expected. See #95.
      -> Command -> DebugAdaptor ()
 --------------------------------------------------------------------------------
-talk l support_rit_var pid_var = \ case
+talk l support_rit_var pid_var client_proxy_signal = \ case
   CommandInitialize -> do
     InitializeRequestArguments{supportsRunInTerminalRequest} <- getArguments
-    liftIO $ writeIORef support_rit_var (fromMaybe False supportsRunInTerminalRequest)
+    let runInTerminal = fromMaybe False supportsRunInTerminalRequest
+    liftIO $ writeIORef support_rit_var runInTerminal
     sendInitializeResponse
 
+    -- If runInTerminal is not supported by the client, signal readiness right away
+    when (not runInTerminal) $
+      liftIO $ putMVar client_proxy_signal ()
+
 --------------------------------------------------------------------------------
   CommandLaunch -> do
     launch_args <- getArguments
@@ -168,7 +178,7 @@ talk l support_rit_var pid_var = \ case
         when supportsRunInTerminalRequest $ do
           -- Run proxy thread, server side, and
           -- send the 'runInTerminal' request
-          serverSideHdbProxy (cmapWithSev RunProxyServerLog l)
+          serverSideHdbProxy (cmapWithSev RunProxyServerLog l) client_proxy_signal
 
         logWith l Info $ LaunchLog $ T.pack "Debugger launched successfully."
 
@@ -192,6 +202,9 @@ talk l support_rit_var pid_var = \ case
   CommandConfigurationDone -> do
     sendConfigurationDoneResponse
     -- now that it has been configured, start executing until it halts, then send an event
+
+    -- wait for the proxy client to connect before starting the execution (#95)
+    () <- liftIO $ takeMVar client_proxy_signal
     startExecution >>= handleEvalResult False
 ----------------------------------------------------------------------------
   CommandThreads    -> commandThreads