为什么Haskell的方括号函数在可执行文件中有效，但在测试中无法清除？

我看到一个非常奇怪的行为，其中Haskell的bracket功能表现不同，这取决于是否stack run或stack test使用。

考虑以下代码，其中使用两个嵌套括号来创建和清理Docker容器：

module Main where

import Control.Concurrent
import Control.Exception
import System.Process

main :: IO ()
main = do
  bracket (callProcess "docker" ["run", "-d", "--name", "container1", "registry:2"])
          (\() -> do
              putStrLn "Outer release"
              callProcess "docker" ["rm", "-f", "container1"]
              putStrLn "Done with outer release"
          )
          (\() -> do
             bracket (callProcess "docker" ["run", "-d", "--name", "container2", "registry:2"])
                     (\() -> do
                         putStrLn "Inner release"
                         callProcess "docker" ["rm", "-f", "container2"]
                         putStrLn "Done with inner release"
                     )
                     (\() -> do
                         putStrLn "Inside both brackets, sleeping!"
                         threadDelay 300000000
                     )
          )

当我运行stack run并中断时Ctrl+C，我得到了预期的输出：

Inside both brackets, sleeping!
^CInner release
container2
Done with inner release
Outer release
container1
Done with outer release

而且我可以验证两个Docker容器均已创建然后删除。

但是，如果我将这个完全相同的代码粘贴到测试中并运行stack test，则仅（部分）第一次清除会发生：

Inside both brackets, sleeping!
^CInner release
container2

这导致Docker容器在我的机器上运行。这是怎么回事？

• 我确保将完全相同ghc-options的内容传递给两个。
• 完整的演示仓库在这里：https : //github.com/thomasjm/bracket-issue

使用时stack run，Stack有效地使用exec系统调用将控制权转移到可执行文件，因此新可执行文件的进程将替换正在运行的Stack进程，就像您直接从外壳程序运行可执行文件一样。这是流程树的外观stack run。特别要注意的是，可执行文件是Bash shell的直接子级。更重要的是，请注意终端的前台进程组（TPGID）是17996，并且该进程组（PGID）中的唯一进程是该bracket-test-exe进程。

PPID   PID  PGID   SID TTY      TPGID STAT   UID   TIME COMMAND
13816 13831 13831 13831 pts/3    17996 Ss    2001   0:00  |       \_ /bin/bash --noediting -i
13831 17996 17996 13831 pts/3    17996 Sl+   2001   0:00  |       |   \_ .../.stack-work/.../bracket-test-exe

结果，当您按Ctrl-C中断stack run在shell 下或直接从shell 运行的进程时，SIGINT信号仅传递给该bracket-test-exe进程。这引发了一个异步UserInterrupt异常。这种方法bracket在以下情况下有效：

bracket
  acquire
  (\() -> release)
  (\() -> body)

在处理过程中收到异步异常body，它会运行release，然后重新引发该异常。对于您的嵌套bracket调用，这具有中断内部主体，处理内部释放，重新引发异常以中断外部主体，处理外部释放以及最后重新引发异常以终止程序的作用。（如果bracket您的main函数中有更多跟随外部函数的动作，它们将不会执行。）

另一方面，当您使用时stack test，Stack将withProcessWait启动可执行文件作为进程的子stack test进程。在以下进程树中，请注意这bracket-test-test是的子进程stack test。至关重要的是，终端的前台进程组是18050，并且该进程组包括stack test进程和bracket-test-test进程。

PPID   PID  PGID   SID TTY      TPGID STAT   UID   TIME COMMAND
13816 13831 13831 13831 pts/3    18050 Ss    2001   0:00  |       \_ /bin/bash --noediting -i
13831 18050 18050 13831 pts/3    18050 Sl+   2001   0:00  |       |   \_ stack test
18050 18060 18050 13831 pts/3    18050 Sl+   2001   0:00  |       |       \_ .../.stack-work/.../bracket-test-test

当您在终端按Ctrl-C，SIGINT信号发送到所有进程终端的前台进程组中这样既stack test和bracket-test-test得到信号。 bracket-test-test将开始处理信号并如上所述运行终结器。但是，这里有一个竞争条件，因为当stack test被中断时，它的中间位置withProcessWait或多或少地定义如下：

withProcessWait config f =
  bracket
    (startProcess config)
    stopProcess
    (\p -> f p <* waitExitCode p)

因此，当其bracket中断时，它会stopProcess通过向其发送SIGTERM信号来终止子进程的调用。与相比SIGINT，这不会引发异步异常。它只是立即终止子项，通常会在其完成任何终结器之前终止。

我想不出一种特别简单的方法来解决此问题。一种方法是使用工具System.Posix将流程放入自己的流程组中：

main :: IO ()
main = do
  -- save old terminal foreground process group
  oldpgid <- getTerminalProcessGroupID (Fd 2)
  -- get our PID
  mypid <- getProcessID
  let -- put us in our own foreground process group
      handleInt  = setTerminalProcessGroupID (Fd 2) mypid >> createProcessGroupFor mypid
      -- restore the old foreground process gorup
      releaseInt = setTerminalProcessGroupID (Fd 2) oldpgid
  bracket
    (handleInt >> putStrLn "acquire")
    (\() -> threadDelay 1000000 >> putStrLn "release" >> releaseInt)
    (\() -> putStrLn "between" >> threadDelay 60000000)
  putStrLn "finished"

现在，Ctrl-C将导致SIGINT仅传递给该bracket-test-test进程。它将清理，还原原始的前台进程组以指向该stack test进程，然后终止。这将导致测试失败，并且stack test将继续运行。

一种替代方法是尝试处理SIGTERM并保持子进程运行以执行清理，即使该stack test进程已终止也是如此。这有点丑陋，因为在查看shell提示时，该过程将在后台进行清理。