summaryrefslogtreecommitdiff
path: root/Command/NotifyChanges.hs
diff options
context:
space:
mode:
authorGravatar Joey Hess <joeyh@joeyh.name>2016-12-09 14:52:38 -0400
committerGravatar Joey Hess <joeyh@joeyh.name>2016-12-09 15:01:09 -0400
commitb3b800bb6140543306ec65751506ae2862ca345f (patch)
tree6357ef2d4ea6a6f302b9b00f45d25e4c997b5ec2 /Command/NotifyChanges.hs
parent94e91f857e9ae3522c31c3d2268475aeae45fdb3 (diff)
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.
Diffstat (limited to 'Command/NotifyChanges.hs')
-rw-r--r--Command/NotifyChanges.hs48
1 files changed, 6 insertions, 42 deletions
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