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

WIP: Add function stripFilePath #75

Open
wants to merge 1 commit into
base: master
Choose a base branch
from
Open

WIP: Add function stripFilePath #75

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
44 changes: 44 additions & 0 deletions System/FilePath/Internal.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -85,6 +85,7 @@ module System.FilePath.MODULE_NAME
takeDirectory, replaceDirectory,
combine, (</>),
splitPath, joinPath, splitDirectories,
stripFilePath,

-- * Drive functions
splitDrive, joinDrive,
Expand Down Expand Up @@ -827,6 +828,49 @@ makeRelative root path
takeAbs x | hasLeadingPathSeparator x && not (hasDrive x) = [pathSeparator]
takeAbs x = map (\y -> if isPathSeparator y then pathSeparator else toLower y) $ takeDrive x

-- | Strip the given directory from the filepath if and only if
-- the given directory is a prefix of the filepath.
--
-- >>> stripFilePath "app" "app/File.hs"
-- Just "File.hs"
--
-- >>> stripFilePath "src" "app/File.hs"
-- Nothing
--
-- >>> stripFilePath "src" "src-dir/File.hs"
-- Nothing
--
-- >>> stripFilePath "." "src/File.hs"
-- Just "src/File.hs"
--
-- >>> stripFilePath "app/" "./app/Lib/File.hs"
-- Just "Lib/File.hs"
--
-- >>> stripFilePath "/app/" "./app/Lib/File.hs"
-- Nothing -- Nothing since '/app/' is absolute
--
-- >>> stripFilePath "/app" "/app/Lib/File.hs"
-- Just "Lib/File.hs"
stripFilePath :: FilePath -> FilePath -> Maybe FilePath
Copy link
Member

Choose a reason for hiding this comment

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

How does this behave with windows file namespaces, such as \\?\, \\.\ and \??\. See e.g.

Copy link
Author

Choose a reason for hiding this comment

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

My apologies, my implementation is very naive since I have never needed anything like that (I personally don't even know what windows file namespaces are)

Copy link
Member

Choose a reason for hiding this comment

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

Sure... I've implemented a filepath AST and parser here: #99

That would be more strict wrt special windows filepaths. I haven't decided yet how to use this AST yet... it's pretty annoying to pattern match on it. Using just lexemes on the other hand throws away some information. If you have ideas, let me know.

stripFilePath "." fp
Copy link
Member

Choose a reason for hiding this comment

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

What about:

> stripFilePath "./." "lol"
Nothing
> stripFilePath "./" "lol"
Nothing

I can't figure out what semantics a user would expect here.

Copy link
Author

Choose a reason for hiding this comment

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

We could take rust as a precedent?

stripPrefix("lol", "./.") -> Err(StripPrefixError(()))
stripPrefix("lol", "./") -> Err(StripPrefixError(()))

Copy link
Member

Choose a reason for hiding this comment

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

Ok, so do we want MonadThrow here maybe?

Copy link
Author

Choose a reason for hiding this comment

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

That's in general a possible idea, for the whole API to have those for the case of errors.

| isRelative fp = Just fp
| otherwise = Nothing
stripFilePath dir' fp'
| Just relativeFpParts <- splitDir `stripPrefix` splitFp = Just (joinPath relativeFpParts)
Copy link
Member

Choose a reason for hiding this comment

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

the splitpath -> joinpath idiom can sometimes turn an invalid filepath into a valid one, e.g.: #12 (comment)

| otherwise = Nothing
where
dir = normalise dir'
Copy link
Member

Choose a reason for hiding this comment

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

I'm a friend of ViewPatterns for this, unless there's a reason we can't use that here

Copy link
Author

Choose a reason for hiding this comment

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

I think the whole implementation is a bit trash atm, so no reason other than trying to be as simple as possible

fp = normalise fp'

splitFp = splitPath fp
splitDir = splitPath dir

stripFilePath' (x:xs) (y:ys)
| x `equalFilePath` y = stripFilePath' xs ys
| otherwise = Nothing
stripFilePath' [] ys = Just ys
Copy link
Member

Choose a reason for hiding this comment

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

> stripFilePath "lol" "lol"
Just ""

I'm not sure whether we should allow this or not (most of the filepath API allows empty paths), but it at least warrants its own doctest line, because for some it might be unexpected.

This also means this function does not guarantee a valid filepath.

Copy link
Author

Choose a reason for hiding this comment

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

Good point!

BTW, rust has the same:

stripPrefix("lol", "lol") -> Ok("")

stripFilePath' _ [] = Nothing

-- | Normalise a file
--
-- * \/\/ outside of the drive can be made blank
Expand Down
7 changes: 7 additions & 0 deletions tests/TestGen.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -384,6 +384,13 @@ tests =
,("P.makeRelative \"/file/test\" \"/file/test/fred\" == \"fred\"", property $ P.makeRelative "/file/test" "/file/test/fred" == "fred")
,("P.makeRelative \"/file/test\" \"/file/test/fred/\" == \"fred/\"", property $ P.makeRelative "/file/test" "/file/test/fred/" == "fred/")
,("P.makeRelative \"some/path\" \"some/path/a/b/c\" == \"a/b/c\"", property $ P.makeRelative "some/path" "some/path/a/b/c" == "a/b/c")
,("P.stripFilePath \"app\" \"app/File.hs\" == Just \"File.hs\"", property $ P.stripFilePath "app" "app/File.hs" == Just "File.hs")
,("P.stripFilePath \"src\" \"app/File.hs\" == Nothing", property $ P.stripFilePath "src" "app/File.hs" == Nothing)
,("P.stripFilePath \"src\" \"src-dir/File.hs\" == Nothing", property $ P.stripFilePath "src" "src-dir/File.hs" == Nothing)
,("P.stripFilePath \".\" \"src/File.hs\" == Just \"src/File.hs\"", property $ P.stripFilePath "." "src/File.hs" == Just "src/File.hs")
,("P.stripFilePath \"app/\" \"./app/Lib/File.hs\" == Just \"Lib/File.hs\"", property $ P.stripFilePath "app/" "./app/Lib/File.hs" == Just "Lib/File.hs")
,("P.stripFilePath \"/app/\" \"./app/Lib/File.hs\" == Nothing", property $ P.stripFilePath "/app/" "./app/Lib/File.hs" == Nothing)
,("P.stripFilePath \"/app\" \"/app/Lib/File.hs\" == Just \"Lib/File.hs\"", property $ P.stripFilePath "/app" "/app/Lib/File.hs" == Just "Lib/File.hs")
,("P.normalise \"/file/\\\\test////\" == \"/file/\\\\test/\"", property $ P.normalise "/file/\\test////" == "/file/\\test/")
,("P.normalise \"/file/./test\" == \"/file/test\"", property $ P.normalise "/file/./test" == "/file/test")
,("P.normalise \"/test/file/../bob/fred/\" == \"/test/file/../bob/fred/\"", property $ P.normalise "/test/file/../bob/fred/" == "/test/file/../bob/fred/")
Expand Down