1 {-# LANGUAGE CPP, OverloadedStrings #-}
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.LSP.Test.Compat where
10 import Language.LSP.Types
12 #if MIN_VERSION_process(1,6,3)
13 -- We have to hide cleanupProcess for process-1.6.3.0
14 -- cause it is in the public api for 1.6.3.0 versions
15 -- shipped with ghc >= 8.6 and < 8.6.4
16 import System.Process hiding (getPid, cleanupProcess, withCreateProcess)
17 # if MIN_VERSION_process(1,6,4)
18 import qualified System.Process (getPid, cleanupProcess, withCreateProcess)
20 import Foreign.C.Error
21 import GHC.IO.Exception ( IOErrorType(..), IOException(..) )
23 import qualified System.Process (getPid)
24 import qualified Control.Exception as C
27 import Control.Concurrent.MVar
28 import Foreign.C.Error
29 import GHC.IO.Exception ( IOErrorType(..), IOException(..) )
30 import System.Process hiding (withCreateProcess)
31 import System.Process.Internals
33 import qualified Control.Exception as C
36 #ifdef mingw32_HOST_OS
37 import qualified System.Win32.Process
39 import qualified System.Posix.Process
43 getCurrentProcessID :: IO Int
44 #ifdef mingw32_HOST_OS
45 getCurrentProcessID = fromIntegral <$> System.Win32.Process.getCurrentProcessId
47 getCurrentProcessID = fromIntegral <$> System.Posix.Process.getProcessID
50 getProcessID :: ProcessHandle -> IO Int
51 getProcessID p = fromIntegral . fromJust <$> getProcessID' p
53 #if MIN_VERSION_process(1,6,3)
54 getProcessID' = System.Process.getPid
56 #if MIN_VERSION_process(1,6,0)
57 getProcessID' (ProcessHandle mh _ _) = do
59 getProcessID' (ProcessHandle mh _) = do
63 #ifdef mingw32_HOST_OS
65 pid <- System.Win32.Process.getProcessId h
68 OpenHandle pid -> return $ Just pid
74 :: (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle) -> IO ()
78 -> (Maybe Handle -> Maybe Handle -> Maybe Handle -> ProcessHandle -> IO a)
81 #if MIN_VERSION_process(1,6,4)
83 cleanupProcess = System.Process.cleanupProcess
85 withCreateProcess = System.Process.withCreateProcess
89 cleanupProcess (mb_stdin, mb_stdout, mb_stderr, ph) = do
90 -- We ignore the spurious "permission denied" error in windows:
91 -- see https://github.com/haskell/process/issues/110
92 ignorePermDenied $ terminateProcess ph
93 -- Note, it's important that other threads that might be reading/writing
94 -- these handles also get killed off, since otherwise they might be holding
95 -- the handle lock and prevent us from closing, leading to deadlock.
96 maybe (return ()) (ignoreSigPipe . hClose) mb_stdin
97 maybe (return ()) hClose mb_stdout
98 maybe (return ()) hClose mb_stderr
101 where ignoreSigPipe = ignoreIOError ResourceVanished ePIPE
102 ignorePermDenied = ignoreIOError PermissionDenied eACCES
104 ignoreIOError :: IOErrorType -> Errno -> IO () -> IO ()
105 ignoreIOError ioErrorType errno =
106 C.handle $ \e -> case e of
107 IOError { ioe_type = iot
108 , ioe_errno = Just ioe }
109 | iot == ioErrorType && Errno ioe == errno -> return ()
112 withCreateProcess c action =
113 C.bracket (createProcess c) cleanupProcess
114 (\(m_in, m_out, m_err, ph) -> action m_in m_out m_err ph)
119 lspTestClientInfo :: ClientInfo
120 lspTestClientInfo = ClientInfo "lsp-test" (Just CURRENT_PACKAGE_VERSION)