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 1/2] 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
 

From 5c68a4473d06b58cca28b9c43068173f67612b36 Mon Sep 17 00:00:00 2001
From: Julian Ospald <hasufell@posteo.de>
Date: Fri, 15 Nov 2024 12:53:55 +0800
Subject: [PATCH 2/2] Bump to 1.5.4.0

---
 changelog.md   | 4 ++++
 filepath.cabal | 2 +-
 2 files changed, 5 insertions(+), 1 deletion(-)

diff --git a/changelog.md b/changelog.md
index fea188c1..08202f3e 100644
--- a/changelog.md
+++ b/changelog.md
@@ -2,6 +2,10 @@
 
 _Note: below all `FilePath` values are unquoted, so `\\` really means two backslashes._
 
+## 1.5.4.0 *Nov 2024*
+
+* Don't catch async exceptions in internal functions wrt https://github.com/haskell/os-string/issues/22
+
 ## 1.5.3.0 *Jun 2024*
 
 * Adjust for `encodeFS`/`decodedFS` deprecation in os-string
diff --git a/filepath.cabal b/filepath.cabal
index cee80805..196f208b 100644
--- a/filepath.cabal
+++ b/filepath.cabal
@@ -1,6 +1,6 @@
 cabal-version:      2.2
 name:               filepath
-version:            1.5.3.0
+version:            1.5.4.0
 
 -- NOTE: Don't forget to update ./changelog.md
 license:            BSD-3-Clause