module BuildBox.Command.System
( module System.Exit
, system
, ssystem
, qsystem
, qssystem
, ssystemOut
, qssystemOut
, systemTee
, systemTeeLog
, ssystemTee
, systemTeeIO
, 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
system :: String -> Build ExitCode
system cmd
= do (code, _, _) <- systemTeeLog True cmd Log.empty
return code
ssystem :: String -> Build ()
ssystem cmd
= do (code, logOut, logErr) <- systemTeeLog True cmd Log.empty
when (code /= ExitSuccess)
$ throw $ ErrorSystemCmdFailed cmd code logOut logErr
qsystem :: String -> Build ExitCode
qsystem cmd
= do (code, _, _) <- systemTeeLog False cmd Log.empty
return code
qssystem :: String -> Build ()
qssystem cmd
= do (code, logOut, logErr) <- systemTeeLog False cmd Log.empty
when (code /= ExitSuccess)
$ throw $ ErrorSystemCmdFailed cmd code logOut logErr
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
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
systemTee :: Bool -> String -> String -> Build (ExitCode, String, String)
systemTee tee cmd strIn
= do logSystem cmd
io $ systemTeeIO tee cmd strIn
systemTeeLog :: Bool -> String -> Log -> Build (ExitCode, Log, Log)
systemTeeLog tee cmd logIn
= do logSystem cmd
io $ systemTeeLogIO tee cmd logIn
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
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)
systemTeeLogIO
:: Bool
-> String
-> Log
-> IO (ExitCode, Log, Log)
systemTeeLogIO tee cmd logIn
= do trace $ "systemTeeIO " ++ show tee ++ ": " ++ cmd
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 }
hPutStr hInWrite $ Log.toString logIn
chanOut <- newChan
chanErr <- newChan
semOut <- newQSem 0
semErr <- newQSem 0
chanOutAcc <- dupChan chanOut
chanErrAcc <- dupChan chanErr
_tidOut <- forkIO $ streamIn hOutRead chanOut
_tidErr <- forkIO $ streamIn hErrRead chanErr
_tidStream <- forkIO $ streamOuts
[ (chanOut, if tee then Just stdout else Nothing, semOut)
, (chanErr, if tee then Just stderr else Nothing, semErr) ]
code <- waitForProcess phProc
trace $ "systemTeeIO: Process done, code = " ++ show code
trace $ "systemTeeIO: Waiting for sems"
mapM_ waitQSem [semOut, semErr]
trace $ "systemTeeIO: Getting output"
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)