managerThread :: TimeoutManager -> IO ()
managerThread tm = loop `finally` (readIORef connections >>= destroyAll)
where
--------------------------------------------------------------------------
connections = _connections tm
getTime = _getTime tm
inactivity = _inactivity tm
morePlease = _morePlease tm
waitABit = threadDelay 5000000
--------------------------------------------------------------------------
loop = do
waitABit
handles <- atomicModifyIORef connections (\x -> ([],x))
if null handles
then do
-- we're inactive, go to sleep until we get new threads
writeIORef inactivity True
takeMVar morePlease
else do
now <- getTime
dlist <- processHandles now handles id
atomicModifyIORef connections (\x -> (dlist x, ()))
loop
--------------------------------------------------------------------------
processHandles !now handles initDlist = go handles initDlist
where
go [] !dlist = return dlist
go (x:xs) !dlist = do
state <- readIORef $ _state x
!dlist' <- case state of
Canceled -> return dlist
Deadline t -> if t <= now
then do
_killAction x
return dlist
else return (dlist . (x:))
go xs dlist'
--------------------------------------------------------------------------
destroyAll = mapM_ diediedie
--------------------------------------------------------------------------
diediedie x = do
state <- readIORef $ _state x
case state of
Canceled -> return ()
_ -> _killAction x
Если нет дескрипторов для обработки, managerThread
будет заблокирован takeMVar morePlease
. _ <- tryPutMVar morePlease ()
будит его.