Immortal chans

Chans.hs

#!/usr/bin/env stack
-- stack --resolver lts-9.8 script
module Main where

import Data.Functor (void)
import Data.Foldable (traverse_, for_)
import Data.Traversable (for)
import Control.Concurrent (forkIO, readChan, writeChan, newChan, getNumCapabilities)
import Control.Immortal (create, wait, Thread)

main :: IO ()
main = do
  numThreads <- getNumCapabilities
  chan <- newChan
  void . forkIO . for_ [1..120000 :: Int] $ writeChan chan . show
  waitImmortalFor_ ['a'..toEnum $ 96 + numThreads] $ \tid _ -> do
    val <- readChan chan
    putStrLn $ tid:val

waitImmortalFor_ :: Traversable t => t a -> (a -> Thread -> IO ()) -> IO ()
waitImmortalFor_ xs action = do
  threads <- for xs $ \x -> create $ action x
  traverse_ wait threads