Haskell:启动一个长时间运行的进程，默默地捕获标准输出

Question

我有一个长时间运行的进程需要启动。 启动需要几秒钟，并将日志输出到标准输出，其中一条表明它已准备就绪。

我愿意:

• 以静默方式启动进程，以便进程的标准输出不会显示在我的 session 中。
• 捕获输出流，以便我可以确定它是否已准备就绪。
• 掌握该流程，以便我稍后可以停止该流程。

我已经接近使用 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