module RawFilePath.Process.Utility
    ( callProcess
    , readProcessWithExitCode
    ) where

-- base modules

import RawFilePath.Import

-- extra modules

import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as LB
import qualified Data.ByteString.Builder as B

-- local modules

import RawFilePath.Process.Common
import RawFilePath.Process.Basic

-- | Create a new process with the given configuration, and wait for it to
-- finish.
callProcess :: ProcessConf stdin stdout stderr -> IO ExitCode
callProcess :: ProcessConf stdin stdout stderr -> IO ExitCode
callProcess ProcessConf stdin stdout stderr
conf = IO (Process NoStream NoStream NoStream)
start IO (Process NoStream NoStream NoStream)
-> (Process NoStream NoStream NoStream -> IO ExitCode)
-> IO ExitCode
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Process NoStream NoStream NoStream -> IO ExitCode
forall stdin stdout stderr.
Process stdin stdout stderr -> IO ExitCode
waitForProcess
  where
    start :: IO (Process NoStream NoStream NoStream)
start = ProcessConf NoStream NoStream NoStream
-> IO (Process NoStream NoStream NoStream)
forall stdin stdout stderr.
(StreamType stdin, StreamType stdout, StreamType stderr) =>
ProcessConf stdin stdout stderr -> IO (Process stdin stdout stderr)
startProcess ProcessConf stdin stdout stderr
conf
        { cfgStdin :: NoStream
cfgStdin = NoStream
NoStream
        , cfgStdout :: NoStream
cfgStdout = NoStream
NoStream
        , cfgStderr :: NoStream
cfgStderr = NoStream
NoStream
        }

-- | Fork an external process, read its standard output and standard error
-- strictly, blocking until the process terminates, and return them with the
-- process exit code.
readProcessWithExitCode
    :: ProcessConf stdin stdout stderr
    -> IO (ExitCode, ByteString, ByteString)
readProcessWithExitCode :: ProcessConf stdin stdout stderr
-> IO (ExitCode, ByteString, ByteString)
readProcessWithExitCode ProcessConf stdin stdout stderr
conf = do
    Process NoStream CreatePipe CreatePipe
process <- ProcessConf NoStream CreatePipe CreatePipe
-> IO (Process NoStream CreatePipe CreatePipe)
forall stdin stdout stderr.
(StreamType stdin, StreamType stdout, StreamType stderr) =>
ProcessConf stdin stdout stderr -> IO (Process stdin stdout stderr)
startProcess ProcessConf stdin stdout stderr
conf
        { cfgStdin :: NoStream
cfgStdin = NoStream
NoStream
        , cfgStdout :: CreatePipe
cfgStdout = CreatePipe
CreatePipe
        , cfgStderr :: CreatePipe
cfgStderr = CreatePipe
CreatePipe
        }
    ByteString
stdoutB <- Handle -> IO ByteString
hGetAll (Process NoStream CreatePipe CreatePipe -> Handle
forall stdin stderr. Process stdin CreatePipe stderr -> Handle
processStdout Process NoStream CreatePipe CreatePipe
process)
    ByteString
stderrB <- Handle -> IO ByteString
hGetAll (Process NoStream CreatePipe CreatePipe -> Handle
forall stdin stdout. Process stdin stdout CreatePipe -> Handle
processStderr Process NoStream CreatePipe CreatePipe
process)
    ExitCode
exitCode <- Process NoStream CreatePipe CreatePipe -> IO ExitCode
forall stdin stdout stderr.
Process stdin stdout stderr -> IO ExitCode
waitForProcess Process NoStream CreatePipe CreatePipe
process
    (ExitCode, ByteString, ByteString)
-> IO (ExitCode, ByteString, ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (ExitCode
exitCode, ByteString
stdoutB, ByteString
stderrB)

-- utility functions

-- Read from Handle until IOError
hGetAll :: Handle -> IO ByteString
hGetAll :: Handle -> IO ByteString
hGetAll Handle
h = ByteString -> ByteString
LB.toStrict (ByteString -> ByteString)
-> (Builder -> ByteString) -> Builder -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
B.toLazyByteString (Builder -> ByteString) -> IO Builder -> IO ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Builder -> Handle -> IO Builder
forall t. Builder -> t -> IO Builder
hGetAll' Builder
forall a. Monoid a => a
mempty Handle
h
  where
    hGetAll' :: Builder -> t -> IO Builder
hGetAll' Builder
acc t
h' = IO ByteString -> IO (Either IOError ByteString)
forall a. IO a -> IO (Either IOError a)
tryIOError (Handle -> IO ByteString
B.hGetContents Handle
h) IO (Either IOError ByteString)
-> (Either IOError ByteString -> IO Builder) -> IO Builder
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ case
        Left IOError
_ -> Builder -> IO Builder
forall (m :: * -> *) a. Monad m => a -> m a
return Builder
acc
        Right ByteString
b -> Builder -> t -> IO Builder
hGetAll' (Builder
acc Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
B.byteString ByteString
b) t
h'