@@ -130,6 +130,7 @@ module System.Process.Typed
130130 ) where
131131
132132import Control.Exception hiding (bracket , finally )
133+ import Control.Monad ((>=>) , guard )
133134import Control.Monad.IO.Class
134135import qualified System.Process as P
135136import System.IO (hClose )
@@ -265,25 +266,22 @@ startProcess pConfig'@ProcessConfig {..} = liftIO $ do
265266 where
266267 pConfig = clearStreams pConfig'
267268
268- terminateProcess pHandle = do
269- eres <- try $ P. terminateProcess pHandle
270- case eres of
271- Left e
272- -- On Windows, with the single-threaded runtime, it
273- -- seems that if a process has already exited, the
274- -- call to terminateProcess will fail with a
275- -- permission denied error. To work around this, we
276- -- catch this exception and then immediately
277- -- waitForProcess. There's a chance that there may be
278- -- other reasons for this permission error to appear,
279- -- in which case this code may allow us to wait too
280- -- long for a child process instead of erroring out.
281- -- Recommendation: always use the multi-threaded
282- -- runtime!
283- | isPermissionError e && not multiThreadedRuntime && isWindows ->
284- pure ()
285- | otherwise -> throwIO e
286- Right () -> pure ()
269+ terminateProcess :: P. ProcessHandle -> IO ()
270+ terminateProcess p = do
271+ -- On Windows, with the single-threaded runtime, it seems that if a
272+ -- process has already exited, the call to terminateProcess will fail
273+ -- with a permission denied error. To work around this, we ignore this
274+ -- exception. There's a chance that there may be other reasons for this
275+ -- permission error to appear, in which case this code may allow us to
276+ -- wait too long for a child process instead of erroring out on a
277+ -- subsequent call to `waitForProcess`.
278+ -- Recommendation: always use the multi-threaded runtime!
279+ ignorePermissionErrorOnSingleThreadedWindows $ P. terminateProcess p
280+
281+ ignorePermissionErrorOnSingleThreadedWindows :: IO () -> IO ()
282+ ignorePermissionErrorOnSingleThreadedWindows = tryJust (guard . p) >=> either return return
283+ where
284+ p e = isPermissionError e && not multiThreadedRuntime && isWindows
287285
288286foreign import ccall unsafe " rtsSupportsBoundThreads"
289287 multiThreadedRuntime :: Bool
0 commit comments