diff --git a/src/Database/Postgres/Temp/Internal/Config.hs b/src/Database/Postgres/Temp/Internal/Config.hs index 5141878..e18d42c 100644 --- a/src/Database/Postgres/Temp/Internal/Config.hs +++ b/src/Database/Postgres/Temp/Internal/Config.hs @@ -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 <- diff --git a/src/Database/Postgres/Temp/Internal/Core.hs b/src/Database/Postgres/Temp/Internal/Core.hs index 1b7fdb4..30d41c3 100644 --- a/src/Database/Postgres/Temp/Internal/Core.hs +++ b/src/Database/Postgres/Temp/Internal/Core.hs @@ -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'