summaryrefslogtreecommitdiff
path: root/Assistant
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2012-11-10 16:35:09 -0400
committerGravatar Joey Hess <joey@kitenet.net>2012-11-10 16:36:21 -0400
commitd55ec6c25e8843910930a8e760db9793aad637ec (patch)
tree9f33b37d51379765399c6a17e1f5fd257c41f9b7 /Assistant
parentc629bc1a599da582be71d497f59dabc1961735d3 (diff)
show when a buddy is already paired
Diffstat (limited to 'Assistant')
-rw-r--r--Assistant/NetMessager.hs12
-rw-r--r--Assistant/Sync.hs10
-rw-r--r--Assistant/XMPP/Buddies.hs7
3 files changed, 16 insertions, 13 deletions
diff --git a/Assistant/NetMessager.hs b/Assistant/NetMessager.hs
index 5a2746cc7..c3bd73c57 100644
--- a/Assistant/NetMessager.hs
+++ b/Assistant/NetMessager.hs
@@ -9,12 +9,15 @@ module Assistant.NetMessager where
import Assistant.Common
import Assistant.Types.NetMessager
+import qualified Types.Remote as Remote
+import qualified Git
import Control.Concurrent
import Control.Concurrent.STM
import Control.Concurrent.MSampleVar
import Control.Exception as E
import qualified Data.Set as S
+import qualified Data.Text as T
sendNetMessage :: NetMessage -> Assistant ()
sendNetMessage m =
@@ -93,3 +96,12 @@ queueNetPushMessage m = do
waitNetPushMessage :: Assistant (NetMessage)
waitNetPushMessage = (atomically . readTChan) <<~ (netMessagesPush . netMessager)
+
+{- Remotes using the XMPP transport have urls like xmpp::user@host -}
+isXMPPRemote :: Remote -> Bool
+isXMPPRemote remote = Git.repoIsUrl r && "xmpp::" `isPrefixOf` Git.repoLocation r
+ where
+ r = Remote.repo remote
+
+getXMPPClientID :: Remote -> ClientID
+getXMPPClientID r = T.pack $ drop (length "xmpp::") (Git.repoLocation (Remote.repo r))
diff --git a/Assistant/Sync.hs b/Assistant/Sync.hs
index 8815f40c8..ae2b5ea36 100644
--- a/Assistant/Sync.hs
+++ b/Assistant/Sync.hs
@@ -27,7 +27,6 @@ import Annex.UUID
import Data.Time.Clock
import qualified Data.Map as M
-import qualified Data.Text as T
import Control.Concurrent
{- Syncs with remotes that may have been disconnected for a while.
@@ -176,12 +175,3 @@ syncNewRemote remote = do
thread <- asIO $ do
reconnectRemotes False [remote]
void $ liftIO $ forkIO $ thread
-
-{- Remotes using the XMPP transport have urls like xmpp::user@host -}
-isXMPPRemote :: Remote -> Bool
-isXMPPRemote remote = Git.repoIsUrl r && "xmpp::" `isPrefixOf` Git.repoLocation r
- where
- r = Remote.repo remote
-
-getXMPPClientID :: Remote -> ClientID
-getXMPPClientID r = T.pack $ drop (length "xmpp::") (Git.repoLocation (Remote.repo r))
diff --git a/Assistant/XMPP/Buddies.hs b/Assistant/XMPP/Buddies.hs
index fdc307972..7383c38d9 100644
--- a/Assistant/XMPP/Buddies.hs
+++ b/Assistant/XMPP/Buddies.hs
@@ -26,14 +26,15 @@ buddyName j = maybe (T.pack "") strNode (jidNode j)
{- Summary of info about a buddy.
-
- If the buddy has no clients at all anymore, returns Nothing. -}
-buddySummary :: Buddy -> Maybe (Text, Bool, Bool, BuddyKey)
-buddySummary b = case clients of
- ((Client j):_) -> Just (buddyName j, away, canpair, genBuddyKey j)
+buddySummary :: [JID] -> Buddy -> Maybe (Text, Bool, Bool, Bool, BuddyKey)
+buddySummary pairedwith b = case clients of
+ ((Client j):_) -> Just (buddyName j, away, canpair, alreadypaired j, genBuddyKey j)
[] -> Nothing
where
away = S.null (buddyPresent b) && S.null (buddyAssistants b)
canpair = not $ S.null (buddyAssistants b)
clients = S.toList $ buddyPresent b `S.union` buddyAway b `S.union` buddyAssistants b
+ alreadypaired j = baseJID j `elem` pairedwith
{- Updates the buddies with XMPP presence info. -}
updateBuddies :: Presence -> Buddies -> Buddies