Commit eddcaf5b authored by Duncan Coutts's avatar Duncan Coutts
Browse files

Add warnings about missing and out-of-tree relative paths

parent 328519b6
...@@ -47,8 +47,9 @@ module Distribution.PackageDescription.Check ( ...@@ -47,8 +47,9 @@ module Distribution.PackageDescription.Check (
) where ) where
import Data.Maybe (isNothing, catMaybes) import Data.Maybe (isNothing, catMaybes)
import Data.List (intersperse, sort, group, isPrefixOf) import Data.List (sort, group, isPrefixOf)
import System.Directory (doesFileExist) import Control.Monad (filterM)
import System.Directory (doesFileExist, doesDirectoryExist)
import Distribution.PackageDescription import Distribution.PackageDescription
import Distribution.Compiler(CompilerFlavor(..)) import Distribution.Compiler(CompilerFlavor(..))
...@@ -58,7 +59,7 @@ import Distribution.Simple.Utils (cabalVersion, intercalate) ...@@ -58,7 +59,7 @@ import Distribution.Simple.Utils (cabalVersion, intercalate)
import Distribution.Version (Version(..), withinRange, showVersionRange) import Distribution.Version (Version(..), withinRange, showVersionRange)
import Distribution.Package (PackageIdentifier(..)) import Distribution.Package (PackageIdentifier(..))
import Language.Haskell.Extension (Extension(..)) import Language.Haskell.Extension (Extension(..))
import System.FilePath (takeExtension, (</>)) import System.FilePath (takeExtension, isRelative, splitDirectories, (</>))
-- | Results of some kind of failed package check. -- | Results of some kind of failed package check.
-- --
...@@ -118,6 +119,7 @@ checkPackage pkg = ...@@ -118,6 +119,7 @@ checkPackage pkg =
++ checkLicense pkg ++ checkLicense pkg
++ checkGhcOptions pkg ++ checkGhcOptions pkg
++ checkCCOptions pkg ++ checkCCOptions pkg
++ checkPaths pkg
-- ------------------------------------------------------------ -- ------------------------------------------------------------
...@@ -395,6 +397,22 @@ checkAlternatives badField goodField flags = ...@@ -395,6 +397,22 @@ checkAlternatives badField goodField flags =
where (badFlags, goodFlags) = unzip flags where (badFlags, goodFlags) = unzip flags
checkPaths :: PackageDescription -> [PackageCheck]
checkPaths pkg =
[ PackageBuildWarning {
explanation = quote (kind ++ ": " ++ dir)
++ " is a relative path outside of the source tree.\n"
++ "This will not work when generating a tarball with 'sdist'."
}
| 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 ]
, isOutsideTree dir ]
where isOutsideTree dir = case splitDirectories dir of
"..":_ -> True
_ -> False
-- ------------------------------------------------------------ -- ------------------------------------------------------------
-- * Checks in IO -- * Checks in IO
-- ------------------------------------------------------------ -- ------------------------------------------------------------
...@@ -407,8 +425,10 @@ checkPackageFiles pkg root = do ...@@ -407,8 +425,10 @@ checkPackageFiles pkg root = do
licenseError <- checkLicenseExists pkg root licenseError <- checkLicenseExists pkg root
setupError <- checkSetupExists pkg root setupError <- checkSetupExists pkg root
configureError <- checkConfigureExists pkg root configureError <- checkConfigureExists pkg root
localPathErrors <- checkLocalPathsExist pkg root
return (catMaybes [licenseError, setupError, configureError]) return $ catMaybes [licenseError, setupError, configureError]
++ localPathErrors
checkLicenseExists :: PackageDescription -> FilePath -> IO (Maybe PackageCheck) checkLicenseExists :: PackageDescription -> FilePath -> IO (Maybe PackageCheck)
checkLicenseExists pkg root checkLicenseExists pkg root
...@@ -439,6 +459,22 @@ checkConfigureExists PackageDescription { buildType = Just Configure } root = do ...@@ -439,6 +459,22 @@ checkConfigureExists PackageDescription { buildType = Just Configure } root = do
"The 'build-type' is 'Configure' but there is no 'configure' script." "The 'build-type' is 'Configure' but there is no 'configure' script."
checkConfigureExists _ _ = return Nothing checkConfigureExists _ _ = return Nothing
checkLocalPathsExist :: PackageDescription -> FilePath -> IO [PackageCheck]
checkLocalPathsExist pkg root = 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 ]
, isRelative dir ]
missing <- filterM (fmap not . doesDirectoryExist . (root </>) . fst) dirs
return [ PackageBuildWarning {
explanation = quote (kind ++ ": " ++ dir)
++ " directory does not exist."
}
| (dir, kind) <- missing ]
-- ------------------------------------------------------------ -- ------------------------------------------------------------
-- * Utils -- * Utils
-- ------------------------------------------------------------ -- ------------------------------------------------------------
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment