diff options
author | Joey Hess <joey@kitenet.net> | 2012-07-28 15:41:49 -0400 |
---|---|---|
committer | Joey Hess <joey@kitenet.net> | 2012-07-28 15:41:49 -0400 |
commit | ca478b7bcb48fee0d1a97340e6ea5da8e97074f0 (patch) | |
tree | 26797676ecc88b0cc9686da2fc9557456768aa8f /Utility | |
parent | 0a66947e3b8532b902ee5969c5659fe0fd42272c (diff) |
Focus today was writing a notification broadcaster.
This is a way to send a notification to a set of clients, any of which can be
blocked waiting for a new notification to arrive. A complication is that any
number of clients may be be dead, and we don't want stale notifications for
those clients to pile up and leak memory.
It took me 3 tries to find the solution, which turns out to be simple: An array
of SampleVars, one per client. Using SampleVars means that clients only see the
most recent notification, but when the notification is just "the assistant's
state changed somehow; display a refreshed rendering of it", that's sufficient.
Diffstat (limited to 'Utility')
-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) |