TimeoutManagerは、スナップ元で何も

Question

を入れないようにtryPutMVarを使用していますSnap.Internal.Http.Server.TimeoutManager

------------------------------------------------------------------------------ 
-- | Register a new connection with the TimeoutManager. 
register :: IO()    --^action to run when the timeout deadline is 
           -- exceeded. 
     -> TimeoutManager  --^manager to register with. 
     -> IO TimeoutHandle 
register killAction tm = do 
    now <- getTime 
    let !state = Deadline $ now + toEnum defaultTimeout 
    stateRef <- newIORef state 

    let !h = TimeoutHandle killAction stateRef getTime 
    atomicModifyIORef connections $ \x -> (h:x,()) 

    inact <- readIORef inactivity 
    when inact $ do 
     -- wake up manager thread 
     writeIORef inactivity False 
     _ <- tryPutMVar morePlease() 
     return() 
    return h 

    where 
    getTime  = _getTime tm 
    inactivity  = _inactivity tm 
    morePlease  = _morePlease tm 
    connections = _connections tm 
    defaultTimeout = _defaultTimeout tm 

_morePleaseフィールドがあるのはなぜ？
_ <- tryPutMVar morePlease()は何をしますか？

Answer 1

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()は彼を目覚める。