projects
/
lsp-test.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Ignore 'permisision denied' error cleaning up processes
[lsp-test.git]
/
src
/
Language
/
Haskell
/
LSP
/
Test
/
Compat.hs
diff --git
a/src/Language/Haskell/LSP/Test/Compat.hs
b/src/Language/Haskell/LSP/Test/Compat.hs
index 87b7dc9ca9737cb5e2731722c110f6b0c8a76b41..a6151949a07d7486db2069662cba52c112038dd9 100644
(file)
--- a/
src/Language/Haskell/LSP/Test/Compat.hs
+++ b/
src/Language/Haskell/LSP/Test/Compat.hs
@@
-12,9
+12,9
@@
import System.IO
-- We have to hide cleanupProcess for process-1.6.3.0
-- cause it is in the public api for 1.6.3.0 versions
-- shipped with ghc >= 8.6 and < 8.6.4
-- We have to hide cleanupProcess for process-1.6.3.0
-- cause it is in the public api for 1.6.3.0 versions
-- shipped with ghc >= 8.6 and < 8.6.4
-import System.Process hiding (getPid, cleanupProcess)
+import System.Process hiding (getPid, cleanupProcess
, withCreateProcess
)
# if MIN_VERSION_process(1,6,4)
# if MIN_VERSION_process(1,6,4)
-import qualified System.Process (getPid, cleanupProcess)
+import qualified System.Process (getPid, cleanupProcess
, withCreateProcess
)
# else
import Foreign.C.Error
import GHC.IO.Exception ( IOErrorType(..), IOException(..) )
# else
import Foreign.C.Error
import GHC.IO.Exception ( IOErrorType(..), IOException(..) )
@@
-26,7
+26,7
@@
import qualified Control.Exception as C
import Control.Concurrent.MVar
import Foreign.C.Error
import GHC.IO.Exception ( IOErrorType(..), IOException(..) )
import Control.Concurrent.MVar
import Foreign.C.Error
import GHC.IO.Exception ( IOErrorType(..), IOException(..) )
-import System.Process
+import System.Process
hiding (withCreateProcess)
import System.Process.Internals
import qualified Control.Exception as C
import System.Process.Internals
import qualified Control.Exception as C
@@
-73,13
+73,26
@@
cleanupRunningProcess :: (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandl
cleanupRunningProcess p@(_, _, _, ph) =
getProcessExitCode ph >>= maybe (cleanupProcess p) (const $ return ())
cleanupRunningProcess p@(_, _, _, ph) =
getProcessExitCode ph >>= maybe (cleanupProcess p) (const $ return ())
-cleanupProcess :: (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle) -> IO ()
+cleanupProcess
+ :: (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle) -> IO ()
+
+withCreateProcess
+ :: CreateProcess
+ -> (Maybe Handle -> Maybe Handle -> Maybe Handle -> ProcessHandle -> IO a)
+ -> IO a
+
#if MIN_VERSION_process(1,6,4)
#if MIN_VERSION_process(1,6,4)
+
cleanupProcess = System.Process.cleanupProcess
cleanupProcess = System.Process.cleanupProcess
+
+withCreateProcess = System.Process.withCreateProcess
+
#else
#else
-cleanupProcess (mb_stdin, mb_stdout, mb_stderr, ph) = do
- terminateProcess ph
+cleanupProcess (mb_stdin, mb_stdout, mb_stderr, ph) = do
+ -- We ignore the spurious "permission denied" error in windows:
+ -- see https://github.com/haskell/process/issues/110
+ ignorePermDenied $ terminateProcess ph
-- Note, it's important that other threads that might be reading/writing
-- these handles also get killed off, since otherwise they might be holding
-- the handle lock and prevent us from closing, leading to deadlock.
-- Note, it's important that other threads that might be reading/writing
-- these handles also get killed off, since otherwise they might be holding
-- the handle lock and prevent us from closing, leading to deadlock.
@@
-88,11
+101,19
@@
cleanupProcess (mb_stdin, mb_stdout, mb_stderr, ph) = do
maybe (return ()) hClose mb_stderr
return ()
maybe (return ()) hClose mb_stderr
return ()
+ where ignoreSigPipe = ignoreIOError ResourceVanished ePIPE
+ ignorePermDenied = ignoreIOError PermissionDenied ePERM
-ignoreSigPipe :: IO () -> IO ()
-ignoreSigPipe = C.handle $ \e -> case e of
- IOError { ioe_type = ResourceVanished
+ignoreIOError :: IOErrorType -> Errno -> IO () -> IO ()
+ignoreIOError ioErrorType errno =
+ C.handle $ \e -> case e of
+ IOError { ioe_type = iot
, ioe_errno = Just ioe }
, ioe_errno = Just ioe }
-
| Errno ioe == ePIPE
-> return ()
+
| iot == ioErrorType && Errno ioe == errno
-> return ()
_ -> C.throwIO e
_ -> C.throwIO e
+
+withCreateProcess c action =
+ C.bracket (createProcess c) cleanupProcess
+ (\(m_in, m_out, m_err, ph) -> action m_in m_out m_err ph)
+
#endif
#endif