direct mode mappings now updated by git annex sync

Still lots to do to make sync handle direct mode, but this is a good first
step.

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)

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)
+		update branch $
-	Just _ -> all id <$> (mapM merge =<< tomerge (branchlist b))
+			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