支架在线程内时不释放资源

Question

我遇到了 Haskell 的问题bracket：当在分叉线程（使用forkFinally）bracket的第二个参数中运行时，释放资源的计算不会在程序结束时运行。

这是说明问题的代码（我知道在这种特定情况下，我可以禁用缓冲以立即写入文件）：

import           System.IO
import           Control.Exception              ( bracket
                                                , throwTo
                                                )

import           Control.Concurrent             ( forkFinally
                                                , threadDelay
                                                )
main = do
  threadId <- forkFinally
    (writeToFile "first_file")
    (\ex -> putStrLn $ "Exception occurred: " ++ show ex)
  putStrLn "Press enter to exit"
  _ <- getLine
  putStrLn "Bye!"

writeToFile :: FilePath -> IO ()
writeToFile file = bracket
  (openFile file AppendMode)
  (\fileHandle -> do
    putStrLn $ "\nClosing handle " ++ show fileHandle
    hClose fileHandle
  )
  (\fileHandle -> mapM_ (addNrAndWait fileHandle) [1 ..])

addNrAndWait :: Handle -> Int -> IO ()
addNrAndWait fileHandle nr =
  let nrStr = show nr
  in  do
        putStrLn $ "Appending " ++ nrStr
        hPutStrLn fileHandle nrStr
        threadDelay 1000000

永远不会调用释放资源（并写入控制台）的计算：

putStrLn $ "\nClosing handle " ++ show fileHandle
hClose fileHandle

通过删除分叉代码使程序成为单线程main摆脱了这个问题，并且在以Ctrl+结束程序时关闭了文件句柄c：

main = writeToFile "first_file"

如何确保bracket在使用多线程时执行资源释放代码？

Answer 1

使用 throwTo

显然，用forkFinallynever创建的线程会抛出异常，因此bracket永远不会执行资源释放代码。

我们可以通过使用以下方法手动执行此操作来解决此问题throwTo threadId ThreadKilled：

import           Control.Exception              ( bracket
                                                , throwTo
                                                , AsyncException(ThreadKilled)
                                                )

import           Control.Concurrent             ( forkFinally
                                                , threadDelay
                                                )
main = do
  threadId <- forkFinally
    (writeToFile "first_file")
    (\ex -> putStrLn $ "Exception occurred: " ++ show ex)
  putStrLn "Press enter to exit"
  _ <- getLine
  throwTo threadId ThreadKilled
  putStrLn "Bye!"

Answer 2

这里问题的根本原因是，当main退出时，您的进程就会死亡。它不会等待您创建的任何其他线程完成。因此，在您的原始代码中，您创建了一个线程来写入文件，但不允许完成。

如果你想杀死线程但强制它清理，那么throwTo像你在这里做的那样使用。如果您希望线程完成，则需要在main返回之前等待。请参阅如何强制主线程在 Haskell 中等待其所有子线程完成