From fc82c6075481da1535b50e0a70fba47117f0576a Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Fri, 17 May 2013 16:25:18 -0400
Subject: improve handling of receiving object in direct mode when associated
 files are modified

Before, if a direct mode repo had one or more associated files that
were modifed, moving the object into it would overwrite the associated
files with the pristine object.

Now, modified associated files are left unchanged. To ensure that,
when an object is moved into a direct mode repo, it's not thrown away,
it gets stored in indirect mode.
---
 Annex/Content.hs | 37 ++++++++++++++++++++++++++-----------
 1 file changed, 26 insertions(+), 11 deletions(-)

(limited to 'Annex/Content.hs')

diff --git a/Annex/Content.hs b/Annex/Content.hs
index 9f8659fb5..3e6d621b6 100644
--- a/Annex/Content.hs
+++ b/Annex/Content.hs
@@ -245,25 +245,40 @@ moveAnnex :: Key -> FilePath -> Annex ()
 moveAnnex key src = withObjectLoc key storeobject storedirect
   where
 	storeobject dest = ifM (liftIO $ doesFileExist dest)
-		( liftIO $ removeFile src
+		( alreadyhave
 		, do
 			createContentDir dest
 			liftIO $ moveFile src dest
 			freezeContent dest
 			freezeContentDir dest
 		)
-	storedirect fs = storedirect' =<< filterM validsymlink fs
-	validsymlink f = (==) (Just key) <$> isAnnexLink f
-
-	storedirect' [] = storeobject =<< calcRepo (gitAnnexLocation key)
-	storedirect' (f:fs) = do
+	storeindirect = storeobject =<< calcRepo (gitAnnexLocation key)
+
+	{- In direct mode, the associated file's content may be locally
+	 - modified. In that case, it's preserved. However, the content
+	 - we're moving into the annex may be the only extant copy, so
+	 - it's important we not lose it. So, when the key's content
+	 - cannot be moved to any associated file, it's stored in indirect
+	 - mode.
+	 -}
+	storedirect = storedirect' storeindirect
+	storedirect' fallback [] = fallback
+	storedirect' fallback (f:fs) = do
 		thawContentDir =<< calcRepo (gitAnnexLocation key)
-		updateInodeCache key src
 		thawContent src
-		replaceFile f $ liftIO . moveFile src
-		{- Copy to any other locations. -}
-		forM_ fs $
-			addContentWhenNotPresent key f
+		v <- isAnnexLink f
+		if (Just key == v)
+			then do
+				updateInodeCache key src
+				replaceFile f $ liftIO . moveFile src
+				forM_ fs $
+					addContentWhenNotPresent key f
+			else ifM (goodContent key f)
+				( storedirect' alreadyhave fs
+				, storedirect' fallback fs
+				)
+	
+	alreadyhave = liftIO $ removeFile src
 
 {- Runs an action to transfer an object's content.
  -
-- 
cgit v1.2.3