Browse Source

Modify `PresenceType'; update pickler; skip Maybe in `presenceType'

Fixes #15.
master
Jon Kristensen 13 years ago
parent
commit
fc2ececcf4
  1. 2
      source/Network/Xmpp/Marshal.hs
  2. 10
      source/Network/Xmpp/Stanza.hs
  3. 11
      source/Network/Xmpp/Types.hs

2
source/Network/Xmpp/Marshal.hs

@ -65,7 +65,7 @@ xpPresence = ("xpPresence" , "") <?+> xpWrap
(xpAttrImplied "from" xpPrim) (xpAttrImplied "from" xpPrim)
(xpAttrImplied "to" xpPrim) (xpAttrImplied "to" xpPrim)
xpLangTag xpLangTag
(xpAttrImplied "type" xpPrim) (xpAttr "type" $ xpWithDefault Available xpPrim)
) )
(xpAll xpElemVerbatim) (xpAll xpElemVerbatim)
) )

10
source/Network/Xmpp/Stanza.hs

@ -27,26 +27,26 @@ presence = Presence { presenceID = Nothing
, presenceFrom = Nothing , presenceFrom = Nothing
, presenceTo = Nothing , presenceTo = Nothing
, presenceLangTag = Nothing , presenceLangTag = Nothing
, presenceType = Nothing , presenceType = Available
, presencePayload = [] , presencePayload = []
} }
-- | Request subscription with an entity. -- | Request subscription with an entity.
presenceSubscribe :: Jid -> Presence presenceSubscribe :: Jid -> Presence
presenceSubscribe to = presence { presenceTo = Just to presenceSubscribe to = presence { presenceTo = Just to
, presenceType = Just Subscribe , presenceType = Subscribe
} }
-- | Approve a subscripton of an entity. -- | Approve a subscripton of an entity.
presenceSubscribed :: Jid -> Presence presenceSubscribed :: Jid -> Presence
presenceSubscribed to = presence { presenceTo = Just to presenceSubscribed to = presence { presenceTo = Just to
, presenceType = Just Subscribed , presenceType = Subscribed
} }
-- | End a subscription with an entity. -- | End a subscription with an entity.
presenceUnsubscribe :: Jid -> Presence presenceUnsubscribe :: Jid -> Presence
presenceUnsubscribe to = presence { presenceTo = Just to presenceUnsubscribe to = presence { presenceTo = Just to
, presenceType = Just Unsubscribed , presenceType = Unsubscribed
} }
-- | Signal to the server that the client is available for communication. -- | Signal to the server that the client is available for communication.
@ -56,7 +56,7 @@ presenceOnline = presence
-- | Signal to the server that the client is no longer available for -- | Signal to the server that the client is no longer available for
-- communication. -- communication.
presenceOffline :: Presence presenceOffline :: Presence
presenceOffline = presence {presenceType = Just Unavailable} presenceOffline = presence {presenceType = Unavailable}
-- | Produce an answer message with the given payload, setting "from" to the -- | Produce an answer message with the given payload, setting "from" to the
-- "to" attributes in the original message. Produces a 'Nothing' value of the -- "to" attributes in the original message. Produces a 'Nothing' value of the

11
source/Network/Xmpp/Types.hs

@ -220,7 +220,7 @@ data Presence = Presence { presenceID :: !(Maybe StanzaID)
, presenceFrom :: !(Maybe Jid) , presenceFrom :: !(Maybe Jid)
, presenceTo :: !(Maybe Jid) , presenceTo :: !(Maybe Jid)
, presenceLangTag :: !(Maybe LangTag) , presenceLangTag :: !(Maybe LangTag)
, presenceType :: !(Maybe PresenceType) , presenceType :: !PresenceType
, presencePayload :: ![Element] , presencePayload :: ![Element]
} deriving Show } deriving Show
@ -243,7 +243,8 @@ data PresenceType = Subscribe | -- ^ Sender wants to subscribe to presence
-- subscription -- subscription
Probe | -- ^ Sender requests current presence; Probe | -- ^ Sender requests current presence;
-- should only be used by servers -- should only be used by servers
Default | Available | -- ^ Sender wants to express availability
-- (no type attribute is defined)
Unavailable deriving (Eq) Unavailable deriving (Eq)
instance Show PresenceType where instance Show PresenceType where
@ -252,12 +253,12 @@ instance Show PresenceType where
show Unsubscribe = "unsubscribe" show Unsubscribe = "unsubscribe"
show Unsubscribed = "unsubscribed" show Unsubscribed = "unsubscribed"
show Probe = "probe" show Probe = "probe"
show Default = "" show Available = ""
show Unavailable = "unavailable" show Unavailable = "unavailable"
instance Read PresenceType where instance Read PresenceType where
readsPrec _ "" = [(Default, "")] readsPrec _ "" = [(Available, "")]
readsPrec _ "available" = [(Default, "")] readsPrec _ "available" = [(Available, "")]
readsPrec _ "unavailable" = [(Unavailable, "")] readsPrec _ "unavailable" = [(Unavailable, "")]
readsPrec _ "subscribe" = [(Subscribe, "")] readsPrec _ "subscribe" = [(Subscribe, "")]
readsPrec _ "subscribed" = [(Subscribed, "")] readsPrec _ "subscribed" = [(Subscribed, "")]

Loading…
Cancel
Save