summaryrefslogtreecommitdiff
path: root/Assistant/XMPP/Buddies.hs
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2012-11-02 21:13:06 -0400
committerGravatar Joey Hess <joey@kitenet.net>2012-11-02 21:13:06 -0400
commitdf24b5661e7728a1ca37ec8e7001ca50b300725e (patch)
tree87d044aade7598abe74e454f04d3c2708ca8ebd4 /Assistant/XMPP/Buddies.hs
parentc3bd80207051ca96d9d172e29ba600dec25df113 (diff)
add buddy list to pairing UI
Diffstat (limited to 'Assistant/XMPP/Buddies.hs')
-rw-r--r--Assistant/XMPP/Buddies.hs38
1 files changed, 19 insertions, 19 deletions
diff --git a/Assistant/XMPP/Buddies.hs b/Assistant/XMPP/Buddies.hs
index de2b570c6..db56235c7 100644
--- a/Assistant/XMPP/Buddies.hs
+++ b/Assistant/XMPP/Buddies.hs
@@ -9,32 +9,32 @@ module Assistant.XMPP.Buddies where
import Assistant.XMPP
import Common.Annex
+import Assistant.Types.Buddies
import Network.Protocol.XMPP
import qualified Data.Map as M
import qualified Data.Set as S
-import Data.Ord
+import Data.Text (Text)
+import qualified Data.Text as T
-newtype Client = Client JID
- deriving (Eq, Show)
+genBuddyID :: JID -> BuddyID
+genBuddyID j = BuddyID $ formatJID j
-instance Ord Client where
- compare = comparing show
+genKey :: JID -> BuddyKey
+genKey j = BuddyKey $ formatJID $ JID (jidNode j) (jidDomain j) Nothing
-data Buddy = Buddy
- { buddyPresent :: S.Set Client
- , buddyAway :: S.Set Client
- , buddyAssistants :: S.Set Client
- }
- deriving (Eq, Show)
-
-{- Note that the buddy map includes one buddy for the user's own JID,
- - so that we can track other git-annex assistant's sharing the same
- - account. -}
-type Buddies = M.Map String Buddy
-
-genKey :: JID -> String
-genKey j = show $ JID (jidNode j) (jidDomain j) Nothing
+{- Summary of info about a buddy.
+ -
+ - If the buddy has no clients at all anymore, returns Nothing. -}
+buddySummary :: Buddy -> Maybe (Text, Bool, Bool, BuddyID)
+buddySummary b = case clients of
+ ((Client j):_) -> Just (buddyname j, away, canpair, genBuddyID j)
+ [] -> Nothing
+ where
+ buddyname j = maybe (T.pack "") strNode (jidNode j)
+ 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
{- Updates the buddies with XMPP presence info. -}
updateBuddies :: Presence -> Buddies -> Buddies