Using Haskell STM to pick items from multiple sources with bias / priority

prio.hs

import Control.Monad (forever, forM_)
import Control.Concurrent
import Control.Concurrent.STM

data Event = Timeout
           | Message Int
  deriving (Show)

pusher :: TChan Event -> IO ()
pusher c = forM_ [0 ..] $ \i -> do
    atomically $ writeTChan c (Message i)
    threadDelay $ 600 * 1000

timeouter :: TMVar Event -> IO ()
timeouter t = forever $ do
    -- Use tryPutTMVar, since when the previous timeout hasn't been handled
    -- yet, we don't really care about setting a new one
    atomically $ tryPutTMVar t Timeout
    threadDelay $ 1000 * 1000

reader :: TMVar Event -> TChan Event -> IO ()
reader t q = forever $ do
    -- Switching sides of orElse would change priority
    e <- atomically $ takeTMVar t `orElse` readTChan q
    print e

main :: IO ()
main = do
    t <- newEmptyTMVarIO
    q <- newTChanIO

    forkIO $ timeouter t
    forkIO $ pusher q
    forkIO $ reader t q

    forever $ threadDelay $ 1000 * 1000

$ ghc --make -threaded -rtsopts -O2 prio.hs
[1 of 1] Compiling Main             ( prio.hs, prio.o )
Linking prio ...
$ ./prio +RTS -N
Timeout
Message 0
Message 1
Timeout
Message 2
Message 3
Timeout
Message 4
Timeout
Message 5
Message 6
Timeout
Message 7
Message 8
Timeout
^C