simpler more generic processTranscript'

This allows using functions that generate CreateProcess and passing the
result to processTranscript', which is more flexible, and also simpler
than the old interface.

This commit was sponsored by Riku Voipio.

diff --git a/Assistant/WebApp/Configurators/Ssh.hs b/Assistant/WebApp/Configurators/Ssh.hs
index 66f45d6ec9912c52c2049a66c17d71f3e3fd1f76..9b137c3bc984a5b5d27ce52aebb63aefd5633f56 100644 (file)
--- a/Assistant/WebApp/Configurators/Ssh.hs
+++ b/Assistant/WebApp/Configurators/Ssh.hs
@@ -379,7 +379,7 @@ sshAuthTranscript sshinput opts input = case inputAuthMethod sshinput of
        geti f = maybe "" T.unpack (f sshinput)
 
        go extraopts environ = processTranscript' 
-               (askPass environ) "ssh" (extraopts ++ opts)
+               (askPass environ (proc "ssh" (extraopts ++ opts)))
                -- Always provide stdin, even when empty.
                (Just (fromMaybe "" input))
 

diff --git a/Build/EvilLinker.hs b/Build/EvilLinker.hs
index 94e399dfe1d69c27e039540b16797f2c8d2602ba..47111d47631622700c2e326be9b437723becc7c6 100644 (file)
--- a/Build/EvilLinker.hs
+++ b/Build/EvilLinker.hs
@@ -127,7 +127,7 @@ getOutput c ps environ = do
        putStrLn $ unwords [c, show ps]
        systemenviron <- getEnvironment
        let environ' = fromMaybe [] environ ++ systemenviron
-       out@(_, ok) <- processTranscript' (\p -> p { Utility.Process.env = Just environ' }) c ps Nothing
+       out@(_, ok) <- processTranscript' ((proc c ps) { Utility.Process.env = Just environ' }) Nothing
        putStrLn $ unwords [c, "finished", show ok]
        return out
 

diff --git a/Utility/Process.hs b/Utility/Process.hs
index ed02f49e5181f0c19538b3d1e2e2430f121caebc..6d981cb51aaafe126b1a8f8692c010a2dab2aee5 100644 (file)
--- a/Utility/Process.hs
+++ b/Utility/Process.hs
@@ -174,22 +174,21 @@ createBackgroundProcess p a = a =<< createProcess p
 -- returns a transcript combining its stdout and stderr, and
 -- whether it succeeded or failed.
 processTranscript :: String -> [String] -> (Maybe String) -> IO (String, Bool)
-processTranscript = processTranscript' id
+processTranscript cmd opts = processTranscript' (proc cmd opts)
 
-processTranscript' :: (CreateProcess -> CreateProcess) -> String -> [String] -> Maybe String -> IO (String, Bool)
-processTranscript' modproc cmd opts input = do
+processTranscript' :: CreateProcess -> Maybe String -> IO (String, Bool)
+processTranscript' cp input = do
 #ifndef mingw32_HOST_OS
 {- This implementation interleves stdout and stderr in exactly the order
  - the process writes them. -}
        (readf, writef) <- System.Posix.IO.createPipe
        readh <- System.Posix.IO.fdToHandle readf
        writeh <- System.Posix.IO.fdToHandle writef
-       p@(_, _, _, pid) <- createProcess $ modproc $
-               (proc cmd opts)
-                       { std_in = if isJust input then CreatePipe else Inherit
-                       , std_out = UseHandle writeh
-                       , std_err = UseHandle writeh
-                       }
+       p@(_, _, _, pid) <- createProcess $ cp
+               { std_in = if isJust input then CreatePipe else Inherit
+               , std_out = UseHandle writeh
+               , std_err = UseHandle writeh
+               }
        hClose writeh
 
        get <- mkreader readh
@@ -200,12 +199,11 @@ processTranscript' modproc cmd opts input = do
        return (transcript, ok)
 #else
 {- This implementation for Windows puts stderr after stdout. -}
-       p@(_, _, _, pid) <- createProcess $ modproc $
-               (proc cmd opts)
-                       { std_in = if isJust input then CreatePipe else Inherit
-                       , std_out = CreatePipe
-                       , std_err = CreatePipe
-                       }
+       p@(_, _, _, pid) <- createProcess $ cp
+               { std_in = if isJust input then CreatePipe else Inherit
+               , std_out = CreatePipe
+               , std_err = CreatePipe
+               }
 
        getout <- mkreader (stdoutHandle p)
        geterr <- mkreader (stderrHandle p)