From cb67af7446706a78d062b46ed9fd1c07947d071f Mon Sep 17 00:00:00 2001
From: Simon Hengel <sol@typeful.net>
Date: Mon, 22 May 2023 20:48:48 +0700
Subject: [PATCH] refactoring: Use `tryJust` instead of pattern guards

---
 src/System/Process/Typed.hs | 36 +++++++++++++++++-------------------
 1 file changed, 17 insertions(+), 19 deletions(-)

diff --git a/src/System/Process/Typed.hs b/src/System/Process/Typed.hs
index c94701a..57dd9ee 100644
--- a/src/System/Process/Typed.hs
+++ b/src/System/Process/Typed.hs
@@ -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)
@@ -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