On Sun, 2006-03-12 at 21:41 +0000, Duncan Coutts wrote:

> I'm somewhat tempted to patch our current ghc to do this, it might be
> easier to get that working than to get our current hacks to work
> properly.

Attached is the current patch I'm testing.

It's pretty minimal. It doesn't convert everything over to use a
directory of .conf files. It just makes ghc and ghc-pkg look for
package.conf.d/*.conf in addition to the normal package.conf.

So in fact ghc-pkg still registers by modifying the global package.conf
file. It's just that this allows us to register without using ghc-pkg at
all and directly dropping a file into the right directory.

In fact in Gentoo we already have such a directory. We keep a .conf file
per package anyway since we need these to be able to re-register
packages if ghc is reinstalled. So I've tested it by just symlinking:

/usr/lib/ghc-6.4.1/package.conf.d -> /usr/lib/ghc-6.4.1/gentoo/

So far this seems to work. ghc-pkg reports all the installed packages
and ghci can still load them up.

Duncan
diff -urwpN ghc-6.4.1/ghc/compiler/main/Packages.lhs ghc-6.4.1.modified/ghc/compiler/main/Packages.lhs
--- ghc-6.4.1/ghc/compiler/main/Packages.lhs	2005-09-19 10:34:06.000000000 +0100
+++ ghc-6.4.1.modified/ghc/compiler/main/Packages.lhs	2006-03-13 06:22:19.000000000 +0000
@@ -67,7 +67,8 @@ import Distribution.Package
 import Distribution.Version
 import System.IO	( hPutStrLn, stderr )
 import Data.Maybe	( fromJust, isNothing )
-import System.Directory	( doesFileExist )
+import System.Directory	( doesFileExist, doesDirectoryExist,
+			  getDirectoryContents )
 import Control.Monad	( foldM, when )
 import Data.List	( nub, partition, sortBy )
 
@@ -207,7 +208,18 @@ readPackageConfigs :: DynFlags -> IO Pac
 readPackageConfigs dflags = do
 	-- System one always comes first
    system_pkgconf <- getPackageConfigPath
-   pkg_map1 <- readPackageConfig dflags emptyPackageConfigMap system_pkgconf
+   pkg_map0 <- readPackageConfig dflags emptyPackageConfigMap system_pkgconf
+   
+   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 []
+   pkg_map1 <- foldM (readPackageConfig dflags) pkg_map0 system_pkgconfs
 
 	-- Read user's package conf (eg. ~/.ghc/i386-linux-6.3/package.conf)
 	-- unless the -no-user-package-conf flag was given.
diff -urwpN ghc-6.4.1/ghc/utils/ghc-pkg/Main.hs ghc-6.4.1.modified/ghc/utils/ghc-pkg/Main.hs
--- ghc-6.4.1/ghc/utils/ghc-pkg/Main.hs	2005-08-03 10:53:31.000000000 +0100
+++ ghc-6.4.1.modified/ghc/utils/ghc-pkg/Main.hs	2006-03-13 06:32:14.000000000 +0000
@@ -285,6 +285,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"
 
@@ -301,9 +311,9 @@ getPkgDatabases modify flags = do
 	-- If we are not modifying (eg. list, describe etc.) then
 	-- the user database is included by default.
 	databases
-	  | modify          = foldl addDB [global_conf] flags
-	  | not user_exists = foldl addDB [global_conf] flags
-	  | otherwise       = foldl addDB [user_conf,global_conf] flags
+	  | modify          = foldl addDB (global_conf:global_confs) flags
+	  | not user_exists = foldl addDB (global_conf:global_confs) flags
+	  | otherwise       = foldl addDB (user_conf:global_conf:global_confs) flags
 
 	-- implement the following rules:
 	-- 	--user means overlap with the user database
@@ -312,7 +322,7 @@ getPkgDatabases modify flags = do
 	addDB dbs FlagUser
 	   | user_conf `elem` dbs     = dbs
 	   | modify || user_exists    = user_conf : dbs
-	addDB dbs FlagGlobal     = [global_conf]
+	addDB dbs FlagGlobal     = global_conf:global_confs
 	addDB dbs (FlagConfig f) = f : dbs
 	addDB dbs _		 = dbs
 
_______________________________________________
Glasgow-haskell-users mailing list
Glasgow-haskell-users@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users

Reply via email to