{-# LANGUAGE CPP #-} {-# LANGUAGE ForeignFunctionInterface #-} {- | Compatibility code for things that need to be done differently on different systems. -} module Config.Dyre.Compat ( customExec, getPIDString ) where import Config.Dyre.Options ( customOptions ) #if defined(mingw32_HOST_OS) || defined(__MINGW32__) import System.Win32 import System.Process import System.Exit import System.Mem -- This can be removed as soon as a 'getProcessID' function -- gets added to 'System.Win32' foreign import stdcall unsafe "winbase.h GetCurrentProcessId" c_GetCurrentProcessID :: IO DWORD getPIDString = fmap show c_GetCurrentProcessID customExec binary mArgs = do args <- customOptions mArgs -- This whole thing is a terrible, ugly hack. Since Windows -- is too braindead to provide an exec() system call for us -- to use, we simply create a new process that inherits -- the stdio handles. (_,_,_,child) <- createProcess $ CreateProcess { cmdspec = RawCommand binary args , cwd = Nothing , env = Nothing , std_in = Inherit , std_out = Inherit , std_err = Inherit , close_fds = True } -- Do some garbage collection in an optimistic attempt to -- offset some of the memory we waste here. performGC -- And to prevent terminal apps from losing IO, we have to -- sit around waiting for the child to exit. exitCode <- waitForProcess child case exitCode of ExitSuccess -> c_ExitProcess 0 ExitFailure c -> c_ExitProcess (fromIntegral c) foreign import stdcall unsafe "winbase.h ExitProcess" c_ExitProcess :: UINT -> IO () #else import System.Posix.Process ( executeFile, getProcessID ) getPIDString = fmap show getProcessID customExec binary mArgs = do args <- customOptions mArgs executeFile binary False args Nothing #endif -- | Called whenever execution needs to be transferred over to -- a different binary. customExec :: FilePath -> Maybe [String] -> IO () -- | What it says on the tin. Gets the current PID as a string. -- Used to determine the name for the state file during restarts. getPIDString :: IO String