Use the correct errno and remove cleanupRunningProcess
authorjneira <atreyu.bbb@gmail.com>
Wed, 24 Jul 2019 05:48:06 +0000 (07:48 +0200)
committerjneira <atreyu.bbb@gmail.com>
Wed, 24 Jul 2019 05:48:06 +0000 (07:48 +0200)
src/Language/Haskell/LSP/Test/Compat.hs
src/Language/Haskell/LSP/Test/Session.hs

index a6151949a07d7486db2069662cba52c112038dd9..883bfc9ef32e5db25a0eb22a22e204fa9cf3d512 100644 (file)
@@ -69,10 +69,6 @@ getProcessID p = fromIntegral . fromJust <$> getProcessID' p
       _ -> return Nothing
 #endif
 
-cleanupRunningProcess :: (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle) -> IO ()
-cleanupRunningProcess p@(_, _, _, ph) =
-  getProcessExitCode ph >>= maybe (cleanupProcess p) (const $ return ())
-
 cleanupProcess
   :: (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle) -> IO ()
 
@@ -102,7 +98,7 @@ cleanupProcess (mb_stdin, mb_stdout, mb_stderr, ph) = do
 
     return ()
   where ignoreSigPipe = ignoreIOError ResourceVanished ePIPE
-        ignorePermDenied = ignoreIOError PermissionDenied ePERM
+        ignorePermDenied = ignoreIOError PermissionDenied eACCES
     
 ignoreIOError :: IOErrorType -> Errno -> IO () -> IO ()
 ignoreIOError ioErrorType errno =
index 4d75d1defa541f07993874da444ed8d4cf08d0ff..8e1afa8c62e515b661576fcf43190cced7e47a15 100644 (file)
@@ -218,13 +218,16 @@ runSessionWithHandles serverIn serverOut serverProc serverHandler config caps ro
       runSession' = runSession context initState
 
       errorHandler = throwTo mainThreadId :: SessionException -> IO()
-      serverLauncher = forkIO $ catch (serverHandler serverOut context) errorHandler
+      serverListenerLauncher =
+        forkIO $ catch (serverHandler serverOut context) errorHandler
       server = (Just serverIn, Just serverOut, Nothing, serverProc)
-      serverFinalizer tid = finally (timeout (messageTimeout config * 1000000)
+      serverAndListenerFinalizer tid =
+        finally (timeout (messageTimeout config * 1000000)
                          (runSession' exitServer))
-                                    (cleanupRunningProcess server >> killThread tid)
+                (cleanupProcess server >> killThread tid)
 
-  (result, _) <- bracket serverLauncher serverFinalizer (const $ runSession' session)
+  (result, _) <- bracket serverListenerLauncher serverAndListenerFinalizer
+                         (const $ runSession' session)
   return result
 
 updateStateC :: ConduitM FromServerMessage FromServerMessage (StateT SessionState (ReaderT SessionContext IO)) ()