module Network.Hermes.MChan(
MChan ,newMChan, newMChanIO, readMChan, writeMChan, writeMChan'
,existsMChan, ensureMChan, deleteMChan
) where
import Prelude hiding(lookup)
import Control.Concurrent.STM
import Control.Applicative((<$>))
import Data.Typeable
import Data.Map
import Network.Hermes.Misc(modifyTVar)
newtype MChan k v = MChan (TVar (Map k (TChan v)))
deriving(Typeable)
newMChan :: Ord k => STM (MChan k v)
newMChan = MChan <$> newTVar empty
newMChanIO :: Ord k => IO (MChan k v)
newMChanIO = MChan <$> newTVarIO empty
readMChan :: Ord k => MChan k v -> k -> STM (Maybe v)
readMChan (MChan var) k = do
chan <- lookup k <$> readTVar var
case chan of
Nothing -> return Nothing
Just chan' -> Just <$> readTChan chan'
writeMChan :: Ord k => MChan k v -> k -> v -> STM Bool
writeMChan (MChan var) k v = do
chan <- lookup k <$> readTVar var
case chan of
Nothing -> return False
Just chan' -> writeTChan chan' v >> return True
writeMChan' :: Ord k => MChan k v -> k -> v -> STM ()
writeMChan' mchan@(MChan var) k v = do
chan <- lookup k <$> readTVar var
case chan of
Nothing -> ensureMChan mchan k >> writeMChan' mchan k v
Just chan' -> writeTChan chan' v
existsMChan :: Ord k => MChan k v -> k -> STM Bool
existsMChan (MChan var) k = member k <$> readTVar var
ensureMChan :: Ord k => MChan k v -> k -> STM ()
ensureMChan (MChan var) k = do
chan <- newTChan
modifyTVar var (insertWith (const id) k chan)
deleteMChan :: Ord k => MChan k v -> k -> STM ()
deleteMChan (MChan var) k = modifyTVar var (delete k)