From 9eac701e5dafbbd1be1db5facdffa4ac2971d018 Mon Sep 17 00:00:00 2001 From: joe Date: Wed, 1 Nov 2017 03:26:06 -0400 Subject: oops. Fixed Announcer termination. --- Announcer.hs | 11 +++++++++-- 1 file changed, 9 insertions(+), 2 deletions(-) (limited to 'Announcer.hs') diff --git a/Announcer.hs b/Announcer.hs index f4af9329..1f539d5d 100644 --- a/Announcer.hs +++ b/Announcer.hs @@ -1,6 +1,7 @@ {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE LambdaCase #-} +{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE NondecreasingIndentation #-} module Announcer ( Announcer @@ -58,6 +59,7 @@ scheduleImmediately announcer k item stopAnnouncer :: Announcer -> IO () stopAnnouncer announcer = do atomically $ scheduleImmediately announcer (AnnounceKey "*stop*") StopAnnouncer + interruptDelay (interrutible announcer) atomically $ readTVar (announcerActive announcer) >>= check . not data AnnounceMethod r = forall nid ni addr r tok a. AnnounceMethod @@ -66,9 +68,14 @@ data AnnounceMethod r = forall nid ni addr r tok a. AnnounceMethod } schedule :: Announcer -> AnnounceKey -> AnnounceMethod r -> r -> IO () -schedule announcer k _ _ = do +schedule announcer k AnnounceMethod{aSearch,aPublish} r = do let announce = _todo :: IO () -- publish to current search results + onResult _ = return True search = _todo :: IO () -- thread to fork + -- ns <- R.kclosest (searchSpace qsearch) searchK nid <$> readTVar dhtBuckets + -- st <- newSearch qsearch nid ns + -- searchLoop :: Search nid addr tok ni r -> nid -> (r -> STM Bool) -> SearchState nid addr tok ni r -> IO () + -- searchLoop aSearch nid onResult st interval = _todo :: POSIXTime -- publish interval atomically $ scheduleImmediately announcer k $ NewAnnouncement search announce interval interruptDelay (interrutible announcer) @@ -97,7 +104,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) -- cgit v1.2.3