snoyberg/keter
1
1
Fork 0
mirror of https://github.com/snoyberg/keter.git synced 2024-12-14 17:12:46 +03:00
Code Issues Projects Releases Wiki Activity

onException killProcess

Browse Source
This commit is contained in:
Michael Snoyman 2012-10-16 15:13:26 +02:00
parent 0f5920cf12
commit da6ea6735c
1 changed files with 4 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
Keter/Process.hs
View File

@ -15,6 +15,7 @@ import Prelude (error)
import Filesystem.Path.CurrentOS (encode) import Filesystem.Path.CurrentOS (encode)
import Data.Text.Encoding (encodeUtf8) import Data.Text.Encoding (encodeUtf8)
import Data.Conduit (($$)) import Data.Conduit (($$))
import Control.Exception (onException)
data Status = NeedsRestart | NoRestart | Running ProcessID data Status = NeedsRestart | NoRestart | Running ProcessID
@ -58,7 +59,9 @@ run exec dir args env logger = do
Right pid -> do Right pid -> do
attach logger $ LogPipes pout perr attach logger $ LogPipes pout perr
log $ ProcessCreated exec log $ ProcessCreated exec
return (Running pid, liftIO (waitForProcess pid) >> loop (Just now)) return (Running pid, do
liftIO $ waitForProcess pid `onException` killProcess pid
loop (Just now))
next next
forkKIO $ loop Nothing forkKIO $ loop Nothing
return $ Process mstatus return $ Process mstatus