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

refactor

Browse source
This commit is contained in:
Joey Hess 2012-11-09 23:17:47 -04:00
parent 6174c748af
commit 4a5e758a5a
1 changed files with 9 additions and 10 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

19
Assistant/XMPP/Git.hs
View file

@ -233,25 +233,24 @@ xmppRemotes cid = case baseJID <$> parseJID cid of
let r = Remote.repo remote
return $ repoIsUrl r && repoLocation r == "xmpp::" ++ want
handleDeferred :: NetMessage -> Assistant ()
handleDeferred = handlePushMessage
whenXMPPRemote :: ClientID -> Assistant () -> Assistant ()
whenXMPPRemote cid = unlessM (null <$> xmppRemotes cid)
handlePushMessage :: NetMessage -> Assistant ()
handlePushMessage (CanPush cid) = do
rs <- xmppRemotes cid
unless (null rs) $
sendNetMessage $ PushRequest cid
handlePushMessage (CanPush cid) = whenXMPPRemote cid $
sendNetMessage $ PushRequest cid
handlePushMessage (PushRequest cid) = do
rs <- xmppRemotes cid
current <- liftAnnex $ inRepo Git.Branch.current
--let refs = catMaybes [current, Just Annex.Branch.fullname] -- TODO
let refs = [Ref "master:refs/xmpp/newmaster"]
forM_ rs $ \r -> xmppPush cid r refs
handlePushMessage (StartingPush cid) = do
rs <- xmppRemotes cid
unless (null rs) $
void $ xmppReceivePack cid
handlePushMessage (StartingPush cid) = whenXMPPRemote cid $
void $ xmppReceivePack cid
handlePushMessage _ = noop
handleDeferred :: NetMessage -> Assistant ()
handleDeferred = handlePushMessage
chunkSize :: Int
chunkSize = 1024