{-# LANGUAGE CPP #-}

module GHC.Runtime.Utils
  ( runWithPipes
  )
where

import GHC.Prelude

#if defined(mingw32_HOST_OS)
import Foreign.C
import GHC.IO.Handle.FD (fdToHandle)
import GHC.Utils.Exception as Ex
# if defined(__IO_MANAGER_WINIO__)
import GHC.IO.SubSystem ((<!>))
import GHC.IO.Handle.Windows (handleToHANDLE)
import GHC.Event.Windows (associateHandle')
# endif
#else
import System.Posix as Posix
#endif
import System.Process
import System.IO

runWithPipes :: (CreateProcess -> IO ProcessHandle)
             -> FilePath -> [String] -> [String] -> IO (ProcessHandle, Handle, Handle)
#if defined(mingw32_HOST_OS)
foreign import ccall "io.h _close"
   c__close :: CInt -> IO CInt

foreign import ccall unsafe "io.h _get_osfhandle"
   _get_osfhandle :: CInt -> IO CIntPtr

runWithPipesPOSIX :: (CreateProcess -> IO ProcessHandle)
                  -> FilePath -> [String] -> [String] -> IO (ProcessHandle, Handle, Handle)
runWithPipesPOSIX :: (CreateProcess -> IO ProcessHandle)
-> FilePath
-> [FilePath]
-> [FilePath]
-> IO (ProcessHandle, Handle, Handle)
runWithPipesPOSIX CreateProcess -> IO ProcessHandle
createProc FilePath
prog [FilePath]
pre_opts [FilePath]
opts = do
    (FD
rfd1, FD
wfd1) <- IO (FD, FD)
createPipeFd -- we read on rfd1
    (FD
rfd2, FD
wfd2) <- IO (FD, FD)
createPipeFd -- we write on wfd2
    CIntPtr
wh_client    <- FD -> IO CIntPtr
_get_osfhandle FD
wfd1
    CIntPtr
rh_client    <- FD -> IO CIntPtr
_get_osfhandle FD
rfd2
    let args :: [FilePath]
args = [FilePath]
pre_opts [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ (CIntPtr -> FilePath
forall a. Show a => a -> FilePath
show CIntPtr
wh_client FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: CIntPtr -> FilePath
forall a. Show a => a -> FilePath
show CIntPtr
rh_client FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: [FilePath]
opts)
    ProcessHandle
ph <- CreateProcess -> IO ProcessHandle
createProc (FilePath -> [FilePath] -> CreateProcess
proc FilePath
prog [FilePath]
args)
    Handle
rh <- FD -> IO Handle
mkHandle FD
rfd1
    Handle
wh <- FD -> IO Handle
mkHandle FD
wfd2
    (ProcessHandle, Handle, Handle)
-> IO (ProcessHandle, Handle, Handle)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ProcessHandle
ph, Handle
rh, Handle
wh)
      where mkHandle :: CInt -> IO Handle
            mkHandle :: FD -> IO Handle
mkHandle FD
fd = (FD -> IO Handle
fdToHandle FD
fd) IO Handle -> IO FD -> IO Handle
forall a b. IO a -> IO b -> IO a
`Ex.onException` (FD -> IO FD
c__close FD
fd)

# if defined (__IO_MANAGER_WINIO__)
runWithPipesNative :: (CreateProcess -> IO ProcessHandle)
                   -> FilePath -> [String] -> [String] -> IO (ProcessHandle, Handle, Handle)
runWithPipesNative :: (CreateProcess -> IO ProcessHandle)
-> FilePath
-> [FilePath]
-> [FilePath]
-> IO (ProcessHandle, Handle, Handle)
runWithPipesNative CreateProcess -> IO ProcessHandle
createProc FilePath
prog [FilePath]
pre_opts [FilePath]
opts = do
    (Handle
rh, Handle
wfd1) <- IO (Handle, Handle)
createPipe -- we read on rfd1
    (Handle
rfd2, Handle
wh) <- IO (Handle, Handle)
createPipe -- we write on wfd2
    HANDLE
wh_client    <- Handle -> IO HANDLE
handleToHANDLE Handle
wfd1
    HANDLE
rh_client    <- Handle -> IO HANDLE
handleToHANDLE Handle
rfd2
    -- Associate the handle with the current manager
    -- but don't touch the ones we're passing to the child
    -- since it needs to register the handle with its own manager.
    HANDLE -> IO ()
associateHandle' (HANDLE -> IO ()) -> IO HANDLE -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Handle -> IO HANDLE
handleToHANDLE Handle
rh
    HANDLE -> IO ()
associateHandle' (HANDLE -> IO ()) -> IO HANDLE -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Handle -> IO HANDLE
handleToHANDLE Handle
wh
    let args :: [FilePath]
args = [FilePath]
pre_opts [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ (HANDLE -> FilePath
forall a. Show a => a -> FilePath
show HANDLE
wh_client FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: HANDLE -> FilePath
forall a. Show a => a -> FilePath
show HANDLE
rh_client FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: [FilePath]
opts)
    ProcessHandle
ph <- CreateProcess -> IO ProcessHandle
createProc (FilePath -> [FilePath] -> CreateProcess
proc FilePath
prog [FilePath]
args)
    (ProcessHandle, Handle, Handle)
-> IO (ProcessHandle, Handle, Handle)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ProcessHandle
ph, Handle
rh, Handle
wh)

runWithPipes :: (CreateProcess -> IO ProcessHandle)
-> FilePath
-> [FilePath]
-> [FilePath]
-> IO (ProcessHandle, Handle, Handle)
runWithPipes = (CreateProcess -> IO ProcessHandle)
-> FilePath
-> [FilePath]
-> [FilePath]
-> IO (ProcessHandle, Handle, Handle)
runWithPipesPOSIX ((CreateProcess -> IO ProcessHandle)
 -> FilePath
 -> [FilePath]
 -> [FilePath]
 -> IO (ProcessHandle, Handle, Handle))
-> ((CreateProcess -> IO ProcessHandle)
    -> FilePath
    -> [FilePath]
    -> [FilePath]
    -> IO (ProcessHandle, Handle, Handle))
-> (CreateProcess -> IO ProcessHandle)
-> FilePath
-> [FilePath]
-> [FilePath]
-> IO (ProcessHandle, Handle, Handle)
forall a. a -> a -> a
<!> (CreateProcess -> IO ProcessHandle)
-> FilePath
-> [FilePath]
-> [FilePath]
-> IO (ProcessHandle, Handle, Handle)
runWithPipesNative
# else
runWithPipes = runWithPipesPOSIX
# endif
#else
runWithPipes createProc prog pre_opts opts = do
    (rfd1, wfd1) <- Posix.createPipe -- we read on rfd1
    (rfd2, wfd2) <- Posix.createPipe -- we write on wfd2
    setFdOption rfd1 CloseOnExec True
    setFdOption wfd2 CloseOnExec True
    let args = pre_opts ++ (show wfd1 : show rfd2 : opts)
    ph <- createProc (proc prog args)
    closeFd wfd1
    closeFd rfd2
    rh <- fdToHandle rfd1
    wh <- fdToHandle wfd2
    return (ph, rh, wh)
#endif