From d077ee56347d5370684768ed537b8bc6c0062f58 Mon Sep 17 00:00:00 2001
From: Philipp Balzarek <p.balzarek@googlemail.com>
Date: Sat, 8 Dec 2012 20:16:07 +0100
Subject: [PATCH] improve IM/Message

---
 .../Xmpp/Concurrent/Channels/Message.hs       |  4 +++
 source/Network/Xmpp/IM.hs                     |  3 +-
 source/Network/Xmpp/IM/Message.hs             | 34 +++++++++++++------
 3 files changed, 29 insertions(+), 12 deletions(-)

diff --git a/source/Network/Xmpp/Concurrent/Channels/Message.hs b/source/Network/Xmpp/Concurrent/Channels/Message.hs
index 20d50b9..aaf71a9 100644
--- a/source/Network/Xmpp/Concurrent/Channels/Message.hs
+++ b/source/Network/Xmpp/Concurrent/Channels/Message.hs
@@ -33,6 +33,10 @@ pullMessage session = do
     c <- getMessageChan session
     atomically $ readTChan c
 
+-- | Get the next received message
+getMessage :: Context -> IO Message
+getMessage = waitForMessage (const True)
+
 -- | Pulls a (non-error) message and returns it if the given predicate returns
 -- @True@.
 waitForMessage :: (Message -> Bool) -> Context -> IO Message
diff --git a/source/Network/Xmpp/IM.hs b/source/Network/Xmpp/IM.hs
index 1f2a61f..35b2c9c 100644
--- a/source/Network/Xmpp/IM.hs
+++ b/source/Network/Xmpp/IM.hs
@@ -3,6 +3,7 @@ module Network.Xmpp.IM
     subject
   , thread
   , body
+  , bodies
   , newIM
   , simpleIM
   , answerIM
@@ -11,4 +12,4 @@ module Network.Xmpp.IM
   ) where
 
 import Network.Xmpp.IM.Message
-import Network.Xmpp.IM.Presence
\ No newline at end of file
+import Network.Xmpp.IM.Presence
diff --git a/source/Network/Xmpp/IM/Message.hs b/source/Network/Xmpp/IM/Message.hs
index 2a76a3e..fe43744 100644
--- a/source/Network/Xmpp/IM/Message.hs
+++ b/source/Network/Xmpp/IM/Message.hs
@@ -6,7 +6,7 @@ module Network.Xmpp.IM.Message
 
 import Control.Applicative ((<$>))
 
-import Data.Maybe (maybeToList)
+import Data.Maybe (maybeToList, listToMaybe)
 import Data.Text (Text)
 import Data.XML.Pickle
 import Data.XML.Types
@@ -14,11 +14,17 @@ import Data.XML.Types
 import Network.Xmpp.Types
 import Network.Xmpp.Pickle
 
-data MessageBody = MessageBody (Maybe LangTag) Text
-data MessageThread = MessageThread
-                        Text          -- Thread ID
-                        (Maybe Text)  -- Parent Thread
-data MessageSubject = MessageSubject (Maybe LangTag) Text
+data MessageBody = MessageBody { bodyLang :: (Maybe LangTag)
+                               , bodyContent :: Text
+                               }
+
+data MessageThread = MessageThread { theadID :: Text
+                                   , threadParent :: (Maybe Text)
+                                   }
+
+data MessageSubject = MessageSubject { subjectLang :: (Maybe LangTag)
+                                     , subjectContent :: Text
+                                     }
 
 xpMessageSubject :: PU [Element] MessageSubject
 xpMessageSubject = xpUnliftElems .
@@ -61,12 +67,16 @@ thread m = ms
 
 -- | Get the body elements of a message (if any). Messages may contain
 -- multiple bodies if each of them has a distinct xml:lang attribute
-body :: Message -> [MessageBody]
-body m = ms
+bodies :: Message -> [MessageBody]
+bodies m = ms
   where
     -- xpFindMatches will _always_ return Right
     Right ms = unpickle (xpFindMatches xpMessageBody) $ messagePayload m
 
+-- | Return the first body element, regardless of it's language.
+body :: Message -> Maybe Text
+body m = bodyContent <$> listToMaybe (bodies m)
+
 -- | Generate a new instant message
 newIM
   :: Jid
@@ -109,8 +119,10 @@ simpleIM t bd = newIM
 -- taken from the original sender, the sender is set to Nothing,
 -- message ID, language tag, message type as well as subject and
 -- thread are inherited, the remaining payload is replaced by the
--- given one
-answerIM :: Maybe MessageBody -> [Element] -> Message -> Message
+-- given one.
+--
+-- If multiple message bodies are given they must have different language tags
+answerIM :: [MessageBody] -> [Element] -> Message -> Message
 answerIM bd payload msg = Message
     { messageID      = messageID msg
     , messageFrom    = Nothing
@@ -120,6 +132,6 @@ answerIM bd payload msg = Message
     , messagePayload =  concat $
                         (pickle xpMessageSubject <$> subject msg)
                         ++ maybeToList (pickle xpMessageThread <$> thread msg)
-                        ++ maybeToList (pickle xpMessageBody <$> bd)
+                        ++ (pickle xpMessageBody <$> bd)
                         ++ [payload]
     }