X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fmain%2FPackages.lhs;h=d5cfbd10986ef08622eb346ecd4810a6c3f2ae68;hb=983c316af4654b6532909a0e85dec175e808401a;hp=1402db10408f79212c867a1c33c626df10c94b2a;hpb=1a7d1b77334529ca96ed4cbc03fcb5f55dc2de4a;p=ghc-hetmet.git diff --git a/compiler/main/Packages.lhs b/compiler/main/Packages.lhs index 1402db1..d5cfbd1 100644 --- a/compiler/main/Packages.lhs +++ b/compiler/main/Packages.lhs @@ -66,6 +66,7 @@ import FastString import ErrUtils ( debugTraceMsg, putMsg, Message ) import System.Directory +import System.FilePath import Data.Maybe import Control.Monad import Data.List @@ -210,14 +211,14 @@ getSystemPackageConfigs dflags = do -- 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" + 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 + return [ system_pkgconf_dir file | file <- files - , isSuffixOf ".conf" file] + , takeExtension file == ".conf" ] else return [] -- Read user's package conf (eg. ~/.ghc/i386-linux-6.3/package.conf) @@ -228,8 +229,8 @@ getSystemPackageConfigs dflags = do appdir <- getAppUserDataDirectory "ghc" let pkgconf = appdir - `joinFileName` (TARGET_ARCH ++ '-':TARGET_OS ++ '-':cProjectVersion) - `joinFileName` "package.conf" + (TARGET_ARCH ++ '-':TARGET_OS ++ '-':cProjectVersion) + "package.conf" flg <- doesFileExist pkgconf if (flg && dopt Opt_ReadUserPackageConf dflags) then return [pkgconf] @@ -268,9 +269,12 @@ mungePackagePaths top_dir ps = map munge_pkg ps munge_paths = map munge_path munge_path p - | Just p' <- maybePrefixMatch "$topdir" p = top_dir ++ p' + | Just p' <- maybePrefixMatch "$topdir" p = top_dir ++ p' + | Just p' <- maybePrefixMatch "$httptopdir" p = toHttpPath top_dir ++ p' | otherwise = p + toHttpPath p = "file:///" ++ p + -- ----------------------------------------------------------------------------- -- Modify our copy of the package database based on a package flag