From fdac2544006a5c27a10f90041b4ba429ed0a51c1 Mon Sep 17 00:00:00 2001
From: Philipp Balzarek <p.balzarek@googlemail.com>
Date: Wed, 9 May 2012 17:12:28 +0200
Subject: [PATCH] add simpleIM add answerIM

---
 src/Network/XMPP/IM/Message.hs | 45 ++++++++++++++++++++++++++++------
 1 file changed, 38 insertions(+), 7 deletions(-)

diff --git a/src/Network/XMPP/IM/Message.hs b/src/Network/XMPP/IM/Message.hs
index 08810d4..fbf3819 100644
--- a/src/Network/XMPP/IM/Message.hs
+++ b/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]
+    }