{-# OPTIONS_GHC -XFlexibleInstances -XTypeSynonymInstances -XStandaloneDeriving #-}

{- Commands for HSH
Copyright (C) 2004-2008 John Goerzen <jgoerzen@complete.org>
Please see the COPYRIGHT file
-}

{- |
   Module     : HSH.Command
   Copyright  : Copyright (C) 2006-2009 John Goerzen
   License    : GNU LGPL, version 2.1 or above

   Maintainer : John Goerzen <jgoerzen@complete.org>
   Stability  : provisional
   Portability: portable

Copyright (c) 2006-2009 John Goerzen, jgoerzen\@complete.org
-}

module HSH.Command (Environment,
                    ShellCommand(..),
                    PipeCommand(..),
                    (-|-),
                    RunResult,
                    run,
                    runIO,
                    runSL,
                    InvokeResult,
                    checkResults,
                    tryEC,
                    catchEC,
                    setenv,
                    unsetenv
                   ) where

-- import System.IO.HVIO
-- import System.IO.Utils
import Prelude hiding (catch)
import System.IO
import System.Exit
import System.Log.Logger
import System.IO.Error (isUserError, ioeGetErrorString)
import Data.Maybe.Utils
import Data.Maybe
import Data.List.Utils(uniq)
import Control.Exception(try, evaluate, SomeException, catch)
import Text.Regex.Posix
import Control.Monad(when)
import Data.String.Utils(rstrip)
import Control.Concurrent
import System.Process
import System.Environment(getEnvironment)
import qualified Data.ByteString.Lazy as BSL
import qualified Data.ByteString as BS
import HSH.Channel

d, dr :: String -> IO ()
d :: FilePath -> IO ()
d = FilePath -> FilePath -> IO ()
debugM FilePath
"HSH.Command"
dr :: FilePath -> IO ()
dr = FilePath -> FilePath -> IO ()
debugM FilePath
"HSH.Command.Run"
em :: FilePath -> IO ()
em = FilePath -> FilePath -> IO ()
errorM FilePath
"HSH.Command"

{- | Result type for shell commands.  The String is the text description of
the command, not its output. -}
type InvokeResult = (String, IO ExitCode)

{- | Type for the environment. -}
type Environment = Maybe [(String, String)]

{- | A shell command is something we can invoke, pipe to, pipe from,
or pipe in both directions.  All commands that can be run as shell
commands must define these methods.

Minimum implementation is 'fdInvoke'.

Some pre-defined instances include:

 * A simple bare string, which is passed to the shell for execution. The shell
   will then typically expand wildcards, parse parameters, etc.

 * A @(String, [String])@ tuple.  The first item in the tuple gives
   the name of a program to run, and the second gives its arguments.
   The shell is never involved.  This is ideal for passing filenames,
   since there is no security risk involving special shell characters.

 * A @Handle -> Handle -> IO ()@ function, which reads from the first
   handle and write to the second.

 * Various functions.  These functions will accept input representing
   its standard input and output will go to standard output.  

Some pre-defined instance functions include:

 * @(String -> String)@, @(String -> IO String)@, plus the same definitions
   for ByteStrings.

 * @([String] -> [String])@, @([String] -> IO [String])@, where each @String@
   in the list represents a single line

 * @(() -> String)@, @(() -> IO String)@, for commands that explicitly
   read no input.  Useful with closures.  Useful when you want to avoid
   reading stdin because something else already is.  These have the unit as
   part of the function because otherwise we would have conflicts with things
   such as bare Strings, which represent a command name.

-}
class (Show a) => ShellCommand a where
    {- | Invoke a command. -}
    fdInvoke :: a               -- ^ The command
             -> Environment     -- ^ The environment
             -> Channel         -- ^ Where to read input from
             -> IO (Channel, [InvokeResult]) -- ^ Returns an action that, when evaluated, waits for the process to finish and returns an exit code.

instance Show (Handle -> Handle -> IO ()) where
    show :: (Handle -> Handle -> IO ()) -> FilePath
show Handle -> Handle -> IO ()
_ = FilePath
"(Handle -> Handle -> IO ())"
instance Show (Channel -> IO Channel) where
    show :: (Channel -> IO Channel) -> FilePath
show Channel -> IO Channel
_ = FilePath
"(Channel -> IO Channel)"
instance Show (String -> String) where
    show :: ShowS -> FilePath
show ShowS
_ = FilePath
"(String -> String)"
instance Show (() -> String) where
    show :: (() -> FilePath) -> FilePath
show () -> FilePath
_ = FilePath
"(() -> String)"
instance Show (String -> IO String) where
    show :: (FilePath -> IO FilePath) -> FilePath
show FilePath -> IO FilePath
_ = FilePath
"(String -> IO String)"
instance Show (() -> IO String) where
    show :: (() -> IO FilePath) -> FilePath
show () -> IO FilePath
_ = FilePath
"(() -> IO String)"
instance Show (BSL.ByteString -> BSL.ByteString) where
    show :: (ByteString -> ByteString) -> FilePath
show ByteString -> ByteString
_ = FilePath
"(Data.ByteString.Lazy.ByteString -> Data.ByteString.Lazy.ByteString)"
instance Show (() -> BSL.ByteString) where
    show :: (() -> ByteString) -> FilePath
show () -> ByteString
_ = FilePath
"(() -> Data.ByteString.Lazy.ByteString)"
instance Show (BSL.ByteString -> IO BSL.ByteString) where
    show :: (ByteString -> IO ByteString) -> FilePath
show ByteString -> IO ByteString
_ = FilePath
"(Data.ByteString.Lazy.ByteString -> IO Data.ByteString.Lazy.ByteString)"
instance Show (() -> IO BSL.ByteString) where
    show :: (() -> IO ByteString) -> FilePath
show () -> IO ByteString
_ =  FilePath
"(() -> IO BSL.ByteString)"
instance Show (BS.ByteString -> BS.ByteString) where
    show :: (ByteString -> ByteString) -> FilePath
show ByteString -> ByteString
_ = FilePath
"(Data.ByteString.ByteString -> Data.ByteString.ByteString)"
instance Show (() -> BS.ByteString) where
    show :: (() -> ByteString) -> FilePath
show () -> ByteString
_ = FilePath
"(() -> Data.ByteString.ByteString)"
instance Show (BS.ByteString -> IO BS.ByteString) where
    show :: (ByteString -> IO ByteString) -> FilePath
show ByteString -> IO ByteString
_ = FilePath
"(Data.ByteString.ByteString -> IO Data.ByteString.ByteString)"
instance Show (() -> IO BS.ByteString) where
    show :: (() -> IO ByteString) -> FilePath
show () -> IO ByteString
_ = FilePath
"(() -> IO Data.ByteString.ByteString)"

instance ShellCommand (String -> IO String) where
    fdInvoke :: (FilePath -> IO FilePath)
-> Environment -> Channel -> IO (Channel, [InvokeResult])
fdInvoke = (Channel -> IO FilePath)
-> (FilePath -> IO FilePath)
-> Environment
-> Channel
-> IO (Channel, [InvokeResult])
forall a.
(Show (a -> IO a), Channelizable a) =>
(Channel -> IO a)
-> (a -> IO a)
-> Environment
-> Channel
-> IO (Channel, [InvokeResult])
genericStringlikeIO Channel -> IO FilePath
chanAsString

{- | A user function that takes no input, and generates output.  We will deal
with it using hPutStr to send the output on. -}
instance ShellCommand (() -> IO String) where
    fdInvoke :: (() -> IO FilePath)
-> Environment -> Channel -> IO (Channel, [InvokeResult])
fdInvoke = (() -> IO FilePath)
-> Environment -> Channel -> IO (Channel, [InvokeResult])
forall a.
(Show (() -> IO a), Channelizable a) =>
(() -> IO a)
-> Environment -> Channel -> IO (Channel, [InvokeResult])
genericStringlikeO

instance ShellCommand (BSL.ByteString -> IO BSL.ByteString) where
    fdInvoke :: (ByteString -> IO ByteString)
-> Environment -> Channel -> IO (Channel, [InvokeResult])
fdInvoke = (Channel -> IO ByteString)
-> (ByteString -> IO ByteString)
-> Environment
-> Channel
-> IO (Channel, [InvokeResult])
forall a.
(Show (a -> IO a), Channelizable a) =>
(Channel -> IO a)
-> (a -> IO a)
-> Environment
-> Channel
-> IO (Channel, [InvokeResult])
genericStringlikeIO Channel -> IO ByteString
chanAsBSL

instance ShellCommand (() -> IO BSL.ByteString) where
    fdInvoke :: (() -> IO ByteString)
-> Environment -> Channel -> IO (Channel, [InvokeResult])
fdInvoke = (() -> IO ByteString)
-> Environment -> Channel -> IO (Channel, [InvokeResult])
forall a.
(Show (() -> IO a), Channelizable a) =>
(() -> IO a)
-> Environment -> Channel -> IO (Channel, [InvokeResult])
genericStringlikeO

instance ShellCommand (BS.ByteString -> IO BS.ByteString) where
    fdInvoke :: (ByteString -> IO ByteString)
-> Environment -> Channel -> IO (Channel, [InvokeResult])
fdInvoke = (Channel -> IO ByteString)
-> (ByteString -> IO ByteString)
-> Environment
-> Channel
-> IO (Channel, [InvokeResult])
forall a.
(Show (a -> IO a), Channelizable a) =>
(Channel -> IO a)
-> (a -> IO a)
-> Environment
-> Channel
-> IO (Channel, [InvokeResult])
genericStringlikeIO Channel -> IO ByteString
chanAsBS

instance ShellCommand (() -> IO BS.ByteString) where
    fdInvoke :: (() -> IO ByteString)
-> Environment -> Channel -> IO (Channel, [InvokeResult])
fdInvoke = (() -> IO ByteString)
-> Environment -> Channel -> IO (Channel, [InvokeResult])
forall a.
(Show (() -> IO a), Channelizable a) =>
(() -> IO a)
-> Environment -> Channel -> IO (Channel, [InvokeResult])
genericStringlikeO

{- | An instance of 'ShellCommand' for a pure Haskell function mapping
String to String.  Implement in terms of (String -> IO String) for
simplicity. -}
instance ShellCommand (String -> String) where
    fdInvoke :: ShowS -> Environment -> Channel -> IO (Channel, [InvokeResult])
fdInvoke ShowS
func =
        (FilePath -> IO FilePath)
-> Environment -> Channel -> IO (Channel, [InvokeResult])
forall a.
ShellCommand a =>
a -> Environment -> Channel -> IO (Channel, [InvokeResult])
fdInvoke FilePath -> IO FilePath
iofunc
            where iofunc :: String -> IO String
                  iofunc :: FilePath -> IO FilePath
iofunc = FilePath -> IO FilePath
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> IO FilePath) -> ShowS -> FilePath -> IO FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
func

instance ShellCommand (() -> String) where
    fdInvoke :: (() -> FilePath)
-> Environment -> Channel -> IO (Channel, [InvokeResult])
fdInvoke () -> FilePath
func =
        (() -> IO FilePath)
-> Environment -> Channel -> IO (Channel, [InvokeResult])
forall a.
ShellCommand a =>
a -> Environment -> Channel -> IO (Channel, [InvokeResult])
fdInvoke () -> IO FilePath
iofunc
            where iofunc :: () -> IO String
                  iofunc :: () -> IO FilePath
iofunc = FilePath -> IO FilePath
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> IO FilePath) -> (() -> FilePath) -> () -> IO FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> FilePath
func

instance ShellCommand (BSL.ByteString -> BSL.ByteString) where
    fdInvoke :: (ByteString -> ByteString)
-> Environment -> Channel -> IO (Channel, [InvokeResult])
fdInvoke ByteString -> ByteString
func =
        (ByteString -> IO ByteString)
-> Environment -> Channel -> IO (Channel, [InvokeResult])
forall a.
ShellCommand a =>
a -> Environment -> Channel -> IO (Channel, [InvokeResult])
fdInvoke ByteString -> IO ByteString
iofunc
            where iofunc :: BSL.ByteString -> IO BSL.ByteString
                  iofunc :: ByteString -> IO ByteString
iofunc = ByteString -> IO ByteString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> IO ByteString)
-> (ByteString -> ByteString) -> ByteString -> IO ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
func

instance ShellCommand (() -> BSL.ByteString) where
    fdInvoke :: (() -> ByteString)
-> Environment -> Channel -> IO (Channel, [InvokeResult])
fdInvoke () -> ByteString
func =
        (() -> IO ByteString)
-> Environment -> Channel -> IO (Channel, [InvokeResult])
forall a.
ShellCommand a =>
a -> Environment -> Channel -> IO (Channel, [InvokeResult])
fdInvoke () -> IO ByteString
iofunc
            where iofunc :: () -> IO BSL.ByteString
                  iofunc :: () -> IO ByteString
iofunc = ByteString -> IO ByteString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> IO ByteString)
-> (() -> ByteString) -> () -> IO ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> ByteString
func

instance ShellCommand (BS.ByteString -> BS.ByteString) where
    fdInvoke :: (ByteString -> ByteString)
-> Environment -> Channel -> IO (Channel, [InvokeResult])
fdInvoke ByteString -> ByteString
func =
        (ByteString -> IO ByteString)
-> Environment -> Channel -> IO (Channel, [InvokeResult])
forall a.
ShellCommand a =>
a -> Environment -> Channel -> IO (Channel, [InvokeResult])
fdInvoke ByteString -> IO ByteString
iofunc
            where iofunc :: BS.ByteString -> IO BS.ByteString
                  iofunc :: ByteString -> IO ByteString
iofunc = ByteString -> IO ByteString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> IO ByteString)
-> (ByteString -> ByteString) -> ByteString -> IO ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
func

instance ShellCommand (() -> BS.ByteString) where
    fdInvoke :: (() -> ByteString)
-> Environment -> Channel -> IO (Channel, [InvokeResult])
fdInvoke () -> ByteString
func =
        (() -> IO ByteString)
-> Environment -> Channel -> IO (Channel, [InvokeResult])
forall a.
ShellCommand a =>
a -> Environment -> Channel -> IO (Channel, [InvokeResult])
fdInvoke () -> IO ByteString
iofunc
            where iofunc :: () -> IO BS.ByteString
                  iofunc :: () -> IO ByteString
iofunc = ByteString -> IO ByteString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> IO ByteString)
-> (() -> ByteString) -> () -> IO ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> ByteString
func

instance ShellCommand (Channel -> IO Channel) where
    fdInvoke :: (Channel -> IO Channel)
-> Environment -> Channel -> IO (Channel, [InvokeResult])
fdInvoke Channel -> IO Channel
func Environment
_ Channel
cstdin =
        FilePath -> IO Channel -> IO (Channel, [InvokeResult])
runInHandler ((Channel -> IO Channel) -> FilePath
forall a. Show a => a -> FilePath
show Channel -> IO Channel
func) (Channel -> IO Channel
func Channel
cstdin)

{-
instance ShellCommand (Handle -> Handle -> IO ()) where
    fdInvoke func cstdin cstdout =
        runInHandler (show func) (func hstdin hstdout)
-}

genericStringlikeIO :: (Show (a -> IO a), Channelizable a) =>
                       (Channel -> IO a)
                    -> (a -> IO a)
                    -> Environment
                    -> Channel
                    -> IO (Channel, [InvokeResult])
genericStringlikeIO :: forall a.
(Show (a -> IO a), Channelizable a) =>
(Channel -> IO a)
-> (a -> IO a)
-> Environment
-> Channel
-> IO (Channel, [InvokeResult])
genericStringlikeIO Channel -> IO a
dechanfunc a -> IO a
userfunc Environment
_ Channel
cstdin =
    do a
contents <- Channel -> IO a
dechanfunc Channel
cstdin
       FilePath -> IO Channel -> IO (Channel, [InvokeResult])
runInHandler ((a -> IO a) -> FilePath
forall a. Show a => a -> FilePath
show a -> IO a
userfunc) (a -> IO Channel
realfunc a
contents)
    where realfunc :: a -> IO Channel
realfunc a
contents = do a
r <- a -> IO a
userfunc a
contents
                                 Channel -> IO Channel
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Channel
forall a. Channelizable a => a -> Channel
toChannel a
r)

genericStringlikeO :: (Show (() -> IO a), Channelizable a) =>
                      (() -> IO a)
                   -> Environment
                   -> Channel
                   -> IO (Channel, [InvokeResult])
genericStringlikeO :: forall a.
(Show (() -> IO a), Channelizable a) =>
(() -> IO a)
-> Environment -> Channel -> IO (Channel, [InvokeResult])
genericStringlikeO () -> IO a
userfunc Environment
_ Channel
_ =
    FilePath -> IO Channel -> IO (Channel, [InvokeResult])
runInHandler ((() -> IO a) -> FilePath
forall a. Show a => a -> FilePath
show () -> IO a
userfunc) IO Channel
realfunc
        where realfunc :: IO Channel
              realfunc :: IO Channel
realfunc = do a
r <- () -> IO a
userfunc ()
                            Channel -> IO Channel
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Channel
forall a. Channelizable a => a -> Channel
toChannel a
r)

instance Show ([String] -> [String]) where
    show :: ([FilePath] -> [FilePath]) -> FilePath
show [FilePath] -> [FilePath]
_ = FilePath
"([String] -> [String])"
instance Show (() -> [String]) where
    show :: (() -> [FilePath]) -> FilePath
show () -> [FilePath]
_ = FilePath
"(() -> [String])"
instance Show ([String] -> IO [String]) where
    show :: ([FilePath] -> IO [FilePath]) -> FilePath
show [FilePath] -> IO [FilePath]
_ = FilePath
"([String] -> IO [String])"
instance Show (() -> IO [String]) where
    show :: (() -> IO [FilePath]) -> FilePath
show () -> IO [FilePath]
_ = FilePath
"(() -> IO [String])"

{- | An instance of 'ShellCommand' for a pure Haskell function mapping
[String] to [String].

A [String] is generated from a Handle via the 'lines' function, and the
reverse occurs via 'unlines'.

So, this function is intended to operate upon lines of input and produce
lines of output. -}
instance ShellCommand ([String] -> [String]) where
    fdInvoke :: ([FilePath] -> [FilePath])
-> Environment -> Channel -> IO (Channel, [InvokeResult])
fdInvoke [FilePath] -> [FilePath]
func = ShowS -> Environment -> Channel -> IO (Channel, [InvokeResult])
forall a.
ShellCommand a =>
a -> Environment -> Channel -> IO (Channel, [InvokeResult])
fdInvoke ([FilePath] -> FilePath
unlines ([FilePath] -> FilePath) -> (FilePath -> [FilePath]) -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FilePath] -> [FilePath]
func ([FilePath] -> [FilePath])
-> (FilePath -> [FilePath]) -> FilePath -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> [FilePath]
lines)

instance ShellCommand (() -> [String]) where
    fdInvoke :: (() -> [FilePath])
-> Environment -> Channel -> IO (Channel, [InvokeResult])
fdInvoke () -> [FilePath]
func = (() -> FilePath)
-> Environment -> Channel -> IO (Channel, [InvokeResult])
forall a.
ShellCommand a =>
a -> Environment -> Channel -> IO (Channel, [InvokeResult])
fdInvoke ([FilePath] -> FilePath
unlines ([FilePath] -> FilePath) -> (() -> [FilePath]) -> () -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> [FilePath]
func)

{- | The same for an IO function -}
instance ShellCommand ([String] -> IO [String]) where
    fdInvoke :: ([FilePath] -> IO [FilePath])
-> Environment -> Channel -> IO (Channel, [InvokeResult])
fdInvoke [FilePath] -> IO [FilePath]
func = (FilePath -> IO FilePath)
-> Environment -> Channel -> IO (Channel, [InvokeResult])
forall a.
ShellCommand a =>
a -> Environment -> Channel -> IO (Channel, [InvokeResult])
fdInvoke FilePath -> IO FilePath
iofunc
        where iofunc :: FilePath -> IO FilePath
iofunc FilePath
input = do [FilePath]
r <- [FilePath] -> IO [FilePath]
func (FilePath -> [FilePath]
lines FilePath
input)
                                FilePath -> IO FilePath
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([FilePath] -> FilePath
unlines [FilePath]
r)

instance ShellCommand (() -> IO [String]) where
    fdInvoke :: (() -> IO [FilePath])
-> Environment -> Channel -> IO (Channel, [InvokeResult])
fdInvoke () -> IO [FilePath]
func = (() -> IO FilePath)
-> Environment -> Channel -> IO (Channel, [InvokeResult])
forall a.
ShellCommand a =>
a -> Environment -> Channel -> IO (Channel, [InvokeResult])
fdInvoke () -> IO FilePath
iofunc
        where iofunc :: (() -> IO String)
              iofunc :: () -> IO FilePath
iofunc () = do [FilePath]
r <- () -> IO [FilePath]
func ()
                             FilePath -> IO FilePath
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([FilePath] -> FilePath
unlines [FilePath]
r)


{- | An instance of 'ShellCommand' for an external command.  The
first String is the command to run, and the list of Strings represents the
arguments to the program, if any. -}
instance ShellCommand (String, [String]) where
    fdInvoke :: (FilePath, [FilePath])
-> Environment -> Channel -> IO (Channel, [InvokeResult])
fdInvoke (FilePath
fp, [FilePath]
args) = CmdSpec -> Environment -> Channel -> IO (Channel, [InvokeResult])
genericCommand (FilePath -> [FilePath] -> CmdSpec
RawCommand FilePath
fp [FilePath]
args)

{- | An instance of 'ShellCommand' for an external command.  The
String is split using words to the command to run, and the arguments, if any. -}
instance ShellCommand String where
    fdInvoke :: FilePath -> Environment -> Channel -> IO (Channel, [InvokeResult])
fdInvoke FilePath
cmd = CmdSpec -> Environment -> Channel -> IO (Channel, [InvokeResult])
genericCommand (FilePath -> CmdSpec
ShellCommand FilePath
cmd)

{- | How to we handle and external command. -}
genericCommand :: CmdSpec 
               -> Environment
               -> Channel
               -> IO (Channel, [InvokeResult])

-- Handling external command when stdin channel is a Handle
genericCommand :: CmdSpec -> Environment -> Channel -> IO (Channel, [InvokeResult])
genericCommand CmdSpec
c Environment
environ (ChanHandle Handle
ih) =
    let cp :: CreateProcess
cp = CreateProcess {cmdspec :: CmdSpec
cmdspec = CmdSpec
c,
                            cwd :: Maybe FilePath
cwd = Maybe FilePath
forall a. Maybe a
Nothing,
                            env :: Environment
env = Environment
environ,
                            std_in :: StdStream
std_in = Handle -> StdStream
UseHandle Handle
ih,
                            std_out :: StdStream
std_out = StdStream
CreatePipe,
                            std_err :: StdStream
std_err = StdStream
Inherit,
                            close_fds :: Bool
close_fds = Bool
True
#if MIN_VERSION_process(1,1,0)
-- Or use GHC version as a proxy:  __GLASGOW_HASKELL__ >= 720
			    -- Added field in process 1.1.0.0:
			    , create_group :: Bool
create_group = Bool
False
#endif
#if MIN_VERSION_process(1,2,0)
			    , delegate_ctlc :: Bool
delegate_ctlc = Bool
False
#endif
#if MIN_VERSION_process(1,3,0)
          , detach_console :: Bool
detach_console = Bool
False
          , create_new_console :: Bool
create_new_console = Bool
False
          , new_session :: Bool
new_session = Bool
False
#endif
#if MIN_VERSION_process(1,4,0)
          , child_group :: Maybe GroupID
child_group = Maybe GroupID
forall a. Maybe a
Nothing
          , child_user :: Maybe UserID
child_user = Maybe UserID
forall a. Maybe a
Nothing
#endif
#if MIN_VERSION_process(1,5,0)
          , use_process_jobs :: Bool
use_process_jobs = Bool
False
#endif
			   }
    in do (Maybe Handle
_, Maybe Handle
oh', Maybe Handle
_, ProcessHandle
ph) <- CreateProcess
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
createProcess CreateProcess
cp
          let oh :: Handle
oh = Maybe Handle -> Handle
forall a. HasCallStack => Maybe a -> a
fromJust Maybe Handle
oh'
          (Channel, [InvokeResult]) -> IO (Channel, [InvokeResult])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Handle -> Channel
ChanHandle Handle
oh, [(CmdSpec -> FilePath
printCmdSpec CmdSpec
c, ProcessHandle -> IO ExitCode
waitForProcess ProcessHandle
ph)])
genericCommand CmdSpec
cspec Environment
environ Channel
ichan = 
    let cp :: CreateProcess
cp = CreateProcess {cmdspec :: CmdSpec
cmdspec = CmdSpec
cspec,
                            cwd :: Maybe FilePath
cwd = Maybe FilePath
forall a. Maybe a
Nothing,
                            env :: Environment
env = Environment
environ,
                            std_in :: StdStream
std_in = StdStream
CreatePipe,
                            std_out :: StdStream
std_out = StdStream
CreatePipe,
                            std_err :: StdStream
std_err = StdStream
Inherit,
                            close_fds :: Bool
close_fds = Bool
True
#if MIN_VERSION_process(1,1,0)
			    -- Added field in process 1.1.0.0:
			    , create_group :: Bool
create_group = Bool
False
#endif
#if MIN_VERSION_process(1,2,0)
			    , delegate_ctlc :: Bool
delegate_ctlc = Bool
False
#endif
#if MIN_VERSION_process(1,3,0)
          , detach_console :: Bool
detach_console = Bool
False
          , create_new_console :: Bool
create_new_console = Bool
False
          , new_session :: Bool
new_session = Bool
False
#endif
#if MIN_VERSION_process(1,4,0)
          , child_group :: Maybe GroupID
child_group = Maybe GroupID
forall a. Maybe a
Nothing
          , child_user :: Maybe UserID
child_user = Maybe UserID
forall a. Maybe a
Nothing
#endif
#if MIN_VERSION_process(1,5,0)
          , use_process_jobs :: Bool
use_process_jobs = Bool
False
#endif
			   }
    in do (Maybe Handle
ih', Maybe Handle
oh', Maybe Handle
_, ProcessHandle
ph) <- CreateProcess
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
createProcess CreateProcess
cp
          let ih :: Handle
ih = Maybe Handle -> Handle
forall a. HasCallStack => Maybe a -> a
fromJust Maybe Handle
ih'
          let oh :: Handle
oh = Maybe Handle -> Handle
forall a. HasCallStack => Maybe a -> a
fromJust Maybe Handle
oh'
          Bool -> Channel -> Handle -> IO ()
chanToHandle Bool
True Channel
ichan Handle
ih
          (Channel, [InvokeResult]) -> IO (Channel, [InvokeResult])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Handle -> Channel
ChanHandle Handle
oh, [(CmdSpec -> FilePath
printCmdSpec CmdSpec
cspec, ProcessHandle -> IO ExitCode
waitForProcess ProcessHandle
ph)])

printCmdSpec :: CmdSpec -> String
printCmdSpec :: CmdSpec -> FilePath
printCmdSpec (ShellCommand FilePath
s) = FilePath
s
printCmdSpec (RawCommand FilePath
fp [FilePath]
args) = (FilePath, [FilePath]) -> FilePath
forall a. Show a => a -> FilePath
show (FilePath
fp, [FilePath]
args)

------------------------------------------------------------
-- Pipes
------------------------------------------------------------

data PipeCommand a b = (ShellCommand a, ShellCommand b) => PipeCommand a b

deriving instance Show (PipeCommand a b)

{- | An instance of 'ShellCommand' represeting a pipeline. -}
instance (ShellCommand a, ShellCommand b) => ShellCommand (PipeCommand a b) where
    fdInvoke :: PipeCommand a b
-> Environment -> Channel -> IO (Channel, [InvokeResult])
fdInvoke (PipeCommand a
cmd1 b
cmd2) Environment
env Channel
ichan =
        do (Channel
chan1, [InvokeResult]
res1) <- a -> Environment -> Channel -> IO (Channel, [InvokeResult])
forall a.
ShellCommand a =>
a -> Environment -> Channel -> IO (Channel, [InvokeResult])
fdInvoke a
cmd1 Environment
env Channel
ichan
           (Channel
chan2, [InvokeResult]
res2) <- b -> Environment -> Channel -> IO (Channel, [InvokeResult])
forall a.
ShellCommand a =>
a -> Environment -> Channel -> IO (Channel, [InvokeResult])
fdInvoke b
cmd2 Environment
env Channel
chan1
           (Channel, [InvokeResult]) -> IO (Channel, [InvokeResult])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Channel
chan2, [InvokeResult]
res1 [InvokeResult] -> [InvokeResult] -> [InvokeResult]
forall a. [a] -> [a] -> [a]
++ [InvokeResult]
res2)

{- | Pipe the output of the first command into the input of the second. -}
(-|-) :: (ShellCommand a, ShellCommand b) => a -> b -> PipeCommand a b
-|- :: forall a b.
(ShellCommand a, ShellCommand b) =>
a -> b -> PipeCommand a b
(-|-) = a -> b -> PipeCommand a b
forall a b.
(ShellCommand a, ShellCommand b) =>
a -> b -> PipeCommand a b
PipeCommand

{- | Different ways to get data from 'run'.

 * IO () runs, throws an exception on error, and sends stdout to stdout

 * IO String runs, throws an exception on error, reads stdout into
   a buffer, and returns it as a string.  Note: This output is not lazy.

 * IO [String] is same as IO String, but returns the results as lines.
   Note: this output is not lazy.

 * IO ExitCode runs and returns an ExitCode with the exit
   information.  stdout is sent to stdout.  Exceptions are not thrown.

 * IO (String, ExitCode) is like IO ExitCode, but also
   includes a description of the last command in the pipe to have
   an error (or the last command, if there was no error).

 * IO ByteString and are similar to their String counterparts.

 * IO (String, IO (String, ExitCode)) returns a String read lazily
   and an IO action that, when evaluated, finishes up the process and
   results in its exit status.  This command returns immediately.

 * IO (IO (String, ExitCode)) sends stdout to stdout but returns
   immediately.  It forks off the child but does not wait for it to finish.
   You can use 'checkResults' to wait for the finish.

 * IO Int returns the exit code from a program directly.  If a signal
   caused the command to be reaped, returns 128 + SIGNUM.

 * IO Bool returns True if the program exited normally (exit code 0,
   not stopped by a signal) and False otherwise.

To address insufficient laziness, you can process anything that needs to be
processed lazily within the pipeline itself.
-}
class RunResult a where
    {- | Runs a command (or pipe of commands), with results presented
       in any number of different ways. -}
    run :: (ShellCommand b) => b -> a

instance RunResult (IO ()) where
    run :: forall b. ShellCommand b => b -> IO ()
run b
cmd = b -> IO (FilePath, ExitCode)
forall a b. (RunResult a, ShellCommand b) => b -> a
forall b. ShellCommand b => b -> IO (FilePath, ExitCode)
run b
cmd IO (FilePath, ExitCode) -> ((FilePath, ExitCode) -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (FilePath, ExitCode) -> IO ()
checkResults

instance RunResult (IO (String, ExitCode)) where
    run :: forall b. ShellCommand b => b -> IO (FilePath, ExitCode)
run b
cmd =
        do (Channel
ochan, [InvokeResult]
r) <- b -> Environment -> Channel -> IO (Channel, [InvokeResult])
forall a.
ShellCommand a =>
a -> Environment -> Channel -> IO (Channel, [InvokeResult])
fdInvoke b
cmd Environment
forall a. Maybe a
Nothing (Handle -> Channel
ChanHandle Handle
stdin)
           Bool -> Channel -> Handle -> IO ()
chanToHandle Bool
False Channel
ochan Handle
stdout
           [InvokeResult] -> IO (FilePath, ExitCode)
processResults [InvokeResult]
r

instance RunResult (IO ExitCode) where
    run :: forall b. ShellCommand b => b -> IO ExitCode
run b
cmd = ((b -> IO (FilePath, ExitCode)
forall a b. (RunResult a, ShellCommand b) => b -> a
forall b. ShellCommand b => b -> IO (FilePath, ExitCode)
run b
cmd)::IO (String, ExitCode)) IO (FilePath, ExitCode)
-> ((FilePath, ExitCode) -> IO ExitCode) -> IO ExitCode
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ExitCode -> IO ExitCode
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ExitCode -> IO ExitCode)
-> ((FilePath, ExitCode) -> ExitCode)
-> (FilePath, ExitCode)
-> IO ExitCode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath, ExitCode) -> ExitCode
forall a b. (a, b) -> b
snd

instance RunResult (IO Int) where
    run :: forall b. ShellCommand b => b -> IO Int
run b
cmd = do ExitCode
rc <- b -> IO ExitCode
forall a b. (RunResult a, ShellCommand b) => b -> a
forall b. ShellCommand b => b -> IO ExitCode
run b
cmd
                 case ExitCode
rc of
                   ExitCode
ExitSuccess -> Int -> IO Int
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int
0
                   ExitFailure Int
x -> Int -> IO Int
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int
x

instance RunResult (IO Bool) where
    run :: forall b. ShellCommand b => b -> IO Bool
run b
cmd = do Int
rc <- b -> IO Int
forall a b. (RunResult a, ShellCommand b) => b -> a
forall b. ShellCommand b => b -> IO Int
run b
cmd
                 Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ((Int
rc::Int) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0)

instance RunResult (IO [String]) where
    run :: forall b. ShellCommand b => b -> IO [FilePath]
run b
cmd = do FilePath
r <- b -> IO FilePath
forall a b. (RunResult a, ShellCommand b) => b -> a
forall b. ShellCommand b => b -> IO FilePath
run b
cmd
                 [FilePath] -> IO [FilePath]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> [FilePath]
lines FilePath
r)

instance RunResult (IO String) where
    run :: forall b. ShellCommand b => b -> IO FilePath
run b
cmd = (Channel -> IO FilePath)
-> (FilePath -> IO Int) -> b -> IO FilePath
forall b a c.
ShellCommand b =>
(Channel -> IO a) -> (a -> IO c) -> b -> IO a
genericStringlikeResult Channel -> IO FilePath
chanAsString (\FilePath
c -> Int -> IO Int
forall a. a -> IO a
evaluate (FilePath -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length FilePath
c))
              b
cmd

instance RunResult (IO BSL.ByteString) where
    run :: forall b. ShellCommand b => b -> IO ByteString
run b
cmd = (Channel -> IO ByteString)
-> (ByteString -> IO Int64) -> b -> IO ByteString
forall b a c.
ShellCommand b =>
(Channel -> IO a) -> (a -> IO c) -> b -> IO a
genericStringlikeResult Channel -> IO ByteString
chanAsBSL
              (\ByteString
c -> Int64 -> IO Int64
forall a. a -> IO a
evaluate (ByteString -> Int64
BSL.length ByteString
c))
              b
cmd

instance RunResult (IO BS.ByteString) where
    run :: forall b. ShellCommand b => b -> IO ByteString
run b
cmd = (Channel -> IO ByteString)
-> (ByteString -> IO Int) -> b -> IO ByteString
forall b a c.
ShellCommand b =>
(Channel -> IO a) -> (a -> IO c) -> b -> IO a
genericStringlikeResult Channel -> IO ByteString
chanAsBS
              (\ByteString
c -> Int -> IO Int
forall a. a -> IO a
evaluate (ByteString -> Int
BS.length ByteString
c))
              b
cmd

instance RunResult (IO (String, IO (String, ExitCode))) where
    run :: forall b.
ShellCommand b =>
b -> IO (FilePath, IO (FilePath, ExitCode))
run b
cmd = (Channel -> IO FilePath)
-> b -> IO (FilePath, IO (FilePath, ExitCode))
forall b a.
ShellCommand b =>
(Channel -> IO a) -> b -> IO (a, IO (FilePath, ExitCode))
intermediateStringlikeResult Channel -> IO FilePath
chanAsString b
cmd

instance RunResult (IO (BSL.ByteString, IO (String, ExitCode))) where
    run :: forall b.
ShellCommand b =>
b -> IO (ByteString, IO (FilePath, ExitCode))
run b
cmd = (Channel -> IO ByteString)
-> b -> IO (ByteString, IO (FilePath, ExitCode))
forall b a.
ShellCommand b =>
(Channel -> IO a) -> b -> IO (a, IO (FilePath, ExitCode))
intermediateStringlikeResult Channel -> IO ByteString
chanAsBSL b
cmd

instance RunResult (IO (BS.ByteString, IO (String, ExitCode))) where
    run :: forall b.
ShellCommand b =>
b -> IO (ByteString, IO (FilePath, ExitCode))
run b
cmd = (Channel -> IO ByteString)
-> b -> IO (ByteString, IO (FilePath, ExitCode))
forall b a.
ShellCommand b =>
(Channel -> IO a) -> b -> IO (a, IO (FilePath, ExitCode))
intermediateStringlikeResult Channel -> IO ByteString
chanAsBS b
cmd

instance RunResult (IO (IO (String, ExitCode))) where
    run :: forall b. ShellCommand b => b -> IO (IO (FilePath, ExitCode))
run b
cmd = do (Channel
ochan, [InvokeResult]
r) <- b -> Environment -> Channel -> IO (Channel, [InvokeResult])
forall a.
ShellCommand a =>
a -> Environment -> Channel -> IO (Channel, [InvokeResult])
fdInvoke b
cmd Environment
forall a. Maybe a
Nothing (Handle -> Channel
ChanHandle Handle
stdin)
                 Bool -> Channel -> Handle -> IO ()
chanToHandle Bool
False Channel
ochan Handle
stdout
                 IO (FilePath, ExitCode) -> IO (IO (FilePath, ExitCode))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([InvokeResult] -> IO (FilePath, ExitCode)
processResults [InvokeResult]
r)

intermediateStringlikeResult :: ShellCommand b =>
                                (Channel -> IO a)
                             -> b
                             -> IO (a, IO (String, ExitCode))
intermediateStringlikeResult :: forall b a.
ShellCommand b =>
(Channel -> IO a) -> b -> IO (a, IO (FilePath, ExitCode))
intermediateStringlikeResult Channel -> IO a
chanfunc b
cmd =
        do (Channel
ochan, [InvokeResult]
r) <- b -> Environment -> Channel -> IO (Channel, [InvokeResult])
forall a.
ShellCommand a =>
a -> Environment -> Channel -> IO (Channel, [InvokeResult])
fdInvoke b
cmd Environment
forall a. Maybe a
Nothing (Handle -> Channel
ChanHandle Handle
stdin)
           a
c <- Channel -> IO a
chanfunc Channel
ochan
           (a, IO (FilePath, ExitCode)) -> IO (a, IO (FilePath, ExitCode))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (a
c, [InvokeResult] -> IO (FilePath, ExitCode)
processResults [InvokeResult]
r)

genericStringlikeResult :: ShellCommand b => 
                           (Channel -> IO a)
                        -> (a -> IO c)
                        -> b 
                        -> IO a
genericStringlikeResult :: forall b a c.
ShellCommand b =>
(Channel -> IO a) -> (a -> IO c) -> b -> IO a
genericStringlikeResult Channel -> IO a
chanfunc a -> IO c
evalfunc b
cmd =
        do (a
c, IO (FilePath, ExitCode)
r) <- (Channel -> IO a) -> b -> IO (a, IO (FilePath, ExitCode))
forall b a.
ShellCommand b =>
(Channel -> IO a) -> b -> IO (a, IO (FilePath, ExitCode))
intermediateStringlikeResult Channel -> IO a
chanfunc b
cmd
           a -> IO c
evalfunc a
c
           --evaluate (length c)
           -- d "runS 6"
           -- d "runS 7"
           IO (FilePath, ExitCode)
r IO (FilePath, ExitCode) -> ((FilePath, ExitCode) -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (FilePath, ExitCode) -> IO ()
checkResults
           -- d "runS 8"
           a -> IO a
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
c

{- | Evaluates the result codes and returns an overall status -}
processResults :: [InvokeResult] -> IO (String, ExitCode)
processResults :: [InvokeResult] -> IO (FilePath, ExitCode)
processResults [InvokeResult]
r =
    do [Maybe (FilePath, ExitCode)]
rc <- (InvokeResult -> IO (Maybe (FilePath, ExitCode)))
-> [InvokeResult] -> IO [Maybe (FilePath, ExitCode)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM InvokeResult -> IO (Maybe (FilePath, ExitCode))
procresult [InvokeResult]
r
       case [Maybe (FilePath, ExitCode)] -> [(FilePath, ExitCode)]
forall a. [Maybe a] -> [a]
catMaybes [Maybe (FilePath, ExitCode)]
rc of
         [] -> (FilePath, ExitCode) -> IO (FilePath, ExitCode)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (InvokeResult -> FilePath
forall a b. (a, b) -> a
fst ([InvokeResult] -> InvokeResult
forall a. HasCallStack => [a] -> a
last [InvokeResult]
r), ExitCode
ExitSuccess)
         [(FilePath, ExitCode)]
x -> (FilePath, ExitCode) -> IO (FilePath, ExitCode)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([(FilePath, ExitCode)] -> (FilePath, ExitCode)
forall a. HasCallStack => [a] -> a
last [(FilePath, ExitCode)]
x)
    where procresult :: InvokeResult -> IO (Maybe (String, ExitCode))
          procresult :: InvokeResult -> IO (Maybe (FilePath, ExitCode))
procresult (FilePath
cmd, IO ExitCode
action) =
              do ExitCode
rc <- IO ExitCode
action
                 Maybe (FilePath, ExitCode) -> IO (Maybe (FilePath, ExitCode))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (FilePath, ExitCode) -> IO (Maybe (FilePath, ExitCode)))
-> Maybe (FilePath, ExitCode) -> IO (Maybe (FilePath, ExitCode))
forall a b. (a -> b) -> a -> b
$ case ExitCode
rc of
                   ExitCode
ExitSuccess -> Maybe (FilePath, ExitCode)
forall a. Maybe a
Nothing
                   ExitCode
x -> (FilePath, ExitCode) -> Maybe (FilePath, ExitCode)
forall a. a -> Maybe a
Just (FilePath
cmd, ExitCode
x)

{- | Evaluates result codes and raises an error for any bad ones it finds. -}
checkResults :: (String, ExitCode) -> IO ()
checkResults :: (FilePath, ExitCode) -> IO ()
checkResults (FilePath
cmd, ExitCode
ps) =
       case ExitCode
ps of
         ExitCode
ExitSuccess -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
         ExitFailure Int
x ->
             FilePath -> IO ()
forall a. FilePath -> IO a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
cmd FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
": exited with code " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> FilePath
forall a. Show a => a -> FilePath
show Int
x
{- FIXME: generate these again 
         Terminated sig ->
             fail $ cmd ++ ": terminated by signal " ++ show sig
         Stopped sig ->
             fail $ cmd ++ ": stopped by signal " ++ show sig
-}

{- | Handle an exception derived from a program exiting abnormally -}
tryEC :: IO a -> IO (Either ExitCode a)
tryEC :: forall a. IO a -> IO (Either ExitCode a)
tryEC IO a
action =
    do Either IOError a
r <-  IO a -> IO (Either IOError a)
forall e a. Exception e => IO a -> IO (Either e a)
Control.Exception.try IO a
action
       case Either IOError a
r of
         Left IOError
ioe ->
          if IOError -> Bool
isUserError IOError
ioe then
              case (IOError -> FilePath
ioeGetErrorString IOError
ioe FilePath -> FilePath -> Maybe FilePath
forall source source1 target (m :: * -> *).
(RegexMaker Regex CompOption ExecOption source,
 RegexContext Regex source1 target, MonadFail m) =>
source1 -> source -> m target
=~~ FilePath
pat) of
                Maybe FilePath
Nothing -> IOError -> IO (Either ExitCode a)
forall a. IOError -> IO a
ioError IOError
ioe -- not ours; re-raise it
                Just FilePath
e -> Either ExitCode a -> IO (Either ExitCode a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either ExitCode a -> IO (Either ExitCode a))
-> (FilePath -> Either ExitCode a)
-> FilePath
-> IO (Either ExitCode a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExitCode -> Either ExitCode a
forall a b. a -> Either a b
Left (ExitCode -> Either ExitCode a)
-> (FilePath -> ExitCode) -> FilePath -> Either ExitCode a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> ExitCode
procit (FilePath -> IO (Either ExitCode a))
-> FilePath -> IO (Either ExitCode a)
forall a b. (a -> b) -> a -> b
$ FilePath
e
          else IOError -> IO (Either ExitCode a)
forall a. IOError -> IO a
ioError IOError
ioe      -- not ours; re-raise it
         Right a
result -> Either ExitCode a -> IO (Either ExitCode a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Either ExitCode a
forall a b. b -> Either a b
Right a
result)
    where pat :: FilePath
pat = FilePath
": exited with code [0-9]+$|: terminated by signal ([0-9]+)$|: stopped by signal [0-9]+"
          procit :: String -> ExitCode
          procit :: FilePath -> ExitCode
procit FilePath
e
              | FilePath
e FilePath -> FilePath -> Bool
forall source source1 target.
(RegexMaker Regex CompOption ExecOption source,
 RegexContext Regex source1 target) =>
source1 -> source -> target
=~ FilePath
"^: exited" = Int -> ExitCode
ExitFailure (FilePath -> Int
forall {a} {source1}.
(Read a, RegexContext Regex source1 FilePath) =>
source1 -> a
str2ec FilePath
e)
--              | e =~ "^: terminated by signal" = Terminated (str2ec e)
--              | e =~ "^: stopped by signal" = Stopped (str2ec e)
              | Bool
otherwise = FilePath -> ExitCode
forall a. HasCallStack => FilePath -> a
error FilePath
"Internal error in tryEC"
          str2ec :: source1 -> a
str2ec source1
e =
              FilePath -> a
forall a. Read a => FilePath -> a
read (source1
e source1 -> ShowS
forall source source1 target.
(RegexMaker Regex CompOption ExecOption source,
 RegexContext Regex source1 target) =>
source1 -> source -> target
=~ FilePath
"[0-9]+$")

{- | Catch an exception derived from a program exiting abnormally -}
catchEC :: IO a -> (ExitCode -> IO a) -> IO a
catchEC :: forall a. IO a -> (ExitCode -> IO a) -> IO a
catchEC IO a
action ExitCode -> IO a
handler =
    do Either ExitCode a
r <- IO a -> IO (Either ExitCode a)
forall a. IO a -> IO (Either ExitCode a)
tryEC IO a
action
       case Either ExitCode a
r of
         Left ExitCode
ec -> ExitCode -> IO a
handler ExitCode
ec
         Right a
result -> a -> IO a
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
result

{- | A convenience function.  Refers only to the version of 'run'
that returns @IO ()@.  This prevents you from having to cast to it
all the time when you do not care about the result of 'run'.

The implementation is simply:

>runIO :: (ShellCommand a) => a -> IO ()
>runIO = run
-}
runIO :: (ShellCommand a) => a -> IO ()
runIO :: forall b. ShellCommand b => b -> IO ()
runIO = a -> IO ()
forall a b. (RunResult a, ShellCommand b) => b -> a
forall b. ShellCommand b => b -> IO ()
run

{- | Another convenience function.  This returns the first line of the output,
with any trailing newlines or whitespace stripped off.  No leading whitespace
is stripped.  This function will raise an exception if there is not at least
one line of output.  Mnemonic: runSL means \"run single line\".

This command exists separately from 'run' because there is already a
'run' instance that returns a String, though that instance returns the
entirety of the output in that String. -}
runSL :: (ShellCommand a) => a -> IO String
runSL :: forall b. ShellCommand b => b -> IO FilePath
runSL a
cmd =
    do [FilePath]
r <- a -> IO [FilePath]
forall a b. (RunResult a, ShellCommand b) => b -> a
forall b. ShellCommand b => b -> IO [FilePath]
run a
cmd
       Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([FilePath]
r [FilePath] -> [FilePath] -> Bool
forall a. Eq a => a -> a -> Bool
== []) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> IO ()
forall a. FilePath -> IO a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"runSL: no output received from " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> FilePath
forall a. Show a => a -> FilePath
show a
cmd
       FilePath -> IO FilePath
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ShowS
rstrip ShowS -> ([FilePath] -> FilePath) -> [FilePath] -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FilePath] -> FilePath
forall a. HasCallStack => [a] -> a
head ([FilePath] -> FilePath) -> [FilePath] -> FilePath
forall a b. (a -> b) -> a -> b
$ [FilePath]
r)


{- | Convenience function to wrap a child thread.  Kicks off the thread, handles
running the code, traps execptions, the works.

Note that if func is lazy, such as a getContents sort of thing,
the exception may go uncaught here.

NOTE: expects func to be lazy!
 -}
runInHandler :: String           -- ^ Description of this function
            -> (IO Channel)     -- ^ The action to run in the thread
            -> IO (Channel, [InvokeResult])
runInHandler :: FilePath -> IO Channel -> IO (Channel, [InvokeResult])
runInHandler FilePath
descrip IO Channel
func =
    IO (Channel, [InvokeResult])
-> (SomeException -> IO (Channel, [InvokeResult]))
-> IO (Channel, [InvokeResult])
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
catch (IO (Channel, [InvokeResult])
realfunc) (SomeException -> IO (Channel, [InvokeResult])
exchandler)
    where realfunc :: IO (Channel, [InvokeResult])
realfunc = do Channel
r <- IO Channel
func
                        (Channel, [InvokeResult]) -> IO (Channel, [InvokeResult])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Channel
r, [(FilePath
descrip, ExitCode -> IO ExitCode
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ExitCode
ExitSuccess)])
          exchandler :: SomeException -> IO (Channel, [InvokeResult])
          exchandler :: SomeException -> IO (Channel, [InvokeResult])
exchandler SomeException
e = do FilePath -> IO ()
em (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"runInHandler/" FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
descrip FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
": " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ SomeException -> FilePath
forall a. Show a => a -> FilePath
show SomeException
e
                            (Channel, [InvokeResult]) -> IO (Channel, [InvokeResult])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> Channel
ChanString FilePath
"", [(FilePath
descrip, ExitCode -> IO ExitCode
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> ExitCode
ExitFailure Int
1))])


------------------------------------------------------------
-- Environment
------------------------------------------------------------
{- | An environment variable filter function.

This is a low-level interface; see 'setenv' and 'unsetenv' for more convenient
interfaces. -}
type EnvironFilter = [(String, String)] -> [(String, String)]

instance Show EnvironFilter where
    show :: EnvironFilter -> FilePath
show EnvironFilter
_ = FilePath
"EnvironFilter"


{- | A command that carries environment variable information with it.

This is a low-level interface; see 'setenv' and 'unsetenv' for more
convenient interfaces. -}
data EnvironCommand a = (ShellCommand a) => EnvironCommand EnvironFilter a

deriving instance Show (EnvironCommand a)

instance (ShellCommand a) => ShellCommand (EnvironCommand a) where
    fdInvoke :: EnvironCommand a
-> Environment -> Channel -> IO (Channel, [InvokeResult])
fdInvoke (EnvironCommand EnvironFilter
efilter a
cmd) Environment
Nothing Channel
ichan =
        do -- No incoming environment; initialize from system default.
           [(FilePath, FilePath)]
e <- IO [(FilePath, FilePath)]
getEnvironment
           a -> Environment -> Channel -> IO (Channel, [InvokeResult])
forall a.
ShellCommand a =>
a -> Environment -> Channel -> IO (Channel, [InvokeResult])
fdInvoke a
cmd ([(FilePath, FilePath)] -> Environment
forall a. a -> Maybe a
Just (EnvironFilter
efilter [(FilePath, FilePath)]
e)) Channel
ichan
    fdInvoke (EnvironCommand EnvironFilter
efilter a
cmd) (Just [(FilePath, FilePath)]
ienv) Channel
ichan =
        a -> Environment -> Channel -> IO (Channel, [InvokeResult])
forall a.
ShellCommand a =>
a -> Environment -> Channel -> IO (Channel, [InvokeResult])
fdInvoke a
cmd ([(FilePath, FilePath)] -> Environment
forall a. a -> Maybe a
Just (EnvironFilter
efilter [(FilePath, FilePath)]
ienv)) Channel
ichan

{- | Sets an environment variable, replacing an existing one if it exists.

Here's a sample ghci session to illustrate.  First, let's see the defaults for
some variables:

> Prelude HSH> runIO $ "echo $TERM, $LANG"
> xterm, en_US.UTF-8

Now, let's set one:

> Prelude HSH> runIO $ setenv [("TERM", "foo")] $ "echo $TERM, $LANG"
> foo, en_US.UTF-8

Or two:

> Prelude HSH> runIO $ setenv [("TERM", "foo")] $ setenv [("LANG", "de_DE.UTF-8")] $ "echo $TERM, $LANG"
> foo, de_DE.UTF-8

We could also do it easier, like this:

> Prelude HSH> runIO $ setenv [("TERM", "foo"), ("LANG", "de_DE.UTF-8")] $ "echo $TERM, $LANG"
> foo, de_DE.UTF-8

It can be combined with unsetenv:

> Prelude HSH> runIO $ setenv [("TERM", "foo")] $ unsetenv ["LANG"] $ "echo $TERM, $LANG"
> foo,

And used with pipes:

> Prelude HSH> runIO $ setenv [("TERM", "foo")] $ "echo $TERM, $LANG" -|- "tr a-z A-Z"
> FOO, EN_US.UTF-8

See also 'unsetenv'.
-}
setenv :: (ShellCommand cmd) => [(String, String)] -> cmd -> EnvironCommand cmd
setenv :: forall cmd.
ShellCommand cmd =>
[(FilePath, FilePath)] -> cmd -> EnvironCommand cmd
setenv [(FilePath, FilePath)]
items cmd
cmd =
    EnvironFilter -> cmd -> EnvironCommand cmd
forall a. ShellCommand a => EnvironFilter -> a -> EnvironCommand a
EnvironCommand EnvironFilter
efilter cmd
cmd
    where efilter :: EnvironFilter
efilter [(FilePath, FilePath)]
ienv = ((FilePath, FilePath) -> EnvironFilter)
-> [(FilePath, FilePath)] -> EnvironFilter
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (FilePath, FilePath) -> EnvironFilter
forall {a} {b}. Eq a => (a, b) -> [(a, b)] -> [(a, b)]
efilter' [(FilePath, FilePath)]
ienv [(FilePath, FilePath)]
items
          efilter' :: (a, b) -> [(a, b)] -> [(a, b)]
efilter' (a
key, b
val) [(a, b)]
ienv = 
              (a
key, b
val) (a, b) -> [(a, b)] -> [(a, b)]
forall a. a -> [a] -> [a]
: (((a, b) -> Bool) -> [(a, b)] -> [(a, b)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(a
k, b
_) -> a
k a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
key) [(a, b)]
ienv)

{- | Removes an environment variable if it exists; does nothing otherwise.

See also 'setenv', which has a more extensive example.
-}
unsetenv :: (ShellCommand cmd) => [String] -> cmd -> EnvironCommand cmd
unsetenv :: forall cmd.
ShellCommand cmd =>
[FilePath] -> cmd -> EnvironCommand cmd
unsetenv [FilePath]
keys cmd
cmd =
    EnvironFilter -> cmd -> EnvironCommand cmd
forall a. ShellCommand a => EnvironFilter -> a -> EnvironCommand a
EnvironCommand EnvironFilter
forall {b}. [(FilePath, b)] -> [(FilePath, b)]
efilter cmd
cmd
    where efilter :: [(FilePath, b)] -> [(FilePath, b)]
efilter [(FilePath, b)]
ienv = (FilePath -> [(FilePath, b)] -> [(FilePath, b)])
-> [(FilePath, b)] -> [FilePath] -> [(FilePath, b)]
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr FilePath -> [(FilePath, b)] -> [(FilePath, b)]
forall {a} {b}. Eq a => a -> [(a, b)] -> [(a, b)]
efilter' [(FilePath, b)]
ienv [FilePath]
keys
          efilter' :: a -> [(a, b)] -> [(a, b)]
efilter' a
key = ((a, b) -> Bool) -> [(a, b)] -> [(a, b)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(a
k, b
_) -> a
k a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
key)