src/Language/Haskell/LSP/Test/Compat.hs

   1 {-# LANGUAGE CPP #-}
   2 -- For some reason ghc warns about not using
   3 -- Control.Monad.IO.Class but it's needed for
   4 -- MonadIO
   5 {-# OPTIONS_GHC -Wunused-imports #-}
   6 module Language.Haskell.LSP.Test.Compat where
   7
   8 import Data.Maybe
   9 import System.IO
  10
  11 #if MIN_VERSION_process(1,6,3)
  12 import System.Process hiding (getPid, cleanupProcess)
  13 import qualified System.Process (getPid, cleanupProcess)
  14 #else
  15 import System.Process
  16 import System.Process.Internals
  17 import Control.Concurrent.MVar
  18 #endif
  19
  20 #ifdef mingw32_HOST_OS
  21 import qualified System.Win32.Process
  22 #else
  23 import qualified System.Posix.Process
  24 #endif
  25
  26
  27 getCurrentProcessID :: IO Int
  28 #ifdef mingw32_HOST_OS
  29 getCurrentProcessID = fromIntegral <$> System.Win32.Process.getCurrentProcessId
  30 #else
  31 getCurrentProcessID = fromIntegral <$> System.Posix.Process.getProcessID
  32 #endif
  33
  34 getProcessID :: ProcessHandle -> IO Int
  35 getProcessID p = fromIntegral . fromJust <$> getProcessID' p
  36   where
  37 #if MIN_VERSION_process(1,6,3)
  38   getProcessID' = System.Process.getPid
  39 #else
  40 #if MIN_VERSION_process(1,6,0)
  41   getProcessID' (ProcessHandle mh _ _) = do
  42 #else
  43   getProcessID' (ProcessHandle mh _) = do
  44 #endif
  45     p_ <- readMVar mh
  46     case p_ of
  47 #ifdef mingw32_HOST_OS
  48       OpenHandle h -> do
  49         pid <- System.Win32.Process.getProcessId h
  50         return $ Just pid
  51 #else
  52       OpenHandle pid -> return $ Just pid
  53 #endif
  54       _ -> return Nothing
  55 #endif
  56
  57 cleanupRunningProcess :: (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle) -> IO ()
  58 cleanupRunningProcess p@(_, _, _, ph) =
  59   getProcessExitCode ph >>= maybe (cleanupProcess p) (const $ return ())
  60
  61 cleanupProcess :: (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle) -> IO ()
  62 #if MIN_VERSION_process(1,6,3)
  63 cleanupProcess = System.Process.cleanupProcess
  64 #else
  65 cleanupProcess (mb_stdin, mb_stdout, mb_stderr, ph) = do
  66
  67     terminateProcess ph
  68     -- Note, it's important that other threads that might be reading/writing
  69     -- these handles also get killed off, since otherwise they might be holding
  70     -- the handle lock and prevent us from closing, leading to deadlock.
  71     maybe (return ()) hClose mb_stdin
  72     maybe (return ()) hClose mb_stdout
  73     maybe (return ()) hClose mb_stderr
  74
  75     return ()
  76 #endif