- Implement CS2 min-cost-flow adaptor and generalize common min-cost-flow stuff

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

diff --git a/program/IOStuff.hs b/program/IOStuff.hs
new file mode 100644 (file)
index 0000000..fcebc48
--- /dev/null
+++ b/program/IOStuff.hs
@@ -0,0 +1,38 @@
+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