plumb file status through to event handlers

The idea, not yet done, is to use this to detect when a file
has an old change time, and avoid expensive restaging of the file.

If git-annex watch keeps track of the last time it finished a full scan,
then any symlink that is older than that time must have been scanned
before, so need not be added. (Relying on moving, copying, etc of a file
all updating its change time.)

Anyway, this info is available for free since inotify already checks it,
so it might as well make it available.

2 files changed, 37 insertions, 30 deletions

diff --git a/Command/Watch.hs b/Command/Watch.hs
index 6f85c124c..b97a4212d 100644
--- a/Command/Watch.hs
+++ b/Command/Watch.hs
@@ -68,7 +68,7 @@ import System.INotify
 
 type ChangeChan = TChan Change
 
-type Handler = FilePath -> Annex (Maybe Change)
+type Handler = FilePath -> Maybe FileStatus -> Annex (Maybe Change)
 
 data Change = Change
 	{ changeTime :: UTCTime
@@ -181,9 +181,9 @@ runChangeChan = atomically
  -
  - Exceptions are ignored, otherwise a whole watcher thread could be crashed.
  -}
-runHandler :: MVar Annex.AnnexState -> ChangeChan -> Handler -> FilePath -> IO ()
-runHandler st changechan handler file = void $ do
-	r <- tryIO (runStateMVar st $ handler file)
+runHandler :: MVar Annex.AnnexState -> ChangeChan -> Handler -> FilePath -> Maybe FileStatus -> IO ()
+runHandler st changechan handler file filestatus = void $ do
+	r <- tryIO (runStateMVar st $ handler file filestatus)
 	case r of
 		Left e -> print e
 		Right Nothing -> noop
@@ -214,7 +214,7 @@ noChange = return Nothing
  - startup.
  -}
 onAdd :: Handler
-onAdd file = do
+onAdd file _filestatus = do
 	ifM (Annex.getState Annex.fast)
 		( go -- initial directory scan is complete
 		, do -- expensive check done only during startup scan
@@ -243,7 +243,7 @@ onAdd file = do
  - already exist.
  -}
 onAddSymlink :: Handler
-onAddSymlink file = go =<< Backend.lookupFile file
+onAddSymlink file filestatus = go =<< Backend.lookupFile file
 	where
 		go Nothing = addlink =<< liftIO (readSymbolicLink file)
 		go (Just (key, _)) = do
@@ -270,7 +270,7 @@ onAddSymlink file = go =<< Backend.lookupFile file
 			madeChange file "link"
 
 onDel :: Handler
-onDel file = do
+onDel file _filestatus = do
 	Annex.Queue.addUpdateIndex =<<
 		inRepo (Git.UpdateIndex.unstageFile file)
 	madeChange file "rm"
@@ -283,14 +283,14 @@ onDel file = do
  - command to get the recursive list of files in the directory, so rm is
  - just as good. -}
 onDelDir :: Handler
-onDelDir dir = do
+onDelDir dir _filestatus = do
 	Annex.Queue.addCommand "rm"
 		[Params "--quiet -r --cached --ignore-unmatch --"] [dir]
 	madeChange dir "rmdir"
 
 {- Called when there's an error with inotify. -}
 onErr :: Handler
-onErr msg = do
+onErr msg _ = do
 	warning msg
 	return Nothing
 
diff --git a/Utility/Inotify.hs b/Utility/Inotify.hs
index 6eb7be31c..9ad947f31 100644
--- a/Utility/Inotify.hs
+++ b/Utility/Inotify.hs
@@ -15,7 +15,7 @@ import qualified System.Posix.Files as Files
 import System.IO.Error
 import Control.Exception (throw)
 
-type Hook a = Maybe (a -> IO ())
+type Hook a = Maybe (a -> Maybe FileStatus -> IO ())
 
 data WatchHooks = WatchHooks
 	{ addHook :: Hook FilePath
@@ -84,15 +84,18 @@ watchDir i dir ignored hooks
 			| otherwise = []
 
 		scan f = unless (ignored f) $ do
-			let fullf = indir f
-			r <- catchMaybeIO $ getSymbolicLinkStatus fullf
-			case r of
+			ms <- getstatus f
+			case ms of
 				Nothing -> return ()
 				Just s
-					| Files.isDirectory s -> recurse fullf
-					| Files.isSymbolicLink s -> addSymlinkHook <@> f
-					| Files.isRegularFile s -> addHook <@> f
-					| otherwise -> return ()
+					| Files.isDirectory s ->
+						recurse $ indir f
+					| Files.isSymbolicLink s ->
+						runhook addSymlinkHook f ms
+					| Files.isRegularFile s ->
+						runhook addHook f ms
+					| otherwise ->
+						noop
 
 		-- Ignore creation events for regular files, which won't be
 		-- done being written when initially created, but handle for
@@ -100,39 +103,43 @@ watchDir i dir ignored hooks
 		go (Created { isDirectory = isd, filePath = f })
 			| isd = recurse $ indir f
 			| hashook addSymlinkHook =
-				whenM (filetype Files.isSymbolicLink f) $
-					addSymlinkHook <@> f
+				checkfiletype Files.isSymbolicLink addSymlinkHook f
 			| otherwise = noop
 		-- Closing a file is assumed to mean it's done being written.
 		go (Closed { isDirectory = False, maybeFilePath = Just f }) =
-			whenM (filetype Files.isRegularFile f) $
-				addHook <@> f
+				checkfiletype Files.isRegularFile addHook f
 		-- When a file or directory is moved in, scan it to add new
 		-- stuff.
 		go (MovedIn { filePath = f }) = scan f
 		go (MovedOut { isDirectory = isd, filePath = f })
-			| isd = delDirHook <@> f
-			| otherwise = delHook <@> f
+			| isd = runhook delDirHook f Nothing
+			| otherwise = runhook delHook f Nothing
 		-- Verify that the deleted item really doesn't exist,
 		-- since there can be spurious deletion events for items
 		-- in a directory that has been moved out, but is still
 		-- being watched.
 		go (Deleted { isDirectory = isd, filePath = f })
-			| isd = guarded $ delDirHook <@> f
-			| otherwise = guarded $ delHook <@> f
+			| isd = guarded $ runhook delDirHook f Nothing
+			| otherwise = guarded $ runhook delHook f Nothing
 			where
 				guarded = unlessM (filetype (const True) f)
 		go _ = noop
 
 		hashook h = isJust $ h hooks
 
-		runhook h f
+		runhook h f s
 			| ignored f = noop
-			| otherwise = maybe noop (\a -> a $ indir f) (h hooks)
-		h <@> f = runhook h f
+			| otherwise = maybe noop (\a -> a (indir f) s) (h hooks)
 
 		indir f = dir </> f
 
+		getstatus f = catchMaybeIO $ getSymbolicLinkStatus $ indir f
+		checkfiletype check h f = do
+			ms <- getstatus f
+			case ms of
+				Just s
+					| check s -> runhook h f ms
+				_ -> noop
 		filetype t f = catchBoolIO $ t <$> getSymbolicLinkStatus (indir f)
 
 		-- Inotify fails when there are too many watches with a
@@ -144,10 +151,10 @@ watchDir i dir ignored hooks
 					Just hook -> tooManyWatches hook dir
 			| otherwise = throw e
 
-tooManyWatches :: (String -> IO ()) -> FilePath -> IO ()
+tooManyWatches :: (String -> Maybe FileStatus -> IO ()) -> FilePath -> IO ()
 tooManyWatches hook dir = do
 	sysctlval <- querySysctl [Param maxwatches] :: IO (Maybe Integer)
-	hook $ unlines $ basewarning : maybe withoutsysctl withsysctl sysctlval
+	hook (unlines $ basewarning : maybe withoutsysctl withsysctl sysctlval) Nothing
 	where
 		maxwatches = "fs.inotify.max_user_watches"
 		basewarning = "Too many directories to watch! (Not watching " ++ dir ++")"