Skip to content

Allow directories in cabal data-files (#713) #1344

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

Closed
wants to merge 1 commit into from
Closed

Allow directories in cabal data-files (#713) #1344

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
18 changes: 13 additions & 5 deletions Cabal/Distribution/Simple/Utils.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -695,16 +695,21 @@ data FileGlob
-- @FileGlob \"foo\/bar\" \".baz\"@
| FileGlob FilePath String

-- | A directory which explicitly ends with a slash. This means "Include all
-- the files below me recursively"
| DirTrailingSlash FilePath

parseFileGlob :: FilePath -> Maybe FileGlob
parseFileGlob filepath = case splitExtensions filepath of
(filepath', ext) -> case splitFileName filepath' of
(dir, "*") | '*' `elem` dir
|| '*' `elem` ext
|| null ext -> Nothing
| null dir -> Just (FileGlob "." ext)
| otherwise -> Just (FileGlob dir ext)
_ | '*' `elem` filepath -> Nothing
| otherwise -> Just (NoGlob filepath)
|| null ext -> Nothing
| null dir -> Just (FileGlob "." ext)
| otherwise -> Just (FileGlob dir ext)
_ | '*' `elem` filepath -> Nothing
| last filepath == '/' -> Just (DirTrailingSlash filepath)
| otherwise -> Just (NoGlob filepath)

matchFileGlob :: FilePath -> IO [FilePath]
matchFileGlob = matchDirFileGlob "."
Expand All @@ -725,6 +730,9 @@ matchDirFileGlob dir filepath = case parseFileGlob filepath of
[] -> die $ "filepath wildcard '" ++ filepath
++ "' does not match any files."
matches -> return matches
Just (DirTrailingSlash dir') ->
let contents = getDirectoryContentsRecursive (dir </> 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 think that the original idea with this feature was to add only a limited form of globbing and explicitly disallow including directories recursively because it makes it easy to include unwanted files.

in (fmap . fmap) (dir' ++) contents

----------------------------------------
-- Copying and installing files and dirs
Expand Down