Label the internal thread spawned in linkOnly

Author: jasagredo

Control/Concurrent/Async/Internal.hs

@@ -55,7 +55,7 @@ import Data.IORef
 
 import GHC.Exts
 import GHC.IO hiding (finally, onException)
-import GHC.Conc (ThreadId(..))
+import GHC.Conc (ThreadId(..), labelThread)
 
 -- -----------------------------------------------------------------------------
 -- STM Async API
@@ -504,6 +504,7 @@ linkOnly
 linkOnly shouldThrow a = do
   me <- myThreadId
   void $ forkRepeat $ do
+    myThreadId >>= flip labelThread ("linkOnly " ++ show (asyncThreadId a) ++ " -> " ++ show me)
     r <- waitCatch a
     case r of
       Left e | shouldThrow e -> throwTo me (ExceptionInLinkedThread a e)