如何在不阻塞Haskell中的线程的情况下从进程检索输出

Question

写入stdin并从子进程的stdout读取而不阻塞的最佳方法是什么？

子进程是通过System.IO.createProcess创建的，它返回用于写入和读取子进程的句柄。写作和阅读以文本格式完成。

例如，我进行非阻塞读取的最佳尝试是timeout 1 $ hGetLine out，如果不存在要读取的行，则返回Just "some line"或Nothing。然而，这对我来说似乎是一个黑客，所以我正在寻找更多的标准＆＃34;方式。

由于

Answer 1

以下是一些如何以@jberryman提到的方式与衍生过程进行交互的示例。

该程序与脚本./compute进行交互，该脚本只是以<x> <y>形式读取stdin中的行，并在 y 延迟后返回 x + 1 em>秒。更多详情请见this gist。

与衍生过程交互时有许多警告。为了避免“遭受缓冲”，您需要在发送输入时刷新传出管道，并且每次发送响应时，生成的进程都需要刷新stdout。如果您发现stdout没有及时刷新，则可以通过伪tty与进程交互。

此外，这些示例假设关闭输入管道将导致生成进程终止。如果不是这种情况，您将不得不向其发送信号以确保终止。

以下是示例代码 - 请参阅最后的main例程以获取示例调用。

import System.Environment
import System.Timeout (timeout)
import Control.Concurrent
import Control.Concurrent (forkIO, threadDelay, killThread)
import Control.Concurrent.MVar (newEmptyMVar, putMVar, takeMVar)

import System.Process
import System.IO

-- blocking IO
main1 cmd tmicros = do
  r <- createProcess (proc "./compute" []) { std_out = CreatePipe, std_in = CreatePipe }
  let (Just inp, Just outp, _, phandle) = r

  hSetBuffering inp NoBuffering
  hPutStrLn inp cmd     -- send a command

  -- block until the response is received
  contents <- hGetLine outp
  putStrLn $ "got: " ++ contents

  hClose inp            -- and close the pipe
  putStrLn "waiting for process to terminate"
  waitForProcess phandle

-- non-blocking IO, send one line, wait the timeout period for a response
main2 cmd tmicros = do
  r <- createProcess (proc "./compute" []) { std_out = CreatePipe, std_in = CreatePipe }
  let (Just inp, Just outp, _, phandle) = r

  hSetBuffering inp NoBuffering
  hPutStrLn inp cmd   -- send a command, will respond after 4 seconds

  mvar <- newEmptyMVar
  tid  <- forkIO $ hGetLine outp >>= putMVar mvar

  -- wait the timeout period for the response
  result <- timeout tmicros (takeMVar mvar)
  killThread tid

  case result of
    Nothing -> putStrLn "timed out"
    Just x  -> putStrLn $ "got: " ++ x

  hClose inp            -- and close the pipe
  putStrLn "waiting for process to terminate"
  waitForProcess phandle

-- non-block IO, send one line, report progress every timeout period
main3 cmd tmicros = do
  r <- createProcess (proc "./compute" []) { std_out = CreatePipe, std_in = CreatePipe }
  let (Just inp, Just outp, _, phandle) = r

  hSetBuffering inp NoBuffering
  hPutStrLn inp cmd   -- send command

  mvar <- newEmptyMVar
  tid  <- forkIO $ hGetLine outp >>= putMVar mvar

  -- loop until response received; report progress every timeout period
  let loop = do result <- timeout tmicros (takeMVar mvar)
                case result of
                  Nothing -> putStrLn  "still waiting..." >> loop
                  Just x  -> return x
  x <- loop
  killThread tid

  putStrLn $ "got: " ++ x

  hClose inp            -- and close the pipe
  putStrLn "waiting for process to terminate"
  waitForProcess phandle

{-

Usage: ./prog which delay timeout

  where
    which   = main routine to run: 1, 2 or 3
    delay   = delay in seconds to send to compute script
    timeout = timeout in seconds to wait for response

E.g.:

  ./prog 1 4 3   -- note: timeout is ignored for main1
  ./prog 2 2 3   -- should timeout
  ./prog 2 4 3   -- should get response
  ./prog 3 4 1   -- should see "still waiting..." a couple of times

-}

main = do
  (which : vtime : tout : _) <- fmap (map read) getArgs
  let cmd = "10 " ++ show vtime
      tmicros = 1000000*tout :: Int
  case which of
    1 -> main1 cmd tmicros
    2 -> main2 cmd tmicros
    3 -> main3 cmd tmicros
    _   -> error "huh?"