From: jneira <atreyu.bbb@gmail.com>
Date: Wed, 24 Jul 2019 05:48:06 +0000 (+0200)
Subject: Use the correct errno and remove cleanupRunningProcess
X-Git-Tag: 0.6.1.0~2^2~1
X-Git-Url: http://git.lukelau.me/?p=lsp-test.git;a=commitdiff_plain;h=ed60503a91fb152bb856fbf768cd120abdb6944a

Use the correct errno and remove cleanupRunningProcess
---

diff --git a/src/Language/Haskell/LSP/Test/Compat.hs b/src/Language/Haskell/LSP/Test/Compat.hs
index a615194..883bfc9 100644
--- a/src/Language/Haskell/LSP/Test/Compat.hs
+++ b/src/Language/Haskell/LSP/Test/Compat.hs
@@ -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 =
diff --git a/src/Language/Haskell/LSP/Test/Session.hs b/src/Language/Haskell/LSP/Test/Session.hs
index 4d75d1d..8e1afa8 100644
--- a/src/Language/Haskell/LSP/Test/Session.hs
+++ b/src/Language/Haskell/LSP/Test/Session.hs
@@ -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)) ()