add a newtype
This commit is contained in:
parent
e31277d38a
commit
109dc122da
1 changed files with 11 additions and 8 deletions
|
@ -30,8 +30,13 @@ import Control.Concurrent.SampleVar
|
||||||
{- One SampleVar per client. The TMVar is never empty, so never blocks. -}
|
{- One SampleVar per client. The TMVar is never empty, so never blocks. -}
|
||||||
type NotificationBroadcaster = TMVar [SampleVar ()]
|
type NotificationBroadcaster = TMVar [SampleVar ()]
|
||||||
|
|
||||||
|
newtype NotificationId = NotificationId Int
|
||||||
|
|
||||||
|
instance Show NotificationId where
|
||||||
|
show (NotificationId i) = show i
|
||||||
|
|
||||||
{- Handle given out to an individual client. -}
|
{- Handle given out to an individual client. -}
|
||||||
data NotificationHandle = NotificationHandle NotificationBroadcaster Int
|
data NotificationHandle = NotificationHandle NotificationBroadcaster NotificationId
|
||||||
|
|
||||||
newNotificationBroadcaster :: IO NotificationBroadcaster
|
newNotificationBroadcaster :: IO NotificationBroadcaster
|
||||||
newNotificationBroadcaster = atomically (newTMVar [])
|
newNotificationBroadcaster = atomically (newTMVar [])
|
||||||
|
@ -47,16 +52,14 @@ newNotificationHandle b = NotificationHandle
|
||||||
atomically $ do
|
atomically $ do
|
||||||
l <- readTMVar b
|
l <- readTMVar b
|
||||||
putTMVar b $ l ++ [s]
|
putTMVar b $ l ++ [s]
|
||||||
return $ length l
|
return $ NotificationId $ length l
|
||||||
|
|
||||||
{- Extracts the Int identifier from a notification handle.
|
{- Extracts the identifier from a notification handle.
|
||||||
- This can be used to eg, pass the identifier through to a WebApp. -}
|
- This can be used to eg, pass the identifier through to a WebApp. -}
|
||||||
notificationHandleToId :: NotificationHandle -> Int
|
notificationHandleToId :: NotificationHandle -> NotificationId
|
||||||
notificationHandleToId (NotificationHandle _ i) = i
|
notificationHandleToId (NotificationHandle _ i) = i
|
||||||
|
|
||||||
{- Given a NotificationBroadcaster, and an Int identifier, recreates the
|
notificationHandleFromId :: NotificationBroadcaster -> NotificationId -> NotificationHandle
|
||||||
- NotificationHandle. -}
|
|
||||||
notificationHandleFromId :: NotificationBroadcaster -> Int -> NotificationHandle
|
|
||||||
notificationHandleFromId = NotificationHandle
|
notificationHandleFromId = NotificationHandle
|
||||||
|
|
||||||
{- Sends a notification to all clients. -}
|
{- Sends a notification to all clients. -}
|
||||||
|
@ -70,6 +73,6 @@ sendNotification b = do
|
||||||
{- 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 i) = do
|
waitNotification (NotificationHandle b (NotificationId i)) = do
|
||||||
l <- atomically $ readTMVar b
|
l <- atomically $ readTMVar b
|
||||||
readSampleVar (l !! i)
|
readSampleVar (l !! i)
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue