From baf55059d4ed234005a04e2ad5d26bc8b9463aeb Mon Sep 17 00:00:00 2001
From: Michael Snoyman <michael@snoyman.com>
Date: Thu, 11 Jan 2018 15:54:56 -0800
Subject: [PATCH] Do not discard package location #3714 (#3759)

---
 ChangeLog.md          | 7 +++++++
 src/Stack/Snapshot.hs | 6 +++---
 2 files changed, 10 insertions(+), 3 deletions(-)

diff --git a/ChangeLog.md b/ChangeLog.md
index df70945cfc..dc56a7676a 100644
--- a/ChangeLog.md
+++ b/ChangeLog.md
@@ -17,6 +17,13 @@ Bug fixes:
 * Some unnecessary rebuilds when no files were changed are now avoided, by
   having a separate build cache for each component of a package. See
   [#3732](https://github.com/commercialhaskell/stack/issues/3732).
+* When promoting packages from snapshot to local, we were
+  occassionally discarding the actual package location content and
+  instead defaulting to pulling the package from the index. We now
+  correctly retain this information. Note that if you were affected by
+  this bug, you will likely need to delete the binary build cache
+  associated with the relevant custom snapshot. See
+  [#3714](https://github.com/commercialhaskell/stack/issues/3714).
 
 ## v1.6.3
 
diff --git a/src/Stack/Snapshot.hs b/src/Stack/Snapshot.hs
index 4889ff3fdc..75207b6013 100644
--- a/src/Stack/Snapshot.hs
+++ b/src/Stack/Snapshot.hs
@@ -482,7 +482,7 @@ calculatePackagePromotion
 
           -- Put together the two split out groups of packages
           noLongerGlobals3 :: Map PackageName (LoadedPackageInfo SinglePackageLocation)
-          noLongerGlobals3 = Map.union (Map.mapWithKey globalToSnapshot noLongerGlobals1) noLongerGlobals2
+          noLongerGlobals3 = Map.mapWithKey globalToSnapshot (Map.union noLongerGlobals1 noLongerGlobals2)
 
           -- Now do the same thing with parent packages: take out the
           -- packages to be upgraded and then split out unmet
@@ -715,14 +715,14 @@ globalToSnapshot name lpi = lpi
 splitUnmetDeps :: Map PackageName Version -- ^ extra dependencies available
                -> Map PackageName (LoadedPackageInfo loc)
                -> ( Map PackageName (LoadedPackageInfo loc)
-                  , Map PackageName (LoadedPackageInfo (PackageLocationIndex FilePath))
+                  , Map PackageName (LoadedPackageInfo loc)
                   )
 splitUnmetDeps extra =
     start Map.empty . Map.toList
   where
     start newGlobals0 toProcess0
       | anyAdded = start newGlobals1 toProcess1
-      | otherwise = (newGlobals1, Map.mapWithKey globalToSnapshot $ Map.fromList toProcess1)
+      | otherwise = (newGlobals1, Map.fromList toProcess1)
       where
         (newGlobals1, toProcess1, anyAdded) = loop False newGlobals0 id toProcess0