From ed60503a91fb152bb856fbf768cd120abdb6944a Mon Sep 17 00:00:00 2001 From: jneira Date: Wed, 24 Jul 2019 07:48:06 +0200 Subject: [PATCH] Use the correct errno and remove cleanupRunningProcess --- src/Language/Haskell/LSP/Test/Compat.hs | 6 +----- src/Language/Haskell/LSP/Test/Session.hs | 11 +++++++---- 2 files changed, 8 insertions(+), 9 deletions(-) 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)) () -- 2.30.2