summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorjoe <joe@jerkface.net>2017-11-01 03:26:06 -0400
committerjoe <joe@jerkface.net>2017-11-01 03:26:06 -0400
commit9eac701e5dafbbd1be1db5facdffa4ac2971d018 (patch)
tree3f08f0e58cbcbdfcac07db260a2d363edefb55ef
parentcc7c11e5d477866403ab52dd77ace3203a0b53ff (diff)
oops. Fixed Announcer termination.
-rw-r--r--Announcer.hs11
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 #-}
5module Announcer 6module Announcer
6 ( Announcer 7 ( Announcer
@@ -58,6 +59,7 @@ scheduleImmediately announcer k item
58stopAnnouncer :: Announcer -> IO () 59stopAnnouncer :: Announcer -> IO ()
59stopAnnouncer announcer = do 60stopAnnouncer 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
63data AnnounceMethod r = forall nid ni addr r tok a. AnnounceMethod 65data 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
68schedule :: Announcer -> AnnounceKey -> AnnounceMethod r -> r -> IO () 70schedule :: Announcer -> AnnounceKey -> AnnounceMethod r -> r -> IO ()
69schedule announcer k _ _ = do 71schedule 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)