From d55ec6c25e8843910930a8e760db9793aad637ec Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Sat, 10 Nov 2012 16:35:09 -0400
Subject: show when a buddy is already paired

---
 Assistant/NetMessager.hs  | 12 ++++++++++++
 Assistant/Sync.hs         | 10 ----------
 Assistant/XMPP/Buddies.hs |  7 ++++---
 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
-- 
cgit v1.2.3