summaryrefslogtreecommitdiff
path: root/Annex/Content.hs
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2013-05-17 15:59:37 -0400
committerGravatar Joey Hess <joey@kitenet.net>2013-05-17 15:59:37 -0400
commit4e74c0d7f33a66eb524ef020ef4401fa322db34c (patch)
treed0a239d6022339b3cb5afeced2d3f859aa4d02d3 /Annex/Content.hs
parent963f2c5726ce0fe899038733d4318a234d355268 (diff)
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.
Diffstat (limited to 'Annex/Content.hs')
-rw-r--r--Annex/Content.hs34
1 files changed, 5 insertions, 29 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.
-