Haskell: start a long running process, silently, capturing stdout - haskell

Question

I have a long running process which I need to start.
It takes a few seconds to start, and outputs logs to stdout, with one that indicates it is ready.
I would like to:
start the process silently, so that the stdout from the process is not displayed in my session.
capture the output as it streams so that I can determine that it is ready.
have some handle on the process so that I can stop the process at a later point.
I have come close using Shelly, Turtle and System.Process, but fail to capture the stdout.
Using System.Process I had:
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
But The handler hout was never in a ready state.
Using Shelly I had:
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
But the recordWhenStarted is never called.

Answer 1

The following is example of starting process and reading 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

This answer uses the process-streaming library (written by the author of this answer) which is a set of helpers over process.
{-# 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 installs exception handlers that terminate the external process when an asynchronous exceptions arrives, to it is safe to use race with it.
execute also takes care to drain any standard stream that is not read explicitly (like stderr in this case) to avoid a common source of deadlocks.