Tweaks to announce scheduler.

2 files changed, 10 insertions, 3 deletions

diff --git a/Announcer.hs b/Announcer.hs
index c66d26b4..140ee993 100644
--- a/Announcer.hs
+++ b/Announcer.hs
@@ -36,6 +36,7 @@ import Data.Ord
 import Data.Time.Clock.POSIX
 import qualified GHC.Generics as Generics
 -- import Generic.Data.Internal.Meta as Lyxia
+import System.IO
 
 newtype AnnounceKey = AnnounceKey ByteString
  deriving (Hashable,Ord,Eq)
@@ -179,7 +180,11 @@ schedule announcer k AnnounceMethod{aSearch,aPublish,aBuckets,aTarget,aInterval}
                     --    atomically $ modifyTVar ns $ MM.insertTake announceK ni (Down now)
                     return ()
                 return True -- True to keep searching.
-        searchAgain = searchIsFinished st >>= \isfin -> return $ when isfin $ void $ fork search
+        searchAgain = do
+            -- Canceling a pending search here seems to make announcements more reliable.
+            searchCancel st
+            isfin <- searchIsFinished st -- Always True, since we canceled.
+            return $ when isfin $ void $ fork search
         search  = do -- thread to fork
             atomically $ reset aBuckets aSearch aTarget st
             searchLoop aSearch aTarget onResult st
@@ -225,7 +230,7 @@ announceThread announcer = do
         return $ do
         now <- getPOSIXTime
         -- Is it time to do something?
-        if (prio item < now)
+        if (prio item <= now)
             then do -- Yes.  Dequeue and handle this event.
                  action <- atomically $ do
                      modifyTVar' (scheduled announcer)
@@ -263,6 +268,7 @@ performScheduledItem announcer now = \case
                    (PSQ.insert' k (Announce checkFin announce interval) (now + interval))
         return $ Just $ do
             isfin
+            hPutStrLn stderr $ "This print avoids negative-time future scheduling. Weird bug. TODO: fix it. "++show now
             announce
 
     -- search finished:
diff --git a/examples/dhtd.hs b/examples/dhtd.hs
index 58a69c6a..d6da567a 100644
--- a/examples/dhtd.hs
+++ b/examples/dhtd.hs
@@ -988,7 +988,8 @@ clientSession s@Session{..} sock cnum h = do
                             as <- readTVar (scheduled $ announcer)
                             forM (PSQ.toList as) $ \(k,ptm,item) -> do
                                 kstr <- unpackAnnounceKey announcer k
-                                return [ show (ptm - now)
+                                return [ if ptm==0 then "now"
+                                                   else show (ptm - now)
                                        , show (itemStatusNum item)
                                        , kstr
                                        ]