{-# LANGUAGE PatternGuards, BangPatterns #-}

-- | Running system commands. On some platforms this may cause the command to be executed directly, so 
--   shell tricks won't work. The `Build` monad can be made to log commands executed with all versions
--   of `system` by setting `buildConfigLogSystem` in the `BuildConfig` passed to `runBuildPrintWithConfig`.
--
--   We define a lot of wrappers because executing system commands is the bread-and-butter of 
--   buildbots, and we usually need all the versions...

module BuildBox.Command.System 
	( module System.Exit

	-- * Wrappers
	, system
	, ssystem
	, qsystem
	, qssystem
	, ssystemOut
	, qssystemOut
	, systemTee
	, systemTeeLog
	, ssystemTee
	, systemTeeIO

	-- * The real function
	, systemTeeLogIO)
where
import BuildBox.Command.System.Internals
import BuildBox.Build
import Control.Concurrent
import System.Exit
import System.IO
import Control.Monad
import Data.ByteString.Char8		(ByteString)
import BuildBox.Data.Log		(Log)
import System.Process			hiding (system)
import qualified BuildBox.Data.Log	as Log

debug :: Bool
debug	= False

trace :: String -> IO ()
trace s	= when debug $ putStrLn s


-- Wrappers ---------------------------------------------------------------------------------------
-- | Run a system command, returning its exit code.
system :: String -> Build ExitCode
system cmd
 = do	(code, _, _)		<- systemTeeLog True cmd Log.empty
	return code


-- | Run a successful system command.
--   If the exit code is `ExitFailure` then throw an error in the `Build` monad.
ssystem :: String -> Build ()
ssystem cmd
 = do	(code, logOut, logErr)	<- systemTeeLog True cmd Log.empty

	when (code /= ExitSuccess)
	 $ throw $ ErrorSystemCmdFailed cmd code logOut logErr


-- | Quietly run a system command, returning its exit code.
qsystem :: String -> Build ExitCode
qsystem cmd
 = do	(code, _, _)		<- systemTeeLog False cmd Log.empty
	return code


-- | Quietly run a successful system command.
--   If the exit code is `ExitFailure` then throw an error in the `Build` monad.
qssystem :: String -> Build ()
qssystem cmd
 = do	(code, logOut, logErr)	<- systemTeeLog False cmd Log.empty

	when (code /= ExitSuccess)
	 $ throw $ ErrorSystemCmdFailed cmd code logOut logErr
	

-- | Run a successful system command, returning what it wrote to its @stdout@.
--   If anything was written to @stderr@ then treat that as failure. 
--   If it fails due to writing to @stderr@ or returning `ExitFailure`
--   then throw an error in the `Build` monad.
ssystemOut :: String -> Build String
ssystemOut cmd
 = do	(code, logOut, logErr)	<- systemTeeLog True cmd Log.empty
	when (code /= ExitSuccess || (not $ Log.null logErr))
	 $ throw $ ErrorSystemCmdFailed cmd code logOut logErr

	return $ Log.toString logOut

-- | Quietly run a successful system command, returning what it wrote to its @stdout@.
--   If anything was written to @stderr@ then treat that as failure. 
--   If it fails due to writing to @stderr@ or returning `ExitFailure`
--   then throw an error in the `Build` monad.
qssystemOut :: String -> Build String
qssystemOut cmd
 = do	(code, logOut, logErr)	<- systemTeeLog False cmd Log.empty
	when (code /= ExitSuccess || (not $ Log.null logErr))
	 $ throw $ ErrorSystemCmdFailed cmd code logOut logErr

	return $ Log.toString logOut



-- Tee versions -----------------------------------------------------------------------------------

-- | Like `systemTeeIO`, but in the `Build` monad.
systemTee :: Bool -> String -> String -> Build (ExitCode, String, String)
systemTee tee cmd strIn
 = do	logSystem cmd
	io $ systemTeeIO tee cmd strIn

-- | Like `systemTeeLogIO`, but in the `Build` monad.
systemTeeLog :: Bool -> String -> Log -> Build (ExitCode, Log, Log)
systemTeeLog tee cmd logIn
 = do	logSystem cmd
	io $ systemTeeLogIO tee cmd logIn


-- | Like `systemTeeIO`, but in the `Build` monad and throw an error if it returns `ExitFailure`.
ssystemTee  :: Bool -> String -> String -> Build ()
ssystemTee tee cmd strIn
 = do	logSystem cmd
	(code, logOut, logErr)	<- systemTeeLog tee cmd (Log.fromString strIn)
	when (code /= ExitSuccess)
	 $ throw $ ErrorSystemCmdFailed cmd code logOut logErr


-- | Like `systemTeeLogIO`, but with strings.
systemTeeIO :: Bool -> String -> String -> IO (ExitCode, String, String)
systemTeeIO tee cmd strIn
 = do	(code, logOut, logErr)	<- systemTeeLogIO tee cmd $ Log.fromString strIn
	return	(code, Log.toString logOut, Log.toString logErr)


-- | Run a system command, returning its `ExitCode` and what was written to @stdout@ and @stderr@.
systemTeeLogIO
	:: Bool 	-- ^ Whether @stdout@ and @stderr@ should be forwarded to the parent process.
	-> String 	-- ^ Command to run.
	-> Log		-- ^ What to pass to the command's @stdin@.
	-> IO (ExitCode, Log, Log)

systemTeeLogIO tee cmd logIn
 = do	trace $ "systemTeeIO " ++ show tee ++ ": " ++ cmd

	-- Create some new pipes for the process to write its stdout and stderr to.
	trace $ "systemTeeIO: Creating process"
	(Just hInWrite, Just hOutRead, Just hErrRead, phProc)
	 	<- createProcess 
		$  CreateProcess
			{ cmdspec	= ShellCommand cmd
			, cwd		= Nothing
			, env		= Nothing
			, std_in	= CreatePipe
			, std_out	= CreatePipe
			, std_err	= CreatePipe
			, close_fds	= False }

	-- Push input into in handle
	hPutStr hInWrite $ Log.toString logIn
			
	-- To implement the tee-like behavior we'll fork some threads that read lines from the
	-- processes stdout and stderr and write them to these channels. 
	-- 	When they hit EOF they signal this via the semaphores.
	chanOut		<- newChan
	chanErr		<- newChan
	semOut		<- newQSem 0
	semErr		<- newQSem 0

	-- Make duplicates of the above, which will store everything
	-- written to them. This gives us the copy to return from the fn.
	chanOutAcc	<- dupChan chanOut
	chanErrAcc	<- dupChan chanErr

	-- Fork threads to read from the process handles and write to our channels.
	_tidOut		<- forkIO $ streamIn hOutRead chanOut
	_tidErr		<- forkIO $ streamIn hErrRead chanErr

	-- If tee-like behavior is turned on, we forward what the process writes to
	--	its stdout and stderr to the parent.
	_tidStream	<- forkIO $ streamOuts
				[ (chanOut, if tee then Just stdout else Nothing, semOut)
				, (chanErr, if tee then Just stderr else Nothing, semErr) ]

	-- Wait for the main process to complete.
	code		<- waitForProcess phProc
	trace $ "systemTeeIO: Process done, code = " ++ show code

	trace $ "systemTeeIO: Waiting for sems"
	-- Wait for the tee processes to finish.
	--	We need to do this to avoid corrupted output on the console due to our forwarding
	--	threads writing at the same time as successing Build commands.
	mapM_ waitQSem [semOut, semErr]

	trace $ "systemTeeIO: Getting output"
	-- Get what was written to its stdout and stderr.
	--	getChanContents is a lazy read, so don't pull from the channel after
	--	seeing a Nothing else we'll block forever.
	logOut		<- slurpChan chanOutAcc Log.empty
	logErr		<- slurpChan chanErrAcc Log.empty

	trace $ "systemTeeIO stdout: " ++ Log.toString logOut
	trace $ "systemTeeIO stderr: " ++ Log.toString logErr

	trace $ "systemTeeIO: All done"
	code `seq` logOut `seq` logErr `seq` 
		return	(code, logOut, logErr)

slurpChan :: Chan (Maybe ByteString) -> Log -> IO Log
slurpChan !chan !ll
 = do	mStr	<- readChan chan
	case mStr of
	 Nothing	-> return ll
	 Just str	-> slurpChan chan (ll Log.|> str)