Skip to content

Commit

Permalink
refactoring: Use tryJust instead of pattern guards
Browse files Browse the repository at this point in the history
  • Loading branch information
sol committed May 23, 2023
1 parent 8a0026a commit cb67af7
Showing 1 changed file with 17 additions and 19 deletions.
36 changes: 17 additions & 19 deletions src/System/Process/Typed.hs
Original file line number Diff line number Diff line change
Expand Up @@ -130,6 +130,7 @@ module System.Process.Typed
) where

import Control.Exception hiding (bracket, finally)
import Control.Monad ((>=>), guard)
import Control.Monad.IO.Class
import qualified System.Process as P
import System.IO (hClose)
Expand Down Expand Up @@ -265,25 +266,22 @@ startProcess pConfig'@ProcessConfig {..} = liftIO $ do
where
pConfig = clearStreams pConfig'

terminateProcess pHandle = do
eres <- try $ P.terminateProcess pHandle
case eres of
Left e
-- On Windows, with the single-threaded runtime, it
-- seems that if a process has already exited, the
-- call to terminateProcess will fail with a
-- permission denied error. To work around this, we
-- catch this exception and then immediately
-- waitForProcess. There's a chance that there may be
-- other reasons for this permission error to appear,
-- in which case this code may allow us to wait too
-- long for a child process instead of erroring out.
-- Recommendation: always use the multi-threaded
-- runtime!
| isPermissionError e && not multiThreadedRuntime && isWindows ->
pure ()
| otherwise -> throwIO e
Right () -> pure ()
terminateProcess :: P.ProcessHandle -> IO ()
terminateProcess p = do
-- On Windows, with the single-threaded runtime, it seems that if a
-- process has already exited, the call to terminateProcess will fail
-- with a permission denied error. To work around this, we ignore this
-- exception. There's a chance that there may be other reasons for this
-- permission error to appear, in which case this code may allow us to
-- wait too long for a child process (on a subsequent call to
-- `waitForProcess`) instead of erroring out here.
-- Recommendation: always use the multi-threaded runtime!
ignorePermissionErrorOnSingleThreadedWindows $ P.terminateProcess p

ignorePermissionErrorOnSingleThreadedWindows :: IO () -> IO ()
ignorePermissionErrorOnSingleThreadedWindows = tryJust (guard . p) >=> either return return
where
p e = isPermissionError e && not multiThreadedRuntime && isWindows

foreign import ccall unsafe "rtsSupportsBoundThreads"
multiThreadedRuntime :: Bool
Expand Down

0 comments on commit cb67af7

Please sign in to comment.