Switch from -this-package-key to -this-unit-id.

A small cosmetic change, but we have to do a bit of work to
actually support it:

    - Cabal submodule update, so that Cabal passes us
      -this-unit-id when we ask for it.  This includes
      a Cabal renaming to be consistent with Unit ID, which
      makes ghc-pkg a bit more scrutable.

    - Build system is updated to use -this-unit-id rather than
      -this-package-key, to avoid deprecation warnings.  Needs
      a version test so I resurrected the old test we had
      (sorry rwbarton!)

    - I've *undeprecated* -package-name, so that we are in the same
      state as GHC 7.10, since the "correct" flag will have only
      entered circulation in GHC 8.0.

    - I removed -package-key.  Since we didn't deprecate -package-id
      I think this should not cause any problems for users; they
      can just change their code to use -package-id.

    - The package database is indexed by UNIT IDs, not component IDs.
      I updated the naming here.

    - I dropped the signatures field from ExposedModule; nothing
      was using it, and instantiatedWith from the package database
      field.

    - ghc-pkg was updated to use unit ID nomenclature, I removed
      the -package-key flags but I decided not to add any new flags
      for now.

Signed-off-by: Edward Z. Yang <ezyang@cs.stanford.edu>

Test Plan: validate

Reviewers: austin, hvr, bgamari

Reviewed By: bgamari

Subscribers: 23Skidoo, thomie, erikd

Differential Revision: https://phabricator.haskell.org/D1780

1 files changed, 44 insertions, 51 deletions

diff --git a/utils/ghc-pkg/Main.hs b/utils/ghc-pkg/Main.hs
index 4a3fbdb294..0845792198 100644
--- a/utils/ghc-pkg/Main.hs
+++ b/utils/ghc-pkg/Main.hs
@@ -19,7 +19,7 @@ import Distribution.ModuleName (ModuleName)
 import Distribution.InstalledPackageInfo as Cabal
 import Distribution.Compat.ReadP hiding (get)
 import Distribution.ParseUtils
-import Distribution.Package hiding (installedComponentId)
+import Distribution.Package hiding (installedUnitId)
 import Distribution.Text
 import Distribution.Version
 import Distribution.Simple.Utils (fromUTF8, toUTF8, writeUTF8File, readUTF8File)
@@ -132,7 +132,7 @@ data Flag
   | FlagIgnoreCase
   | FlagNoUserDb
   | FlagVerbosity (Maybe String)
-  | FlagComponentId
+  | FlagUnitId
   deriving Eq
 
 flags :: [OptDescr Flag]
@@ -175,8 +175,8 @@ flags = [
         "only print package names, not versions; can only be used with list --simple-output",
   Option [] ["ignore-case"] (NoArg FlagIgnoreCase)
         "ignore case for substring matching",
-  Option [] ["ipid", "package-key"] (NoArg FlagComponentId)
-        "interpret package arguments as installed package IDs",
+  Option [] ["ipid", "unit-id"] (NoArg FlagUnitId)
+        "interpret package arguments as unit IDs (e.g. installed package IDs)",
   Option ['v'] ["verbose"] (OptArg FlagVerbosity "Verbosity")
         "verbosity level (0-2, default 1)"
   ]
@@ -315,7 +315,7 @@ data Force = NoForce | ForceFiles | ForceAll | CannotForce
 
 -- | Enum flag representing argument type
 data AsPackageArg
-    = AsComponentId
+    = AsUnitId
     | AsDefault
 
 -- | Represents how a package may be specified by a user on the command line.
@@ -324,7 +324,7 @@ data PackageArg
     = Id PackageIdentifier
     -- | An installed package ID foo-0.1-HASH.  This is guaranteed to uniquely
     -- match a single entry in the package database.
-    | ICId ComponentId
+    | IUId UnitId
     -- | A glob against the package name.  The first string is the literal
     -- glob, the second is a function which returns @True@ if the argument
     -- matches.
@@ -341,8 +341,8 @@ runit verbosity cli nonopts = do
           | FlagForce `elem` cli        = ForceAll
           | FlagForceFiles `elem` cli   = ForceFiles
           | otherwise                   = NoForce
-        as_arg | FlagComponentId        `elem` cli = AsComponentId
-               | otherwise                  = AsDefault
+        as_arg | FlagUnitId `elem` cli = AsUnitId
+               | otherwise             = AsDefault
         multi_instance = FlagMultiInstance `elem` cli
         expand_env_vars= FlagExpandEnvVars `elem` cli
         mexpand_pkgroot= foldl' accumExpandPkgroot Nothing cli
@@ -494,8 +494,8 @@ parseGlobPackageId =
       return (PackageIdentifier{ pkgName = n, pkgVersion = globVersion }))
 
 readPackageArg :: AsPackageArg -> String -> IO PackageArg
-readPackageArg AsComponentId str =
-    parseCheck (ICId `fmap` parse) str "installed package id"
+readPackageArg AsUnitId str =
+    parseCheck (IUId `fmap` parse) str "installed package id"
 readPackageArg AsDefault str = Id `fmap` readGlobPkgId str
 
 -- globVersion means "all versions"
@@ -1021,7 +1021,7 @@ updateInternalDB :: PackageDB -> [DBOp] -> PackageDB
 updateInternalDB db cmds = db{ packages = foldl do_cmd (packages db) cmds }
  where
   do_cmd pkgs (RemovePackage p) =
-    filter ((/= installedComponentId p) . installedComponentId) pkgs
+    filter ((/= installedUnitId p) . installedUnitId) pkgs
   do_cmd pkgs (AddPackage p) = p : pkgs
   do_cmd pkgs (ModifyPackage p) =
     do_cmd (do_cmd pkgs (RemovePackage p)) (AddPackage p)
@@ -1033,11 +1033,11 @@ changeDBDir verbosity cmds db = do
   updateDBCache verbosity db
  where
   do_cmd (RemovePackage p) = do
-    let file = location db </> display (installedComponentId p) <.> "conf"
+    let file = location db </> display (installedUnitId p) <.> "conf"
     when (verbosity > Normal) $ infoLn ("removing " ++ file)
     removeFileSafe file
   do_cmd (AddPackage p) = do
-    let file = location db </> display (installedComponentId p) <.> "conf"
+    let file = location db </> display (installedUnitId p) <.> "conf"
     when (verbosity > Normal) $ infoLn ("writing " ++ file)
     writeUTF8File file (showInstalledPackageInfo p)
   do_cmd (ModifyPackage p) =
@@ -1071,7 +1071,6 @@ updateDBCache verbosity db = do
       hPutChar handle c
 
 type PackageCacheFormat = GhcPkg.InstalledPackageInfo
-                            String     -- installed package id
                             String     -- src package id
                             String     -- package name
                             String     -- unit id
@@ -1080,11 +1079,10 @@ type PackageCacheFormat = GhcPkg.InstalledPackageInfo
 convertPackageInfoToCacheFormat :: InstalledPackageInfo -> PackageCacheFormat
 convertPackageInfoToCacheFormat pkg =
     GhcPkg.InstalledPackageInfo {
-       GhcPkg.componentId = display (installedComponentId pkg),
+       GhcPkg.unitId             = display (installedUnitId pkg),
        GhcPkg.sourcePackageId    = display (sourcePackageId pkg),
        GhcPkg.packageName        = display (packageName pkg),
        GhcPkg.packageVersion     = packageVersion pkg,
-       GhcPkg.unitId            = display (installedComponentId pkg),
        GhcPkg.depends            = map display (depends pkg),
        GhcPkg.abiHash            = let AbiHash abi = abiHash pkg
                                    in abi,
@@ -1103,16 +1101,13 @@ convertPackageInfoToCacheFormat pkg =
        GhcPkg.haddockHTMLs       = haddockHTMLs pkg,
        GhcPkg.exposedModules     = map convertExposed (exposedModules pkg),
        GhcPkg.hiddenModules      = hiddenModules pkg,
-       GhcPkg.instantiatedWith   = map convertInst (instantiatedWith pkg),
        GhcPkg.exposed            = exposed pkg,
        GhcPkg.trusted            = trusted pkg
     }
-  where convertExposed (ExposedModule n reexport sig) =
+  where convertExposed (ExposedModule n reexport) =
             GhcPkg.ExposedModule n (fmap convertOriginal reexport)
-                                   (fmap convertOriginal sig)
         convertOriginal (OriginalModule ipid m) =
             GhcPkg.OriginalModule (display ipid) m
-        convertInst (m, o) = (m, convertOriginal o)
 
 instance GhcPkg.BinaryStringRep ModuleName where
   fromStringRep = ModuleName.fromString . fromUTF8 . BS.unpack
@@ -1159,9 +1154,9 @@ modifyPackage fn pkgarg verbosity my_flags force = do
       db_name = location db
       pkgs    = packages db
 
-      pks = map installedComponentId ps
+      pks = map installedUnitId ps
 
-      cmds = [ fn pkg | pkg <- pkgs, installedComponentId pkg `elem` pks ]
+      cmds = [ fn pkg | pkg <- pkgs, installedUnitId pkg `elem` pks ]
       new_db = updateInternalDB db cmds
 
       -- ...but do consistency checks with regards to the full stack
@@ -1169,14 +1164,14 @@ modifyPackage fn pkgarg verbosity my_flags force = do
       rest_of_stack = filter ((/= db_name) . location) db_stack
       new_stack = new_db : rest_of_stack
       new_broken = brokenPackages (allPackagesInStack new_stack)
-      newly_broken = filter ((`notElem` map installedComponentId old_broken)
-                            . installedComponentId) new_broken
+      newly_broken = filter ((`notElem` map installedUnitId old_broken)
+                            . installedUnitId) new_broken
   --
   let displayQualPkgId pkg
         | [_] <- filter ((== pkgid) . sourcePackageId)
                         (allPackagesInStack db_stack)
             = display pkgid
-        | otherwise = display pkgid ++ "@" ++ display (installedComponentId pkg)
+        | otherwise = display pkgid ++ "@" ++ display (installedUnitId pkg)
         where pkgid = sourcePackageId pkg
   when (not (null newly_broken)) $
       dieOrForceAll force ("unregistering would break the following packages: "
@@ -1227,7 +1222,7 @@ listPackages verbosity my_flags mPackageName mModuleName = do
                         EQ -> case pkgVersion p1 `compare` pkgVersion p2 of
                                 LT -> LT
                                 GT -> GT
-                                EQ -> installedComponentId pkg1 `compare` installedComponentId pkg2
+                                EQ -> installedUnitId pkg1 `compare` installedUnitId pkg2
                    where (p1,p2) = (sourcePackageId pkg1, sourcePackageId pkg2)
 
       stack = reverse db_stack_sorted
@@ -1235,7 +1230,7 @@ listPackages verbosity my_flags mPackageName mModuleName = do
       match `exposedInPkg` pkg = any match (map display $ exposedModules pkg)
 
       pkg_map = allPackagesInStack db_stack
-      broken = map installedComponentId (brokenPackages pkg_map)
+      broken = map installedUnitId (brokenPackages pkg_map)
 
       show_normal PackageDB{ location = db_name, packages = pkg_confs } =
           do hPutStrLn stdout db_name
@@ -1244,13 +1239,12 @@ listPackages verbosity my_flags mPackageName mModuleName = do
                  else hPutStrLn stdout $ unlines (map ("    " ++) (map pp_pkg pkg_confs))
            where
                  pp_pkg p
-                   | installedComponentId p `elem` broken = printf "{%s}" doc
+                   | installedUnitId p `elem` broken = printf "{%s}" doc
                    | exposed p = doc
                    | otherwise = printf "(%s)" doc
-                   where doc | verbosity >= Verbose = printf "%s (%s)" pkg pk
+                   where doc | verbosity >= Verbose = printf "%s (%s)" pkg (display (installedUnitId p))
                              | otherwise            = pkg
                           where
-                          ComponentId pk = installedComponentId p
                           pkg = display (sourcePackageId p)
 
       show_simple = simplePackageList my_flags . allPackagesInStack
@@ -1274,15 +1268,14 @@ listPackages verbosity my_flags mPackageName mModuleName = do
                             : map (termText "    " <#>) (map pp_pkg pkg_confs))
           where
                    pp_pkg p
-                     | installedComponentId p `elem` broken = withF Red  doc
+                     | installedUnitId p `elem` broken = withF Red  doc
                      | exposed p                       = doc
                      | otherwise                       = withF Blue doc
                      where doc | verbosity >= Verbose
-                               = termText (printf "%s (%s)" pkg pk)
+                               = termText (printf "%s (%s)" pkg (display (installedUnitId p)))
                                | otherwise
                                = termText pkg
                             where
-                            ComponentId pk = installedComponentId p
                             pkg = display (sourcePackageId p)
 
     is_tty <- hIsTerminalDevice stdout
@@ -1318,7 +1311,7 @@ showPackageDot verbosity myflags = do
                  | p <- all_pkgs,
                    let from = display (sourcePackageId p),
                    key <- depends p,
-                   Just dep <- [PackageIndex.lookupComponentId ipix key],
+                   Just dep <- [PackageIndex.lookupUnitId ipix key],
                    let to = display (sourcePackageId dep)
                  ]
   putStrLn "}"
@@ -1390,7 +1383,7 @@ findPackagesByDB db_stack pkgarg
         ps -> return ps
   where
         pkg_msg (Id pkgid)           = display pkgid
-        pkg_msg (ICId ipid)          = display ipid
+        pkg_msg (IUId ipid)          = display ipid
         pkg_msg (Substring pkgpat _) = "matching " ++ pkgpat
 
 matches :: PackageIdentifier -> PackageIdentifier -> Bool
@@ -1404,7 +1397,7 @@ realVersion pkgid = versionBranch (pkgVersion pkgid) /= []
 
 matchesPkg :: PackageArg -> InstalledPackageInfo -> Bool
 (Id pid)        `matchesPkg` pkg = pid `matches` sourcePackageId pkg
-(ICId ipid)     `matchesPkg` pkg = ipid == installedComponentId pkg
+(IUId ipid)     `matchesPkg` pkg = ipid == installedUnitId pkg
 (Substring _ m) `matchesPkg` pkg = m (display (sourcePackageId pkg))
 
 -- -----------------------------------------------------------------------------
@@ -1492,7 +1485,7 @@ closure pkgs db_stack = go pkgs db_stack
                  -> Bool
    depsAvailable pkgs_ok pkg = null dangling
         where dangling = filter (`notElem` pids) (depends pkg)
-              pids = map installedComponentId pkgs_ok
+              pids = map installedUnitId pkgs_ok
 
         -- we want mutually recursive groups of package to show up
         -- as broken. (#1750)
@@ -1580,7 +1573,7 @@ checkPackageConfig :: InstalledPackageInfo
 checkPackageConfig pkg verbosity db_stack
                    multi_instance update = do
   checkPackageId pkg
-  checkComponentId pkg db_stack update
+  checkUnitId pkg db_stack update
   checkDuplicates db_stack pkg multi_instance update
   mapM_ (checkDep db_stack) (depends pkg)
   checkDuplicateDepends (depends pkg)
@@ -1610,17 +1603,17 @@ checkPackageId ipi =
     []  -> verror CannotForce ("invalid package identifier: " ++ str)
     _   -> verror CannotForce ("ambiguous package identifier: " ++ str)
 
-checkComponentId :: InstalledPackageInfo -> PackageDBStack -> Bool
+checkUnitId :: InstalledPackageInfo -> PackageDBStack -> Bool
                 -> Validate ()
-checkComponentId ipi db_stack update = do
-  let pk@(ComponentId str) = installedComponentId ipi
-  when (null str) $ verror CannotForce "missing id field"
+checkUnitId ipi db_stack update = do
+  let uid = installedUnitId ipi
+  when (null (display uid)) $ verror CannotForce "missing id field"
   let dups = [ p | p <- allPackagesInStack db_stack,
-                   installedComponentId p == pk ]
+                   installedUnitId p == uid ]
   when (not update && not (null dups)) $
     verror CannotForce $
         "package(s) with this id already exist: " ++
-         unwords (map (display.installedComponentId) dups)
+         unwords (map (display.installedUnitId) dups)
 
 checkDuplicates :: PackageDBStack -> InstalledPackageInfo
                 -> Bool -> Bool-> Validate ()
@@ -1679,16 +1672,16 @@ checkPath url_ok is_dir warn_only thisfield d
           then vwarn msg
           else verror ForceFiles msg
 
-checkDep :: PackageDBStack -> ComponentId -> Validate ()
+checkDep :: PackageDBStack -> UnitId -> Validate ()
 checkDep db_stack pkgid
   | pkgid `elem` pkgids = return ()
   | otherwise = verror ForceAll ("dependency \"" ++ display pkgid
                                  ++ "\" doesn't exist")
   where
         all_pkgs = allPackagesInStack db_stack
-        pkgids = map installedComponentId all_pkgs
+        pkgids = map installedUnitId all_pkgs
 
-checkDuplicateDepends :: [ComponentId] -> Validate ()
+checkDuplicateDepends :: [UnitId] -> Validate ()
 checkDuplicateDepends deps
   | null dups = return ()
   | otherwise = verror ForceAll ("package has duplicate dependencies: " ++
@@ -1725,7 +1718,7 @@ checkExposedModules :: PackageDBStack -> InstalledPackageInfo -> Validate ()
 checkExposedModules db_stack pkg =
   mapM_ checkExposedModule (exposedModules pkg)
   where
-    checkExposedModule (ExposedModule modl reexport _sig) = do
+    checkExposedModule (ExposedModule modl reexport) = do
       let checkOriginal = checkModuleFile pkg modl
           checkReexport = checkOriginalModule "module reexport" db_stack pkg
       maybe checkOriginal checkReexport reexport
@@ -1772,9 +1765,9 @@ checkOriginalModule :: String
                     -> Validate ()
 checkOriginalModule field_name db_stack pkg
     (OriginalModule definingPkgId definingModule) =
-  let mpkg = if definingPkgId == installedComponentId pkg
+  let mpkg = if definingPkgId == installedUnitId pkg
               then Just pkg
-              else PackageIndex.lookupComponentId ipix definingPkgId
+              else PackageIndex.lookupUnitId ipix definingPkgId
   in case mpkg of
       Nothing
            -> verror ForceAll (field_name ++ " refers to a non-existent " ++
@@ -1808,7 +1801,7 @@ checkOriginalModule field_name db_stack pkg
     ipix     = PackageIndex.fromList all_pkgs
 
     isIndirectDependency pkgid = fromMaybe False $ do
-      thispkg  <- graphVertex (installedComponentId pkg)
+      thispkg  <- graphVertex (installedUnitId pkg)
       otherpkg <- graphVertex pkgid
       return (Graph.path depgraph thispkg otherpkg)
     (depgraph, _, graphVertex) =