module Lambdabot.Process (popen, run) where
import System.Exit
import System.IO
import System.Process
import Control.Concurrent (forkIO, newEmptyMVar, putMVar, takeMVar, killThread)
import Control.Monad
import qualified Control.Exception as E
run :: FilePath -> String -> (String -> String) -> IO String
run binary src scrub = do
(out,err,_) <- popen binary [] (Just src)
let o = scrub out
e = scrub err
return $ case () of {_
| null o && null e -> "Done."
| null o -> e
| otherwise -> o
}
popen :: FilePath
-> [String]
-> Maybe String
-> IO (String,String,ExitCode)
popen file args minput =
E.handle (\(E.SomeException e) -> return ([],show e,error (show e))) $
E.bracketOnError (runInteractiveProcess file args Nothing Nothing) (\(_,_,_,pid) -> terminateProcess pid) $
\(inp,out,err,pid) -> do
case minput of
Just input -> hPutStr inp input >> E.catch (hClose inp)
(\(E.SomeException e) -> return ())
Nothing -> return ()
output <- hGetContents out
errput <- hGetContents err
outMVar <- newEmptyMVar
errMVar <- newEmptyMVar
E.bracketOnError (do t1 <- forkIO (E.evaluate (length output) >> putMVar outMVar ())
t2 <- forkIO (E.evaluate (length errput) >> putMVar errMVar ())
return (t1,t2))
(\(t1,t2) -> killThread t1 >> killThread t2 )
(\_ -> takeMVar outMVar >> takeMVar errMVar)
e <- waitForProcess pid
return (output,errput,e)