Skip to content
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

Jump to bottom

Fix W.splitFileName "/\\?/a:" #220

Merged
merged 5 commits into from
Jan 26, 2024
Merged

Fix W.splitFileName "/\\?/a:" #220

Show file tree
Hide file tree
Changes from 2 commits
Commits
Show all changes
5 commits
Select commit Hold shift + click to select a range
399df96
Add more tests on splitFileName and dropFileName
Bodigrim Jan 21, 2024
c394803
Fix regression of splitFileName on '//?/A:'
Bodigrim Jan 21, 2024
67a45a4
Improve equivalence tests
hasufell Jan 24, 2024
0530486
Fix AltShow Maybe instance
hasufell Jan 24, 2024
74713b9
Truly fix splitFileName on windows
hasufell Jan 25, 2024
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
29 changes: 21 additions & 8 deletions System/FilePath/Internal.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down Expand Up @@ -644,15 +645,26 @@ 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"
Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Trivia: //?/A:foo is actually invalid in some sense... it's hard to interpret it. UNC paths are absolute, but A:foo on its own is a relative directory (relative to current working dir on drive A). The windows API probably won't care, but no such file can ever exist, I think.

Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

True, but filepath-1.4.2.2 does not mind to process //?/A:foo even if it's complete nonsense.

| isPathSeparator s1
, isPathSeparator s2
, Just (s3, s4, bs'') <- uncons2 bs'
, s3 == _question
Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Note that this is in fact a bug (although the old filepath behaves the same way):

ghci> System.FilePath.Windows.splitFileName "\\\\.\\a:foo"
("\\\\.\\","a:foo")

There are three UNC namespaces:

  • file namespace: //?/
  • device namespace: //./
  • NT namespace /??/

I'm still unsure whether fixing those bugs will cause more good than harm, but those are bugs.

, isPathSeparator s4
, null bs''
, Just (drive, rest) <- readDriveLetter file
-> (dirSlash <> drive, rest)
_ -> (dirSlash, file)
Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I think this line is redundant? I'tll fall through to | otherwise, no?

Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Unfortunately it does not fall through, the line is required.

Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Oops, I misread the code.

| otherwise
= (dirSlash, file)
= (dirSlash, file)
where
(dirSlash, file) = breakEnd isPathSeparator fp

Expand All @@ -671,6 +683,7 @@ replaceFileName x y = a </> y where (a,_) = splitFileName_ x
--
-- > dropFileName "/directory/file.ext" == "/directory/"
-- > dropFileName x == fst (splitFileName x)
-- > isPrefixOf (takeDrive x) (dropFileName x)
dropFileName :: FILEPATH -> FILEPATH
dropFileName = fst . splitFileName

Expand Down
6 changes: 6 additions & 0 deletions tests/filepath-tests/TestGen.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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"))
Expand All @@ -474,6 +476,10 @@ tests =
,("W.dropFileName x == fst (W.splitFileName x)", property $ \(QFilePath x) -> W.dropFileName x == fst (W.splitFileName x))
,("AFP_P.dropFileName x == fst (AFP_P.splitFileName x)", property $ \(QFilePathAFP_P x) -> AFP_P.dropFileName x == fst (AFP_P.splitFileName x))
,("AFP_W.dropFileName x == fst (AFP_W.splitFileName x)", property $ \(QFilePathAFP_W x) -> AFP_W.dropFileName x == fst (AFP_W.splitFileName x))
,("isPrefixOf (P.takeDrive x) (P.dropFileName x)", property $ \(QFilePath x) -> isPrefixOf (P.takeDrive x) (P.dropFileName x))
,("isPrefixOf (W.takeDrive x) (W.dropFileName x)", property $ \(QFilePath x) -> isPrefixOf (W.takeDrive x) (W.dropFileName x))
,("(\\(getPosixString -> x) (getPosixString -> y) -> SBS.isPrefixOf x y) (AFP_P.takeDrive x) (AFP_P.dropFileName x)", property $ \(QFilePathAFP_P x) -> (\(getPosixString -> x) (getPosixString -> y) -> SBS.isPrefixOf x y) (AFP_P.takeDrive x) (AFP_P.dropFileName x))
,("(\\(getWindowsString -> x) (getWindowsString -> y) -> SBS16.isPrefixOf x y) (AFP_W.takeDrive x) (AFP_W.dropFileName x)", property $ \(QFilePathAFP_W x) -> (\(getWindowsString -> x) (getWindowsString -> y) -> SBS16.isPrefixOf x y) (AFP_W.takeDrive x) (AFP_W.dropFileName x))
,("P.takeFileName \"/directory/file.ext\" == \"file.ext\"", property $ P.takeFileName "/directory/file.ext" == "file.ext")
,("W.takeFileName \"/directory/file.ext\" == \"file.ext\"", property $ W.takeFileName "/directory/file.ext" == "file.ext")
,("AFP_P.takeFileName (\"/directory/file.ext\") == (\"file.ext\")", property $ AFP_P.takeFileName ("/directory/file.ext") == ("file.ext"))
Expand Down