From 4a2a01a7eaa8945d063468d7d1c24f095a3ae2a4 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Fri, 5 May 2017 14:17:20 -0400 Subject: avoid hang when terminal emulator fails to run debug-me --- ControlWindow.hs | 21 +++++++++++++-------- 1 file changed, 13 insertions(+), 8 deletions(-) diff --git a/ControlWindow.hs b/ControlWindow.hs index 2540640..4f806c9 100644 --- a/ControlWindow.hs +++ b/ControlWindow.hs @@ -69,15 +69,20 @@ openControlWindow = do _ <- async $ serveControlSocket soc ichan ochan myexe <- getExecutablePath mproc <- runInVirtualTerminal winDesc myexe ["--control"] + let cannotrun = do + putStrLn "You need to open another shell prompt, and run: debug-me --control" + return (ichan, ochan) case mproc of - Nothing -> putStrLn "You need to open another shell prompt, and run: debug-me --control" - Just p -> void $ createProcess p - -- Wait for message from control process. - v <- atomically $ readTMChan ochan - case v of - Just ControlWindowOpened -> return () - _ -> error "unexpected message from control process" - return (ichan, ochan) + Nothing -> cannotrun + Just p -> do + (_, _, _, pid) <- createProcess p + -- Wait for message from control process. + v <- atomically (readTMChan ochan) + `race` waitForProcess pid + case v of + Left (Just ControlWindowOpened) -> return (ichan, ochan) + Left _ -> error "unexpected message from control process" + Right _ -> cannotrun type Prompt = () type Response = String -- cgit v1.2.3