From 0af7a24b89ca963e54c79998f1c6ccbd272943e9 Mon Sep 17 00:00:00 2001 From: Julian Ospald Date: Tue, 30 Jan 2024 14:53:31 +0800 Subject: [PATCH] Backport bugfix for splitFileName on windows Wrt #219 --- System/FilePath/Internal.hs | 44 +++++++++++++++++++++++++-------- changelog.md | 4 +++ filepath.cabal | 2 +- tests/filepath-tests/TestGen.hs | 10 +++++--- 4 files changed, 45 insertions(+), 15 deletions(-) diff --git a/System/FilePath/Internal.hs b/System/FilePath/Internal.hs index 7ad9f301..36e93fbb 100644 --- a/System/FilePath/Internal.hs +++ b/System/FilePath/Internal.hs @@ -602,6 +602,7 @@ isDrive x = not (null x) && null (dropDrive x) -- > Posix: splitFileName "/" == ("/","") -- > Windows: splitFileName "c:" == ("c:","") -- > Windows: splitFileName "\\\\?\\A:\\fred" == ("\\\\?\\A:\\","fred") +-- > Windows: splitFileName "\\\\?\\A:" == ("\\\\?\\A:","") splitFileName :: FILEPATH -> (STRING, STRING) splitFileName x = if null path then (dotSlash, file) @@ -644,20 +645,43 @@ splitFileName_ fp -- or UNC location "\\?\UNC\foo", where path separator is a part of the drive name. -- We can test this by trying dropDrive and falling back to splitDrive. | isWindows - , Just (s1, _s2, bs') <- uncons2 dirSlash - , isPathSeparator s1 - -- If bs' is empty, then s2 as the last character of dirSlash must be a path separator, - -- so we are in the middle of shared drive. - -- Otherwise, since s1 is a path separator, we might be in the middle of UNC path. - , null bs' || maybe False isIncompleteUNC (readDriveUNC dirSlash) - = (fp, mempty) + = case uncons2 dirSlash of + Just (s1, s2, bs') + | isPathSeparator s1 + -- If bs' is empty, then s2 as the last character of dirSlash must be a path separator, + -- so we are in the middle of shared drive. + -- Otherwise, since s1 is a path separator, we might be in the middle of UNC path. + , null bs' || maybe False isIncompleteUNC (readDriveUNC dirSlash) + -> (fp, mempty) + -- This handles inputs like "//?/A:" and "//?/A:foo" + | isPathSeparator s1 + , isPathSeparator s2 + , Just (s3, s4, bs'') <- uncons2 bs' + , s3 == _question + , isPathSeparator s4 + , null bs'' + , Just (drive, rest) <- readDriveLetter file + -> (dirSlash <> drive, rest) + _ -> (dirSlash, file) | otherwise - = (dirSlash, file) + = (dirSlash, file) where (dirSlash, file) = breakEnd isPathSeparator fp - + dropExcessTrailingPathSeparators x + | hasTrailingPathSeparator x + , let x' = dropWhileEnd isPathSeparator x + , otherwise = if | null x' -> singleton (last x) + | otherwise -> addTrailingPathSeparator x' + | otherwise = x + + -- an "incomplete" UNC is one without a path (but potentially a drive) isIncompleteUNC (pref, suff) = null suff && not (hasPenultimateColon pref) - hasPenultimateColon = maybe False (maybe False ((== _colon) . snd) . unsnoc . fst) . unsnoc + + -- e.g. @//?/a:/@ or @//?/a://@, but not @//?/a:@ + hasPenultimateColon pref + | hasTrailingPathSeparator pref + = maybe False (maybe False ((== _colon) . snd) . unsnoc . fst) . unsnoc . dropExcessTrailingPathSeparators $ pref + | otherwise = False -- | Set the filename. -- diff --git a/changelog.md b/changelog.md index c18bdb08..8afb0376 100644 --- a/changelog.md +++ b/changelog.md @@ -2,6 +2,10 @@ _Note: below all `FilePath` values are unquoted, so `\\` really means two backslashes._ +## 1.4.300.0. *Jan 2024* + +* Backport bugfix for [`splitFileName`](https://github.com/haskell/filepath/issues/219) on windows + ## 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 231f788d..e6f38565 100644 --- a/filepath.cabal +++ b/filepath.cabal @@ -1,6 +1,6 @@ cabal-version: 2.2 name: filepath -version: 1.4.200.1 +version: 1.4.300.1 -- NOTE: Don't forget to update ./changelog.md license: BSD-3-Clause diff --git a/tests/filepath-tests/TestGen.hs b/tests/filepath-tests/TestGen.hs index 2075e7f0..a68490b2 100755 --- a/tests/filepath-tests/TestGen.hs +++ b/tests/filepath-tests/TestGen.hs @@ -14,11 +14,11 @@ import Data.String import GHC.IO.Encoding.Failure ( CodingFailureMode(..) ) import GHC.IO.Encoding.UTF16 ( mkUTF16le ) import GHC.IO.Encoding.UTF8 ( mkUTF8 ) -import System.OsString.Internal.Types -import System.OsPath.Encoding.Internal +import System.OsString.Internal.Types.Hidden +import System.OsPath.Encoding.Internal.Hidden import qualified Data.Char as C -import qualified System.OsPath.Data.ByteString.Short as SBS -import qualified System.OsPath.Data.ByteString.Short.Word16 as SBS16 +import qualified System.OsPath.Data.ByteString.Short.Hidden as SBS +import qualified System.OsPath.Data.ByteString.Short.Word16.Hidden as SBS16 import qualified System.FilePath.Windows as W import qualified System.FilePath.Posix as P import qualified System.OsPath.Windows as AFP_W @@ -458,6 +458,8 @@ tests = ,("AFP_W.splitFileName (\"c:\") == ((\"c:\"), (\"\"))", property $ AFP_W.splitFileName ("c:") == (("c:"), (""))) ,("W.splitFileName \"\\\\\\\\?\\\\A:\\\\fred\" == (\"\\\\\\\\?\\\\A:\\\\\", \"fred\")", property $ W.splitFileName "\\\\?\\A:\\fred" == ("\\\\?\\A:\\", "fred")) ,("AFP_W.splitFileName (\"\\\\\\\\?\\\\A:\\\\fred\") == ((\"\\\\\\\\?\\\\A:\\\\\"), (\"fred\"))", property $ AFP_W.splitFileName ("\\\\?\\A:\\fred") == (("\\\\?\\A:\\"), ("fred"))) + ,("W.splitFileName \"\\\\\\\\?\\\\A:\" == (\"\\\\\\\\?\\\\A:\", \"\")", property $ W.splitFileName "\\\\?\\A:" == ("\\\\?\\A:", "")) + ,("AFP_W.splitFileName (\"\\\\\\\\?\\\\A:\") == ((\"\\\\\\\\?\\\\A:\"), (\"\"))", property $ AFP_W.splitFileName ("\\\\?\\A:") == (("\\\\?\\A:"), (""))) ,("P.replaceFileName \"/directory/other.txt\" \"file.ext\" == \"/directory/file.ext\"", property $ P.replaceFileName "/directory/other.txt" "file.ext" == "/directory/file.ext") ,("W.replaceFileName \"/directory/other.txt\" \"file.ext\" == \"/directory/file.ext\"", property $ W.replaceFileName "/directory/other.txt" "file.ext" == "/directory/file.ext") ,("AFP_P.replaceFileName (\"/directory/other.txt\") (\"file.ext\") == (\"/directory/file.ext\")", property $ AFP_P.replaceFileName ("/directory/other.txt") ("file.ext") == ("/directory/file.ext"))