From edc9532079a62d7a666288c2dd3cc1047c6820ea Mon Sep 17 00:00:00 2001
From: Julian Ospald <hasufell@posteo.de>
Date: Fri, 15 Nov 2024 12:31:00 +0800
Subject: [PATCH] Don't catch async exceptions

Related: https://github.com/haskell/os-string/issues/22
---
 System/FilePath/Internal.hs | 24 ++++++++++++++++++++----
 1 file changed, 20 insertions(+), 4 deletions(-)

diff --git a/System/FilePath/Internal.hs b/System/FilePath/Internal.hs
index 5b3cfa2b..0c92b3e0 100644
--- a/System/FilePath/Internal.hs
+++ b/System/FilePath/Internal.hs
@@ -129,8 +129,8 @@ import Data.List(stripPrefix, isSuffixOf, uncons, dropWhileEnd)
 #define STRING String
 #define FILEPATH FilePath
 #else
-import Prelude (fromIntegral)
-import Control.Exception ( SomeException, evaluate, try, displayException )
+import Prelude (fromIntegral, return, IO, Either(..))
+import Control.Exception ( catch, displayException, evaluate, fromException, toException, throwIO, Exception, SomeAsyncException(..), SomeException )
 import Control.DeepSeq (force)
 import GHC.IO (unsafePerformIO)
 import qualified Data.Char as C
@@ -1270,15 +1270,31 @@ snoc :: String -> Char -> String
 snoc str = \c -> str <> [c]
 
 #else
+-- | Like 'try', but rethrows async exceptions.
+trySafe :: Exception e => IO a -> IO (Either e a)
+trySafe ioA = catch action eHandler
+ where
+  action = do
+    v <- ioA
+    return (Right v)
+  eHandler e
+    | isAsyncException e = throwIO e
+    | otherwise = return (Left e)
+
+isAsyncException :: Exception e => e -> Bool
+isAsyncException e =
+    case fromException (toException e) of
+        Just (SomeAsyncException _) -> True
+        Nothing -> False
 #ifdef WINDOWS
 fromString :: P.String -> STRING
 fromString str = P.either (P.error . P.show) P.id $ unsafePerformIO $ do
-  r <- try @SomeException $ GHC.withCStringLen (mkUTF16le ErrorOnCodingFailure) str $ \cstr -> packCStringLen cstr
+  r <- trySafe @SomeException $ GHC.withCStringLen (mkUTF16le ErrorOnCodingFailure) str $ \cstr -> packCStringLen cstr
   evaluate $ force $ first displayException r
 #else
 fromString :: P.String -> STRING
 fromString str = P.either (P.error . P.show) P.id $ unsafePerformIO $ do
-  r <- try @SomeException $ GHC.withCStringLen (mkUTF8 ErrorOnCodingFailure) str $ \cstr -> packCStringLen cstr
+  r <- trySafe @SomeException $ GHC.withCStringLen (mkUTF8 ErrorOnCodingFailure) str $ \cstr -> packCStringLen cstr
   evaluate $ force $ first displayException r
 #endif