diff options
author | Joey Hess <joeyh@joeyh.name> | 2017-05-05 14:17:20 -0400 |
---|---|---|
committer | Joey Hess <joeyh@joeyh.name> | 2017-05-05 14:17:20 -0400 |
commit | 4a2a01a7eaa8945d063468d7d1c24f095a3ae2a4 (patch) | |
tree | 7d425d5056295c20449dbf4303631197b10e884d /ControlWindow.hs | |
parent | be53d40694e59f9ef48d8a8106004623bddc703b (diff) | |
download | debug-me-4a2a01a7eaa8945d063468d7d1c24f095a3ae2a4.tar.gz |
avoid hang when terminal emulator fails to run debug-me
Diffstat (limited to 'ControlWindow.hs')
-rw-r--r-- | ControlWindow.hs | 21 |
1 files 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 |