summaryrefslogtreecommitdiff
path: root/utils
diff options
context:
space:
mode:
authorDuncan Coutts <duncan@well-typed.com>2011-05-24 15:42:38 +0100
committerDuncan Coutts <duncan@well-typed.com>2011-05-25 12:16:56 +0100
commitf61d53d322cdf81a1cfa09cf4a4af4198611bcd5 (patch)
tree2d3a7f91c89ea8837247204128d6e3a7ae9bc7df /utils
parent40b6bd47cf00f025426746bbd7abdd0eda2a3afd (diff)
downloadhaskell-f61d53d322cdf81a1cfa09cf4a4af4198611bcd5.tar.gz
Add stricter ghc-pkg checks on package file/dir/url fields
The haddock-html and haddock-interface fields are now checked as well. Had to fix up ghc-cabal as it used relative paths for the inplace package's haddock-html. It turns out that these were never used so it could simply be omitted.
Diffstat (limited to 'utils')
-rw-r--r--utils/ghc-cabal/Main.hs2
-rw-r--r--utils/ghc-pkg/Main.hs35
2 files changed, 26 insertions, 11 deletions
diff --git a/utils/ghc-cabal/Main.hs b/utils/ghc-cabal/Main.hs
index d64c2240a8..75d1faf9bf 100644
--- a/utils/ghc-cabal/Main.hs
+++ b/utils/ghc-cabal/Main.hs
@@ -296,7 +296,7 @@ generate config_args distdir directory
pd lib lbi clbi
final_ipi = installedPkgInfo {
Installed.installedPackageId = ipid,
- Installed.haddockHTMLs = ["../" ++ display (packageId pd)]
+ Installed.haddockHTMLs = []
}
content = Installed.showInstalledPackageInfo final_ipi ++ "\n"
writeFileAtomic (distdir </> "inplace-pkg-config") (toUTF8 content)
diff --git a/utils/ghc-pkg/Main.hs b/utils/ghc-pkg/Main.hs
index 8b8210d5ed..cc4d1835a0 100644
--- a/utils/ghc-pkg/Main.hs
+++ b/utils/ghc-pkg/Main.hs
@@ -1274,6 +1274,8 @@ checkPackageConfig pkg db_stack auto_ghci_libs update = do
mapM_ (checkDir False "import-dirs") (importDirs pkg)
mapM_ (checkDir True "library-dirs") (libraryDirs pkg)
mapM_ (checkDir True "include-dirs") (includeDirs pkg)
+ mapM_ (checkFile True "haddock-interfaces") (haddockInterfaces pkg)
+ mapM_ (checkDirURL True "haddock-html") (haddockHTMLs pkg)
checkModules pkg
mapM_ (checkHSLib (libraryDirs pkg) auto_ghci_libs) (hsLibraries pkg)
-- ToDo: check these somehow?
@@ -1325,18 +1327,34 @@ checkDuplicates db_stack pkg update = do
"Package " ++ display pkgid ++
" overlaps with: " ++ unwords (map display dups)
-checkDir :: Bool -> String -> FilePath -> Validate ()
-checkDir warn_only thisfield d
- -- Note: we don't check for $topdir/${pkgroot} here. We relies on these
+checkDir, checkFile, checkDirURL :: Bool -> String -> FilePath -> Validate ()
+checkDir = checkPath False True
+checkFile = checkPath False False
+checkDirURL = checkPath True True
+
+checkPath :: Bool -> Bool -> Bool -> String -> FilePath -> Validate ()
+checkPath url_ok is_dir warn_only thisfield d
+ | url_ok && ("http://" `isPrefixOf` d
+ || "https://" `isPrefixOf` d) = return ()
+
+ | url_ok
+ , Just d' <- stripPrefix "file://" d
+ = checkPath False is_dir warn_only thisfield d'
+
+ -- Note: we don't check for $topdir/${pkgroot} here. We rely on these
-- variables having been expanded already, see mungePackagePaths.
| isRelative d = verror ForceFiles $
- thisfield ++ ": " ++ d ++ " is a relative path"
+ thisfield ++ ": " ++ d ++ " is a relative path which "
+ ++ "makes no sense (as there is nothing for it to be "
+ ++ "relative to). You can make paths relative to the "
+ ++ "package database itself by using ${pkgroot}."
-- relative paths don't make any sense; #4134
| otherwise = do
- there <- liftIO $ doesDirectoryExist d
+ there <- liftIO $ if is_dir then doesDirectoryExist d else doesFileExist d
when (not there) $
- let msg = thisfield ++ ": " ++ d ++ " doesn't exist or isn't a directory"
+ let msg = thisfield ++ ": " ++ d ++ " doesn't exist or isn't a "
+ ++ if is_dir then "directory" else "file"
in
if warn_only
then vwarn msg
@@ -1375,10 +1393,7 @@ doesFileExistOnPath file path = go path
if b then return (Just p) else go ps
doesFileExistIn :: String -> String -> IO Bool
-doesFileExistIn lib d
- | "$topdir" `isPrefixOf` d = return True
- | "$httptopdir" `isPrefixOf` d = return True
- | otherwise = doesFileExist (d </> lib)
+doesFileExistIn lib d = doesFileExist (d </> lib)
checkModules :: InstalledPackageInfo -> Validate ()
checkModules pkg = do