diff options
| -rw-r--r-- | Annex/Direct.hs | 49 | ||||
| -rw-r--r-- | Command/Direct.hs | 2 | ||||
| -rw-r--r-- | Command/Sync.hs | 11 |
3 files changed, 38 insertions, 24 deletions
diff --git a/Annex/Direct.hs b/Annex/Direct.hs index ad67ee990..3846b0a9e 100644 --- a/Annex/Direct.hs +++ b/Annex/Direct.hs @@ -145,20 +145,7 @@ mergeDirectCleanup d oldsha newsha = do | otherwise = araw f f = DiffTree.file item - {- Any content that was present in direct mode and whose file is to - - be modified or deleted by the merge is first moved to - - .git/annex/objects, unless there are other associated files for - - the content. No content is ever lost due to a direct mode merge. -} - moveout k f = do - locs <- removeAssociatedFile k f - when (null locs) $ do - r <- liftIO $ catchMaybeIO $ getSymbolicLinkStatus f - case r of - Just s - | not (isSymbolicLink s) -> - moveAnnex k f - _ -> noop - moveout_raw f + moveout k f = removeDirect k f {- Files deleted by the merge are removed from the work tree. - Empty work tree directories are removed, per git behavior. -} @@ -168,19 +155,24 @@ mergeDirectCleanup d oldsha newsha = do {- Key symlinks are replaced with their content, if it's available. -} movein k f = do - movein_raw f - maybe noop id =<< toDirect k f + l <- calcGitLink f k + liftIO $ replaceFile f $ const $ + createSymbolicLink l f + toDirect k f {- Any new, modified, or renamed files were written to the temp - directory by the merge, and are moved to the real work tree. -} movein_raw f = liftIO $ do createDirectoryIfMissing True $ parentDir f - rename (d </> f) f + void $ catchMaybeIO $ rename (d </> f) f -{- If possible, returns an action that will convert a symlink in the - - working tree into a direct mode file. -} -toDirect :: Key -> FilePath -> Annex (Maybe (Annex ())) -toDirect k f = do +{- If possible, converts a symlink in the working tree into a direct + - mode file. -} +toDirect :: Key -> FilePath -> Annex () +toDirect k f = maybe noop id =<< toDirectGen k f + +toDirectGen :: Key -> FilePath -> Annex (Maybe (Annex ())) +toDirectGen k f = do loc <- inRepo $ gitAnnexLocation k createContentDir loc -- thaws directory too locs <- filter (/= f) <$> addAssociatedFile k f @@ -197,3 +189,18 @@ toDirect k f = do {- Another direct file has the content, so - hard link to it. -} liftIO $ replaceFile f $ createLink loc' + +{- Removes a direct mode file, while retaining its content. -} +removeDirect :: Key -> FilePath -> Annex () +removeDirect k f = do + locs <- removeAssociatedFile k f + when (null locs) $ do + r <- liftIO $ catchMaybeIO $ getSymbolicLinkStatus f + case r of + Just s + | not (isSymbolicLink s) -> + moveAnnex k f + _ -> noop + liftIO $ do + nukeFile f + void $ catchMaybeIO $ removeDirectory $ parentDir f diff --git a/Command/Direct.hs b/Command/Direct.hs index 991930c38..8e7f40145 100644 --- a/Command/Direct.hs +++ b/Command/Direct.hs @@ -41,7 +41,7 @@ perform = do next cleanup where go = whenAnnexed $ \f (k, _) -> do - r <- toDirect k f + r <- toDirectGen k f case r of Nothing -> noop Just a -> do diff --git a/Command/Sync.hs b/Command/Sync.hs index 2d1b2fb9c..d6736a616 100644 --- a/Command/Sync.hs +++ b/Command/Sync.hs @@ -15,6 +15,7 @@ import qualified Annex import qualified Annex.Branch import qualified Annex.Queue import Annex.Content +import Annex.Content.Direct import Annex.Direct import Annex.CatFile import qualified Git.Command @@ -234,7 +235,8 @@ resolveMerge' :: LsFiles.Unmerged -> Annex Bool resolveMerge' u | issymlink LsFiles.valUs && issymlink LsFiles.valThem = withKey LsFiles.valUs $ \keyUs -> - withKey LsFiles.valThem $ \keyThem -> go keyUs keyThem + withKey LsFiles.valThem $ \keyThem -> do + go keyUs keyThem | otherwise = return False where go keyUs keyThem @@ -242,7 +244,10 @@ resolveMerge' u makelink keyUs return True | otherwise = do - liftIO $ nukeFile file + ifM isDirect + ( maybe noop (\k -> removeDirect k file) keyUs + , liftIO $ nukeFile file + ) Annex.Queue.addCommand "rm" [Params "--quiet -f --"] [file] makelink keyUs makelink keyThem @@ -257,6 +262,8 @@ resolveMerge' u nukeFile dest createSymbolicLink l dest Annex.Queue.addCommand "add" [Param "--force", Param "--"] [dest] + whenM (isDirect) $ + toDirect key dest makelink _ = noop withKey select a = do let msha = select $ LsFiles.unmergedSha u |