mirrors/git-annex
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages 1 Wiki Activity Actions

NotificationBroadcaster: Use SampleVars from SafeSemaphores instead of base

Browse source 
SampleVars from base are unsafe
This commit is contained in:
Ben Gamari 2012-10-05 17:04:46 -04:00
parent 179aeeaacc
commit 7fc4ee0dee
1 changed files with 6 additions and 6 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

12
Utility/NotificationBroadcaster.hs
View file

@ -26,10 +26,10 @@ module Utility.NotificationBroadcaster (
import Common import Common
import Control.Concurrent.STM import Control.Concurrent.STM
import Control.Concurrent.SampleVar import Control.Concurrent.MSampleVar
{- One SampleVar per client. The TMVar is never empty, so never blocks. -} {- One MSampleVar per client. The TMVar is never empty, so never blocks. -}
type NotificationBroadcaster = TMVar [SampleVar ()] type NotificationBroadcaster = TMVar [MSampleVar ()]
newtype NotificationId = NotificationId Int newtype NotificationId = NotificationId Int
deriving (Read, Show, Eq, Ord) deriving (Read, Show, Eq, Ord)
@ -47,7 +47,7 @@ newNotificationHandle b = NotificationHandle
<*> addclient <*> addclient
where where
addclient = do addclient = do
s <- newEmptySampleVar s <- newEmptySV
atomically $ do atomically $ do
l <- takeTMVar b l <- takeTMVar b
putTMVar b $ l ++ [s] putTMVar b $ l ++ [s]
@ -67,11 +67,11 @@ sendNotification b = do
l <- atomically $ readTMVar b l <- atomically $ readTMVar b
mapM_ notify l mapM_ notify l
where where
notify s = writeSampleVar s () notify s = writeSV s ()
{- Used by a client to block until a new notification is available since {- Used by a client to block until a new notification is available since
- the last time it tried. -} - the last time it tried. -}
waitNotification :: NotificationHandle -> IO () waitNotification :: NotificationHandle -> IO ()
waitNotification (NotificationHandle b (NotificationId i)) = do waitNotification (NotificationHandle b (NotificationId i)) = do
l <- atomically $ readTMVar b l <- atomically $ readTMVar b
readSampleVar (l !! i) readSV (l !! i)