Support for abi-depends for computing shadowing.
[ghc.git] / utils / ghc-pkg / Main.hs
index b089e7b..53f5f9d 100644 (file)
@@ -1,4 +1,7 @@
-{-# LANGUAGE CPP, TypeSynonymInstances, FlexibleInstances #-}
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE TypeSynonymInstances #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 -----------------------------------------------------------------------------
 --
@@ -12,6 +15,7 @@ module Main (main) where
 
 import Version ( version, targetOS, targetARCH )
 import qualified GHC.PackageDb as GhcPkg
+import GHC.PackageDb (BinaryStringRep(..))
 import qualified Distribution.Simple.PackageIndex as PackageIndex
 import qualified Data.Graph as Graph
 import qualified Distribution.ModuleName as ModuleName
@@ -19,10 +23,12 @@ 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.Backpack
 import Distribution.Simple.Utils (fromUTF8, toUTF8, writeUTF8File, readUTF8File)
+import qualified Data.Version as Version
 import System.FilePath as FilePath
 import qualified System.FilePath.Posix as FilePath.Posix
 import System.Directory ( getAppUserDataDirectory, createDirectoryIfMissing,
@@ -36,10 +42,6 @@ import qualified Control.Exception as Exception
 import Data.Maybe
 
 import Data.Char ( isSpace, toLower )
-import Data.Ord (comparing)
-#if __GLASGOW_HASKELL__ < 709
-import Control.Applicative (Applicative(..))
-#endif
 import Control.Monad
 import System.Directory ( doesDirectoryExist, getDirectoryContents,
                           doesFileExist, removeFile,
@@ -51,6 +53,8 @@ import System.IO.Error
 import GHC.IO.Exception (IOErrorType(InappropriateType))
 import Data.List
 import Control.Concurrent
+import qualified Data.Set as Set
+import qualified Data.Map as Map
 
 import qualified Data.ByteString.Char8 as BS
 
@@ -136,7 +140,7 @@ data Flag
   | FlagIgnoreCase
   | FlagNoUserDb
   | FlagVerbosity (Maybe String)
-  | FlagComponentId
+  | FlagUnitId
   deriving Eq
 
 flags :: [OptDescr Flag]
@@ -179,8 +183,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)"
   ]
@@ -226,8 +230,8 @@ usageHeader prog = substProg prog $
   "    Register the package, overwriting any other package with the\n" ++
   "    same name. The input file should be encoded in UTF-8.\n" ++
   "\n" ++
-  "  $p unregister {pkg-id}\n" ++
-  "    Unregister the specified package.\n" ++
+  "  $p unregister [pkg-id] \n" ++
+  "    Unregister the specified packages in the order given.\n" ++
   "\n" ++
   "  $p expose {pkg-id}\n" ++
   "    Expose the specified package.\n" ++
@@ -319,16 +323,16 @@ 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.
 data PackageArg
-    -- | A package identifier foo-0.1; the version might be a glob.
-    = Id PackageIdentifier
+    -- | A package identifier foo-0.1, or a glob foo-*
+    = Id GlobPackageIdentifier
     -- | 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.
@@ -345,8 +349,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
@@ -422,9 +426,10 @@ runit verbosity cli nonopts = do
         registerPackage filename verbosity cli
                         multi_instance
                         expand_env_vars True force
-    ["unregister", pkgarg_str] -> do
-        pkgarg <- readPackageArg as_arg pkgarg_str
-        unregisterPackage pkgarg verbosity cli force
+    "unregister" : pkgarg_strs@(_:_) -> do
+        forM_ pkgarg_strs $ \pkgarg_str -> do
+          pkgarg <- readPackageArg as_arg pkgarg_str
+          unregisterPackage pkgarg verbosity cli force
     ["expose", pkgarg_str] -> do
         pkgarg <- readPackageArg as_arg pkgarg_str
         exposePackage pkgarg verbosity cli force
@@ -447,8 +452,8 @@ runit verbosity cli nonopts = do
                                  (Just (Substring pkgarg_str m)) Nothing
     ["dot"] -> do
         showPackageDot verbosity cli
-    ["find-module", moduleName] -> do
-        let match = maybe (==moduleName) id (substringCheck moduleName)
+    ["find-module", mod_name] -> do
+        let match = maybe (==mod_name) id (substringCheck mod_name)
         listPackages verbosity cli Nothing (Just match)
     ["latest", pkgid_str] -> do
         pkgid <- readGlobPkgId pkgid_str
@@ -486,26 +491,32 @@ parseCheck parser str what =
     [x] -> return x
     _ -> die ("cannot parse \'" ++ str ++ "\' as a " ++ what)
 
-readGlobPkgId :: String -> IO PackageIdentifier
+-- | Either an exact 'PackageIdentifier', or a glob for all packages
+-- matching 'PackageName'.
+data GlobPackageIdentifier
+    = ExactPackageIdentifier PackageIdentifier
+    | GlobPackageIdentifier  PackageName
+
+displayGlobPkgId :: GlobPackageIdentifier -> String
+displayGlobPkgId (ExactPackageIdentifier pid) = display pid
+displayGlobPkgId (GlobPackageIdentifier pn) = display pn ++ "-*"
+
+readGlobPkgId :: String -> IO GlobPackageIdentifier
 readGlobPkgId str = parseCheck parseGlobPackageId str "package identifier"
 
-parseGlobPackageId :: ReadP r PackageIdentifier
+parseGlobPackageId :: ReadP r GlobPackageIdentifier
 parseGlobPackageId =
-  parse
+  fmap ExactPackageIdentifier parse
      +++
   (do n <- parse
       _ <- string "-*"
-      return (PackageIdentifier{ pkgName = n, pkgVersion = globVersion }))
+      return (GlobPackageIdentifier n))
 
 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"
-globVersion :: Version
-globVersion = Version [] ["*"]
-
 -- -----------------------------------------------------------------------------
 -- Package databases
 
@@ -790,7 +801,7 @@ mungePackageDBPaths :: FilePath -> PackageDB -> PackageDB
 mungePackageDBPaths top_dir db@PackageDB { packages = pkgs } =
     db { packages = map (mungePackagePaths top_dir pkgroot) pkgs }
   where
-    pkgroot = takeDirectory (locationAbsolute db)
+    pkgroot = takeDirectory $ dropTrailingPathSeparator (locationAbsolute db)
     -- It so happens that for both styles of package db ("package.conf"
     -- files and "package.conf.d" dirs) the pkgroot is the parent directory
     -- ${pkgroot}/package.conf  or  ${pkgroot}/package.conf.d/
@@ -811,6 +822,7 @@ mungePackagePaths top_dir pkgroot pkg =
       importDirs  = munge_paths (importDirs pkg),
       includeDirs = munge_paths (includeDirs pkg),
       libraryDirs = munge_paths (libraryDirs pkg),
+      libraryDynDirs = munge_paths (libraryDynDirs pkg),
       frameworkDirs = munge_paths (frameworkDirs pkg),
       haddockInterfaces = munge_paths (haddockInterfaces pkg),
                      -- haddock-html is allowed to be either a URL or a file
@@ -987,7 +999,9 @@ registerPackage input verbosity my_flags multi_instance
      removes = [ RemovePackage p
                | not multi_instance,
                  p <- packages db_to_operate_on,
-                 sourcePackageId p == sourcePackageId pkg ]
+                 sourcePackageId p == sourcePackageId pkg,
+                 -- Only remove things that were instantiated the same way!
+                 instantiatedWith p == instantiatedWith pkg ]
   --
   changeDB verbosity (removes ++ [AddPackage pkg]) db_to_operate_on
 
@@ -1025,7 +1039,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)
@@ -1037,11 +1051,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) =
@@ -1075,28 +1089,32 @@ 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
-                            ModuleName -- module name
+                            ComponentId
+                            PackageIdentifier
+                            PackageName
+                            UnitId
+                            OpenUnitId
+                            ModuleName
+                            OpenModule
 
 convertPackageInfoToCacheFormat :: InstalledPackageInfo -> PackageCacheFormat
 convertPackageInfoToCacheFormat pkg =
     GhcPkg.InstalledPackageInfo {
-       GhcPkg.componentId = display (installedComponentId 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,
+       GhcPkg.unitId             = installedUnitId pkg,
+       GhcPkg.componentId        = installedComponentId pkg,
+       GhcPkg.instantiatedWith   = instantiatedWith pkg,
+       GhcPkg.sourcePackageId    = sourcePackageId pkg,
+       GhcPkg.packageName        = packageName pkg,
+       GhcPkg.packageVersion     = Version.Version (versionNumbers (packageVersion pkg)) [],
+       GhcPkg.depends            = depends pkg,
+       GhcPkg.abiDepends         = map (\(AbiDependency k v) -> (k,unAbiHash v)) (abiDepends pkg),
+       GhcPkg.abiHash            = unAbiHash (abiHash pkg),
        GhcPkg.importDirs         = importDirs pkg,
        GhcPkg.hsLibraries        = hsLibraries pkg,
        GhcPkg.extraLibraries     = extraLibraries pkg,
        GhcPkg.extraGHCiLibraries = extraGHCiLibraries pkg,
        GhcPkg.libraryDirs        = libraryDirs pkg,
+       GhcPkg.libraryDynDirs     = libraryDynDirs pkg,
        GhcPkg.frameworks         = frameworks pkg,
        GhcPkg.frameworkDirs      = frameworkDirs pkg,
        GhcPkg.ldOptions          = ldOptions pkg,
@@ -1107,25 +1125,48 @@ convertPackageInfoToCacheFormat pkg =
        GhcPkg.haddockHTMLs       = haddockHTMLs pkg,
        GhcPkg.exposedModules     = map convertExposed (exposedModules pkg),
        GhcPkg.hiddenModules      = hiddenModules pkg,
-       GhcPkg.instantiatedWith   = map convertInst (instantiatedWith pkg),
+       GhcPkg.indefinite         = indefinite pkg,
        GhcPkg.exposed            = exposed pkg,
        GhcPkg.trusted            = trusted pkg
     }
-  where convertExposed (ExposedModule n reexport sig) =
-            GhcPkg.ExposedModule n (fmap convertOriginal reexport)
-                                   (fmap convertOriginal sig)
-        convertOriginal (OriginalModule ipid m) =
-            GhcPkg.OriginalModule (display ipid) m
-        convertInst (m, o) = (m, convertOriginal o)
+  where convertExposed (ExposedModule n reexport) = (n, reexport)
+
+instance GhcPkg.BinaryStringRep ComponentId where
+  fromStringRep = mkComponentId . fromStringRep
+  toStringRep   = toStringRep . display
+
+instance GhcPkg.BinaryStringRep PackageName where
+  fromStringRep = mkPackageName . fromStringRep
+  toStringRep   = toStringRep . display
+
+instance GhcPkg.BinaryStringRep PackageIdentifier where
+  fromStringRep = fromMaybe (error "BinaryStringRep PackageIdentifier")
+                . simpleParse . fromStringRep
+  toStringRep = toStringRep . display
 
 instance GhcPkg.BinaryStringRep ModuleName where
-  fromStringRep = ModuleName.fromString . fromUTF8 . BS.unpack
-  toStringRep   = BS.pack . toUTF8 . display
+  fromStringRep = ModuleName.fromString . fromStringRep
+  toStringRep   = toStringRep . display
 
 instance GhcPkg.BinaryStringRep String where
   fromStringRep = fromUTF8 . BS.unpack
   toStringRep   = BS.pack . toUTF8
 
+instance GhcPkg.BinaryStringRep UnitId where
+  fromStringRep = mkUnitId . fromStringRep
+  toStringRep   = toStringRep . display
+
+instance GhcPkg.DbUnitIdModuleRep UnitId ComponentId OpenUnitId ModuleName OpenModule where
+  fromDbModule (GhcPkg.DbModule uid mod_name) = OpenModule uid mod_name
+  fromDbModule (GhcPkg.DbModuleVar mod_name) = OpenModuleVar mod_name
+  toDbModule (OpenModule uid mod_name) = GhcPkg.DbModule uid mod_name
+  toDbModule (OpenModuleVar mod_name) = GhcPkg.DbModuleVar mod_name
+  fromDbUnitId (GhcPkg.DbUnitId cid insts) = IndefFullUnitId cid (Map.fromList insts)
+  fromDbUnitId (GhcPkg.DbInstalledUnitId uid)
+    = DefiniteUnitId (unsafeMkDefUnitId uid)
+  toDbUnitId (IndefFullUnitId cid insts) = GhcPkg.DbUnitId cid (Map.toList insts)
+  toDbUnitId (DefiniteUnitId def_uid)
+    = GhcPkg.DbInstalledUnitId (unDefUnitId def_uid)
 
 -- -----------------------------------------------------------------------------
 -- Exposing, Hiding, Trusting, Distrusting, Unregistering are all similar
@@ -1163,9 +1204,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
@@ -1173,14 +1214,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: "
@@ -1231,7 +1272,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
@@ -1239,24 +1280,21 @@ 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 ++ ":")
-             if null pp_pkgs
+          do hPutStrLn stdout db_name
+             if null pkg_confs
                  then hPutStrLn stdout "    (no packages)"
-                 else hPutStrLn stdout $ unlines (map ("    " ++) pp_pkgs)
+                 else hPutStrLn stdout $ unlines (map ("    " ++) (map pp_pkg pkg_confs))
            where
-                 -- Sort using instance Ord PackageId
-                 pp_pkgs = map pp_pkg . sortBy (comparing installedComponentId) $ pkg_confs
                  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
@@ -1276,19 +1314,18 @@ listPackages verbosity my_flags mPackageName mModuleName = do
            then termText (location db) <#> termText "\n    (no packages)\n"
            else
                mconcat $ map (<#> termText "\n") $
-                           (termText (location db) :
-                                     map (termText "   " <#>) (map pp_pkg pkg_confs))
+                           (termText (location db)
+                            : 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
@@ -1305,8 +1342,7 @@ simplePackageList :: [Flag] -> [InstalledPackageInfo] -> IO ()
 simplePackageList my_flags pkgs = do
    let showPkg = if FlagNamesOnly `elem` my_flags then display . pkgName
                                                   else display
-       -- Sort using instance Ord PackageId
-       strs = map showPkg $ sort $ map sourcePackageId pkgs
+       strs = map showPkg $ map sourcePackageId pkgs
    when (not (null pkgs)) $
       hPutStrLn stdout $ concat $ intersperse " " strs
 
@@ -1325,7 +1361,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 "}"
@@ -1335,7 +1371,7 @@ showPackageDot verbosity myflags = do
 
 -- ToDo: This is no longer well-defined with unit ids, because the
 -- dependencies may be varying versions
-latestPackage ::  Verbosity -> [Flag] -> PackageIdentifier -> IO ()
+latestPackage ::  Verbosity -> [Flag] -> GlobPackageIdentifier -> IO ()
 latestPackage verbosity my_flags pkgid = do
   (_, _, flag_db_stack) <-
      getPkgDatabases verbosity False{-modify-} False{-use user-}
@@ -1396,22 +1432,20 @@ findPackagesByDB db_stack pkgarg
         [] -> die ("cannot find package " ++ pkg_msg pkgarg)
         ps -> return ps
   where
-        pkg_msg (Id pkgid)           = display pkgid
-        pkg_msg (ICId ipid)          = display ipid
+        pkg_msg (Id pkgid)           = displayGlobPkgId pkgid
+        pkg_msg (IUId ipid)          = display ipid
         pkg_msg (Substring pkgpat _) = "matching " ++ pkgpat
 
-matches :: PackageIdentifier -> PackageIdentifier -> Bool
-pid `matches` pid'
-  = (pkgName pid == pkgName pid')
-    && (pkgVersion pid == pkgVersion pid' || not (realVersion pid))
-
-realVersion :: PackageIdentifier -> Bool
-realVersion pkgid = versionBranch (pkgVersion pkgid) /= []
-  -- when versionBranch == [], this is a glob
+matches :: GlobPackageIdentifier -> PackageIdentifier -> Bool
+GlobPackageIdentifier pn `matches` pid'
+  = (pn == pkgName pid')
+ExactPackageIdentifier pid `matches` pid'
+  = pkgName pid == pkgName pid' &&
+    (pkgVersion pid == pkgVersion pid' || pkgVersion pid == nullVersion)
 
 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))
 
 -- -----------------------------------------------------------------------------
@@ -1499,7 +1533,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)
@@ -1524,7 +1558,6 @@ instance Applicative Validate where
     (<*>) = ap
 
 instance Monad Validate where
-   return = pure
    m >>= k = V $ do
       (a, es, ws) <- runValidate m
       (b, es', ws') <- runValidate (k a)
@@ -1588,12 +1621,13 @@ 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)
   mapM_ (checkDir False "import-dirs")  (importDirs pkg)
   mapM_ (checkDir True  "library-dirs") (libraryDirs pkg)
+  mapM_ (checkDir True  "dynamic-library-dirs") (libraryDynDirs pkg)
   mapM_ (checkDir True  "include-dirs") (includeDirs pkg)
   mapM_ (checkDir True  "framework-dirs") (frameworkDirs pkg)
   mapM_ (checkFile   True "haddock-interfaces") (haddockInterfaces pkg)
@@ -1601,7 +1635,8 @@ checkPackageConfig pkg verbosity db_stack
   checkDuplicateModules pkg
   checkExposedModules db_stack pkg
   checkOtherModules pkg
-  mapM_ (checkHSLib verbosity (libraryDirs pkg)) (hsLibraries pkg)
+  let has_code = Set.null (openModuleSubstFreeHoles (Map.fromList (instantiatedWith pkg)))
+  when has_code $ mapM_ (checkHSLib verbosity (libraryDirs pkg ++ libraryDynDirs pkg)) (hsLibraries pkg)
   -- ToDo: check these somehow?
   --    extra_libraries :: [String],
   --    c_includes      :: [String],
@@ -1618,17 +1653,20 @@ 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"
+  when (display uid /= compatPackageKey ipi) $
+    verror CannotForce $ "installed package info from too old version of Cabal "
+                      ++ "(key field does not match 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 ()
@@ -1687,16 +1725,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: " ++
@@ -1733,9 +1771,9 @@ 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
+          checkReexport = checkModule "module reexport" db_stack pkg
       maybe checkOriginal checkReexport reexport
 
 -- | Validates the existence of an appropriate @hi@ file associated with
@@ -1773,16 +1811,18 @@ checkDuplicateModules pkg
 -- implementation, then we should also check that the original module in
 -- question is NOT a signature (however, if it is a reexport, then it's fine
 -- for the original module to be a signature.)
-checkOriginalModule :: String
-                    -> PackageDBStack
-                    -> InstalledPackageInfo
-                    -> OriginalModule
-                    -> Validate ()
-checkOriginalModule field_name db_stack pkg
-    (OriginalModule definingPkgId definingModule) =
-  let mpkg = if definingPkgId == installedComponentId pkg
+checkModule :: String
+            -> PackageDBStack
+            -> InstalledPackageInfo
+            -> OpenModule
+            -> Validate ()
+checkModule _ _ _ (OpenModuleVar _) = error "Impermissible reexport"
+checkModule field_name db_stack pkg
+    (OpenModule (DefiniteUnitId def_uid) definingModule) =
+  let definingPkgId = unDefUnitId def_uid
+      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 " ++
@@ -1810,18 +1850,21 @@ checkOriginalModule field_name db_stack pkg
                                "that is reexported but not defined in the " ++
                                "defining package " ++ display definingPkgId)
             _ -> return ()
-
   where
     all_pkgs = allPackagesInStack db_stack
     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) =
       PackageIndex.dependencyGraph (PackageIndex.insert pkg ipix)
 
+checkModule _ _ _ (OpenModule (IndefFullUnitId _ _) _) =
+    -- TODO: add some checks here
+    return ()
+
 
 -- ---------------------------------------------------------------------------
 -- expanding environment variables in the package configuration