"unschedule" is STM variant of "cancel"

1 files changed, 11 insertions, 7 deletions

diff --git a/Announcer.hs b/Announcer.hs
index ef931cce..8d2087dd 100644
--- a/Announcer.hs
+++ b/Announcer.hs
@@ -18,6 +18,7 @@ module Announcer
     , cancel
     , itemStatusNum
     , runAction
+    , unschedule
 
     -- lower level, Announcer.Tox needs these.
     , scheduleImmediately
@@ -121,9 +122,11 @@ stopAnnouncer announcer = do
     atomically $ writeTChan (commander announcer) ShutdownScheduler
     atomically $ readTVar (announcerActive announcer) >>= check . not
 
+unschedule :: Announcer -> AnnounceKey -> STM ()
+unschedule announcer k = writeTChan (commander announcer) $ UnscheduleAction k
+
 cancel :: Announcer -> AnnounceKey -> IO ()
-cancel announcer k = do
-    atomically $ writeTChan (commander announcer) $ ScheduleAction (k, 0, (ScheduledItem (\a k p -> return $ atomically $ return ())))
+cancel = ((.).(.)) atomically unschedule
 
 -- | Construct an 'Announcer' object and fork a thread in which to perform the
 -- Kademlia searches and announces.
@@ -143,7 +146,7 @@ readTChanTimeout delay pktChannel = do
 toMicroseconds :: POSIXTime -> Int
 toMicroseconds = round . (* 1000) . (* 1000)
 
-data SchedulerCommand = ShutdownScheduler | ScheduleAction KPS | RunAction (IO ())
+data SchedulerCommand = ShutdownScheduler | ScheduleAction KPS | RunAction (IO ()) | UnscheduleAction AnnounceKey
 
 listener :: Announcer -> IO ()
 listener announcer = relisten
@@ -174,16 +177,17 @@ listener announcer = relisten
                   ScheduledItem f    -> (fmap (>> relisten) (fmap fork (f announcer k now)))
 
       where
+        modifyScheduled f = modifyTVar (scheduled announcer) (Schedule . f . unSchedule)
         declareInactive = writeTVar (announcerActive announcer) False
         handleCommand =
           \case
             ShutdownScheduler -> atomically declareInactive
             RunAction io -> io >> relisten
+            UnscheduleAction k -> do
+              atomically $ modifyScheduled $ PSQ.delete k
+              relisten
             ScheduleAction (k, p, s) -> do
-              atomically $
-                modifyTVar
-                  (scheduled announcer)
-                  (Schedule . PSQ.insert' k s p . unSchedule)
+              atomically $ modifyScheduled $ PSQ.insert' k s p
               relisten
 
 announceThread :: Announcer -> IO ()