Look for a package.conf.d directory containing per-package .conf files
authorSimon Marlow <simonmar@microsoft.com>
Mon, 13 Mar 2006 13:32:11 +0000 (13:32 +0000)
committerSimon Marlow <simonmar@microsoft.com>
Mon, 13 Mar 2006 13:32:11 +0000 (13:32 +0000)
Contributed by Duncan Coutts, with changes to merge into the HEAD.
This isn't the full deal, ghc-pkg still modifies files only, but it's
enough to help the Gentoo folk along.

ghc/compiler/main/Packages.lhs
ghc/utils/ghc-pkg/Main.hs

index 76d2f08..ae6b188 100644 (file)
@@ -65,7 +65,8 @@ import System.Environment ( getEnv )
 import Distribution.InstalledPackageInfo
 import Distribution.Package
 import Distribution.Version
-import System.Directory        ( doesFileExist )
+import System.Directory        ( doesFileExist, doesDirectoryExist,
+                         getDirectoryContents )
 import Control.Monad   ( foldM )
 import Data.List       ( nub, partition, sortBy, isSuffixOf )
 import FastString
@@ -225,6 +226,21 @@ getSystemPackageConfigs dflags = do
        -- System one always comes first
    system_pkgconf <- getPackageConfigPath
 
+       -- allow package.conf.d to contain a bunch of .conf files
+       -- containing package specifications.  This is an easier way
+       -- to maintain the package database on systems with a package
+       -- management system, or systems that don't want to run ghc-pkg
+       -- to register or unregister packages.  Undocumented feature for now.
+   let system_pkgconf_dir = system_pkgconf ++ ".d"
+   system_pkgconf_dir_exists <- doesDirectoryExist system_pkgconf_dir
+   system_pkgconfs <-
+     if system_pkgconf_dir_exists
+       then do files <- getDirectoryContents system_pkgconf_dir
+               return [ system_pkgconf_dir ++ '/' : file
+                      | file <- files
+                      , isSuffixOf ".conf" file]
+       else return []
+
        -- Read user's package conf (eg. ~/.ghc/i386-linux-6.3/package.conf)
        -- unless the -no-user-package-conf flag was given.
        -- We only do this when getAppUserDataDirectory is available 
@@ -240,7 +256,7 @@ getSystemPackageConfigs dflags = do
        then return [pkgconf]
        else return []
 
-   return (user_pkgconf ++ [system_pkgconf])
+   return (user_pkgconf ++ system_pkgconfs ++ [system_pkgconf])
 
 
 readPackageConfig
index a734636..fb3ef07 100644 (file)
@@ -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 =