[commit: ghc] wip/cabal-head-updates: Update to Cabal head, update ghc-pkg to use new module re-export types (0df4c4c)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : wip/cabal-head-updates
Link       : http://ghc.haskell.org/trac/ghc/changeset/0df4c4c08adf76062e33fbf7f5bf48b6f6e967fc/ghc

>---------------------------------------------------------------

commit 0df4c4c08adf76062e33fbf7f5bf48b6f6e967fc
Author: Duncan Coutts <duncan at well-typed.com>
Date:   Fri Aug 29 14:00:57 2014 +0100

    Update to Cabal head, update ghc-pkg to use new module re-export types
    
    Summary:
    The main change is that Cabal changed the representation of module
    re-exports to distinguish reexports in source .cabal files versus
    re-exports in installed package registraion files.
    
    Cabal now also does the resolution of re-exports to specific installed
    packages itself, so ghc-pkg no longer has to do this. This is a cleaner
    design overall because re-export resolution can fail so it is better to
    do it during package configuration rather than package registration.
    It also simplifies the re-export representation that ghc-pkg has to use.
    
    Add extra ghc-pkg sanity check for module re-exports and duplicates
    
    For re-exports, check that the defining package exists and that it
    exposes the defining module (or for self-rexport exposed or hidden
    modules). Also check that the defining package is actually a direct
    or indirect dependency of the package doing the re-exporting.
    
    Also add a check for duplicate modules in a package, including
    re-exported modules.
    
    Test Plan:
    So far the sanity checks are totally untested. Should add some test
    case to make sure the sanity checks do catch things correctly, and
    don't ban legal things.
    
    Reviewers: ezyang, austin
    
    Subscribers: simonmar, ezyang, carter
    
    Differential Revision: https://phabricator.haskell.org/D183


>---------------------------------------------------------------

0df4c4c08adf76062e33fbf7f5bf48b6f6e967fc
 utils/ghc-pkg/Main.hs | 66 +++++++++++++++++++++++++++++++++++++++++++++++----
 1 file changed, 62 insertions(+), 4 deletions(-)

diff --git a/utils/ghc-pkg/Main.hs b/utils/ghc-pkg/Main.hs
index 4d4f8e9..f063db4 100644
--- a/utils/ghc-pkg/Main.hs
+++ b/utils/ghc-pkg/Main.hs
@@ -14,6 +14,7 @@ module Main (main) where
 import Version ( version, targetOS, targetARCH )
 import qualified GHC.PackageDb as GhcPkg
 import qualified Distribution.Simple.PackageIndex as PackageIndex
+import qualified Data.Graph as Graph
 import qualified Distribution.ModuleName as ModuleName
 import Distribution.ModuleName (ModuleName)
 import Distribution.InstalledPackageInfo as Cabal
@@ -1519,7 +1520,9 @@ checkPackageConfig pkg verbosity db_stack auto_ghci_libs
   mapM_ (checkDir True  "framework-dirs") (frameworkDirs pkg)
   mapM_ (checkFile   True "haddock-interfaces") (haddockInterfaces pkg)
   mapM_ (checkDirURL True "haddock-html")       (haddockHTMLs pkg)
-  checkModules pkg
+  checkDuplicateModules pkg
+  checkModuleFiles pkg
+  checkModuleReexports db_stack pkg
   mapM_ (checkHSLib verbosity (libraryDirs pkg) auto_ghci_libs) (hsLibraries pkg)
   -- ToDo: check these somehow?
   --    extra_libraries :: [String],
@@ -1653,9 +1656,8 @@ doesFileExistOnPath filenames paths = go fullFilenames
         go ((p, fp) : xs) = do b <- doesFileExist fp
                                if b then return (Just p) else go xs
 
--- XXX maybe should check reexportedModules too
-checkModules :: InstalledPackageInfo -> Validate ()
-checkModules pkg = do
+checkModuleFiles :: InstalledPackageInfo -> Validate ()
+checkModuleFiles pkg = do
   mapM_ findModule (exposedModules pkg ++ hiddenModules pkg)
   where
     findModule modl =
@@ -1667,6 +1669,62 @@ checkModules pkg = do
       when (isNothing m) $
          verror ForceFiles ("cannot find any of " ++ show files)
 
+checkDuplicateModules :: InstalledPackageInfo -> Validate ()
+checkDuplicateModules pkg
+  | null dups = return ()
+  | otherwise = verror ForceAll ("package has duplicate modules: " ++
+                                     unwords (map display dups))
+  where
+    dups = [ m | (m:_:_) <- group (sort mods) ]
+    mods = exposedModules pkg ++ hiddenModules pkg
+        ++ map moduleReexportName (reexportedModules pkg)
+
+checkModuleReexports :: PackageDBStack -> InstalledPackageInfo -> Validate ()
+checkModuleReexports db_stack pkg =
+    mapM_ checkReexport (reexportedModules pkg)
+  where
+    all_pkgs = allPackagesInStack db_stack
+    ipix     = PackageIndex.fromList all_pkgs
+
+    checkReexport ModuleReexport {
+      moduleReexportDefiningPackage = definingPkgId,
+      moduleReexportDefiningName    = definingModule
+    } = case PackageIndex.lookupInstalledPackageId ipix definingPkgId of
+          Nothing
+           -> verror ForceAll ("module re-export refers to a non-existant " ++
+                               "(or not visible) defining package: " ++
+                                       display definingPkgId)
+
+          Just definingPkg
+            | not (isIndirectDependency definingPkgId)
+           -> verror ForceAll ("module re-export refers to a defining  " ++
+                               "package that is not a direct (or indirect) " ++
+                               "dependency of this package: " ++
+                                       display definingPkgId)
+
+            | definingPkgId == installedPackageId pkg
+              && definingModule `notElem` (exposedModules definingPkg
+                                        ++ hiddenModules definingPkg)
+           -> verror ForceAll ("module (self) re-export refers to a module " ++
+                               "that is not defined in this package " ++
+                                       display definingModule)
+
+            | definingPkgId /= installedPackageId pkg
+              && definingModule `notElem` exposedModules definingPkg
+           -> verror ForceAll ("module re-export refers to a module that is " ++
+                               "not exposed by the defining package " ++
+                                       display definingModule)
+
+            | otherwise
+           -> return ()
+
+    isIndirectDependency pkgid = fromMaybe False $ do
+      thispkg  <- graphVertex (installedPackageId pkg)
+      otherpkg <- graphVertex pkgid
+      return (Graph.path depgraph thispkg otherpkg)
+    (depgraph, _, graphVertex) = PackageIndex.dependencyGraph ipix
+
+
 checkGHCiLib :: Verbosity -> String -> String -> String -> Bool -> IO ()
 checkGHCiLib verbosity batch_lib_dir batch_lib_file lib auto_build
   | auto_build = autoBuildGHCiLib verbosity batch_lib_dir batch_lib_file ghci_lib_file