RTS如何在MVar操作中检测到​​线程被无限期阻塞？

Question

我有这段代码

mvarToList :: MVar (Maybe a) -> IO [a]
mvarToList mv = do
    mby <- takeMVar mv
    case mby of
        Nothing -> return []
        Just x  -> do
            xs <- unsafeInterleaveIO (mvarToList mv)
            return (x : xs)
{-# NOINLINE mvarToList #-}

streamQuery_ :: FromRow a => Connection -> Query -> IO [a]
streamQuery_ conn q = do
    mv <- newEmptyMVar
    void $ forkIO $ do
        fold_ conn q () (\_ x -> putMVar mv (Just x))
        putMVar mv Nothing
    mvarToList mv

它使用提供postgresql-simple功能的fold_库。它允许您提供在查询结果的每一行上运行的函数。内部实现是这样的，如果提供的功能阻塞，则不会获取下一个结果（模数批处理）。

我在这里所做的基本上是将列表元素的评估附加到takeMVar，这给了我一个从DB中传输结果的惰性列表。

这里的问题是泄漏。我希望避免任何泄漏的唯一方法是，如果SOMEHOW垃圾收集列表导致RTS确定获取线程永远被阻塞（因为不再从MVar中获取任何内容）并向其抛出异常。也许我甚至可以抓住那个例外并处理清理工作？