-- GENERATED by C->Haskell Compiler, version 0.28.8 Switcheroo, 25 November 2017 (Haskell)
-- Edit the ORIGNAL .chs file instead!


{-# LINE 1 "src/HsShellScript/ProcErr.chs" #-}
-- #hide

-- New Typeable class in GHC 7.8:
-- http://www.haskell.org/ghc/docs/7.8.3/html/libraries/base-4.7.0.1/Data-Typeable.html
-- https://ghc.haskell.org/trac/ghc/wiki/GhcKinds/PolyTypeable


module HsShellScript.ProcErr where
import qualified Foreign.C.Types as C2HSImp
import qualified Foreign.Ptr as C2HSImp
import qualified System.IO.Unsafe as C2HSImp



import Control.Concurrent.MVar
import Control.Exception
import Control.Monad
import Data.IORef as IORef
import Data.Int
import Data.List
import Data.Maybe
import Data.Typeable
import Foreign
import Foreign.C
import Foreign.C.Error
import GHC.Conc
import GHC.IO hiding (finally, bracket)
import GHC.IO.Exception                    -- SystemError, ioe_*
import GHC.IO.Handle
import GHC.IO.Handle.Internals             -- withHandle', do_operation
import GHC.IO.Handle.Types hiding (close)
import Prelude hiding (catch)
import System.Directory
import System.Environment
import System.Exit
import System.IO
import System.IO.Error hiding (catch)
import System.Posix
import System.Posix.IO
import System.Posix.Process (forkProcess)
import System.Posix.Types                  -- Fd
import qualified GHC.IO.FD as FD
import qualified System.IO.Error                -- mkIOError

import HsShellScript.Args
import HsShellScript.Shell

infixr 2 -|-    -- left handed, stdout
infixr 2 =|-    -- left handed, stderr
infixl 2 -|=    -- right handed, stdout
infixl 2 =|=    -- right handed, stderr
infixl 3 ->-    -- write stdout to file
infixl 3 =>-    -- write stderr to file
infixl 3 ->>-   -- append stdout to file
infixl 3 =>>-   -- append stderr to file
infixl 3 -<-    -- read stdin from file or string
infixl 3 -&>-   -- write stdout and stderr to file
infixl 3 -&>>-  -- append stdout and stderr to file





{- | Improved version of @System.Posix.Files.setFileMode@, which sets the file name in the @IOError@ which is
thrown in case of an error. The implementation in GHC 6.2.2 neglects to do this.

>setFileMode' path mode =
>   fill_in_filename path $
>      setFileMode path mode
-}
setFileMode' :: FilePath -> FileMode -> IO ()
setFileMode' :: String -> FileMode -> IO ()
setFileMode' String
path FileMode
mode =
   String -> IO () -> IO ()
forall a. String -> IO a -> IO a
fill_in_filename String
path (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
      String -> FileMode -> IO ()
setFileMode String
path FileMode
mode


-- |
-- Execute an IO action as a separate process, and wait for it to finish.
-- Report errors as exceptions.
--
-- This forks a child process, which performs the specified IO action. In case
-- the child process has been stopped by a signal, the parent blocks.
--
-- If the action throws an @IOError@, it is transmitted to the parent.
-- It is then raised there, as if it happened locally. The child then aborts
-- quietly with an exit code of 0.
--
-- Exceptions in the child process, other than @IOError@s, result in an error
-- message on @stderr@, and a @ProcessStatus@ exception in the parent, with the
-- value of @Exited (ExitFailure 1)@. The following exceptions are understood by
-- @subproc@, and result in corresponding messages: @ArgError@, @ProcessStatus@,
-- @RunError@, @IOError@ and @ExitCode@. Other exceptions result in the generic
-- message, as produced by @show@.
--
-- If the child process exits with an exit code other than zero, or it is
-- terminated by a signal, the corresponding @ProcessStatus@ is raised as an
-- exception in the parent program. Only @IOError@s are transmitted to the parent.
--
-- When used in conjunction with an @exec@ variant, this means that the parent
-- process can tell the difference between failure of the @exec@ call itself,
-- and failure of the child program being executed after a successful call of
-- the @exec@ variant. In case of failure of the @exec@
-- call, You get the @IOError@, which
-- happened in the child when calling @executeFile@ (from the GHC hierarchical
-- libraries). In case of the called program failing, you get the @ProcessStatus@.
--
-- Unless you replace the child process, calling an @exec@ variant, the child
-- should let the control flow leave the action normally (unless it throws an
-- @IOError@). The child process is then properly terminated by @subproc@, such
-- that no resources, which have been duplicated by the fork, cause problems.
-- See "HsShellScript#subr" for details.
--
-- If you want to run an external program, by calling one of the @exec@
-- variants in the child action, you might want to call @runprog@ instead of @subproc@.
--
--
-- Examples:
--
-- Run a program with the environment replaced:
--
-- >subproc (execpe "foobar" ["1","2","3"] new_env)
--
-- This results in a @ProcessStatus@ exception:
--
-- >subproc (exec "/bin/false" [])
--
-- This results in an @IOError@ (unless you actually have @\/frooble@):
--
-- >subproc (exec "/frooble" [])
--
-- See 'runprog', 'spawn', 'exec', 'execp', 'exece', 'execpe'.
subproc :: IO a                 -- ^ Action to execute in a child process
        -> IO ()
subproc :: forall a. IO a -> IO ()
subproc IO a
io = do

  -- Make new error channel
   (Fd
readend, Fd
writeend) <- IO (Fd, Fd)
createPipe

   -- Set it to "close on exec"
   CInt -> IO CInt
c_close_on_exec (Fd -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Fd
writeend)

   -- Fork child process
   IO ()
flush_outerr
   ProcessID
pid <- IO () -> IO ProcessID
forkProcess (do -- Child process
                          Fd -> IO ()
closeFd Fd
readend

                          -- Do it. In case some part of the child hands over an IOError to
                          -- be transmitted to the parent, do that and abort quietly.
                          IO () -> IO ()
forall a b. IO a -> IO b
child (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
                             IO () -> (IOError -> IO ()) -> IO ()
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
catch (IO a
io IO a -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ())
                                   (\(IOError
ioe::IOError) -> do
                                       Fd -> IOError -> IO ()
send_ioerror Fd
writeend IOError
ioe
                                       IO ()
flush_outerr
                                       Int -> IO ()
forall a. Int -> IO a
_exit Int
0
                                   )
                      )

   -- Parent process
   Fd -> IO ()
closeFd Fd
writeend

   -- Read the complete contents of the error channel as an encoding
   -- of a possible IOError (until closed on the other side).
   --
   -- The write end in the child stays open, until either
   --    - exec in the child
   --    - child terminates (not merely stops)
   --    - child sends ioerror and closes the channel
   Maybe IOError
mioe <- Fd -> IO (Maybe IOError)
receive_ioerror Fd
readend

   -- Waits for the child to finish. The process status is "Exited
   -- ExitSuccess" in case the child transmitted an error.
   (Just ProcessStatus
ps) <- Bool -> Bool -> ProcessID -> IO (Maybe ProcessStatus)
getProcessStatus Bool
True Bool
False (ProcessID -> ProcessID
forall a b. (Integral a, Num b) => a -> b
fromIntegral ProcessID
pid)
   if ProcessStatus
ps ProcessStatus -> ProcessStatus -> Bool
forall a. Eq a => a -> a -> Bool
== ExitCode -> ProcessStatus
Exited ExitCode
ExitSuccess
       then () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
       else ProcessStatus -> IO ()
forall a e. Exception e => e -> a
throw ProcessStatus
ps

   -- In case an IOError has been received, throw it locally
   case Maybe IOError
mioe of
      Just IOError
ioe -> IOError -> IO ()
forall a. IOError -> IO a
ioError IOError
ioe
      Maybe IOError
Nothing  -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()


-- |
-- Execute an IO action as a separate process, and wait for it to finish.
-- Report errors as exceptions.
--
-- /This function is included only for backwards compatibility. New code should/
-- /use/ 'subproc' instead/, which has better error handling./
--
-- The program forks a child process and performs the specified action.
-- Then it waits for the child process to finish. If it exits in any way
-- which indicates an error, the @ProcessStatus@ is thrown.
--
-- The parent process waits for the child processes, which have been stopped by
-- a signal.
--
-- See "HsShellScript#subr" for further details.
--
-- See 'subproc', 'spawn'.
call :: IO a  -- ^ action to execute as a child process
     -> IO ()
call :: forall a. IO a -> IO ()
call IO a
io = do
    ProcessID
pid <- String -> IO a -> IO ProcessID
forall a. String -> IO a -> IO ProcessID
spawn_loc String
"call" IO a
io
    (Just ProcessStatus
ps) <- Bool -> Bool -> ProcessID -> IO (Maybe ProcessStatus)
getProcessStatus Bool
True Bool
False ProcessID
pid
    if ProcessStatus
ps ProcessStatus -> ProcessStatus -> Bool
forall a. Eq a => a -> a -> Bool
== ExitCode -> ProcessStatus
Exited ExitCode
ExitSuccess
        then () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        else ProcessStatus -> IO ()
forall a e. Exception e => e -> a
throw ProcessStatus
ps


-- |
-- Execute an IO action as a separate process, and continue without waiting
-- for it to finish.
--
-- The program forks a child process, which performs the specified action and terminates.
-- The child's process ID is returned.
--
-- See "HsShellScript#subr" for further details.
--
-- See 'subproc'.
spawn :: IO a           -- ^ Action to execute as a child process.
      -> IO ProcessID   -- ^ Process ID of the new process.
spawn :: forall a. IO a -> IO ProcessID
spawn = String -> IO a -> IO ProcessID
forall a. String -> IO a -> IO ProcessID
spawn_loc String
"spawn"

spawn_loc :: String -> IO a -> IO ProcessID
spawn_loc :: forall a. String -> IO a -> IO ProcessID
spawn_loc String
loc IO a
io = do
   IO ()
flush_outerr
   ProcessID
pid <- IO () -> IO ProcessID
forkProcess (IO a -> IO ()
forall a b. IO a -> IO b
child IO a
io)
   ProcessID -> IO ProcessID
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ProcessID
pid


-- |
-- Run an external program. This starts a program as a child
-- process, and waits for it to finish. The executable is searched via the
-- @PATH@.
--
-- /This function is included for backwards compatibility only. New code should/
-- /use/ 'runprog'/, which has much better error handling./
--
-- When the specified program can't be executed, an error message is printed, and the main process
-- gets a @ProcessStatus@ thrown, with the value @Exited
-- (ExitFailure 1)@. This means that the main program can't distinguish between
-- failure of calling the program and the program exiting with an exit code of
-- 1. However, an error message \"Error calling ...\", including the description in the IOError produced
-- by the failed @execp@ call, is printed on @stderr@.
--
-- @run prog par@ is essentially @call (execp prog par)@.
--
-- Example:
--
-- >run "/usr/bin/foobar" ["some", "args"]
-- >   `catch` (\ps -> do -- oops...
-- >              )
--
-- See 'runprog', 'subproc', 'spawn'.
run :: FilePath                    -- ^ Name of the executable to run
    -> [String]                    -- ^ Command line arguments
    -> IO ()
run :: String -> [String] -> IO ()
run String
prog [String]
par =
   IO Any -> IO ()
forall a. IO a -> IO ()
call (IO Any -> IO Any
forall a b. IO a -> IO b
child (IO Any -> IO Any) -> IO Any -> IO Any
forall a b. (a -> b) -> a -> b
$ String -> [String] -> IO Any
forall a. String -> [String] -> IO a
execp String
prog [String]
par)



{- | An error which occured when calling an external program.
   The fields specifiy the details of the call.

   See 'show_runerror', 'to_ioe', 'as_ioe', @System.Posix.ProcessStatus@.
-}
data RunError = RunError
        { RunError -> String
re_prog  :: String             -- ^ Program name
        , RunError -> [String]
re_pars  :: [String]           -- ^ Program arguments
        , RunError -> [(String, String)]
re_env   :: [(String,String)]  -- ^ The environment in use when the call was done
        , RunError -> String
re_wd    :: String             -- ^ The working directory when the call was done
        , RunError -> ProcessStatus
re_ps    :: ProcessStatus      -- ^ The process status of the failure
        , RunError -> Maybe CInt
re_errno :: Maybe CInt         -- ^ The error (errno) code
        }
   deriving (Int -> RunError -> ShowS
[RunError] -> ShowS
RunError -> String
(Int -> RunError -> ShowS)
-> (RunError -> String) -> ([RunError] -> ShowS) -> Show RunError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RunError -> ShowS
showsPrec :: Int -> RunError -> ShowS
$cshow :: RunError -> String
show :: RunError -> String
$cshowList :: [RunError] -> ShowS
showList :: [RunError] -> ShowS
Show, Typeable, RunError -> RunError -> Bool
(RunError -> RunError -> Bool)
-> (RunError -> RunError -> Bool) -> Eq RunError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RunError -> RunError -> Bool
== :: RunError -> RunError -> Bool
$c/= :: RunError -> RunError -> Bool
/= :: RunError -> RunError -> Bool
Eq)

instance Exception RunError



-- | Make a readable error message. This includes all the
-- fields of @RunError@ except for the environment.
--
-- See 'RunError'.
show_runerror :: RunError -> String
show_runerror :: RunError -> String
show_runerror RunError
re =
   String
"The following program failed:\n\
   \   " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
shell_command (RunError -> String
re_prog RunError
re) (RunError -> [String]
re_pars RunError
re) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++
   ProcessStatus -> String
explain_processstatus (RunError -> ProcessStatus
re_ps RunError
re) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n\
   \The working directory was " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
quote (RunError -> String
re_wd RunError
re) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"."


-- | Generate a human-readable description of a @ProcessStatus@.
--
-- See 'exec', 'runprog' and @System.Posix.ProcessStatus@ in the GHC hierarchical
-- library documentation.
explain_processstatus :: ProcessStatus -> String
explain_processstatus :: ProcessStatus -> String
explain_processstatus ProcessStatus
ps =
   case ProcessStatus
ps of
      Exited (ExitFailure Int
ec) -> String
"The program exited abnormally with an exit code of " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
ec String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"."
      Exited ExitCode
ExitSuccess      -> String
"The program finished normally."
      Terminated CInt
sig Bool
_        -> String
"The process was terminated by signal " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CInt -> String
showsig CInt
sig String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"."
      Stopped CInt
sig             -> String
"The process was stopped by signal " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CInt -> String
showsig CInt
sig String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"."
   where
      showsig :: CInt -> String
showsig CInt
sig = CInt -> String
forall a. Show a => a -> String
show CInt
sig String -> ShowS
forall a. [a] -> [a] -> [a]
++
                    case CInt -> [(CInt, String)] -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup CInt
sig [(CInt, String)]
signals of
                       Just String
name -> String
" (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
name String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"
                       Maybe String
Nothing   -> String
""

      signals :: [(CInt, String)]
signals = [(CInt
sigABRT, String
"SIGABRT"), (CInt
sigALRM, String
"SIGALRM"), (CInt
sigBUS, String
"SIGBUS"), (CInt
sigCHLD, String
"SIGCHLD"),
                 (CInt
sigCONT, String
"SIGCONT"), (CInt
sigFPE, String
"SIGFPE"), (CInt
sigHUP, String
"SIGHUP"), (CInt
sigILL, String
"SIGILL"),
                 (CInt
sigINT, String
"SIGINT"), (CInt
sigKILL, String
"SIGKILL"), (CInt
sigPIPE, String
"SIGPIPE"), (CInt
sigQUIT, String
"SIGQUIT"),
                 (CInt
sigSEGV, String
"SIGSEGV"), (CInt
sigSTOP, String
"SIGSTOP"), (CInt
sigTERM, String
"SIGTERM"), (CInt
sigTSTP, String
"SIGTSTP"),
                 (CInt
sigTTIN, String
"SIGTTIN"), (CInt
sigTTOU, String
"SIGTTOU"), (CInt
sigUSR1, String
"SIGUSR1"), (CInt
sigUSR2, String
"SIGUSR2"),
                 (CInt
sigPOLL, String
"SIGPOLL"), (CInt
sigPROF, String
"SIGPROF"), (CInt
sigSYS, String
"SIGSYS"), (CInt
sigTRAP, String
"SIGTRAP"),
                 (CInt
sigURG, String
"SIGURG"), (CInt
sigVTALRM, String
"SIGVTALRM"), (CInt
sigXCPU, String
"SIGXCPU"), (CInt
sigXFSZ, String
"SIGXFSZ")]


-- | Convert a @RunError@ to an @IOError@.
--
-- The @IOError@ type isn't capable of holding all the information which is
-- contained in a @RunError@. The environment is left out, and most of the other
-- fields are included only informally, in the description.
--
-- The fields of the generated @IOError@ are:
--
-- * The handle (@ioeGetHandle@): @Nothing@
--
-- * The error type (@ioeGetErrorType@): @GHC.IO.Exception.SystemError@
--
-- * @ioe_location@: @\"runprog\"@
--
-- * @ioe_description@: The error message, as procuded by @show_runerror@.
--
-- * @ioe_filename@: This is @Just (shell_command /prog/ /pars/)@, with /prog/
--   and /pars/ being the program and its arguments.
--
-- See 'as_ioe', 'runprog', 'show_runerror'.
to_ioe :: RunError -> IOError
to_ioe :: RunError -> IOError
to_ioe RunError
re =
   GHC.IO.Exception.IOError { ioe_handle :: Maybe Handle
ioe_handle      = Maybe Handle
forall a. Maybe a
Nothing,
                              ioe_type :: IOErrorType
ioe_type        = IOErrorType
GHC.IO.Exception.SystemError,
                              ioe_location :: String
ioe_location    = String
"runprog",
                              ioe_description :: String
ioe_description = RunError -> String
show_runerror RunError
re,
                              ioe_filename :: Maybe String
ioe_filename    = String -> Maybe String
forall a. a -> Maybe a
Just (String -> [String] -> String
shell_command (RunError -> String
re_prog RunError
re) (RunError -> [String]
re_pars RunError
re)),
                              ioe_errno :: Maybe CInt
ioe_errno       = RunError -> Maybe CInt
re_errno RunError
re
                            }


-- | Call the specified IO action (which is expected to contain calls of
-- @runprog@) and convert any @RunError@ exceptions to @IOError@s.
--
-- The conversion is done by @to_ioe@.
--
-- See 'to_ioe', 'runprog'.
as_ioe :: IO a -> IO a
as_ioe :: forall a. IO a -> IO a
as_ioe IO a
io =
   IO a
io
   IO a -> (RunError -> IO a) -> IO a
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` (\(RunError
re::RunError) -> IOError -> IO a
forall a. IOError -> IO a
ioError (RunError -> IOError
to_ioe RunError
re))


-- |
-- Run an external program, and report errors as exceptions. The executable is
-- searched via the @PATH@. In case the child process has been stopped by a
-- signal, the parent blocks.
--
-- In case the program exits in an way which indicates an error, or is
-- terminated by a signal, a @RunError@ is thrown. It
-- contains the details of the call. The @runprog@ action can also be converted
-- to throw @IOError@s instaed, by applying @as_ioe@ to it. Either can be used
-- to generate an informative error message.
--
-- In case of starting the program itself failed, an @IOError@ is thrown.
--
-- @runprog prog par@ is a simple front end to @subproc@. It is essentially
-- @subproc (execp prog par)@, apart from building a @RunError@ from a
-- @ProcessStatus@.
--
-- Example 1:
--
-- >do runprog "foo" ["some", "args"]
-- >   ...
-- >`catch` (\re -> do errm (show_runerror re)
-- >                      ...
-- >           )
--
-- Example 2:
--
-- >do as_ioe $ runprog "foo" ["some", "args"]
-- >   ...
-- >`catch` (\ioe -> do errm (show_ioerror ioe)
-- >                       ...
-- >           )
--
-- See 'subproc', 'spawn', 'RunError', 'show_runerror', 'to_ioe', 'as_ioe'.
runprog :: FilePath                    -- ^ Name of the executable to run
        -> [String]                    -- ^ Command line arguments
        -> IO ()
runprog :: String -> [String] -> IO ()
runprog String
prog [String]
pars =
   IO Any -> IO ()
forall a. IO a -> IO ()
subproc (String -> [String] -> IO Any
forall a. String -> [String] -> IO a
execp String
prog [String]
pars)

   IO () -> (ProcessStatus -> IO ()) -> IO ()
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch`
      -- Convert ProcessStatus error to RunError
      (\(ProcessStatus
ps::ProcessStatus) ->
          do [(String, String)]
env   <- IO [(String, String)]
System.Environment.getEnvironment
             String
wd    <- IO String
getCurrentDirectory
             (Errno CInt
c_errno) <- IO Errno
getErrno
             RunError -> IO ()
forall a e. Exception e => e -> a
throw (RunError { re_prog :: String
re_prog  = String
prog
                             , re_pars :: [String]
re_pars  = [String]
pars
                             , re_env :: [(String, String)]
re_env   = [(String, String)]
env
                             , re_wd :: String
re_wd    = String
wd
                             , re_ps :: ProcessStatus
re_ps    = ProcessStatus
ps
                             , re_errno :: Maybe CInt
re_errno = if CInt
c_errno CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= (CInt
0::CInt) then CInt -> Maybe CInt
forall a. a -> Maybe a
Just CInt
c_errno else Maybe CInt
forall a. Maybe a
Nothing
                             }))



-- | Print an action as a shell command, then perform it.
--
-- This is used with actions such as 'runprog', 'exec' or 'subproc'. For instance,
-- @echo runprog prog args@ is a variant of @runprog prog args@, which prints what
-- is being done before doing it.
--
-- See 'runprog', 'subproc', 'exec'.
echo :: ( FilePath -> [String] -> IO () )       -- ^ Action to perform
     -> FilePath                                -- ^ Name or path of the executable to run
     -> [String]                                -- ^ Command line arguments
     -> IO ()
echo :: (String -> [String] -> IO ()) -> String -> [String] -> IO ()
echo String -> [String] -> IO ()
action String
path [String]
args = do
   String -> IO ()
putStrLn (String -> [String] -> String
shell_command String
path [String]
args)
   String -> [String] -> IO ()
action String
path [String]
args


-- | Execute an external program. This replaces the running process. The path isn't searched, the environment
-- isn't changed. In case of failure, an IOError is thrown.
--
-- >exec path args =
-- >   execute_file path False args Nothing
--
-- See 'execute_file', "HsShellScript#exec".
exec :: String          -- ^ Full path to the executable
     -> [String]        -- ^ Command line arguments
     -> IO a            -- ^ Never returns
exec :: forall a. String -> [String] -> IO a
exec String
path [String]
args =
   String -> Bool -> [String] -> Maybe [(String, String)] -> IO a
forall a.
String -> Bool -> [String] -> Maybe [(String, String)] -> IO a
execute_file String
path Bool
False [String]
args Maybe [(String, String)]
forall a. Maybe a
Nothing


-- | Execute an external program. This replaces the running process. The path is searched, the environment
-- isn't changed. In case of failure, an IOError is thrown.
--
-- >execp prog args =
-- >   execute_file prog True args Nothing
--
-- See 'execute_file', "HsShellScript#exec".
execp :: String        -- ^ Name or path of the executable
      -> [String]      -- ^ Command line arguments
      -> IO a          -- ^ Never returns
execp :: forall a. String -> [String] -> IO a
execp String
prog [String]
args =
   String -> Bool -> [String] -> Maybe [(String, String)] -> IO a
forall a.
String -> Bool -> [String] -> Maybe [(String, String)] -> IO a
execute_file String
prog Bool
True [String]
args Maybe [(String, String)]
forall a. Maybe a
Nothing


-- | Execute an external program. This replaces the running process. The path isn't searched, the environment
-- of the program is set as specified. In case of failure, an IOError is thrown.
--
-- >exece path args env =
-- >   execute_file path False args (Just env)
--
-- See 'execute_file', "HsShellScript#exec".
exece :: String                 -- ^ Full path to the executable
      -> [String]               -- ^ Command line arguments
      -> [(String,String)]      -- ^ New environment
      -> IO a                   -- ^ Never returns
exece :: forall a. String -> [String] -> [(String, String)] -> IO a
exece String
path [String]
args [(String, String)]
env =
   String -> Bool -> [String] -> Maybe [(String, String)] -> IO a
forall a.
String -> Bool -> [String] -> Maybe [(String, String)] -> IO a
execute_file String
path Bool
False [String]
args ([(String, String)] -> Maybe [(String, String)]
forall a. a -> Maybe a
Just [(String, String)]
env)


-- | Execute an external program. This replaces the running process. The path is searched, the environment of
-- the program is set as specified. In case of failure, an IOError is thrown.
--
-- >execpe prog args env =
-- >   execute_file prog True args (Just env)
--
-- See 'execute_file', "HsShellScript#exec".
execpe :: String                -- ^ Name or path of the executable
       -> [String]              -- ^ Command line arguments
       -> [(String,String)]     -- ^ New environment
       -> IO a                  -- ^ Never returns
execpe :: forall a. String -> [String] -> [(String, String)] -> IO a
execpe String
prog [String]
args [(String, String)]
env =
   String -> Bool -> [String] -> Maybe [(String, String)] -> IO a
forall a.
String -> Bool -> [String] -> Maybe [(String, String)] -> IO a
execute_file String
prog Bool
True [String]
args ([(String, String)] -> Maybe [(String, String)]
forall a. a -> Maybe a
Just [(String, String)]
env)


{- | Build left handed pipe of stdout.

   \"@p -|- q@\" builds an IO action from the two IO actions @p@ and @q@.
   @q@ is executed in an external process. The standard output of @p@ is sent
   to the standard input of @q@ through a pipe. The result action consists
   of forking off @q@ (connected with a pipe), and @p@.

   The result action does /not/ run @p@ in a separate process. So, the pipe
   itself can be seen as a modified action @p@, forking a connected @q@. The
   pipe is called \"left handed\", because @p@ remains unforked, and not @q@.

   /The exit code of q is silently ignored./ The process ID of the forked
   copy of @q@ isn't returned to the caller, so it's lost.

   The pipe, which connects @p@ and @q@, is in /text mode/. This means that the 
   output of @p@ is converted from Unicode to the system character set, which 
   is determined by the environment variable @LANG@.

   See "HsShellScript#subr" and
   "HsShellScript#exec" for further details.

   Examples:

   >subproc (exec "/usr/bin/foo" [] -|- exec "/usr/bin/bar" [])

   >sunproc (    execp "foo" ["..."]
   >         -|= ( -- Do something with foo's output
   >               do cnt <- lazy_contents "-"
   >                  ...
   >             )
   >        )

   >sunproc ( err_to_out foo
   >          -|- exec "/usr/bin/tee" ["-a", "/tmp/foo.log"] )

   See 'subproc', '(=|-)', '(-|=)', 'redirect'
-}
(-|-) :: IO a   -- ^ Action which won't be forked
      -> IO b   -- ^ Action which will be forked and connected with a pipe
      -> IO a   -- ^ Result action
IO a
p -|- :: forall a b. IO a -> IO b -> IO a
-|- IO b
q = do
   (Just Handle
h, Maybe Handle
_, Maybe Handle
_, ProcessID
_) <- IO b
-> Bool
-> Bool
-> Bool
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessID)
forall a.
IO a
-> Bool
-> Bool
-> Bool
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessID)
pipe_fork_dup IO b
q Bool
True Bool
False Bool
False
   a
res <- Handle -> Handle -> IO a -> IO a
forall a. Handle -> Handle -> IO a -> IO a
redirect Handle
stdout Handle
h IO a
p
   Handle -> IO ()
hClose Handle
h
   a -> IO a
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
res


{- | Build left handed pipe of stderr.

   \"@p =|- q@\" builds an IO action from the two IO actions @p@ and @q@.
   @q@ is executed in an external process. The standard error output of @p@ is sent
   to the standard input of @q@ through a pipe. The result action consists
   of forking off @q@ (connected with a pipe), and @p@.

   The result action does /not/ run @p@ in a separate process. So, the pipe
   itself can be seen as a modified action @p@, forking a connected @q@. The
   pipe is called \"left handed\", because @p@ has this property, and not @q@.

   /The exit code of q is silently ignored./ The process ID of the forked
   copy of @q@ isn't returned to the caller, so it's lost.

   The pipe, which connects @p@ and @q@, is in /text mode/. This means that the 
   output of @p@ is converted from Unicode to the system character set, which 
   is determined by the environment variable @LANG@.

   See "HsShellScript#subr" and
   "HsShellScript#exec" for further details.

   Example:

>subproc (exec "/usr/bin/foo" [] =|- exec "/usr/bin/bar" [])

   See 'subproc', '(-|-)', '(-|=)'.
-}
(=|-) :: IO a    -- ^ Action which won't be forked
      -> IO b    -- ^ Action which will be forked and connected with a pipe
      -> IO a    -- ^ Result action
IO a
p =|- :: forall a b. IO a -> IO b -> IO a
=|- IO b
q = do
   (Just Handle
h, Maybe Handle
_, Maybe Handle
_, ProcessID
_) <- IO b
-> Bool
-> Bool
-> Bool
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessID)
forall a.
IO a
-> Bool
-> Bool
-> Bool
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessID)
pipe_fork_dup IO b
q Bool
True Bool
False Bool
False
   a
res <- Handle -> Handle -> IO a -> IO a
forall a. Handle -> Handle -> IO a -> IO a
redirect Handle
stderr Handle
h IO a
p
   Handle -> IO ()
hClose Handle
h
   a -> IO a
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
res


{- | Build right handed pipe of stdout.

   \"@p -|= q@\" builds an IO action from the two IO actions @p@ and @q@.
   @p@ is executed in an external process. The standard output of @p@ is sent
   to the standard input of @q@ through a pipe. The result action consists
   of forking off @p@ (connected with a pipe), and @q@.

   The result action does /not/ run @q@ in a separate process. So, the pipe
   itself can be seen as a modified action @q@, forking a connected @p@.
   The pipe is called \"right
   handed\", because @q@ has this property, and not @p@.

   /The exit code of p is silently ignored./ The process ID of the forked
   copy of @q@ isn't returned to the caller, so it's lost.

   The pipe, which connects @p@ and @q@, is in /text mode/. This means that the 
   output of @p@ is converted from Unicode to the system character set, which 
   is determined by the environment variable @LANG@.

   See "HsShellScript#subr" and
   "HsShellScript#exec" for further details.

   Example:

>subproc (exec \"\/usr\/bin\/foo\" [] -|= exec \"\/usr\/bin\/bar\" [])

   See 'subproc', '(=|-)', '(=|=)'.
-}
(-|=) :: IO a     -- ^ Action which will be forked and connected with a pipe
      -> IO b     -- ^ Action which won't be forked
      -> IO b     -- ^ Result action
IO a
p -|= :: forall a b. IO a -> IO b -> IO b
-|= IO b
q = do
   (Maybe Handle
_, Just Handle
h, Maybe Handle
_, ProcessID
_) <- IO a
-> Bool
-> Bool
-> Bool
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessID)
forall a.
IO a
-> Bool
-> Bool
-> Bool
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessID)
pipe_fork_dup IO a
p Bool
False Bool
True Bool
False
   b
res <- Handle -> Handle -> IO b -> IO b
forall a. Handle -> Handle -> IO a -> IO a
redirect Handle
stdin Handle
h IO b
q
   Handle -> IO ()
hClose Handle
h
   b -> IO b
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return b
res

{- | Build right handed pipe of stderr.

   \"@p =|= q@\" builds an IO action from the two IO actions @p@ and @q@.
   @p@ is executed in an external process. The standard error output of @p@ is sent
   to the standard input of @q@ through a pipe. The result action consists
   of forking off @p@ (connected with a pipe), and @q@.

   The result action does /not/ run @q@ in a separate process. So, the pipe
   itself can be seen as a modified action @q@, forking a connected @p@.
   The pipe is called \"right
   handed\", because @q@ has this property, and not @p@.

   /The exit code of p is silently ignored./ The process ID of the forked
   copy of @q@ isn't returned to the caller, so it's lost.

   The pipe, which connects @p@ and @q@, is in /text mode/. This means that the 
   output of @p@ is converted from Unicode to the system character set, which 
   is determined by the environment variable @LANG@.

   See "HsShellScript#subr" and
   "HsShellScript#exec" for further details.

   Example:

   > subproc (exec "/usr/bin/foo" [] =|= exec "/usr/bin/bar" [])

   See 'subproc', '=|-', '-|='.
-}
(=|=) :: IO a     -- ^ Action which will be forked and connected with a pipe
      -> IO b     -- ^ Action which won't be forked
      -> IO b     -- ^ Result action
IO a
p =|= :: forall a b. IO a -> IO b -> IO b
=|= IO b
q = do
   (Maybe Handle
_, Maybe Handle
_, Just Handle
h, ProcessID
_) <- IO a
-> Bool
-> Bool
-> Bool
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessID)
forall a.
IO a
-> Bool
-> Bool
-> Bool
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessID)
pipe_fork_dup IO a
p Bool
False Bool
False Bool
True
   b
res <- Handle -> Handle -> IO b -> IO b
forall a. Handle -> Handle -> IO a -> IO a
redirect Handle
stdin Handle
h IO b
q
   Handle -> IO ()
hClose Handle
h
   b -> IO b
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return b
res


-- | Temporarily replace a handle. This makes a backup copy of the original handle (typically a standard
-- handle), overwrites it with the specified one, runs the specified action, and restores the handle from the
-- backup.
--
-- Example:
--
-- >   h <- openFile "/tmp/log" WriteMode
-- >   redirect stdout h io
-- >   hClose h
--
-- This is the same as
--
-- >   io ->- "/tmp/log"
--
-- See '-|-', '=|-'.
redirect :: Handle              -- ^ Handle to replace
         -> Handle              -- ^ Handle to replace it with
         -> IO a                -- ^ Action
         -> IO a
redirect :: forall a. Handle -> Handle -> IO a -> IO a
redirect Handle
handle Handle
replacement IO a
io =
   IO Handle -> (Handle -> IO ()) -> (Handle -> IO a) -> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (do Handle
bak <- Handle -> IO Handle
hDuplicate Handle
handle
               Handle -> Handle -> IO ()
hDuplicateTo Handle
replacement Handle
handle
               Handle -> IO Handle
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Handle
bak
           )
           (\Handle
bak -> do Handle -> Handle -> IO ()
hDuplicateTo Handle
bak Handle
handle
                       Handle -> IO ()
hClose Handle
bak
           )
           (\Handle
_ -> IO a
io)


redirect_helper :: Handle -> IOMode -> IO b -> String -> IO b
redirect_helper Handle
stdh IOMode
mode IO b
io String
path = do
   Handle
h <- String -> IOMode -> IO Handle
openFile String
path IOMode
mode

   -- The file in a redirection is accessed in /text mode/, If stdout or stderr
   -- are redirected, this means that output is converted from ghc's Unicode to
   -- the system character set. If stdin is redirected, this means that data
   -- read from the file is converted from the system character set to ghc's
   -- Unicode. The system character set is taken from the environment variable
   -- LANG.
   Handle -> Bool -> IO ()
hSetBinaryMode Handle
h Bool
False

   b
res <- Handle -> Handle -> IO b -> IO b
forall a. Handle -> Handle -> IO a -> IO a
redirect Handle
stdh Handle
h IO b
io
   Handle -> IO ()
hClose Handle
h
   b -> IO b
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return b
res


{- | Redirect the standard output of the specified IO action to a file. The file will be overwritten, if it
already exists.

What's actually modified is the @stdout@ handle, not the file descriptor 1. The
@exec@ functions know about this. See "HsShellScript#fdpipes" and
"HsShellScript#exec" for details.

The file is written in /text mode/. This means that the
output is converted from Unicode to the system character set, which
is determined by the environment variable @LANG@.

Example:

>runprog "/some/program" [] ->- "/tmp/output"

Note: You can't redirect to @\"\/dev\/null\"@ this way, because GHC 6.4's @openFile@ throws an \"invalid argument\"
IOError. (This may be a bug in the GHC 6.4 libraries). Use @->>-@ instead.

See 'subproc', 'runprog', '->>-', '=>-'.
-}
(->-) :: IO a           -- ^ Action, whose output will be redirected
      -> FilePath       -- ^ File to redirect the output to
      -> IO a           -- ^ Result action
->- :: forall a. IO a -> String -> IO a
(->-) IO a
io String
path =
   Handle -> IOMode -> IO a -> String -> IO a
forall {b}. Handle -> IOMode -> IO b -> String -> IO b
redirect_helper Handle
stdout IOMode
WriteMode IO a
io String
path


{- | Redirect the standard output of the specified IO action to a file. If the file already exists, the output
will be appended.

What's actually modified is the @stdout@ handle, not the file descriptor 1. The
@exec@ functions know about this. See "HsShellScript#fdpipes" and
"HsShellScript#exec" for details.

The file is written in /text mode/. This means that the
output is converted from Unicode to the system character set, which
is determined by the environment variable @LANG@.

Example:

>run "/some/noisy/program" [] ->>- "/dev/null"

See 'subproc', 'runprog', '(->-)', '(=>>-)'.
-}
(->>-) :: IO a          -- ^ Action, whose output will be redirected
       -> FilePath      -- ^ File to redirect the output to
       -> IO a          -- ^ Result action
->>- :: forall a. IO a -> String -> IO a
(->>-) IO a
io String
path =
   Handle -> IOMode -> IO a -> String -> IO a
forall {b}. Handle -> IOMode -> IO b -> String -> IO b
redirect_helper Handle
stdout IOMode
AppendMode IO a
io String
path


{- | Redirect the standard error output of the specified IO action to a file. If the file already exists, it
will be overwritten.

What's actually modified is the @stderr@ handle, not the file descriptor 2. The
@exec@ functions know about this. See "HsShellScript#fdpipes" and
"HsShellScript#exec" for details.

Note: You can't redirect to @\"\/dev\/null\"@ this way, because GHC 6.4's @openFile@ throws an \"invalid argument\"
IOError. (This may be a bug in the GHC 6.4 libraries). Use @=>>-@ instead.

The file is written in /text mode/. This means that the
output is converted from Unicode to the system character set, which
is determined by the environment variable @LANG@.

Example:

>run "/path/to/foo" [] =>- "/tmp/errlog"

See 'subproc', 'runprog', '(->-)', '(=>>-)'.
-}
(=>-) :: IO a           -- ^ Action, whose error output will be redirected
      -> FilePath       -- ^ File to redirect the error output to
      -> IO a           -- ^ Result action
=>- :: forall a. IO a -> String -> IO a
(=>-) =
   Handle -> IOMode -> IO a -> String -> IO a
forall {b}. Handle -> IOMode -> IO b -> String -> IO b
redirect_helper Handle
stderr IOMode
WriteMode


{- | Redirect the standard error output of the specified IO action to a file. If the file already exists, the
output will be appended.

What's actually modified is the @stderr@ handle, not the file descriptor 2. The
@exec@ functions know about this. See "HsShellScript#fdpipes" and
"HsShellScript#exec" for details.

The file is written in /text mode/. This means that the
output is converted from Unicode to the system character set, which
is determined by the environment variable @LANG@.

Example:

>run "/some/program" [] =>>- "/dev/null"

See 'subproc', 'runprog', '(->>-)', '(=>-)'.
-}
(=>>-) :: IO a          -- ^ Action, whose error output will be redirected
       -> FilePath      -- ^ File to redirect the error output to
       -> IO a          -- ^ Result action
=>>- :: forall a. IO a -> String -> IO a
(=>>-) =
   Handle -> IOMode -> IO a -> String -> IO a
forall {b}. Handle -> IOMode -> IO b -> String -> IO b
redirect_helper Handle
stderr IOMode
AppendMode


{- | Redirect both stdout and stderr to a file. This is equivalent to the
shell's @&>@ operator. If the file already exists, it will be overwritten.

What's actually modified are the @stdout@ and @stderr@ handles, not the file
descriptors 1 and 2. The @exec@ functions know about this. See
"HsShellScript#fdpipes" and
"HsShellScript#exec" for details.

Note: You can't redirect to @\"\/dev\/null\"@ this way, because GHC 6.4's @openFile@ throws an \"invalid argument\"
IOError. (This may be a bug in the GHC 6.4 libraries). Use @-&>>-@ instead.

The file is written in /text mode/. This means that the
output is converted from Unicode to the system character set, which
is determined by the environment variable @LANG@.

>(-&>-) io path = err_to_out io ->- path

Example:

@subproc (exec \"\/path\/to\/foo\" [] -&\>- \"log\")@

See '(-&>>-)', 'err_to_out'.
-}
(-&>-) :: IO a          -- ^ Action, whose output and error output will be redirected
       -> FilePath      -- ^ File to redirect to
       -> IO a          -- ^ Result action
-&>- :: forall a. IO a -> String -> IO a
(-&>-) IO a
io String
path = IO a -> IO a
forall a. IO a -> IO a
err_to_out IO a
io IO a -> String -> IO a
forall a. IO a -> String -> IO a
->- String
path


{- | Redirect both stdout and stderr to a file. If the file already exists, the
   output will be appended.

What's actually modified are the @stdout@ and @stderr@ handles, not the file
descriptors 1 and 2. The @exec@ functions know about this. See
"HsShellScript#fdpipes" and
"HsShellScript#exec" for details.

The file is written in /text mode/. This means that the
output is converted from Unicode to the system character set, which
is determined by the environment variable @LANG@.

>(-&>>-) io path = (err_to_out >> io) ->>- path

Example:

>run "/some/noisy/program" [] -&>>- "/dev/null"

See '(-&>-)', 'out_to_err'.
-}
(-&>>-) :: IO a         -- ^ Action, whose output and error output will be redirected
       -> FilePath      -- ^ File to redirect to
       -> IO a          -- ^ Result action
-&>>- :: forall a. IO a -> String -> IO a
(-&>>-) IO a
io String
path =
   IO a -> IO a
forall a. IO a -> IO a
err_to_out IO a
io IO a -> String -> IO a
forall a. IO a -> String -> IO a
->>- String
path


{- | Redirect stdin from a file. This modifies the specified action, such
that the standard input is read from a file.

   What's actually modified is the @stdin@ handle, not the file
   descriptor 0. The @exec@ functions know about this. See
   "HsShellScript#fdpipes" and
"HsShellScript#exec" for details.

The file is read in /text mode/. This means that the input is converted from the
system character set to Unicode. The system's character set is determined by the
environment variable @LANG@.

Example:

@subproc (exec \"\/path\/to\/foo\" [] -\<- \"bar\")@

See 'exec', 'runprog', '(->-)', '(=>-)'.
-}
(-<-) :: IO a
      -> FilePath
      -> IO a
-<- :: forall a. IO a -> String -> IO a
(-<-) = Handle -> IOMode -> IO a -> String -> IO a
forall {b}. Handle -> IOMode -> IO b -> String -> IO b
redirect_helper Handle
stdin IOMode
ReadMode


{- | Send the error output of the specified action to its standard output.

What's actually modified is the @stdout@ handle, not the file descriptor 1. The
@exec@ functions know about this. See "HsShellScript#fdpipes" and
"HsShellScript#exec" for details.

>err_to_out = redirect stderr stdout

See 'redirect'.
-}
err_to_out :: IO a -> IO a
err_to_out :: forall a. IO a -> IO a
err_to_out = Handle -> Handle -> IO a -> IO a
forall a. Handle -> Handle -> IO a -> IO a
redirect Handle
stderr Handle
stdout


{- | Send the output of the specified action to its standard error output.

What's actually modified is the @stderr@ handle, not the file descriptor 2. The
@exec@ functions know about this. See "HsShellScript#fdpipes" and
"HsShellScript#exec" for details.

>redirect stdout stderr

See 'redirect'.
-}
out_to_err :: IO a -> IO a
out_to_err :: forall a. IO a -> IO a
out_to_err = Handle -> Handle -> IO a -> IO a
forall a. Handle -> Handle -> IO a -> IO a
redirect Handle
stdout Handle
stderr


-- Run an IO action as a new process, and optionally connect its
-- stdin, stdout and stderr via pipes.
pipe_fork_dup :: IO a                   -- Action to run in a new process.
              -> Bool                   -- make stdin pipe?
              -> Bool                   -- make stdout pipe?
              -> Bool                   -- make stderr pipe?
              -> IO ( Maybe Handle      -- Handle to the new process's stdin, if applicable.
                    , Maybe Handle      -- Handle to the new process's stdout, if applicable.
                    , Maybe Handle      -- Handle to the new process's stderr, if applicable.
                    , ProcessID
                    )
pipe_fork_dup :: forall a.
IO a
-> Bool
-> Bool
-> Bool
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessID)
pipe_fork_dup IO a
io Bool
fd0 Bool
fd1 Bool
fd2 = do
    IO ()
flush_outerr

    Maybe (Fd, Fd)
pipe0 <- Bool -> IO (Maybe (Fd, Fd))
pipe_if Bool
fd0
    Maybe (Fd, Fd)
pipe1 <- Bool -> IO (Maybe (Fd, Fd))
pipe_if Bool
fd1
    Maybe (Fd, Fd)
pipe2 <- Bool -> IO (Maybe (Fd, Fd))
pipe_if Bool
fd2

    ProcessID
pid <- IO () -> IO ProcessID
forkProcess (do -- child
                           Maybe (Fd, Fd) -> Handle -> Bool -> IO ()
dup_close Maybe (Fd, Fd)
pipe0 Handle
stdin Bool
True
                           Maybe (Fd, Fd) -> Handle -> Bool -> IO ()
dup_close Maybe (Fd, Fd)
pipe1 Handle
stdout Bool
False
                           Maybe (Fd, Fd) -> Handle -> Bool -> IO ()
dup_close Maybe (Fd, Fd)
pipe2 Handle
stderr Bool
False
                           IO a -> IO ()
forall a b. IO a -> IO b
child IO a
io
                       )
    -- parent
    Maybe Handle
h0 <- Maybe (Fd, Fd) -> Bool -> IO (Maybe Handle)
finish_pipe Maybe (Fd, Fd)
pipe0 Bool
True
    Maybe Handle
h1 <- Maybe (Fd, Fd) -> Bool -> IO (Maybe Handle)
finish_pipe Maybe (Fd, Fd)
pipe1 Bool
False
    Maybe Handle
h2 <- Maybe (Fd, Fd) -> Bool -> IO (Maybe Handle)
finish_pipe Maybe (Fd, Fd)
pipe2 Bool
False
    (Maybe Handle, Maybe Handle, Maybe Handle, ProcessID)
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessID)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Handle
h0, Maybe Handle
h1, Maybe Handle
h2, ProcessID
pid)

  where
     -- Make a pipe, if applicable.
     pipe_if :: Bool -> IO (Maybe (Fd, Fd))
pipe_if Bool
False = Maybe (Fd, Fd) -> IO (Maybe (Fd, Fd))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Fd, Fd)
forall a. Maybe a
Nothing
     pipe_if Bool
True  = do
        (Fd
read, Fd
write) <- IO (Fd, Fd)
createPipe
        Maybe (Fd, Fd) -> IO (Maybe (Fd, Fd))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ((Fd, Fd) -> Maybe (Fd, Fd)
forall a. a -> Maybe a
Just (Fd
read,Fd
write))

     -- Child work after fork: connect a fd of the new process to the pipe.
     dup_close :: Maybe (Fd, Fd)        -- maybe the pipe
               -> Handle                -- which handle to connect to the pipe
               -> Bool                  -- whether the child reads from this pipe
               -> IO ()
     dup_close :: Maybe (Fd, Fd) -> Handle -> Bool -> IO ()
dup_close Maybe (Fd, Fd)
Nothing Handle
_ Bool
_ =
         () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     dup_close m :: Maybe (Fd, Fd)
m@(Just (Fd
readend,Fd
writeend)) Handle
dest Bool
True =
         do
            Handle
h <- Fd -> IO Handle
System.Posix.fdToHandle Fd
readend
            Handle -> Handle -> IO ()
hDuplicateTo Handle
h Handle
dest
            Handle -> Bool -> IO ()
hSetBinaryMode Handle
dest Bool
False -- Use Text mode for the new handle by default. 
            Handle -> IO ()
hClose Handle
h
            Fd -> IO ()
closeFd Fd
writeend
     dup_close m :: Maybe (Fd, Fd)
m@(Just (Fd
readend,Fd
writeend)) Handle
dest Bool
False =
         do 
            Handle
h <- Fd -> IO Handle
System.Posix.fdToHandle Fd
writeend
            Handle -> Handle -> IO ()
hDuplicateTo Handle
h Handle
dest
            Handle -> Bool -> IO ()
hSetBinaryMode Handle
dest Bool
False -- Use Text mode for the new handle by default. 
            Handle -> IO ()
hClose Handle
h
            Fd -> IO ()
closeFd Fd
readend

     -- Parent work after fork: close surplus end of the pipe and make a handle from the other end.
     finish_pipe :: Maybe (Fd, Fd)      -- maybe the pipe
                 -> Bool                -- whether the fd is for reading
                 -> IO (Maybe Handle)
     finish_pipe :: Maybe (Fd, Fd) -> Bool -> IO (Maybe Handle)
finish_pipe Maybe (Fd, Fd)
Nothing Bool
_ =
         Maybe Handle -> IO (Maybe Handle)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Handle
forall a. Maybe a
Nothing
     finish_pipe (Just (Fd
readend,Fd
writeend)) Bool
read =
         do Fd -> IO ()
closeFd (if Bool
read then Fd
readend else Fd
writeend)
            let fd :: Fd
fd = if Bool
read then Fd
writeend else Fd
readend
            Handle
h <- Fd -> IO Handle
System.Posix.fdToHandle Fd
fd
            -- Use Text mode for the new handle by default.
            Handle -> Bool -> IO ()
hSetBinaryMode Handle
h Bool
False
            Maybe Handle -> IO (Maybe Handle)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Handle -> Maybe Handle
forall a. a -> Maybe a
Just Handle
h)


-- |
-- Run an IO action as a separate process, and pipe some text to its @stdin@.
-- Then close the pipe and wait for the child process to finish.
--
-- This forks a child process, which executes the specified action. The specified
-- text is sent to the action's @stdin@ through a pipe. Then the pipe is closed.
-- In case the action replaces the process by calling an @exec@ variant, it is
-- made sure that the process gets the text on it's file descriptor 0.
--
-- In case the action fails (exits with an exit status other than 0, or is
-- terminated by a signal), the @ProcessStatus@ is thrown, such as reported by
-- 'System.Posix.getProcessStatus'. No attempt is made to create more meaningful
-- exceptions, like it is done by @runprog@/@subproc@.
--
-- Exceptions in the action result in an error message on @stderr@, and the
-- termination of the child. The parent gets a @ProcessStatus@ exception, with
-- the value of @Exited (ExitFailure 1)@. The following exceptions are
-- understood, and result in corresponding messages: @ArgError@,
-- @ProcessStatus@, @RunError@, @IOError@ and @ExitCode@. Other exceptions
-- result in the generic message, as produced by @show@.
--
-- Unless you replace the child process, calling an @exec@ variant, the child
-- should let the control flow leave the action normally.
-- The child process is then properly terminated, such
-- that no resources, which have been duplicated by the fork, cause problems.
-- See "HsShellScript#subr" for details.
--
-- The pipe is set to /text mode/. This means that the Unicode characters in
-- the text are converted to the system character set. If you need to pipe binary
-- data, you should use @h_pipe_to@, and set the returned handle to binary
-- mode. This is accomplished by @'hSetBinaryMode' h True@. The system
-- character set is determined by the environment variable @LANG@.
--
-- Example:
--
-- >pipe_to "blah" (exec "/usr/bin/foo" ["bar"])
--
-- Example: Access both @stdin@ and @stdout@ of an external program.
--
-- >import HsShellScript
-- >
-- >main = mainwrapper $ do
-- >
-- >   res <- pipe_from $
-- >      pipe_to "2\n3\n1" $
-- >         exec "/usr/bin/sort" []
-- >
-- >   putStrLn res
--
--
-- See 'subproc', 'runprog', '-<-', 'h_pipe_to'.
pipe_to :: String       -- ^ Text to pipe
        -> IO a         -- ^ Action to run as a separate process, and to pipe to
        -> IO ()
pipe_to :: forall a. String -> IO a -> IO ()
pipe_to String
str IO a
io = do
   (Handle
h, ProcessID
pid) <- IO a -> IO (Handle, ProcessID)
forall a. IO a -> IO (Handle, ProcessID)
h_pipe_to IO a
io
   Handle -> String -> IO ()
hPutStr Handle
h String
str
   Handle -> IO ()
hClose Handle
h
   (Just ProcessStatus
ps) <- Bool -> Bool -> ProcessID -> IO (Maybe ProcessStatus)
getProcessStatus Bool
True Bool
False ProcessID
pid
   if ProcessStatus
ps ProcessStatus -> ProcessStatus -> Bool
forall a. Eq a => a -> a -> Bool
== ExitCode -> ProcessStatus
Exited ExitCode
ExitSuccess
       then () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
       else ProcessStatus -> IO ()
forall a e. Exception e => e -> a
throw ProcessStatus
ps


-- |
-- Run an IO action as a separate process, and get a connection (a pipe) to
-- its @stdin@ as a file handle.
--
-- This forks a subprocess, which executes the specified action. A file handle,
-- which is connected to its @stdin@, is returned. The child's @ProcessID@
-- is returned as well. If the action replaces the child process, by calling an
-- @exec@ variant, it is made sure that its file descriptor 0 is connected to
-- the returned file handle.
--
-- This gives you full control of the pipe, and of the forked process. But you
-- need to deal with the child process by yourself.
--
-- Unless you replace the child process, calling an @exec@ variant, the child
-- should let the control flow leave the action normally.
-- The child process is then properly terminated, such
-- that no resources, which have been duplicated by the fork, cause problems.
-- See "HsShellScript#subr" for details.
--
-- Errors can only be detected by examining the child's process status (using
-- 'System.Posix.Process.getProcessStatus'). If the child action throws an
-- exception, an error message is printed on @stderr@, and the child process
-- exits with a @ProcessStatus@ of @Exited
-- (ExitFailure 1)@. The following exceptions are understood, and
-- result in corresponding messages: @ArgError@, @ProcessStatus@, @RunError@,
-- @IOError@ and @ExitCode@. Other exceptions result in the generic message, as
-- produced by @show@.
--
-- If the child process exits in a way which signals an error, the
-- corresponding @ProcessStatus@ is returned by @getProcessStatus@. See
-- 'System.Posix.Process.getProcessStatus' for details.
--
-- The pipe is set to /text mode/. This means that the Unicode characters in the
-- text are converted to the system character set. You can set the returned
-- handle to binary mode, by calling @'hSetBinaryMode' handle True@. The system
-- character set is determined by the environment variable @LANG@.
--
-- Example:
--
-- >(handle, pid) <- h_pipe_to $ exec "/usr/bin/foo" ["bar"]
-- >hPutStrLn handle "Some text to go through the pipe"
-- >(Just ps) <- getProcessStatus True False pid
-- >when (ps /= Exited ExitSuccess) $
-- >   throw ps
--
-- See '-<-', 'pipe_to', 'pipe_from', 'pipe_from2'. See "HsShellScript#fdpipes" for more details.
h_pipe_to :: IO a                       -- ^ Action to run as a separate process, and to pipe to
          -> IO (Handle, ProcessID)     -- ^ Returns handle connected to the standard input of the child process,
                                        --   and the child's process ID
h_pipe_to :: forall a. IO a -> IO (Handle, ProcessID)
h_pipe_to IO a
io = do
   (Just Handle
h, Maybe Handle
_, Maybe Handle
_, ProcessID
pid) <- IO a
-> Bool
-> Bool
-> Bool
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessID)
forall a.
IO a
-> Bool
-> Bool
-> Bool
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessID)
pipe_fork_dup IO a
io Bool
True Bool
False Bool
False
   (Handle, ProcessID) -> IO (Handle, ProcessID)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Handle
h, ProcessID
pid)


-- | Run an IO action as a separate process, and read its @stdout@ strictly.
-- Then wait for the child process to finish. This is like the backquote feature
-- of shells.
--
-- This forks a child process, which executes the specified action. The output
-- of the child is read from its standard output. In case it replaces the
-- process by calling an @exec@ variant, it is make sure that the output is
-- read from the new process' file descriptor 1.
--
-- The end of the child's output is reached when either the standard output is
-- closed, or the child process exits. The program blocks until the action
-- exits, even if the child closes its standard output earlier. So the parent
-- process always notices a failure of the action (when it exits in a way which
-- indicates an error).
--
-- When the child action exits in a way which indicates an error, the
-- corresponding @ProcessStatus@ is thrown. See
-- 'System.Posix.Process.getProcessStatus'. No attempt is made to create more
-- meaningful exceptions, like it is done by @runprog@/@subproc@.
--
-- Exceptions in the action result in an error message on @stderr@, and the
-- proper termination of the child. The parent gets a @ProcessStatus@ exception, with
-- the value of @Exited (ExitFailure 1)@. The following exceptions are
-- understood, and result in corresponding messages: @ArgError@,
-- @ProcessStatus@, @RunError@, @IOError@ and @ExitCode@. Other exceptions
-- result in the generic message, as produced by @show@.
--
-- Unless you replace the child process, calling an @exec@ variant, the child
-- should let the control flow leave the action normally. The child process is
-- then properly terminated, such that no resources, which have been duplicated
-- by the fork, cause problems. See "HsShellScript#subr" for details.
--
-- Unlike shells\' backquote feature, @pipe_from@ does not remove any trailing
-- newline characters. The entire output of the action is returned. You might want
-- to apply @chomp@ to the result.
--
-- The pipe is set to /text mode/. This means that the Unicode characters in the
-- text, which is read from stdin, is converted from the system character set to
-- Unicode. The system character set is determined by the environment variable
-- @LANG@. If you need to read binary data from the forked process, you should use
-- @h_pipe_from@ and set the returned handle to binary mode. This is
-- accomplished by @'hSetBinaryMode' h True@.
--
-- Example:
--
-- >output <- pipe_from $ exec "/bin/mount" []
--
-- Example: Access both @stdin@ and @stdout@ of an external program.
--
-- >import HsShellScript
-- >
-- >main = mainwrapper $ do
-- >
-- >   res <- pipe_from $
-- >      pipe_to "2\n3\n1" $
-- >         exec "/usr/bin/sort" []
-- >
-- >   putStrLn res
--
-- See 'exec', 'pipe_to', 'pipe_from2', 'h_pipe_from', 'lazy_pipe_from', 'HsShellScript.Misc.chomp', 'silently'.
pipe_from :: IO a               -- ^ Action to run as a separate process. Its
                                -- return value is ignored.
          -> IO String          -- ^ The action's standard output
pipe_from :: forall a. IO a -> IO String
pipe_from IO a
io = do
   (Handle
h, ProcessID
pid) <- IO a -> IO (Handle, ProcessID)
forall a. IO a -> IO (Handle, ProcessID)
h_pipe_from IO a
io
   String
txt <- Handle -> IO String
hGetContents Handle
h
   Int -> IO () -> IO ()
forall a b. a -> b -> b
seq (String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
txt) (Handle -> IO ()
hClose Handle
h)
   (Just ProcessStatus
ps) <- Bool -> Bool -> ProcessID -> IO (Maybe ProcessStatus)
System.Posix.getProcessStatus Bool
True Bool
False ProcessID
pid
   if ProcessStatus
ps ProcessStatus -> ProcessStatus -> Bool
forall a. Eq a => a -> a -> Bool
== ExitCode -> ProcessStatus
Exited ExitCode
ExitSuccess
       then String -> IO String
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return String
txt
       else ProcessStatus -> IO String
forall a e. Exception e => e -> a
throw ProcessStatus
ps


-- | Run an IO action as a separate process, and read its standard error output
-- strictly. Then wait for the child process to finish. This is like the
-- backquote feature of shells. This function is exactly the same as
-- @pipe_from@, except that the standard error output is read, instead of the
-- standard output.
--
-- This forks a child process, which executes the specified action. The error output
-- of the child is read from its standard error output. In case it replaces the
-- process by calling an @exec@ variant, it is made sure that the output is
-- read from the new process' file descriptor 2.
--
-- The end of the child's error output is reached when either the standard error
-- output is closed, or the child process exits. The program blocks until the
-- action exits, even if the child closes its standard error output earlier. So
-- the parent process always notices a failure of the action (which means it
-- exits in a way which indicates an error).
--
-- When the child action exits in a way which indicates an error, the
-- corresponding @ProcessStatus@ is thrown. See
-- 'System.Posix.Process.getProcessStatus'.
-- No attempt is made to create
-- more meaningful exceptions, like it is done by @runprog@/@subproc@.
--
--
-- Exceptions in the action result in an error message on @stderr@, and the
-- proper termination of the child. This means that the error message is sent
-- through the pipe, to the parent process. The message can be found in the text
-- which has been read from the child process. It doesn't appear on the console.
--
-- The parent gets a @ProcessStatus@ exception, with
-- the value of @Exited (ExitFailure 1)@. The following exceptions are
-- understood, and result in corresponding messages: @ArgError@,
-- @ProcessStatus@, @RunError@, @IOError@ and @ExitCode@. Other exceptions
-- result in the generic message, as produced by @show@.
--
-- Unless you replace the child process, calling an @exec@ variant, the child
-- should let the control flow leave the action normally. The child process is
-- then properly terminated, such that no resources, which have been duplicated
-- by the fork, cause problems. See "HsShellScript#subr" for details.
--
-- Unlike shells\' backquote feature, @pipe_from2@ does not remove any trailing
-- newline characters. The entire error output of the action is returned. You might want
-- to apply @chomp@ to the result.
--
-- The pipe is set to /text mode/. This means that the Unicode characters in the
-- text, which is read from stdin, is converted from the system character set to
-- Unicode. The system character set is determined by the environment variable
-- @LANG@. If you need to read binary data from the forked process, you should use
-- @h_pipe_from@ and set the returned handle to binary mode. This is
-- accomplished by @'hSetBinaryMode' h True@.
--
-- Example:
--
-- >output <- pipe_from $ exec "/bin/mount" []
--
-- Example: Access both @stdin@ and @stdout@ of an external program.
--
-- >import HsShellScript
-- >
-- >main = mainwrapper $ do
-- >
-- >   res <- pipe_from $
-- >      pipe_to "2\n3\n1" $
-- >         exec "/usr/bin/sort" []
-- >
-- >   putStrLn res
--
-- See 'exec', 'pipe_to', 'pipe_from', 'h_pipe_from2', 'lazy_pipe_from2', 'silently'.
-- See "HsShellScript#fdpipes" for more details.

pipe_from2 :: IO a              -- ^ Action to run as a separate process
           -> IO String         -- ^ The action's standard error output
pipe_from2 :: forall a. IO a -> IO String
pipe_from2 IO a
io = do
   (Handle
h, ProcessID
pid) <- IO a -> IO (Handle, ProcessID)
forall a. IO a -> IO (Handle, ProcessID)
h_pipe_from2 IO a
io
   String
txt <- Handle -> IO String
hGetContents Handle
h
   Int -> IO () -> IO ()
forall a b. a -> b -> b
seq (String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
txt) (Handle -> IO ()
hClose Handle
h)
   (Just ProcessStatus
ps) <- Bool -> Bool -> ProcessID -> IO (Maybe ProcessStatus)
System.Posix.getProcessStatus Bool
True Bool
False ProcessID
pid
   if ProcessStatus
ps ProcessStatus -> ProcessStatus -> Bool
forall a. Eq a => a -> a -> Bool
== ExitCode -> ProcessStatus
Exited ExitCode
ExitSuccess
       then String -> IO String
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return String
txt
       else ProcessStatus -> IO String
forall a e. Exception e => e -> a
throw ProcessStatus
ps


-- | Run an IO action as a separate process, and connect to its @stdout@
-- with a file handle.
-- This is like the backquote feature of shells.
--
-- This forks a subprocess, which executes the specified action. A file handle,
-- which is connected to its @stdout@, is returned. The child's @ProcessID@
-- is returned as well. If the action replaces the child process, by calling an
-- @exec@ variant, it is made sure that its file descriptor 1 is connected to
-- the returned file handle.
--
-- This gives you full control of the pipe, and of the forked process. But you
-- need to deal with the child process by yourself.
--
-- When you call @getProcessStatus@ blockingly, you must first ensure that all
-- data has been read, or close the handle. Otherwise you'll get a deadlock.
-- When you close the handle before all data has been read, then the child gets
-- a @SIGPIPE@ signal.
--
-- Unless you replace the child process, calling an @exec@ variant, the child
-- should let the control flow leave the action normally.
-- The child process is then properly terminated, such
-- that no resources, which have been duplicated by the fork, cause problems.
-- See "HsShellScript#subr" for details.
--
-- Errors can only be detected by examining the child's process status (using
-- 'System.Posix.Process.getProcessStatus'). No attempt is made to create more
-- meaningful exceptions, like it is done by @runprog@/@subproc@. If the child
-- action throws an exception, an error message is printed on @stderr@, and the
-- child process exits with a @ProcessStatus@ of @Exited (ExitFailure 1)@. The
-- following exceptions are understood, and result in corresponding messages:
-- @ArgError@, @ProcessStatus@, @RunError@, @IOError@ and @ExitCode@. Other
-- exceptions result in the generic message, as produced by @show@.
--
-- The pipe is set to /text mode/. This means that the Unicode characters in the
-- text, which is read from stdin, is converted from the system character set to
-- Unicode. The system character set is determined by the environment variable
-- @LANG@. If you need to read binary data from the forked process, you can set
-- the returned handle to binary mode. This is accomplished by @'hSetBinaryMode'
-- h True@.
--
-- Example:
--
-- >(h,pid) <- h_pipe_from $ exec "/usr/bin/foo" ["bar"]
--
-- See 'exec', 'pipe_to', 'h_pipe_from2', 'pipe_from', 'lazy_pipe_from', 'HsShellScript.Misc.chomp', 'silently'.
-- See "HsShellScript#fdpipes" for more details.
h_pipe_from :: IO a                             -- ^ Action to run as a separate process, and to pipe from
            -> IO (Handle, ProcessID)           -- ^ Returns handle connected to the standard output of the child
                                                -- process, and the child's process ID
h_pipe_from :: forall a. IO a -> IO (Handle, ProcessID)
h_pipe_from IO a
io = do
   (Maybe Handle
_, Just Handle
h, Maybe Handle
_, ProcessID
pid) <- IO a
-> Bool
-> Bool
-> Bool
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessID)
forall a.
IO a
-> Bool
-> Bool
-> Bool
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessID)
pipe_fork_dup IO a
io Bool
False Bool
True Bool
False
   (Handle, ProcessID) -> IO (Handle, ProcessID)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Handle
h, ProcessID
pid)


-- | Run an IO action as a separate process, and connect to its @stderr@
-- with a file handle.
--
-- This forks a subprocess, which executes the specified action. A file handle,
-- which is connected to its @stderr@, is returned. The child's @ProcessID@
-- is returned as well. If the action replaces the child process, by calling an
-- @exec@ variant, it is made sure that its file descriptor 2 is connected to
-- the returned file handle.
--
-- This gives you full control of the pipe, and of the forked process. But you
-- need to deal with the child process by yourself.
--
-- When you call @getProcessStatus@ blockingly, you must first ensure that all
-- data has been read, or close the handle. Otherwise you'll get a deadlock.
-- When you close the handle before all data has been read, then the child gets
-- a @SIGPIPE@ signal.
--
-- Unless you replace the child process, calling an @exec@ variant, the child
-- should let the control flow leave the action normally. The child process is
-- then properly terminated, such that no resources, which have been duplicated
-- by the fork, cause problems. See "HsShellScript#subr" for details.
--
-- Errors can only be detected by examining the child's process status (using
-- 'System.Posix.Process.getProcessStatus'). No attempt is made to create more
-- meaningful exceptions, like it is done by @runprog@/@subproc@. If the child
-- action throws an exception, an error message is printed on @stderr@. This
-- means that the message goes through the pipe to the parent process. Then the
-- child process exits with a @ProcessStatus@ of @Exited (ExitFailure 1)@. The
-- following exceptions are understood, and result in corresponding messages:
-- @ArgError@, @ProcessStatus@, @RunError@, @IOError@ and @ExitCode@. Other
-- exceptions result in the generic message, as produced by @show@.
--
-- The pipe is set to /text mode/. This means that the Unicode characters in the
-- text, which is read from stdin, is converted from the system character set to
-- Unicode. The system character set is determined by the environment variable
-- @LANG@. If you need to read binary data from the forked process, you can set
-- the returned handle to binary mode. This is accomplished by @'hSetBinaryMode'
-- h True@.
--
-- Example:
--
-- >(h,pid) <- h_pipe_from $ exec "/usr/bin/foo" ["bar"]
--
-- See 'exec', 'pipe_from', 'pipe_from2', 'h_pipe_from', 'pipe_to',
-- 'lazy_pipe_from', 'HsShellScript.Misc.chomp', 'silently'.
h_pipe_from2 :: IO a                             -- ^ Action to run as a separate process, and to pipe from
             -> IO (Handle, ProcessID)           -- ^ Returns handle connected to the standard output of the child
                                                 -- process, and the child's process ID
h_pipe_from2 :: forall a. IO a -> IO (Handle, ProcessID)
h_pipe_from2 IO a
io = do
   (Maybe Handle
_, Maybe Handle
_, Just Handle
h, ProcessID
pid) <- IO a
-> Bool
-> Bool
-> Bool
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessID)
forall a.
IO a
-> Bool
-> Bool
-> Bool
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessID)
pipe_fork_dup IO a
io Bool
False Bool
False Bool
True
   (Handle, ProcessID) -> IO (Handle, ProcessID)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Handle
h, ProcessID
pid)




-- | Run an IO action in a separate process, and read its standard output, The output
-- is read lazily, as the returned string is evaluated. The child's output along
-- with its process ID are returned.
--
-- This forks a child process, which executes the specified action. The output
-- of the child is read lazily through a pipe, which connncts to its standard
-- output. In case the child replaces the process by calling an @exec@ variant,
-- it is make sure that the output is read from the new process' file descriptor
-- 1.
--
-- @lazy_pipe_from@ calls 'System.IO.hGetContents', in order to read the pipe
-- lazily. This means that the file handle goes to semi-closed state. The handle
-- holds a file descriptor, and as long as the string isn't fully evaluated,
-- this file descriptor won't be closed. For the file descriptor to be closed,
-- first its standard output needs to be closed on the child side. This happens
-- when the child explicitly closes it, or the child process exits. When
-- afterwards the string on the parent side is completely evaluated, the handle,
-- along with the file descritor it holds, are closed and freed.
--
-- If you use the string in such a way that you only access the beginning of the
-- string, the handle will remain in semi-closed state, holding a file
-- descriptor, even when the pipe is closed on the child side. When you do that
-- repeatedly, you may run out of file descriptors.
--
-- Unless you're sure that your program will reach the string's end, you should
-- take care for it explicitly, by doing something like this:
--
-- >(output, pid) <- lazy_pipe_from (exec "\/usr\/bin\/foobar" [])
-- >...
-- >seq (length output) (return ())
--
-- This will read the entire standard output of the child, even if it isn't
-- needed. You can't cut the child process' output short, when you use
-- @lazy_pipe_from@. If you need to do this, you should use @h_pipe_from@, which
-- gives you the handle, which can then be closed by 'System.IO.hClose', even
-- if the child's output isn't completed:
--
-- >(h, pid) <- h_pipe_from io
-- >
-- >-- Lazily read io's output
-- >output <- hGetContents h
-- >...
-- >-- Not eveyting read yet, but cut io short.
-- >hClose h
-- >
-- >-- Wait for io to finish, and detect errors
-- >(Just ps) <- System.Posix.getProcessStatus True False pid
-- >when (ps /= Exited ExitSuccess) $
-- >   throw ps
--
-- When you close the handle before all data has been read, then the child gets
-- a @SIGPIPE@ signal.
--
-- After all the output has been read, you should call @getProcessStatus@ on the
-- child's process ID, in order to detect errors. Be aware that you must
-- evaluate the whole string, before calling @getProcessStatus@ blockingly, or
-- you'll get a deadlock.
--
-- You won't get an exception, if the child action exits in a way which
-- indicates an error. Errors occur asynchronously, when the output string is
-- evaluated. You must detect errors by yourself, by calling
-- 'System.Posix.Process.getProcessStatus'.
--
-- In case the action doesn't replace the child process with an external
-- program, an exception may be thrown out of the action. This results in an error
-- message on @stderr@, and the proper termination of the child. The
-- @ProcessStatus@, which can be accessed in the parent process by
-- @getProcessStatus@, is @Exited (ExitFailure 1)@. The following exceptions are
-- understood, and result in corresponding messages: @ArgError@,
-- @ProcessStatus@, @RunError@, @IOError@ and @ExitCode@. Other exceptions
-- result in the generic message, as produced by @show@.
--
-- Unless you replace the child process, calling an @exec@ variant, the child
-- should let the control flow leave the action normally. The child process is
-- then properly terminated, such that no resources, which have been duplicated
-- by the fork, cause problems. See "HsShellScript#subr" for details.
--
-- Unlike shells\' backquote feature, @lazy_pipe_from@ does not remove any trailing
-- newline characters. The entire output of the action is returned. You might want
-- to apply @chomp@ to the result.
--
-- The pipe is set to /text mode/. This means that the Unicode characters in the
-- text, which is read from the IO action's stdout, are converted from the system
-- character set to Unicode. The system character set is determined by the
-- environment variable @LANG@. If you need to read binary data from the forked
-- process, you should use h_pipe_from and set the returned handle to binary mode.
-- This is accomplished by @'hSetBinaryMode' h True@. Then you can lazily read 
-- the output of the action from the handle.
--
-- Example: Lazily read binary data from an IO action. Don't forget to collect 
-- the child process later, using @'System.Posix.getProcessStatus' True False pid@.
--
-- >(h, pid) <- h_pipe_from io
-- >hSetBinaryMode h True
-- >txt <- hGetContents h
-- >...
-- >(Just ps) <- System.Posix.getProcessStatus True False pid
--
-- See 'exec', 'pipe_to', 'pipe_from', 'h_pipe_from', 'lazy_pipe_from2', 'silently'.
lazy_pipe_from :: IO a                          -- ^ Action to run as a separate process
               -> IO (String, ProcessID)        -- ^ The action's lazy output and the process ID of the child
                                                -- process
lazy_pipe_from :: forall a. IO a -> IO (String, ProcessID)
lazy_pipe_from IO a
io = do
   (Maybe Handle
_, Just Handle
h, Maybe Handle
_, ProcessID
pid) <- IO a
-> Bool
-> Bool
-> Bool
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessID)
forall a.
IO a
-> Bool
-> Bool
-> Bool
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessID)
pipe_fork_dup IO a
io Bool
False Bool
True Bool
False
   String
txt <- Handle -> IO String
hGetContents Handle
h
   (String, ProcessID) -> IO (String, ProcessID)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (String
txt, ProcessID
pid)


-- | Run an IO action in a separate process, and read its standard error output, The output
-- is read lazily, as the returned string is evaluated. The child's error output along
-- with its process ID are returned.
--
-- This forks a child process, which executes the specified action. The error output
-- of the child is read lazily through a pipe, which connncts to its standard error
-- output. In case the child replaces the process by calling an @exec@ variant,
-- it is make sure that the output is read from the new process' file descriptor
-- 1.
--
-- @lazy_pipe_from@ calls 'System.IO.hGetContents', in order to read the pipe
-- lazily. This means that the file handle goes to semi-closed state. The handle
-- holds a file descriptor, and as long as the string isn't fully evaluated,
-- this file descriptor won't be closed. For the file descriptor to be closed,
-- first its standard error output needs to be closed on the child side. This happens
-- when the child explicitly closes it, or the child process exits. When
-- afterwards the string on the parent side is completely evaluated, the handle,
-- along with the file descritor it holds, are closed and freed.
--
-- If you use the string in such a way that you only access the beginning of the
-- string, the handle will remain in semi-closed state, holding a file
-- descriptor, even when the pipe is closed on the child side. When you do that
-- repeatedly, you may run out of file descriptors.
--
-- Unless you're sure that your program will reach the string's end, you should
-- take care for it explicitly, by doing something like this:
--
-- >(errmsg, pid) <- lazy_pipe_from2 (exec "/usr/bin/foobar" [])
-- >...
-- >seq (length errmsg) (return ())
--
-- This will read the entire standard error output of the child, even if it isn't
-- needed. You can't cut the child process' output short, when you use
-- @lazy_pipe_from@. If you need to do this, you should use @h_pipe_from@, which
-- gives you the handle, which can then be closed by 'System.IO.hClose', even
-- if the child's output isn't completed:
--
-- >(h, pid) <- h_pipe_from io
-- >
-- >-- Lazily read io's output
-- >output <- hGetContents h
-- >...
-- >-- Not eveyting read yet, but cut io short.
-- >hClose h
-- >
-- >-- Wait for io to finish, and detect errors
-- >(Just ps) <- System.Posix.getProcessStatus True False pid
-- >when (ps /= Exited ExitSuccess) $
-- >   throw ps
--
-- When you close the handle before all data has been read, then the child gets
-- a @SIGPIPE@ signal.
--
-- After all the output has been read, you should call @getProcessStatus@ on the
-- child's process ID, in order to detect errors. Be aware that you must
-- evaluate the whole string, before calling @getProcessStatus@ blockingly, or
-- you'll get a deadlock.
--
-- You won't get an exception, if the child action exits in a way which
-- indicates an error. Errors occur asynchronously, when the output string is
-- evaluated. You must detect errors by yourself, by calling
-- 'System.Posix.Process.getProcessStatus'.
--
-- In case the action doesn't replace the child process with an external
-- program, an exception may be thrown out of the action. This results in an
-- error message on @stderr@. This means that the message is sent through the
-- pipe, to the parent process. Then the child process is properly terminated.
-- The @ProcessStatus@, which can be accessed in the parent process by
-- @getProcessStatus@, is @Exited (ExitFailure 1)@. The following exceptions are
-- understood, and result in corresponding messages: @ArgError@,
-- @ProcessStatus@, @RunError@, @IOError@ and @ExitCode@. Other exceptions
-- result in the generic message, as produced by @show@.
--
-- Unless you replace the child process, calling an @exec@ variant, the child
-- should let the control flow leave the action normally. The child process is
-- then properly terminated, such that no resources, which have been duplicated
-- by the fork, cause problems. See "HsShellScript#subr" for details.
--
-- The pipe is set to /text mode/. This means that the Unicode characters in the
-- text, which is read from stdin, is converted from the system character set to
-- Unicode. The system character set is determined by the environment variable
-- @LANG@. If you need to read binary data from the forked process, you can set
-- the returned handle to binary mode. This is accomplished by @'hSetBinaryMode'
-- h True@.
--
-- Unlike shells\' backquote feature, @lazy_pipe_from@ does not remove any trailing
-- newline characters. The entire output of the action is returned. You might want
-- to apply @chomp@ to the result.
--
-- The pipe is set to /text mode/. This means that the Unicode characters in the
-- text, which is read from the IO action's stdout, are converted from the
-- system character set to Unicode. The system character set is determined by
-- the environment variable @LANG@. If you need to read binary data from the
-- forked process' standard error output, you should use h_pipe_from2 and set
-- the returned handle to binary mode. This is accomplished by @'hSetBinaryMode'
-- h True@. Then you can lazily read the output of the action from the handle.
--
-- Example: Lazily read binary data from an IO action. Don't forget to collect 
-- the child process later, using @'System.Posix.getProcessStatus' True False pid@.
--
-- >(h, pid) <- h_pipe_from2 io
-- >hSetBinaryMode h True
-- >txt <- hGetContents h
-- >...
-- >(Just ps) <- System.Posix.getProcessStatus True False pid
--
-- See 'exec', 'pipe_to', 'pipe_from2', 'h_pipe_from2', 'lazy_pipe_from', 'silently'.
lazy_pipe_from2 :: IO a                          -- ^ Action to run as a separate process
                -> IO (String, ProcessID)        -- ^ The action's lazy output and the process ID of the child
                                                 -- process
lazy_pipe_from2 :: forall a. IO a -> IO (String, ProcessID)
lazy_pipe_from2 IO a
io = do
   (Maybe Handle
_, Maybe Handle
_, Just Handle
h, ProcessID
pid) <- IO a
-> Bool
-> Bool
-> Bool
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessID)
forall a.
IO a
-> Bool
-> Bool
-> Bool
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessID)
pipe_fork_dup IO a
io Bool
False Bool
False Bool
True
   String
txt <- Handle -> IO String
hGetContents Handle
h
   (String, ProcessID) -> IO (String, ProcessID)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (String
txt, ProcessID
pid)



-- | Run an IO action as a separate process, and read its @stdout@ strictly. All
-- the output is read, until the action terminates. Contrary to 'pipe_from',
-- when the action signals an error (with a non-zero exit code), the error isn't
-- thrown as an exception, but is returned alongside the output.
--
-- The result consists of the output which has been read, alongside with the
-- process status, with which the action has terminated. For success,
-- the process status is @Exited ExitSuccess@. See
-- 'System.Posix.Process.ProcessStatus'.
--
-- This is a frontend to the 'h_pipe_from' function. See there for more details.
--
-- See 'pipe_from_full2', 'exec', 'pipe_to', 'pipe_from', 'h_pipe_from', 'lazy_pipe_from', 'HsShellScript.Misc.chomp'.

pipe_from_full
  :: IO a                       -- ^ Action to run as a separate process. Its return value is ignored.
  -> IO (String, ProcessStatus) -- ^ The output of the IO action until it terminated and
                                -- the process status of the terminated action.

pipe_from_full :: forall a. IO a -> IO (String, ProcessStatus)
pipe_from_full IO a
io = do
   (Handle
h, ProcessID
pid) <- IO a -> IO (Handle, ProcessID)
forall a. IO a -> IO (Handle, ProcessID)
h_pipe_from IO a
io
   String
txt <- Handle -> IO String
hGetContents Handle
h
   Int -> IO () -> IO ()
forall a b. a -> b -> b
seq (String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
txt) (Handle -> IO ()
hClose Handle
h)
   (Just ProcessStatus
ps) <- Bool -> Bool -> ProcessID -> IO (Maybe ProcessStatus)
System.Posix.getProcessStatus Bool
True Bool
False ProcessID
pid
   (String, ProcessStatus) -> IO (String, ProcessStatus)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (String
txt, ProcessStatus
ps)


-- | Run an IO action as a separate process, and read its @stderr@ strictly. All
-- the error output is read, until the action terminates. Contrary to 'pipe_from2',
-- when the action signals an error (with a non-zero exit code), the error isn't
-- thrown as an exception, but is returned alongside the output.
--
-- The result consists of the error output which has been read, alongside with
-- the process status, with which the action has terminated. For success, the
-- process status is @Exited ExitSuccess@. See
-- 'System.Posix.Process.ProcessStatus'.
--
-- This is a frontend to the 'h_pipe_from2' function. See there for more details.
--
-- See 'pipe_from_full', 'exec', 'pipe_to', 'pipe_from', 'h_pipe_from', 'lazy_pipe_from',
-- 'HsShellScript.Misc.chomp'.

pipe_from_full2
  :: IO a                       -- ^ Action to run as a separate process. Its return value is ignored.
  -> IO (String, ProcessStatus) -- ^ The error output of the IO action until it terminated and
                                -- the process status of the terminated action.
pipe_from_full2 :: forall a. IO a -> IO (String, ProcessStatus)
pipe_from_full2 IO a
io = do
   (Handle
h, ProcessID
pid) <- IO a -> IO (Handle, ProcessID)
forall a. IO a -> IO (Handle, ProcessID)
h_pipe_from2 IO a
io
   String
txt <- Handle -> IO String
hGetContents Handle
h
   Int -> IO () -> IO ()
forall a b. a -> b -> b
seq (String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
txt) (Handle -> IO ()
hClose Handle
h)
   (Just ProcessStatus
ps) <- Bool -> Bool -> ProcessID -> IO (Maybe ProcessStatus)
System.Posix.getProcessStatus Bool
True Bool
False ProcessID
pid
   (String, ProcessStatus) -> IO (String, ProcessStatus)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (String
txt, ProcessStatus
ps)




-- | Run an IO action as a separate process, and optionally connect to its
-- @stdin@, its @stdout@ and its @stderr@ output with pipes.
--
-- This forks a subprocess, which executes the specified action. The child\'s
-- @ProcessID@ is returned. Some of the action\'s standard handles are made to
-- connected to pipes, which the caller can use in order to communicate with the
-- new child process. Which, this is determined by the first three arguments.
--   
-- You get full control of the pipes, and of the forked process. But you
-- need to deal with the child process by yourself.
--
-- Errors in the child process can only be detected by examining its process
-- status (using 'System.Posix.Process.getProcessStatus'). If the child action
-- throws an exception, an error message is printed on @stderr@, and the child
-- process exits with a @ProcessStatus@ of @Exited (ExitFailure 1)@. The
-- following exceptions are understood, and result in corresponding messages:
-- @ArgError@, @ProcessStatus@, @RunError@, @IOError@ and @ExitCode@. Other
-- exceptions result in the generic message, as produced by @show@.
--
-- Unless you replace the child process, calling an @exec@ variant, the child
-- should let the control flow leave the action normally. It is then properly 
-- take care of.
--
-- The pipes are set to /text mode/. When connecting to the child\'s @stdin@,
-- this means that the Unicode characters in the Haskell side text are converted
-- to the system character set. When reading from the child\'s @stdout@ or
-- @stderr@, the text is converted from the system character set to Unicode in
-- the Haskell-side strings. The system character set is determined by the
-- environment variable @LANG@. If you need to read or write binary data, then
-- this is no problem. Just call @'hSetBinaryMode' handle True@. This sets the
-- corresponding pipe to binary mode.
--
-- See 'pipe_from', 'h_pipe_from', 'pipe_from2', 'h_pipe_from2', 'pipe_to', 
-- 'h_pipe_to', 'lazy_pipe_from', 'lazy_pipe_from2'
pipes :: IO a                   -- ^ Action to run in a new process
      -> Bool                   -- ^ Whether to make stdin pipe
      -> Bool                   -- ^ Whether to make stdout pipe
      -> Bool                   -- ^ Whether to make stderr pipe
      -> IO ( Maybe Handle
            , Maybe Handle
            , Maybe Handle
            , ProcessID
            )                   -- ^ Pipes to the new process's @stdin@, @stdout@ and @stderr@, if applicable;
                                -- and its process id.
pipes :: forall a.
IO a
-> Bool
-> Bool
-> Bool
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessID)
pipes = IO a
-> Bool
-> Bool
-> Bool
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessID)
forall a.
IO a
-> Bool
-> Bool
-> Bool
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessID)
pipe_fork_dup


-- {- | Execute the supplied action. In case of an error, exit with an error
-- message.
--
-- > Noch nicht auf neue Exception-Bibliothek portiert. <
--
-- An error is an exception, thrown using @throw@ as a type which is
-- instance of @Typeable@. The type err is supposed to be a specific type used
-- for specific errors. The program is terminated with @exitFailure@.
-- -}
-- abort :: Exception err
--       => (err -> String)        -- ^ Error message generation function
--       -> IO a                   -- ^ IO action to monitor
--       -> IO a                   -- ^ Same action, but abort with error message in case of user exception
-- abort msgf io =
--    io
--    `catch` (\se -> hPutStrLn stderr (msgf errval) >> exitFailure)


{- | Forcibly terminate the program, circumventing normal program shutdown.

This is the @_exit(2)@ system call. No cleanup actions installed with @bracket@
are performed, no data buffered by file handles is written out, etc.
-}
_exit :: Int                    -- ^ Exit code
      -> IO a                   -- ^ Never returns
_exit :: forall a. Int -> IO a
_exit Int
ec = do
   CInt -> IO ()
_exit_prim (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
ec)
   String -> IO a
forall a. HasCallStack => String -> a
error String
"Impossible error" -- never reached, only for the type checker



-- | Generate an error message from an @errno@ value. This is the POSIX
-- @strerror@ system library function.
--
-- See the man page @strerror(3)@.
strerror :: Errno       -- ^ @errno@ value
         -> IO String   -- ^ Corresponding error message
strerror :: Errno -> IO String
strerror (Errno CInt
errno) = do
    CString -> IO String
peekCString ((\ CInt
x1 -> IO CString -> CString
forall a. IO a -> a
C2HSImp.unsafePerformIO (CInt -> IO CString
foreign_strerror CInt
x1)) CInt
errno)


-- | Read the global system error number. This is the POSIX @errno@ value. This
-- function is redundant. Use @Foreign.C.Error.getErrno@ instead.
errno :: IO Errno       -- ^ @errno@ value
errno :: IO Errno
errno = IO Errno
getErrno


-- | Print error message corresponding to the specified @errno@ error
-- number. This is similar to the POSIX system library function @perror@.
--
-- See the man page @perror(3)@.
perror' :: Errno        -- ^ @errno@ error number
        -> String       -- ^ Text to precede the message, separated by \"@: @\"
        -> IO ()
perror' :: Errno -> String -> IO ()
perror' Errno
errno String
txt = do
   String
str <- Errno -> IO String
strerror Errno
errno
   Handle -> String -> IO ()
hPutStrLn Handle
stderr ((if String
txt String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"" then String
"" else String
txt String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": ") String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
str)


-- | Print error message corresponding to the global @errno@ error
-- number. This is the same as the POSIX system library function @perror@.
--
-- See the man page @perror(3)@.
perror :: String        -- ^ Text to precede the message, separated by \"@: @\"
       -> IO ()
perror :: String -> IO ()
perror String
txt = do
   Errno
eno <- IO Errno
getErrno
   Errno -> String -> IO ()
perror' Errno
eno String
txt


-- | Print a message to @stderr@ and exit with an exit code
-- indicating an error.
--
-- >failIO msg = hPutStrLn stderr msg >> exitFailure
failIO :: String -> IO a
failIO :: forall a. String -> IO a
failIO String
meld =
   Handle -> String -> IO ()
hPutStrLn Handle
stderr String
meld IO () -> IO a -> IO a
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO a
forall a. IO a
exitFailure


-- | Modify an IO action to return the exit code of a failed program call,
-- instead of throwing an exception.
--
-- This is used to modify the error reporting behaviour of an IO action which
-- uses 'run'/'runprog' or 'call'/'subproc'. When an external program exits with
-- an exit code which indicates an error, normally an exception is thrown. After
-- @exitcode@ has been applied, the exit code is retruned instead.
--
-- The caught exceptions are 'RunError' and 'ProcessStatus'. Termination by a
-- signal is still reported by an exception, which is passed through.
--
-- Example: @ec \<- exitcode $ runprog \"foo\" [\"bar\"]@
--
-- See 'runprog', 'subproc', 'run', 'call'.
exitcode :: IO ()             -- ^ Action to modify
         -> IO ExitCode       -- ^ Modified action
exitcode :: IO () -> IO ExitCode
exitcode IO ()
io =
   do IO ()
io
      ExitCode -> IO ExitCode
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ExitCode
ExitSuccess
   IO ExitCode -> (ProcessStatus -> IO ExitCode) -> IO ExitCode
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch`
      (\ProcessStatus
processstatus ->
          case ProcessStatus
processstatus of
             (Exited ExitCode
ec) -> ExitCode -> IO ExitCode
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ExitCode
ec
             ProcessStatus
ps          -> ProcessStatus -> IO ExitCode
forall a e. Exception e => e -> a
throw ProcessStatus
ps)
   IO ExitCode -> (RunError -> IO ExitCode) -> IO ExitCode
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch`
      (\RunError
re ->
          case RunError -> ProcessStatus
re_ps RunError
re of
             (Exited ExitCode
ec) -> ExitCode -> IO ExitCode
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ExitCode
ec
             ProcessStatus
ps          -> RunError -> IO ExitCode
forall a e. Exception e => e -> a
throw RunError
re)


-- |Create and throw an @IOError@ from the current @errno@ value, an optional handle and an optional file name.
--
-- This is an extended version of the @Foreign.C.Error.throwErrno@ function
-- from the GHC libraries, which additionally allows to specify a handle and a file
-- name to include in the @IOError@ thrown.
--
-- See @Foreign.C.Error.throwErrno@, @Foreign.C.Error.errnoToIOError@.
throwErrno' :: String           -- ^ Description of the location where the error occurs in the program
            -> Maybe Handle     -- ^ Optional handle
            -> Maybe FilePath   -- ^ Optional file name (for failing operations on files)
            -> IO a
throwErrno' :: forall a. String -> Maybe Handle -> Maybe String -> IO a
throwErrno' String
loc Maybe Handle
maybe_handle Maybe String
maybe_filename =
  do
    Errno
errno <- IO Errno
getErrno
    IOError -> IO a
forall a. IOError -> IO a
ioError (String -> Errno -> Maybe Handle -> Maybe String -> IOError
errnoToIOError String
loc Errno
errno Maybe Handle
maybe_handle Maybe String
maybe_filename)


-- |Convert an @IOError@ to a string.
--
-- There is an instance declaration of @IOError@ in @Show@ in the @GHC.IO@ library, but @show_ioerror@ produces a
-- more readable, and more complete, message.
show_ioerror :: IOError -> String
show_ioerror :: IOError -> String
show_ioerror IOError
ioe =
   String
"IO-Error\n\
   \   Error type:   " String -> ShowS
forall a. [a] -> [a] -> [a]
++ IOErrorType -> String
forall a. Show a => a -> String
show (IOError -> IOErrorType
ioeGetErrorType IOError
ioe) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n\
   \   Location:     " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
none (ShowS
indent (IOError -> String
ioe_location IOError
ioe)) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n\
   \   Description:  " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
none (ShowS
indent (IOError -> String
ioe_description IOError
ioe)) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n\
   \   " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Maybe String -> String
fn (IOError -> Maybe String
ioeGetFileName IOError
ioe)
   where fn :: Maybe String -> String
fn (Just String
n) = String
"File name:    " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
quote String
n
         fn Maybe String
Nothing  = String
"File name:    (none)"
         none :: ShowS
none String
""  = String
"(none)"
         none String
msg = String
msg
         indent :: ShowS
indent String
txt = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (String -> [String] -> [String]
forall a. a -> [a] -> [a]
intersperse (String
"\n                 ") (String -> [String]
lines String
txt))


{- | Call the shell to execute a command. In case of an error, throw the @ProcessStatus@ (such as @(Exited
(ExitFailure ec))@) as an exception. This is like the Haskell standard library function @system@, except that error
handling is brought in accordance with HsShellScript\'s scheme.

@exitcode . system_throw@ is the same as the @system@ function, except that when the called shell is terminated or
stopped by a signal, this still lead to the @ProcessStatus@ being thrown. The Haskell library report says nothing
about what happens in this case, when using the @system@ function.

>system_throw cmd = run "/bin/sh" ["-c", "--", cmd]

This function is deprecated. You should rather use 'system_runprog', which provides for much better error
reporting.
-}
-- This function should go to HsShellScript.Shell, but this would introduce a circular dependency.
system_throw :: String -> IO ()
system_throw :: String -> IO ()
system_throw String
cmd =
   String -> [String] -> IO ()
run String
"/bin/sh" [String
"-c", String
"--", String
cmd]




{- | Call the shell to execute a command. In case of an error, a @RunError@ ist thrown. This is like the Haskell
standard library function @system@, except that error handling is brought in accordance with HsShellScript's
scheme. (It is /not/ a front end to @system@.)

>system_runprog cmd = runprog "/bin/sh" ["-c", "--", cmd]

Example: Call \"foo\" and report Errors as @IOError@s, rather than @RunError@s.

>as_ioe $ system_runprog "foo" ["bar", "baz"]

See 'RunError', 'as_ioe'
-}

-- This function should go to HsShellScript.Shell, but this would introduce a circular dependency.
system_runprog :: String -> IO ()
system_runprog :: String -> IO ()
system_runprog String
cmd =
   String -> [String] -> IO ()
runprog String
"/bin/sh" [String
"-c", String
"--", String
cmd]



{- | Run a subroutine as a child process, but don't let it produce any messages.
Read its @stdout@ and @stderr@ instead, and append it to the contents of a
mutable variable. The idea is that you can run some commands silently, and
report them and their messages to the user only when something goes wrong.

If the child process terminates in a way which indicates an error, then the
process status is thrown, in the same way as 'runprog' does. If the subroutine
throws an @(Exited ec)@ exception (of type @ProcessStatus@), such as thrown by
'runprog', then the child process exits with the same exit code, such that the
parent process reports it to the caller, again as a @ProcessStatus@ exception.

When the subroutine finishes, the child process is terminated with @'_exit' 0@.
When it throws an exception, an error message is printed and it is terminated
with @'_exit' 1@. See "HsShellScript#subr" for details.

The standard output (and the standard error output) of the parent process are
flushed before the fork, such that no output appears twice.

Example:

>let handler :: IORef String -> ProcessStatus -> IO ()
>    handler msgref ps = do hPutStrLn stderr ("Command failed with " ++ show ps ++ ". Actions so far: ")
>                           msg <- readIORef msgref
>                           hPutStrLn stderr msg
>                           exitWith (ExitFailure 1)
>
>msgref <- newIORef ""
>do silently msgref $ do putStrLn "Now doing foobar:"
>                        echo exec "/foo/bar" ["arguments"]
>   silently msgref $ echo exec "/bar/baz" ["arguments"]
>`catch` (handler msgref)

See 'lazy_pipe_from', 'subproc', 'runprog', Data.IORef.
-}
silently :: IORef.IORef String       -- ^ A mutable variable, which gets the output (stdout and stderr) of the
                                     -- action appended.
         -> IO ()                    -- ^ The IO action to run.
         -> IO ()
silently :: IORef String -> IO () -> IO ()
silently IORef String
ref IO ()
io = do
   (String
msg, ProcessID
pid) <- IO Any -> IO (String, ProcessID)
forall a. IO a -> IO (String, ProcessID)
lazy_pipe_from (IO Any -> IO Any
forall a. IO a -> IO a
err_to_out (IO () -> IO Any
forall a b. IO a -> IO b
child IO ()
io))
   Int -> IO () -> IO ()
forall a b. a -> b -> b
seq (String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
msg) (() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ())

   String
msgs <- IORef String -> IO String
forall a. IORef a -> IO a
readIORef IORef String
ref
   IORef String -> String -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef String
ref (String
msgs String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
msg)

   (Just ProcessStatus
ps) <- Bool -> Bool -> ProcessID -> IO (Maybe ProcessStatus)
getProcessStatus Bool
True Bool
False ProcessID
pid
   case ProcessStatus
ps of
      Exited ExitCode
ExitSuccess -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      ProcessStatus
ps                 -> ProcessStatus -> IO ()
forall a e. Exception e => e -> a
throw ProcessStatus
ps


{- | Modify a subroutine action in order to make it suitable to run as a child
   process.

   This is used by functions like 'call', 'silently', 'pipe_to' etc. The action
   is executed. When it returns, the (child) process is terminated with @'_exit' 0@
   (after flushing @stdout@), circumventing normal program shutdown. When it
   throws an exception, an error message is printed and the (child) process is
   terminated with @'_exit' 1@.
-}
child :: IO a           -- Action to modify
      -> IO b           -- Never returns
child :: forall a b. IO a -> IO b
child IO a
io = do
   IO a
io
      IO a -> [Handler a] -> IO a
forall a. IO a -> [Handler a] -> IO a
`catches`
      [ (ArgError -> IO a) -> Handler a
forall a e. Exception e => (e -> IO a) -> Handler a
Handler ((ArgError -> IO a) -> Handler a)
-> (ArgError -> IO a) -> Handler a
forall a b. (a -> b) -> a -> b
$ (\ArgError
argerror -> do
                      String -> IO ()
errm (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"In child process:\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++ ArgError -> String
argerror_message ArgError
argerror
                      IO ()
flush_outerr
                      Int -> IO a
forall a. Int -> IO a
_exit Int
1
                  )
      , (ProcessStatus -> IO a) -> Handler a
forall a e. Exception e => (e -> IO a) -> Handler a
Handler ((ProcessStatus -> IO a) -> Handler a)
-> (ProcessStatus -> IO a) -> Handler a
forall a b. (a -> b) -> a -> b
$ (\ProcessStatus
processstatus -> do
                      String -> IO ()
errm (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Process error in child process. Process status = " String -> ShowS
forall a. [a] -> [a] -> [a]
++
                             ProcessStatus -> String
forall a. Show a => a -> String
show ( ProcessStatus
processstatus :: ProcessStatus )
                      IO ()
flush_outerr
                      Int -> IO a
forall a. Int -> IO a
_exit Int
1
                  )
      , (RunError -> IO a) -> Handler a
forall a e. Exception e => (e -> IO a) -> Handler a
Handler ((RunError -> IO a) -> Handler a)
-> (RunError -> IO a) -> Handler a
forall a b. (a -> b) -> a -> b
$ (\(RunError
runerror::RunError) -> do
                      String -> IO ()
errm (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ (RunError -> String
show_runerror RunError
runerror)
                      IO ()
flush_outerr
                      Int -> IO a
forall a. Int -> IO a
_exit Int
1
                  )
      , (IOError -> IO a) -> Handler a
forall a e. Exception e => (e -> IO a) -> Handler a
Handler ((IOError -> IO a) -> Handler a) -> (IOError -> IO a) -> Handler a
forall a b. (a -> b) -> a -> b
$ (\(IOError
ioe::IOError) -> do
                      String -> IO ()
errm (String
"In child process:\n   " String -> ShowS
forall a. [a] -> [a] -> [a]
++ IOError -> String
show_ioerror IOError
ioe)
                      IO ()
flush_outerr
                      Int -> IO a
forall a. Int -> IO a
_exit Int
1
                  )
      , (ExitCode -> IO a) -> Handler a
forall a e. Exception e => (e -> IO a) -> Handler a
Handler ((ExitCode -> IO a) -> Handler a)
-> (ExitCode -> IO a) -> Handler a
forall a b. (a -> b) -> a -> b
$ (\(ExitCode
e::ExitCode) -> do
                      -- Child process is a subroutine that has terminated normally.
                      let ec :: Int
ec = case ExitCode
e of
                                  ExitCode
ExitSuccess     -> Int
0
                                  ExitFailure Int
ec' -> Int
ec'
                      String -> IO ()
errm (String
"Warning! Child process tries to shut down normally. This is a bug. It should\n\
                            \terminate with _exit (or catch the ExitException yourself). See section\n\"\
                            \Running a Subroutine in a Separate Process\" in the HsShellScript API\n\
                            \documentation. Terminating with _exit " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
ec String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" now.")
                      IO ()
flush_outerr
                      Int -> IO a
forall a. Int -> IO a
_exit Int
ec)
      , (SomeException -> IO a) -> Handler a
forall a e. Exception e => (e -> IO a) -> Handler a
Handler ((SomeException -> IO a) -> Handler a)
-> (SomeException -> IO a) -> Handler a
forall a b. (a -> b) -> a -> b
$ (\(SomeException
e::SomeException) -> do
                     String -> IO ()
errm (String
"Child process quit with unexpected exception:\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++ SomeException -> String
forall a. Show a => a -> String
show SomeException
e)
                     IO ()
flush_outerr
                     Int -> IO a
forall a. Int -> IO a
_exit Int
1
                  )
      ]

   IO ()
flush_outerr
   Int -> IO b
forall a. Int -> IO a
_exit Int
0


{- | Print text to @stdout@.

   This is a shorthand for @putStrLn@, except for @stderr@ being flushed
   beforehand. This way normal output and error output appear in
   order, even when they aren't buffered as by default.

   An additional newline is printed at the end.

   >outm msg = do
   >   hFlush stderr
   >   putStrLn msg
-}
outm :: String          -- ^ Message to print
     -> IO ()
outm :: String -> IO ()
outm String
msg = do
   Handle -> IO ()
hFlush Handle
stderr
   String -> IO ()
putStrLn String
msg


{- | Print text to @stdout@.

   This is a shorthand for @putStr@, except for @stderr@ being flushed
   beforehand. This way normal output and error output appear in
   order, even when they aren't buffered as by default.

   No newline is printed at the end.

   >outm_ msg = do
   >   hFlush stderr
   >   putStr msg
-}
outm_ :: String          -- ^ Message to print
      -> IO ()
outm_ :: String -> IO ()
outm_ String
msg = do
   Handle -> IO ()
hFlush Handle
stderr
   String -> IO ()
putStr String
msg


{- | Colorful log message to @stderr@.

   This prints a message to @stderr@. When @stderr@ is connected to a terminal
   (as determined by @isatty(3)@), additional escape sequences are printed,
   which make the message appear in cyan. Additionally, a newline character is
   output at the end.

   @stdout@ is flushed beforehand. So normal output and error output appear in
   order, even when they aren't buffered as by default.

   See 'logm_', 'errm', 'errm_'.
-}
logm :: String          -- ^ Message to print
     -> IO ()
logm :: String -> IO ()
logm String
msg =
   do Handle -> IO ()
hFlush Handle
stdout
      Bool
tty <- Handle -> IO Bool
isatty Handle
stderr
      if Bool
tty
         then Handle -> String -> IO ()
hPutStrLn Handle
stderr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"\ESC[36m" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
msg String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\ESC[00m"
         else Handle -> String -> IO ()
hPutStrLn Handle
stderr String
msg


{- | Colorful log message to @stderr@.

   This prints a message to @stderr@. When @stderr@ is connected to a terminal
   (as determined by @isatty(3)@), additional escape sequences are printed,
   which make the message appear in cyan. No a newline character is output at the end.

   @stdout@ is flushed beforehand. So normal output and error output appear in
   order, even when they aren't buffered as by default.

   See 'logm', 'errm', 'errm_'.
-}
logm_ :: String -> IO ()
logm_ :: String -> IO ()
logm_ String
msg = do
   do Handle -> IO ()
hFlush Handle
stdout
      Bool
tty <- Handle -> IO Bool
isatty Handle
stderr
      if Bool
tty
         then Handle -> String -> IO ()
hPutStr Handle
stderr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"\ESC[36m" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
msg String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\ESC[00m"
         else Handle -> String -> IO ()
hPutStr Handle
stderr String
msg


{- | Colorful error message to @stderr@.

   This prints a message to @stderr@. When @stderr@ is connected to a terminal
   (as determined by @isatty(3)@), additional escape sequences are printed,
   which make the message appear in red. Additionally, a newline character is
   output at the end.

   @stdout@ is flushed beforehand. So normal output and error output appear in
   order, even when they aren't buffered as by default.

   See 'logm', 'logm_', 'errm_'.
-}
errm :: String -> IO ()
errm :: String -> IO ()
errm String
msg = do
   do Handle -> IO ()
hFlush Handle
stdout
      Bool
tty <- Handle -> IO Bool
isatty Handle
stderr
      if Bool
tty
         then Handle -> String -> IO ()
hPutStrLn Handle
stderr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"\ESC[01;31m" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
msg String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\ESC[00m"
         else Handle -> String -> IO ()
hPutStrLn Handle
stderr String
msg


{- | Colorful error message to @stderr@.

   This prints a message to @stderr@. When @stderr@ is connected to a terminal
   (as determined by @isatty(3)@), additional escape sequences are printed,
   which make the message appear in red. No a newline character is output at the end.

   @stdout@ is flushed beforehand. So normal output and error output appear in
   order, even when they aren't buffered as by default.

   See 'logm', 'logm_', 'errm'.
-}
errm_ :: String -> IO ()
errm_ :: String -> IO ()
errm_ String
msg = do
   do Handle -> IO ()
hFlush Handle
stdout
      Bool
tty <- Handle -> IO Bool
isatty Handle
stderr
      if Bool
tty
         then Handle -> String -> IO ()
hPutStr Handle
stderr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"\ESC[01;31m" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
msg String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\ESC[00m"
         else Handle -> String -> IO ()
hPutStr Handle
stderr String
msg


{- | In case the specified action throws an IOError, fill in its filename field. This way, more useful error
messages can be produced.

Example:

>-- Oh, the GHC libraries neglect to fill in the file name
>executeFile' prog a b c =
>   fill_in_filename prog $ executeFile prog a b c

See 'fill_in_location', 'add_location'.
-}
fill_in_filename :: String              -- ^ File name to fill in
                 -> IO a                -- ^ IO action to modify
                 -> IO a                -- ^ Modified IO action
fill_in_filename :: forall a. String -> IO a -> IO a
fill_in_filename String
filename IO a
io =
   IO a
io IO a -> (IOError -> IO a) -> IO a
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` (\IOError
ioe -> IOError -> IO a
forall a. IOError -> IO a
ioError (IOError -> String -> IOError
ioeSetFileName IOError
ioe String
filename))


{- | In case the specified action throws an IOError, fill in its location field. This way, more useful error
messages can be produced.

Example:

>my_fun a b c = do
>   -- ...
>   fill_in_location "my_fun" $  -- Give the caller a more useful location information in case of failure
>      rename "foo" "bar"
>   -- ...

See 'fill_in_filename'.
-}
fill_in_location :: String              -- ^ Location name to fill in
                 -> IO a                -- ^ IO action to modify
                 -> IO a                -- ^ Modified IO action
fill_in_location :: forall a. String -> IO a -> IO a
fill_in_location String
location IO a
io =
   IO a
io IO a -> (IOError -> IO a) -> IO a
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` (\IOError
ioe -> IOError -> IO a
forall a. IOError -> IO a
ioError (IOError -> String -> IOError
ioeSetLocation IOError
ioe String
location))


{- | In case the specified action throws an IOError, add a line to its location field. This way, more useful
error messages can be produced. The specified string is prepended to the old location, separating it with a
newline from the previous location, if any. When using this thoroughly, you get a reverse call stack in
IOErrors.

Example:

>my_fun =
>   add_location "my_fun" $ do
>      -- ...

See 'fill_in_filename', 'fill_in_location'.
-}
add_location :: String              -- ^ Location name to add
             -> IO a                -- ^ IO action to modify
             -> IO a                -- ^ Modified IO action
add_location :: forall a. String -> IO a -> IO a
add_location String
location IO a
io =
   IO a
io IO a -> (IOError -> IO a) -> IO a
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` (\IOError
ioe -> let loc :: String
loc = case IOError -> String
ioe_location IOError
ioe of
                                    String
""   -> String
location
                                    String
loc0 -> String
location String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
loc0
                       in  IOError -> IO a
forall a. IOError -> IO a
ioError (IOError
ioe { ioe_location :: String
ioe_location = String
loc })
              )


{- | This is a replacement for @System.Posix.Process.executeFile@. It does
   additional preparations, then calls @executeFile@. @executeFile@ /can't normally/
   /be used directly, because it doesn't do the things which are/
   /outlined here./

   This are the differences to @executeFile@:

   1. @stdout@ and @stderr@ are flushed.

   2. The standard file descriptors 0-2 are made copies of the file descriptors
   which the standard handles currently use. This is necessary because they
   might no longer use the standard handles. See "HsShellScript#fdpipes".

   If the standard handles @stdin@, @stdout@, @stderr@ aren't in closed state,
   and they aren't already connected to the respective standard file
   descriptors, their file descriptors are copied to the respective standard
   file descriptors (with @dup2@). Backup copies are made of the file
   descriptors which are overwritten. If some of the standard handles are closed,
   the corresponding standard file descriptors are closed as well.

   3. All file descriptors, except for the standard ones, are set to close-on-exec
   (see @fcntl(2)@), and will be closed on successful replacement of
   the process. Before that, the old file descriptor flags are saved.

   4. The standard file descriptors are set to blocking mode, since GHC 6.2.2
   sets file descriptors to non-blocking (except 0-2, which may get
   overwritten by a non-blocking one in step 2). The called program
   doesn't expect that.

   5. In case replacing the process fails, the file descriptors are reset to
   the original state. The file descriptors flags are restored, and the file
   descriptors 0-2 are overwritten again, with their backup copies. Then an
   IOError is thrown.

   6. In any IOError, the program is filled in as the file name (@executeFile@
   neglects this).

   7. The return type is a generic @a@, rather than @()@.

   Also see "HsShellScript#exec".
-}
execute_file :: FilePath                     -- ^ Program to call
             -> Bool                         -- ^ Search @PATH@?
             -> [String]                     -- ^ Arguments
             -> Maybe [(String, String)]     -- ^ Optionally new environment
             -> IO a                         -- ^ Never returns
execute_file :: forall a.
String -> Bool -> [String] -> Maybe [(String, String)] -> IO a
execute_file String
path Bool
search [String]
args Maybe [(String, String)]
menv =
   String -> IO a -> IO a
forall a. String -> IO a -> IO a
fill_in_filename String
path (IO a -> IO a) -> IO a -> IO a
forall a b. (a -> b) -> a -> b
$ String -> IO a -> IO a
forall a. String -> IO a -> IO a
fill_in_location String
"execute_file" (IO a -> IO a) -> IO a -> IO a
forall a b. (a -> b) -> a -> b
$ do
      IO (IO (), IO (), IO (), Ptr CInt)
-> ((IO (), IO (), IO (), Ptr CInt) -> IO ())
-> ((IO (), IO (), IO (), Ptr CInt) -> IO a)
-> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket
         (do -- Flush stdout and stderr, if open
             IO ()
flush_outerr

             -- Make fds 0-2 copies of the things which the standard handles refer to.
             recover0 <- restore stdin 0
             recover1 <- restore stdout 1
             recover2 <- restore stderr 2

             -- Save the flags of all file descriptors
             fdflags <- c_save_fdflags
{-# LINE 2213 "src/HsShellScript/ProcErr.chs" #-}


             -- Prepare all fds for subsequent exec. Fds 0-2 are set to blocking (because GHC sets new fds to
             -- non-blocking). All others are set to close-on-exec.
             c_prepare_fd_flags_for_exec
{-# LINE 2217 "src/HsShellScript/ProcErr.chs" #-}


             return (recover0, recover1, recover2, fdflags)
         )
         (\(recover0, recover1, recover2, fdflags) ->
             do -- Failure of the exec. Restore the file descriptor flags
                c_restore_fdflags fdflags

                -- Restore the standard handles
                recover0
                recover1
                recover2
         )
         (const $ do
             -- The exec. Throws an IOError in case replacing the process failed.
             executeFile path search args menv

             -- Never reached, only for the type checker
             error "Impossible error"
         )

   where
      restore h@(FileHandle _ mvar) fd = do
         -- The fd used by the handle. This is in GHC.IO.Handle.FD
         --                              handleToFd_noclose: Fehlerhaft, aus hssh-2.9
         -- handle_fd: der file descriptor, den der Handle mitbringt. Weicht möglicherweise von 0-2 ab.
         handle_fd <- fmap fromIntegral (handleToFd_noclose h)

         -- Get the fd which the handle h uses. This locks the handle.
         (h__ :: Handle__) <- takeMVar mvar

         -- Make a copy of the fd which is about to be overwritten. Returns -1 for invalid (closed) fd.
         -- Mache Sicherheitskopie des Standard-file descriptor (0-2) in einem neu zu belegenden f.d. (ab 3).
         -- fd: Standard-file descritor, 0-2.
         -- Bewegt den Standardfiledescriptor aus dem Weg.
         fd_backup <- c_fcntl_dupfd fd 3
         -- Liefert den neuen file descriptor, oder -1 (bei Fehler), wenn der filedescriptor geschlossen ist


         -- Is the handle closed?
         let closed = case haType h__ of
                         ClosedHandle -> True
                         SemiClosedHandle -> True
                         otherwise -> False

         -- If the handle is open, make the fd a copy of the fd which the handle uses. Otherwise, close the fd
         -- as well.
         if closed
            then close fd >> return ()
            else when (fd /= handle_fd) $
                 -- Den f.d., den der Standard-Handle benutzt, auf die Standardposition in 0-2 kopieren.
                 dup2 handle_fd fd >> return ()


         -- Return recovery action which undoes everything.
         return (do -- Restore the fd
                    if fd_backup /= -1 then do -- Den Inhalt des 0-2-file descriptors wiederherstellen
                                               dup2 fd_backup fd
                                               -- Die Sicherheitskopie wieder freigeben
                                               close fd_backup

                                               return ()
                                       else do -- Wenn der 0-2-filedescriptor nicht kopiert werden konnte,
                                               -- dann liegt das (?) daran, daß er geschlossen war. Ihn dann
                                               -- wieder schließen.
                                               close fd
                                               return ()
                    -- Unlock the handle
                    putMVar mvar h__
                    return ()
                )

      -- Silly: The standard handle has been overwritten with a duplex.
      restore h fd = do
        -- Make a copy of the fd which is about to be closed. Returns -1 for already closed fd.
        fd_backup <- c_fcntl_dupfd fd 3

        -- Close the fd
        close fd

        -- Return recovery action, which restores the fd.
        return (if fd_backup /= -1 then do dup2 fd_backup fd
                                           close fd_backup
                                           return ()
                                   else do close fd
                                           return ()
               )



handleToFd_noclose :: Handle -> IO Fd
handleToFd_noclose :: Handle -> IO Fd
handleToFd_noclose Handle
h =
    Handle -> (Fd -> IO Fd) -> IO Fd
forall a. Handle -> (Fd -> IO a) -> IO a
unsafeWithHandleFd Handle
h (\Fd
fd -> Fd -> IO Fd
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Fd
fd)



{- About Bas van Dijk's unsafeWithHandleFd:

   This function is broken. It blocks when called like this:

   -- Blocks
   unsafeWithHandleFd stdout $ \fd ->
      putStrLn ("stdout: fd = " ++ show fd)

   The job of unsafeWithHandleFd's job is, to keep a reference to
   the handle, so it won't be garbage collected, while the action is still
   running. Garbage collecting the handle would close it, as well as the
   underlying file descriptor, while the latter is still in use by the action.
   This can't happen as long as use of the file descriptor is encapsulated in the
   action.

   This encapsulation can be circumvented by returning the file descriptor, and
   that's what I do in execute_file. This should usually not be done.

   However, I want to use it on stdin, stdout and stderr, only. These three
   should never be garbage collected. Under this circumstances, it should be
   safe to use unsafeWithHandleFd this way.
-}

unsafeWithHandleFd :: Handle -> (Fd -> IO a) -> IO a
unsafeWithHandleFd :: forall a. Handle -> (Fd -> IO a) -> IO a
unsafeWithHandleFd h :: Handle
h@(FileHandle String
_ MVar Handle__
m)     Fd -> IO a
f = Handle -> MVar Handle__ -> (Fd -> IO a) -> IO a
forall a. Handle -> MVar Handle__ -> (Fd -> IO a) -> IO a
unsafeWithHandleFd' Handle
h MVar Handle__
m Fd -> IO a
f
-- unsafeWithHandleFd h@(DuplexHandle _ _ w) f = unsafeWithHandleFd' h w f

unsafeWithHandleFd' :: Handle -> MVar Handle__ -> (Fd -> IO a) -> IO a
unsafeWithHandleFd' :: forall a. Handle -> MVar Handle__ -> (Fd -> IO a) -> IO a
unsafeWithHandleFd' Handle
h MVar Handle__
m Fd -> IO a
f =
  String
-> Handle
-> MVar Handle__
-> (Handle__ -> IO (Handle__, a))
-> IO a
forall a.
String
-> Handle
-> MVar Handle__
-> (Handle__ -> IO (Handle__, a))
-> IO a
withHandle' String
"unsafeWithHandleFd" Handle
h MVar Handle__
m ((Handle__ -> IO (Handle__, a)) -> IO a)
-> (Handle__ -> IO (Handle__, a)) -> IO a
forall a b. (a -> b) -> a -> b
$ \h_ :: Handle__
h_@Handle__{dev
haDevice :: dev
haDevice :: ()
haDevice} ->
    case dev -> Maybe FD
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast dev
haDevice of
      Maybe FD
Nothing -> IOError -> IO (Handle__, a)
forall a. IOError -> IO a
ioError (IOError -> String -> IOError
System.IO.Error.ioeSetErrorString (IOErrorType -> String -> Maybe Handle -> Maybe String -> IOError
System.IO.Error.mkIOError IOErrorType
IllegalOperation
                                                             String
"unsafeWithHandleFd" (Handle -> Maybe Handle
forall a. a -> Maybe a
Just Handle
h) Maybe String
forall a. Maybe a
Nothing)
                         String
"handle is not a file descriptor")
      Just FD
fd -> do
        a
x <- Fd -> IO a
f (CInt -> Fd
Fd (FD -> CInt
FD.fdFD FD
fd))
        (Handle__, a) -> IO (Handle__, a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Handle__
h_, a
x)


-------------------------------------------------------------------------------------------------------------



{- | Check if a handle is connected to a terminal.

   This is a front end to the @isatty(3)@ function (see man page). It is useful,
   for instance, to determine if color escape sequences should be
   generated.
-}

isatty :: Handle        -- ^ Handle to check
       -> IO Bool       -- ^ Whether the handle is connected to a terminal
isatty :: Handle -> IO Bool
isatty Handle
h =
   Handle -> (Fd -> IO Bool) -> IO Bool
forall a. Handle -> (Fd -> IO a) -> IO a
unsafeWithHandleFd Handle
h ((Fd -> IO Bool) -> IO Bool) -> (Fd -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \Fd
fd -> do
      CInt
isterm <- CInt -> IO CInt
hssh_c_isatty ((Fd -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Fd
fd) :: CInt)
      Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (CInt
isterm CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= (CInt
0::CInt))


-- Flush stdout and stderr (which should not be necessary). Discard Illegal Operation IOError which arises
-- when they are closed.
flush_outerr :: IO ()
flush_outerr = do
   Handle -> IO ()
flush Handle
stdout
   Handle -> IO ()
flush Handle
stderr
   where
      flush :: Handle -> IO ()
flush Handle
h = Handle -> IO ()
hFlush Handle
h IO () -> (IOError -> IO ()) -> IO ()
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` (\IOError
ioe -> if IOError -> Bool
isIllegalOperation IOError
ioe then () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return () else IOError -> IO ()
forall a. IOError -> IO a
ioError IOError
ioe)


-- ProcessStatus doesn't derive Typeable.
{-
data ProcessStatus = Exited ExitCode
                   | Terminated Signal
                   | Stopped Signal
		   deriving (Eq, Ord, Show)
-}

-- For GHC-7.8:
deriving instance Typeable ProcessStatus

{- Pre-7.8-Stuff:
instance Typeable ProcessStatus where
   typeOf = const tyCon_ProcessStatus

-- GHC 6.4
tyCon_ProcessStatus = mkTyConApp (mkTyCon3 "hsshellscript"
                                           "HsShellScript.ProcErr"
                                           "Posix.ProcessStatus") []
-}


-- | The GHC libraries don't declare @Foreign.C.Error.Errno@ as instance of
-- Show. This makes it up.
instance Show Foreign.C.Error.Errno where
   show :: Errno -> String
show (Errno CInt
e) = CInt -> String
forall a. Show a => a -> String
show CInt
e




----------------------------------------------------------------------------------------------------
-- Transmission of at most one IOError through a pipe (as far as that's possible).
-- This is used by execute_file to send the IOError of a failed exec...-call to the parent process.
--
-- Can't be transmitted:
--   - the handle field (of course...)
--   - IOErrors of the type DynIOError. They carry a dynamic value, with no provisions for serialization.
--
-- See base.GHC.IO.lhs


-- Read a single possible IOError from a file descriptor. The stream must be
-- closed on the other side after writing either nothing or a single IOError to
-- it.
receive_ioerror :: Fd -> IO (Maybe IOError)
receive_ioerror :: Fd -> IO (Maybe IOError)
receive_ioerror Fd
fd = do
   Handle
h <- Fd -> IO Handle
System.Posix.fdToHandle Fd
fd
   String
txt <- Handle -> IO String
hGetContents Handle
h
   Int -> IO () -> IO ()
forall a b. a -> b -> b
seq (String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
txt) (() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ())
   Handle -> IO ()
hClose Handle
h
   Maybe IOError -> IO (Maybe IOError)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Maybe IOError
decode_ioerror String
txt)


-- Write a single IOError to a file descriptor, and close it.
send_ioerror :: Fd -> IOError -> IO ()
send_ioerror Fd
fd IOError
ioe = do
   Handle
h <- Fd -> IO Handle
System.Posix.fdToHandle Fd
fd
   IO Errno
Foreign.C.Error.getErrno
   Handle -> String -> IO ()
hPutStr Handle
h (IOError -> String
encode_ioerror IOError
ioe)
   Handle -> IO ()
hClose Handle
h


encode_ioerror :: IOError -> String
encode_ioerror :: IOError -> String
encode_ioerror IOError
ioe =
   (Integer, String, String, Maybe String, Maybe CInt) -> String
forall a. Show a => a -> String
show (IOError -> Integer
ioetype_num IOError
ioe, IOError -> String
ioe_location IOError
ioe, IOError -> String
ioe_description IOError
ioe, IOError -> Maybe String
ioe_filename IOError
ioe, IOError -> Maybe CInt
ioe_errno IOError
ioe)


decode_ioerror :: String -> Maybe IOError
decode_ioerror :: String -> Maybe IOError
decode_ioerror String
txt =
   case String
txt of
      String
"" -> Maybe IOError
forall a. Maybe a
Nothing
      String
_  -> let (Integer
type_nr, String
location, String
description, Maybe String
filename, Maybe CInt
errno) = String -> (Integer, String, String, Maybe String, Maybe CInt)
forall a. Read a => String -> a
read String
txt
            in (IOError -> Maybe IOError
forall a. a -> Maybe a
Just (IOError { ioe_handle :: Maybe Handle
ioe_handle      = Maybe Handle
forall a. Maybe a
Nothing,
                                ioe_type :: IOErrorType
ioe_type        = Integer -> IOErrorType
num_ioetype Integer
type_nr,
                                ioe_location :: String
ioe_location    = String
location,
                                ioe_description :: String
ioe_description = String
description,
                                ioe_filename :: Maybe String
ioe_filename    = Maybe String
filename,
                                ioe_errno :: Maybe CInt
ioe_errno       = Maybe CInt
errno
                              }))

-- All IOError types in GHC 6.4, taken from the source code of GHC.IO.
-- Used only for serializing IOErrors which are thrown by executeFile, so this should never go out of date.
ioe_types :: [(IOErrorType, Integer)]
ioe_types = [(IOErrorType
AlreadyExists, Integer
1), (IOErrorType
NoSuchThing, Integer
2), (IOErrorType
ResourceBusy, Integer
3), (IOErrorType
ResourceExhausted, Integer
4), (IOErrorType
EOF, Integer
5), (IOErrorType
IllegalOperation, Integer
6), (IOErrorType
PermissionDenied, Integer
7),
             (IOErrorType
UserError, Integer
8), (IOErrorType
UnsatisfiedConstraints, Integer
9), (IOErrorType
SystemError, Integer
10), (IOErrorType
ProtocolError, Integer
11), (IOErrorType
OtherError, Integer
12), (IOErrorType
InvalidArgument, Integer
13),
             (IOErrorType
InappropriateType, Integer
14), (IOErrorType
HardwareFault, Integer
15), (IOErrorType
UnsupportedOperation, Integer
16), (IOErrorType
TimeExpired, Integer
17), (IOErrorType
ResourceVanished, Integer
18), (IOErrorType
Interrupted, Integer
19)]

-- IOError type as a number
ioetype_num :: IOError -> Integer
ioetype_num IOError
ioe =
   case IOError -> IOErrorType
ioeGetErrorType IOError
ioe of
        IOErrorType
ioetype    -> case IOErrorType -> [(IOErrorType, Integer)] -> Maybe Integer
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup IOErrorType
ioetype [(IOErrorType, Integer)]
ioe_types of
                         Just Integer
num -> Integer
num
                         Maybe Integer
Nothing  -> String -> Integer
forall a. HasCallStack => String -> a
error String
"Bug in HsShellScript: Unknown IOError type, can't serialize it."

-- IOError type from the number
num_ioetype :: Integer -> IOErrorType
num_ioetype Integer
num =
   case Integer -> [(Integer, IOErrorType)] -> Maybe IOErrorType
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Integer
num (((IOErrorType, Integer) -> (Integer, IOErrorType))
-> [(IOErrorType, Integer)] -> [(Integer, IOErrorType)]
forall a b. (a -> b) -> [a] -> [b]
map (\(IOErrorType
a,Integer
b) -> (Integer
b,IOErrorType
a)) [(IOErrorType, Integer)]
ioe_types) of
      Just IOErrorType
ioetype -> IOErrorType
ioetype
      Maybe IOErrorType
Nothing      -> String -> IOErrorType
forall a. HasCallStack => String -> a
error (String
"Bug in HsShellScript: Unknown IOError type number " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
num)


instance Exception ProcessStatus


-- | Determine the terminal width in columns. 
--
-- This value can be used to format output to fit the terminal.
--
-- This queries the terminal which is connected to stdout. It may happen, that
-- stdout isn't connected to a terminal. For instance when the program is part of
-- a pipe. In this case, an IOError is thrown.
--
-- See 'terminal_width', 'make_usage_info', 'print_usage_info', 'usage_info', 'wrap'.
terminal_width_ioe :: Handle                -- ^ Handle, which is connected to the terminal    
                   -> IO Int                -- ^ The number of columns in the constrolling terminal. 
                                            --   Throws an IOError when the handle isn't connected to a terminal.
terminal_width_ioe :: Handle -> IO Int
terminal_width_ioe Handle
h = do

   CInt
fd <- Handle -> (Fd -> IO CInt) -> IO CInt
forall a. Handle -> (Fd -> IO a) -> IO a
unsafeWithHandleFd Handle
h ((Fd -> IO CInt) -> IO CInt) -> (Fd -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Fd
fd -> do 
      CInt
res <- CInt -> IO CInt
c_terminal_width (Fd -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Fd
fd)
      Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (CInt
res CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== -CInt
1) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Maybe Handle -> Maybe String -> IO ()
forall a. String -> Maybe Handle -> Maybe String -> IO a
throwErrno' String
"terminal_width" Maybe Handle
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
      CInt -> IO CInt
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CInt
res
   Int -> IO Int
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
fd)


-- | Determine the terminal width in columns. 
--
-- This value can be used to format output to fit the terminal.
--
-- This queries the terminal which is connected to stdout. It may happen, that
-- stdout isn't connected to a terminal, for instance when the program is part of
-- a pipe. In this case, @Nothing@ is returned. No exception is thrown.
--
-- See 'terminal_width_ioe', 'make_usage_info', 'print_usage_info', 'usage_info', 'wrap'.
terminal_width :: Handle                -- ^ Handle, which is connected to the terminal    
               -> IO (Maybe Int)        -- ^ The number of columns in the constrolling terminal. 
                                    --   Nothing, when the handle isn't connected to a terminal.
terminal_width :: Handle -> IO (Maybe Int)
terminal_width Handle
h = do
   Int
w <- Handle -> IO Int
terminal_width_ioe Handle
h
   Maybe Int -> IO (Maybe Int)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
w)
   IO (Maybe Int) -> (IOError -> IO (Maybe Int)) -> IO (Maybe Int)
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` (\(IOError
ioe :: IOError) -> Maybe Int -> IO (Maybe Int)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Int
forall a. Maybe a
Nothing)




foreign import ccall safe "HsShellScript/ProcErr.chs.h c_close_on_exec"
  c_close_on_exec :: (C2HSImp.CInt -> (IO C2HSImp.CInt))

foreign import ccall safe "HsShellScript/ProcErr.chs.h _exit"
  _exit_prim :: (C2HSImp.CInt -> (IO ()))

foreign import ccall safe "HsShellScript/ProcErr.chs.h strerror"
  foreign_strerror :: (C2HSImp.CInt -> (IO (C2HSImp.Ptr C2HSImp.CChar)))

foreign import ccall safe "HsShellScript/ProcErr.chs.h c_save_fdflags"
  c_save_fdflags :: (IO (C2HSImp.Ptr C2HSImp.CInt))

foreign import ccall safe "HsShellScript/ProcErr.chs.h c_prepare_fd_flags_for_exec"
  c_prepare_fd_flags_for_exec :: (IO ())

foreign import ccall safe "HsShellScript/ProcErr.chs.h c_restore_fdflags"
  c_restore_fdflags :: ((C2HSImp.Ptr C2HSImp.CInt) -> (IO ()))

foreign import ccall safe "HsShellScript/ProcErr.chs.h c_fcntl_dupfd"
  c_fcntl_dupfd :: (C2HSImp.CInt -> (C2HSImp.CInt -> (IO C2HSImp.CInt)))

foreign import ccall safe "HsShellScript/ProcErr.chs.h close"
  close :: (C2HSImp.CInt -> (IO C2HSImp.CInt))

foreign import ccall safe "HsShellScript/ProcErr.chs.h dup2"
  dup2 :: (C2HSImp.CInt -> (C2HSImp.CInt -> (IO C2HSImp.CInt)))

foreign import ccall safe "HsShellScript/ProcErr.chs.h isatty"
  hssh_c_isatty :: (C2HSImp.CInt -> (IO C2HSImp.CInt))

foreign import ccall safe "HsShellScript/ProcErr.chs.h c_terminal_width"
  c_terminal_width :: (C2HSImp.CInt -> (IO C2HSImp.CInt))