Allow passing process_group flag (#271)

Author: samtay

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  <-

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'