diff options
-rw-r--r-- | Announcer.hs | 25 |
1 files changed, 24 insertions, 1 deletions
diff --git a/Announcer.hs b/Announcer.hs index 140ee993..0a731efa 100644 --- a/Announcer.hs +++ b/Announcer.hs | |||
@@ -50,6 +50,11 @@ packAnnounceKey _ = return . AnnounceKey . Char8.pack | |||
50 | unpackAnnounceKey :: Announcer -> AnnounceKey -> STM String | 50 | unpackAnnounceKey :: Announcer -> AnnounceKey -> STM String |
51 | unpackAnnounceKey _ (AnnounceKey bs) = return $ Char8.unpack bs | 51 | unpackAnnounceKey _ (AnnounceKey bs) = return $ Char8.unpack bs |
52 | 52 | ||
53 | -- | Actions that can be scheduled to occur at some particular time in the | ||
54 | -- future. Since periodic event handlers are responsible for re-scheduling | ||
55 | -- themselves, they are typically bootstrapped using 'scheduleImmediately' with | ||
56 | -- 'NewAnnouncement' which triggers the ordinary recurring scheduling of | ||
57 | -- 'Announce'. | ||
53 | data ScheduledItem | 58 | data ScheduledItem |
54 | = DeleteAnnouncement | 59 | = DeleteAnnouncement |
55 | | NewAnnouncement (STM (IO ())) (IO ()) (IO ()) POSIXTime | 60 | | NewAnnouncement (STM (IO ())) (IO ()) (IO ()) POSIXTime |
@@ -75,8 +80,14 @@ itemStatusNum (StopAnnouncer ) = 5 | |||
75 | itemStatusNum _ = error "itemStatusNum not in sync with ScheduledItem declaration." | 80 | itemStatusNum _ = error "itemStatusNum not in sync with ScheduledItem declaration." |
76 | 81 | ||
77 | data Announcer = Announcer | 82 | data Announcer = Announcer |
78 | { scheduled :: TVar (PSQ' AnnounceKey POSIXTime ScheduledItem) | 83 | { -- | The queue of scheduled events. The priority is the time at which an |
84 | -- event is supposed to occur. | ||
85 | scheduled :: TVar (PSQ' AnnounceKey POSIXTime ScheduledItem) | ||
86 | -- | This TVar is False when the Announcer thread has finished. | ||
79 | , announcerActive :: TVar Bool | 87 | , announcerActive :: TVar Bool |
88 | -- | This delay is used to wait until it's time to act on the earliest | ||
89 | -- scheduled item. It will be interrupted whenever a new item is | ||
90 | -- scheduled. | ||
80 | , interrutible :: InterruptibleDelay | 91 | , interrutible :: InterruptibleDelay |
81 | } | 92 | } |
82 | 93 | ||
@@ -88,6 +99,10 @@ data AnnounceState = forall nid addr tok ni r. AnnounceState | |||
88 | , aStoringNodes :: TVar (MM.MinMaxPSQ ni (Down POSIXTime)) | 99 | , aStoringNodes :: TVar (MM.MinMaxPSQ ni (Down POSIXTime)) |
89 | } | 100 | } |
90 | 101 | ||
102 | -- | Schedules an event to occur long ago at the epoch (which effectively makes | ||
103 | -- the event happen as soon as possible). Note that the caller will usually | ||
104 | -- also want to interrupt the 'interrutible' delay so that it finds this item | ||
105 | -- immediately. | ||
91 | scheduleImmediately :: Announcer -> AnnounceKey -> ScheduledItem -> STM () | 106 | scheduleImmediately :: Announcer -> AnnounceKey -> ScheduledItem -> STM () |
92 | scheduleImmediately announcer k item | 107 | scheduleImmediately announcer k item |
93 | = modifyTVar' (scheduled announcer) (PSQ.insert' k item 0) | 108 | = modifyTVar' (scheduled announcer) (PSQ.insert' k item 0) |
@@ -245,6 +260,14 @@ announceThread announcer = do | |||
245 | -- We're done. Let 'stopAnnouncer' know that it can stop blocking. | 260 | -- We're done. Let 'stopAnnouncer' know that it can stop blocking. |
246 | atomically $ writeTVar (announcerActive announcer) False | 261 | atomically $ writeTVar (announcerActive announcer) False |
247 | 262 | ||
263 | -- | Returns 'Nothing' to stop the announcer thread (when the event is | ||
264 | -- StopAnnouncer). Otherwise, returns an action that will be performed in the | ||
265 | -- announcer thread before looping for the next scheduled item. | ||
266 | -- | ||
267 | -- Note that the returned action is responsible for re-scheduled another event | ||
268 | -- for periodic tasks. Otherwise, as is the case for the 'DeleteAnnouncement' | ||
269 | -- event, the item associated with a particular announce key will be removed | ||
270 | -- from the queue. | ||
248 | performScheduledItem :: Announcer -> POSIXTime -> Binding' AnnounceKey POSIXTime ScheduledItem -> STM (Maybe (IO ())) | 271 | performScheduledItem :: Announcer -> POSIXTime -> Binding' AnnounceKey POSIXTime ScheduledItem -> STM (Maybe (IO ())) |
249 | performScheduledItem announcer now = \case | 272 | performScheduledItem announcer now = \case |
250 | 273 | ||