{-# LANGUAGE CPP #-}
module Distribution.Compat.Process (
    -- * Redefined functions
    createProcess,
    runInteractiveProcess,
    rawSystem,
    -- * Additions
    enableProcessJobs,
    ) where

import System.Exit (ExitCode (..))
import System.IO   (Handle)

import           System.Process (CreateProcess, ProcessHandle)
import qualified System.Process as Process

#if MIN_VERSION_process(1,2,0)
import           System.Process (waitForProcess)
#endif

-------------------------------------------------------------------------------
-- enableProcessJobs
-------------------------------------------------------------------------------

-- | Enable process jobs to ensure accurate determination of process completion
-- in the presence of @exec(3)@ on Windows.
--
-- Unfortunately the process job support is badly broken in @process@ releases
-- prior to 1.6.8, so we disable it in these versions, despite the fact that
-- this means we may see sporatic build failures without jobs.
enableProcessJobs :: CreateProcess -> CreateProcess
#ifdef MIN_VERSION_process
#if MIN_VERSION_process(1,6,8)
enableProcessJobs cp = cp {Process.use_process_jobs = True}
#else
enableProcessJobs cp = cp
#endif
#else
enableProcessJobs cp = cp
#endif

-------------------------------------------------------------------------------
-- process redefinitions
-------------------------------------------------------------------------------

-- | 'System.Process.createProcess' with process jobs enabled when appropriate.
-- See 'enableProcessJobs'.
createProcess :: CreateProcess
              -> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
createProcess = Process.createProcess . enableProcessJobs

-- | 'System.Process.rawSystem' with process jobs enabled when appropriate.
-- See 'enableProcessJobs'.
rawSystem :: String -> [String] -> IO ExitCode
rawSystem cmd args = do
#if MIN_VERSION_process(1,2,0)
  (_,_,_,p) <- createProcess (Process.proc cmd args) { Process.delegate_ctlc = True }
  waitForProcess p
#else
  -- With very old 'process', just do its rawSystem
  Process.rawSystem cmd args
#endif

-- | 'System.Process.runInteractiveProcess' with process jobs enabled when
-- appropriate. See 'enableProcessJobs'.
runInteractiveProcess
  :: FilePath                   -- ^ Filename of the executable (see 'RawCommand' for details)
  -> [String]                   -- ^ Arguments to pass to the executable
  -> Maybe FilePath             -- ^ Optional path to the working directory
  -> Maybe [(String,String)]    -- ^ Optional environment (otherwise inherit)
  -> IO (Handle,Handle,Handle,ProcessHandle)
runInteractiveProcess cmd args mb_cwd mb_env = do
  (mb_in, mb_out, mb_err, p) <-
      createProcess (Process.proc cmd args)
              { Process.std_in  = Process.CreatePipe,
                Process.std_out = Process.CreatePipe,
                Process.std_err = Process.CreatePipe,
                Process.env     = mb_env,
                Process.cwd     = mb_cwd }
  return (fromJust mb_in, fromJust mb_out, fromJust mb_err, p)
  where
    fromJust = maybe (error "runInteractiveProcess: fromJust") id