Look for a package.conf.d directory containing per-package .conf files

[ghc-hetmet.git] / ghc / utils / ghc-pkg / Main.hs

diff --git a/ghc/utils/ghc-pkg/Main.hs b/ghc/utils/ghc-pkg/Main.hs
index 04170c4..fb3ef07 100644 (file)
--- a/ghc/utils/ghc-pkg/Main.hs
+++ b/ghc/utils/ghc-pkg/Main.hs
@@ -290,6 +290,16 @@ getPkgDatabases modify flags = do
                        Just dir -> return (dir `joinFileName` "package.conf")
         fs -> return (last fs)
 
+  let global_conf_dir = global_conf ++ ".d"
+  global_conf_dir_exists <- doesDirectoryExist global_conf_dir
+  global_confs <-
+    if global_conf_dir_exists
+      then do files <- getDirectoryContents global_conf_dir
+              return [ global_conf_dir ++ '/' : file
+                     | file <- files
+                     , isSuffixOf ".conf" file]
+      else return []
+
   -- get the location of the user package database, and create it if necessary
   appdir <- getAppUserDataDirectory "ghc"
 
@@ -302,8 +312,8 @@ getPkgDatabases modify flags = do
   -- If the user database doesn't exist, and this command isn't a
   -- "modify" command, then we won't attempt to create or use it.
   let sys_databases
-       | modify || user_exists = [user_conf,global_conf]
-       | otherwise             = [global_conf]
+       | modify || user_exists = user_conf : global_confs ++ [global_conf]
+       | otherwise             = global_confs ++ [global_conf]
 
   e_pkg_path <- try (getEnv "GHC_PACKAGE_PATH")
   let env_stack =
@@ -314,6 +324,10 @@ getPkgDatabases modify flags = do
                  | otherwise      -> cs
                  where cs = parseSearchPath path
 
+       -- The "global" database is always the one at the bottom of the stack.
+       -- This is the database we modify by default.
+      virt_global_conf = last env_stack
+
   -- -f flags on the command line add to the database stack, unless any
   -- of them are present in the stack already.
   let flag_stack = filter (`notElem` env_stack) 
@@ -327,10 +341,10 @@ getPkgDatabases modify flags = do
         then return flag_stack
        else let
                go (FlagUser : fs)     = modifying user_conf
-               go (FlagGlobal : fs)   = modifying global_conf
+               go (FlagGlobal : fs)   = modifying virt_global_conf
                go (FlagConfig f : fs) = modifying f
                go (_ : fs)            = go fs
-               go []                  = modifying global_conf
+               go []                  = modifying virt_global_conf
                
                modifying f 
                  | f `elem` flag_stack = return (dropWhile (/= f) flag_stack)
@@ -406,7 +420,7 @@ parsePackageInfo
        -> IO InstalledPackageInfo
 parsePackageInfo str defines force =
   case parseInstalledPackageInfo str of
-    ParseOk ok -> return ok
+    ParseOk _warns ok -> return ok
     ParseFailed err -> die (showError err)
 
 -- -----------------------------------------------------------------------------
@@ -452,8 +466,21 @@ listPackages flags mPackageName = do
             map (\(conf,pkgs) -> (conf, filter (this `matchesPkg`) pkgs)) 
                db_stack
         | otherwise = db_stack
+
+      db_stack_sorted 
+          = [ (db, sort_pkgs pkgs) | (db,pkgs) <- db_stack_filtered ]
+         where sort_pkgs = sortBy cmpPkgIds
+               cmpPkgIds pkg1 pkg2 = 
+                  case pkgName p1 `compare` pkgName p2 of
+                       LT -> LT
+                       GT -> GT
+                       EQ -> pkgVersion p1 `compare` pkgVersion p2
+                  where (p1,p2) = (package pkg1, package pkg2)
+
       show_func = if simple_output then show_easy else mapM_ show_regular
-  show_func (reverse db_stack_filtered)
+
+  show_func (reverse db_stack_sorted)
+
   where show_regular (db_name,pkg_confs) =
          hPutStrLn stdout (render $
                text (db_name ++ ":") $$ nest 4 packages
@@ -463,6 +490,7 @@ listPackages flags mPackageName = do
                   | exposed p = doc
                   | otherwise = parens doc
                   where doc = text (showPackageId (package p))
+
         show_easy db_stack = do
           let pkgs = map showPackageId $ sortBy compPkgIdVer $
                           map package (concatMap snd db_stack)