2 -- For some reason ghc warns about not using
3 -- Control.Monad.IO.Class but it's needed for
5 {-# OPTIONS_GHC -Wunused-imports #-}
6 module Language.Haskell.LSP.Test.Compat where
11 #if MIN_VERSION_process(1,6,3)
12 -- We have to hide cleanupProcess for process-1.6.3.0
13 -- cause it is in the public api for 1.6.3.0 versions
14 -- shipped with ghc >= 8.6 and < 8.6.4
15 import System.Process hiding (getPid, cleanupProcess)
16 # if MIN_VERSION_process(1,6,4)
17 import qualified System.Process (getPid, cleanupProcess)
19 import Foreign.C.Error
20 import GHC.IO.Exception ( IOErrorType(..), IOException(..) )
22 import qualified System.Process (getPid)
23 import qualified Control.Exception as C
26 import Control.Concurrent.MVar
27 import Foreign.C.Error
28 import GHC.IO.Exception ( IOErrorType(..), IOException(..) )
30 import System.Process.Internals
32 import qualified Control.Exception as C
35 #ifdef mingw32_HOST_OS
36 import qualified System.Win32.Process
38 import qualified System.Posix.Process
42 getCurrentProcessID :: IO Int
43 #ifdef mingw32_HOST_OS
44 getCurrentProcessID = fromIntegral <$> System.Win32.Process.getCurrentProcessId
46 getCurrentProcessID = fromIntegral <$> System.Posix.Process.getProcessID
49 getProcessID :: ProcessHandle -> IO Int
50 getProcessID p = fromIntegral . fromJust <$> getProcessID' p
52 #if MIN_VERSION_process(1,6,3)
53 getProcessID' = System.Process.getPid
55 #if MIN_VERSION_process(1,6,0)
56 getProcessID' (ProcessHandle mh _ _) = do
58 getProcessID' (ProcessHandle mh _) = do
62 #ifdef mingw32_HOST_OS
64 pid <- System.Win32.Process.getProcessId h
67 OpenHandle pid -> return $ Just pid
72 cleanupRunningProcess :: (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle) -> IO ()
73 cleanupRunningProcess p@(_, _, _, ph) =
74 getProcessExitCode ph >>= maybe (cleanupProcess p) (const $ return ())
76 cleanupProcess :: (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle) -> IO ()
77 #if MIN_VERSION_process(1,6,4)
78 cleanupProcess = System.Process.cleanupProcess
80 cleanupProcess (mb_stdin, mb_stdout, mb_stderr, ph) = do
83 -- Note, it's important that other threads that might be reading/writing
84 -- these handles also get killed off, since otherwise they might be holding
85 -- the handle lock and prevent us from closing, leading to deadlock.
86 maybe (return ()) (ignoreSigPipe . hClose) mb_stdin
87 maybe (return ()) hClose mb_stdout
88 maybe (return ()) hClose mb_stderr
92 ignoreSigPipe :: IO () -> IO ()
93 ignoreSigPipe = C.handle $ \e -> case e of
94 IOError { ioe_type = ResourceVanished
95 , ioe_errno = Just ioe }
96 | Errno ioe == ePIPE -> return ()