{-# OPTIONS_GHC -XFlexibleInstances -XTypeSynonymInstances -XStandaloneDeriving #-}
module HSH.Command (Environment,
ShellCommand(..),
PipeCommand(..),
(-|-),
RunResult,
run,
runIO,
runSL,
InvokeResult,
checkResults,
tryEC,
catchEC,
setenv,
unsetenv
) where
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 :: String -> IO ()
d = String -> String -> IO ()
debugM "HSH.Command"
dr :: String -> IO ()
dr = String -> String -> IO ()
debugM "HSH.Command.Run"
em :: String -> IO ()
em = String -> String -> IO ()
errorM "HSH.Command"
type InvokeResult = (String, IO ExitCode)
type Environment = Maybe [(String, String)]
class (Show a) => ShellCommand a where
fdInvoke :: a
-> Environment
-> Channel
-> IO (Channel, [InvokeResult])
instance Show (Handle -> Handle -> IO ()) where
show :: (Handle -> Handle -> IO ()) -> String
show _ = "(Handle -> Handle -> IO ())"
instance Show (Channel -> IO Channel) where
show :: (Channel -> IO Channel) -> String
show _ = "(Channel -> IO Channel)"
instance Show (String -> String) where
show :: ShowS -> String
show _ = "(String -> String)"
instance Show (() -> String) where
show :: (() -> String) -> String
show _ = "(() -> String)"
instance Show (String -> IO String) where
show :: (String -> IO String) -> String
show _ = "(String -> IO String)"
instance Show (() -> IO String) where
show :: (() -> IO String) -> String
show _ = "(() -> IO String)"
instance Show (BSL.ByteString -> BSL.ByteString) where
show :: (ByteString -> ByteString) -> String
show _ = "(Data.ByteString.Lazy.ByteString -> Data.ByteString.Lazy.ByteString)"
instance Show (() -> BSL.ByteString) where
show :: (() -> ByteString) -> String
show _ = "(() -> Data.ByteString.Lazy.ByteString)"
instance Show (BSL.ByteString -> IO BSL.ByteString) where
show :: (ByteString -> IO ByteString) -> String
show _ = "(Data.ByteString.Lazy.ByteString -> IO Data.ByteString.Lazy.ByteString)"
instance Show (() -> IO BSL.ByteString) where
show :: (() -> IO ByteString) -> String
show _ = "(() -> IO BSL.ByteString)"
instance Show (BS.ByteString -> BS.ByteString) where
show :: (ByteString -> ByteString) -> String
show _ = "(Data.ByteString.ByteString -> Data.ByteString.ByteString)"
instance Show (() -> BS.ByteString) where
show :: (() -> ByteString) -> String
show _ = "(() -> Data.ByteString.ByteString)"
instance Show (BS.ByteString -> IO BS.ByteString) where
show :: (ByteString -> IO ByteString) -> String
show _ = "(Data.ByteString.ByteString -> IO Data.ByteString.ByteString)"
instance Show (() -> IO BS.ByteString) where
show :: (() -> IO ByteString) -> String
show _ = "(() -> IO Data.ByteString.ByteString)"
instance ShellCommand (String -> IO String) where
fdInvoke :: (String -> IO String)
-> Environment -> Channel -> IO (Channel, [InvokeResult])
fdInvoke = (Channel -> IO String)
-> (String -> IO String)
-> 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 String
chanAsString
instance ShellCommand (() -> IO String) where
fdInvoke :: (() -> IO String)
-> Environment -> Channel -> IO (Channel, [InvokeResult])
fdInvoke = (() -> IO String)
-> 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
instance ShellCommand (String -> String) where
fdInvoke :: ShowS -> Environment -> Channel -> IO (Channel, [InvokeResult])
fdInvoke func :: ShowS
func =
(String -> IO String)
-> Environment -> Channel -> IO (Channel, [InvokeResult])
forall a.
ShellCommand a =>
a -> Environment -> Channel -> IO (Channel, [InvokeResult])
fdInvoke String -> IO String
iofunc
where iofunc :: String -> IO String
iofunc :: String -> IO String
iofunc = String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> IO String) -> ShowS -> String -> IO String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
func
instance ShellCommand (() -> String) where
fdInvoke :: (() -> String)
-> Environment -> Channel -> IO (Channel, [InvokeResult])
fdInvoke func :: () -> String
func =
(() -> IO String)
-> Environment -> Channel -> IO (Channel, [InvokeResult])
forall a.
ShellCommand a =>
a -> Environment -> Channel -> IO (Channel, [InvokeResult])
fdInvoke () -> IO String
iofunc
where iofunc :: () -> IO String
iofunc :: () -> IO String
iofunc = String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> IO String) -> (() -> String) -> () -> IO String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> String
func
instance ShellCommand (BSL.ByteString -> BSL.ByteString) where
fdInvoke :: (ByteString -> ByteString)
-> Environment -> Channel -> IO (Channel, [InvokeResult])
fdInvoke func :: 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 (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 func :: () -> 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 (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 func :: 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 (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 func :: () -> 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 (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 func :: Channel -> IO Channel
func _ cstdin :: Channel
cstdin =
String -> IO Channel -> IO (Channel, [InvokeResult])
runInHandler ((Channel -> IO Channel) -> String
forall a. Show a => a -> String
show Channel -> IO Channel
func) (Channel -> IO Channel
func Channel
cstdin)
genericStringlikeIO :: (Show (a -> IO a), Channelizable a) =>
(Channel -> IO a)
-> (a -> IO a)
-> Environment
-> Channel
-> IO (Channel, [InvokeResult])
genericStringlikeIO :: (Channel -> IO a)
-> (a -> IO a)
-> Environment
-> Channel
-> IO (Channel, [InvokeResult])
genericStringlikeIO dechanfunc :: Channel -> IO a
dechanfunc userfunc :: a -> IO a
userfunc _ cstdin :: Channel
cstdin =
do a
contents <- Channel -> IO a
dechanfunc Channel
cstdin
String -> IO Channel -> IO (Channel, [InvokeResult])
runInHandler ((a -> IO a) -> String
forall a. Show a => a -> String
show a -> IO a
userfunc) (a -> IO Channel
realfunc a
contents)
where realfunc :: a -> IO Channel
realfunc contents :: a
contents = do a
r <- a -> IO a
userfunc a
contents
Channel -> IO Channel
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 :: (() -> IO a)
-> Environment -> Channel -> IO (Channel, [InvokeResult])
genericStringlikeO userfunc :: () -> IO a
userfunc _ _ =
String -> IO Channel -> IO (Channel, [InvokeResult])
runInHandler ((() -> IO a) -> String
forall a. Show a => a -> String
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 (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 :: ([String] -> [String]) -> String
show _ = "([String] -> [String])"
instance Show (() -> [String]) where
show :: (() -> [String]) -> String
show _ = "(() -> [String])"
instance Show ([String] -> IO [String]) where
show :: ([String] -> IO [String]) -> String
show _ = "([String] -> IO [String])"
instance Show (() -> IO [String]) where
show :: (() -> IO [String]) -> String
show _ = "(() -> IO [String])"
instance ShellCommand ([String] -> [String]) where
fdInvoke :: ([String] -> [String])
-> Environment -> Channel -> IO (Channel, [InvokeResult])
fdInvoke func :: [String] -> [String]
func = ShowS -> Environment -> Channel -> IO (Channel, [InvokeResult])
forall a.
ShellCommand a =>
a -> Environment -> Channel -> IO (Channel, [InvokeResult])
fdInvoke ([String] -> String
unlines ([String] -> String) -> (String -> [String]) -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [String]
func ([String] -> [String])
-> (String -> [String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines)
instance ShellCommand (() -> [String]) where
fdInvoke :: (() -> [String])
-> Environment -> Channel -> IO (Channel, [InvokeResult])
fdInvoke func :: () -> [String]
func = (() -> String)
-> Environment -> Channel -> IO (Channel, [InvokeResult])
forall a.
ShellCommand a =>
a -> Environment -> Channel -> IO (Channel, [InvokeResult])
fdInvoke ([String] -> String
unlines ([String] -> String) -> (() -> [String]) -> () -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> [String]
func)
instance ShellCommand ([String] -> IO [String]) where
fdInvoke :: ([String] -> IO [String])
-> Environment -> Channel -> IO (Channel, [InvokeResult])
fdInvoke func :: [String] -> IO [String]
func = (String -> IO String)
-> Environment -> Channel -> IO (Channel, [InvokeResult])
forall a.
ShellCommand a =>
a -> Environment -> Channel -> IO (Channel, [InvokeResult])
fdInvoke String -> IO String
iofunc
where iofunc :: String -> IO String
iofunc input :: String
input = do [String]
r <- [String] -> IO [String]
func (String -> [String]
lines String
input)
String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return ([String] -> String
unlines [String]
r)
instance ShellCommand (() -> IO [String]) where
fdInvoke :: (() -> IO [String])
-> Environment -> Channel -> IO (Channel, [InvokeResult])
fdInvoke func :: () -> IO [String]
func = (() -> IO String)
-> Environment -> Channel -> IO (Channel, [InvokeResult])
forall a.
ShellCommand a =>
a -> Environment -> Channel -> IO (Channel, [InvokeResult])
fdInvoke () -> IO String
iofunc
where iofunc :: (() -> IO String)
iofunc :: () -> IO String
iofunc () = do [String]
r <- () -> IO [String]
func ()
String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return ([String] -> String
unlines [String]
r)
instance ShellCommand (String, [String]) where
fdInvoke :: (String, [String])
-> Environment -> Channel -> IO (Channel, [InvokeResult])
fdInvoke (fp :: String
fp, args :: [String]
args) = CmdSpec -> Environment -> Channel -> IO (Channel, [InvokeResult])
genericCommand (String -> [String] -> CmdSpec
RawCommand String
fp [String]
args)
instance ShellCommand String where
fdInvoke :: String -> Environment -> Channel -> IO (Channel, [InvokeResult])
fdInvoke cmd :: String
cmd = CmdSpec -> Environment -> Channel -> IO (Channel, [InvokeResult])
genericCommand (String -> CmdSpec
ShellCommand String
cmd)
genericCommand :: CmdSpec
-> Environment
-> Channel
-> IO (Channel, [InvokeResult])
genericCommand :: CmdSpec -> Environment -> Channel -> IO (Channel, [InvokeResult])
genericCommand c :: CmdSpec
c environ :: Environment
environ (ChanHandle ih :: Handle
ih) =
let cp :: CreateProcess
cp = CreateProcess :: CmdSpec
-> Maybe String
-> Environment
-> StdStream
-> StdStream
-> StdStream
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Maybe GroupID
-> Maybe UserID
-> Bool
-> CreateProcess
CreateProcess {cmdspec :: CmdSpec
cmdspec = CmdSpec
c,
cwd :: Maybe String
cwd = Maybe String
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)
, 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 (_, oh' :: Maybe Handle
oh', _, ph :: 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 (m :: * -> *) a. Monad m => a -> m a
return (Handle -> Channel
ChanHandle Handle
oh, [(CmdSpec -> String
printCmdSpec CmdSpec
c, ProcessHandle -> IO ExitCode
waitForProcess ProcessHandle
ph)])
genericCommand cspec :: CmdSpec
cspec environ :: Environment
environ ichan :: Channel
ichan =
let cp :: CreateProcess
cp = CreateProcess :: CmdSpec
-> Maybe String
-> Environment
-> StdStream
-> StdStream
-> StdStream
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Maybe GroupID
-> Maybe UserID
-> Bool
-> CreateProcess
CreateProcess {cmdspec :: CmdSpec
cmdspec = CmdSpec
cspec,
cwd :: Maybe String
cwd = Maybe String
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)
, 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 (ih' :: Maybe Handle
ih', oh' :: Maybe Handle
oh', _, ph :: 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 (m :: * -> *) a. Monad m => a -> m a
return (Handle -> Channel
ChanHandle Handle
oh, [(CmdSpec -> String
printCmdSpec CmdSpec
cspec, ProcessHandle -> IO ExitCode
waitForProcess ProcessHandle
ph)])
printCmdSpec :: CmdSpec -> String
printCmdSpec :: CmdSpec -> String
printCmdSpec (ShellCommand s :: String
s) = String
s
printCmdSpec (RawCommand fp :: String
fp args :: [String]
args) = (String, [String]) -> String
forall a. Show a => a -> String
show (String
fp, [String]
args)
data PipeCommand a b = (ShellCommand a, ShellCommand b) => PipeCommand a b
deriving instance Show (PipeCommand a b)
instance (ShellCommand a, ShellCommand b) => ShellCommand (PipeCommand a b) where
fdInvoke :: PipeCommand a b
-> Environment -> Channel -> IO (Channel, [InvokeResult])
fdInvoke (PipeCommand cmd1 :: a
cmd1 cmd2 :: b
cmd2) env :: Environment
env ichan :: Channel
ichan =
do (chan1 :: Channel
chan1, res1 :: [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
(chan2 :: Channel
chan2, res2 :: [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 (m :: * -> *) a. Monad m => a -> m a
return (Channel
chan2, [InvokeResult]
res1 [InvokeResult] -> [InvokeResult] -> [InvokeResult]
forall a. [a] -> [a] -> [a]
++ [InvokeResult]
res2)
(-|-) :: (ShellCommand a, ShellCommand b) => a -> b -> PipeCommand a b
-|- :: a -> b -> PipeCommand a b
(-|-) = a -> b -> PipeCommand a b
forall a b.
(ShellCommand a, ShellCommand b) =>
a -> b -> PipeCommand a b
PipeCommand
class RunResult a where
run :: (ShellCommand b) => b -> a
instance RunResult (IO ()) where
run :: b -> IO ()
run cmd :: b
cmd = b -> IO (String, ExitCode)
forall a b. (RunResult a, ShellCommand b) => b -> a
run b
cmd IO (String, ExitCode) -> ((String, ExitCode) -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (String, ExitCode) -> IO ()
checkResults
instance RunResult (IO (String, ExitCode)) where
run :: b -> IO (String, ExitCode)
run cmd :: b
cmd =
do (ochan :: Channel
ochan, r :: [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 (String, ExitCode)
processResults [InvokeResult]
r
instance RunResult (IO ExitCode) where
run :: b -> IO ExitCode
run cmd :: b
cmd = ((b -> IO (String, ExitCode)
forall a b. (RunResult a, ShellCommand b) => b -> a
run b
cmd)::IO (String, ExitCode)) IO (String, ExitCode)
-> ((String, ExitCode) -> IO ExitCode) -> IO ExitCode
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ExitCode -> IO ExitCode
forall (m :: * -> *) a. Monad m => a -> m a
return (ExitCode -> IO ExitCode)
-> ((String, ExitCode) -> ExitCode)
-> (String, ExitCode)
-> IO ExitCode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, ExitCode) -> ExitCode
forall a b. (a, b) -> b
snd
instance RunResult (IO Int) where
run :: b -> IO Int
run cmd :: b
cmd = do ExitCode
rc <- b -> IO ExitCode
forall a b. (RunResult a, ShellCommand b) => b -> a
run b
cmd
case ExitCode
rc of
ExitSuccess -> Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return 0
ExitFailure x :: Int
x -> Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
x
instance RunResult (IO Bool) where
run :: b -> IO Bool
run cmd :: b
cmd = do Int
rc <- b -> IO Int
forall a b. (RunResult a, ShellCommand b) => b -> a
run b
cmd
Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return ((Int
rc::Int) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0)
instance RunResult (IO [String]) where
run :: b -> IO [String]
run cmd :: b
cmd = do String
r <- b -> IO String
forall a b. (RunResult a, ShellCommand b) => b -> a
run b
cmd
[String] -> IO [String]
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> [String]
lines String
r)
instance RunResult (IO String) where
run :: b -> IO String
run cmd :: b
cmd = (Channel -> IO String) -> (String -> IO Int) -> b -> IO String
forall b a c.
ShellCommand b =>
(Channel -> IO a) -> (a -> IO c) -> b -> IO a
genericStringlikeResult Channel -> IO String
chanAsString (\c :: String
c -> Int -> IO Int
forall a. a -> IO a
evaluate (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
c))
b
cmd
instance RunResult (IO BSL.ByteString) where
run :: b -> IO ByteString
run cmd :: 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
(\c :: 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 :: b -> IO ByteString
run cmd :: 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
(\c :: 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 :: b -> IO (String, IO (String, ExitCode))
run cmd :: b
cmd = (Channel -> IO String) -> b -> IO (String, IO (String, ExitCode))
forall b a.
ShellCommand b =>
(Channel -> IO a) -> b -> IO (a, IO (String, ExitCode))
intermediateStringlikeResult Channel -> IO String
chanAsString b
cmd
instance RunResult (IO (BSL.ByteString, IO (String, ExitCode))) where
run :: b -> IO (ByteString, IO (String, ExitCode))
run cmd :: b
cmd = (Channel -> IO ByteString)
-> b -> IO (ByteString, IO (String, ExitCode))
forall b a.
ShellCommand b =>
(Channel -> IO a) -> b -> IO (a, IO (String, ExitCode))
intermediateStringlikeResult Channel -> IO ByteString
chanAsBSL b
cmd
instance RunResult (IO (BS.ByteString, IO (String, ExitCode))) where
run :: b -> IO (ByteString, IO (String, ExitCode))
run cmd :: b
cmd = (Channel -> IO ByteString)
-> b -> IO (ByteString, IO (String, ExitCode))
forall b a.
ShellCommand b =>
(Channel -> IO a) -> b -> IO (a, IO (String, ExitCode))
intermediateStringlikeResult Channel -> IO ByteString
chanAsBS b
cmd
instance RunResult (IO (IO (String, ExitCode))) where
run :: b -> IO (IO (String, ExitCode))
run cmd :: b
cmd = do (ochan :: Channel
ochan, r :: [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 (String, ExitCode) -> IO (IO (String, ExitCode))
forall (m :: * -> *) a. Monad m => a -> m a
return ([InvokeResult] -> IO (String, ExitCode)
processResults [InvokeResult]
r)
intermediateStringlikeResult :: ShellCommand b =>
(Channel -> IO a)
-> b
-> IO (a, IO (String, ExitCode))
intermediateStringlikeResult :: (Channel -> IO a) -> b -> IO (a, IO (String, ExitCode))
intermediateStringlikeResult chanfunc :: Channel -> IO a
chanfunc cmd :: b
cmd =
do (ochan :: Channel
ochan, r :: [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 (String, ExitCode)) -> IO (a, IO (String, ExitCode))
forall (m :: * -> *) a. Monad m => a -> m a
return (a
c, [InvokeResult] -> IO (String, ExitCode)
processResults [InvokeResult]
r)
genericStringlikeResult :: ShellCommand b =>
(Channel -> IO a)
-> (a -> IO c)
-> b
-> IO a
genericStringlikeResult :: (Channel -> IO a) -> (a -> IO c) -> b -> IO a
genericStringlikeResult chanfunc :: Channel -> IO a
chanfunc evalfunc :: a -> IO c
evalfunc cmd :: b
cmd =
do (c :: a
c, r :: IO (String, ExitCode)
r) <- (Channel -> IO a) -> b -> IO (a, IO (String, ExitCode))
forall b a.
ShellCommand b =>
(Channel -> IO a) -> b -> IO (a, IO (String, ExitCode))
intermediateStringlikeResult Channel -> IO a
chanfunc b
cmd
a -> IO c
evalfunc a
c
IO (String, ExitCode)
r IO (String, ExitCode) -> ((String, ExitCode) -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (String, ExitCode) -> IO ()
checkResults
a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
c
processResults :: [InvokeResult] -> IO (String, ExitCode)
processResults :: [InvokeResult] -> IO (String, ExitCode)
processResults r :: [InvokeResult]
r =
do [Maybe (String, ExitCode)]
rc <- (InvokeResult -> IO (Maybe (String, ExitCode)))
-> [InvokeResult] -> IO [Maybe (String, ExitCode)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM InvokeResult -> IO (Maybe (String, ExitCode))
procresult [InvokeResult]
r
case [Maybe (String, ExitCode)] -> [(String, ExitCode)]
forall a. [Maybe a] -> [a]
catMaybes [Maybe (String, ExitCode)]
rc of
[] -> (String, ExitCode) -> IO (String, ExitCode)
forall (m :: * -> *) a. Monad m => a -> m a
return (InvokeResult -> String
forall a b. (a, b) -> a
fst ([InvokeResult] -> InvokeResult
forall a. [a] -> a
last [InvokeResult]
r), ExitCode
ExitSuccess)
x :: [(String, ExitCode)]
x -> (String, ExitCode) -> IO (String, ExitCode)
forall (m :: * -> *) a. Monad m => a -> m a
return ([(String, ExitCode)] -> (String, ExitCode)
forall a. [a] -> a
last [(String, ExitCode)]
x)
where procresult :: InvokeResult -> IO (Maybe (String, ExitCode))
procresult :: InvokeResult -> IO (Maybe (String, ExitCode))
procresult (cmd :: String
cmd, action :: IO ExitCode
action) =
do ExitCode
rc <- IO ExitCode
action
Maybe (String, ExitCode) -> IO (Maybe (String, ExitCode))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (String, ExitCode) -> IO (Maybe (String, ExitCode)))
-> Maybe (String, ExitCode) -> IO (Maybe (String, ExitCode))
forall a b. (a -> b) -> a -> b
$ case ExitCode
rc of
ExitSuccess -> Maybe (String, ExitCode)
forall a. Maybe a
Nothing
x :: ExitCode
x -> (String, ExitCode) -> Maybe (String, ExitCode)
forall a. a -> Maybe a
Just (String
cmd, ExitCode
x)
checkResults :: (String, ExitCode) -> IO ()
checkResults :: (String, ExitCode) -> IO ()
checkResults (cmd :: String
cmd, ps :: ExitCode
ps) =
case ExitCode
ps of
ExitSuccess -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
ExitFailure x :: Int
x ->
String -> IO ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
cmd String -> ShowS
forall a. [a] -> [a] -> [a]
++ ": exited with code " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
x
tryEC :: IO a -> IO (Either ExitCode a)
tryEC :: IO a -> IO (Either ExitCode a)
tryEC action :: 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 ioe :: IOError
ioe ->
if IOError -> Bool
isUserError IOError
ioe then
case (IOError -> String
ioeGetErrorString IOError
ioe String -> String -> Maybe String
forall source source1 target (m :: * -> *).
(RegexMaker Regex CompOption ExecOption source,
RegexContext Regex source1 target, MonadFail m) =>
source1 -> source -> m target
=~~ String
pat) of
Nothing -> IOError -> IO (Either ExitCode a)
forall a. IOError -> IO a
ioError IOError
ioe
Just e :: String
e -> Either ExitCode a -> IO (Either ExitCode a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either ExitCode a -> IO (Either ExitCode a))
-> (String -> Either ExitCode a)
-> String
-> 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)
-> (String -> ExitCode) -> String -> Either ExitCode a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ExitCode
procit (String -> IO (Either ExitCode a))
-> String -> IO (Either ExitCode a)
forall a b. (a -> b) -> a -> b
$ String
e
else IOError -> IO (Either ExitCode a)
forall a. IOError -> IO a
ioError IOError
ioe
Right result :: a
result -> Either ExitCode a -> IO (Either ExitCode 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 :: String
pat = ": exited with code [0-9]+$|: terminated by signal ([0-9]+)$|: stopped by signal [0-9]+"
procit :: String -> ExitCode
procit :: String -> ExitCode
procit e :: String
e
| String
e String -> String -> Bool
forall source source1 target.
(RegexMaker Regex CompOption ExecOption source,
RegexContext Regex source1 target) =>
source1 -> source -> target
=~ "^: exited" = Int -> ExitCode
ExitFailure (String -> Int
forall a source1.
(Read a, RegexContext Regex source1 String) =>
source1 -> a
str2ec String
e)
| Bool
otherwise = String -> ExitCode
forall a. HasCallStack => String -> a
error "Internal error in tryEC"
str2ec :: source1 -> a
str2ec e :: source1
e =
String -> a
forall a. Read a => String -> a
read (source1
e source1 -> ShowS
forall source source1 target.
(RegexMaker Regex CompOption ExecOption source,
RegexContext Regex source1 target) =>
source1 -> source -> target
=~ "[0-9]+$")
catchEC :: IO a -> (ExitCode -> IO a) -> IO a
catchEC :: IO a -> (ExitCode -> IO a) -> IO a
catchEC action :: IO a
action handler :: 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 ec :: ExitCode
ec -> ExitCode -> IO a
handler ExitCode
ec
Right result :: a
result -> a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
result
runIO :: (ShellCommand a) => a -> IO ()
runIO :: a -> IO ()
runIO = a -> IO ()
forall a b. (RunResult a, ShellCommand b) => b -> a
run
runSL :: (ShellCommand a) => a -> IO String
runSL :: a -> IO String
runSL cmd :: a
cmd =
do [String]
r <- a -> IO [String]
forall a b. (RunResult a, ShellCommand b) => b -> a
run a
cmd
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([String]
r [String] -> [String] -> Bool
forall a. Eq a => a -> a -> Bool
== []) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ "runSL: no output received from " String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
cmd
String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return (ShowS
rstrip ShowS -> ([String] -> String) -> [String] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
forall a. [a] -> a
head ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ [String]
r)
runInHandler :: String
-> (IO Channel)
-> IO (Channel, [InvokeResult])
runInHandler :: String -> IO Channel -> IO (Channel, [InvokeResult])
runInHandler descrip :: String
descrip func :: 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 (m :: * -> *) a. Monad m => a -> m a
return (Channel
r, [(String
descrip, ExitCode -> IO ExitCode
forall (m :: * -> *) a. Monad m => a -> m a
return ExitCode
ExitSuccess)])
exchandler :: SomeException -> IO (Channel, [InvokeResult])
exchandler :: SomeException -> IO (Channel, [InvokeResult])
exchandler e :: SomeException
e = do String -> IO ()
em (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ "runInHandler/" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
descrip String -> ShowS
forall a. [a] -> [a] -> [a]
++ ": " String -> ShowS
forall a. [a] -> [a] -> [a]
++ SomeException -> String
forall a. Show a => a -> String
show SomeException
e
(Channel, [InvokeResult]) -> IO (Channel, [InvokeResult])
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Channel
ChanString "", [(String
descrip, ExitCode -> IO ExitCode
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> ExitCode
ExitFailure 1))])
type EnvironFilter = [(String, String)] -> [(String, String)]
instance Show EnvironFilter where
show :: EnvironFilter -> String
show _ = "EnvironFilter"
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 efilter :: EnvironFilter
efilter cmd :: a
cmd) Nothing ichan :: Channel
ichan =
do
[(String, String)]
e <- IO [(String, String)]
getEnvironment
a -> Environment -> Channel -> IO (Channel, [InvokeResult])
forall a.
ShellCommand a =>
a -> Environment -> Channel -> IO (Channel, [InvokeResult])
fdInvoke a
cmd ([(String, String)] -> Environment
forall a. a -> Maybe a
Just (EnvironFilter
efilter [(String, String)]
e)) Channel
ichan
fdInvoke (EnvironCommand efilter :: EnvironFilter
efilter cmd :: a
cmd) (Just ienv :: [(String, String)]
ienv) ichan :: Channel
ichan =
a -> Environment -> Channel -> IO (Channel, [InvokeResult])
forall a.
ShellCommand a =>
a -> Environment -> Channel -> IO (Channel, [InvokeResult])
fdInvoke a
cmd ([(String, String)] -> Environment
forall a. a -> Maybe a
Just (EnvironFilter
efilter [(String, String)]
ienv)) Channel
ichan
setenv :: (ShellCommand cmd) => [(String, String)] -> cmd -> EnvironCommand cmd
setenv :: [(String, String)] -> cmd -> EnvironCommand cmd
setenv items :: [(String, String)]
items cmd :: cmd
cmd =
EnvironFilter -> cmd -> EnvironCommand cmd
forall a. ShellCommand a => EnvironFilter -> a -> EnvironCommand a
EnvironCommand EnvironFilter
efilter cmd
cmd
where efilter :: EnvironFilter
efilter ienv :: [(String, String)]
ienv = ((String, String) -> EnvironFilter)
-> [(String, String)] -> EnvironFilter
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (String, String) -> EnvironFilter
forall a b. Eq a => (a, b) -> [(a, b)] -> [(a, b)]
efilter' [(String, String)]
ienv [(String, String)]
items
efilter' :: (a, b) -> [(a, b)] -> [(a, b)]
efilter' (key :: a
key, val :: b
val) ienv :: [(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 (\(k :: a
k, _) -> a
k a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
key) [(a, b)]
ienv)
unsetenv :: (ShellCommand cmd) => [String] -> cmd -> EnvironCommand cmd
unsetenv :: [String] -> cmd -> EnvironCommand cmd
unsetenv keys :: [String]
keys cmd :: cmd
cmd =
EnvironFilter -> cmd -> EnvironCommand cmd
forall a. ShellCommand a => EnvironFilter -> a -> EnvironCommand a
EnvironCommand EnvironFilter
forall b. [(String, b)] -> [(String, b)]
efilter cmd
cmd
where efilter :: [(String, b)] -> [(String, b)]
efilter ienv :: [(String, b)]
ienv = (String -> [(String, b)] -> [(String, b)])
-> [(String, b)] -> [String] -> [(String, b)]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr String -> [(String, b)] -> [(String, b)]
forall a b. Eq a => a -> [(a, b)] -> [(a, b)]
efilter' [(String, b)]
ienv [String]
keys
efilter' :: a -> [(a, b)] -> [(a, b)]
efilter' key :: a
key = ((a, b) -> Bool) -> [(a, b)] -> [(a, b)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(k :: a
k, _) -> a
k a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
key)