{- Running processes in the foreground, not via the concurrent-output
 - layer.
 -
 - Avoid using this in propellor properties!
 -
 - Copyright 2016 Joey Hess <id@joeyh.name>
 -
 - License: BSD-2-clause
 -}

{-# OPTIONS_GHC -fno-warn-tabs #-}

module Utility.Process.NonConcurrent where

import System.Process
import System.Exit
import System.IO
import Utility.SafeCommand
import Control.Applicative
import Prelude

boolSystemNonConcurrent :: String -> [CommandParam] -> IO Bool
boolSystemNonConcurrent :: String -> [CommandParam] -> IO Bool
boolSystemNonConcurrent String
cmd [CommandParam]
params = do
	(Maybe Handle
Nothing, Maybe Handle
Nothing, Maybe Handle
Nothing, ProcessHandle
p) <- CreateProcess
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
createProcessNonConcurrent forall a b. (a -> b) -> a -> b
$
		String -> [String] -> CreateProcess
proc String
cmd ([CommandParam] -> [String]
toCommand [CommandParam]
params)
	ExitCode -> Bool
dispatch forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProcessHandle -> IO ExitCode
waitForProcessNonConcurrent ProcessHandle
p
  where
	dispatch :: ExitCode -> Bool
dispatch ExitCode
ExitSuccess = Bool
True
	dispatch ExitCode
_ = Bool
False

createProcessNonConcurrent :: CreateProcess -> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
createProcessNonConcurrent :: CreateProcess
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
createProcessNonConcurrent = CreateProcess
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
createProcess

waitForProcessNonConcurrent  :: ProcessHandle -> IO ExitCode
waitForProcessNonConcurrent :: ProcessHandle -> IO ExitCode
waitForProcessNonConcurrent  = ProcessHandle -> IO ExitCode
waitForProcess