chan.hs

import Control.Concurrent.Chan (Chan, newChan)
import qualified Data.Map as M
import Control.Concurrent.STM
import Control.Monad.Trans (MonadIO, liftIO)
import GHC.Conc (unsafeIOToSTM)

type Id = Integer

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