Rename "desirability" to "preference" (much less awkward), with the

[match/match.git] / program / IOStuff.hs

module IOStuff (interactWithCommand) where
import System.IO
import System.Process
import System.Exit
import Control.Concurrent
import Control.Concurrent.MVar

-- Like hGetContents but reads all the input before returning, resulting in
-- more predictable behavior.
hStrictGetContents :: Handle -> IO String
hStrictGetContents h = do
	c <- hGetContents h
	-- Note to self: The seq has to be *outside* the return.  Otherwise the
	-- seqified thunk will just be returned to the caller, defeating the
	-- purpose.
	seq (length c) $ return c

interactWithCommand :: String -> String -> IO String
interactWithCommand cmd inData = do
	(inH, outH, errH, pid) <- runInteractiveCommand cmd
	forkIO (do
		hPutStr inH inData
		hClose inH)
	outDataMV <- newEmptyMVar
	forkIO (do
		outData <- hStrictGetContents outH
		putMVar outDataMV outData)
	errDataMV <- newEmptyMVar
	forkIO (do
		errData <- hStrictGetContents errH
		putMVar errDataMV errData)
	outData <- takeMVar outDataMV
	errData <- takeMVar errDataMV
	ex <- waitForProcess pid
	if ex == ExitSuccess && length errData == 0
		then return outData
		else error $ "Command " ++ show cmd ++ " failed: "
			++ "stderr " ++ show errData ++ ", exit " ++ show ex