From 9ccea56b3bce6feb11ee71f78ad96dd9b730c75c Mon Sep 17 00:00:00 2001
From: Michael Snoyman <michael@snoyman.com>
Date: Wed, 11 Jan 2017 13:05:57 +0200
Subject: [PATCH] Standardize the Git/HTTP selection logic

---
 src/Stack/Fetch.hs              | 18 +++++++++++++-----
 src/Stack/PackageIndex.hs       |  9 ++++-----
 src/Stack/Types/Config.hs       |  9 +++------
 src/Stack/Types/PackageIndex.hs | 11 +++++++++++
 4 files changed, 31 insertions(+), 16 deletions(-)

diff --git a/src/Stack/Fetch.hs b/src/Stack/Fetch.hs
index 49abd02799..f0972f4ab6 100644
--- a/src/Stack/Fetch.hs
+++ b/src/Stack/Fetch.hs
@@ -229,7 +229,7 @@ resolvePackagesAllowMissing
     -> m (Set PackageName, Set PackageIdentifier, Map PackageIdentifier ResolvedPackage)
 resolvePackagesAllowMissing menv mMiniBuildPlan idents0 names0 = do
     res@(_, _, resolved) <- inner
-    if Map.any rpMissingGitSHA resolved
+    if any rpMissingGitSHA $ Map.elems resolved
         then do
             $logInfo "Missing some cabal revision files, updating indices"
             updateAllIndices menv
@@ -281,11 +281,19 @@ resolvePackagesAllowMissing menv mMiniBuildPlan idents0 names0 = do
                                         , False -- not missing, we found the Git SHA
                                         )
                                 Nothing -> (index, cache, mgitsha,
-                                    case indexLocation index of
-                                        ILGit _ -> False -- look it up later
+                                    case simplifyIndexLocation (indexLocation index) of
+                                        -- No surprise that there's
+                                        -- nothing in the cache about
+                                        -- the SHA, since this package
+                                        -- comes from a Git
+                                        -- repo. We'll look it up
+                                        -- later when we've opened up
+                                        -- the Git repo itself for
+                                        -- reading.
+                                        SILGit _ -> False
+
                                         -- Index using HTTP, so we're missing the Git SHA
-                                        ILGitHttp _ _ -> True
-                                        ILHttp _ -> True)
+                                        SILHttp _ -> True)
                  in Right (ident, ResolvedPackage
                     { rpCache = cache'
                     , rpIndex = index'
diff --git a/src/Stack/PackageIndex.hs b/src/Stack/PackageIndex.hs
index 56bf5f1805..0c62e96bcc 100644
--- a/src/Stack/PackageIndex.hs
+++ b/src/Stack/PackageIndex.hs
@@ -222,11 +222,10 @@ updateIndex menv index =
   do let name = indexName index
          logUpdate mirror = $logSticky $ "Updating package index " <> indexNameText (indexName index) <> " (mirrored at " <> mirror  <> ") ..."
      git <- isGitInstalled menv
-     case (git, indexLocation index) of
-        (True, ILGit url) -> logUpdate url >> updateIndexGit menv name index url
-        (False, ILGit url) -> logUpdate url >> throwM (GitNotAvailable name)
-        (_, ILGitHttp _ url) -> logUpdate url >> updateIndexHTTP name index url
-        (_, ILHttp url) -> logUpdate url >> updateIndexHTTP name index url
+     case (git, simplifyIndexLocation $ indexLocation index) of
+        (True, SILGit url) -> logUpdate url >> updateIndexGit menv name index url
+        (False, SILGit url) -> logUpdate url >> throwM (GitNotAvailable name)
+        (_, SILHttp url) -> logUpdate url >> updateIndexHTTP name index url
 
 -- | Update the index Git repo and the index tarball
 updateIndexGit :: (StackMiniM env m, HasConfig env)
diff --git a/src/Stack/Types/Config.hs b/src/Stack/Types/Config.hs
index d45aa5ed76..517f5ec240 100644
--- a/src/Stack/Types/Config.hs
+++ b/src/Stack/Types/Config.hs
@@ -1172,12 +1172,9 @@ configPackageIndexRepo name = do
     case filter (\p -> indexName p == name) indices of
         [index] -> do
             let murl =
-                    case indexLocation index of
-                        ILGit x -> Just x
-                        ILHttp _ -> Nothing
-                        -- See logic in updateIndex, which prefers
-                        -- HTTP to Git in this case
-                        ILGitHttp _ _ -> Nothing
+                    case simplifyIndexLocation $ indexLocation index of
+                        SILGit x -> Just x
+                        SILHttp _ -> Nothing
             case murl of
                 Nothing -> return Nothing
                 Just url -> do
diff --git a/src/Stack/Types/PackageIndex.hs b/src/Stack/Types/PackageIndex.hs
index 5646eb7f29..939bfcbdae 100644
--- a/src/Stack/Types/PackageIndex.hs
+++ b/src/Stack/Types/PackageIndex.hs
@@ -16,6 +16,8 @@ module Stack.Types.PackageIndex
     , IndexName(..)
     , indexNameText
     , IndexLocation(..)
+    , SimplifiedIndexLocation (..)
+    , simplifyIndexLocation
     ) where
 
 import           Control.DeepSeq (NFData)
@@ -108,6 +110,15 @@ instance FromJSON IndexName where
 data IndexLocation = ILGit !Text | ILHttp !Text | ILGitHttp !Text !Text
     deriving (Show, Eq, Ord)
 
+-- | Simplified 'IndexLocation', which will either be a Git repo or HTTP URL.
+data SimplifiedIndexLocation = SILGit !Text | SILHttp !Text
+    deriving (Show, Eq, Ord)
+
+simplifyIndexLocation :: IndexLocation -> SimplifiedIndexLocation
+simplifyIndexLocation (ILGit t) = SILGit t
+simplifyIndexLocation (ILHttp t) = SILHttp t
+-- Prefer HTTP over Git
+simplifyIndexLocation (ILGitHttp _ t) = SILHttp t
 
 -- | Information on a single package index
 data PackageIndex = PackageIndex