mirrors/git-annex
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages 1 Wiki Activity Actions

avoid redundant CanPush messages with different shas being queued up

Browse source
This commit is contained in:
Joey Hess 2013-05-26 17:09:23 -04:00
parent c3cf6bef34
commit f857c44b45
1 changed files with 5 additions and 3 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

8
Assistant/NetMessager.hs
View file

@ -32,8 +32,9 @@ notifyNetMessagerRestart =
waitNetMessagerRestart :: Assistant ()
waitNetMessagerRestart = readSV <<~ (netMessagerRestart . netMessager)
{- Store an important NetMessage for a client, and if an equivilant
- message was already sent, remove it from sentImportantNetMessages. -}
{- Store a new important NetMessage for a client, and if an equivilant
- older message is already stored, remove it from both importantNetMessages
- and sentImportantNetMessages. -}
storeImportantNetMessage :: NetMessage -> ClientID -> (ClientID -> Bool) -> Assistant ()
storeImportantNetMessage m client matchingclient = go <<~ netMessager
where
@ -41,7 +42,8 @@ storeImportantNetMessage m client matchingclient = go <<~ netMessager
q <- takeTMVar $ importantNetMessages nm
sent <- takeTMVar $ sentImportantNetMessages nm
putTMVar (importantNetMessages nm) $
M.alter (Just . maybe (S.singleton m) (S.insert m)) client q
M.alter (Just . maybe (S.singleton m) (S.insert m)) client $
M.mapWithKey removematching sent q
putTMVar (sentImportantNetMessages nm) $
M.mapWithKey removematching sent
removematching someclient s