Compat.hs

{-# 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