Haskell中的子进程的非阻塞读取

Question

写入标准输入并从子进程的标准输出中读取而不阻塞的最佳方式是什么？

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

例如，我在做非阻塞读取时的最佳尝试是timeout 1 $ hGetLine out，如果不存在要读取的行，则返回Just "some line"或Nothing。然而，这对我来说似乎是一种破绽，所以我正在寻找更“标准”的方式。

感谢

Answer 1

下面是如何在由@jberryman提到时尚衍生进程交互的一些例子。

该程序与脚本./compute简单地读取从stdin线路中的形式和<x> <y>ÿ秒的延迟之后返回X + 1相互作用。更多详情，请致电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?"