module Yi.Process (popen, runProgCommand, runShellCommand, shellFileName,
createSubprocess, readAvailable, SubprocessInfo(..), SubprocessId) where
import System.Exit (ExitCode(ExitFailure))
import System.Directory (findExecutable)
import System.IO
import System.Process
import System.Environment ( getEnv )
import Control.Concurrent (forkIO)
import qualified Control.Exception (evaluate, handle, SomeException)
import Foreign.Marshal.Alloc(allocaBytes)
import Foreign.C.String
import Prelude(length)
import Control.Exc(orException)
import Yi.Prelude
import Yi.Buffer (BufferRef)
#ifndef mingw32_HOST_OS
import System.Posix.IO
#endif
popen :: FilePath -> [String] -> Maybe String -> IO (String,String,ExitCode)
popen file args minput =
Control.Exception.handle handler $ do
(inp,out,err,pid) <- runInteractiveProcess file args Nothing Nothing
hSetBuffering out LineBuffering
hSetBuffering err LineBuffering
case minput of
Just input -> hPutStr inp input >> hClose inp
Nothing -> return ()
output <- hGetContents out
errput <- hGetContents err
discard $ forkIO (Control.Exception.evaluate (length output) >> return ())
discard $ forkIO (Control.Exception.evaluate (length errput) >> return ())
exitCode <- waitForProcess pid
return (output,errput,exitCode)
where handler (e :: Control.Exception.SomeException) = return ([], show e, error (show e))
runProgCommand :: String -> [String] -> IO (String,String,ExitCode)
runProgCommand prog args = do loc <- findExecutable prog
case loc of
Nothing -> return ("","",ExitFailure 1)
Just fp -> popen fp args Nothing
shellFileName :: IO String
shellFileName = orException (getEnv "SHELL") (return "/bin/sh")
shellCommandSwitch :: String
shellCommandSwitch = "-c"
runShellCommand :: String -> IO (String,String,ExitCode)
runShellCommand cmd = do
sh <- shellFileName
popen sh [shellCommandSwitch, cmd] Nothing
type SubprocessId = Integer
data SubprocessInfo = SubprocessInfo {
procCmd :: FilePath,
procArgs :: [String],
procHandle :: ProcessHandle,
hIn :: Handle,
hOut :: Handle,
hErr :: Handle,
bufRef :: BufferRef,
separateStdErr :: Bool
}
createSubprocess :: FilePath -> [String] -> BufferRef -> IO SubprocessInfo
createSubprocess cmd args bufref = do
#ifdef mingw32_HOST_OS
(inp,out,err,handle) <- runInteractiveProcess cmd args Nothing Nothing
let separate = True
#else
(inpReadFd,inpWriteFd) <- createPipe
(outReadFd,outWriteFd) <- createPipe
[inpRead,inpWrite,outRead,outWrite] <- mapM fdToHandle [inpReadFd,inpWriteFd,outReadFd,outWriteFd]
handle <- runProcess cmd args Nothing Nothing (Just inpRead) (Just outWrite) (Just outWrite)
let inp = inpWrite
out = outRead
err = outRead
separate = False
#endif
hSetBuffering inp NoBuffering
hSetBuffering out NoBuffering
hSetBuffering err NoBuffering
return $ SubprocessInfo { procCmd=cmd, procArgs=args, procHandle=handle, hIn=inp, hOut=out, hErr=err, bufRef=bufref, separateStdErr=separate }
readAvailable :: Handle -> IO String
readAvailable handle = (fmap concat) $ repeatUntilM $ read_chunk handle
read_chunk :: Handle -> IO (Bool,String)
read_chunk handle = do
let bufferSize = 1024
allocaBytes bufferSize $ \buffer -> do
bytesRead <- hGetBufNonBlocking handle buffer bufferSize
s <- peekCStringLen (buffer,bytesRead)
let mightHaveMore = (bytesRead == bufferSize)
return (mightHaveMore, s)