diff --git a/System/FilePath/Internal.hs b/System/FilePath/Internal.hs index dcb45256..d786b5c4 100644 --- a/System/FilePath/Internal.hs +++ b/System/FilePath/Internal.hs @@ -129,8 +129,9 @@ import Data.List(stripPrefix, isSuffixOf, uncons, dropWhileEnd) #define STRING String #define FILEPATH FilePath #else +import System.OsPath.Encoding.Internal.Hidden ( trySafe ) 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 qualified Data.Char as C @@ -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 diff --git a/System/OsPath/Encoding/Internal/Hidden.hs b/System/OsPath/Encoding/Internal/Hidden.hs index e9aec3ba..04455ce9 100644 --- a/System/OsPath/Encoding/Internal/Hidden.hs +++ b/System/OsPath/Encoding/Internal/Hidden.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, try, Exception (displayException), evaluate, SomeAsyncException(..), catch, fromException, toException, throwIO) 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,24 @@ 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 diff --git a/System/OsString/Common.hs b/System/OsString/Common.hs index c4b656f0..368cd111 100644 --- a/System/OsString/Common.hs +++ b/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 @@ -70,7 +70,7 @@ import Language.Haskell.TH.Quote ( QuasiQuoter (..) ) import Language.Haskell.TH.Syntax ( Lift (..), lift ) - +import System.OsPath.Encoding.Internal.Hidden ( trySafe ) import GHC.IO.Encoding.Failure ( CodingFailureMode(..) ) #ifdef WINDOWS @@ -116,10 +116,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 +176,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 +186,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 diff --git a/changelog.md b/changelog.md index 8dbb9f4d..45c55d27 100644 --- a/changelog.md +++ b/changelog.md @@ -2,11 +2,19 @@ _Note: below all `FilePath` values are unquoted, so `\\` really means two backslashes._ -## 1.4.300.1. *Jan 2024* +## 1.4.301.0 *Nov 2024* + +* Don't catch async exceptions in internal functions wrt https://github.com/haskell/os-string/issues/22 + +## 1.4.300.2 *Apr 2024* + +* Fix compabitiliby with GHC 9.10 + +## 1.4.300.1 *Jan 2024* * Backport bugfix for [`splitFileName`](https://github.com/haskell/filepath/issues/219) on windows -## 1.4.200.1. *Dec 2023* +## 1.4.200.1 *Dec 2023* * Improve deprecation warnings wrt [#209](https://github.com/haskell/filepath/issues/209) diff --git a/filepath.cabal b/filepath.cabal index e6f38565..74c5820b 100644 --- a/filepath.cabal +++ b/filepath.cabal @@ -1,6 +1,6 @@ cabal-version: 2.2 name: filepath -version: 1.4.300.1 +version: 1.4.301.0 -- NOTE: Don't forget to update ./changelog.md license: BSD-3-Clause @@ -113,7 +113,7 @@ library default-language: Haskell2010 build-depends: - , base >=4.9 && <4.20 + , base >=4.9 && <4.21 , bytestring >=0.11.3.0 , deepseq , exceptions diff --git a/tests/abstract-filepath/EncodingSpec.hs b/tests/abstract-filepath/EncodingSpec.hs index 1a0c3ac3..ad343eab 100644 --- a/tests/abstract-filepath/EncodingSpec.hs +++ b/tests/abstract-filepath/EncodingSpec.hs @@ -39,7 +39,9 @@ tests = let str = [toEnum 55296, toEnum 55297] encoded = encodeWithTE utf16le str decoded = decodeWithTE utf16le =<< encoded -#if __GLASGOW_HASKELL__ >= 904 +#if __GLASGOW_HASKELL__ >= 910 + in decoded === Left (EncodingError ("recoverEncode: invalid argument (cannot encode character " <> show (head str) <> ")\n") Nothing)) +#elif __GLASGOW_HASKELL__ >= 904 in decoded === Left (EncodingError ("recoverEncode: invalid argument (cannot encode character " <> show (head str) <> ")") Nothing)) #else in decoded === Left (EncodingError "recoverEncode: invalid argument (invalid character)" Nothing)) @@ -69,7 +71,9 @@ tests = let str = [toEnum 0xDFF0, toEnum 0xDFF2] encoded = encodeWithTE (mkUTF8 RoundtripFailure) str decoded = decodeWithTE (mkUTF8 RoundtripFailure) =<< encoded -#if __GLASGOW_HASKELL__ >= 904 +#if __GLASGOW_HASKELL__ >= 910 + in decoded === Left (EncodingError ("recoverEncode: invalid argument (cannot encode character " <> show (head str) <> ")\n") Nothing)) +#elif __GLASGOW_HASKELL__ >= 904 in decoded === Left (EncodingError ("recoverEncode: invalid argument (cannot encode character " <> show (head str) <> ")") Nothing)) #else in decoded === Left (EncodingError "recoverEncode: invalid argument (invalid character)" Nothing)) diff --git a/tests/bytestring-tests/Properties/Common.hs b/tests/bytestring-tests/Properties/Common.hs index c5ef566a..31c1254a 100644 --- a/tests/bytestring-tests/Properties/Common.hs +++ b/tests/bytestring-tests/Properties/Common.hs @@ -33,7 +33,7 @@ import Data.Word import Control.Arrow import Data.Foldable -import Data.List as L +import Data.List as L hiding (unsnoc) import Data.Semigroup import Data.Tuple import Test.QuickCheck