| 1 | module IOStuff (interactWithCommand) where |
| 2 | import System.IO |
| 3 | import System.Process |
| 4 | import System.Exit |
| 5 | import Control.Concurrent |
| 6 | import Control.Concurrent.MVar |
| 7 | |
| 8 | -- Like hGetContents but reads all the input before returning, resulting in |
| 9 | -- more predictable behavior. |
| 10 | hStrictGetContents :: Handle -> IO String |
| 11 | hStrictGetContents h = do |
| 12 | c <- hGetContents h |
| 13 | -- Note to self: The seq has to be *outside* the return. Otherwise the |
| 14 | -- seqified thunk will just be returned to the caller, defeating the |
| 15 | -- purpose. |
| 16 | seq (length c) $ return c |
| 17 | |
| 18 | interactWithCommand :: String -> String -> IO String |
| 19 | interactWithCommand cmd inData = do |
| 20 | (inH, outH, errH, pid) <- runInteractiveCommand cmd |
| 21 | forkIO (do |
| 22 | hPutStr inH inData |
| 23 | hClose inH) |
| 24 | outDataMV <- newEmptyMVar |
| 25 | forkIO (do |
| 26 | outData <- hStrictGetContents outH |
| 27 | putMVar outDataMV outData) |
| 28 | errDataMV <- newEmptyMVar |
| 29 | forkIO (do |
| 30 | errData <- hStrictGetContents errH |
| 31 | putMVar errDataMV errData) |
| 32 | outData <- takeMVar outDataMV |
| 33 | errData <- takeMVar errDataMV |
| 34 | ex <- waitForProcess pid |
| 35 | if ex == ExitSuccess && length errData == 0 |
| 36 | then return outData |
| 37 | else error $ "Command " ++ show cmd ++ " failed: " |
| 38 | ++ "stderr " ++ show errData ++ ", exit " ++ show ex |