module Control.Concurrent.Datastructures.ThreadWaitQueue where
import Control.Concurrent
import Control.Concurrent.MVar
type WaitOnToken = MVar ()
type ThreadWaitQueue = MVar WaitOnToken
createWaitQueue :: IO ThreadWaitQueue
createWaitQueue
= do
waitOnToken <- newEmptyMVar
threadWaitQueue <- newMVar waitOnToken
return threadWaitQueue
getQueueTicket :: ThreadWaitQueue -> IO WaitOnToken
getQueueTicket threadWaitQueue
= readMVar threadWaitQueue
enterWaitQueueWithTicket :: WaitOnToken -> IO ()
enterWaitQueueWithTicket waitOnToken
= do
yield
readMVar waitOnToken
enterWaitQueue :: ThreadWaitQueue -> IO ()
enterWaitQueue threadWaitQueue
= getQueueTicket threadWaitQueue >>= enterWaitQueueWithTicket
openWaitQueue :: ThreadWaitQueue -> IO ()
openWaitQueue threadWaitQueue
= do
waitOnToken <- takeMVar threadWaitQueue
_openIfNeeded waitOnToken
putMVar threadWaitQueue waitOnToken
_openIfNeeded :: WaitOnToken -> IO ()
_openIfNeeded waitOnToken
= do
notOpenYet <- isEmptyMVar waitOnToken
case notOpenYet of
True -> putMVar waitOnToken ()
False -> return ()
recloseWaitQueue :: ThreadWaitQueue -> IO ()
recloseWaitQueue threadWaitQueue
= do
waitOnToken' <- newEmptyMVar
_ <- takeMVar threadWaitQueue
putMVar threadWaitQueue waitOnToken'
openAndRecloseWaitQueue :: ThreadWaitQueue -> IO ()
openAndRecloseWaitQueue threadWaitQueue
= do
waitOnToken1 <- takeMVar threadWaitQueue
waitOnToken2 <- newEmptyMVar
_openIfNeeded waitOnToken1
putMVar threadWaitQueue waitOnToken2