summaryrefslogtreecommitdiff
path: root/src/Utility/Process.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Utility/Process.hs')
-rw-r--r--src/Utility/Process.hs48
1 files changed, 41 insertions, 7 deletions
diff --git a/src/Utility/Process.hs b/src/Utility/Process.hs
index 8fefaa54..cbbe8a81 100644
--- a/src/Utility/Process.hs
+++ b/src/Utility/Process.hs
@@ -25,14 +25,16 @@ module Utility.Process (
processTranscript,
processTranscript',
withHandle,
- withBothHandles,
+ withIOHandles,
+ withOEHandles,
withQuietOutput,
+ feedWithQuietOutput,
createProcess,
startInteractiveProcess,
stdinHandle,
stdoutHandle,
stderrHandle,
- bothHandles,
+ ioHandles,
processHandle,
devNull,
) where
@@ -255,12 +257,12 @@ withHandle h creator p a = creator p' $ a . select
(stderrHandle, base { std_err = CreatePipe })
{- Like withHandle, but passes (stdin, stdout) handles to the action. -}
-withBothHandles
+withIOHandles
:: CreateProcessRunner
-> CreateProcess
-> ((Handle, Handle) -> IO a)
-> IO a
-withBothHandles creator p a = creator p' $ a . bothHandles
+withIOHandles creator p a = creator p' $ a . ioHandles
where
p' = p
{ std_in = CreatePipe
@@ -268,6 +270,20 @@ withBothHandles creator p a = creator p' $ a . bothHandles
, std_err = Inherit
}
+{- Like withHandle, but passes (stdout, stderr) handles to the action. -}
+withOEHandles
+ :: CreateProcessRunner
+ -> CreateProcess
+ -> ((Handle, Handle) -> IO a)
+ -> IO a
+withOEHandles creator p a = creator p' $ a . oeHandles
+ where
+ p' = p
+ { std_in = Inherit
+ , std_out = CreatePipe
+ , std_err = CreatePipe
+ }
+
{- Forces the CreateProcessRunner to run quietly;
- both stdout and stderr are discarded. -}
withQuietOutput
@@ -281,6 +297,21 @@ withQuietOutput creator p = withFile devNull WriteMode $ \nullh -> do
}
creator p' $ const $ return ()
+{- Stdout and stderr are discarded, while the process is fed stdin
+ - from the handle. -}
+feedWithQuietOutput
+ :: CreateProcessRunner
+ -> CreateProcess
+ -> (Handle -> IO a)
+ -> IO a
+feedWithQuietOutput creator p a = withFile devNull WriteMode $ \nullh -> do
+ let p' = p
+ { std_in = CreatePipe
+ , std_out = UseHandle nullh
+ , std_err = UseHandle nullh
+ }
+ creator p' $ a . stdinHandle
+
devNull :: FilePath
#ifndef mingw32_HOST_OS
devNull = "/dev/null"
@@ -303,9 +334,12 @@ stdoutHandle _ = error "expected stdoutHandle"
stderrHandle :: HandleExtractor
stderrHandle (_, _, Just h, _) = h
stderrHandle _ = error "expected stderrHandle"
-bothHandles :: (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle) -> (Handle, Handle)
-bothHandles (Just hin, Just hout, _, _) = (hin, hout)
-bothHandles _ = error "expected bothHandles"
+ioHandles :: (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle) -> (Handle, Handle)
+ioHandles (Just hin, Just hout, _, _) = (hin, hout)
+ioHandles _ = error "expected ioHandles"
+oeHandles :: (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle) -> (Handle, Handle)
+oeHandles (_, Just hout, Just herr, _) = (hout, herr)
+oeHandles _ = error "expected oeHandles"
processHandle :: (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle) -> ProcessHandle
processHandle (_, _, _, pid) = pid