module Data.Streaming.Process
(
streamingProcess
, Inherited (..)
, ClosedStream (..)
, UseProvidedHandle (..)
, StreamingProcessHandle
, waitForStreamingProcess
, waitForStreamingProcessSTM
, getStreamingProcessExitCode
, getStreamingProcessExitCodeSTM
, streamingProcessHandleRaw
, streamingProcessHandleTMVar
, InputSource
, OutputSink
, module System.Process
) where
import Control.Applicative ((<$>), (<*>))
import Control.Concurrent (forkIO)
import Control.Concurrent.STM (STM, TMVar, atomically,
newEmptyTMVar, putTMVar,
readTMVar, tryReadTMVar)
import Control.Monad.IO.Class (MonadIO, liftIO)
import Data.Maybe (fromMaybe)
import Data.Streaming.Process.Internal
import System.Exit (ExitCode)
import System.IO (hClose)
import System.Process
data UseProvidedHandle = UseProvidedHandle
data Inherited = Inherited
data ClosedStream = ClosedStream
instance InputSource ClosedStream where
isStdStream = (\(Just h) -> hClose h >> return ClosedStream, Just CreatePipe)
instance InputSource Inherited where
isStdStream = (\Nothing -> return Inherited, Just Inherit)
instance InputSource UseProvidedHandle where
isStdStream = (\Nothing -> return UseProvidedHandle, Nothing)
instance OutputSink ClosedStream where
osStdStream = (\(Just h) -> hClose h >> return ClosedStream, Just CreatePipe)
instance OutputSink Inherited where
osStdStream = (\Nothing -> return Inherited, Just Inherit)
instance OutputSink UseProvidedHandle where
osStdStream = (\Nothing -> return UseProvidedHandle, Nothing)
waitForStreamingProcess :: MonadIO m => StreamingProcessHandle -> m ExitCode
waitForStreamingProcess = liftIO . atomically . waitForStreamingProcessSTM
waitForStreamingProcessSTM :: StreamingProcessHandle -> STM ExitCode
waitForStreamingProcessSTM = readTMVar . streamingProcessHandleTMVar
getStreamingProcessExitCode :: MonadIO m => StreamingProcessHandle -> m (Maybe ExitCode)
getStreamingProcessExitCode = liftIO . atomically . getStreamingProcessExitCodeSTM
getStreamingProcessExitCodeSTM :: StreamingProcessHandle -> STM (Maybe ExitCode)
getStreamingProcessExitCodeSTM = tryReadTMVar . streamingProcessHandleTMVar
streamingProcessHandleRaw :: StreamingProcessHandle -> ProcessHandle
streamingProcessHandleRaw (StreamingProcessHandle ph _) = ph
streamingProcessHandleTMVar :: StreamingProcessHandle -> TMVar ExitCode
streamingProcessHandleTMVar (StreamingProcessHandle _ var) = var
streamingProcess :: (MonadIO m, InputSource stdin, OutputSink stdout, OutputSink stderr)
=> CreateProcess
-> m (stdin, stdout, stderr, StreamingProcessHandle)
streamingProcess cp = liftIO $ do
let (getStdin, stdinStream) = isStdStream
(getStdout, stdoutStream) = osStdStream
(getStderr, stderrStream) = osStdStream
(stdinH, stdoutH, stderrH, ph) <- createProcess cp
{ std_in = fromMaybe (std_in cp) stdinStream
, std_out = fromMaybe (std_out cp) stdoutStream
, std_err = fromMaybe (std_err cp) stderrStream
}
ec <- atomically newEmptyTMVar
_ <- forkIO $ waitForProcess ph >>= atomically . putTMVar ec
(,,,)
<$> getStdin stdinH
<*> getStdout stdoutH
<*> getStderr stderrH
<*> return (StreamingProcessHandle ph ec)