{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
-- | A full tutorial for this module is available at:
-- <https://github.com/snoyberg/conduit/blob/master/PROCESS.md>.
--
-- Note that, while the tutorial covers @Data.Conduit.Process@, that module closely
-- follows the present one, and almost all concepts in the tutorial apply here.
module Data.Streaming.Process
    ( -- * Functions
      streamingProcess
    , closeStreamingProcessHandle
      -- * Specialized streaming types
    , Inherited (..)
    , ClosedStream (..)
    , UseProvidedHandle (..)
      -- * Process handle
    , StreamingProcessHandle
    , waitForStreamingProcess
    , waitForStreamingProcessSTM
    , getStreamingProcessExitCode
    , getStreamingProcessExitCodeSTM
    , streamingProcessHandleRaw
    , streamingProcessHandleTMVar
      -- * Type classes
    , InputSource
    , OutputSink
      -- * Checked processes
    , withCheckedProcess
    , ProcessExitedUnsuccessfully (..)
      -- * Reexport
    , module System.Process
    ) where

import           Control.Applicative             as A ((<$>), (<*>))
import           Control.Concurrent              (forkIOWithUnmask)
import           Control.Concurrent.STM          (STM, TMVar, atomically,
                                                  newEmptyTMVar, putTMVar,
                                                  readTMVar)
import           Control.Exception               (Exception, throwIO, try, throw,
                                                  SomeException, finally)
import           Control.Monad.IO.Class          (MonadIO, liftIO)
import           Data.Maybe                      (fromMaybe)
import           Data.Streaming.Process.Internal
import           Data.Typeable                   (Typeable)
import           System.Exit                     (ExitCode (ExitSuccess))
import           System.IO                       (hClose)
import           System.Process

#if MIN_VERSION_process(1,2,0)
import qualified System.Process.Internals        as PI
#endif

#if MIN_VERSION_stm(2,3,0)
import           Control.Concurrent.STM          (tryReadTMVar)
#else
import           Control.Concurrent.STM          (tryTakeTMVar, putTMVar)

tryReadTMVar :: TMVar a -> STM (Maybe a)
tryReadTMVar var = do
    mx <- tryTakeTMVar var
    case mx of
        Nothing -> return ()
        Just x -> putTMVar var x
    return mx
#endif

-- | Use the @Handle@ provided by the @CreateProcess@ value. This would allow
-- you, for example, to open up a @Handle@ to a file, set it as @std_out@, and
-- avoid any additional overhead of dealing with providing that data to your
-- process.
--
-- Since 0.1.4
data UseProvidedHandle = UseProvidedHandle

-- | Inherit the stream from the current process.
--
-- Since 0.1.4
data Inherited = Inherited

-- | Close the stream with the child process.
--
-- You usually do not want to use this, as it will leave the corresponding file
-- descriptor unassigned and hence available for re-use in the child process.
--
-- Since 0.1.4
data ClosedStream = ClosedStream

instance InputSource ClosedStream where
    isStdStream :: (Maybe Handle -> IO ClosedStream, Maybe StdStream)
isStdStream = (\(Just Handle
h) -> Handle -> IO ()
hClose Handle
h forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return ClosedStream
ClosedStream, forall a. a -> Maybe a
Just StdStream
CreatePipe)
instance InputSource Inherited where
    isStdStream :: (Maybe Handle -> IO Inherited, Maybe StdStream)
isStdStream = (\Maybe Handle
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return Inherited
Inherited, forall a. a -> Maybe a
Just StdStream
Inherit)
instance InputSource UseProvidedHandle where
    isStdStream :: (Maybe Handle -> IO UseProvidedHandle, Maybe StdStream)
isStdStream = (\Maybe Handle
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return UseProvidedHandle
UseProvidedHandle, forall a. Maybe a
Nothing)

instance OutputSink ClosedStream where
    osStdStream :: (Maybe Handle -> IO ClosedStream, Maybe StdStream)
osStdStream = (\(Just Handle
h) -> Handle -> IO ()
hClose Handle
h forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return ClosedStream
ClosedStream, forall a. a -> Maybe a
Just StdStream
CreatePipe)
instance OutputSink Inherited where
    osStdStream :: (Maybe Handle -> IO Inherited, Maybe StdStream)
osStdStream = (\Maybe Handle
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return Inherited
Inherited, forall a. a -> Maybe a
Just StdStream
Inherit)
instance OutputSink UseProvidedHandle where
    osStdStream :: (Maybe Handle -> IO UseProvidedHandle, Maybe StdStream)
osStdStream = (\Maybe Handle
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return UseProvidedHandle
UseProvidedHandle, forall a. Maybe a
Nothing)

-- | Blocking call to wait for a process to exit.
--
-- Since 0.1.4
waitForStreamingProcess :: MonadIO m => StreamingProcessHandle -> m ExitCode
waitForStreamingProcess :: forall (m :: * -> *).
MonadIO m =>
StreamingProcessHandle -> m ExitCode
waitForStreamingProcess = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. STM a -> IO a
atomically forall b c a. (b -> c) -> (a -> b) -> a -> c
. StreamingProcessHandle -> STM ExitCode
waitForStreamingProcessSTM

-- | STM version of @waitForStreamingProcess@.
--
-- Since 0.1.4
waitForStreamingProcessSTM :: StreamingProcessHandle -> STM ExitCode
waitForStreamingProcessSTM :: StreamingProcessHandle -> STM ExitCode
waitForStreamingProcessSTM = forall a. TMVar a -> STM a
readTMVar forall b c a. (b -> c) -> (a -> b) -> a -> c
. StreamingProcessHandle -> TMVar ExitCode
streamingProcessHandleTMVar

-- | Non-blocking call to check for a process exit code.
--
-- Since 0.1.4
getStreamingProcessExitCode :: MonadIO m => StreamingProcessHandle -> m (Maybe ExitCode)
getStreamingProcessExitCode :: forall (m :: * -> *).
MonadIO m =>
StreamingProcessHandle -> m (Maybe ExitCode)
getStreamingProcessExitCode = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. STM a -> IO a
atomically forall b c a. (b -> c) -> (a -> b) -> a -> c
.  StreamingProcessHandle -> STM (Maybe ExitCode)
getStreamingProcessExitCodeSTM

-- | STM version of @getStreamingProcessExitCode@.
--
-- Since 0.1.4
getStreamingProcessExitCodeSTM :: StreamingProcessHandle -> STM (Maybe ExitCode)
getStreamingProcessExitCodeSTM :: StreamingProcessHandle -> STM (Maybe ExitCode)
getStreamingProcessExitCodeSTM = forall a. TMVar a -> STM (Maybe a)
tryReadTMVar forall b c a. (b -> c) -> (a -> b) -> a -> c
. StreamingProcessHandle -> TMVar ExitCode
streamingProcessHandleTMVar

-- | Get the raw @ProcessHandle@ from a @StreamingProcessHandle@. Note that
-- you should avoid using this to get the process exit code, and instead
-- use the provided functions.
--
-- Since 0.1.4
streamingProcessHandleRaw :: StreamingProcessHandle -> ProcessHandle
streamingProcessHandleRaw :: StreamingProcessHandle -> ProcessHandle
streamingProcessHandleRaw (StreamingProcessHandle ProcessHandle
ph TMVar ExitCode
_ IO ()
_) = ProcessHandle
ph

-- | Get the @TMVar@ storing the process exit code. In general, one of the
-- above functions should be used instead to avoid accidentally corrupting the variable\'s state..
--
-- Since 0.1.4
streamingProcessHandleTMVar :: StreamingProcessHandle -> TMVar ExitCode
streamingProcessHandleTMVar :: StreamingProcessHandle -> TMVar ExitCode
streamingProcessHandleTMVar (StreamingProcessHandle ProcessHandle
_ TMVar ExitCode
var IO ()
_) = TMVar ExitCode
var

-- | The primary function for running a process. Note that, with the
-- exception of 'UseProvidedHandle', the values for @std_in@, @std_out@
-- and @std_err@ will be ignored by this function.
--
-- Since 0.1.4
streamingProcess :: (MonadIO m, InputSource stdin, OutputSink stdout, OutputSink stderr)
               => CreateProcess
               -> m (stdin, stdout, stderr, StreamingProcessHandle)
streamingProcess :: forall (m :: * -> *) stdin stdout stderr.
(MonadIO m, InputSource stdin, OutputSink stdout,
 OutputSink stderr) =>
CreateProcess -> m (stdin, stdout, stderr, StreamingProcessHandle)
streamingProcess CreateProcess
cp = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
    let (Maybe Handle -> IO stdin
getStdin, Maybe StdStream
stdinStream) = forall a. InputSource a => (Maybe Handle -> IO a, Maybe StdStream)
isStdStream
        (Maybe Handle -> IO stdout
getStdout, Maybe StdStream
stdoutStream) = forall a. OutputSink a => (Maybe Handle -> IO a, Maybe StdStream)
osStdStream
        (Maybe Handle -> IO stderr
getStderr, Maybe StdStream
stderrStream) = forall a. OutputSink a => (Maybe Handle -> IO a, Maybe StdStream)
osStdStream

#if MIN_VERSION_process(1,2,0)
    (Maybe Handle
stdinH, Maybe Handle
stdoutH, Maybe Handle
stderrH, ProcessHandle
ph) <- String
-> CreateProcess
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
PI.createProcess_ String
"streamingProcess" CreateProcess
cp
#else
    (stdinH, stdoutH, stderrH, ph) <- createProcess cp
#endif
        { std_in :: StdStream
std_in = forall a. a -> Maybe a -> a
fromMaybe (CreateProcess -> StdStream
std_in CreateProcess
cp) Maybe StdStream
stdinStream
        , std_out :: StdStream
std_out = forall a. a -> Maybe a -> a
fromMaybe (CreateProcess -> StdStream
std_out CreateProcess
cp) Maybe StdStream
stdoutStream
        , std_err :: StdStream
std_err = forall a. a -> Maybe a -> a
fromMaybe (CreateProcess -> StdStream
std_err CreateProcess
cp) Maybe StdStream
stderrStream
        }

    TMVar ExitCode
ec <- forall a. STM a -> IO a
atomically forall a. STM (TMVar a)
newEmptyTMVar
    -- Apparently waitForProcess can throw an exception itself when
    -- delegate_ctlc is True, so to avoid this TMVar from being left empty, we
    -- capture any exceptions and store them as an impure exception in the
    -- TMVar
    ThreadId
_ <- ((forall a. IO a -> IO a) -> IO ()) -> IO ThreadId
forkIOWithUnmask forall a b. (a -> b) -> a -> b
$ \forall a. IO a -> IO a
_unmask -> forall e a. Exception e => IO a -> IO (Either e a)
try (ProcessHandle -> IO ExitCode
waitForProcess ProcessHandle
ph)
        forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. STM a -> IO a
atomically
          forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. TMVar a -> a -> STM ()
putTMVar TMVar ExitCode
ec
          forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
              (forall a e. Exception e => e -> a
throw :: SomeException -> a)
              forall a. a -> a
id

    let close :: IO ()
close =
            Maybe Handle -> IO ()
mclose Maybe Handle
stdinH forall a b. IO a -> IO b -> IO a
`finally` Maybe Handle -> IO ()
mclose Maybe Handle
stdoutH forall a b. IO a -> IO b -> IO a
`finally` Maybe Handle -> IO ()
mclose Maybe Handle
stderrH
          where
            mclose :: Maybe Handle -> IO ()
mclose = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. Monad m => a -> m a
return ()) Handle -> IO ()
hClose

    (,,,)
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
A.<$> Maybe Handle -> IO stdin
getStdin Maybe Handle
stdinH
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
A.<*> Maybe Handle -> IO stdout
getStdout Maybe Handle
stdoutH
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe Handle -> IO stderr
getStderr Maybe Handle
stderrH
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a. Monad m => a -> m a
return (ProcessHandle -> TMVar ExitCode -> IO () -> StreamingProcessHandle
StreamingProcessHandle ProcessHandle
ph TMVar ExitCode
ec IO ()
close)

-- | Free any resources (e.g. @Handle@s) acquired by a call to 'streamingProcess'.
--
-- @since 0.1.16
closeStreamingProcessHandle :: MonadIO m => StreamingProcessHandle -> m ()
closeStreamingProcessHandle :: forall (m :: * -> *). MonadIO m => StreamingProcessHandle -> m ()
closeStreamingProcessHandle (StreamingProcessHandle ProcessHandle
_ TMVar ExitCode
_ IO ()
f) = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO ()
f

-- | Indicates that a process exited with an non-success exit code.
--
-- Since 0.1.7
data ProcessExitedUnsuccessfully = ProcessExitedUnsuccessfully CreateProcess ExitCode
    deriving Typeable
instance Show ProcessExitedUnsuccessfully where
    show :: ProcessExitedUnsuccessfully -> String
show (ProcessExitedUnsuccessfully CreateProcess
cp ExitCode
ec) = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        [ String
"Process exited with "
        , forall a. Show a => a -> String
show ExitCode
ec
        , String
": "
        , CmdSpec -> String
showCmdSpec (CreateProcess -> CmdSpec
cmdspec CreateProcess
cp)
        ]
      where
        showCmdSpec :: CmdSpec -> String
showCmdSpec (ShellCommand String
str) = String
str
        showCmdSpec (RawCommand String
x [String]
xs) = [String] -> String
unwords (String
xforall a. a -> [a] -> [a]
:forall a b. (a -> b) -> [a] -> [b]
map ShowS
showArg [String]
xs)

        -- Ensure that strings that need to be escaped are
        showArg :: ShowS
showArg String
x
            | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\Char
c -> Char
c forall a. Eq a => a -> a -> Bool
== Char
'"' Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
' ') String
x = forall a. Show a => a -> String
show String
x
            | Bool
otherwise = String
x
instance Exception ProcessExitedUnsuccessfully

-- | Run a process and supply its streams to the given callback function. After
-- the callback completes, wait for the process to complete and check its exit
-- code. If the exit code is not a success, throw a
-- 'ProcessExitedUnsuccessfully'.
--
-- NOTE: This function does not kill the child process or ensure
-- resources are cleaned up in the event of an exception from the
-- provided function. For that, please use @withCheckedProcessCleanup@
-- from the @conduit-extra@ package.
--
-- Since 0.1.7
withCheckedProcess :: ( InputSource stdin
                      , OutputSink stderr
                      , OutputSink stdout
                      , MonadIO m
                      )
                   => CreateProcess
                   -> (stdin -> stdout -> stderr -> m b)
                   -> m b
withCheckedProcess :: forall stdin stderr stdout (m :: * -> *) b.
(InputSource stdin, OutputSink stderr, OutputSink stdout,
 MonadIO m) =>
CreateProcess -> (stdin -> stdout -> stderr -> m b) -> m b
withCheckedProcess CreateProcess
cp stdin -> stdout -> stderr -> m b
f = do
    (stdin
x, stdout
y, stderr
z, StreamingProcessHandle
sph) <- forall (m :: * -> *) stdin stdout stderr.
(MonadIO m, InputSource stdin, OutputSink stdout,
 OutputSink stderr) =>
CreateProcess -> m (stdin, stdout, stderr, StreamingProcessHandle)
streamingProcess CreateProcess
cp
    b
res <- stdin -> stdout -> stderr -> m b
f stdin
x stdout
y stderr
z
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
        ExitCode
ec <- forall (m :: * -> *).
MonadIO m =>
StreamingProcessHandle -> m ExitCode
waitForStreamingProcess StreamingProcessHandle
sph forall a b. IO a -> IO b -> IO a
`finally` forall (m :: * -> *). MonadIO m => StreamingProcessHandle -> m ()
closeStreamingProcessHandle StreamingProcessHandle
sph
        if ExitCode
ec forall a. Eq a => a -> a -> Bool
== ExitCode
ExitSuccess
            then forall (m :: * -> *) a. Monad m => a -> m a
return b
res
            else forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$ CreateProcess -> ExitCode -> ProcessExitedUnsuccessfully
ProcessExitedUnsuccessfully CreateProcess
cp ExitCode
ec