{-# 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 IO () -> IO ClosedStream -> IO ClosedStream
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ClosedStream -> IO ClosedStream
forall (m :: * -> *) a. Monad m => a -> m a
return ClosedStream
ClosedStream, StdStream -> Maybe StdStream
forall a. a -> Maybe a
Just StdStream
CreatePipe)
instance InputSource Inherited where
    isStdStream :: (Maybe Handle -> IO Inherited, Maybe StdStream)
isStdStream = (\Maybe Handle
Nothing -> Inherited -> IO Inherited
forall (m :: * -> *) a. Monad m => a -> m a
return Inherited
Inherited, StdStream -> Maybe StdStream
forall a. a -> Maybe a
Just StdStream
Inherit)
instance InputSource UseProvidedHandle where
    isStdStream :: (Maybe Handle -> IO UseProvidedHandle, Maybe StdStream)
isStdStream = (\Maybe Handle
Nothing -> UseProvidedHandle -> IO UseProvidedHandle
forall (m :: * -> *) a. Monad m => a -> m a
return UseProvidedHandle
UseProvidedHandle, Maybe StdStream
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 IO () -> IO ClosedStream -> IO ClosedStream
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ClosedStream -> IO ClosedStream
forall (m :: * -> *) a. Monad m => a -> m a
return ClosedStream
ClosedStream, StdStream -> Maybe StdStream
forall a. a -> Maybe a
Just StdStream
CreatePipe)
instance OutputSink Inherited where
    osStdStream :: (Maybe Handle -> IO Inherited, Maybe StdStream)
osStdStream = (\Maybe Handle
Nothing -> Inherited -> IO Inherited
forall (m :: * -> *) a. Monad m => a -> m a
return Inherited
Inherited, StdStream -> Maybe StdStream
forall a. a -> Maybe a
Just StdStream
Inherit)
instance OutputSink UseProvidedHandle where
    osStdStream :: (Maybe Handle -> IO UseProvidedHandle, Maybe StdStream)
osStdStream = (\Maybe Handle
Nothing -> UseProvidedHandle -> IO UseProvidedHandle
forall (m :: * -> *) a. Monad m => a -> m a
return UseProvidedHandle
UseProvidedHandle, Maybe StdStream
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 :: StreamingProcessHandle -> m ExitCode
waitForStreamingProcess = IO ExitCode -> m ExitCode
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ExitCode -> m ExitCode)
-> (StreamingProcessHandle -> IO ExitCode)
-> StreamingProcessHandle
-> m ExitCode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. STM ExitCode -> IO ExitCode
forall a. STM a -> IO a
atomically (STM ExitCode -> IO ExitCode)
-> (StreamingProcessHandle -> STM ExitCode)
-> StreamingProcessHandle
-> IO ExitCode
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 = TMVar ExitCode -> STM ExitCode
forall a. TMVar a -> STM a
readTMVar (TMVar ExitCode -> STM ExitCode)
-> (StreamingProcessHandle -> TMVar ExitCode)
-> StreamingProcessHandle
-> STM ExitCode
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 :: StreamingProcessHandle -> m (Maybe ExitCode)
getStreamingProcessExitCode = IO (Maybe ExitCode) -> m (Maybe ExitCode)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe ExitCode) -> m (Maybe ExitCode))
-> (StreamingProcessHandle -> IO (Maybe ExitCode))
-> StreamingProcessHandle
-> m (Maybe ExitCode)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. STM (Maybe ExitCode) -> IO (Maybe ExitCode)
forall a. STM a -> IO a
atomically (STM (Maybe ExitCode) -> IO (Maybe ExitCode))
-> (StreamingProcessHandle -> STM (Maybe ExitCode))
-> StreamingProcessHandle
-> IO (Maybe ExitCode)
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 = TMVar ExitCode -> STM (Maybe ExitCode)
forall a. TMVar a -> STM (Maybe a)
tryReadTMVar (TMVar ExitCode -> STM (Maybe ExitCode))
-> (StreamingProcessHandle -> TMVar ExitCode)
-> StreamingProcessHandle
-> STM (Maybe ExitCode)
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 :: CreateProcess -> m (stdin, stdout, stderr, StreamingProcessHandle)
streamingProcess CreateProcess
cp = IO (stdin, stdout, stderr, StreamingProcessHandle)
-> m (stdin, stdout, stderr, StreamingProcessHandle)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (stdin, stdout, stderr, StreamingProcessHandle)
 -> m (stdin, stdout, stderr, StreamingProcessHandle))
-> IO (stdin, stdout, stderr, StreamingProcessHandle)
-> m (stdin, stdout, stderr, StreamingProcessHandle)
forall a b. (a -> b) -> a -> b
$ do
    let (Maybe Handle -> IO stdin
getStdin, Maybe StdStream
stdinStream) = (Maybe Handle -> IO stdin, Maybe StdStream)
forall a. InputSource a => (Maybe Handle -> IO a, Maybe StdStream)
isStdStream
        (Maybe Handle -> IO stdout
getStdout, Maybe StdStream
stdoutStream) = (Maybe Handle -> IO stdout, Maybe StdStream)
forall a. OutputSink a => (Maybe Handle -> IO a, Maybe StdStream)
osStdStream
        (Maybe Handle -> IO stderr
getStderr, Maybe StdStream
stderrStream) = (Maybe Handle -> IO stderr, Maybe StdStream)
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 = StdStream -> Maybe StdStream -> StdStream
forall a. a -> Maybe a -> a
fromMaybe (CreateProcess -> StdStream
std_in CreateProcess
cp) Maybe StdStream
stdinStream
        , std_out :: StdStream
std_out = StdStream -> Maybe StdStream -> StdStream
forall a. a -> Maybe a -> a
fromMaybe (CreateProcess -> StdStream
std_out CreateProcess
cp) Maybe StdStream
stdoutStream
        , std_err :: StdStream
std_err = StdStream -> Maybe StdStream -> StdStream
forall a. a -> Maybe a -> a
fromMaybe (CreateProcess -> StdStream
std_err CreateProcess
cp) Maybe StdStream
stderrStream
        }

    TMVar ExitCode
ec <- STM (TMVar ExitCode) -> IO (TMVar ExitCode)
forall a. STM a -> IO a
atomically STM (TMVar ExitCode)
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. IO a -> IO a) -> IO ()) -> IO ThreadId)
-> ((forall a. IO a -> IO a) -> IO ()) -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ \forall a. IO a -> IO a
_unmask -> IO ExitCode -> IO (Either SomeException ExitCode)
forall e a. Exception e => IO a -> IO (Either e a)
try (ProcessHandle -> IO ExitCode
waitForProcess ProcessHandle
ph)
        IO (Either SomeException ExitCode)
-> (Either SomeException ExitCode -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= STM () -> IO ()
forall a. STM a -> IO a
atomically
          (STM () -> IO ())
-> (Either SomeException ExitCode -> STM ())
-> Either SomeException ExitCode
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TMVar ExitCode -> ExitCode -> STM ()
forall a. TMVar a -> a -> STM ()
putTMVar TMVar ExitCode
ec
          (ExitCode -> STM ())
-> (Either SomeException ExitCode -> ExitCode)
-> Either SomeException ExitCode
-> STM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SomeException -> ExitCode)
-> (ExitCode -> ExitCode)
-> Either SomeException ExitCode
-> ExitCode
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
              (forall a. SomeException -> a
forall a e. Exception e => e -> a
throw :: SomeException -> a)
              ExitCode -> ExitCode
forall a. a -> a
id

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

    (,,,)
      (stdin
 -> stdout
 -> stderr
 -> StreamingProcessHandle
 -> (stdin, stdout, stderr, StreamingProcessHandle))
-> IO stdin
-> IO
     (stdout
      -> stderr
      -> StreamingProcessHandle
      -> (stdin, stdout, stderr, StreamingProcessHandle))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
A.<$> Maybe Handle -> IO stdin
getStdin Maybe Handle
stdinH
      IO
  (stdout
   -> stderr
   -> StreamingProcessHandle
   -> (stdin, stdout, stderr, StreamingProcessHandle))
-> IO stdout
-> IO
     (stderr
      -> StreamingProcessHandle
      -> (stdin, stdout, stderr, StreamingProcessHandle))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
A.<*> Maybe Handle -> IO stdout
getStdout Maybe Handle
stdoutH
        IO
  (stderr
   -> StreamingProcessHandle
   -> (stdin, stdout, stderr, StreamingProcessHandle))
-> IO stderr
-> IO
     (StreamingProcessHandle
      -> (stdin, stdout, stderr, StreamingProcessHandle))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe Handle -> IO stderr
getStderr Maybe Handle
stderrH
        IO
  (StreamingProcessHandle
   -> (stdin, stdout, stderr, StreamingProcessHandle))
-> IO StreamingProcessHandle
-> IO (stdin, stdout, stderr, StreamingProcessHandle)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StreamingProcessHandle -> IO StreamingProcessHandle
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 :: StreamingProcessHandle -> m ()
closeStreamingProcessHandle (StreamingProcessHandle ProcessHandle
_ TMVar ExitCode
_ IO ()
f) = IO () -> m ()
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) = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        [ String
"Process exited with "
        , ExitCode -> String
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
xString -> [String] -> [String]
forall a. a -> [a] -> [a]
:ShowS -> [String] -> [String]
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
            | (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\Char
c -> Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'"' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ') String
x = ShowS
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 :: 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) <- CreateProcess -> m (stdin, stdout, stderr, StreamingProcessHandle)
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
    IO b -> m b
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO b -> m b) -> IO b -> m b
forall a b. (a -> b) -> a -> b
$ do
        ExitCode
ec <- StreamingProcessHandle -> IO ExitCode
forall (m :: * -> *).
MonadIO m =>
StreamingProcessHandle -> m ExitCode
waitForStreamingProcess StreamingProcessHandle
sph IO ExitCode -> IO () -> IO ExitCode
forall a b. IO a -> IO b -> IO a
`finally` StreamingProcessHandle -> IO ()
forall (m :: * -> *). MonadIO m => StreamingProcessHandle -> m ()
closeStreamingProcessHandle StreamingProcessHandle
sph
        if ExitCode
ec ExitCode -> ExitCode -> Bool
forall a. Eq a => a -> a -> Bool
== ExitCode
ExitSuccess
            then b -> IO b
forall (m :: * -> *) a. Monad m => a -> m a
return b
res
            else ProcessExitedUnsuccessfully -> IO b
forall e a. Exception e => e -> IO a
throwIO (ProcessExitedUnsuccessfully -> IO b)
-> ProcessExitedUnsuccessfully -> IO b
forall a b. (a -> b) -> a -> b
$ CreateProcess -> ExitCode -> ProcessExitedUnsuccessfully
ProcessExitedUnsuccessfully CreateProcess
cp ExitCode
ec