How can I poll a process for it's stdout / stderrr output? Blocked by isEOF

Question

The following example requires the packages of:

- text
- string-conversions
- process

Code:

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE LambdaCase #-}

module Example where

import qualified Data.Text as T
import Data.Text (Text)
import Data.Monoid
import Control.Monad.Identity
import System.Process
import GHC.IO.Handle
import Debug.Trace
import Data.String.Conversions

runGhci :: Text -> IO Text
runGhci _ =  do
  let expr = "print \"test\""
  let inputLines = (<> "\n") <$> T.lines expr :: [Text]
  print inputLines
  createProcess ((proc "ghci" ["-v0", "-ignore-dot-ghci"]) {std_in=CreatePipe, std_out=CreatePipe, std_err=CreatePipe}) >>= \case
    (Just pin, Just pout, Just perr, ph) -> do
      output <-
        forM inputLines (\i -> do
          let script = i <> "\n"
          do
            hPutStr pin $ cs $ script
            hFlush pin
            x <- hIsEOF pout >>= \case
              True -> return ""
              False -> hGetLine pout
            y <- hIsEOF perr >>= \case
              True -> return ""
              False -> hGetLine perr
            let output = cs $! x ++ y
            return $ trace "OUTPUT" $ output
        )
      let f i o = "ghci>" <> i <> o
      let final = T.concat ( zipWith f (inputLines :: [Text]) (output :: [Text]) :: [Text])
      print final
      terminateProcess ph
      pure $ T.strip $  final
    _ -> error "Invaild GHCI process"

If I attempt to run the above:

stack ghci src/Example.hs
ghci> :set -XOverloadedStrings
ghci> runGhci ""
["print \"test\"\n"]

It appears to be blocking on hIsEOF perr, according to https://stackoverflow.com/a/26510673/1663462 it sounds like I shouldn't call this function unless there is 'some output' ready to be flushed / read... However how do I handle the case where it does not have any output at that stage? I don't mind periodically 'checking' or having a timeout.

How can I prevent the above from hanging? I've tried various approaches involving hGetContents, hGetLine however they all seem to end up blocking (or closing the handle) in this situation...

https://stackoverflow.com/questions/33225837/non-blocking-read-from-subprocess-in-haskell I think I've found a solution at the above. — Chris Stryczynski, Mar 19 '18 at 19:50
[You fork a thread, then go ahead and block.](https://stackoverflow.com/questions/11744527/how-can-i-watch-multiple-files-socket-to-become-readable-writable-in-haskell) — Daniel Wagner, Mar 19 '18 at 19:52

Chris Stryczynski · Accepted Answer · 2018-03-21T21:31:09.077

I had to use additional threads, MVars, as well as timeouts:

runGhci :: Text -> IO Text
runGhci _ =  do
  let expr = "123 <$> 123"
  let inputLines = filter (/= "") (T.lines expr)
  print inputLines
  createProcess ((proc "ghci" ["-v0", "-ignore-dot-ghci"]) {std_in=CreatePipe, std_out=CreatePipe, std_err=CreatePipe}) >>= \case
    (Just pin, Just pout, Just perr, ph) -> do
      output <- do
        forM inputLines
          (\i -> do
              let script = "putStrLn " ++ show magic ++ "\n"
                            ++ cs i ++ "\n"
                            ++ "putStrLn " ++ show magic ++ "\n"
              do
                stdoutMVar <- newEmptyMVar
                stderrMVar <- newMVar ""
                hPutStr pin script
                hFlush pin
                tOutId <- forkIO $ extract' pout >>= putMVar stdoutMVar
                tErrId <- forkIO $ do
                  let f' = hGetLine perr >>= (\l -> modifyMVar_ stderrMVar (return . (++ (l ++ "\n"))))
                  forever f'
                x <- timeout (1 * (10^6)) (takeMVar stdoutMVar) >>= return . fromMaybe "***ghci timed out"
                y <- timeout (1 * (10^6)) (takeMVar stderrMVar) >>= return . fromMaybe "***ghci timed out"
                killThread tOutId
                killThread tErrId
                return $ trace "OUTPUT" $ cs $! x ++ y
          )
      let final = T.concat ( zipWith f (inputLines :: [Text]) (output :: [Text]) :: [Text])
      print final
      terminateProcess ph
      pure $ T.strip $ cs $ final
    _ -> error "Invaild GHCI process"

How can I poll a process for it's stdout / stderrr output? Blocked by isEOF

1 Answers1