X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=utils%2Fghc-pkg%2FMain.hs;h=2157d071a118ffae2ecbdde84e526db501cadf2e;hp=e0bae2f384e2149c46ca08bd7e7ef53bbb3a59b2;hb=37557940c005d34fc755203139cfaa555fdb3cb8;hpb=f300abd65061cdc2cc1db685570fefa958b06679 diff --git a/utils/ghc-pkg/Main.hs b/utils/ghc-pkg/Main.hs index e0bae2f..2157d07 100644 --- a/utils/ghc-pkg/Main.hs +++ b/utils/ghc-pkg/Main.hs @@ -224,10 +224,12 @@ runit cli nonopts = do pkgid <- readGlobPkgId pkgid_str hidePackage pkgid cli ["list"] -> do - listPackages cli Nothing + listPackages cli Nothing Nothing ["list", pkgid_str] -> do pkgid <- readGlobPkgId pkgid_str - listPackages cli (Just pkgid) + listPackages cli (Just pkgid) Nothing + ["find-module", moduleName] -> do + listPackages cli Nothing (Just moduleName) ["latest", pkgid_str] -> do pkgid <- readGlobPkgId pkgid_str latestPackage cli pkgid @@ -408,10 +410,9 @@ registerPackage input defines flags auto_ghci_libs update force = do expanded <- expandEnvVars s defines force - pkg0 <- parsePackageInfo expanded defines + pkg <- parsePackageInfo expanded defines putStrLn "done." - pkg <- resolveDeps db_stack pkg0 validatePackageConfig pkg db_stack auto_ghci_libs update force let new_details = filter not_this (snd db_to_operate_on) ++ [pkg] not_this p = package p /= package pkg @@ -461,14 +462,17 @@ modifyPackage fn pkgid flags = do -- ----------------------------------------------------------------------------- -- Listing packages -listPackages :: [Flag] -> Maybe PackageIdentifier -> IO () -listPackages flags mPackageName = do +listPackages :: [Flag] -> Maybe PackageIdentifier -> Maybe String -> IO () +listPackages flags mPackageName mModuleName = do let simple_output = FlagSimpleOutput `elem` flags db_stack <- getPkgDatabases False flags let db_stack_filtered -- if a package is given, filter out all other packages | Just this <- mPackageName = map (\(conf,pkgs) -> (conf, filter (this `matchesPkg`) pkgs)) db_stack + | Just this <- mModuleName = -- packages which expose mModuleName + map (\(conf,pkgs) -> (conf, filter (this `exposedInPkg`) pkgs)) + db_stack | otherwise = db_stack db_stack_sorted @@ -546,6 +550,9 @@ pid `matchesPkg` pkg = pid `matches` package pkg compPkgIdVer :: PackageIdentifier -> PackageIdentifier -> Ordering compPkgIdVer p1 p2 = pkgVersion p1 `compare` pkgVersion p2 +exposedInPkg :: String -> InstalledPackageInfo -> Bool +moduleName `exposedInPkg` pkg = moduleName `elem` exposedModules pkg + -- ----------------------------------------------------------------------------- -- Field @@ -719,40 +726,6 @@ checkPackageId ipi = [] -> die ("invalid package identifier: " ++ str) _ -> die ("ambiguous package identifier: " ++ str) --- ToDo: remove this (see #1837) -resolveDeps :: PackageDBStack -> InstalledPackageInfo -> IO InstalledPackageInfo -resolveDeps db_stack p = do - when (not (null unversioned_deps)) $ - hPutStr stderr ("WARNING: unversioned dependencies are deprecated, "++ - "and will NOT be accepted by GHC 6.10: " ++ - unwords (map showPackageId unversioned_deps) ++ "\n") - return (updateDeps p) - where - unversioned_deps = filter (not.realVersion) (depends p) - - -- The input package spec is allowed to give a package dependency - -- without a version number; e.g. - -- depends: base - -- Here, we update these dependencies without version numbers to - -- match the actual versions of the relevant packages installed. - updateDeps p = p{depends = map resolveDep (depends p)} - - resolveDep dep_pkgid - | realVersion dep_pkgid = dep_pkgid - | otherwise = lookupDep dep_pkgid - - lookupDep dep_pkgid - = let - name = pkgName dep_pkgid - in - case [ pid | p <- concat (map snd db_stack), - let pid = package p, - pkgName pid == name ] of - (pid:_) -> pid -- Found installed package, - -- replete with its version - [] -> dep_pkgid -- No installed package; use - -- the version-less one - checkDuplicates :: PackageDBStack -> InstalledPackageInfo -> Bool -> IO () checkDuplicates db_stack pkg update = do let @@ -959,8 +932,8 @@ oldRunit clis = do defines = [ (nm,val) | OF_DefinedName nm val <- clis ] case [ c | c <- clis, isAction c ] of - [ OF_List ] -> listPackages new_flags Nothing - [ OF_ListLocal ] -> listPackages new_flags Nothing + [ OF_List ] -> listPackages new_flags Nothing Nothing + [ OF_ListLocal ] -> listPackages new_flags Nothing Nothing [ OF_Add upd ] -> registerPackage input_file defines new_flags auto_ghci_libs upd force [ OF_Remove pkgid_str ] -> do