1{-# LANGUAGE CPP #-}
2module Distribution.Compat.Process (
3    -- * Redefined functions
4    createProcess,
5    runInteractiveProcess,
6    rawSystem,
7    -- * Additions
8    enableProcessJobs,
9    ) where
10
11import System.Exit (ExitCode (..))
12import System.IO   (Handle)
13
14import           System.Process (CreateProcess, ProcessHandle)
15import qualified System.Process as Process
16
17#if MIN_VERSION_process(1,2,0)
18import           System.Process (waitForProcess)
19#endif
20
21-------------------------------------------------------------------------------
22-- enableProcessJobs
23-------------------------------------------------------------------------------
24
25-- | Enable process jobs to ensure accurate determination of process completion
26-- in the presence of @exec(3)@ on Windows.
27--
28-- Unfortunately the process job support is badly broken in @process@ releases
29-- prior to 1.6.9, so we disable it in these versions, despite the fact that
30-- this means we may see sporatic build failures without jobs.
31enableProcessJobs :: CreateProcess -> CreateProcess
32#ifdef MIN_VERSION_process
33#if MIN_VERSION_process(1,6,9)
34enableProcessJobs cp = cp {Process.use_process_jobs = True}
35#else
36enableProcessJobs cp = cp
37#endif
38#else
39enableProcessJobs cp = cp
40#endif
41
42-------------------------------------------------------------------------------
43-- process redefinitions
44-------------------------------------------------------------------------------
45
46-- | 'System.Process.createProcess' with process jobs enabled when appropriate.
47-- See 'enableProcessJobs'.
48createProcess :: CreateProcess
49              -> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
50createProcess = Process.createProcess . enableProcessJobs
51
52-- | 'System.Process.rawSystem' with process jobs enabled when appropriate.
53-- See 'enableProcessJobs'.
54rawSystem :: String -> [String] -> IO ExitCode
55rawSystem cmd args = do
56#if MIN_VERSION_process(1,2,0)
57  (_,_,_,p) <- createProcess (Process.proc cmd args) { Process.delegate_ctlc = True }
58  waitForProcess p
59#else
60  -- With very old 'process', just do its rawSystem
61  Process.rawSystem cmd args
62#endif
63
64-- | 'System.Process.runInteractiveProcess' with process jobs enabled when
65-- appropriate. See 'enableProcessJobs'.
66runInteractiveProcess
67  :: FilePath                   -- ^ Filename of the executable (see 'RawCommand' for details)
68  -> [String]                   -- ^ Arguments to pass to the executable
69  -> Maybe FilePath             -- ^ Optional path to the working directory
70  -> Maybe [(String,String)]    -- ^ Optional environment (otherwise inherit)
71  -> IO (Handle,Handle,Handle,ProcessHandle)
72runInteractiveProcess cmd args mb_cwd mb_env = do
73  (mb_in, mb_out, mb_err, p) <-
74      createProcess (Process.proc cmd args)
75              { Process.std_in  = Process.CreatePipe,
76                Process.std_out = Process.CreatePipe,
77                Process.std_err = Process.CreatePipe,
78                Process.env     = mb_env,
79                Process.cwd     = mb_cwd }
80  return (fromJust mb_in, fromJust mb_out, fromJust mb_err, p)
81  where
82    fromJust = maybe (error "runInteractiveProcess: fromJust") id
83