PackageState(..),
initPackages,
getPackageDetails,
- lookupModuleInAllPackages,
+ lookupModuleInAllPackages, lookupModuleWithSuggestions,
-- * Inspecting the set of packages in scope
getPackageIncludePath,
#include "HsVersions.h"
import PackageConfig
-import DynFlags ( dopt, DynFlag(..), DynFlags(..), PackageFlag(..) )
+import DynFlags
import StaticFlags
import Config ( cProjectVersion )
import Name ( Name, nameModule_maybe )
import Exception
import System.Directory
-import System.FilePath
+import System.FilePath as FilePath
+import qualified System.FilePath.Posix as FilePath.Posix
import Control.Monad
import Data.List as List
import Data.Map (Map)
initPackages dflags = do
pkg_db <- case pkgDatabase dflags of
Nothing -> readPackageConfigs dflags
- Just db -> return db
+ Just db -> return $ maybeHidePackages dflags db
(pkg_state, preload, this_pkg)
<- mkPackageState dflags pkg_db [] (thisPackage dflags)
return (dflags{ pkgDatabase = Just pkg_db,
let
top_dir = topDir dflags
- pkg_configs1 = mungePackagePaths top_dir proto_pkg_configs
+ pkgroot = takeDirectory conf_file
+ pkg_configs1 = map (mungePackagePaths top_dir pkgroot) proto_pkg_configs
pkg_configs2 = maybeHidePackages dflags pkg_configs1
--
return pkg_configs2
where
hide pkg = pkg{ exposed = False }
-mungePackagePaths :: String -> [PackageConfig] -> [PackageConfig]
--- Replace the string "$topdir" at the beginning of a path
--- with the current topdir (obtained from the -B option).
-mungePackagePaths top_dir ps = map munge_pkg ps
- where
- munge_pkg p = p{ importDirs = munge_paths (importDirs p),
- includeDirs = munge_paths (includeDirs p),
- libraryDirs = munge_paths (libraryDirs p),
- frameworkDirs = munge_paths (frameworkDirs p),
- haddockInterfaces = munge_paths (haddockInterfaces p),
- haddockHTMLs = munge_paths (haddockHTMLs p)
- }
-
- munge_paths = map munge_path
-
- munge_path p
- | Just p' <- stripPrefix "$topdir" p = top_dir ++ p'
- | Just p' <- stripPrefix "$httptopdir" p = toHttpPath top_dir ++ p'
- | otherwise = p
-
- toHttpPath p = "file:///" ++ p
+-- TODO: This code is duplicated in utils/ghc-pkg/Main.hs
+mungePackagePaths :: FilePath -> FilePath -> PackageConfig -> PackageConfig
+-- Perform path/URL variable substitution as per the Cabal ${pkgroot} spec
+-- (http://www.haskell.org/pipermail/libraries/2009-May/011772.html)
+-- Paths/URLs can be relative to ${pkgroot} or ${pkgrooturl}.
+-- The "pkgroot" is the directory containing the package database.
+--
+-- Also perform a similar substitution for the older GHC-specific
+-- "$topdir" variable. The "topdir" is the location of the ghc
+-- installation (obtained from the -B option).
+mungePackagePaths top_dir pkgroot pkg =
+ pkg {
+ importDirs = munge_paths (importDirs pkg),
+ includeDirs = munge_paths (includeDirs pkg),
+ libraryDirs = munge_paths (libraryDirs pkg),
+ frameworkDirs = munge_paths (frameworkDirs pkg),
+ haddockInterfaces = munge_paths (haddockInterfaces pkg),
+ haddockHTMLs = munge_urls (haddockHTMLs pkg)
+ }
+ where
+ munge_paths = map munge_path
+ munge_urls = map munge_url
+
+ munge_path p
+ | Just p' <- stripVarPrefix "${pkgroot}" p = pkgroot ++ p'
+ | Just p' <- stripVarPrefix "$topdir" p = top_dir ++ p'
+ | otherwise = p
+
+ munge_url p
+ | Just p' <- stripVarPrefix "${pkgrooturl}" p = toUrlPath pkgroot p'
+ | Just p' <- stripVarPrefix "$httptopdir" p = toUrlPath top_dir p'
+ | otherwise = p
+
+ toUrlPath r p = "file:///"
+ -- URLs always use posix style '/' separators:
+ ++ FilePath.Posix.joinPath
+ (r : -- We need to drop a leading "/" or "\\"
+ -- if there is one:
+ dropWhile (all isPathSeparator)
+ (FilePath.splitDirectories p))
+
+ -- We could drop the separator here, and then use </> above. However,
+ -- by leaving it in and using ++ we keep the same path separator
+ -- rather than letting FilePath change it to use \ as the separator
+ stripVarPrefix var path = case stripPrefix var path of
+ Just [] -> Just []
+ Just cs@(c : _) | isPathSeparator c -> Just cs
+ _ -> Nothing
-- -----------------------------------------------------------------------------
integerPackageId,
basePackageId,
rtsPackageId,
- haskell98PackageId,
thPackageId,
dphSeqPackageId,
dphParPackageId ]
-> IO (PackageState,
[PackageId], -- new packages to preload
PackageId) -- this package, might be modified if the current
-
-- package is a wired-in package.
mkPackageState dflags pkgs0 preload0 this_package = do
-}
let
- flags = reverse (packageFlags dflags)
+ flags = reverse (packageFlags dflags) ++ dphPackage
+ -- expose the appropriate DPH backend library
+ dphPackage = case dphBackend dflags of
+ DPHPar -> [ExposePackage "dph-prim-par", ExposePackage "dph-par"]
+ DPHSeq -> [ExposePackage "dph-prim-seq", ExposePackage "dph-seq"]
+ DPHThis -> []
+ DPHNone -> []
-- pkgs0 with duplicate packages filtered out. This is
-- important: it is possible for a package in the global package
-- set up preloaded package when we are just building it
preload3 = nub $ filter (/= this_package)
$ (basicLinkedPackages ++ preload2)
-
+
-- Close the preload packages with their dependencies
dep_preload <- closeDeps pkg_db ipid_map (zip preload3 (repeat Nothing))
let new_dep_preload = filter (`notElem` preload0) dep_preload
let pstate = PackageState{ preloadPackages = dep_preload,
- pkgIdMap = pkg_db,
- moduleToPkgConfAll = mkModuleMap pkg_db,
+ pkgIdMap = pkg_db,
+ moduleToPkgConfAll = mkModuleMap pkg_db,
installedPackageIdMap = ipid_map
- }
+ }
return (pstate, new_dep_preload, this_package)
-
+
-- -----------------------------------------------------------------------------
-- Make the mapping from module to package info
-- @(pkgconf, exposed)@ where pkgconf is the PackageConfig for that package,
-- and exposed is @True@ if the package exposes the module.
lookupModuleInAllPackages :: DynFlags -> ModuleName -> [(PackageConfig,Bool)]
-lookupModuleInAllPackages dflags m =
- case lookupUFM (moduleToPkgConfAll (pkgState dflags)) m of
- Nothing -> []
- Just ps -> ps
+lookupModuleInAllPackages dflags m
+ = case lookupModuleWithSuggestions dflags m of
+ Right pbs -> pbs
+ Left _ -> []
+
+lookupModuleWithSuggestions
+ :: DynFlags -> ModuleName
+ -> Either [Module] [(PackageConfig,Bool)]
+ -- Lookup module in all packages
+ -- Right pbs => found in pbs
+ -- Left ms => not found; but here are sugestions
+lookupModuleWithSuggestions dflags m
+ = case lookupUFM (moduleToPkgConfAll pkg_state) m of
+ Nothing -> Left suggestions
+ Just ps -> Right ps
+ where
+ pkg_state = pkgState dflags
+ suggestions
+ | dopt Opt_HelpfulErrors dflags = fuzzyLookup (moduleNameString m) all_mods
+ | otherwise = []
+
+ all_mods :: [(String, Module)] -- All modules
+ all_mods = [ (moduleNameString mod_nm, mkModule pkg_id mod_nm)
+ | pkg_config <- eltsUFM (pkgIdMap pkg_state)
+ , let pkg_id = packageConfigId pkg_config
+ , mod_nm <- exposedModules pkg_config ]
-- | Find all the 'PackageConfig' in both the preload packages from 'DynFlags' and corresponding to the list of
-- 'PackageConfig's
projects / ghc-hetmet.git / blobdiff