Skip to content

Use decodeFS for ioe_filename #289

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 1 commit into from
Jul 21, 2023
Merged

Use decodeFS for ioe_filename #289

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
24 changes: 20 additions & 4 deletions System/Posix/ByteString/FilePath.hsc
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,4 +1,5 @@
{-# LANGUAGE Safe #-}
{-# LANGUAGE TypeApplications #-}

-----------------------------------------------------------------------------
-- |
Expand Down Expand Up @@ -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)
Expand Down Expand Up @@ -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.
Expand Down Expand Up @@ -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
20 changes: 11 additions & 9 deletions System/Posix/PosixPath/FilePath.hsc
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,4 +1,5 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE TypeApplications #-}

-----------------------------------------------------------------------------
-- |
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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.
Expand Down Expand Up @@ -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