module Yi.Process (runProgCommand, runShellCommand, shellFileName,
createSubprocess, readAvailable, SubprocessInfo(..), SubprocessId) where
import Control.Exc (orException)
import qualified Data.ListLike as L (empty)
import Foreign.C.String (peekCStringLen)
import Foreign.Marshal.Alloc (allocaBytes)
import System.Directory (findExecutable)
import System.Environment (getEnv)
import System.Exit (ExitCode (ExitFailure))
import System.IO (BufferMode (NoBuffering), Handle, hSetBuffering, hGetBufNonBlocking)
import System.Process (ProcessHandle, runProcess)
import System.Process.ListLike (ListLikeProcessIO, readProcessWithExitCode)
import Yi.Buffer.Basic (BufferRef)
import Yi.Monad (repeatUntilM)
#ifdef mingw32_HOST_OS
import System.Process (runInteractiveProcess)
#else
import System.Posix.IO (createPipe, fdToHandle)
#endif
runProgCommand :: ListLikeProcessIO a c => String -> [String] -> IO (ExitCode, a, a)
runProgCommand prog args = do loc <- findExecutable prog
case loc of
Nothing -> return (ExitFailure 1, L.empty, L.empty)
Just fp -> readProcessWithExitCode fp args L.empty
shellFileName :: IO String
shellFileName = orException (getEnv "SHELL") (return "/bin/sh")
shellCommandSwitch :: String
shellCommandSwitch = "-c"
runShellCommand :: ListLikeProcessIO a c => String -> IO (ExitCode, a, a)
runShellCommand cmd = do
sh <- shellFileName
readProcessWithExitCode sh [shellCommandSwitch, cmd] L.empty
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) <- System.Posix.IO.createPipe
(outReadFd,outWriteFd) <- System.Posix.IO.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 $ readChunk handle
readChunk :: Handle -> IO (Bool, String)
readChunk 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)