{-# 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 = (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 :: (String -> String)
-> Environment -> Channel -> IO (Channel, [InvokeResult])
fdInvoke String -> 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 :: String -> IO String
iofunc = String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> IO String) -> (String -> String) -> String -> IO String
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 =
(() -> 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 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 () -> 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 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 () -> 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 Channel -> IO Channel
func Environment
_ 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 :: 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 ((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 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 :: 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 ((() -> 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]
_ = 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 = (String -> String)
-> Environment -> Channel -> IO (Channel, [InvokeResult])
forall a.
ShellCommand a =>
a -> Environment -> Channel -> IO (Channel, [InvokeResult])
fdInvoke ([String] -> String
unlines ([String] -> String) -> (String -> [String]) -> String -> String
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 () -> [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 [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 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 () -> 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 (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
-> 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 (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 (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
-> 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 (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 (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) = (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 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 (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
-|- :: 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
class RunResult a where
run :: (ShellCommand b) => b -> a
instance RunResult (IO ()) where
run :: forall b. ShellCommand b => b -> IO ()
run 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 :: forall b. ShellCommand b => b -> IO (String, 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 (String, ExitCode)
processResults [InvokeResult]
r
instance RunResult (IO ExitCode) where
run :: forall b. ShellCommand b => b -> IO ExitCode
run 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 :: 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
run b
cmd
case ExitCode
rc of
ExitCode
ExitSuccess -> Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
0
ExitFailure Int
x -> Int -> IO Int
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
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
== Int
0)
instance RunResult (IO [String]) where
run :: forall b. ShellCommand b => b -> IO [String]
run 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 :: forall b. ShellCommand b => b -> IO String
run 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 (\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 :: 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 (String, IO (String, ExitCode))
run 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 :: forall b.
ShellCommand b =>
b -> IO (ByteString, IO (String, ExitCode))
run 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 :: forall b.
ShellCommand b =>
b -> IO (ByteString, IO (String, ExitCode))
run 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 :: forall b. ShellCommand b => b -> IO (IO (String, 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 (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 :: 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) <- 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 :: 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) <- (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 [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)
[(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 (String
cmd, 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
ExitCode
ExitSuccess -> Maybe (String, ExitCode)
forall a. Maybe a
Nothing
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 (String
cmd, ExitCode
ps) =
case ExitCode
ps of
ExitCode
ExitSuccess -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
ExitFailure 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 -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": exited with code " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
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 <- 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 -> 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
Maybe String
Nothing -> IOError -> IO (Either ExitCode a)
forall a. IOError -> IO a
ioError IOError
ioe
Just 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 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 = 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 String -> String -> Bool
forall source source1 target.
(RegexMaker Regex CompOption ExecOption source,
RegexContext Regex source1 target) =>
source1 -> source -> target
=~ String
"^: 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 String
"Internal error in tryEC"
str2ec :: source1 -> a
str2ec source1
e =
String -> a
forall a. Read a => String -> a
read (source1
e source1 -> String -> String
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 <- 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 (m :: * -> *) a. Monad m => a -> m a
return a
result
runIO :: (ShellCommand a) => a -> IO ()
runIO :: forall b. ShellCommand b => b -> IO ()
runIO = a -> IO ()
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 <- 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
$ String
"runSL: no output received from " String -> String -> String
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 (String -> String
rstrip (String -> String) -> ([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 String
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 (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 SomeException
e = do String -> IO ()
em (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"runInHandler/" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
descrip String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": " String -> String -> String
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
"", [(String
descrip, ExitCode -> IO ExitCode
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
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 EnvironFilter
efilter a
cmd) (Just [(String, String)]
ienv) 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 :: forall cmd.
ShellCommand cmd =>
[(String, String)] -> cmd -> EnvironCommand cmd
setenv [(String, String)]
items cmd
cmd =
EnvironFilter -> cmd -> EnvironCommand cmd
forall a. ShellCommand a => EnvironFilter -> a -> EnvironCommand a
EnvironCommand EnvironFilter
efilter cmd
cmd
where efilter :: EnvironFilter
efilter [(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' (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)
unsetenv :: (ShellCommand cmd) => [String] -> cmd -> EnvironCommand cmd
unsetenv :: forall cmd.
ShellCommand cmd =>
[String] -> cmd -> EnvironCommand cmd
unsetenv [String]
keys 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 [(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' 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)