diff --git a/System/Posix/ByteString/FilePath.hsc b/System/Posix/ByteString/FilePath.hsc index 1e49546ed722c415504434d04df167e22e3366c1..3eecc1d3f10698f7d694e417b8abe258c7015407 100644 --- a/System/Posix/ByteString/FilePath.hsc +++ b/System/Posix/ByteString/FilePath.hsc @@ -1,4 +1,5 @@ {-# LANGUAGE Safe #-} +{-# LANGUAGE TypeApplications #-} ----------------------------------------------------------------------------- -- | @@ -39,7 +40,10 @@ import Foreign.C hiding ( throwErrnoPathIfMinus1_ ) import Control.Monad -import Data.ByteString +import Control.Exception +import GHC.Foreign as GHC ( peekCStringLen ) +import GHC.IO.Encoding ( getFileSystemEncoding ) +import Data.ByteString as B import Data.ByteString.Char8 as BC import Prelude hiding (FilePath) #if !MIN_VERSION_base(4, 11, 0) @@ -91,7 +95,8 @@ throwErrnoPath :: String -> RawFilePath -> IO a throwErrnoPath loc path = do errno <- getErrno - ioError (errnoToIOError loc errno Nothing (Just (BC.unpack path))) + path' <- either (const (BC.unpack path)) id <$> try @IOException (decodeWithBasePosix path) + ioError (errnoToIOError loc errno Nothing (Just path')) -- | as 'throwErrnoIf', but exceptions include the given path when -- appropriate. @@ -129,5 +134,16 @@ throwErrnoPathIfMinus1_ = throwErrnoPathIf_ (== -1) -- | as 'throwErrnoTwoPathsIfMinus1_', but exceptions include two paths when appropriate. -- throwErrnoTwoPathsIfMinus1_ :: (Eq a, Num a) => String -> RawFilePath -> RawFilePath -> IO a -> IO () -throwErrnoTwoPathsIfMinus1_ loc path1 path2 = - throwErrnoIfMinus1_ (loc <> " '" <> BC.unpack path1 <> "' to '" <> BC.unpack path2 <> "'") +throwErrnoTwoPathsIfMinus1_ loc path1 path2 action = do + path1' <- either (const (BC.unpack path1)) id <$> try @IOException (decodeWithBasePosix path1) + path2' <- either (const (BC.unpack path2)) id <$> try @IOException (decodeWithBasePosix path2) + throwErrnoIfMinus1_ (loc <> " '" <> path1' <> "' to '" <> path2' <> "'") action + +-- | This mimics the filepath decoder base uses on unix, +-- with the small distinction that we're not truncating at NUL bytes (because we're not at +-- the outer FFI layer). +decodeWithBasePosix :: RawFilePath -> IO String +decodeWithBasePosix ba = B.useAsCStringLen ba $ \fp -> peekFilePathPosix fp + where + peekFilePathPosix :: CStringLen -> IO String + peekFilePathPosix fp = getFileSystemEncoding >>= \enc -> GHC.peekCStringLen enc fp diff --git a/System/Posix/PosixPath/FilePath.hsc b/System/Posix/PosixPath/FilePath.hsc index 0ce2c7ea37efb322e4511af6470a6fbe3c183d3d..8bba2b611d02e5452ec9794e4a7d4a9581041ed5 100644 --- a/System/Posix/PosixPath/FilePath.hsc +++ b/System/Posix/PosixPath/FilePath.hsc @@ -1,4 +1,5 @@ {-# LANGUAGE CPP #-} +{-# LANGUAGE TypeApplications #-} ----------------------------------------------------------------------------- -- | @@ -40,12 +41,12 @@ import Foreign.C hiding ( import System.OsPath.Types import Control.Monad -import GHC.IO.Encoding.UTF8 ( mkUTF8 ) -import GHC.IO.Encoding.Failure ( CodingFailureMode(..) ) -import System.OsPath.Posix +import Control.Exception +import System.OsPath.Posix as PS import System.OsPath.Data.ByteString.Short import Prelude hiding (FilePath) import System.OsString.Internal.Types (PosixString(..)) + #if !MIN_VERSION_base(4, 11, 0) import Data.Monoid ((<>)) #endif @@ -93,7 +94,8 @@ throwErrnoPath :: String -> PosixPath -> IO a throwErrnoPath loc path = do errno <- getErrno - ioError (errnoToIOError loc errno Nothing (Just (_toStr path))) + path' <- either (const (_toStr path)) id <$> try @IOException (PS.decodeFS path) + ioError (errnoToIOError loc errno Nothing (Just path')) -- | as 'throwErrnoIf', but exceptions include the given path when -- appropriate. @@ -131,10 +133,10 @@ throwErrnoPathIfMinus1_ = throwErrnoPathIf_ (== -1) -- | as 'throwErrnoTwoPathsIfMinus1_', but exceptions include two paths when appropriate. -- throwErrnoTwoPathsIfMinus1_ :: (Eq a, Num a) => String -> PosixPath -> PosixPath -> IO a -> IO () -throwErrnoTwoPathsIfMinus1_ loc path1 path2 = - throwErrnoIfMinus1_ (loc <> " '" <> _toStr path1 <> "' to '" <> _toStr path2 <> "'") - +throwErrnoTwoPathsIfMinus1_ loc path1 path2 action = do + path1' <- either (const (_toStr path1)) id <$> try @IOException (PS.decodeFS path1) + path2' <- either (const (_toStr path2)) id <$> try @IOException (PS.decodeFS path2) + throwErrnoIfMinus1_ (loc <> " '" <> path1' <> "' to '" <> path2' <> "'") action _toStr :: PosixPath -> String -_toStr fp = either (error . show) id $ decodeWith (mkUTF8 TransliterateCodingFailure) fp - +_toStr = fmap PS.toChar . PS.unpack