module Control.Concurrent.ReadWriteLock
    ( newReadWriteLock
    , readLock
    , readUnlock
    , ReadWriteLock
    , withReadLock
    , withWriteLock
    , writeLock
    , writeUnlock
    ) where

import Control.Concurrent.LightSwitch (LightSwitch, lockLightSwitch, newLightSwitch, unlockLightSwitch)
import Control.Concurrent.Util (withQSem)

import Control.Applicative ((<$>), (<*>))
import Control.Concurrent.QSem (newQSem, QSem, signalQSem, waitQSem)
import Control.Exception (bracket_)

data ReadWriteLock = ReadWriteLock
                   { readSwitch :: LightSwitch
                   , roomEmpty :: QSem
                   , turnstile :: QSem
                   }

newReadWriteLock :: IO ReadWriteLock
newReadWriteLock = do
  re <- newQSem 1
  ReadWriteLock <$> newLightSwitch re <*> return re <*> newQSem 1

readLock :: ReadWriteLock -> IO ()
readLock rw = do
  withQSem (turnstile rw) $ return ()
  lockLightSwitch $ readSwitch rw

readUnlock :: ReadWriteLock -> IO ()
readUnlock = unlockLightSwitch . readSwitch

withReadLock :: ReadWriteLock -> IO () -> IO ()
withReadLock = bracket_ . readLock <*> readUnlock

writeLock :: ReadWriteLock -> IO ()
writeLock = (>>) . waitQSem . turnstile <*> waitQSem . roomEmpty

writeUnlock :: ReadWriteLock -> IO ()
writeUnlock = (>>) . signalQSem . turnstile <*> signalQSem . roomEmpty

withWriteLock :: ReadWriteLock -> IO () -> IO ()
withWriteLock = bracket_ . writeLock <*> writeUnlock