Commit | Line | Data |
---|---|---|
fd0d2377 MM |
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 |