{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module System.Process.Common
    ( ProcessMaker(process, showProcessMakerForUser)
    , ListLikeProcessIO(forceOutput, readChunks)
    , ProcessText
    , ProcessResult(pidf, outf, errf, intf, codef)
    , readProcessWithExitCode
    , readCreateProcessWithExitCode
    , readCreateProcessStrict
    , readCreateProcessLazy
    , showCmdSpecForUser
    , showCreateProcessForUser
    ) where

import Control.Concurrent
import Control.Exception as E (SomeException, onException, catch, mask, throw)
import Control.Monad
import Data.ListLike as ListLike (ListLike, null)
import Data.ListLike.IO (ListLikeIO, hGetContents, hPutStr)
import Data.Monoid ((<>))
import Data.String (IsString)
import Generics.Deriving.Instances ()
import GHC.IO.Exception (IOErrorType(ResourceVanished), IOException(ioe_type))
import Prelude hiding (null)
import System.Exit (ExitCode(..))
import System.IO (Handle, hClose, hFlush, BufferMode, hSetBuffering)
import System.IO.Unsafe (unsafeInterleaveIO)
import System.Process (CmdSpec(..), CreateProcess(cmdspec, cwd, std_err, std_in, std_out), StdStream(CreatePipe), ProcessHandle, createProcess, proc, showCommandForUser, waitForProcess, terminateProcess)
import Utils (forkWait)

#if __GLASGOW_HASKELL__ <= 709
import Control.Applicative ((<$>), (<*>))
import Data.Monoid (Monoid(mempty, mappend))
#endif

#if !MIN_VERSION_deepseq(1,4,2)
import Control.DeepSeq (NFData)
-- | This instance lets us use DeepSeq's force function on a stream of Chunks.
instance NFData ExitCode
#endif

class ProcessMaker a where
    process :: a -> IO (Handle, Handle, Handle, ProcessHandle)
    showProcessMakerForUser :: a -> String

-- | This is the usual maker argument to 'readCreateProcessLazy'.
instance ProcessMaker CreateProcess where
    process :: CreateProcess -> IO (Handle, Handle, Handle, ProcessHandle)
process p :: CreateProcess
p = do
      (Just inh :: Handle
inh, Just outh :: Handle
outh, Just errh :: Handle
errh, pid :: ProcessHandle
pid) <- CreateProcess
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
createProcess CreateProcess
p { std_in :: StdStream
std_in = StdStream
CreatePipe, std_out :: StdStream
std_out = StdStream
CreatePipe, std_err :: StdStream
std_err = StdStream
CreatePipe }
      (Handle, Handle, Handle, ProcessHandle)
-> IO (Handle, Handle, Handle, ProcessHandle)
forall (m :: * -> *) a. Monad m => a -> m a
return (Handle
inh, Handle
outh, Handle
errh, ProcessHandle
pid)
    showProcessMakerForUser :: CreateProcess -> String
showProcessMakerForUser = CreateProcess -> String
showCreateProcessForUser

-- | Passing this to 'readCreateProcessLazy' as the maker argument allows
-- you to set the buffer mode of the process stdout and stderr handles
-- just after the handles are created.  These are set to
-- BlockBuffering by default, but for running console commands
-- LineBuffering is probably what you want.
instance ProcessMaker (CreateProcess, BufferMode, BufferMode) where
    process :: (CreateProcess, BufferMode, BufferMode)
-> IO (Handle, Handle, Handle, ProcessHandle)
process (p :: CreateProcess
p, outmode :: BufferMode
outmode, errmode :: BufferMode
errmode) = do
      (Just inh :: Handle
inh, Just outh :: Handle
outh, Just errh :: Handle
errh, pid :: ProcessHandle
pid) <- CreateProcess
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
createProcess CreateProcess
p { std_in :: StdStream
std_in = StdStream
CreatePipe, std_out :: StdStream
std_out = StdStream
CreatePipe, std_err :: StdStream
std_err = StdStream
CreatePipe }
      Handle -> BufferMode -> IO ()
hSetBuffering Handle
outh BufferMode
outmode
      Handle -> BufferMode -> IO ()
hSetBuffering Handle
errh BufferMode
errmode
      (Handle, Handle, Handle, ProcessHandle)
-> IO (Handle, Handle, Handle, ProcessHandle)
forall (m :: * -> *) a. Monad m => a -> m a
return (Handle
inh, Handle
outh, Handle
errh, ProcessHandle
pid)
    showProcessMakerForUser :: (CreateProcess, BufferMode, BufferMode) -> String
showProcessMakerForUser (p :: CreateProcess
p, outmode :: BufferMode
outmode, errmode :: BufferMode
errmode) =
        CreateProcess -> String
showCreateProcessForUser CreateProcess
p String -> String -> String
forall a. [a] -> [a] -> [a]
++ " outmode=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ BufferMode -> String
forall a. Show a => a -> String
show BufferMode
outmode String -> String -> String
forall a. [a] -> [a] -> [a]
++ ", errmode=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ BufferMode -> String
forall a. Show a => a -> String
show BufferMode
errmode

class (IsString text, Monoid text, ListLike text char) => ProcessText text char

class Monoid result => ProcessResult text result | result -> text where
    pidf :: ProcessHandle -> result
    outf :: text -> result
    errf :: text -> result
    intf :: SomeException -> result
    codef :: ExitCode -> result

instance ListLikeProcessIO text char => ProcessResult text (ExitCode, text, text) where
    pidf :: ProcessHandle -> (ExitCode, text, text)
pidf _ = (ExitCode, text, text)
forall a. Monoid a => a
mempty
    codef :: ExitCode -> (ExitCode, text, text)
codef c :: ExitCode
c = (ExitCode
c, text
forall a. Monoid a => a
mempty, text
forall a. Monoid a => a
mempty)
    outf :: text -> (ExitCode, text, text)
outf x :: text
x = (ExitCode
forall a. Monoid a => a
mempty, text
x, text
forall a. Monoid a => a
mempty)
    errf :: text -> (ExitCode, text, text)
errf x :: text
x = (ExitCode
forall a. Monoid a => a
mempty, text
forall a. Monoid a => a
mempty, text
x)
    intf :: SomeException -> (ExitCode, text, text)
intf e :: SomeException
e = SomeException -> (ExitCode, text, text)
forall a e. Exception e => e -> a
throw SomeException
e

-- | A process usually has one 'ExitCode' at the end of its output, this 'Monoid'
-- instance lets us build the type returned by 'System.Process.readProcessWithExitCode'.
instance Monoid ExitCode where
    mempty :: ExitCode
mempty = Int -> ExitCode
ExitFailure 0
    mappend :: ExitCode -> ExitCode -> ExitCode
mappend x :: ExitCode
x (ExitFailure 0) = ExitCode
x
    mappend _ x :: ExitCode
x = ExitCode
x

#if MIN_VERSION_base(4,11,0)
instance Semigroup ExitCode where
  <> :: ExitCode -> ExitCode -> ExitCode
(<>) = ExitCode -> ExitCode -> ExitCode
forall a. Monoid a => a -> a -> a
mappend
#endif

-- | Process IO is based on the 'ListLikeIO' class from the ListLike
-- package
class ListLikeIO text char => ListLikeProcessIO text char where
    forceOutput :: text -> IO text
    readChunks :: Handle -> IO [text]
    -- ^ Read from a handle, returning a lazy list of the monoid a.

-- | Like 'System.Process.readProcessWithExitCode', but with
-- generalized input and output type.  Aside from the usual text-like
-- types, the output can be a list of Chunk a.  This lets you process
-- the chunks received from stdout and stderr lazil, in the order they
-- are received, as well as the exit code.  Utilities to handle Chunks
-- are provided in System.Process.ListLike.
readProcessWithExitCode
    :: ListLikeProcessIO text char =>
       FilePath                 -- ^ command to run
    -> [String]                 -- ^ any arguments
    -> text               -- ^ standard input
    -> IO (ExitCode, text, text) -- ^ exitcode, stdout, stderr
readProcessWithExitCode :: String -> [String] -> text -> IO (ExitCode, text, text)
readProcessWithExitCode cmd :: String
cmd args :: [String]
args input :: text
input = CreateProcess -> text -> IO (ExitCode, text, text)
forall maker text char.
(ProcessMaker maker, ListLikeProcessIO text char) =>
maker -> text -> IO (ExitCode, text, text)
readCreateProcessWithExitCode (String -> [String] -> CreateProcess
proc String
cmd [String]
args) text
input

readCreateProcessWithExitCode
    :: (ProcessMaker maker, ListLikeProcessIO text char) =>
       maker                     -- ^ command and arguments to run
    -> text                      -- ^ standard input
    -> IO (ExitCode, text, text) -- ^ exitcode, stdout, stderr
readCreateProcessWithExitCode :: maker -> text -> IO (ExitCode, text, text)
readCreateProcessWithExitCode = maker -> text -> IO (ExitCode, text, text)
forall maker text result char.
(ProcessMaker maker, ProcessResult text result,
 ListLikeProcessIO text char) =>
maker -> text -> IO result
readCreateProcessStrict

readCreateProcessStrict :: (ProcessMaker maker, ProcessResult text result, ListLikeProcessIO text char) =>
                           maker -> text -> IO result
readCreateProcessStrict :: maker -> text -> IO result
readCreateProcessStrict maker :: maker
maker input :: text
input = ((forall a. IO a -> IO a) -> IO result) -> IO result
forall b. ((forall a. IO a -> IO a) -> IO b) -> IO b
mask (((forall a. IO a -> IO a) -> IO result) -> IO result)
-> ((forall a. IO a -> IO a) -> IO result) -> IO result
forall a b. (a -> b) -> a -> b
$ \restore :: forall a. IO a -> IO a
restore -> do
    (inh :: Handle
inh, outh :: Handle
outh, errh :: Handle
errh, pid :: ProcessHandle
pid) <- maker -> IO (Handle, Handle, Handle, ProcessHandle)
forall a.
ProcessMaker a =>
a -> IO (Handle, Handle, Handle, ProcessHandle)
process maker
maker
    (IO result -> IO ExitCode -> IO result)
-> IO ExitCode -> IO result -> IO result
forall a b c. (a -> b -> c) -> b -> a -> c
flip IO result -> IO ExitCode -> IO result
forall a b. IO a -> IO b -> IO a
onException
      (do ProcessHandle -> IO ()
terminateProcess ProcessHandle
pid; Handle -> IO ()
hClose Handle
inh; Handle -> IO ()
hClose Handle
outh; Handle -> IO ()
hClose Handle
errh;
          ProcessHandle -> IO ExitCode
waitForProcess ProcessHandle
pid) (IO result -> IO result) -> IO result -> IO result
forall a b. (a -> b) -> a -> b
$ IO result -> IO result
forall a. IO a -> IO a
restore (IO result -> IO result) -> IO result -> IO result
forall a b. (a -> b) -> a -> b
$ do

      -- fork off a thread to start consuming stdout
      IO result
waitOut <- IO result -> IO (IO result)
forall a. IO a -> IO (IO a)
forkWait (IO result -> IO (IO result)) -> IO result -> IO (IO result)
forall a b. (a -> b) -> a -> b
$ text -> result
forall text result. ProcessResult text result => text -> result
outf (text -> result) -> IO text -> IO result
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Handle -> IO text
forall full item. ListLikeIO full item => Handle -> IO full
hGetContents Handle
outh IO text -> (text -> IO text) -> IO text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= text -> IO text
forall text char. ListLikeProcessIO text char => text -> IO text
forceOutput)

      -- fork off a thread to start consuming stderr
      IO result
waitErr <- IO result -> IO (IO result)
forall a. IO a -> IO (IO a)
forkWait (IO result -> IO (IO result)) -> IO result -> IO (IO result)
forall a b. (a -> b) -> a -> b
$ text -> result
forall text result. ProcessResult text result => text -> result
errf (text -> result) -> IO text -> IO result
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Handle -> IO text
forall full item. ListLikeIO full item => Handle -> IO full
hGetContents Handle
errh IO text -> (text -> IO text) -> IO text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= text -> IO text
forall text char. ListLikeProcessIO text char => text -> IO text
forceOutput)

      -- now write and flush any input.
      Handle -> text -> IO ()
forall a c. ListLikeProcessIO a c => Handle -> a -> IO ()
writeInput Handle
inh text
input

      -- wait on the output
      result
out <- IO result
waitOut
      result
err <- IO result
waitErr

      Handle -> IO ()
hClose Handle
outh
      Handle -> IO ()
hClose Handle
errh

      -- wait on the process
      result
ex <- ExitCode -> result
forall text result. ProcessResult text result => ExitCode -> result
codef (ExitCode -> result) -> IO ExitCode -> IO result
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProcessHandle -> IO ExitCode
waitForProcess ProcessHandle
pid

      result -> IO result
forall (m :: * -> *) a. Monad m => a -> m a
return (result -> IO result) -> result -> IO result
forall a b. (a -> b) -> a -> b
$ result
out result -> result -> result
forall a. Semigroup a => a -> a -> a
<> result
err result -> result -> result
forall a. Semigroup a => a -> a -> a
<> result
ex

-- | Like readCreateProcessStrict, but the output is read lazily.
readCreateProcessLazy :: (ProcessMaker maker, ProcessResult a b, ListLikeProcessIO a c) => maker -> a -> IO b
readCreateProcessLazy :: maker -> a -> IO b
readCreateProcessLazy maker :: maker
maker input :: a
input = ((forall a. IO a -> IO a) -> IO b) -> IO b
forall b. ((forall a. IO a -> IO a) -> IO b) -> IO b
mask (((forall a. IO a -> IO a) -> IO b) -> IO b)
-> ((forall a. IO a -> IO a) -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \restore :: forall a. IO a -> IO a
restore -> do
    (inh :: Handle
inh, outh :: Handle
outh, errh :: Handle
errh, pid :: ProcessHandle
pid) <- maker -> IO (Handle, Handle, Handle, ProcessHandle)
forall a.
ProcessMaker a =>
a -> IO (Handle, Handle, Handle, ProcessHandle)
process maker
maker
    IO b -> IO ExitCode -> IO b
forall a b. IO a -> IO b -> IO a
onException
      (IO b -> IO b
forall a. IO a -> IO a
restore (IO b -> IO b) -> IO b -> IO b
forall a b. (a -> b) -> a -> b
$
       do -- fork off a thread to start consuming stdout
          -- Without unsafeIntereleaveIO the pid messsage gets stuck
          -- until some additional output arrives from the process.
          IO b
waitOut <- IO b -> IO (IO b)
forall a. IO a -> IO (IO a)
forkWait (IO b -> IO (IO b)) -> IO b -> IO (IO b)
forall a b. (a -> b) -> a -> b
$ b -> b -> b
forall a. Semigroup a => a -> a -> a
(<>) (b -> b -> b) -> IO b -> IO (b -> b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> b -> IO b
forall (m :: * -> *) a. Monad m => a -> m a
return (ProcessHandle -> b
forall text result.
ProcessResult text result =>
ProcessHandle -> result
pidf ProcessHandle
pid)
                                     IO (b -> b) -> IO b -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IO b -> IO b
forall a. IO a -> IO a
unsafeInterleaveIO ([(a -> b, Handle)] -> IO b -> IO b
forall a c b.
(ListLikeProcessIO a c, ProcessResult a b) =>
[(a -> b, Handle)] -> IO b -> IO b
readInterleaved [(a -> b
forall text result. ProcessResult text result => text -> result
outf, Handle
outh), (a -> b
forall text result. ProcessResult text result => text -> result
errf, Handle
errh)] (ExitCode -> b
forall text result. ProcessResult text result => ExitCode -> result
codef (ExitCode -> b) -> IO ExitCode -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProcessHandle -> IO ExitCode
waitForProcess ProcessHandle
pid))
          Handle -> a -> IO ()
forall a c. ListLikeProcessIO a c => Handle -> a -> IO ()
writeInput Handle
inh a
input
          IO b
waitOut)
      (do ProcessHandle -> IO ()
terminateProcess ProcessHandle
pid; Handle -> IO ()
hClose Handle
inh; Handle -> IO ()
hClose Handle
outh; Handle -> IO ()
hClose Handle
errh;
          ProcessHandle -> IO ExitCode
waitForProcess ProcessHandle
pid)

-- | Helper function for readCreateProcessLazy.
readInterleaved :: (ListLikeProcessIO a c, ProcessResult a b) =>
                   [(a -> b, Handle)] -> IO b -> IO b
readInterleaved :: [(a -> b, Handle)] -> IO b -> IO b
readInterleaved pairs :: [(a -> b, Handle)]
pairs finish :: IO b
finish = IO (MVar (Either Handle b))
forall a. IO (MVar a)
newEmptyMVar IO (MVar (Either Handle b))
-> (MVar (Either Handle b) -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [(a -> b, Handle)] -> IO b -> MVar (Either Handle b) -> IO b
forall a b c.
(ListLikeProcessIO a c, ProcessResult a b) =>
[(a -> b, Handle)] -> IO b -> MVar (Either Handle b) -> IO b
readInterleaved' [(a -> b, Handle)]
pairs IO b
finish

readInterleaved' :: forall a b c. (ListLikeProcessIO a c, ProcessResult a b) =>
                    [(a -> b, Handle)] -> IO b -> MVar (Either Handle b) -> IO b
readInterleaved' :: [(a -> b, Handle)] -> IO b -> MVar (Either Handle b) -> IO b
readInterleaved' pairs :: [(a -> b, Handle)]
pairs finish :: IO b
finish res :: MVar (Either Handle b)
res = do
  ((a -> b, Handle) -> IO ThreadId) -> [(a -> b, Handle)] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (IO () -> IO ThreadId
forkIO (IO () -> IO ThreadId)
-> ((a -> b, Handle) -> IO ()) -> (a -> b, Handle) -> IO ThreadId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a -> b) -> Handle -> IO ()) -> (a -> b, Handle) -> IO ()
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (a -> b) -> Handle -> IO ()
readHandle) [(a -> b, Handle)]
pairs
  Int -> IO b
takeChunks ([(a -> b, Handle)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(a -> b, Handle)]
pairs)
    where
      -- Forked thread to read the input and send it to takeChunks via
      -- the MVar.
      readHandle :: (a -> b) -> Handle -> IO ()
      readHandle :: (a -> b) -> Handle -> IO ()
readHandle f :: a -> b
f h :: Handle
h = do
        [a]
cs <- Handle -> IO [a]
forall text char.
ListLikeProcessIO text char =>
Handle -> IO [text]
readChunks Handle
h
        -- If the type returned as stdout and stderr is lazy we need
        -- to force it here in the producer thread - I'm not exactly
        -- sure why.  And why is String lazy?
        -- when (lazy (undefined :: a)) (void cs)
        (a -> IO ()) -> [a] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\ c :: a
c -> MVar (Either Handle b) -> Either Handle b -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar (Either Handle b)
res (b -> Either Handle b
forall a b. b -> Either a b
Right (a -> b
f a
c))) [a]
cs
        Handle -> IO ()
hClose Handle
h
        MVar (Either Handle b) -> Either Handle b -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar (Either Handle b)
res (Handle -> Either Handle b
forall a b. a -> Either a b
Left Handle
h)
      takeChunks :: Int -> IO b
      takeChunks :: Int -> IO b
takeChunks 0 = IO b
finish
      takeChunks openCount :: Int
openCount = IO (Either Handle b)
takeChunk IO (Either Handle b) -> (Either Handle b -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> Either Handle b -> IO b
takeMore Int
openCount
      takeMore :: Int -> Either Handle b -> IO b
      takeMore :: Int -> Either Handle b -> IO b
takeMore openCount :: Int
openCount (Left h :: Handle
h) = Handle -> IO ()
hClose Handle
h IO () -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> IO b
takeChunks (Int
openCount Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1)
      takeMore openCount :: Int
openCount (Right x :: b
x) =
          do b
xs <- IO b -> IO b
forall a. IO a -> IO a
unsafeInterleaveIO (IO b -> IO b) -> IO b -> IO b
forall a b. (a -> b) -> a -> b
$ Int -> IO b
takeChunks Int
openCount
             b -> IO b
forall (m :: * -> *) a. Monad m => a -> m a
return (b
x b -> b -> b
forall a. Semigroup a => a -> a -> a
<> b
xs)
      takeChunk :: IO (Either Handle b)
takeChunk = MVar (Either Handle b) -> IO (Either Handle b)
forall a. MVar a -> IO a
takeMVar MVar (Either Handle b)
res IO (Either Handle b)
-> (SomeException -> IO (Either Handle b)) -> IO (Either Handle b)
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`E.catch` (\ (SomeException
e :: SomeException) -> Either Handle b -> IO (Either Handle b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Handle b -> IO (Either Handle b))
-> Either Handle b -> IO (Either Handle b)
forall a b. (a -> b) -> a -> b
$ b -> Either Handle b
forall a b. b -> Either a b
Right (b -> Either Handle b) -> b -> Either Handle b
forall a b. (a -> b) -> a -> b
$ SomeException -> b
forall text result.
ProcessResult text result =>
SomeException -> result
intf SomeException
e)

-- | Write and flush process input, closing the handle when done.
-- Catch and ignore Resource Vanished exceptions, they just mean the
-- process exited before all of its output was read.
writeInput :: ListLikeProcessIO a c => Handle -> a -> IO ()
writeInput :: Handle -> a -> IO ()
writeInput inh :: Handle
inh input :: a
input =
    IO () -> IO ()
ignoreResourceVanished (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
      Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (a -> Bool
forall full item. ListLike full item => full -> Bool
ListLike.null a
input) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        Handle -> a -> IO ()
forall full item. ListLikeIO full item => Handle -> full -> IO ()
hPutStr Handle
inh a
input
        Handle -> IO ()
hFlush Handle
inh
      Handle -> IO ()
hClose Handle
inh -- stdin has been fully written

-- | Wrapper for a process that provides a handler for the
-- ResourceVanished exception.  This is frequently an exception we
-- wish to ignore, because many processes will deliberately exit
-- before they have read all of their input.
ignoreResourceVanished :: IO () -> IO ()
ignoreResourceVanished :: IO () -> IO ()
ignoreResourceVanished action :: IO ()
action =
    IO ()
action IO () -> (IOException -> IO ()) -> IO ()
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`E.catch` (\e :: IOException
e -> if IOException -> IOErrorType
ioe_type IOException
e IOErrorType -> IOErrorType -> Bool
forall a. Eq a => a -> a -> Bool
== IOErrorType
ResourceVanished then () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return () else IOException -> IO ()
forall a. IOException -> IO a
ioError IOException
e)

-- | System.Process utility functions.
showCreateProcessForUser :: CreateProcess -> String
showCreateProcessForUser :: CreateProcess -> String
showCreateProcessForUser p :: CreateProcess
p =
    CmdSpec -> String
showCmdSpecForUser (CreateProcess -> CmdSpec
cmdspec CreateProcess
p) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> (String -> String) -> Maybe String -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe "" (\ d :: String
d -> " (in " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
d String -> String -> String
forall a. [a] -> [a] -> [a]
++ ")") (CreateProcess -> Maybe String
cwd CreateProcess
p)

showCmdSpecForUser :: CmdSpec -> String
showCmdSpecForUser :: CmdSpec -> String
showCmdSpecForUser (ShellCommand s :: String
s) = String
s
showCmdSpecForUser (RawCommand p :: String
p args :: [String]
args) = String -> [String] -> String
showCommandForUser String
p [String]
args