From 91f3212c807731b1b37c07cb5cba1bd2d398b853 Mon Sep 17 00:00:00 2001
From: M Farkas-Dyck <strake888@gmail.com>
Date: Tue, 29 Sep 2020 16:46:22 -0800
Subject: [PATCH] =?UTF-8?q?Sync=20repo=20=E2=80=94=20Darcs:=20Check=20whet?=
 =?UTF-8?q?her=20we=20are=20already=20at=20the=20tag=20before=20re-cloning?=
 =?UTF-8?q?=20repo.?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

---
 cabal-install/src/Distribution/Client/VCS.hs | 26 +++++++++++++++-----
 1 file changed, 20 insertions(+), 6 deletions(-)

diff --git a/cabal-install/src/Distribution/Client/VCS.hs b/cabal-install/src/Distribution/Client/VCS.hs
index a71f0baf3f8..0000e2a7a76 100644
--- a/cabal-install/src/Distribution/Client/VCS.hs
+++ b/cabal-install/src/Distribution/Client/VCS.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE NamedFieldPuns, RecordWildCards, RankNTypes #-}
 module Distribution.Client.VCS (
     -- * VCS driver type
@@ -46,7 +47,7 @@ import Distribution.Simple.Program
          ( Program(programFindVersion)
          , ConfiguredProgram(programVersion)
          , simpleProgram, findProgramVersion
-         , ProgramInvocation(..), programInvocation, runProgramInvocation
+         , ProgramInvocation(..), programInvocation, runProgramInvocation, getProgramInvocationOutput
          , emptyProgramDb, requireProgram )
 import Distribution.Version
          ( mkVersion )
@@ -55,10 +56,11 @@ import qualified Distribution.PackageDescription as PD
 import Control.Applicative
          ( liftA2 )
 import Control.Exception
-         ( throw )
+         ( throw, try )
 import Control.Monad.Trans
          ( liftIO )
 import qualified Data.Char as Char
+import qualified Data.List as List
 import qualified Data.Map  as Map
 import System.FilePath
          ( takeDirectory )
@@ -324,12 +326,24 @@ vcsDarcs =
         dirs = primaryLocalDir : (snd <$> secondaryRepos)
         monitors = monitorDirectoryExistence <$> dirs
 
-    vcsSyncRepo verbosity prog SourceRepositoryPackage{..} localDir _peer = do
-      removeDirectoryRecursive localDir `catch` liftA2 unless isDoesNotExistError throw
-      darcs (takeDirectory localDir) cloneArgs
+    vcsSyncRepo verbosity prog SourceRepositoryPackage{..} localDir _peer =
+      try (lines <$> darcsWithOutput localDir ["log", "--last", "1"]) >>= \ case
+        Right (_:_:_:x:_)
+          | Just tag <- (List.stripPrefix "tagged " . List.dropWhile Char.isSpace) x
+          , Just tag' <- srpTag
+          , tag == tag' -> pure ()
+        Left e | not (isDoesNotExistError e) -> throw e
+        _ -> do
+          removeDirectoryRecursive localDir `catch` liftA2 unless isDoesNotExistError throw
+          darcs (takeDirectory localDir) cloneArgs
       where
         darcs :: FilePath -> [String] -> IO ()
-        darcs cwd args = runProgramInvocation verbosity (programInvocation prog args)
+        darcs = darcs' runProgramInvocation
+
+        darcsWithOutput :: FilePath -> [String] -> IO String
+        darcsWithOutput = darcs' getProgramInvocationOutput
+
+        darcs' f cwd args = f verbosity (programInvocation prog args)
           { progInvokeCwd = Just cwd }
 
         cloneArgs = ["clone"] ++ tagArgs ++ [srpLocation, localDir] ++ verboseArg