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.

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

Don't Glob if Glob Ain't Glob 2: The Globbening #10518

Merged
merged 4 commits into from
Dec 13, 2024
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
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
4 changes: 2 additions & 2 deletions Cabal-tests/tests/UnitTests/Distribution/Simple/Glob.hs
Original file line number Diff line number Diff line change
Expand Up @@ -107,13 +107,13 @@ testMatchesVersion version pat expected = do
-- check can't identify that kind of match.
expected' = filter (\case GlobMatchesDirectory _ -> False; _ -> True) expected
unless (sort expected' == sort actual) $
assertFailure $ "Unexpected result (pure matcher): " ++ show actual
assertFailure $ "Unexpected result (pure matcher): " ++ show actual ++ "\nExpected: " ++ show expected
checkIO globPat =
withSystemTempDirectory "globstar-sample" $ \tmpdir -> do
makeSampleFiles tmpdir
actual <- runDirFileGlob Verbosity.normal (Just version) tmpdir globPat
unless (isEqual actual expected) $
assertFailure $ "Unexpected result (impure matcher): " ++ show actual
assertFailure $ "Unexpected result (impure matcher): " ++ show actual ++ "\nExpected: " ++ show expected

testFailParseVersion :: CabalSpecVersion -> FilePath -> GlobSyntaxError -> Assertion
testFailParseVersion version pat expected =
Expand Down
35 changes: 27 additions & 8 deletions Cabal/src/Distribution/Simple/Glob.hs
Original file line number Diff line number Diff line change
Expand Up @@ -370,7 +370,6 @@ runDirFileGlob verbosity mspec rawRoot pat = do
"Null dir passed to runDirFileGlob; interpreting it "
++ "as '.'. This is probably an internal error."
let root = if null rawRoot then "." else rawRoot
debug verbosity $ "Expanding glob '" ++ show (pretty pat) ++ "' in directory '" ++ root ++ "'."
-- This function might be called from the project root with dir as
-- ".". Walking the tree starting there involves going into .git/
-- and dist-newstyle/, which is a lot of work for no reward, so
Expand All @@ -379,7 +378,7 @@ runDirFileGlob verbosity mspec rawRoot pat = do
-- the whole directory if *, and just the specific file if it's a
-- literal.
let
(prefixSegments, variablePattern) = splitConstantPrefix pat
(prefixSegments, pathOrVariablePattern) = splitConstantPrefix pat
joinedPrefix = joinPath prefixSegments

-- The glob matching function depends on whether we care about the cabal version or not
Expand Down Expand Up @@ -431,17 +430,37 @@ runDirFileGlob verbosity mspec rawRoot pat = do
concat <$> traverse (\subdir -> go globPath (dir </> subdir)) subdirs
go GlobDirTrailing dir = return [GlobMatch dir]

directoryExists <- doesDirectoryExist (root </> joinedPrefix)
ulysses4ever marked this conversation as resolved.
Show resolved Hide resolved
if directoryExists
then go variablePattern joinedPrefix
else return [GlobMissingDirectory joinedPrefix]
case pathOrVariablePattern of
Left filename -> do
let filepath = joinedPrefix </> filename
debug verbosity $ "Treating glob as filepath literal '" ++ filepath ++ "' in directory '" ++ root ++ "'."
directoryExists <- doesDirectoryExist (root </> filepath)
if directoryExists
then pure [GlobMatchesDirectory filepath]
else do
exist <- doesFileExist (root </> filepath)
pure $
if exist
then [GlobMatch filepath]
else []
Right variablePattern -> do
debug verbosity $ "Expanding glob '" ++ show (pretty pat) ++ "' in directory '" ++ root ++ "'."
directoryExists <- doesDirectoryExist (root </> joinedPrefix)
if directoryExists
then go variablePattern joinedPrefix
else return [GlobMissingDirectory joinedPrefix]
where
-- \| Extract the (possibly null) constant prefix from the pattern.
-- This has the property that, if @(pref, final) = splitConstantPrefix pat@,
-- then @pat === foldr GlobDir final pref@.
splitConstantPrefix :: Glob -> ([FilePath], Glob)
splitConstantPrefix = unfoldr' step
splitConstantPrefix :: Glob -> ([FilePath], Either FilePath Glob)
splitConstantPrefix = fmap literalize . unfoldr' step
where
literalize (GlobFile [Literal filename]) =
Left filename
literalize glob =
Right glob

step (GlobDir [Literal seg] pat') = Right (seg, pat')
step pat' = Left pat'

Expand Down
Original file line number Diff line number Diff line change
@@ -1,6 +1,6 @@
# cabal check
These warnings may cause trouble when distributing the package:
Warning: [glob-missing-dir] In 'extra-source-files': the pattern '/home/user/file' attempts to match files in the directory '/home/user', but there is no directory by that name.
Warning: [no-glob-match] In 'extra-source-files': the pattern '/home/user/file' does not match any files.
The following errors will cause portability problems on other environments:
Error: [absolute-path] 'extra-source-files: /home/user/file' specifies an absolute path, but the 'extra-source-files' field must use relative paths.
Error: [malformed-relative-path] 'extra-source-files: /home/user/file' is not a good relative path: "posix absolute path"
Expand Down
Loading