[commit: packages/process] master: Add readCreateProcess function (8c92d7d)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/process

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/8c92d7dfd9f6ebba07b35ae1d0da0c2e66bc6c18/process

>---------------------------------------------------------------

commit 8c92d7dfd9f6ebba07b35ae1d0da0c2e66bc6c18
Author: Bartosz Nitka <bnitka at fb.com>
Date:   Wed Feb 25 09:42:50 2015 -0800

    Add readCreateProcess function
    
    This function is more flexible then readProcess, for example it allows
    you to change the working directory before running the command.


>---------------------------------------------------------------

8c92d7dfd9f6ebba07b35ae1d0da0c2e66bc6c18
 System/Process.hsc | 29 +++++++++++++++++++++++++----
 1 file changed, 25 insertions(+), 4 deletions(-)

diff --git a/System/Process.hsc b/System/Process.hsc
index fe3e8fc..6270fe3 100644
--- a/System/Process.hsc
+++ b/System/Process.hsc
@@ -40,6 +40,7 @@ module System.Process (
     callCommand,
     spawnProcess,
     spawnCommand,
+    readCreateProcess,
     readProcess,
     readProcessWithExitCode,
 
@@ -413,13 +414,25 @@ readProcess
     -> [String]                 -- ^ any arguments
     -> String                   -- ^ standard input
     -> IO String                -- ^ stdout
-readProcess cmd args input = do
-    let cp_opts = (proc cmd args) {
+readProcess cmd args = readCreateProcess $ proc cmd args
+
+-- | @readCreateProcess@ works exactly like 'readProcess' except that it
+-- lets you pass 'CreateProcess' giving better flexibility.
+--
+-- >  > readCreateProcess (shell "pwd" { cwd = "/etc/" }) ""
+-- >  "/etc\n"
+
+readCreateProcess
+    :: CreateProcess
+    -> String                   -- ^ standard input
+    -> IO String                -- ^ stdout
+readCreateProcess cp input = do
+    let cp_opts = cp {
                     std_in  = CreatePipe,
                     std_out = CreatePipe,
                     std_err = Inherit
                   }
-    (ex, output) <- withCreateProcess_ "readProcess" cp_opts $
+    (ex, output) <- withCreateProcess_ "readCreateProcess" cp_opts $
       \(Just inh) (Just outh) _ ph -> do
 
         -- fork off a thread to start consuming the output
@@ -442,7 +455,15 @@ readProcess cmd args input = do
 
     case ex of
      ExitSuccess   -> return output
-     ExitFailure r -> processFailedException "readProcess" cmd args r
+     ExitFailure r -> processFailedException "readCreateProcess" cmd args r
+  where
+    cmd = case cp of
+            CreateProcess { cmdspec = ShellCommand sc } -> sc
+            CreateProcess { cmdspec = RawCommand fp _ } -> fp
+    args = case cp of
+             CreateProcess { cmdspec = ShellCommand _ } -> []
+             CreateProcess { cmdspec = RawCommand _ args' } -> args'
+
 
 -- | @readProcessWithExitCode@ is like @readProcess@ but with two differences:
 --