Unregister shadowing local packages #992

commercialhaskell · Sep 16, 2015 · c5772d0 · c5772d0
1 parent c0525a2
commit c5772d0
Show file tree

Hide file tree

Showing 2 changed files with 11 additions and 3 deletions.
diff --git a/ChangeLog.md b/ChangeLog.md
@@ -22,6 +22,7 @@ Bug fixes:
 * Build executables for local extra deps [#920](https://github.com/commercialhaskell/stack/issues/920)
 * copyFile can't handle directories [#942](https://github.com/commercialhaskell/stack/pull/942)
 * Support for spaces in Haddock interface files [fpco/minghc#85](https://github.com/fpco/minghc/issues/85)
+* Temporarily building against a "shadowing" local package? [#992](https://github.com/commercialhaskell/stack/issues/992)
 
 ## 0.1.4.1
 

diff --git a/src/Stack/Build/ConstructPlan.hs b/src/Stack/Build/ConstructPlan.hs
@@ -161,7 +161,7 @@ constructPlan mbp0 baseConfigOpts0 locals extraToBuild0 locallyRegistered loadPa
             return $ takeSubset Plan
                 { planTasks = tasks
                 , planFinals = M.fromList finals
-                , planUnregisterLocal = mkUnregisterLocal tasks dirtyReason locallyRegistered
+                , planUnregisterLocal = mkUnregisterLocal tasks dirtyReason locallyRegistered sourceMap
                 , planInstallExes =
                     if boptsInstallExes $ bcoBuildOpts baseConfigOpts0
                         then installExes
@@ -193,13 +193,20 @@ constructPlan mbp0 baseConfigOpts0 locals extraToBuild0 locallyRegistered loadPa
 mkUnregisterLocal :: Map PackageName Task
                   -> Map PackageName Text
                   -> Map GhcPkgId PackageIdentifier
+                  -> SourceMap
                   -> Map GhcPkgId (PackageIdentifier, Maybe Text)
-mkUnregisterLocal tasks dirtyReason locallyRegistered =
+mkUnregisterLocal tasks dirtyReason locallyRegistered sourceMap =
     Map.unions $ map toUnregisterMap $ Map.toList locallyRegistered
   where
     toUnregisterMap (gid, ident) =
         case M.lookup name tasks of
-            Nothing -> Map.empty
+            Nothing ->
+                case M.lookup name sourceMap of
+                    Just (PSUpstream _ Snap _) -> Map.singleton gid
+                        ( ident
+                        , Just "Switching to snapshot installed package"
+                        )
+                    _ -> Map.empty
             Just _ -> Map.singleton gid
                 ( ident
                 , Map.lookup name dirtyReason