aboutsummaryrefslogtreecommitdiff
path: root/Utility/Process.hs
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2013-06-14 17:35:45 -0400
committerGravatar Joey Hess <joey@kitenet.net>2013-06-14 17:35:45 -0400
commit7d41fb6b1844ccef6df8fc3175556b74f98097f8 (patch)
tree9e78829b19d656bceddf39bcb8ac595f805ca2b4 /Utility/Process.hs
parent4f2d339fd7ce16b974702ee1179143cf449bc89c (diff)
Windows: Fix hang when adding several files at once.
Diffstat (limited to 'Utility/Process.hs')
-rw-r--r--Utility/Process.hs34
1 files changed, 18 insertions, 16 deletions
diff --git a/Utility/Process.hs b/Utility/Process.hs
index cee727656..ecd42a98e 100644
--- a/Utility/Process.hs
+++ b/Utility/Process.hs
@@ -26,7 +26,7 @@ module Utility.Process (
withBothHandles,
withQuietOutput,
createProcess,
- runInteractiveProcess,
+ startInteractiveProcess,
stdinHandle,
stdoutHandle,
stderrHandle,
@@ -34,7 +34,7 @@ module Utility.Process (
import qualified System.Process
import System.Process as X hiding (CreateProcess(..), createProcess, runInteractiveProcess, readProcess, readProcessWithExitCode, system, rawSystem, runInteractiveCommand, runProcess)
-import System.Process hiding (createProcess, runInteractiveProcess, readProcess)
+import System.Process hiding (createProcess, readProcess)
import System.Exit
import System.IO
import System.Log.Logger
@@ -300,17 +300,19 @@ createProcess p = do
debugProcess p
System.Process.createProcess p
-runInteractiveProcess
- :: FilePath
- -> [String]
- -> Maybe FilePath
- -> Maybe [(String, String)]
- -> IO (Handle, Handle, Handle, ProcessHandle)
-runInteractiveProcess f args c e = do
- debugProcess $ (proc f args)
- { std_in = CreatePipe
- , std_out = CreatePipe
- , std_err = CreatePipe
- , env = e
- }
- System.Process.runInteractiveProcess f args c e
+{- Starts an interactive process. Unlike runInteractiveProcess in
+ - System.Process, stderr is inherited. -}
+startInteractiveProcess
+ :: FilePath
+ -> [String]
+ -> Maybe [(String, String)]
+ -> IO (ProcessHandle, Handle, Handle)
+startInteractiveProcess cmd args environ = do
+ let p = (proc cmd args)
+ { std_in = CreatePipe
+ , std_out = CreatePipe
+ , std_err = Inherit
+ , env = environ
+ }
+ (Just from, Just to, _, pid) <- createProcess p
+ return (pid, to, from)