diff options
Diffstat (limited to 'Utility/NotificationBroadcaster.hs')
-rw-r--r-- | Utility/NotificationBroadcaster.hs | 75 |
1 files changed, 75 insertions, 0 deletions
diff --git a/Utility/NotificationBroadcaster.hs b/Utility/NotificationBroadcaster.hs new file mode 100644 index 000000000..51b321752 --- /dev/null +++ b/Utility/NotificationBroadcaster.hs @@ -0,0 +1,75 @@ +{- notification broadcaster + - + - This is used to allow clients to block until there is a new notification + - that some thing occurred. It does not communicate what the change is, + - it only provides blocking reads to wait on notifications. + - + - Multiple clients are supported. Each has a unique id. + - + - Copyright 2012 Joey Hess <joey@kitenet.net> + - + - Licensed under the GNU GPL version 3 or higher. + -} + +module Assistant.NotificationBroadCaster ( + NotificationBroadCaster, + NotificationHandle, + newNotificationBroadCaster, + newNotificationHandle, + notificationHandleToId, + notificationHandleFromId, + sendNotification, + waitNotification, +) where + +import Common + +import Control.Concurrent.STM +import Control.Concurrent.SampleVar + +{- One SampleVar per client. The TMVar is never empty, so never blocks. -} +type NotificationBroadCaster = TMVar [SampleVar ()] + +{- Handle given out to an individual client. -} +data NotificationHandle = NotificationHandle NotificationBroadCaster Int + +newNotificationBroadCaster :: IO NotificationBroadCaster +newNotificationBroadCaster = atomically (newTMVar []) + +{- Allocates a notification handle for a client to use. -} +newNotificationHandle :: NotificationBroadCaster -> IO NotificationHandle +newNotificationHandle b = NotificationHandle + <$> pure b + <*> addclient b + where + addclient b = do + s <- newEmptySampleVar + atomically $ do + l <- readTMVar b + putTMVar b $ l ++ [s] + return $ length l + +{- Extracts the Int identifier from a notification handle. + - This can be used to eg, pass the identifier through to a WebApp. -} +notificationHandleToId :: NotificationHandle -> Int +notificationHandleToId (NotificationHandle _ i) = i + +{- Given a NotificationBroadCaster, and an Int identifier, recreates the + - NotificationHandle. -} +notificationHandleFromId :: NotificationBroadCaster -> Int -> NotificationHandle +notificationHandleFromId = NotificationHandle + +{- Sends a notification to all clients. -} +sendNotification :: NotificationBroadCaster -> IO () +sendNotification b = do + l <- atomically $ readTMVar b + mapM_ notify l + where + notify s = writeSampleVar s () + +{- Used by a client to block until a new notification is available since + - the last time it tried. -} +waitNotification :: NotificationHandle -> IO () +waitNotification (NotificationHandle b i) = do + l <- atomically $ readTMVar b + readSampleVar (l !! i) |