Are TChan writes integrated into Haskell STM?

Question

If an STM transaction fails and retries, does the call to writeTChan get re-executed so that you end up with two writes, or does the STM only actually perform the write if the transaction commits? i.e., is this solution to the sleeping barber problem valid, or might a customer get two haircuts if the transaction in enterShop fails the first time?

import Control.Monad
import Control.Concurrent
import Control.Concurrent.STM
import System.Random
import Text.Printf

runBarber :: TChan Int -> TVar Int -> IO ()
runBarber haircutRequestChan seatsLeftVar = forever $ do
  customerId <- atomically $ readTChan haircutRequestChan
  atomically $ do
    seatsLeft <- readTVar seatsLeftVar
    writeTVar seatsLeftVar $ seatsLeft + 1
  putStrLn $ printf "%d started cutting" customerId
  delay <- randomRIO (1,700)
  threadDelay delay
  putStrLn $ printf "%d finished cutting" customerId

enterShop :: TChan Int -> TVar Int -> Int -> IO ()
enterShop haircutRequestChan seatsLeftVar customerId = do
  putStrLn $ printf "%d entering shop" customerId
  hasEmptySeat <- atomically $ do
    seatsLeft <- readTVar seatsLeftVar
    let hasEmptySeat = seatsLeft > 0
    when hasEmptySeat $ do
      writeTVar seatsLeftVar $ seatsLeft - 1
      writeTChan haircutRequestChan customerId
    return hasEmptySeat
  when (not hasEmptySeat) $ do
    putStrLn $ printf "%d turned away" customerId    

main = do
  seatsLeftVar <- newTVarIO 3
  haircutRequestChan <- newTChanIO
  forkIO $ runBarber haircutRequestChan seatsLeftVar

  forM_ [1..20] $ \customerId -> do
    delay <- randomRIO (1,3)
    threadDelay delay
    forkIO $ enterShop haircutRequestChan seatsLeftVar customerId 

UPDATE I didn't notice until after the fact that the above hairRequestChan doesn't have to be part of the transaction anyway. I can use a regular Chan and do the writeChan in an if statement after the atomically block in enterShop. But making that improvement destroys the whole reason for asking the question, so I'll leave it as-is here.

Gutbucket

Answer 1

TChan operations are performed when a transaction is committed, just like other STM operations, so you'll always end up with a single write, no matter how many times your transaction is retried. They'd be kind of useless otherwise.

To convince yourself, try this example:

import Control.Concurrent
import Control.Concurrent.STM
import Control.Concurrent.STM.TChan

main = do
  ch <- atomically newTChan
  forkIO $ reader ch >>= putStrLn
  writer ch

reader = atomically . readTChan
writer ch = atomically $ writeTChan ch "hi!" >> retry

This will throw a exception complaining that the transaction is blocked indefinitely. If writeTChan caused a write to happen before the transaction was committed, the program would print "hi!" before throwing that exception.

Sasnett

Indeed, TChans are implemented in pure Haskell using TVars (here is the source for the TChan module), so they receive the same amount of isolation as that afforded to TVars. – Solfeggio