multithreading - 在线程内部时括号不释放资源

Question

我在使用 Haskell 的 bracket 时遇到问题: 在 fork 线程中运行时(使用 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 中删除 fork 代码使程序成为单线程的解决了这个问题，当用 Ctrl + c 结束程序时文件句柄被关闭:

main = writeToFile "first_file"

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

Answer 1

使用 throwTo

显然是用 forkFinally 创建的线程永远不会抛出异常，因此 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!"