diff options
Diffstat (limited to 'Assistant/Threads/Merger.hs')
| -rw-r--r-- | Assistant/Threads/Merger.hs | 27 |
1 files changed, 15 insertions, 12 deletions
diff --git a/Assistant/Threads/Merger.hs b/Assistant/Threads/Merger.hs index 46f516262..e415a7562 100644 --- a/Assistant/Threads/Merger.hs +++ b/Assistant/Threads/Merger.hs @@ -11,6 +11,7 @@ import Assistant.Common import Assistant.ThreadedMonad import Assistant.DaemonStatus import Assistant.TransferQueue +import Assistant.BranchChange import Utility.DirWatcher import Utility.Types.DirWatcher import qualified Annex.Branch @@ -23,12 +24,12 @@ thisThread = "Merger" {- This thread watches for changes to .git/refs/, and handles incoming - pushes. -} -mergeThread :: ThreadState -> DaemonStatusHandle -> TransferQueue -> NamedThread -mergeThread st dstatus transferqueue = thread $ do +mergeThread :: ThreadState -> DaemonStatusHandle -> TransferQueue -> BranchChangeHandle -> NamedThread +mergeThread st dstatus transferqueue branchchange = thread $ do g <- runThreadState st gitRepo let dir = Git.localGitDir g </> "refs" createDirectoryIfMissing True dir - let hook a = Just $ runHandler st dstatus transferqueue a + let hook a = Just $ runHandler st dstatus transferqueue branchchange a let hooks = mkWatchHooks { addHook = hook onAdd , errHook = hook onErr @@ -38,21 +39,21 @@ mergeThread st dstatus transferqueue = thread $ do where thread = NamedThread thisThread -type Handler = ThreadState -> DaemonStatusHandle -> TransferQueue -> FilePath -> Maybe FileStatus -> IO () +type Handler = ThreadState -> DaemonStatusHandle -> TransferQueue -> BranchChangeHandle -> FilePath -> Maybe FileStatus -> IO () {- Runs an action handler. - - Exceptions are ignored, otherwise a whole thread could be crashed. -} -runHandler :: ThreadState -> DaemonStatusHandle -> TransferQueue -> Handler -> FilePath -> Maybe FileStatus -> IO () -runHandler st dstatus transferqueue handler file filestatus = void $ +runHandler :: ThreadState -> DaemonStatusHandle -> TransferQueue -> BranchChangeHandle -> Handler -> FilePath -> Maybe FileStatus -> IO () +runHandler st dstatus transferqueue branchchange handler file filestatus = void $ either print (const noop) =<< tryIO go where - go = handler st dstatus transferqueue file filestatus + go = handler st dstatus transferqueue branchchange file filestatus {- Called when there's an error with inotify. -} onErr :: Handler -onErr _ _ _ msg _ = error msg +onErr _ _ _ _ msg _ = error msg {- Called when a new branch ref is written. - @@ -66,11 +67,13 @@ onErr _ _ _ msg _ = error msg - ran are merged in. -} onAdd :: Handler -onAdd st dstatus transferqueue file _ +onAdd st dstatus transferqueue branchchange file _ | ".lock" `isSuffixOf` file = noop - | isAnnexBranch file = runThreadState st $ - whenM Annex.Branch.forceUpdate $ - queueDeferredDownloads Later transferqueue dstatus + | isAnnexBranch file = do + branchChanged branchchange + runThreadState st $ + whenM Annex.Branch.forceUpdate $ + queueDeferredDownloads Later transferqueue dstatus | "/synced/" `isInfixOf` file = runThreadState st $ do mergecurrent =<< inRepo Git.Branch.current | otherwise = noop |