Follow changes in Cabal: package -> sourcePackageId

diff --git a/compiler/ghci/Linker.lhs b/compiler/ghci/Linker.lhs
index 4c85ac6..8d0d6ba 100644 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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"++