module GF.System.Process where
import System.Process
import System.IO(hGetContents,hClose,hPutStr)
import Control.Concurrent(forkIO)
import GF.System.Catch(try)

-- | Feed some input to a shell process and read the output lazily
readShellProcess :: String     -- ^ shell command
                  -> String    -- ^ input to shell command
                  -> IO String -- ^ output from shell command
readShellProcess :: String -> String -> IO String
readShellProcess String
cmd String
input =
  do (Just Handle
stdin,Just Handle
stdout,Maybe Handle
Nothing,ProcessHandle
ph) <-
         CreateProcess
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
createProcess (String -> CreateProcess
shell String
cmd){std_in :: StdStream
std_in=StdStream
CreatePipe,std_out :: StdStream
std_out=StdStream
CreatePipe}
     IO () -> IO ThreadId
forkIO (IO () -> IO ThreadId) -> IO () -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ do IO () -> IO (Either IOError ())
forall a. IO a -> IO (Either IOError a)
try (IO () -> IO (Either IOError ()))
-> IO () -> IO (Either IOError ())
forall a b. (a -> b) -> a -> b
$ Handle -> String -> IO ()
hPutStr Handle
stdin String
input
                 IO () -> IO (Either IOError ())
forall a. IO a -> IO (Either IOError a)
try (IO () -> IO (Either IOError ()))
-> IO () -> IO (Either IOError ())
forall a b. (a -> b) -> a -> b
$ Handle -> IO ()
hClose Handle
stdin
                 ProcessHandle -> IO ExitCode
waitForProcess ProcessHandle
ph
                 () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     Handle -> IO String
hGetContents Handle
stdout