summaryrefslogtreecommitdiff
path: root/Announcer.hs
diff options
context:
space:
mode:
authorAndrew Cady <d@jerkface.net>2018-06-18 08:40:23 -0400
committerAndrew Cady <d@jerkface.net>2018-06-18 18:20:29 -0400
commit56928c6f5602461a06211f2161fa845d17ba159b (patch)
tree0f690ad91d56d77be0e1ac6caefb624f510f7931 /Announcer.hs
parent58a6ff596876e8a3aa1bb55ac0fb2befb633fa75 (diff)
Implement some kind of announcer shutdown
Probably this crashes the program when the tchan is used. Fixable.
Diffstat (limited to 'Announcer.hs')
-rw-r--r--Announcer.hs15
1 files changed, 10 insertions, 5 deletions
diff --git a/Announcer.hs b/Announcer.hs
index 7d1d605d..e0f8b47e 100644
--- a/Announcer.hs
+++ b/Announcer.hs
@@ -153,7 +153,9 @@ readTChanTimeout timeout pktChannel = do
153 toMicroseconds :: POSIXTime -> Int 153 toMicroseconds :: POSIXTime -> Int
154 toMicroseconds = undefined 154 toMicroseconds = undefined
155 155
156listener :: TChan KPS -> IO () 156data SchedulerCommand = ShutdownScheduler | ScheduledAction KPS
157
158listener :: TChan SchedulerCommand -> IO ()
157listener chan = relisten PSQ.empty 159listener chan = relisten PSQ.empty
158 where 160 where
159 note :: String -> IO () 161 note :: String -> IO ()
@@ -162,14 +164,17 @@ listener chan = relisten PSQ.empty
162 case minView queue of 164 case minView queue of
163 Nothing -> do 165 Nothing -> do
164 note "queue empty - listening indefinitely" 166 note "queue empty - listening indefinitely"
165 (k, p, s) <- atomically $ readTChan chan 167 atomically (readTChan chan) >>= \case
166 note "handling new event" 168 ShutdownScheduler -> return ()
167 relisten $ PSQ.insert' k s p queue 169 ScheduledAction (k, p, s) -> do
170 note "handling new event"
171 relisten $ PSQ.insert' k s p queue
168 Just ((k, p, s), queue') -> do 172 Just ((k, p, s), queue') -> do
169 note "queue full - listening with timeout" 173 note "queue full - listening with timeout"
170 now <- getPOSIXTime 174 now <- getPOSIXTime
171 readTChanTimeout (p - now) chan >>= \case 175 readTChanTimeout (p - now) chan >>= \case
172 Just (k, p, s) -> do 176 Just (ShutdownScheduler) -> return ()
177 Just (ScheduledAction (k, p, s)) -> do
173 note "handling new event (event occurred before timeout)" 178 note "handling new event (event occurred before timeout)"
174 relisten $ PSQ.insert' k s p queue 179 relisten $ PSQ.insert' k s p queue
175 Nothing -> do 180 Nothing -> do