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.OldException as Control.Exception
import Foreign.Marshal.Alloc(allocaBytes)
import Foreign.C.String
import Yi.Buffer (BufferRef)
import Yi.Monad(repeatUntilM)
#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 (\e -> return ([],show e,error (show e))) $ 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
forkIO (Control.Exception.evaluate (length output) >> return ())
forkIO (Control.Exception.evaluate (length errput) >> return ())
exitCode <- waitForProcess pid
return (output,errput,exitCode)
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 = Prelude.catch (getEnv "SHELL") (const $ 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)