Skip to content

Commit

Permalink
Standardize the Git/HTTP selection logic
Browse files Browse the repository at this point in the history
  • Loading branch information
snoyberg committed Jan 11, 2017
1 parent a3a3176 commit 9ccea56
Show file tree
Hide file tree
Showing 4 changed files with 31 additions and 16 deletions.
18 changes: 13 additions & 5 deletions src/Stack/Fetch.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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'
Expand Down
9 changes: 4 additions & 5 deletions src/Stack/PackageIndex.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down
9 changes: 3 additions & 6 deletions src/Stack/Types/Config.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
11 changes: 11 additions & 0 deletions src/Stack/Types/PackageIndex.hs
Original file line number Diff line number Diff line change
Expand Up @@ -16,6 +16,8 @@ module Stack.Types.PackageIndex
, IndexName(..)
, indexNameText
, IndexLocation(..)
, SimplifiedIndexLocation (..)
, simplifyIndexLocation
) where

import Control.DeepSeq (NFData)
Expand Down Expand Up @@ -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
Expand Down

0 comments on commit 9ccea56

Please sign in to comment.