Permalink
Browse files

add simpleIM

add answerIM
  • Loading branch information...
Philonous committed May 9, 2012
1 parent 3a2a1ac commit fdac2544006a5c27a10f90041b4ba429ed0a51c1
Showing with 38 additions and 7 deletions.
  1. +38 −7 src/Network/XMPP/IM/Message.hs
@@ -2,6 +2,9 @@
module Network.XMPP.IM.Message
where
+import Control.Applicative ((<$>))
+
+import Data.Maybe (maybeToList)
import Data.Text (Text)
import Data.XML.Pickle
import Data.XML.Types
@@ -64,18 +67,46 @@ newIM
-> Maybe StanzaId
-> Maybe LangTag
-> MessageType
- -> MessageSubject
- -> MessageThread
- -> MessageBody
+ -> Maybe MessageSubject
+ -> Maybe MessageThread
+ -> Maybe MessageBody
+ -> [Element]
-> Message
-newIM t i lang tp sbj thrd bdy = Message
+newIM t i lang tp sbj thrd bdy payload = Message
{ messageID = i
, messageFrom = Nothing
, messageTo = Just t
, messageLangTag = lang
, messageType = tp
- , messagePayload = pickle xpMessageSubject sbj
- ++ pickle xpMessageThread thrd
- ++ pickle xpMessageBody bdy
+ , messagePayload = concat $
+ maybeToList (pickle xpMessageSubject <$> sbj)
+ ++ maybeToList (pickle xpMessageThread <$> thrd)
+ ++ maybeToList (pickle xpMessageBody <$> bdy)
+ ++ [payload]
}
+
+simpleIM :: JID -> Text -> Message
+simpleIM t bd = newIM
+ t
+ Nothing
+ Nothing
+ Normal
+ Nothing
+ Nothing
+ (Just $ MessageBody Nothing bd)
+ []
+
+answerIM :: Maybe MessageBody -> [Element] -> Message -> Message
+answerIM bd payload msg = Message
+ { messageID = messageID msg
+ , messageFrom = Nothing
+ , messageTo = messageFrom msg
+ , messageLangTag = messageLangTag msg
+ , messageType = messageType msg
+ , messagePayload = concat $
+ (pickle xpMessageSubject <$> subject msg)
+ ++ maybeToList (pickle xpMessageThread <$> thread msg)
+ ++ maybeToList (pickle xpMessageBody <$> bd)
+ ++ [payload]
+ }

0 comments on commit fdac254

Please sign in to comment.