diff options
-rw-r--r-- | Announcer.hs | 11 |
1 files changed, 9 insertions, 2 deletions
diff --git a/Announcer.hs b/Announcer.hs index f4af9329..1f539d5d 100644 --- a/Announcer.hs +++ b/Announcer.hs | |||
@@ -1,6 +1,7 @@ | |||
1 | {-# LANGUAGE ExistentialQuantification #-} | 1 | {-# LANGUAGE ExistentialQuantification #-} |
2 | {-# LANGUAGE GeneralizedNewtypeDeriving #-} | 2 | {-# LANGUAGE GeneralizedNewtypeDeriving #-} |
3 | {-# LANGUAGE LambdaCase #-} | 3 | {-# LANGUAGE LambdaCase #-} |
4 | {-# LANGUAGE NamedFieldPuns #-} | ||
4 | {-# LANGUAGE NondecreasingIndentation #-} | 5 | {-# LANGUAGE NondecreasingIndentation #-} |
5 | module Announcer | 6 | module Announcer |
6 | ( Announcer | 7 | ( Announcer |
@@ -58,6 +59,7 @@ scheduleImmediately announcer k item | |||
58 | stopAnnouncer :: Announcer -> IO () | 59 | stopAnnouncer :: Announcer -> IO () |
59 | stopAnnouncer announcer = do | 60 | stopAnnouncer announcer = do |
60 | atomically $ scheduleImmediately announcer (AnnounceKey "*stop*") StopAnnouncer | 61 | atomically $ scheduleImmediately announcer (AnnounceKey "*stop*") StopAnnouncer |
62 | interruptDelay (interrutible announcer) | ||
61 | atomically $ readTVar (announcerActive announcer) >>= check . not | 63 | atomically $ readTVar (announcerActive announcer) >>= check . not |
62 | 64 | ||
63 | data AnnounceMethod r = forall nid ni addr r tok a. AnnounceMethod | 65 | 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 | |||
66 | } | 68 | } |
67 | 69 | ||
68 | schedule :: Announcer -> AnnounceKey -> AnnounceMethod r -> r -> IO () | 70 | schedule :: Announcer -> AnnounceKey -> AnnounceMethod r -> r -> IO () |
69 | schedule announcer k _ _ = do | 71 | schedule announcer k AnnounceMethod{aSearch,aPublish} r = do |
70 | let announce = _todo :: IO () -- publish to current search results | 72 | let announce = _todo :: IO () -- publish to current search results |
73 | onResult _ = return True | ||
71 | search = _todo :: IO () -- thread to fork | 74 | search = _todo :: IO () -- thread to fork |
75 | -- ns <- R.kclosest (searchSpace qsearch) searchK nid <$> readTVar dhtBuckets | ||
76 | -- st <- newSearch qsearch nid ns | ||
77 | -- searchLoop :: Search nid addr tok ni r -> nid -> (r -> STM Bool) -> SearchState nid addr tok ni r -> IO () | ||
78 | -- searchLoop aSearch nid onResult st | ||
72 | interval = _todo :: POSIXTime -- publish interval | 79 | interval = _todo :: POSIXTime -- publish interval |
73 | atomically $ scheduleImmediately announcer k $ NewAnnouncement search announce interval | 80 | atomically $ scheduleImmediately announcer k $ NewAnnouncement search announce interval |
74 | interruptDelay (interrutible announcer) | 81 | interruptDelay (interrutible announcer) |
@@ -97,7 +104,7 @@ announceThread announcer = do | |||
97 | return $ do | 104 | return $ do |
98 | now <- getPOSIXTime | 105 | now <- getPOSIXTime |
99 | -- Is it time to do something? | 106 | -- Is it time to do something? |
100 | if (prio item > now) | 107 | if (prio item < now) |
101 | then do -- Yes. Dequeue and handle this event. | 108 | then do -- Yes. Dequeue and handle this event. |
102 | action <- atomically $ do | 109 | action <- atomically $ do |
103 | modifyTVar' (scheduled announcer) | 110 | modifyTVar' (scheduled announcer) |