From f871cf1bf889704a4ec1f0063ad4d96f31453ea3 Mon Sep 17 00:00:00 2001 From: Simon Marlow Date: Mon, 24 Aug 2009 16:00:20 +0000 Subject: [PATCH] Follow changes in Cabal: package -> sourcePackageId --- compiler/ghci/Linker.lhs | 4 ++-- compiler/main/CodeOutput.lhs | 2 +- compiler/main/PackageConfig.hs | 2 +- compiler/main/Packages.lhs | 31 +++++++++++++------------ compiler/main/ParsePkgConf.y | 2 +- utils/ghc-pkg/Main.hs | 50 ++++++++++++++++++++-------------------- 6 files changed, 46 insertions(+), 45 deletions(-) diff --git a/compiler/ghci/Linker.lhs b/compiler/ghci/Linker.lhs index 4c85ac6..8d0d6ba 100644 --- a/compiler/ghci/Linker.lhs +++ b/compiler/ghci/Linker.lhs @@ -1024,7 +1024,7 @@ linkPackage dflags pkg let dlls = [ dll | DLL dll <- classifieds ] objs = [ obj | Object obj <- classifieds ] - maybePutStr dflags ("Loading package " ++ display (package pkg) ++ " ... ") + maybePutStr dflags ("Loading package " ++ display (sourcePackageId pkg) ++ " ... ") -- See comments with partOfGHCi when (packageName pkg `notElem` partOfGHCi) $ do @@ -1048,7 +1048,7 @@ linkPackage dflags pkg maybePutStr dflags "linking ... " ok <- resolveObjs if succeeded ok then maybePutStrLn dflags "done." - else ghcError (InstallationError ("unable to load package `" ++ display (package pkg) ++ "'")) + else ghcError (InstallationError ("unable to load package `" ++ display (sourcePackageId pkg) ++ "'")) load_dyn :: [FilePath] -> FilePath -> IO () load_dyn dirs dll = do r <- loadDynamic dirs dll diff --git a/compiler/main/CodeOutput.lhs b/compiler/main/CodeOutput.lhs index d362fb4..2d68b83 100644 --- a/compiler/main/CodeOutput.lhs +++ b/compiler/main/CodeOutput.lhs @@ -127,7 +127,7 @@ outputC dflags filenm flat_absC packages _ -> "#include \""++h_file++"\"" pkg_configs <- getPreloadPackagesAnd dflags packages - let pkg_names = map (display.package) pkg_configs + let pkg_names = map (display.sourcePackageId) pkg_configs doOutput filenm $ \ h -> do hPutStr h ("/* GHC_PACKAGES " ++ unwords pkg_names ++ "\n*/\n") diff --git a/compiler/main/PackageConfig.hs b/compiler/main/PackageConfig.hs index 79521c7..ac1a9fe 100644 --- a/compiler/main/PackageConfig.hs +++ b/compiler/main/PackageConfig.hs @@ -59,7 +59,7 @@ mkPackageId = stringToPackageId . display -- | Get the GHC 'PackageId' right out of a Cabalish 'PackageConfig' packageConfigId :: PackageConfig -> PackageId -packageConfigId = mkPackageId . package +packageConfigId = mkPackageId . sourcePackageId -- | Turn a 'PackageConfig', which contains GHC 'Module.ModuleName's into a Cabal specific -- 'InstalledPackageInfo' which contains Cabal 'Distribution.ModuleName.ModuleName's diff --git a/compiler/main/Packages.lhs b/compiler/main/Packages.lhs index c4b8860..e73ee75 100644 --- a/compiler/main/Packages.lhs +++ b/compiler/main/Packages.lhs @@ -291,7 +291,7 @@ applyPackageFlag pkgs flag = Just ([], _) -> panic "applyPackageFlag" Just (p:ps,qs) -> return (p':ps') where p' = p {exposed=True} - ps' = hideAll (pkgName (package p)) (ps++qs) + ps' = hideAll (pkgName (sourcePackageId p)) (ps++qs) HidePackage str -> case matchingPackages str pkgs of @@ -310,8 +310,9 @@ applyPackageFlag pkgs flag = -- When a package is requested to be exposed, we hide all other -- packages with the same name. hideAll name ps = map maybe_hide ps - where maybe_hide p | pkgName (package p) == name = p {exposed=False} - | otherwise = p + where maybe_hide p + | pkgName (sourcePackageId p) == name = p {exposed=False} + | otherwise = p matchingPackages :: String -> [PackageConfig] @@ -325,15 +326,15 @@ matchingPackages str pkgs -- version, or just the name if it is unambiguous. packageMatches :: String -> PackageConfig -> Bool packageMatches str p - = str == display (package p) - || str == display (pkgName (package p)) + = str == display (sourcePackageId p) + || str == display (pkgName (sourcePackageId p)) pickPackages :: [PackageConfig] -> [String] -> [PackageConfig] pickPackages pkgs strs = [ p | p <- strs, Just (p:_, _) <- [matchingPackages p pkgs] ] sortByVersion :: [InstalledPackageInfo_ m] -> [InstalledPackageInfo_ m] -sortByVersion = sortBy (flip (comparing (pkgVersion.package))) +sortByVersion = sortBy (flip (comparing (pkgVersion.sourcePackageId))) comparing :: Ord a => (t -> a) -> t -> t -> Ordering comparing f a b = f a `compare` f b @@ -354,15 +355,15 @@ hideOldPackages dflags pkgs = mapM maybe_hide pkgs | (p' : _) <- later_versions = do debugTraceMsg dflags 2 $ (ptext (sLit "hiding package") <+> - text (display (package p)) <+> + text (display (sourcePackageId p)) <+> ptext (sLit "to avoid conflict with later version") <+> - text (display (package p'))) + text (display (sourcePackageId p'))) return (p {exposed=False}) | otherwise = return p - where myname = pkgName (package p) - myversion = pkgVersion (package p) + where myname = pkgName (sourcePackageId p) + myversion = pkgVersion (sourcePackageId p) later_versions = [ p | p <- pkgs, exposed p, - let pkg = package p, + let pkg = sourcePackageId p, pkgName pkg == myname, pkgVersion pkg > myversion ] @@ -392,7 +393,7 @@ findWiredInPackages dflags pkgs = do dphParPackageId ] matches :: PackageConfig -> String -> Bool - pc `matches` pid = display (pkgName (package pc)) == pid + pc `matches` pid = display (pkgName (sourcePackageId pc)) == pid -- find which package corresponds to each wired-in package -- delete any other packages with the same name @@ -425,7 +426,7 @@ findWiredInPackages dflags pkgs = do ptext (sLit "wired-in package ") <> text wired_pkg <> ptext (sLit " mapped to ") - <> text (display (package pkg)) + <> text (display (sourcePackageId pkg)) return (Just (installedPackageId pkg)) @@ -449,7 +450,7 @@ findWiredInPackages dflags pkgs = do updateWiredInDependencies pkgs = map upd_pkg pkgs where upd_pkg p | installedPackageId p `elem` wired_in_ids - = p { package = (package p){ pkgVersion = Version [] [] } } + = p { sourcePackageId = (sourcePackageId p){ pkgVersion = Version [] [] } } | otherwise = p @@ -591,7 +592,7 @@ mkModuleMap pkg_db = foldr extend_modmap emptyUFM pkgids hidden_mods = hiddenModules pkg pprPkg :: PackageConfig -> SDoc -pprPkg p = text (display (package p)) +pprPkg p = text (display (sourcePackageId p)) -- ----------------------------------------------------------------------------- -- Extracting information from the packages in scope diff --git a/compiler/main/ParsePkgConf.y b/compiler/main/ParsePkgConf.y index d05a6d5..4950b5f 100644 --- a/compiler/main/ParsePkgConf.y +++ b/compiler/main/ParsePkgConf.y @@ -62,7 +62,7 @@ fields :: { PackageConfig -> PackageConfig } field :: { PackageConfig -> PackageConfig } : VARID '=' pkgid {% case unpackFS $1 of - "package" -> return (\p -> p{package = $3}) + "sourcePackageId" -> return (\p -> p{sourcePackageId = $3}) _ -> happyError } diff --git a/utils/ghc-pkg/Main.hs b/utils/ghc-pkg/Main.hs index a13ba44..ee2f319 100644 --- a/utils/ghc-pkg/Main.hs +++ b/utils/ghc-pkg/Main.hs @@ -551,7 +551,7 @@ registerPackage input verbosity my_flags auto_ghci_libs update force = do -- packages lower in the stack to refer to those higher up. validatePackageConfig pkg truncated_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 + not_this p = sourcePackageId p /= sourcePackageId pkg writeNewConfig verbosity to_modify new_details parsePackageInfo @@ -589,10 +589,10 @@ modifyPackage fn pkgid verbosity my_flags force = do -- let ((db_name, pkgs) : rest_of_stack) = db_stack -- ps <- findPackages [(db_name,pkgs)] (Id pkgid) let - pids = map package ps + pids = map sourcePackageId ps modify pkg - | package pkg `elem` pids = fn pkg - | otherwise = [pkg] + | sourcePackageId pkg `elem` pids = fn pkg + | otherwise = [pkg] new_config = concat (map modify pkgs) let @@ -600,8 +600,8 @@ modifyPackage fn pkgid verbosity my_flags force = do rest_of_stack = [ (nm, mypkgs) | (nm, mypkgs) <- db_stack, nm /= db_name ] new_stack = (db_name,new_config) : rest_of_stack - new_broken = map package (brokenPackages (allPackagesInStack new_stack)) - newly_broken = filter (`notElem` map package old_broken) new_broken + new_broken = map sourcePackageId (brokenPackages (allPackagesInStack new_stack)) + newly_broken = filter (`notElem` map sourcePackageId old_broken) new_broken -- when (not (null newly_broken)) $ dieOrForceAll force ("unregistering " ++ display pkgid ++ @@ -636,12 +636,12 @@ listPackages verbosity my_flags mPackageName mModuleName = do LT -> LT GT -> GT EQ -> pkgVersion p1 `compare` pkgVersion p2 - where (p1,p2) = (package pkg1, package pkg2) + where (p1,p2) = (sourcePackageId pkg1, sourcePackageId pkg2) match `exposedInPkg` pkg = any match (map display $ exposedModules pkg) pkg_map = allPackagesInStack db_stack - broken = map package (brokenPackages pkg_map) + broken = map sourcePackageId (brokenPackages pkg_map) show_func = if simple_output then show_simple else mapM_ show_normal @@ -653,7 +653,7 @@ listPackages verbosity my_flags mPackageName mModuleName = do | verbosity >= Verbose = vcat (map pp_pkg pkg_confs) | otherwise = fsep (punctuate comma (map pp_pkg pkg_confs)) pp_pkg p - | package p `elem` broken = braces doc + | sourcePackageId p `elem` broken = braces doc | exposed p = doc | otherwise = parens doc where doc | verbosity >= Verbose = pkg <+> parens ipid @@ -661,7 +661,7 @@ listPackages verbosity my_flags mPackageName mModuleName = do where InstalledPackageId ipid_str = installedPackageId p ipid = text ipid_str - pkg = text (display (package p)) + pkg = text (display (sourcePackageId p)) show_simple = simplePackageList my_flags . allPackagesInStack @@ -675,7 +675,7 @@ simplePackageList :: [Flag] -> [InstalledPackageInfo] -> IO () simplePackageList my_flags pkgs = do let showPkg = if FlagNamesOnly `elem` my_flags then display . pkgName else display - strs = map showPkg $ sortBy compPkgIdVer $ map package pkgs + strs = map showPkg $ sortBy compPkgIdVer $ map sourcePackageId pkgs when (not (null pkgs)) $ hPutStrLn stdout $ concat $ intersperse " " strs @@ -689,10 +689,10 @@ showPackageDot _verbosity myflags = do let quote s = '"':s ++ "\"" mapM_ putStrLn [ quote from ++ " -> " ++ quote to | p <- all_pkgs, - let from = display (package p), + let from = display (sourcePackageId p), depid <- depends p, Just dep <- [PackageIndex.lookupInstalledPackage ipix depid], - let to = display (package dep) + let to = display (sourcePackageId dep) ] putStrLn "}" @@ -703,7 +703,7 @@ latestPackage :: [Flag] -> PackageIdentifier -> IO () latestPackage my_flags pkgid = do (db_stack, _) <- getPkgDatabases False my_flags ps <- findPackages db_stack (Id pkgid) - show_pkg (sortBy compPkgIdVer (map package ps)) + show_pkg (sortBy compPkgIdVer (map sourcePackageId ps)) where show_pkg [] = die "no matches" show_pkg pids = hPutStrLn stdout (display (last pids)) @@ -753,8 +753,8 @@ realVersion pkgid = versionBranch (pkgVersion pkgid) /= [] -- when versionBranch == [], this is a glob matchesPkg :: PackageArg -> InstalledPackageInfo -> Bool -(Id pid) `matchesPkg` pkg = pid `matches` package pkg -(Substring _ m) `matchesPkg` pkg = m (display (package pkg)) +(Id pid) `matchesPkg` pkg = pid `matches` sourcePackageId pkg +(Substring _ m) `matchesPkg` pkg = m (display (sourcePackageId pkg)) compPkgIdVer :: PackageIdentifier -> PackageIdentifier -> Ordering compPkgIdVer p1 p2 = pkgVersion p1 `compare` pkgVersion p2 @@ -844,7 +844,7 @@ checkConsistency my_flags = do then return [] else do when (not simple_output) $ do - reportError ("There are problems in package " ++ display (package p) ++ ":") + reportError ("There are problems in package " ++ display (sourcePackageId p) ++ ":") _ <- reportValidateErrors es " " Nothing return () return [p] @@ -852,8 +852,8 @@ checkConsistency my_flags = do broken_pkgs <- concat `fmap` mapM checkPackage pkgs let filterOut pkgs1 pkgs2 = filter not_in pkgs2 - where not_in p = package p `notElem` all_ps - all_ps = map package pkgs1 + where not_in p = sourcePackageId p `notElem` all_ps + all_ps = map sourcePackageId pkgs1 let not_broken_pkgs = filterOut broken_pkgs pkgs (_, trans_broken_pkgs) = closure [] not_broken_pkgs @@ -865,7 +865,7 @@ checkConsistency my_flags = do else do reportError ("\nThe following packages are broken, either because they have a problem\n"++ "listed above, or because they depend on a broken package.") - mapM_ (hPutStrLn stderr . display . package) all_broken_pkgs + mapM_ (hPutStrLn stderr . display . sourcePackageId) all_broken_pkgs when (not (null all_broken_pkgs)) $ exitWith (ExitFailure 1) @@ -977,7 +977,7 @@ validatePackageConfig :: InstalledPackageInfo -> IO () validatePackageConfig pkg db_stack auto_ghci_libs update force = do (_,es) <- runValidate $ checkPackageConfig pkg db_stack auto_ghci_libs update - ok <- reportValidateErrors es (display (package pkg) ++ ": ") (Just force) + ok <- reportValidateErrors es (display (sourcePackageId pkg) ++ ": ") (Just force) when (not ok) $ exitWith (ExitFailure 1) checkPackageConfig :: InstalledPackageInfo @@ -1018,7 +1018,7 @@ checkInstalledPackageId ipi db_stack update = do -- we check that the package id can be parsed properly here. checkPackageId :: InstalledPackageInfo -> Validate () checkPackageId ipi = - let str = display (package ipi) in + let str = display (sourcePackageId ipi) in case [ x :: PackageIdentifier | (x,ys) <- readP_to_S parse str, all isSpace ys ] of [_] -> return () [] -> verror CannotForce ("invalid package identifier: " ++ str) @@ -1027,18 +1027,18 @@ checkPackageId ipi = checkDuplicates :: PackageDBStack -> InstalledPackageInfo -> Bool -> Validate () checkDuplicates db_stack pkg update = do let - pkgid = package pkg + pkgid = sourcePackageId pkg (_top_db_name, pkgs) : _ = db_stack -- -- Check whether this package id already exists in this DB -- - when (not update && (pkgid `elem` map package pkgs)) $ + when (not update && (pkgid `elem` map sourcePackageId pkgs)) $ verror CannotForce $ "package " ++ display pkgid ++ " is already installed" let uncasep = map toLower . display - dups = filter ((== uncasep pkgid) . uncasep) (map package pkgs) + dups = filter ((== uncasep pkgid) . uncasep) (map sourcePackageId pkgs) when (not update && not (null dups)) $ verror ForceAll $ "Package names may be treated case-insensitively in the future.\n"++ -- 1.7.10.4