From 1b93023235e57c2b0a237ea770563ac36196b51d Mon Sep 17 00:00:00 2001
From: Henk-Jan van Tuyl <hjgtuyl@chello.nl>
Date: Sun, 1 Mar 2015 22:48:33 +0100
Subject: [PATCH] Added checks to see if files and directories exist
This is for fields "extra-source-files", "data-files", "extra-doc-files", "c-sources" and "js-sources"
See https://github.com/haskell/cabal/issues/1531
---
.../Distribution/PackageDescription/Check.hs | 49 +++++++++++--------
1 file changed, 29 insertions(+), 20 deletions(-)
diff --git a/Cabal/Distribution/PackageDescription/Check.hs b/Cabal/Distribution/PackageDescription/Check.hs
index be4e94a2d2..b1b32817b7 100644
--- a/Cabal/Distribution/PackageDescription/Check.hs
+++ b/Cabal/Distribution/PackageDescription/Check.hs
@@ -1379,30 +1379,36 @@ checkPackageContent :: Monad m => CheckPackageContentOps m
-> PackageDescription
-> m [PackageCheck]
checkPackageContent ops pkg = do
- licenseErrors <- checkLicensesExist ops pkg
setupError <- checkSetupExists ops pkg
configureError <- checkConfigureExists ops pkg
localPathErrors <- checkLocalPathsExist ops pkg
vcsLocation <- checkMissingVcsInfo ops pkg
+ fileExistsError <- checkFilesExist ops pkg
- return $ licenseErrors
- ++ catMaybes [setupError, configureError]
+ return $
+ catMaybes [setupError, configureError]
++ localPathErrors
++ vcsLocation
-
-checkLicensesExist :: Monad m => CheckPackageContentOps m
- -> PackageDescription
- -> m [PackageCheck]
-checkLicensesExist ops pkg = do
- exists <- mapM (doesFileExist ops) (licenseFiles pkg)
- return
- [ PackageBuildWarning $
- "The '" ++ fieldname ++ "' field refers to the file "
- ++ quote file ++ " which does not exist."
- | (file, False) <- zip (licenseFiles pkg) exists ]
- where
- fieldname | length (licenseFiles pkg) == 1 = "license-file"
- | otherwise = "license-files"
+ ++ fileExistsError
+
+checkFilesExist :: Monad m => CheckPackageContentOps m
+ -> PackageDescription
+ -> m [PackageCheck]
+checkFilesExist ops pkg = do
+ let filess = [ (files, kind)
+ | (files, kind) <-
+ [ (files, "license-file") | files <- licenseFiles pkg ]
+ ++ [ (files, "extra-source-files") | files <- extraSrcFiles pkg ]
+ ++ [ (files, "data-files") | files <- dataFiles pkg ]
+ ++ [ (files, "extra-doc-files") | files <- extraDocFiles pkg ]
+ ]
+
+ missing <- filterM (liftM not . doesFileExist ops . fst) filess
+ return [ PackageBuildWarning {
+ explanation = quote (kind ++ ": " ++ file)
+ ++ " file does not exist."
+ }
+ | (file, kind) <- missing ]
checkSetupExists :: Monad m => CheckPackageContentOps m
-> PackageDescription
@@ -1432,9 +1438,12 @@ checkLocalPathsExist ops pkg = do
let dirs = [ (dir, kind)
| bi <- allBuildInfo pkg
, (dir, kind) <-
- [ (dir, "extra-lib-dirs") | dir <- extraLibDirs bi ]
- ++ [ (dir, "include-dirs") | dir <- includeDirs bi ]
- ++ [ (dir, "hs-source-dirs") | dir <- hsSourceDirs bi ]
+ [ (dir, "extra-lib-dirs") | dir <- extraLibDirs bi ]
+ ++ [ (dir, "include-dirs") | dir <- includeDirs bi ]
+ ++ [ (dir, "hs-source-dirs") | dir <- hsSourceDirs bi ]
+ ++ [ (dir, "c-sources") | dir <- cSources bi ]
+ ++ [ (dir, "js-sources") | dir <- jsSources bi ]
+
, isRelative dir ]
missing <- filterM (liftM not . doesDirectoryExist ops . fst) dirs
return [ PackageBuildWarning {
--
GitLab