[commit: ghc] master: Unregister stage0 package first if it needs to be cloned (#552) (a8ad5af)

[git at git.haskell.org]

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

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/a8ad5af8537606b0dd8e53051fbcf56d6a30c605/ghc

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

commit a8ad5af8537606b0dd8e53051fbcf56d6a30c605
Author: Zhen Zhang <izgzhen at gmail.com>
Date:   Tue Apr 3 21:33:03 2018 +0800

    Unregister stage0 package first if it needs to be cloned (#552)
    
    Fixes #543


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

a8ad5af8537606b0dd8e53051fbcf56d6a30c605
 src/Builder.hs                  |  5 +++++
 src/Builder.hs-boot             |  2 +-
 src/Rules/Register.hs           | 11 +++++++++--
 src/Settings/Builders/GhcPkg.hs | 10 ++++++++++
 4 files changed, 25 insertions(+), 3 deletions(-)

diff --git a/src/Builder.hs b/src/Builder.hs
index 8ce2aea..5ca6c20 100644
--- a/src/Builder.hs
+++ b/src/Builder.hs
@@ -65,6 +65,7 @@ instance NFData   GhcCabalMode
 data GhcPkgMode = Init         -- initialize a new database.
                 | Update       -- update a package.
                 | Clone        -- clone a package from one pkg database into another. @Copy@ is already taken by GhcCabalMode.
+                | Unregister   -- unregister a package
                 | Dependencies -- compute package dependencies.
                 deriving (Eq, Generic, Show)
 
@@ -265,6 +266,10 @@ instance H.Builder Builder where
                       ]
                     cmd (Stdin pkgDesc) [path] (buildArgs ++ ["-"])
 
+                GhcPkg Unregister _ -> do
+                    Exit _ <- cmd echo [path] (buildArgs ++ [input])
+                    return ()
+
                 _  -> cmd echo [path] buildArgs
 
 -- TODO: Some builders are required only on certain platforms. For example,
diff --git a/src/Builder.hs-boot b/src/Builder.hs-boot
index e8eed47..bd38891 100644
--- a/src/Builder.hs-boot
+++ b/src/Builder.hs-boot
@@ -8,7 +8,7 @@ import Hadrian.Builder.Tar
 data CcMode = CompileC | FindCDependencies
 data GhcMode =  CompileHs | CompileCWithGhc | FindHsDependencies | LinkHs
 data GhcCabalMode = Conf | HsColour | Check | Sdist
-data GhcPkgMode = Init | Update | Clone | Dependencies
+data GhcPkgMode = Init | Update | Clone | Unregister | Dependencies
 data HaddockMode = BuildPackage | BuildIndex
 
 data Builder = Alex
diff --git a/src/Rules/Register.hs b/src/Rules/Register.hs
index 14b085d..12d3c5b 100644
--- a/src/Rules/Register.hs
+++ b/src/Rules/Register.hs
@@ -83,8 +83,15 @@ copyConf rs context at Context {..} conf = do
     depPkgIds <- fmap stdOutToPkgIds . askWithResources rs $
       target context (GhcPkg Dependencies stage) [pkgName package] []
     need =<< mapM (\pkgId -> packageDbPath stage <&> (-/- pkgId <.> "conf")) depPkgIds
-    buildWithResources rs $
-      target context (GhcPkg Clone stage) [pkgName package] [conf]
+    -- we should unregister if the file exists since ghc-pkg will complain
+    -- about existing pkg id (See https://github.com/snowleopard/hadrian/issues/543)
+    -- also, we don't always do the unregistration + registration to avoid
+    -- repeated work after a full build
+    unlessM (doesFileExist conf) $ do
+      buildWithResources rs $
+        target context (GhcPkg Unregister stage) [pkgName package] []
+      buildWithResources rs $
+        target context (GhcPkg Clone stage) [pkgName package] [conf]
 
   where
     stdOutToPkgIds :: String -> [String]
diff --git a/src/Settings/Builders/GhcPkg.hs b/src/Settings/Builders/GhcPkg.hs
index 4056d84..535b00d 100644
--- a/src/Settings/Builders/GhcPkg.hs
+++ b/src/Settings/Builders/GhcPkg.hs
@@ -14,6 +14,16 @@ ghcPkgBuilderArgs = mconcat
                 , arg "register"
                 , verbosity < Chatty ? arg "-v0"
                 ]
+    , builder (GhcPkg Unregister) ? do
+        verbosity <- expr getVerbosity
+        stage     <- getStage
+        pkgDb     <- expr $ packageDbPath stage
+        mconcat [ arg "--global-package-db"
+                , arg pkgDb
+                , arg "unregister"
+                , arg "--force"
+                , verbosity < Chatty ? arg "-v0"
+                ]
     , builder (GhcPkg Update) ? do
         verbosity <- expr getVerbosity
         context   <- getContext