From b92159385785e531985f5c4b7ba5bea44926bd0b Mon Sep 17 00:00:00 2001
From: Philipp Balzarek <p.balzarek@googlemail.com>
Date: Wed, 13 Nov 2013 13:23:17 +0100
Subject: [PATCH] change handling returned annotations: Annotations are
 appended to the list

---
 source/Network/Xmpp/Concurrent.hs       | 6 +++---
 source/Network/Xmpp/Concurrent/Types.hs | 5 +++--
 source/Network/Xmpp/IM/Roster.hs        | 6 +++---
 3 files changed, 9 insertions(+), 8 deletions(-)

diff --git a/source/Network/Xmpp/Concurrent.hs b/source/Network/Xmpp/Concurrent.hs
index 5ecf681..4970eaf 100644
--- a/source/Network/Xmpp/Concurrent.hs
+++ b/source/Network/Xmpp/Concurrent.hs
@@ -58,12 +58,12 @@ runHandlers hs sta = go hs sta []
   where go []        _  _   = return ()
         go (h:hands) sta' as = do
             res <- h sta' as
-            forM_ res $ uncurry (go hands)
+            forM_ res $ \(sta, as') -> go hands sta (as ++ as')
 
 toChan :: TChan (Annotated Stanza) -> StanzaHandler
 toChan stanzaC _ sta as = do
     atomically $ writeTChan stanzaC (sta, as)
-    return [(sta, as)]
+    return [(sta, [])]
 
 handleIQ :: TVar IQHandlers
          -> StanzaHandler
@@ -72,7 +72,7 @@ handleIQ iqHands out sta as = do
             IQRequestS     i -> handleIQRequest iqHands i >> return []
             IQResultS      i -> handleIQResponse iqHands (Right i) >> return []
             IQErrorS       i -> handleIQResponse iqHands (Left i)  >> return []
-            _                -> return [(sta, as)]
+            _                -> return [(sta, [])]
   where
     -- If the IQ request has a namespace, send it through the appropriate channel.
     handleIQRequest :: TVar IQHandlers -> IQRequest -> IO ()
diff --git a/source/Network/Xmpp/Concurrent/Types.hs b/source/Network/Xmpp/Concurrent/Types.hs
index 3dde2a9..a0f237d 100644
--- a/source/Network/Xmpp/Concurrent/Types.hs
+++ b/source/Network/Xmpp/Concurrent/Types.hs
@@ -22,8 +22,9 @@ import           Network.Xmpp.Types
 
 type StanzaHandler =  (Stanza -> IO Bool) -- ^ outgoing stanza
                    -> Stanza       -- ^ stanza to handle
-                   -> [Annotation]
-                   -> IO [(Stanza, [Annotation])]  -- ^ modified stanzas (if any)
+                   -> [Annotation] -- ^ annotations added by previous handlers
+                   -> IO [(Stanza, [Annotation])]  -- ^ modified stanzas and
+                                                   -- /additional/ annotations
 
 data Annotation = forall f. (Typeable f, Show f) => Annotation f
 
diff --git a/source/Network/Xmpp/IM/Roster.hs b/source/Network/Xmpp/IM/Roster.hs
index 03b76b0..a3c09a1 100644
--- a/source/Network/Xmpp/IM/Roster.hs
+++ b/source/Network/Xmpp/IM/Roster.hs
@@ -86,12 +86,12 @@ initRoster session = do
         Just roster -> atomically $ writeTVar (rosterRef session) roster
 
 handleRoster :: TVar Roster -> StanzaHandler
-handleRoster ref out sta as = case sta of
+handleRoster ref out sta _ = case sta of
     IQRequestS (iqr@IQRequest{iqRequestPayload =
                                    iqb@Element{elementName = en}})
         | nameNamespace en == Just "jabber:iq:roster" -> do
             case iqRequestFrom iqr of
-                Just _from -> return [(sta, as)] -- Don't handle roster pushes
+                Just _from -> return [(sta, [])] -- Don't handle roster pushes
                                                  -- from unauthorized sources
                 Nothing -> case unpickleElem xpQuery iqb of
                     Right Query{ queryVer = v
@@ -104,7 +104,7 @@ handleRoster ref out sta as = case sta of
                         errorM "Pontarius.Xmpp" "Invalid roster query"
                         _ <- out $ badRequest iqr
                         return []
-    _ -> return [(sta, as)]
+    _ -> return [(sta, [])]
   where
     handleUpdate v' update = atomically $ modifyTVar ref $ \(Roster v is) ->
         Roster (v' `mplus` v) $ case qiSubscription update of