-- #hide
module System.Process.Internals (
- ProcessHandle(..), PHANDLE,
+ ProcessHandle(..), ProcessHandle__(..),
+ PHANDLE, closePHANDLE, mkProcessHandle,
+ withProcessHandle, withProcessHandle_,
#if !defined(mingw32_HOST_OS) && !defined(__MINGW32__)
pPrPr_disableITimers, c_execvpe,
# ifdef __GLASGOW_HASKELL__
import System.IO ( Handle )
#else
import Data.Word ( Word32 )
+import Data.IORef
#endif
+import System.Exit ( ExitCode )
import Data.Maybe ( fromMaybe )
# ifdef __GLASGOW_HASKELL__
import GHC.IOBase ( haFD, FD, Exception(..), IOException(..) )
import Hugs.Exception ( Exception(..), IOException(..) )
# endif
+import Control.Concurrent
import Control.Exception ( handle, throwIO )
import Foreign.C
import Foreign
termination: they all return a 'ProcessHandle' which may be used
to wait for the process later.
-}
+data ProcessHandle__ = OpenHandle PHANDLE | ClosedHandle ExitCode
+newtype ProcessHandle = ProcessHandle (MVar ProcessHandle__)
+
+withProcessHandle
+ :: ProcessHandle
+ -> (ProcessHandle__ -> IO (ProcessHandle__, a))
+ -> IO a
+withProcessHandle (ProcessHandle m) io = modifyMVar m io
+
+withProcessHandle_
+ :: ProcessHandle
+ -> (ProcessHandle__ -> IO ProcessHandle__)
+ -> IO ()
+withProcessHandle_ (ProcessHandle m) io = modifyMVar_ m io
+
#if !defined(mingw32_HOST_OS) && !defined(__MINGW32__)
+
type PHANDLE = CPid
+
+mkProcessHandle :: PHANDLE -> IO ProcessHandle
+mkProcessHandle p = do
+ m <- newMVar (OpenHandle p)
+ return (ProcessHandle m)
+
+closePHANDLE :: PHANDLE -> IO ()
+closePHANDLE _ = return ()
+
#else
+
type PHANDLE = Word32
-#endif
-newtype ProcessHandle = ProcessHandle PHANDLE
+-- On Windows, we have to close this HANDLE when it is no longer required,
+-- hence we add a finalizer to it, using an IORef as the box on which to
+-- attach the finalizer.
+mkProcessHandle :: PHANDLE -> IO ProcessHandle
+mkProcessHandle h = do
+ m <- newMVar (OpenHandle h)
+ addMVarFinalizer m (processHandleFinaliser m)
+ return (ProcessHandle m)
+
+processHandleFinaliser m =
+ modifyMVar_ m $ \p_ -> do
+ case p_ of
+ OpenHandle ph -> closePHANDLE ph
+ _ -> return ()
+ return (error "closed process handle")
+
+closePHANDLE :: PHANDLE -> IO ()
+closePHANDLE ph = c_CloseHandle ph
+
+foreign import stdcall unsafe "CloseHandle"
+ c_CloseHandle
+ :: PHANDLE
+ -> IO ()
+#endif
-- ----------------------------------------------------------------------------
c_runProcess pargs pWorkDir pEnv
fd_stdin fd_stdout fd_stderr
set_int inthand set_quit quithand
- return (ProcessHandle ph)
+ mkProcessHandle ph
foreign import ccall unsafe "runProcess"
c_runProcess
proc_handle <- throwErrnoIfMinus1 fun
(c_runProcess pcmdline pWorkDir pEnv
fd_stdin fd_stdout fd_stderr)
- return (ProcessHandle proc_handle)
+ mkProcessHandle proc_handle
foreign import ccall unsafe "runProcess"
c_runProcess