gistfile1.hs

import System.IO
import System.Posix
import Network
import Network.Socket hiding (accept)
import Data.List
import Control.Monad
import Control.Concurrent
import Control.Concurrent.STM



main = withSocketsDo $ do
    installHandler sigPIPE Ignore Nothing
    sock <- listenOn (PortNumber 9902)
    setSocketOption sock ReuseAddr 1
    msgQueue <- newTChanIO
    handles <- newTVarIO []
    let state = (msgQueue, handles)
    forkIO $ forever broadcast state
    {- acceptConnections sock state -}

broadcast state@(msgQueue, handles) = do
    (msg, hs) <- atomically $ liftA2 (,) (readTChan msgQueue) (readTVar handles)
    forM_ hs $ \h -> do
        hPutStrLn h msg
        hFlush h