content: -----------------------------------------------------------------------------
  
  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
  
  {-# NOINLINE newResourceTable #-}
  
  -----------------------------------------------------------------------------
  