add annex.delayadd configuration

3 files changed, 32 insertions, 19 deletions

diff --git a/Assistant/Threads/SanityChecker.hs b/Assistant/Threads/SanityChecker.hs
index 148ae1435..b99d72802 100644
--- a/Assistant/Threads/SanityChecker.hs
+++ b/Assistant/Threads/SanityChecker.hs
@@ -93,7 +93,7 @@ check st dstatus transferqueue changechan = do
 			runThreadState st $ warning msg
 			void $ addAlert dstatus $ sanityCheckFixAlert msg
 		addsymlink file s = do
-			Watcher.runHandler thisThread st dstatus
+			Watcher.runHandler thisThread Nothing st dstatus
 				transferqueue changechan
 				Watcher.onAddSymlink file s
 			insanity $ "found unstaged symlink: " ++ file
diff --git a/Assistant/Threads/Watcher.hs b/Assistant/Threads/Watcher.hs
index 17ec0b81f..fa8b7b379 100644
--- a/Assistant/Threads/Watcher.hs
+++ b/Assistant/Threads/Watcher.hs
@@ -34,6 +34,8 @@ import qualified Command.Add
 import Annex.Content
 import Annex.CatFile
 import Git.Types
+import Config
+import Utility.ThreadScheduler
 
 import Data.Bits.Utils
 import qualified Data.ByteString.Lazy as L
@@ -58,17 +60,19 @@ needLsof = error $ unlines
 
 watchThread :: ThreadState -> DaemonStatusHandle -> TransferQueue -> ChangeChan -> NamedThread
 watchThread st dstatus transferqueue changechan = NamedThread thisThread $ do
-	void $ watchDir "." ignored hooks startup
+	delayadd <- runThreadState st $
+		readish <$> getConfig (annexConfig "delayadd") "" 
+	void $ watchDir "." ignored (hooks delayadd) startup
 	debug thisThread [ "watching", "."]
 	where
 		startup = startupScan st dstatus
-		hook a = Just $ runHandler thisThread st dstatus transferqueue changechan a
-		hooks = WatchHooks
-			{ addHook = hook onAdd
-			, delHook = hook onDel
-			, addSymlinkHook = hook onAddSymlink
-			, delDirHook = hook onDelDir
-			, errHook = hook onErr
+		hook delay a = Just $ runHandler thisThread delay st dstatus transferqueue changechan a
+		hooks delayadd = WatchHooks
+			{ addHook = hook (Seconds <$> delayadd) onAdd
+			, delHook = hook Nothing onDel
+			, addSymlinkHook = hook Nothing onAddSymlink
+			, delDirHook = hook Nothing onDelDir
+			, errHook = hook Nothing onErr
 			}
 
 {- Initial scartup scan. The action should return once the scan is complete. -}
@@ -96,22 +100,22 @@ ignored = ig . takeFileName
 	ig ".gitattributes" = True
 	ig _ = False
 
-type Handler = ThreadName -> FilePath -> Maybe FileStatus -> DaemonStatusHandle -> TransferQueue -> Annex (Maybe Change)
+type Handler = ThreadName -> Maybe Seconds -> FilePath -> Maybe FileStatus -> DaemonStatusHandle -> TransferQueue -> Annex (Maybe Change)
 
 {- Runs an action handler, inside the Annex monad, and if there was a
  - change, adds it to the ChangeChan.
  -
  - Exceptions are ignored, otherwise a whole watcher thread could be crashed.
  -}
-runHandler :: ThreadName -> ThreadState -> DaemonStatusHandle -> TransferQueue -> ChangeChan -> Handler -> FilePath -> Maybe FileStatus -> IO ()
-runHandler threadname st dstatus transferqueue changechan handler file filestatus = void $ do
+runHandler :: ThreadName -> Maybe Seconds -> ThreadState -> DaemonStatusHandle -> TransferQueue -> ChangeChan -> Handler -> FilePath -> Maybe FileStatus -> IO ()
+runHandler threadname delay st dstatus transferqueue changechan handler file filestatus = void $ do
 	r <- tryIO go
 	case r of
 		Left e -> print e
 		Right Nothing -> noop
 		Right (Just change) -> recordChange changechan change
 	where
-		go = runThreadState st $ handler threadname file filestatus dstatus transferqueue
+		go = runThreadState st $ handler threadname delay file filestatus dstatus transferqueue
 
 {- During initial directory scan, this will be run for any regular files
  - that are already checked into git. We don't want to turn those into
@@ -132,7 +136,7 @@ runHandler threadname st dstatus transferqueue changechan handler file filestatu
  - the add.
  -}
 onAdd :: Handler
-onAdd threadname file filestatus dstatus _
+onAdd threadname delay file filestatus dstatus _
 	| maybe False isRegularFile filestatus =
 		ifM (scanComplete <$> liftIO (getDaemonStatus dstatus))
 			( go
@@ -144,7 +148,9 @@ onAdd threadname file filestatus dstatus _
 	| otherwise = noChange
 	where
 		go = do
-			liftIO $ debug threadname ["file added", file]
+			liftIO $ do
+				debug threadname ["file added", file]
+				maybe noop threadDelaySeconds delay
 			pendingAddChange =<< Command.Add.lockDown file
 
 {- A symlink might be an arbitrary symlink, which is just added.
@@ -152,7 +158,7 @@ onAdd threadname file filestatus dstatus _
  - before adding it.
  -}
 onAddSymlink :: Handler
-onAddSymlink threadname file filestatus dstatus transferqueue = go =<< Backend.lookupFile file
+onAddSymlink threadname _ file filestatus dstatus transferqueue = go =<< Backend.lookupFile file
 	where
 		go (Just (key, _)) = do
 			link <- calcGitLink file key
@@ -213,7 +219,7 @@ onAddSymlink threadname file filestatus dstatus transferqueue = go =<< Backend.l
 			| otherwise = noop
 
 onDel :: Handler
-onDel threadname file _ _dstatus _ = do
+onDel threadname _ file _ _dstatus _ = do
 	liftIO $ debug threadname ["file deleted", file]
 	Annex.Queue.addUpdateIndex =<<
 		inRepo (Git.UpdateIndex.unstageFile file)
@@ -227,7 +233,7 @@ onDel threadname file _ _dstatus _ = do
  - command to get the recursive list of files in the directory, so rm is
  - just as good. -}
 onDelDir :: Handler
-onDelDir threadname dir _ _dstatus _ = do
+onDelDir threadname _ dir _ _dstatus _ = do
 	liftIO $ debug threadname ["directory deleted", dir]
 	Annex.Queue.addCommand "rm"
 		[Params "--quiet -r --cached --ignore-unmatch --"] [dir]
@@ -235,7 +241,7 @@ onDelDir threadname dir _ _dstatus _ = do
 
 {- Called when there's an error with inotify or kqueue. -}
 onErr :: Handler
-onErr _ msg _ dstatus _ = do
+onErr _ _ msg _ dstatus _ = do
 	warning msg
 	void $ liftIO $ addAlert dstatus $ warningAlert "watcher" msg
 	return Nothing
diff --git a/doc/git-annex.mdwn b/doc/git-annex.mdwn
index e2c881dfb..6cc1fb39d 100644
--- a/doc/git-annex.mdwn
+++ b/doc/git-annex.mdwn
@@ -679,6 +679,13 @@ Here are all the supported configuration settings.
   set to `false`. Then data will only be committed when
   running `git annex merge` (or by automatic merges) or `git annex sync`.
 
+* `annex.delayadd`
+
+  Makes the watch and assistant commands delay for the specified number of
+  seconds before adding a newly created file to the annex. Normally this
+  is not needed, because they already wait for all writers of the file
+  to close it.
+
 * `remote.<name>.annex-cost`
 
   When determining which repository to