From 619c8bd261a4fee0b0d40b664e55c51782e062f7 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Mon, 21 Jul 2014 16:35:23 -0400
Subject: Merge from git-annex.

---
 Utility/Process.hs | 39 ++++++++++++++-------------------------
 1 file changed, 14 insertions(+), 25 deletions(-)

(limited to 'Utility/Process.hs')

diff --git a/Utility/Process.hs b/Utility/Process.hs
index 3f93dc2..1f722af 100644
--- a/Utility/Process.hs
+++ b/Utility/Process.hs
@@ -3,14 +3,14 @@
  -
  - Copyright 2012 Joey Hess <joey@kitenet.net>
  -
- - Licensed under the GNU GPL version 3 or higher.
+ - License: BSD-2-clause
  -}
 
 {-# LANGUAGE CPP, Rank2Types #-}
 
 module Utility.Process (
 	module X,
-	CreateProcess,
+	CreateProcess(..),
 	StdHandle(..),
 	readProcess,
 	readProcessEnv,
@@ -167,10 +167,10 @@ processTranscript :: String -> [String] -> (Maybe String) -> IO (String, Bool)
 processTranscript cmd opts input = processTranscript' cmd opts Nothing input
 
 processTranscript' :: String -> [String] -> Maybe [(String, String)] -> (Maybe String) -> IO (String, Bool)
+processTranscript' cmd opts environ input = do
 #ifndef mingw32_HOST_OS
 {- This implementation interleves stdout and stderr in exactly the order
  - the process writes them. -}
-processTranscript' cmd opts environ input = do
 	(readf, writef) <- createPipe
 	readh <- fdToHandle readf
 	writeh <- fdToHandle writef
@@ -184,24 +184,13 @@ processTranscript' cmd opts environ input = do
 	hClose writeh
 
 	get <- mkreader readh
-
-	-- now write and flush any input
-	case input of
-		Just s -> do
-			let inh = stdinHandle p
-			unless (null s) $ do
-				hPutStr inh s
-				hFlush inh
-			hClose inh
-		Nothing -> return ()
-
+	writeinput input p
 	transcript <- get
 
 	ok <- checkSuccessProcess pid
 	return (transcript, ok)
 #else
 {- This implementation for Windows puts stderr after stdout. -}
-processTranscript' cmd opts environ input = do
 	p@(_, _, _, pid) <- createProcess $
 		(proc cmd opts)
 			{ std_in = if isJust input then CreatePipe else Inherit
@@ -212,17 +201,9 @@ processTranscript' cmd opts environ input = do
 
 	getout <- mkreader (stdoutHandle p)
 	geterr <- mkreader (stderrHandle p)
-
-	case input of
-		Just s -> do
-			let inh = stdinHandle p
-			unless (null s) $ do
-				hPutStr inh s
-				hFlush inh
-			hClose inh
-		Nothing -> return ()
-	
+	writeinput input p
 	transcript <- (++) <$> getout <*> geterr
+
 	ok <- checkSuccessProcess pid
 	return (transcript, ok)
 #endif
@@ -237,6 +218,14 @@ processTranscript' cmd opts environ input = do
 			takeMVar v
 			return s
 
+	writeinput (Just s) p = do
+		let inh = stdinHandle p
+		unless (null s) $ do
+			hPutStr inh s
+			hFlush inh
+		hClose inh
+	writeinput Nothing _ = return ()
+
 {- Runs a CreateProcessRunner, on a CreateProcess structure, that
  - is adjusted to pipe only from/to a single StdHandle, and passes
  - the resulting Handle to an action. -}
-- 
cgit v1.2.3