diff options
author | Joey Hess <joey@kitenet.net> | 2012-11-02 21:13:06 -0400 |
---|---|---|
committer | Joey Hess <joey@kitenet.net> | 2012-11-02 21:13:06 -0400 |
commit | df24b5661e7728a1ca37ec8e7001ca50b300725e (patch) | |
tree | 87d044aade7598abe74e454f04d3c2708ca8ebd4 /Assistant/XMPP/Buddies.hs | |
parent | c3bd80207051ca96d9d172e29ba600dec25df113 (diff) |
add buddy list to pairing UI
Diffstat (limited to 'Assistant/XMPP/Buddies.hs')
-rw-r--r-- | Assistant/XMPP/Buddies.hs | 38 |
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 |