module Data.IterIO.Process
( enumProcess
, cmd
) where
import Data.ByteString.Lazy (ByteString)
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as B8
import qualified Data.ByteString.Lazy as L
import System.Process hiding (readProcess)
import System.IO(hClose, hFlush, Handle)
import System.Exit(ExitCode(ExitFailure))
import Control.Monad.IO.Class(liftIO, MonadIO)
import Data.IterIO
import Control.Exception(ErrorCall(ErrorCall))
enumProcess :: FilePath -> [String] -> Onum ByteString IO a
enumProcess p args = inumBracket (mkProc p args) cleanup procInum_
cmd :: MonadIO m => FilePath -> [String] -> Inum ByteString ByteString m a
cmd p args = inumBracket (mkProc p args) cleanup procInum
mkProc :: MonadIO m => FilePath -> [String] -> m (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
mkProc p args = liftIO $ do
createProcess (proc p args){
std_in = CreatePipe
, std_out = CreatePipe
, std_err = CreatePipe
}
cleanup :: MonadIO m => (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle) -> m ()
cleanup (Just i, Just o, Just e, _) = liftIO $ do
hClose i
hClose o
hClose e
cleanup _ = error "the impossible happened"
procInum :: (MonadIO m) => (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle) -> Inum ByteString ByteString m a
procInum (Just i, Just o, Just e, pid) = mkInumM loop
where
loop = do
Chunk t eof <- chunkI
liftIO $ L.hPut i t
if eof
then liftIO $ hClose i
else liftIO $ hFlush i
done <- feedStdout i o e pid
if done
then return L.empty
else loop
procInum _ = error "unsupported configuration"
procInum_ :: (MonadIO m) => (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle) -> Onum ByteString m a
procInum_ (Just i, Just o, Just e, pid) = mkInumM loop
where
loop = do
done <- feedStdout i o e pid
if done
then return L.empty
else loop
procInum_ _ = error "unsupported configuration"
feedStdout i o e pid = do
liftIO $ hClose i
maybeExitCode <- liftIO $ getProcessExitCode pid
case maybeExitCode of
Just (ExitFailure _) -> do
msg <- liftIO $ B.hGetContents e
throwI (ErrorCall (B8.unpack msg))
_ -> return ()
output <- liftIO $ L.hGetNonBlocking o 1024
notListening <- ifeed output
return $ notListening || maybeExitCode /= Nothing