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