module Control.Concurrent.ResourceTable
where
import Control.Concurrent.MVar
import qualified Data.Map as M
import Data.Maybe
type ResourceTable a = MVar (M.Map a ResourceLock)
type ResourceLock = (MVar (), Int)
requestResource :: (Ord a) => ResourceTable a -> a -> IO ()
requestResource theLocks r
= do
rt <- takeMVar theLocks
(lk, cnt) <- case M.lookup r rt of
Nothing -> do
lk' <- newMVar ()
return (lk', 0)
Just l -> return l
putMVar theLocks $ M.insert r (lk, cnt + 1) rt
takeMVar lk
releaseResource :: (Ord a) => ResourceTable a -> a -> IO ()
releaseResource theLocks r
= do
rt <- takeMVar theLocks
let (lk, cnt) = fromJust . M.lookup r $ rt
putMVar theLocks $ if cnt == 1
then M.delete r rt
else M.insert r (lk, cnt 1) rt
putMVar lk ()
newResourceTable :: IO (ResourceTable a)
newResourceTable = newMVar M.empty