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

allow glob matches of the form dir/**/FileNoExtension #8005

Merged
merged 6 commits into from
Apr 13, 2022
Merged
Changes from 1 commit
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
39 changes: 28 additions & 11 deletions Cabal/src/Distribution/Simple/Glob.hs
Original file line number Diff line number Diff line change
Expand Up @@ -111,7 +111,7 @@ explainGlobSyntaxError filepath VersionDoesNotSupportGlob =
++ "Alternatively if you require compatibility with earlier Cabal "
++ "versions then list all the files explicitly."

data IsRecursive = Recursive | NonRecursive
data IsRecursive = Recursive | NonRecursive deriving Eq

data MultiDot = MultiDotDisabled | MultiDotEnabled

Expand All @@ -125,7 +125,7 @@ data GlobFinal
-- ^ First argument: Is this a @**/*.ext@ pattern?
-- Second argument: should we match against the exact extensions, or accept a suffix?
-- Third argument: the extensions to accept.
| FinalLit FilePath
| FinalLit IsRecursive FilePath
-- ^ Literal file name.

reconstructGlob :: Glob -> FilePath
Expand All @@ -134,7 +134,8 @@ reconstructGlob (GlobStem dir glob) =
reconstructGlob (GlobFinal final) = case final of
FinalMatch Recursive _ exts -> "**" </> "*" <.> exts
FinalMatch NonRecursive _ exts -> "*" <.> exts
FinalLit path -> path
FinalLit Recursive path -> "**" </> path
FinalLit NonRecursive path -> path

-- | Returns 'Nothing' if the glob didn't match at all, or 'Just' the
-- result if the glob matched (or would have matched with a higher
Expand All @@ -159,8 +160,8 @@ fileGlobMatchesSegments pat (seg : segs) = case pat of
let (candidateBase, candidateExts) = splitExtensions seg
guard (null segs && not (null candidateBase))
checkExt multidot ext candidateExts
FinalLit filename -> do
guard (null segs && filename == seg)
FinalLit isRecursive filename -> do
guard ((isRecursive == Recursive || null segs) && filename == seg)
return (GlobMatch ())

checkExt
Expand All @@ -181,12 +182,14 @@ parseFileGlob version filepath = case reverse (splitDirectories filepath) of
Left EmptyGlob
(filename : "**" : segments)
| allowGlobStar -> do
ext <- case splitExtensions filename of
finalSegment <- case splitExtensions filename of
("*", ext) | '*' `elem` ext -> Left StarInExtension
| null ext -> Left NoExtensionOnStar
| otherwise -> Right ext
_ -> Left LiteralFileNameGlobStar
foldM addStem (GlobFinal $ FinalMatch Recursive multidot ext) segments
| otherwise -> Right (FinalMatch Recursive multidot ext)
_ -> if allowLiteralFilenameGlobStar
then Right (FinalLit Recursive filename)
else Left LiteralFileNameGlobStar
foldM addStem (GlobFinal finalSegment) segments
| otherwise -> Left VersionDoesNotSupportGlobStar
(filename : segments) -> do
pat <- case splitExtensions filename of
Expand All @@ -196,7 +199,7 @@ parseFileGlob version filepath = case reverse (splitDirectories filepath) of
| otherwise -> Right (FinalMatch NonRecursive multidot ext)
(_, ext) | '*' `elem` ext -> Left StarInExtension
| '*' `elem` filename -> Left StarInFileName
| otherwise -> Right (FinalLit filename)
| otherwise -> Right (FinalLit NonRecursive filename)
foldM addStem (GlobFinal pat) segments
where
allowGlob = version >= CabalSpecV1_6
Expand All @@ -207,6 +210,7 @@ parseFileGlob version filepath = case reverse (splitDirectories filepath) of
multidot
| version >= CabalSpecV2_4 = MultiDotEnabled
| otherwise = MultiDotDisabled
allowLiteralFilenameGlobStar = version >= CabalSpecV3_8

-- | This will 'die'' when the glob matches no files, or if the glob
-- refers to a missing directory, or if the glob fails to parse.
Expand Down Expand Up @@ -300,7 +304,20 @@ runDirFileGlob verbosity rawDir pat = do
return $ mapMaybe checkName candidates
else
return [ GlobMissingDirectory joinedPrefix ]
FinalLit fn -> do
FinalLit Recursive fn -> do
let prefix = dir </> joinedPrefix
directoryExists <- doesDirectoryExist prefix
if directoryExists
then do
candidates <- getDirectoryContentsRecursive prefix
let checkName candidate
| takeFileName candidate == fn = Just $ GlobMatch (joinedPrefix </> candidate)
| otherwise = Nothing
return $ mapMaybe checkName candidates
else
return [ GlobMissingDirectory joinedPrefix ]

FinalLit NonRecursive fn -> do
exists <- doesFileExist (dir </> joinedPrefix </> fn)
return [ GlobMatch (joinedPrefix </> fn) | exists ]

Expand Down