remove empty dir

[ghc-hetmet.git] / ghc / compiler / main / Packages.lhs

diff --git a/ghc/compiler/main/Packages.lhs b/ghc/compiler/main/Packages.lhs
index 1ab814b..ae6b188 100644 (file)
--- a/ghc/compiler/main/Packages.lhs
+++ b/ghc/compiler/main/Packages.lhs
@@ -61,19 +61,14 @@ import System.Directory     ( getAppUserDataDirectory )
 import Compat.Directory        ( getAppUserDataDirectory )
 #endif
 
+import System.Environment ( getEnv )
 import Distribution.InstalledPackageInfo
 import Distribution.Package
 import Distribution.Version
-import Data.Maybe      ( isNothing )
-import System.Directory        ( doesFileExist )
+import System.Directory        ( doesFileExist, doesDirectoryExist,
+                         getDirectoryContents )
 import Control.Monad   ( foldM )
-import Data.List       ( nub, partition, sortBy )
-
-#ifdef mingw32_TARGET_OS
-import Data.List       ( isPrefixOf )
-#endif
-import Data.List        ( isSuffixOf )
-
+import Data.List       ( nub, partition, sortBy, isSuffixOf )
 import FastString
 import EXCEPTION       ( throwDyn )
 import ErrUtils         ( debugTraceMsg, putMsg, Message )
@@ -207,33 +202,61 @@ initPackages dflags = do
 
 readPackageConfigs :: DynFlags -> IO PackageConfigMap
 readPackageConfigs dflags = do
+   e_pkg_path <- try (getEnv "GHC_PACKAGE_PATH")
+   system_pkgconfs <- getSystemPackageConfigs dflags
+
+   let pkgconfs = case e_pkg_path of
+                   Left _   -> system_pkgconfs
+                   Right path
+                    | last cs == "" -> init cs ++ system_pkgconfs
+                    | otherwise     -> cs
+                    where cs = parseSearchPath path
+                    -- if the path ends in a separator (eg. "/foo/bar:")
+                    -- the we tack on the system paths.
+
+       -- Read all the ones mentioned in -package-conf flags
+   pkg_map <- foldM (readPackageConfig dflags) emptyPackageConfigMap
+                (reverse pkgconfs ++ extraPkgConfs dflags)
+
+   return pkg_map
+
+
+getSystemPackageConfigs :: DynFlags -> IO [FilePath]
+getSystemPackageConfigs dflags = do
        -- System one always comes first
    system_pkgconf <- getPackageConfigPath
-   pkg_map1 <- readPackageConfig dflags emptyPackageConfigMap system_pkgconf
+
+       -- 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 
        -- (GHC >= 6.3).
-   (exists, pkgconf) <- catch (do
+   user_pkgconf <- handle (\_ -> return []) $ do
       appdir <- getAppUserDataDirectory "ghc"
       let 
         pkgconf = appdir
                   `joinFileName` (TARGET_ARCH ++ '-':TARGET_OS ++ '-':cProjectVersion)
                   `joinFileName` "package.conf"
       flg <- doesFileExist pkgconf
-      return (flg, pkgconf))
-       -- gobble them all up and turn into False.
-      (\ _ -> return (False, ""))
-   pkg_map2 <- if (dopt Opt_ReadUserPackageConf dflags && exists)
-                 then readPackageConfig dflags pkg_map1 pkgconf
-                 else return pkg_map1
+      if (flg && dopt Opt_ReadUserPackageConf dflags)
+       then return [pkgconf]
+       else return []
 
-       -- Read all the ones mentioned in -package-conf flags
-   pkg_map <- foldM (readPackageConfig dflags) pkg_map2
-                (extraPkgConfs dflags)
-
-   return pkg_map
+   return (user_pkgconf ++ system_pkgconfs ++ [system_pkgconf])
 
 
 readPackageConfig