async exception safety
Convert to withCreateProcess and concurrently, both of which handle cleaning up when there's an async exception thrown to the thread running this.
This commit is contained in:
parent
94986fb228
commit
1f2e2d15e8
1 changed files with 13 additions and 9 deletions
|
@ -310,17 +310,21 @@ outputFilter
|
||||||
-> (Handle -> IO ())
|
-> (Handle -> IO ())
|
||||||
-> (Handle -> IO ())
|
-> (Handle -> IO ())
|
||||||
-> IO (Maybe ExitCode)
|
-> IO (Maybe ExitCode)
|
||||||
outputFilter cmd params environ outfilter errfilter = catchMaybeIO $ do
|
outputFilter cmd params environ outfilter errfilter =
|
||||||
(_, Just outh, Just errh, pid) <- createProcess p
|
catchMaybeIO $ withCreateProcess p go
|
||||||
{ std_out = CreatePipe
|
where
|
||||||
|
go _ (Just outh) (Just errh) pid = do
|
||||||
|
void $ concurrently
|
||||||
|
(tryIO (outfilter outh) >> hClose outh)
|
||||||
|
(tryIO (errfilter errh) >> hClose errh)
|
||||||
|
waitForProcess pid
|
||||||
|
go _ _ _ _ = error "internal"
|
||||||
|
|
||||||
|
p = (proc cmd (toCommand params))
|
||||||
|
{ env = environ
|
||||||
|
, std_out = CreatePipe
|
||||||
, std_err = CreatePipe
|
, std_err = CreatePipe
|
||||||
}
|
}
|
||||||
void $ async $ tryIO (outfilter outh) >> hClose outh
|
|
||||||
void $ async $ tryIO (errfilter errh) >> hClose errh
|
|
||||||
waitForProcess pid
|
|
||||||
where
|
|
||||||
p = (proc cmd (toCommand params))
|
|
||||||
{ env = environ }
|
|
||||||
|
|
||||||
-- | Limit a meter to only update once per unit of time.
|
-- | Limit a meter to only update once per unit of time.
|
||||||
--
|
--
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue