convert forkIO to forkLabeled (wip)

1 files changed, 8 insertions, 10 deletions

diff --git a/dht/Presence/XMPPServer.hs b/dht/Presence/XMPPServer.hs
index de2dd5d3..272f6efe 100644
--- a/dht/Presence/XMPPServer.hs
+++ b/dht/Presence/XMPPServer.hs
@@ -954,7 +954,7 @@ forkConnection sv xmpp saddr cdta pingflag src snk stanzas pp_mvar = do
                             "."                        -> show saddr
                             mytoxname                  -> show saddr {- TODO: remote tox peer name? -} ]
 
-    forkIO $ do myThreadId >>= flip labelThread (lbl "xmpp-post.")
+    forkLabeled (lbl "xmpp-post.") $ do
                 -- This thread handles messages after they are pulled out of
                 -- the slots-queue.  Hence, xmpp-post, for post- slots-queue.
 
@@ -991,12 +991,11 @@ forkConnection sv xmpp saddr cdta pingflag src snk stanzas pp_mvar = do
     output <- atomically newTChan
     hacks <- atomically $ newTVar Map.empty
     msgids <- atomically $ newTVar []
-    forkIO $ do
+    forkLabeled (lbl "xmpp-pre.") $ do
         -- Here is the pre- slots-queue thread which handles messages as they
         -- arrive and assigns slots to them if that is appropriate.
 
         -- mapM_ (atomically . Slotted.push slots Nothing) greetPeer
-        myThreadId >>= flip labelThread (lbl "xmpp-pre.")
 
         verbosity <- xmppVerbosity xmpp
         fix $ \loop -> do
@@ -1073,8 +1072,7 @@ forkConnection sv xmpp saddr cdta pingflag src snk stanzas pp_mvar = do
                 ]
             what
         wlog $ "end xmpp-pre fork: " ++ show (lbl "")
-    forkIO $ do
-        myThreadId >>= flip labelThread (lbl "xmpp-reader.")
+    forkLabeled (lbl "xmpp-reader.") $ do
         -- src $$ awaitForever (lift . putStrLn . takeWhile (/=' ') . show)
         runConduit $ src .| xmppInbound cdta clientOrServer pingflag stanzas output rdone
         atomically $ putTMVar rdone ()
@@ -1319,9 +1317,9 @@ monitor sv params xmpp = do
         -}
         dup <- cloneStanza stanza
 
-        t <- forkIO $ do applyStanza sv joined_rooms quitVar xmpp stanza
-                         forwardStanza quitVar xmpp stanza
-        labelThread t $ "process." ++ stanzaTypeString stanza
+        forkLabeled ("process." ++ stanzaTypeString stanza) $ do
+            applyStanza sv joined_rooms quitVar xmpp stanza
+            forwardStanza quitVar xmpp stanza
 
         -- We need to clone in the case the stanza is passed on as for Message.
         wantStanzas <- getVerbose XJabber
@@ -1795,8 +1793,8 @@ forkXmpp XMPPServer { _xmpp_sv          = sv
                               { pingInterval = 0
                               , timeout      = 0
                               }
-    mt <- forkIO $ do myThreadId >>= flip labelThread ("XMPP.monitor")
-                      monitor sv peer_params xmpp
+    mt <- forkLabeled "XMPP.monitor" $ do
+        monitor sv peer_params xmpp
     dput XMisc $ "Starting peer listen"
     control sv (Listen peer_bind peer_params)
     dput XMisc $ "Starting client listen"