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?"