diff --git a/System/FilePath/Internal.hs b/System/FilePath/Internal.hs index df454328..e55840a1 100644 --- a/System/FilePath/Internal.hs +++ b/System/FilePath/Internal.hs @@ -1,5 +1,6 @@ {-# LANGUAGE PatternGuards #-} {-# LANGUAGE TypeApplications #-} +{-# LANGUAGE MultiWayIf #-} -- This template expects CPP definitions for: -- MODULE_NAME = Posix | Windows @@ -602,6 +603,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 +646,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 a5bca439..15d4359f 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.101.0. *Jan 2024* + +* Backport bugfix for [`splitFileName`](https://github.com/haskell/filepath/issues/219) on windows + ## 1.4.100.4 *Jul 2023* * Fix isInfixOf and breakSubString in Word16, wrt [#195](https://github.com/haskell/filepath/issues/195) diff --git a/filepath.cabal b/filepath.cabal index c3b76370..6794957f 100644 --- a/filepath.cabal +++ b/filepath.cabal @@ -1,6 +1,6 @@ cabal-version: 2.2 name: filepath -version: 1.4.100.4 +version: 1.4.101.0 -- 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..396c08e3 100755 --- a/tests/filepath-tests/TestGen.hs +++ b/tests/filepath-tests/TestGen.hs @@ -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"))