Traversals where each thread is sequentially labeled

[Icelandjack]

Here are some ideas for labeled traversals that I am using to track down a concurrency bug. Let me know if it's useful.

This is a drop-in replacement for the (for,map)Concurrently.. traversals. The only difference is that each thread that is forked is given a sequential label.

-forConcurrently                     [1..5] print
+forConcurrentlyWithLabel "display"  [1..5] print

The new version labels its threads sequentually: "display1", "display2", ..

mapConcurrentlyWithLabel :: forall t a b. Traversable t => String -> (a -> IO b) -> (t a -> IO (t b))
mapConcurrentlyWithLabel label f = itrav \n a -> do
  threadId <- myThreadId
  labelThread threadId (label ++ show n)
  f a where
  itrav :: (Int -> a -> IO b) -> (t a -> IO (t b))
  itrav = coerce do
    itraverse @t @Concurrently @a @b

mapConcurrentlyWithLabel_ :: forall t a b. Foldable t => String -> (a -> IO b) -> (t a -> IO ())
mapConcurrentlyWithLabel_ label f = itrav_ \n a -> do
  threadId <- myThreadId
  labelThread threadId ("label" ++ show n)
  f a where
  itrav_ :: (Int -> a -> IO b) -> (t a -> IO ())
  itrav_ = coerce do
    itraverse_ @t @Concurrently @a @b

forConcurrentlyWithLabel :: Traversable t => String -> t a -> (a -> IO b) -> IO (t b)
forConcurrentlyWithLabel = flip .  mapConcurrentlyWithLabel

forConcurrentlyWithLabel_ :: Foldable t => String -> t a -> (a -> IO b) -> IO ()
forConcurrentlyWithLabel_ = flip .  mapConcurrentlyWithLabel_

It uses these definitions

itraverse :: forall t f a b. Traversable t => Applicative f => (Int -> a -> f b) -> (t a -> f (t b))
itraverse f = sequenceA . snd . mapAccumL f' 0 where
  f' :: Int -> a -> (Int, f b)
  f' n a = (1 + n, f n a)

itraverse_ :: forall t f a b. Foldable t => Applicative f => (Int -> a -> f b) -> (t a -> f ())
itraverse_ f = ..

Another possibility is to return the ThreadIds.

itraverseThreadIds :: Traversable t => (a -> IO b) -> t a -> IO (t (ThreadId, b))
itraverseThreadIds f = traverse (liftA2 (,) myThreadId . f)

itraverseThreadIds_ :: Traversable t => (a -> IO b) -> t a -> IO (t ThreadId)
itraverseThreadIds_ f = traverse \a -> do
  _ <- f a
  myThreadId