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 # if MIN_VERSION_process(1,6,4)
  13 import System.Process hiding (getPid, cleanupProcess)
  14 import qualified System.Process (getPid, cleanupProcess)
  15 # else
  16 import System.Process hiding (getPid)
  17 import qualified System.Process (getPid)
  18 # endif
  19 #else
  20 import System.Process
  21 import System.Process.Internals
  22 import Control.Concurrent.MVar
  23 #endif
  24
  25 #ifdef mingw32_HOST_OS
  26 import qualified System.Win32.Process
  27 #else
  28 import qualified System.Posix.Process
  29 #endif
  30
  31
  32 getCurrentProcessID :: IO Int
  33 #ifdef mingw32_HOST_OS
  34 getCurrentProcessID = fromIntegral <$> System.Win32.Process.getCurrentProcessId
  35 #else
  36 getCurrentProcessID = fromIntegral <$> System.Posix.Process.getProcessID
  37 #endif
  38
  39 getProcessID :: ProcessHandle -> IO Int
  40 getProcessID p = fromIntegral . fromJust <$> getProcessID' p
  41   where
  42 #if MIN_VERSION_process(1,6,3)
  43   getProcessID' = System.Process.getPid
  44 #else
  45 #if MIN_VERSION_process(1,6,0)
  46   getProcessID' (ProcessHandle mh _ _) = do
  47 #else
  48   getProcessID' (ProcessHandle mh _) = do
  49 #endif
  50     p_ <- readMVar mh
  51     case p_ of
  52 #ifdef mingw32_HOST_OS
  53       OpenHandle h -> do
  54         pid <- System.Win32.Process.getProcessId h
  55         return $ Just pid
  56 #else
  57       OpenHandle pid -> return $ Just pid
  58 #endif
  59       _ -> return Nothing
  60 #endif
  61
  62 cleanupRunningProcess :: (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle) -> IO ()
  63 cleanupRunningProcess p@(_, _, _, ph) =
  64   getProcessExitCode ph >>= maybe (cleanupProcess p) (const $ return ())
  65
  66 cleanupProcess :: (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle) -> IO ()
  67 #if MIN_VERSION_process(1,6,4)
  68 cleanupProcess = System.Process.cleanupProcess
  69 #else
  70 cleanupProcess (mb_stdin, mb_stdout, mb_stderr, ph) = do
  71
  72     terminateProcess ph
  73     -- Note, it's important that other threads that might be reading/writing
  74     -- these handles also get killed off, since otherwise they might be holding
  75     -- the handle lock and prevent us from closing, leading to deadlock.
  76     maybe (return ()) hClose mb_stdin
  77     maybe (return ()) hClose mb_stdout
  78     maybe (return ()) hClose mb_stderr
  79
  80     return ()
  81 #endif