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

Question

我在处理Haskell的bracket时遇到麻烦：当在派生线程中运行（使用forkFinally）@DslMarker的第二个参数时，释放资源的计算在以下情况下不运行程序结束。

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

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 中删除派生代码来使程序成为单线程，可以解决此问题，并在使用 Ctrl + c结束程序时关闭文件句柄kbd>：

main

使用多个线程时，如何确保执行main = writeToFile "first_file" 中的资源释放代码？

Answer 1

使用throwTo

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

我们可以使用bracket手动完成此操作：

throwTo threadId ThreadKilled

Answer 2

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

如果您想杀死线程但要强制清理线程，请像在此一样使用throwTo。如果您希望线程完成，则需要等待main返回之前。参见How to force main thread to wait for all its child threads finish in Haskell

Answer 3

使用async

使getLine无限期地阻塞主线程在nohup中不能很好地发挥作用：它将失败，并

<stdin>: hGetLine: invalid argument (Bad file descriptor)

作为getLine和throwTo的替代方法，您可以使用async's functions：

import           Control.Concurrent.Async       ( withAsync, wait )

main = withAsync (writeToFile "first_file") wait

这可以使程序以nohup ./theProgram-exe &¹（例如on a server via SSH）运行。

async在同时运行多个任务时也会亮起：

import           Control.Concurrent.Async       ( race_ )

main = race_ (writeToFile "first_file") (writeToFile "second_file")

函数race_同时运行两个任务，并等待直到第一个结果到达。使用我们的非终止writeToFile，将永远不会有常规结果，但是如果其中一个任务引发异常，则另一个任务也将被取消。例如，这对于同时运行HTTP和HTTPS服务器很有用。

要彻底关闭程序-给线程一个释放bracket中资源的机会-我向它发送SIGINT信号：

pkill --signal SIGINT theProgram-exe

处理SIGTERM

要在SIGTERM上优雅地结束线程，我们可以install a handler捕获信号：

import           Control.Concurrent.Async       ( withAsync
                                                , wait
                                                , cancel
                                                , Async
                                                )
import           System.Posix.Signals

main = withAsync
  (writeToFile "first_file")
  (\asy -> do
    cancelOnSigTerm asy
    wait asy
  )

cancelOnSigTerm :: Async a -> IO Handler
cancelOnSigTerm asy = installHandler
  sigTERM
  (Catch $ do
    putStrLn "Caught SIGTERM"
    -- Throws an AsyncCancelled exception to the forked thread, allowing
    -- it to release resources via bracket
    cancel asy
  )
  Nothing

现在，我们的程序将在收到SIGTERM时在bracket中释放其资源：

pkill theProgram-exe

这里等同于两个支持SIGTERM的并发任务：

import           Control.Concurrent.Async       ( withAsync
                                                , wait
                                                , cancel
                                                , Async
                                                , waitEither_
                                                )
import           System.Posix.Signals

main = raceWith_ cancelOnSigTerm
                 (writeToFile "first_file")
                 (writeToFile "second_file")

raceWith_ :: (Async a -> IO b) -> IO a -> IO a -> IO ()
raceWith_ f left right = withAsync left $ \a -> withAsync right $ \b -> do
  f a
  f b
  waitEither_ a b

有关异步Haskell主题的更多信息，请浏览Simon Marlow的Parallel and Concurrent Programming in Haskell。

---

¹_{调用stack build以在例如.stack-work/dist/x86_64-linux-tinfo6/Cabal-2.4.0.1/build/theProgram-exe/theProgram-exe处获取可执行文件。您可以使用stack path --local-install-root获取此目录的路径。}