diff options
| -rw-r--r-- | Annex/Content/Direct.hs | 53 | ||||
| -rw-r--r-- | Command/Sync.hs | 27 |
2 files changed, 74 insertions, 6 deletions
diff --git a/Annex/Content/Direct.hs b/Annex/Content/Direct.hs index 4a91cfcf6..9f4026ed6 100644 --- a/Annex/Content/Direct.hs +++ b/Annex/Content/Direct.hs @@ -7,6 +7,8 @@ module Annex.Content.Direct ( associatedFiles, + changeAssociatedFiles, + updateAssociatedFiles, goodContent, updateCache, recordedCache, @@ -16,8 +18,14 @@ module Annex.Content.Direct ( import Common.Annex import qualified Git +import qualified Git.DiffTree as DiffTree +import Git.Sha +import Annex.CatFile +import Utility.TempFile +import Utility.FileMode import System.Posix.Types +import qualified Data.ByteString.Lazy as L {- Files in the tree that are associated with a key. - @@ -34,6 +42,45 @@ associatedFiles key = do top <- fromRepo Git.repoPath return $ map (top </>) files +{- Changes the associated files information for a key, applying a + - transformation to the list. -} +changeAssociatedFiles :: Key -> ([FilePath] -> [FilePath]) -> Annex () +changeAssociatedFiles key transform = do + mapping <- inRepo $ gitAnnexMapping key + liftIO $ do + files <- catchDefaultIO [] $ lines <$> readFile mapping + let files' = transform files + when (files /= files') $ + viaTmp writeFile mapping $ unlines files' + +removeAssociatedFile :: Key -> FilePath -> Annex () +removeAssociatedFile key file = changeAssociatedFiles key $ filter (/= file) + +addAssociatedFile :: Key -> FilePath -> Annex () +addAssociatedFile key file = changeAssociatedFiles key $ \files -> + if file `elem` files + then files + else file:files + +{- Uses git diff-tree to find files changed between two tree Shas, and + - updates the associated file mappings, efficiently -} +updateAssociatedFiles :: Git.Sha -> Git.Sha -> Annex () +updateAssociatedFiles oldsha newsha = do + (items, cleanup) <- inRepo $ DiffTree.diffTree oldsha newsha + forM_ items update + void $ liftIO $ cleanup + where + update item = do + go DiffTree.dstsha DiffTree.dstmode addAssociatedFile + go DiffTree.srcsha DiffTree.srcmode removeAssociatedFile + where + go getsha getmode a = + when (getsha item /= nullSha && isSymLink (getmode item)) $ do + key <- getkey $ getsha item + maybe noop (\k -> a k $ DiffTree.file item) key + getkey sha = fileKey . takeFileName . encodeW8 . L.unpack + <$> catObject sha + {- Checks if a file in the tree, associated with a key, has not been modified. - - To avoid needing to fsck the file's content, which can involve an @@ -65,9 +112,6 @@ updateCache key file = withCacheFile key $ \cachefile -> removeCache :: Key -> Annex () removeCache key = withCacheFile key nukeFile -withCacheFile :: Key -> (FilePath -> IO a) -> Annex a -withCacheFile key a = liftIO . a =<< inRepo (gitAnnexCache key) - {- Cache a file's inode, size, and modification time to determine if it's - been changed. -} data Cache = Cache FileID FileOffset EpochTime @@ -98,3 +142,6 @@ toCache s (fileSize s) (modificationTime s) | otherwise = Nothing + +withCacheFile :: Key -> (FilePath -> IO a) -> Annex a +withCacheFile key a = liftIO . a =<< inRepo (gitAnnexCache key) diff --git a/Command/Sync.hs b/Command/Sync.hs index f7410112e..95ce0697e 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.CatFile import qualified Git.Command import qualified Git.LsFiles as LsFiles @@ -129,19 +130,39 @@ pullRemote remote branch = do {- The remote probably has both a master and a synced/master branch. - Which to merge from? Well, the master has whatever latest changes - were committed, while the synced/master may have changes that some - - other remote synced to this remote. So, merge them both. -} + - other remote synced to this remote. So, merge them both. + - + - In direct mode, updates associated files mappings for the files that + - were changed by the merge. + -} mergeRemote :: Remote -> (Maybe Git.Ref) -> CommandCleanup mergeRemote remote b = case b of Nothing -> do branch <- inRepo Git.Branch.currentUnsafe - all id <$> (mapM merge $ branchlist branch) - Just _ -> all id <$> (mapM merge =<< tomerge (branchlist b)) + update branch $ + all id <$> (mapM merge $ branchlist branch) + Just branch -> update (Just branch) $ + all id <$> (mapM merge =<< tomerge (branchlist b)) where merge = mergeFrom . remoteBranch remote tomerge branches = filterM (changed remote) branches branchlist Nothing = [] branchlist (Just branch) = [branch, syncBranch branch] + update Nothing a = a + update (Just branch) a = ifM isDirect + ( do + old <- inRepo $ Git.Ref.sha branch + r <- a + new <- inRepo $ Git.Ref.sha branch + case (old, new) of + (Just oldsha, Just newsha) -> do + updateAssociatedFiles oldsha newsha + _ -> noop + return r + , a + ) + pushRemote :: Remote -> Git.Ref -> CommandStart pushRemote remote branch = go =<< needpush where |