Example of bad TChan usage

TChan.hs

-- See http://stackoverflow.com/questions/6439925/poor-performance-lockup-with-stm

{-# LANGUAGE BangPatterns #-}

module Main where

import Control.Concurrent.STM
import Control.Concurrent
import System.Random(randomRIO)
import Control.Monad(forever, when)

maxN :: Int
maxN = 20

data Tuple = T {-# UNPACK #-} !Int {-# UNPACK #-} !Int
             deriving (Eq, Show)

data Record = R {-# UNPACK #-} !Tuple {-# UNPACK #-} !Int
             deriving (Eq, Show)

allCoords :: [Tuple]
allCoords = [ T x y | x <- [0..maxN], y <- [0..maxN]]

randomCoords :: IO Tuple
randomCoords = do
  x <- randomRIO (0,maxN)
  y <- randomRIO (0,maxN)
  return $ T x y

doWork :: TChan Record -> IO ()
doWork chan = do mapM_ startWatcher allCoords
                 go 1 >> return ()
    where
      go !cnt = do xy <- randomCoords
                   atomically $ writeTChan chan (R xy cnt)
                   go cnt

      startWatcher p = do
        chan' <- atomically $ dupTChan chan
        _ <- ($) forkIO $ watcher chan'
        return ()
        where
          watcher chan' = forever $ do
            r@(R p' _) <- atomically $ readTChan chan'
            when (p == p') (print r)


main :: IO ()
main = do
  chan <- newTChanIO :: IO (TChan Record)
  doWork chan
  return ()