From 753a7db71d8f97df7fe3d9c2c7da3a1a109d1c3c Mon Sep 17 00:00:00 2001 From: "Paolo G. Giarrusso" Date: Tue, 9 Aug 2016 22:55:16 +0200 Subject: [PATCH] Stop truncating all-cabal-hashes repo Fix #2175. * Fetch full history of tags (in particular, `current-hackage`). * Before fetching tags, transition previously shallow repos to be non-shallow with `fetch --unshallow`. * Fetch full history in initial clone, otherwise, we immediately afterwards use `fetch --unshallow`. This means that the initial fetch and later updates require more data, proportional to the entire repository history; however, reducing data usage again is not trivial and would require changes in the layout of all-cabal-hashes, as discussed in #2175. --- src/Stack/PackageIndex.hs | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) diff --git a/src/Stack/PackageIndex.hs b/src/Stack/PackageIndex.hs index f4a8216dc2..c8d2a6a410 100644 --- a/src/Stack/PackageIndex.hs +++ b/src/Stack/PackageIndex.hs @@ -59,7 +59,7 @@ import Data.Text.Unsafe (unsafeTail) import Data.Traversable (forM) import Data.Typeable (Typeable) import Network.HTTP.Download -import Path (mkRelDir, parent, parseRelDir, toFilePath, parseAbsFile, ()) +import Path (mkRelDir, mkRelFile, parent, parseRelDir, toFilePath, parseAbsFile, ()) import Path.IO import Prelude -- Fix AMP warning import Stack.Types.Config @@ -239,8 +239,6 @@ updateIndexGit menv indexName' index gitUrl = do ["clone" ,T.unpack gitUrl ,toFilePath repoName - ,"--depth" - ,"1" ,"-b" -- ,"display"] sDir <- configPackageIndexRoot indexName' @@ -251,9 +249,13 @@ updateIndexGit menv indexName' index gitUrl = do repoExists <- doesDirExist acfDir unless repoExists (readProcessNull (Just suDir) menv "git" cloneArgs) + isShallow <- doesFileExist $ acfDir $(mkRelDir ".git") $(mkRelFile "shallow") + when isShallow $ do + $logWarn "Shallow package index repo detected, transitioning to a full clone..." + (readProcessNull (Just acfDir) menv "git" ["fetch", "--unshallow"]) $logSticky "Fetching package index ..." let runFetch = callProcessInheritStderrStdout - (Cmd (Just acfDir) "git" menv ["fetch","--tags","--depth=1"]) + (Cmd (Just acfDir) "git" menv ["fetch","--tags"]) runFetch `C.catch` \(ex :: ProcessExitedUnsuccessfully) -> do -- we failed, so wipe the directory and try again, see #1418 $logWarn (T.pack (show ex))