assistant direct mode file add/change bookkeeping

When a file is changed in direct mode, the old content is probably lost
(at least from the local repo), and bookeeping needs to be updated to
reflect this.

Also, synthetic add events are generated at assistant startup, so
make it detect when the file has not really changed, and avoid re-adding
it.

This does add the overhead of querying the runing git cat-file for the
key that's recorded in git for the file, each time a file is added or
modified in direct mode.

4 files changed, 39 insertions, 7 deletions

diff --git a/Annex/CatFile.hs b/Annex/CatFile.hs
index 161554f29..ffac4fccd 100644
--- a/Annex/CatFile.hs
+++ b/Annex/CatFile.hs
@@ -44,6 +44,6 @@ catFileHandle = maybe startup return =<< Annex.getState Annex.catfilehandle
 		Annex.changeState $ \s -> s { Annex.catfilehandle = Just h }
 		return h
 
-{- From the Sha of a symlink back to the key. -}
-catKey :: Sha -> Annex (Maybe Key)
-catKey sha = fileKey . takeFileName . encodeW8 . L.unpack  <$> catObject sha
+{- From the Sha or Ref of a symlink back to the key. -}
+catKey :: Ref -> Annex (Maybe Key)
+catKey ref = fileKey . takeFileName . encodeW8 . L.unpack  <$> catObject ref
diff --git a/Annex/Content/Direct.hs b/Annex/Content/Direct.hs
index 75a32e3fc..75cdaad79 100644
--- a/Annex/Content/Direct.hs
+++ b/Annex/Content/Direct.hs
@@ -10,6 +10,7 @@ module Annex.Content.Direct (
 	removeAssociatedFile,
 	addAssociatedFile,
 	goodContent,
+	changedFileStatus,
 	updateCache,
 	recordedCache,
 	compareCache,
@@ -79,6 +80,12 @@ goodContent key file = do
 	old <- recordedCache key
 	compareCache file old
 
+changedFileStatus :: Key -> FileStatus -> Annex Bool
+changedFileStatus key status = do
+	old <- recordedCache key
+	let curr = toCache status
+	return $ curr == old
+
 {- Gets the recorded cache for a key. -}
 recordedCache :: Key -> Annex (Maybe Cache)
 recordedCache key = withCacheFile key $ \cachefile ->
diff --git a/Annex/Direct.hs b/Annex/Direct.hs
index 77a544257..e44081639 100644
--- a/Annex/Direct.hs
+++ b/Annex/Direct.hs
@@ -209,3 +209,11 @@ removeDirect k f = do
 	liftIO $ do
 		nukeFile f
 		void $ catchMaybeIO $ removeDirectory $ parentDir f
+
+{- Called when a direct mode file has been changed. Its old content may be
+ - lost. -}
+changedDirect :: Key -> FilePath -> Annex ()
+changedDirect oldk f = do
+	locs <- removeAssociatedFile oldk f
+	whenM (pure (null locs) <&&> not <$> inAnnex oldk) $
+		logStatus oldk InfoMissing
diff --git a/Assistant/Threads/Watcher.hs b/Assistant/Threads/Watcher.hs
index fd59f1b27..507362dd8 100644
--- a/Assistant/Threads/Watcher.hs
+++ b/Assistant/Threads/Watcher.hs
@@ -33,6 +33,8 @@ import qualified Git.HashObject
 import qualified Git.LsFiles as LsFiles
 import qualified Backend
 import Annex.Content
+import Annex.Direct
+import Annex.Content.Direct
 import Annex.CatFile
 import Git.Types
 import Config
@@ -60,7 +62,7 @@ watchThread :: NamedThread
 watchThread = NamedThread "Watcher" $ do
 	startup <- asIO1 startupScan
 	direct <- liftAnnex isDirect
-	addhook <- hook $ onAdd direct
+	addhook <- hook $ if direct then onAddDirect else onAdd
 	delhook <- hook onDel
 	addsymlinkhook <- hook onAddSymlink
 	deldirhook <- hook onDelDir
@@ -126,12 +128,27 @@ runHandler handler file filestatus = void $ do
 			liftAnnex $ Annex.Queue.flushWhenFull
 			recordChange change
 
-onAdd :: Bool -> Handler
-onAdd isdirect file filestatus
-	| isdirect = pendingAddChange file
+onAdd :: Handler
+onAdd file filestatus
 	| maybe False isRegularFile filestatus = pendingAddChange file
 	| otherwise = noChange
 
+{- In direct mode, add events are received for both new files, and
+ - modified existing files. Or, in some cases, existing files that have not
+ - really been modified. -}
+onAddDirect :: Handler
+onAddDirect file fs = do
+	v <- liftAnnex $ catKey (Ref $ ':':file)
+	case (v, fs) of
+		(Just key, Just filestatus) ->
+			ifM (liftAnnex $ changedFileStatus key filestatus)
+				( noChange
+				, do
+					liftAnnex $ changedDirect key file
+					pendingAddChange file
+				)
+		_ -> pendingAddChange file
+
 {- A symlink might be an arbitrary symlink, which is just added.
  - Or, if it is a git-annex symlink, ensure it points to the content
  - before adding it.