summaryrefslogtreecommitdiff
path: root/PingMachine.hs
diff options
context:
space:
mode:
Diffstat (limited to 'PingMachine.hs')
-rw-r--r--PingMachine.hs7
1 files changed, 4 insertions, 3 deletions
diff --git a/PingMachine.hs b/PingMachine.hs
index b714d71e..5cd70f95 100644
--- a/PingMachine.hs
+++ b/PingMachine.hs
@@ -48,17 +48,18 @@ data PingMachine = PingMachine
48-- 'pingFlag' is difficult to use properly because it is up to the caller to 48-- 'pingFlag' is difficult to use properly because it is up to the caller to
49-- remember that the ping is already in progress. 49-- remember that the ping is already in progress.
50forkPingMachine 50forkPingMachine
51 :: PingInterval -- ^ Milliseconds of idle before a ping is considered necessary. 51 :: String
52 -> PingInterval -- ^ Milliseconds of idle before a ping is considered necessary.
52 -> TimeOut -- ^ Milliseconds after 'PingIdle' before we signal 'PingTimeOut'. 53 -> TimeOut -- ^ Milliseconds after 'PingIdle' before we signal 'PingTimeOut'.
53 -> IO PingMachine 54 -> IO PingMachine
54forkPingMachine idle timeout = do 55forkPingMachine label idle timeout = do
55 d <- interruptibleDelay 56 d <- interruptibleDelay
56 flag <- atomically $ newTVar False 57 flag <- atomically $ newTVar False
57 canceled <- atomically $ newTVar False 58 canceled <- atomically $ newTVar False
58 event <- atomically newEmptyTMVar 59 event <- atomically newEmptyTMVar
59 started <- atomically $ newEmptyTMVar 60 started <- atomically $ newEmptyTMVar
60 when (idle/=0) $ void . forkIO $ do 61 when (idle/=0) $ void . forkIO $ do
61 myThreadId >>= flip labelThread ("ping.watchdog") 62 myThreadId >>= flip labelThread ("Ping." ++ label) -- ("ping.watchdog")
62 (>>=) (atomically (readTMVar started)) $ flip when $ do 63 (>>=) (atomically (readTMVar started)) $ flip when $ do
63 fix $ \loop -> do 64 fix $ \loop -> do
64 atomically $ writeTVar flag False 65 atomically $ writeTVar flag False