X-Git-Url: http://git.lukelau.me/?a=blobdiff_plain;f=src%2FLanguage%2FHaskell%2FLSP%2FTest%2FCompat.hs;h=a68f74158bb95baa85d5965556eecaf5689c1044;hb=c20539b56bdb7ae9b0c01a30e70215a6aeaa7bd1;hp=f616331929b7250c9930708652322089c5fc44de;hpb=a4c1143848809be8aed55403dc3187a256dcbe9b;p=lsp-test.git

diff --git a/src/Language/Haskell/LSP/Test/Compat.hs b/src/Language/Haskell/LSP/Test/Compat.hs
index f616331..a68f741 100644
--- a/src/Language/Haskell/LSP/Test/Compat.hs
+++ b/src/Language/Haskell/LSP/Test/Compat.hs
@@ -6,10 +6,16 @@
 module Language.Haskell.LSP.Test.Compat where
 
 import Data.Maybe
+import System.IO
 
 #if MIN_VERSION_process(1,6,3)
+# if MIN_VERSION_process(1,6,4)
+import System.Process hiding (getPid, cleanupProcess)
+import qualified System.Process (getPid, cleanupProcess)
+# else
 import System.Process hiding (getPid)
 import qualified System.Process (getPid)
+# endif
 #else
 import System.Process
 import System.Process.Internals
@@ -36,7 +42,11 @@ getProcessID p = fromIntegral . fromJust <$> getProcessID' p
 #if MIN_VERSION_process(1,6,3)
   getProcessID' = System.Process.getPid
 #else
+#if MIN_VERSION_process(1,6,0)
   getProcessID' (ProcessHandle mh _ _) = do
+#else
+  getProcessID' (ProcessHandle mh _) = do
+#endif
     p_ <- readMVar mh
     case p_ of
 #ifdef mingw32_HOST_OS
@@ -48,3 +58,24 @@ getProcessID p = fromIntegral . fromJust <$> getProcessID' p
 #endif
       _ -> 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 ()
+#if MIN_VERSION_process(1,6,4)
+cleanupProcess = System.Process.cleanupProcess
+#else
+cleanupProcess (mb_stdin, mb_stdout, mb_stderr, ph) = do
+
+    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.
+    maybe (return ()) hClose mb_stdin
+    maybe (return ()) hClose mb_stdout
+    maybe (return ()) hClose mb_stderr
+
+    return ()
+#endif