From 6c50dfb3b739954d39db14e308c721b64344ec9b Mon Sep 17 00:00:00 2001
From: Philipp Balzarek <p.balzarek@googlemail.com>
Date: Wed, 25 Apr 2012 11:49:47 +0200
Subject: [PATCH] added forkSession renamed forkXMPP to fork

---
 src/Network/XMPP.hs                  |  3 ++-
 src/Network/XMPP/Concurrent/Monad.hs | 20 ++++++++++++--------
 2 files changed, 14 insertions(+), 9 deletions(-)

diff --git a/src/Network/XMPP.hs b/src/Network/XMPP.hs
index b2a1e54..af4ed0a 100644
--- a/src/Network/XMPP.hs
+++ b/src/Network/XMPP.hs
@@ -133,7 +133,8 @@ module Network.XMPP
   , iqResultPayload
   -- * Threads
   , XMPP
-  , forkXMPP
+  , fork
+  , forkSession
   -- * Misc
   , exampleParams
   ) where
diff --git a/src/Network/XMPP/Concurrent/Monad.hs b/src/Network/XMPP/Concurrent/Monad.hs
index 2d97372..84cb77e 100644
--- a/src/Network/XMPP/Concurrent/Monad.hs
+++ b/src/Network/XMPP/Concurrent/Monad.hs
@@ -98,15 +98,19 @@ sendS a = do
   liftIO . atomically $ writeTChan out a
   return ()
 
+-- | Create a forked session object without forking a thread
+forkSession :: Session -> IO Session
+forkSession sess = do
+    mCH' <- newIORef Nothing
+    pCH' <- newIORef Nothing
+    return $ sess {messagesRef = mCH' ,presenceRef = pCH'}
+
 -- | Fork a new thread
-forkXMPP :: XMPP () -> XMPP ThreadId
-forkXMPP a = do
-  thread <- ask
-  mCH' <- liftIO $ newIORef Nothing
-  pCH' <- liftIO $ newIORef Nothing
-  liftIO $ forkIO $ runReaderT a (thread {messagesRef = mCH'
-                                         ,presenceRef = pCH'
-                                         })
+fork :: XMPP () -> XMPP ThreadId
+fork a = do
+  sess <- ask
+  sess' <- liftIO $ forkSession sess
+  liftIO $ forkIO $ runReaderT a sess'
 
 filterMessages :: (MessageError -> Bool)
                -> (Message -> Bool)