Merge branch '1.4.1XX-no-async' into 1.4.1XX

System/FilePath/Internal.hs

@@ -130,9 +130,10 @@ import Data.List(stripPrefix, isSuffixOf, uncons, dropWhileEnd)
 #define FILEPATH FilePath
 #else
 import Prelude (fromIntegral)
-import Control.Exception ( SomeException, evaluate, try, displayException )
+import Control.Exception ( SomeException, evaluate, displayException )
 import Control.DeepSeq (force)
 import GHC.IO (unsafePerformIO)
+import System.OsPath.Encoding.Internal (trySafe)
 import qualified Data.Char as C
 #ifdef WINDOWS
 import GHC.IO.Encoding.Failure ( CodingFailureMode(..) )
@@ -1273,12 +1274,12 @@ snoc str = \c -> str <> [c]
 #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
 

System/OsPath/Encoding/Internal.hs

@@ -19,7 +19,7 @@ import GHC.IO.Buffer
 import GHC.IO.Encoding.Failure
 import GHC.IO.Encoding.Types
 import Data.Bits
-import Control.Exception (SomeException, try, Exception (displayException), evaluate)
+import Control.Exception (SomeException, SomeAsyncException(..), Exception (displayException), evaluate, catch, throwIO, toException, fromException)
 import qualified GHC.Foreign as GHC
 import Data.Either (Either)
 import GHC.IO (unsafePerformIO)
@@ -31,7 +31,7 @@ import Numeric (showHex)
 import Foreign.C (CStringLen)
 import Data.Char (chr)
 import Foreign
-import Prelude (FilePath)
+import Prelude (FilePath, Either(..))
 import GHC.IO.Encoding (getFileSystemEncoding)
 
 -- -----------------------------------------------------------------------------
@@ -277,13 +277,13 @@ peekFilePathPosix fp = getFileSystemEncoding >>= \enc -> GHC.peekCStringLen enc
 -- | Decode with the given 'TextEncoding'.
 decodeWithTE :: TextEncoding -> BS8.ShortByteString -> Either EncodingException String
 decodeWithTE enc ba = unsafePerformIO $ do
-  r <- try @SomeException $ BS8.useAsCStringLen ba $ \fp -> GHC.peekCStringLen enc fp
+  r <- trySafe @SomeException $ BS8.useAsCStringLen ba $ \fp -> GHC.peekCStringLen enc fp
   evaluate $ force $ first (flip EncodingError Nothing . displayException) r
 
 -- | Encode with the given 'TextEncoding'.
 encodeWithTE :: TextEncoding -> String -> Either EncodingException BS8.ShortByteString
 encodeWithTE enc str = unsafePerformIO $ do
-  r <- try @SomeException $ GHC.withCStringLen enc str $ \cstr -> BS8.packCStringLen cstr
+  r <- trySafe @SomeException $ GHC.withCStringLen enc str $ \cstr -> BS8.packCStringLen cstr
   evaluate $ force $ first (flip EncodingError Nothing . displayException) r
 
 -- -----------------------------------------------------------------------------
@@ -347,3 +347,25 @@ instance NFData EncodingException where
 
 wNUL :: Word16
 wNUL = 0x00
+
+-- -----------------------------------------------------------------------------
+-- Exceptions
+--
+
+-- | 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
+

System/OsString/Common.hs

@@ -60,7 +60,7 @@ import Control.Monad.Catch
 import Data.ByteString.Internal
     ( ByteString )
 import Control.Exception
-    ( SomeException, try, displayException )
+    ( SomeException, displayException )
 import Control.DeepSeq ( force )
 import Data.Bifunctor ( first )
 import GHC.IO
@@ -73,6 +73,7 @@ import Language.Haskell.TH.Syntax
 
 
 import GHC.IO.Encoding.Failure ( CodingFailureMode(..) )
+import System.OsPath.Encoding.Internal (trySafe)
 #ifdef WINDOWS
 import System.OsPath.Encoding
 import System.IO
@@ -116,10 +117,10 @@ encodeWith :: TextEncoding
            -> Either EncodingException PLATFORM_STRING
 encodeWith enc str = unsafePerformIO $ do
 #ifdef WINDOWS
-  r <- try @SomeException $ GHC.withCStringLen enc str $ \cstr -> WindowsString <$> BS8.packCStringLen cstr
+  r <- trySafe @SomeException $ GHC.withCStringLen enc str $ \cstr -> WindowsString <$> BS8.packCStringLen cstr
   evaluate $ force $ first (flip EncodingError Nothing . displayException) r
 #else
-  r <- try @SomeException $ GHC.withCStringLen enc str $ \cstr -> PosixString <$> BS.packCStringLen cstr
+  r <- trySafe @SomeException $ GHC.withCStringLen enc str $ \cstr -> PosixString <$> BS.packCStringLen cstr
   evaluate $ force $ first (flip EncodingError Nothing . displayException) r
 #endif
 
@@ -176,7 +177,7 @@ decodeWith :: TextEncoding
            -> PLATFORM_STRING
            -> Either EncodingException String
 decodeWith winEnc (WindowsString ba) = unsafePerformIO $ do
-  r <- try @SomeException $ BS8.useAsCStringLen ba $ \fp -> GHC.peekCStringLen winEnc fp
+  r <- trySafe @SomeException $ BS8.useAsCStringLen ba $ \fp -> GHC.peekCStringLen winEnc fp
   evaluate $ force $ first (flip EncodingError Nothing . displayException) r
 #else
 -- | Decode a 'PosixString' with the specified encoding.
@@ -186,7 +187,7 @@ decodeWith :: TextEncoding
        -> PLATFORM_STRING
        -> Either EncodingException String
 decodeWith unixEnc (PosixString ba) = unsafePerformIO $ do
-  r <- try @SomeException $ BS.useAsCStringLen ba $ \fp -> GHC.peekCStringLen unixEnc fp
+  r <- trySafe @SomeException $ BS.useAsCStringLen ba $ \fp -> GHC.peekCStringLen unixEnc fp
   evaluate $ force $ first (flip EncodingError Nothing . displayException) r
 #endif
 

changelog.md

@@ -2,7 +2,11 @@
 
 _Note: below all `FilePath` values are unquoted, so `\\` really means two backslashes._
 
-## 1.4.101.0. *Jan 2024*
+## 1.4.102.0 *Nov 2024*
+
+* Don't catch async exceptions in internal functions wrt https://github.com/haskell/os-string/issues/22
+
+## 1.4.101.0 *Jan 2024*
 
 * Backport bugfix for [`splitFileName`](https://github.com/haskell/filepath/issues/219) on windows
 

filepath.cabal

@@ -1,6 +1,6 @@
 cabal-version:      2.2
 name:               filepath
-version:            1.4.101.0
+version:            1.4.102.0
 
 -- NOTE: Don't forget to update ./changelog.md
 license:            BSD-3-Clause