Merge branch 'issue-22'

Author: hasufell

System/OsString/Common.hs

@@ -143,7 +143,7 @@ module System.OsString.MODULE_NAME
 where
 
 
-
+import System.OsString.Internal.Exception
 import System.OsString.Internal.Types (
 #ifdef WINDOWS
   WindowsString(..), WindowsChar(..)
@@ -236,15 +236,15 @@ encodeWith :: TextEncoding  -- ^ text encoding (wide char)
            -> String
            -> Either EncodingException PLATFORM_STRING
 encodeWith enc str = unsafePerformIO $ do
-  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
 -- | Encode a 'String' with the specified encoding.
 encodeWith :: TextEncoding
            -> String
            -> Either EncodingException PLATFORM_STRING
 encodeWith enc str = unsafePerformIO $ do
-  r <- try @SomeException $ GHC.withCStringLen enc str $ \cstr -> PosixString <$> BSP.packCStringLen cstr
+  r <- trySafe @SomeException $ GHC.withCStringLen enc str $ \cstr -> PosixString <$> BSP.packCStringLen cstr
   evaluate $ force $ first (flip EncodingError Nothing . displayException) r
 #endif
 
@@ -340,7 +340,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.
@@ -350,7 +350,7 @@ decodeWith :: TextEncoding
        -> PLATFORM_STRING
        -> Either EncodingException String
 decodeWith unixEnc (PosixString ba) = unsafePerformIO $ do
-  r <- try @SomeException $ BSP.useAsCStringLen ba $ \fp -> GHC.peekCStringLen unixEnc fp
+  r <- trySafe @SomeException $ BSP.useAsCStringLen ba $ \fp -> GHC.peekCStringLen unixEnc fp
   evaluate $ force $ first (flip EncodingError Nothing . displayException) r
 #endif
 

System/OsString/Encoding/Internal.hs

@@ -10,6 +10,7 @@ module System.OsString.Encoding.Internal where
 
 import qualified System.OsString.Data.ByteString.Short as BS8
 import qualified System.OsString.Data.ByteString.Short.Word16 as BS16
+import System.OsString.Internal.Exception
 
 import GHC.Base
 import GHC.Real
@@ -282,13 +283,13 @@ peekPosixString' fp = getLocaleEncoding >>= \enc -> GHC.peekCStringLen enc fp
 -- | 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
 
 -- -----------------------------------------------------------------------------

System/OsString/Internal/Exception.hs

@@ -0,0 +1,20 @@
+module System.OsString.Internal.Exception where
+
+import Control.Exception ( catch, fromException, toException, throwIO, Exception, SomeAsyncException(..) )
+
+-- | 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

os-string.cabal

@@ -50,6 +50,7 @@ library
     System.OsString.Encoding.Internal
     System.OsString
     System.OsString.Internal
+    System.OsString.Internal.Exception
     System.OsString.Internal.Types
     System.OsString.Posix
     System.OsString.Windows

tests/encoding/EncodingSpec.hs

@@ -14,6 +14,7 @@ import Test.QuickCheck
 import Data.Either ( isRight )
 import qualified System.OsString.Data.ByteString.Short as BS8
 import qualified System.OsString.Data.ByteString.Short.Word16 as BS16
+import System.OsString.Internal.Exception
 import System.OsString.Encoding.Internal
 import GHC.IO (unsafePerformIO)
 import GHC.IO.Encoding ( setFileSystemEncoding )
@@ -154,21 +155,21 @@ padEven bs
 
 decodeP' :: BS8.ShortByteString -> Either String String
 decodeP' ba = unsafePerformIO $ do
-  r <- try @SomeException $ decodeWithBasePosix ba
+  r <- trySafe @SomeException $ decodeWithBasePosix ba
   evaluate $ force $ first displayException r
 
 encodeP' :: String -> Either String BS8.ShortByteString
 encodeP' str = unsafePerformIO $ do
-  r <- try @SomeException $ encodeWithBasePosix str
+  r <- trySafe @SomeException $ encodeWithBasePosix str
   evaluate $ force $ first displayException r
 
 decodeW' :: BS16.ShortByteString -> Either String String
 decodeW' ba = unsafePerformIO $ do
-  r <- try @SomeException $ decodeWithBaseWindows ba
+  r <- trySafe @SomeException $ decodeWithBaseWindows ba
   evaluate $ force $ first displayException r
 
 encodeW' :: String -> Either String BS8.ShortByteString
 encodeW' str = unsafePerformIO $ do
-  r <- try @SomeException $ encodeWithBaseWindows str
+  r <- trySafe @SomeException $ encodeWithBaseWindows str
   evaluate $ force $ first displayException r