{-# 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
        , systemq
        , ssystem
        , ssystemq
        , sesystem
        , sesystemq
        , systemTee
        , systemTeeLog
        , ssystemTee
        , systemTeeIO

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

debug :: Bool
debug   = False

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


-- Wrappers ---------------------------------------------------------------------------------------
-- | Run a system command,
--   returning its exit code and what it wrote to @stdout@ and @stderr@.
system :: String -> Build (ExitCode, String, String)
system cmd
 = do   (code, logOut, logErr)    <- systemTeeLog True cmd Log.empty
        return (code, Log.toString logOut, Log.toString logErr)


-- | Quietly run a system command,
--   returning its exit code and what it wrote to @stdout@ and @stderr@.
systemq :: String -> Build (ExitCode, String, String)
systemq cmd
 = do   (code, logOut, logErr)    <- systemTeeLog False cmd Log.empty
        return (code, Log.toString logOut, Log.toString logErr)



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

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

        return (Log.toString logOut, Log.toString logErr)


-- | Quietly run a successful system command,
--   returning what it wrote to @stdout@ and @stderr@.
--   If the exit code is `ExitFailure` then throw an error in the `Build` monad.
ssystemq :: String -> Build (String, String)
ssystemq cmd
 = do   (code, logOut, logErr)    <- systemTeeLog False cmd Log.empty

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

        return (Log.toString logOut, Log.toString 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.
sesystem :: String -> Build String
sesystem 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.
sesystemq :: String -> Build String
sesystemq 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   (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
                        , create_group          = False
                        , delegate_ctlc         = False
                        , detach_console        = False
                        , create_new_console    = False
                        , new_session           = False
                        , child_group           = Nothing
                        , child_user            = Nothing
                        , use_process_jobs      = True }

        -- Push input into in handle. Close the handle afterwards to ensure the
        -- process gets sent the EOF character.
        hPutStr hInWrite $ Log.toString logIn
        hClose  hInWrite

        -- 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         <- newTChanIO
        chanErr         <- newTChanIO
        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      <- atomically $ dupTChan chanOut
        chanErrAcc      <- atomically $ dupTChan 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"
        hClose hOutRead
        hClose hErrRead
        code `seq` logOut `seq` logErr `seq`
                return  (code, logOut, logErr)

slurpChan :: TChan (Maybe ByteString) -> Log -> IO Log
slurpChan !chan !ll
 = do   mBS     <- atomically $ readTChan chan
        case mBS of
         Nothing    -> return ll
         Just bs    -> slurpChan chan (ll Log.|> Text.decodeUtf8 bs)