test suite passes in direct mode

This fixes a bug with git annex add in direct mode. If some files already
existed in the tree pointing at the same key as a file that was just added,
and their content was not present, add neglected to copy the content to
those files.

I also changed the behavior of moveAnnex slightly: When content is moved
into the annex in direct mode, it does not overwrite any content already
present in direct mode files. That content may be modified after all.

4 files changed, 56 insertions, 30 deletions

diff --git a/Annex/Content.hs b/Annex/Content.hs
index 5ec3c1b3f..9f8659fb5 100644
--- a/Annex/Content.hs
+++ b/Annex/Content.hs
@@ -28,7 +28,6 @@ module Annex.Content (
 	preseedTmp,
 	freezeContent,
 	thawContent,
-	replaceFile,
 	cleanObjectLoc,
 ) where
 
@@ -53,6 +52,7 @@ import Git.SharedRepository
 import Annex.Perms
 import Annex.Link
 import Annex.Content.Direct
+import Annex.ReplaceFile
 
 {- Checks if a given key's content is currently present. -}
 inAnnex :: Key -> Annex Bool
@@ -256,38 +256,14 @@ moveAnnex key src = withObjectLoc key storeobject storedirect
 	validsymlink f = (==) (Just key) <$> isAnnexLink f
 
 	storedirect' [] = storeobject =<< calcRepo (gitAnnexLocation key)
-	storedirect' (dest:fs) = do
+	storedirect' (f:fs) = do
 		thawContentDir =<< calcRepo (gitAnnexLocation key)
 		updateInodeCache key src
 		thawContent src
-		replaceFile dest $ liftIO . moveFile src
+		replaceFile f $ liftIO . moveFile src
 		{- Copy to any other locations. -}
-		forM_ fs $ \f -> replaceFile f $
-			liftIO . void . copyFileExternal dest
-
-{- Replaces a possibly already existing file with a new version, 
- - atomically, by running an action.
-
- - The action is passed a temp file, which it can write to, and once
- - done the temp file is moved into place.
- -}
-replaceFile :: FilePath -> (FilePath -> Annex ()) -> Annex ()
-replaceFile file a = do
-	tmpdir <- fromRepo gitAnnexTmpDir
-	createAnnexDirectory tmpdir
-	tmpfile <- liftIO $ do
-		(tmpfile, h) <- openTempFileWithDefaultPermissions tmpdir $
-			takeFileName file
-		hClose h
-		return tmpfile
-	a tmpfile
-	liftIO $ do
-		r <- tryIO $ rename tmpfile file
-		case r of
-			Left _ -> do
-				createDirectoryIfMissing True $ parentDir file
-				rename tmpfile file
-			_ -> noop
+		forM_ fs $
+			addContentWhenNotPresent key f
 
 {- Runs an action to transfer an object's content.
  -
diff --git a/Annex/Content/Direct.hs b/Annex/Content/Direct.hs
index b885b5e5b..49d317258 100644
--- a/Annex/Content/Direct.hs
+++ b/Annex/Content/Direct.hs
@@ -23,6 +23,7 @@ module Annex.Content.Direct (
 	toInodeCache,
 	inodesChanged,
 	createInodeSentinalFile,
+	addContentWhenNotPresent,
 ) where
 
 import Common.Annex
@@ -32,6 +33,9 @@ import qualified Git
 import Utility.Tmp
 import Logs.Location
 import Utility.InodeCache
+import Utility.CopyFile
+import Annex.ReplaceFile
+import Annex.Link
 
 {- Absolute FilePaths of Files in the tree that are associated with a key. -}
 associatedFiles :: Key -> Annex [FilePath]
@@ -180,6 +184,16 @@ elemInodeCaches c (l:ls) = ifM (compareInodeCaches c l)
 compareInodeCachesWith :: Annex InodeComparisonType
 compareInodeCachesWith = ifM inodesChanged ( return Weakly, return Strongly )
 
+{- Copies the contentfile to the associated file, if the associated
+ - file has not content. If the associated file does have content,
+ - even if the content differs, it's left unchanged. -}
+addContentWhenNotPresent :: Key -> FilePath -> FilePath -> Annex ()
+addContentWhenNotPresent key contentfile associatedfile = do
+	v <- isAnnexLink associatedfile
+	when (Just key == v) $
+		replaceFile associatedfile $
+			liftIO . void . copyFileExternal contentfile
+
 {- Some filesystems get new inodes each time they are mounted.
  - In order to work on such a filesystem, a sentinal file is used to detect
  - when the inodes have changed.
diff --git a/Annex/Direct.hs b/Annex/Direct.hs
index 67822f2d5..02fdb2430 100644
--- a/Annex/Direct.hs
+++ b/Annex/Direct.hs
@@ -26,6 +26,7 @@ import Annex.Link
 import Utility.InodeCache
 import Utility.CopyFile
 import Annex.Perms
+import Annex.ReplaceFile
 
 {- Uses git ls-files to find files that need to be committed, and stages
  - them into the index. Returns True if some changes were staged. -}
@@ -191,7 +192,7 @@ toDirectGen k f = do
 		{- Move content from annex to direct file. -}
 		thawContentDir loc
 		updateInodeCache k loc
-		addAssociatedFile k f
+		void $ addAssociatedFile k f
 		thawContent loc
 		replaceFile f $ liftIO . moveFile loc
 	fromdirect = do
diff --git a/Annex/ReplaceFile.hs b/Annex/ReplaceFile.hs
new file mode 100644
index 000000000..f0dfa5b27
--- /dev/null
+++ b/Annex/ReplaceFile.hs
@@ -0,0 +1,35 @@
+{- git-annex file replacing
+ -
+ - Copyright 2013 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Annex.ReplaceFile where
+
+import Common.Annex
+import Annex.Perms
+
+{- Replaces a possibly already existing file with a new version, 
+ - atomically, by running an action.
+ - 
+ - The action is passed a temp file, which it can write to, and once
+ - done the temp file is moved into place.
+ -}
+replaceFile :: FilePath -> (FilePath -> Annex ()) -> Annex ()
+replaceFile file a = do
+	tmpdir <- fromRepo gitAnnexTmpDir
+	createAnnexDirectory tmpdir
+	tmpfile <- liftIO $ do
+		(tmpfile, h) <- openTempFileWithDefaultPermissions tmpdir $
+			takeFileName file
+		hClose h
+		return tmpfile
+	a tmpfile
+	liftIO $ do
+		r <- tryIO $ rename tmpfile file
+		case r of
+			Left _ -> do
+				createDirectoryIfMissing True $ parentDir file
+				rename tmpfile file
+			_ -> noop