program/IOStuff.hs

   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