Haskell：長期間にわたるプロセスを静かに開始し、stdoutをキャプチャします

Question

私は起動が必要な長い実行プロセスがあります。 起動には数秒かかり、ログはstdoutに出力されます。

私はしたいと思います：プロセスからのstdoutが私のセッションで表示されないように

は、黙ってプロセスを開始
• 。
• 出力がストリームとしてキャプチャされ、準備ができていると判断できるようになります。
• プロセスのハンドルがあるので、後でプロセスを停止できます。

Shelly、Turtle、およびSystem.Processを使用して近づいてきましたが、標準出力をキャプチャできません。私が持っていたSystem.Process使用

：

import Control.Concurrent (threadDelay) 
import Control.Concurrent.Async (race) 
import System.IO 
import System.Process 

startService :: IO ProcessHandle 
startService = do 
    let cmd = "./my-service" 
     args = [ "-p 1234" ] 
    (_, Just hout, _, p) <- createProcess $ (proc cmd args) { std_out = CreatePipe } 
    started <- either id id <$> race (checkStarted hout) timeOut 
    unless started $ fail "Service not started" 
    pure p 
    where 
    checkStarted :: Handle -> IO Bool 
    checkStarted h = do 
     str <- hGetLine h 
     -- check str for started log, else loop 

    timeOut :: IO Bool 
    timeOut = do 
     threadDelay 10000000 
     pure False 

しかしハンドラhoutはレディ状態ではなかったです。シェリーを使用して

は私が持っていた：

import Control.Concurrent (threadDelay) 
import Control.Concurrent.Async (race) 
import Control.Concurrent.MVar 
import Shelly 
import System.IO 

startService :: IO (Async()) 
startService = do 
    let cmd = "./my-service" 
     args = [ "-p 1234" ] 
    startedMVar <- newEmptyMVar 
    async <- shelly $ asyncSh $ runHandle cmd args $ recordWhenStarted startedMVar 
    started <- either id id <$> race (readMVar startedMVar) timeOut 
    unless started $ fail "Service not started" 
    pure async 
    where 
    recordWhenStarted :: MVar Bool -> Text -> IO() 
    recordWhenStarted mvar txt = 
     when (isStartedLog txt) $ 
     modifyMVar_ mvar (const $ pure True) 

    timeOut :: IO Bool 
    timeOut = do 
     threadDelay 10000000 
     pure False 

しかしrecordWhenStartedが呼び出されることはありません。

Answer 1

次のプロセスを開始するとstdout in a program of mineを読み取る例です：

runMystem :: [T.Text] -> IO T.Text 
    runMystem stemWords = do 
    (i, o, _, ph) <- createProcess (proc mystemExecutabe mystemParams) { std_in = CreatePipe, std_out = CreatePipe } 
    res <- flip (maybe (return T.empty)) i $ \hIn -> 
       flip (maybe (return T.empty)) o $ \hOut -> do 
       hSetEncoding hIn utf8 
       hSetEncoding hOut utf8 
       forM_ stemWords $ TIO.hPutStrLn hIn 
       TIO.hGetContents hOut 
    void $ waitForProcess ph 
    return res 

Answer 2

この答えはprocessオーバーヘルパーのセットです（この答えの著者によって書かれた）process-streamingライブラリを使用しています。

{-# language OverloadedStrings #-} 
{-# language NumDecimals #-} 
import   System.Process.Streaming (execute,piped,shell,foldOut,transduce1) 
import qualified System.Process.Streaming.Text as PT 
import   Data.Text.Lazy (isInfixOf) 
import   Control.Applicative 
import   Control.Monad 
import   Control.Concurrent (threadDelay) 
import   Control.Concurrent.Async 
import   Control.Concurrent.MVar 

main :: IO() 
main = do 
    started <- newEmptyMVar 
    let execution = 
      execute (piped (shell "{ sleep 3 ; echo fooo ; sleep 3 ; }")) $ 
       foldOut . transduce1 PT.utf8x . PT.eachLine $ lookline 
     lookline line = do 
      when (isInfixOf "foo" line) (putMVar started()) 
      return (Right()) 
     stopOrNot = 
      do abort <- race (threadDelay 4e6) (readMVar started) 
       case abort of 
        Left() -> return() -- stop immediately 
        Right() -> runConcurrently empty -- sleep forever 
    result <- race stopOrNot execution 
    print result 

executeは、それでraceを使用しても安全であると非同期例外は、到着したときに外部プロセスを終了する例外ハンドラをインストールします。

executeもデッドロックの共通のソースを避けるために、（この場合は標準エラー出力のように）明示的に読まれていない任意の標準ストリームを排出するように注意を要します。