haskell - 终止进程时捕获输出

Question

我需要运行一个进程，在它运行时做一些事情，最后终止它。这有问题的过程将我想保留的东西写入标准输出。很遗憾，似乎这个过程在我可以连接并提取它的最后一句话之前就已经死了。拥有稀缺异步编程的经验，我很难找到一个好的解决方案。它如果我能在 RIO.Process 的框架内完成这项任务，那将是幸运的，尽管我如果无法避免，我准备走出去。 (请注意 RIO 采用了一种不寻常的通过回调系统调用外部进程的方式。)

下面是我正在努力实现的高度简化的可运行示例。

这是要运行的程序的仿真:
(将其放入名为 x.sh 的文件中，然后说 chmod +x x.sh 使其可执行。)

#!/bin/sh

trap 'echo "Terminating..."; exit 0' TERM

echo "Initialization complete."

while true; do sleep 1; done

这是我的代码:
(将其放入名为 X.hs 的文件中，并使用 ghc -package rio X.hs 进行编译。)

{-#   language   NoImplicitPrelude   #-}
{-#   language   BlockArguments      #-}
{-#   language   OverloadedStrings   #-}

module Main where

import RIO
import RIO.Process
import Data.Text.IO (hGetContents, hGetLine)

main :: IO ()
main = runSimpleApp do
    proc "./x.sh" [ ]
        \processConfig -> withProcessWait_ (setStdout createPipe processConfig)
            \processHandle -> bracket_
                (initialize processHandle)
                (terminate processHandle)
                (return ())

initialize :: (HasProcessContext env, HasLogFunc env) => Process () Handle () -> RIO env ()
initialize processHandle = do
    x <- liftIO $ hGetLine (getStdout processHandle)
    if x == "Initialization complete." then return () else error "This should not happen."

terminate :: HasLogFunc env => Process () Handle () -> RIO env ()
terminate processHandle = do
    log' <- async $ liftIO $ hGetContents (getStdout processHandle)
    stopProcess processHandle
    log <- wait log'
    logInfo $ display log

这是发生了什么:

% ./X
X: fd:3: hGetBuffering: illegal operation (handle is closed)

— x.sh 在说什么，但我听不见。

管理它的正确方法是什么？

Answer 1

来自 the documentation for stopProcess :

Close a process and release any resources acquired. This will ensure terminateProcess is called, wait for the process to actually exit, and then close out resources allocated for the streams. In the event of any cleanup exceptions being thrown this will throw an exception.

(强调我的)您不希望 stopProcess 在读取输出之前执行此操作。您只需要 terminateProcess。 withProcessWait_ 将处理剩下的事情。不幸的是，你必须走出 RIO 才能做到这一点，使用 import System.Process (terminateProcess) 然后 liftIO $ terminateProcess (unsafeProcessHandle processHandle).

旁注:您有点误用了 bracket_。由于 bracket_ 的“中间”是空操作，尤其是现在开头和结尾实际上并未获取或释放任何资源，所以它有点毫无意义。此外，完全不用 async，您可以在终止进程后正常读取输出，因为进程已经产生的输出不会在终止时消失。

这是您的代码，上面的所有内容都已修复:

{-#   language   NoImplicitPrelude   #-}
{-#   language   BlockArguments      #-}
{-#   language   OverloadedStrings   #-}

module Main where

import RIO
import RIO.Process
import Data.Text.IO (hGetContents, hGetLine)
import System.Process (terminateProcess)

main :: IO ()
main = runSimpleApp do
    proc "./x.sh" [ ]
        \processConfig -> withProcessWait_ (setStdout createPipe processConfig)
            \processHandle -> do
                initialize processHandle
                terminate processHandle

initialize :: (HasProcessContext env, HasLogFunc env) => Process () Handle () -> RIO env ()
initialize processHandle = do
    x <- liftIO $ hGetLine (getStdout processHandle)
    if x == "Initialization complete." then return () else error "This should not happen."

terminate :: HasLogFunc env => Process () Handle () -> RIO env ()
terminate processHandle = do
    liftIO $ terminateProcess (unsafeProcessHandle processHandle)
    log <- liftIO $ hGetContents (getStdout processHandle)
    logInfo $ display log