chan.hs

import Control.Concurrent.Chan (Chan, newChan)
import qualified Data.Map as M
import Control.Concurrent.STM (TVar, readTVar, writeTVar)

type Id = Integer

getOrCreateChannel :: (MonadIO m) => Id -> TVar (M.Map Id (Chan a))  -> m (Chan a)
getOrCreateChannel cid t = liftIO $ do
    nchan <- newChan
    atomically $ do
        chans <- readTVar t
        case M.lookup cid chans of
            (Just c) -> return c
            Nothing -> do
                writeTVar t $ M.insert cid nchan chans
                return nchan