Unregister stage0 package first if it needs to be cloned (#552)
authorZhen Zhang <izgzhen@gmail.com>
Tue, 3 Apr 2018 13:33:03 +0000 (21:33 +0800)
committerAndrey Mokhov <andrey.mokhov@gmail.com>
Tue, 3 Apr 2018 13:33:03 +0000 (14:33 +0100)
Fixes #543

src/Builder.hs
src/Builder.hs-boot
src/Rules/Register.hs
src/Settings/Builders/GhcPkg.hs

index 8ce2aea..5ca6c20 100644 (file)
@@ -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,
index e8eed47..bd38891 100644 (file)
@@ -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
index 14b085d..12d3c5b 100644 (file)
@@ -83,8 +83,15 @@ copyConf rs context@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]
index 4056d84..535b00d 100644 (file)
@@ -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