{-# LANGUAGE CPP #-}
{-# LANGUAGE ScopedTypeVariables #-}
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 :: String -> [String] -> IO (ExitCode, a, a)
runProgCommand String
prog [String]
args = do Maybe String
loc <- String -> IO (Maybe String)
findExecutable String
prog
case Maybe String
loc of
Maybe String
Nothing -> (ExitCode, a, a) -> IO (ExitCode, a, a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> ExitCode
ExitFailure Int
1, a
forall full item. ListLike full item => full
L.empty, a
forall full item. ListLike full item => full
L.empty)
Just String
fp -> String -> [String] -> a -> IO (ExitCode, a, a)
forall text char.
ListLikeProcessIO text char =>
String -> [String] -> text -> IO (ExitCode, text, text)
readProcessWithExitCode String
fp [String]
args a
forall full item. ListLike full item => full
L.empty
shellFileName :: IO String
shellFileName :: IO String
shellFileName = IO String -> IO String -> IO String
forall a. IO a -> IO a -> IO a
orException (String -> IO String
getEnv String
"SHELL") (String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return String
"/bin/sh")
shellCommandSwitch :: String
shellCommandSwitch :: String
shellCommandSwitch = String
"-c"
runShellCommand :: ListLikeProcessIO a c => String -> IO (ExitCode, a, a)
runShellCommand :: String -> IO (ExitCode, a, a)
runShellCommand String
cmd = do
String
sh <- IO String
shellFileName
String -> [String] -> a -> IO (ExitCode, a, a)
forall text char.
ListLikeProcessIO text char =>
String -> [String] -> text -> IO (ExitCode, text, text)
readProcessWithExitCode String
sh [String
shellCommandSwitch, String
cmd] a
forall full item. ListLike full item => full
L.empty
type SubprocessId = Integer
data SubprocessInfo = SubprocessInfo {
SubprocessInfo -> String
procCmd :: FilePath,
SubprocessInfo -> [String]
procArgs :: [String],
SubprocessInfo -> ProcessHandle
procHandle :: ProcessHandle,
SubprocessInfo -> Handle
hIn :: Handle,
SubprocessInfo -> Handle
hOut :: Handle,
SubprocessInfo -> Handle
hErr :: Handle,
SubprocessInfo -> BufferRef
bufRef :: BufferRef,
SubprocessInfo -> Bool
separateStdErr :: Bool
}
createSubprocess :: FilePath -> [String] -> BufferRef -> IO SubprocessInfo
createSubprocess :: String -> [String] -> BufferRef -> IO SubprocessInfo
createSubprocess String
cmd [String]
args BufferRef
bufref = do
#ifdef mingw32_HOST_OS
(inp,out,err,handle) <- runInteractiveProcess cmd args Nothing Nothing
let separate = True
#else
(Fd
inpReadFd,Fd
inpWriteFd) <- IO (Fd, Fd)
System.Posix.IO.createPipe
(Fd
outReadFd,Fd
outWriteFd) <- IO (Fd, Fd)
System.Posix.IO.createPipe
[Handle
inpRead,Handle
inpWrite,Handle
outRead,Handle
outWrite] <- (Fd -> IO Handle) -> [Fd] -> IO [Handle]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Fd -> IO Handle
fdToHandle [Fd
inpReadFd,Fd
inpWriteFd,Fd
outReadFd,Fd
outWriteFd]
ProcessHandle
handle <- String
-> [String]
-> Maybe String
-> Maybe [(String, String)]
-> Maybe Handle
-> Maybe Handle
-> Maybe Handle
-> IO ProcessHandle
runProcess String
cmd [String]
args Maybe String
forall a. Maybe a
Nothing Maybe [(String, String)]
forall a. Maybe a
Nothing (Handle -> Maybe Handle
forall a. a -> Maybe a
Just Handle
inpRead) (Handle -> Maybe Handle
forall a. a -> Maybe a
Just Handle
outWrite) (Handle -> Maybe Handle
forall a. a -> Maybe a
Just Handle
outWrite)
let inp :: Handle
inp = Handle
inpWrite
out :: Handle
out = Handle
outRead
err :: Handle
err = Handle
outRead
separate :: Bool
separate = Bool
False
#endif
Handle -> BufferMode -> IO ()
hSetBuffering Handle
inp BufferMode
NoBuffering
Handle -> BufferMode -> IO ()
hSetBuffering Handle
out BufferMode
NoBuffering
Handle -> BufferMode -> IO ()
hSetBuffering Handle
err BufferMode
NoBuffering
SubprocessInfo -> IO SubprocessInfo
forall (m :: * -> *) a. Monad m => a -> m a
return SubprocessInfo :: String
-> [String]
-> ProcessHandle
-> Handle
-> Handle
-> Handle
-> BufferRef
-> Bool
-> SubprocessInfo
SubprocessInfo { procCmd :: String
procCmd=String
cmd, procArgs :: [String]
procArgs=[String]
args, procHandle :: ProcessHandle
procHandle=ProcessHandle
handle, hIn :: Handle
hIn=Handle
inp, hOut :: Handle
hOut=Handle
out, hErr :: Handle
hErr=Handle
err, bufRef :: BufferRef
bufRef=BufferRef
bufref, separateStdErr :: Bool
separateStdErr=Bool
separate }
readAvailable :: Handle -> IO String
readAvailable :: Handle -> IO String
readAvailable Handle
handle = ([String] -> String) -> IO [String] -> IO String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (IO [String] -> IO String) -> IO [String] -> IO String
forall a b. (a -> b) -> a -> b
$ IO (Bool, String) -> IO [String]
forall (m :: * -> *) a. Monad m => m (Bool, a) -> m [a]
repeatUntilM (IO (Bool, String) -> IO [String])
-> IO (Bool, String) -> IO [String]
forall a b. (a -> b) -> a -> b
$ Handle -> IO (Bool, String)
readChunk Handle
handle
readChunk :: Handle -> IO (Bool, String)
readChunk :: Handle -> IO (Bool, String)
readChunk Handle
handle = do
let bufferSize :: Int
bufferSize = Int
1024
Int -> (Ptr CChar -> IO (Bool, String)) -> IO (Bool, String)
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
bufferSize ((Ptr CChar -> IO (Bool, String)) -> IO (Bool, String))
-> (Ptr CChar -> IO (Bool, String)) -> IO (Bool, String)
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
buffer -> do
Int
bytesRead <- Handle -> Ptr CChar -> Int -> IO Int
forall a. Handle -> Ptr a -> Int -> IO Int
hGetBufNonBlocking Handle
handle Ptr CChar
buffer Int
bufferSize
String
s <- CStringLen -> IO String
peekCStringLen (Ptr CChar
buffer,Int
bytesRead)
let mightHaveMore :: Bool
mightHaveMore = Int
bytesRead Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
bufferSize
(Bool, String) -> IO (Bool, String)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
mightHaveMore, String
s)