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