module RawFilePath.Process.Utility
( callProcess
, readProcessWithExitCode
) where
import RawFilePath.Import
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as LB
import qualified Data.ByteString.Builder as B
import RawFilePath.Process.Common
import RawFilePath.Process.Basic
callProcess :: ProcessConf stdin stdout stderr -> IO ExitCode
callProcess conf = start >>= waitForProcess
where
start = startProcess conf
{ cfgStdin = NoStream
, cfgStdout = NoStream
, cfgStderr = NoStream
}
readProcessWithExitCode
:: ProcessConf stdin stdout stderr
-> IO (ExitCode, ByteString, ByteString)
readProcessWithExitCode conf = do
process <- startProcess conf
{ cfgStdin = NoStream
, cfgStdout = CreatePipe
, cfgStderr = CreatePipe
}
stdoutB <- hGetAll (processStdout process)
stderrB <- hGetAll (processStderr process)
exitCode <- waitForProcess process
return (exitCode, stdoutB, stderrB)
hGetAll :: Handle -> IO ByteString
hGetAll h = LB.toStrict . B.toLazyByteString <$> hGetAll' mempty h
where
hGetAll' acc h' = tryIOError (B.hGetContents h) >>= \ case
Left _ -> return acc
Right b -> hGetAll' (acc <> B.byteString b) h'