diff options
author | Joey Hess <joey@kitenet.net> | 2012-07-28 18:47:24 -0400 |
---|---|---|
committer | Joey Hess <joey@kitenet.net> | 2012-07-28 18:47:24 -0400 |
commit | e31277d38aa5d9b07395d05a6f1646b5eb3d48c2 (patch) | |
tree | 290f14867fc066daf2e84f2644bccc2356da09df /Assistant/Threads/TransferScanner.hs | |
parent | 3cc18857936e5a09e033439971dc9c43e6ccbaa2 (diff) |
send notifications when the TransferQueue is changed
The fun part was making it move things from TransferQueue to currentTransfers
entirely atomically. Which will avoid inconsistent display if the WebApp
renders the current status at just the wrong time. STM to the rescue!
Diffstat (limited to 'Assistant/Threads/TransferScanner.hs')
-rw-r--r-- | Assistant/Threads/TransferScanner.hs | 13 |
1 files changed, 7 insertions, 6 deletions
diff --git a/Assistant/Threads/TransferScanner.hs b/Assistant/Threads/TransferScanner.hs index e76cbe81d..e6a078907 100644 --- a/Assistant/Threads/TransferScanner.hs +++ b/Assistant/Threads/TransferScanner.hs @@ -11,6 +11,7 @@ import Assistant.Common import Assistant.ScanRemotes import Assistant.TransferQueue import Assistant.ThreadedMonad +import Assistant.DaemonStatus import Logs.Transfer import Logs.Location import qualified Remote @@ -25,20 +26,20 @@ thisThread = "TransferScanner" {- This thread waits until a remote needs to be scanned, to find transfers - that need to be made, to keep data in sync. -} -transferScannerThread :: ThreadState -> ScanRemoteMap -> TransferQueue -> IO () -transferScannerThread st scanremotes transferqueue = do +transferScannerThread :: ThreadState -> DaemonStatusHandle -> ScanRemoteMap -> TransferQueue -> IO () +transferScannerThread st dstatus scanremotes transferqueue = do runEvery (Seconds 2) $ do r <- getScanRemote scanremotes liftIO $ debug thisThread ["starting scan of", show r] - scan st transferqueue r + scan st dstatus transferqueue r liftIO $ debug thisThread ["finished scan of", show r] where {- This is a naive scan through the git work tree. - - The scan is blocked when the transfer queue gets too large. -} -scan :: ThreadState -> TransferQueue -> Remote -> IO () -scan st transferqueue r = do +scan :: ThreadState -> DaemonStatusHandle -> TransferQueue -> Remote -> IO () +scan st dstatus transferqueue r = do g <- runThreadState st $ fromRepo id files <- LsFiles.inRepo [] g go files @@ -63,7 +64,7 @@ scan st transferqueue r = do | otherwise = return Nothing u = Remote.uuid r - enqueue f t = queueTransferAt smallsize Later transferqueue (Just f) t r + enqueue f t = queueTransferAt smallsize Later transferqueue dstatus (Just f) t r smallsize = 10 {- Look directly in remote for the key when it's cheap; |