From b3b800bb6140543306ec65751506ae2862ca345f Mon Sep 17 00:00:00 2001
From: Joey Hess <joeyh@joeyh.name>
Date: Fri, 9 Dec 2016 14:52:38 -0400
Subject: refactor ref change watching

Added to change notification to P2P protocol.

Switched to a TBChan so that a single long-running thread can be
started, and serve perhaps intermittent requests for change
notifications, without buffering all changes in memory.

The P2P runner currently starts up a new thread each times it waits
for a change, but that should allow later reusing a thread. Although
each connection from a peer will still need a new watcher thread to run.

The dependency on stm-chans is more or less free; some stuff in yesod
uses it, so it was already indirectly pulled in when building with the
webapp.

This commit was sponsored by Francois Marier on Patreon.
---
 Command/NotifyChanges.hs | 48 ++++++------------------------------------------
 1 file changed, 6 insertions(+), 42 deletions(-)

(limited to 'Command/NotifyChanges.hs')

diff --git a/Command/NotifyChanges.hs b/Command/NotifyChanges.hs
index bb9b10eee..83d7bca3f 100644
--- a/Command/NotifyChanges.hs
+++ b/Command/NotifyChanges.hs
@@ -8,6 +8,7 @@
 module Command.NotifyChanges where
 
 import Command
+import Annex.ChangedRefs
 import Utility.DirWatcher
 import Utility.DirWatcher.Types
 import qualified Git
@@ -30,55 +31,18 @@ seek = withNothing start
 
 start :: CommandStart
 start = do
-	-- This channel is used to accumulate notifcations,
-	-- because the DirWatcher might have multiple threads that find
-	-- changes at the same time.
-	chan <- liftIO newTChanIO
-	
-	g <- gitRepo
-	let refdir = Git.localGitDir g </> "refs"
-	liftIO $ createDirectoryIfMissing True refdir
+	h <- watchChangedRefs
 
-	let notifyhook = Just $ notifyHook chan
-	let hooks = mkWatchHooks
-		{ addHook = notifyhook
-		, modifyHook = notifyhook
-		}
-
-	void $ liftIO $ watchDir refdir (const False) True hooks id
-
-	let sender = do
-		send READY
-		forever $ send . CHANGED =<< drain chan
-	
 	-- No messages need to be received from the caller,
 	-- but when it closes the connection, notice and terminate.
 	let receiver = forever $ void $ getProtocolLine stdin
+	let sender = forever $ send . CHANGED =<< waitChangedRefs h
+
+	liftIO $ send READY
 	void $ liftIO $ concurrently sender receiver
+	liftIO $ stopWatchingChangedRefs h
 	stop
 
-notifyHook :: TChan Git.Sha -> FilePath -> Maybe FileStatus -> IO ()
-notifyHook chan reffile _
-	| ".lock" `isSuffixOf` reffile = noop
-	| otherwise = void $ do
-		sha <- catchDefaultIO Nothing $
-			extractSha <$> readFile reffile
-		maybe noop (atomically . writeTChan chan) sha
-
--- When possible, coalesce ref writes that occur closely together
--- in time. Delay up to 0.05 seconds to get more ref writes.
-drain :: TChan Git.Sha -> IO [Git.Sha]
-drain chan = do
-	r <- atomically $ readTChan chan
-	threadDelay 50000
-	rs <- atomically $ drain' chan
-	return (r:rs)
-
-drain' :: TChan Git.Sha -> STM [Git.Sha]
-drain' chan = loop []
-  where
-	loop rs = maybe (return rs) (\r -> loop (r:rs)) =<< tryReadTChan chan
-
 send :: Notification -> IO ()
 send n = do
 	putStrLn $ unwords $ formatMessage n
-- 
cgit v1.2.3