    {-# 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 :: forall a c.
    ListLikeProcessIO a c =>
    String -> [String] -> IO (ExitCode, a, a)
    runProgCommand String
    prog [String]
    args = do loc <- String -> IO (Maybe String)
    findExecutable String
    prog
                                  case loc of
                                      Maybe String
    Nothing -> (ExitCode, a, a) -> IO (ExitCode, a, a)
    forall a. a -> IO 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

    ------------------------------------------------------------------------
    -- | Run a command using the system shell, returning stdout, stderr and exit code

    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 a. a -> IO a
    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 :: forall a c. ListLikeProcessIO a c => String -> IO (ExitCode, a, a)
    runShellCommand String
    cmd = do
          sh <- IO String
    shellFileName
          readProcessWithExitCode sh [shellCommandSwitch, cmd] L.empty

    --------------------------------------------------------------------------------
    -- Subprocess support (ie. async processes whose output goes to a buffer)

    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
          }

    {-
    Simon Marlow said this:

     It turns out to be dead easy to bind stderr and stdout to the same pipe. After a couple of minor tweaks the following now works:

     createProcess (proc cmd args){ std_out = CreatePipe,
                                    std_err = UseHandle stdout }

    Therefore it should be possible to simplify the following greatly with the new process package.

    -}
    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
        (inpReadFd,inpWriteFd) <- IO (Fd, Fd)
    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 = Handle
    inpWrite
            out = Handle
    outRead
            err = Handle
    outRead
            separate = Bool
    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 }

    -- Read as much as possible from handle without blocking
    readAvailable :: Handle -> IO String
    readAvailable :: Handle -> IO String
    readAvailable Handle
    handle = ([String] -> String) -> IO [String] -> IO String
    forall a b. (a -> b) -> IO a -> IO b
    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

    -- Read a chunk from a handle, bool indicates if there is potentially more data available
    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
                     bytesRead <- Handle -> Ptr CChar -> Int -> IO Int
    forall a. Handle -> Ptr a -> Int -> IO Int
    hGetBufNonBlocking Handle
    handle Ptr CChar
    buffer Int
    bufferSize
                     s <- peekCStringLen (buffer,bytesRead)
                     let mightHaveMore = Int
    bytesRead Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    bufferSize
                     return (mightHaveMore, s)