Захватить вывод при завершении процесса

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

Из документации дляstopProcess:

Закройте процесс и освободите все полученные ресурсы. Это обеспечит terminateProcess вызывается, дождитесь фактического завершения процесса, а затем закройте ресурсы, выделенные для потоков. В случае возникновения каких-либо исключений очистки это вызовет исключение.

(курсив мой) Вы не хотите 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