summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--Annex/Content.hs37
1 files changed, 26 insertions, 11 deletions
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.
-