haskell/yesod
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

nonblocking waitForProcess

Browse Source
This commit is contained in:
Luite Stegeman 2012-04-04 01:03:05 +02:00
parent 740f4d3843
commit 0c60da3472
1 changed files with 13 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
yesod/Devel.hs
View File

@ -26,8 +26,8 @@ import System.Exit (exitFailure, exitSuccess, ExitCode (..))
import System.FilePath (splitDirectories, dropExtension, takeExtension) import System.FilePath (splitDirectories, dropExtension, takeExtension)
import System.Posix.Types (EpochTime) import System.Posix.Types (EpochTime)
import System.PosixCompat.Files (modificationTime, getFileStatus) import System.PosixCompat.Files (modificationTime, getFileStatus)
import System.Process (createProcess, proc, terminateProcess, readProcess, import System.Process (createProcess, proc, terminateProcess, readProcess, ProcessHandle,
waitForProcess, rawSystem, runInteractiveProcess) getProcessExitCode,waitForProcess, rawSystem, runInteractiveProcess)
import System.IO (hClose, hIsEOF, hGetLine, stdout, stderr, hPutStrLn) import System.IO (hClose, hIsEOF, hGetLine, stdout, stderr, hPutStrLn)
import Build (recompDeps, getDeps, isNewerThan) import Build (recompDeps, getDeps, isNewerThan)
@ -113,7 +113,7 @@ devel isCabalDev passThroughArgs = do
threadDelay 1000000 threadDelay 1000000
putStrLn "Terminating development server..." putStrLn "Terminating development server..."
terminateProcess ph terminateProcess ph
ec <- waitForProcess ph ec <- waitForProcess' ph
putStrLn $ "Exit code: " ++ show ec putStrLn $ "Exit code: " ++ show ec
Ex.throwTo watchTid (userError "process finished") Ex.throwTo watchTid (userError "process finished")
watchForChanges hsSourceDirs list watchForChanges hsSourceDirs list
@ -258,6 +258,15 @@ rawSystemFilter command args = do
go handlein handleout go handlein handleout
_ <- forkIO $ go outh stdout _ <- forkIO $ go outh stdout
_ <- forkIO $ go errh stderr _ <- forkIO $ go errh stderr
waitForProcess ph waitForProcess' ph
-- nonblocking version
waitForProcess' :: ProcessHandle -> IO ExitCode
waitForProcess' pid = go
where
go = do
mec <- getProcessExitCode pid
case mec of
Just ec -> return ec
Nothing -> threadDelay 100000 >> go