From: Ian Lynagh <igloo@earth.li>
Date: Tue, 11 Aug 2009 21:25:59 +0000 (+0000)
Subject: Check Cabal packages when validating
X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=commitdiff_plain;h=d4f9480c7e7bf8167a97ff964f9d85400398c5c4

Check Cabal packages when validating
This checks that hackage would accept the packages.
Currently warnings are printed, but don't result in failure.
---

diff --git a/ghc.mk b/ghc.mk
index 7792b5a..de18a69 100644
--- a/ghc.mk
+++ b/ghc.mk
@@ -597,6 +597,10 @@ libraries/index.html: $(ALL_HADDOCK_FILES)
 $(eval $(call all-target,library_doc_index,libraries/index.html))
 INSTALL_LIBRARY_DOCS += libraries/*.html libraries/*.gif libraries/*.css libraries/*.js
 
+ifeq "$(CHECK_PACKAGES)" "YES"
+all: check_packages
+endif
+
 # -----------------------------------------------------------------------------
 # Bootstrapping libraries
 
diff --git a/mk/config.mk.in b/mk/config.mk.in
index 5e8e265..e6140d2 100644
--- a/mk/config.mk.in
+++ b/mk/config.mk.in
@@ -325,6 +325,8 @@ DotnetSupport=NO
 #
 GhcLibsWithUnix=@GhcLibsWithUnix@
 
+CHECK_PACKAGES = NO
+
 # ----------------------------------------------------------------------------
 # Options for GHC's RTS
 
diff --git a/mk/validate-settings.mk b/mk/validate-settings.mk
index 6964bed..b70a045 100644
--- a/mk/validate-settings.mk
+++ b/mk/validate-settings.mk
@@ -20,6 +20,8 @@ SplitObjs       = NO
 NoFibWays       =
 STRIP           = :
 
+CHECK_PACKAGES = YES
+
 ifeq "$(ValidateHpc)" "YES"
 GhcStage2HcOpts += -fhpc -hpcdir $(TOP)/testsuite/hpc_output/
 endif
diff --git a/rules/build-package.mk b/rules/build-package.mk
index 1c15c6f..8e81389 100644
--- a/rules/build-package.mk
+++ b/rules/build-package.mk
@@ -49,6 +49,14 @@ ifneq "$$($1_$2_GROUP)" ""
 all_$$($1_$2_GROUP): all_$1_$2
 endif
 
+ifneq "$$(CHECKED_$1)" "YES"
+CHECKED_$1 = YES
+check_packages: check_$1
+.PHONY: check_$1
+check_$1: $$(GHC_CABAL_INPLACE)
+	$$(GHC_CABAL_INPLACE) check $1
+endif
+
 distclean : clean_$1_$2_config
 
 maintainer-clean : distclean
diff --git a/utils/ghc-cabal/ghc-cabal.hs b/utils/ghc-cabal/ghc-cabal.hs
index a1bdf66..8c9612f 100644
--- a/utils/ghc-cabal/ghc-cabal.hs
+++ b/utils/ghc-cabal/ghc-cabal.hs
@@ -3,6 +3,7 @@ module Main (main) where
 
 import qualified Distribution.ModuleName as ModuleName
 import Distribution.PackageDescription
+import Distribution.PackageDescription.Check hiding (doesFileExist)
 import Distribution.PackageDescription.Configuration
 import Distribution.PackageDescription.Parse
 import Distribution.Simple
@@ -17,6 +18,7 @@ import Distribution.Verbosity
 import qualified Distribution.InstalledPackageInfo as Installed
 import qualified Distribution.Simple.PackageIndex as PackageIndex
 
+import Data.List
 import Data.Maybe
 import System.IO
 import System.Directory
@@ -29,6 +31,8 @@ main = do args <- getArgs
           case args of
               "haddock" : distDir : dir : args' ->
                   runHaddock distDir dir args'
+              "check" : dir : [] ->
+                  doCheck dir
               "install" : ghcpkg : ghcpkgconfig : directory : distDir
                         : myDestDir : myPrefix : myLibdir : myDocdir : args' ->
                   doInstall ghcpkg ghcpkgconfig directory distDir
@@ -64,6 +68,20 @@ withCurrentDirectory directory io
 userHooks :: UserHooks
 userHooks = autoconfUserHooks
 
+doCheck :: FilePath -> IO ()
+doCheck directory
+ = withCurrentDirectory directory
+ $ do let verbosity = normal
+      gpdFile <- defaultPackageDesc verbosity
+      gpd <- readPackageDescription verbosity gpdFile
+      case partition isFailure $ checkPackage gpd Nothing of
+          ([],   [])       -> return ()
+          ([],   warnings) -> mapM_ print warnings
+          (errs, _)        -> do mapM_ print errs
+                                 exitWith (ExitFailure 1)
+    where isFailure (PackageDistSuspicious {}) = False
+          isFailure _ = True
+
 runHaddock :: FilePath -> FilePath -> [String] -> IO ()
 runHaddock distdir directory args
  = withCurrentDirectory directory