Allow passing process_group flag (#271)

This commit is contained in:
Sam Tay 2020-11-30 13:28:57 -05:00 committed by GitHub
parent f99252ea71
commit 593e3ebcb7
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
2 changed files with 19 additions and 5 deletions

View File

@ -212,6 +212,9 @@ data ProcessConfig = ProcessConfig
-- ^ A monoid for configuring the standard output 'Handle'.
, stdErr :: Last Handle
-- ^ A monoid for configuring the standard error 'Handle'.
, createGroup :: Any
-- ^ A monoid for combining boolean create process group flag.
-- The first 'True' value wins.
}
deriving stock (Generic, Eq, Show)
deriving Semigroup via GenericSemigroup ProcessConfig
@ -235,6 +238,9 @@ instance Pretty ProcessConfig where
<> hardline
<> text "stdErr:" <+>
pretty (prettyHandle <$> getLast stdErr)
<> hardline
<> text "createGroup:" <+>
pretty (getAny createGroup)
-- | The 'standardProcessConfig' sets the handles to 'stdin', 'stdout' and
@ -291,6 +297,7 @@ completeProcessConfig
:: [(String, String)] -> ProcessConfig -> Either [String] CompleteProcessConfig
completeProcessConfig envs ProcessConfig {..} = runErrors $ do
let completeProcessConfigCmdLine = completeCommandLineArgs commandLine
completeProcessConfigCreateGroup = getAny createGroup
completeProcessConfigEnvVars <- eitherToErrors $
completeEnvironmentVariables envs environmentVariables
completeProcessConfigStdIn <-

View File

@ -138,16 +138,18 @@ teeHandle orig f =
-- | 'CompleteProcessConfig' contains the configuration necessary for starting a
-- process. It is essentially a stripped down 'System.Process.CreateProcess'.
data CompleteProcessConfig = CompleteProcessConfig
{ completeProcessConfigEnvVars :: [(String, String)]
{ completeProcessConfigEnvVars :: [(String, String)]
-- ^ Environment variables
, completeProcessConfigCmdLine :: [String]
, completeProcessConfigCmdLine :: [String]
-- ^ Command line arguements
, completeProcessConfigStdIn :: Handle
, completeProcessConfigStdIn :: Handle
-- ^ The 'Handle' for standard input
, completeProcessConfigStdOut :: Handle
, completeProcessConfigStdOut :: Handle
-- ^ The 'Handle' for standard output
, completeProcessConfigStdErr :: Handle
, completeProcessConfigStdErr :: Handle
-- ^ The 'Handle' for standard error
, completeProcessConfigCreateGroup :: Bool
-- ^ Whether or not to create new process group
}
prettyHandle :: Handle -> Doc
@ -174,6 +176,10 @@ instance Pretty CompleteProcessConfig where
<> hardline
<> text "completeProcessConfigStdErr:"
<+> prettyHandle completeProcessConfigStdErr
<> hardline
<> text "completeProcessConfigCreateGroup:"
<> softline
<> pretty completeProcessConfigCreateGroup
-- | Start a process interactively and return the 'ProcessHandle'
startProcess
@ -188,6 +194,7 @@ startProcess name CompleteProcessConfig {..} = (\(_, _, _, x) -> x) <$>
, std_out = UseHandle completeProcessConfigStdOut
, std_in = UseHandle completeProcessConfigStdIn
, env = Just completeProcessConfigEnvVars
, create_group = completeProcessConfigCreateGroup
}
-- | Stop a 'ProcessHandle'. An alias for 'waitForProcess'