module BB8.Jobs where

import           Control.Concurrent (ThreadId, forkIO, killThread)
import qualified Control.Concurrent.STM as STM
import           Control.Exception (SomeException, catch)
import           Control.Monad (forever)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Builder as BS
import qualified Data.ByteString.Lazy as BSL
import qualified Data.Foldable as F
import           Data.Monoid ((<>))
import qualified Data.Sequence as Seq
import qualified Data.Time.Clock as Time
import qualified GHC.IO.Handle as Sys
import qualified System.Exit as Sys
import qualified System.Process as Sys

import BB8.Types
import BB8.Common

type Trace = STM.TVar (Seq.Seq OutputLine)
type Lock = STM.TMVar ()

buildTraceOutput :: Seq.Seq OutputLine -> BSL.ByteString
buildTraceOutput = BS.toLazyByteString . F.foldMap go
  where go (OutputLine time src text) =
          let srcBS = case src of
                        SourceStdout -> "\x1estdout\x1e"
                        SourceStderr -> "\x1estderr\x1e"
          in BS.stringUtf8 (show time) <> srcBS <> BS.byteString text <> "\n"


-- | The result of a job is a trace of (timestamped) output lines as
-- well as the resulting exit code, which is 0 on success and nonzero
-- on failure
data JobResult = JobResult
  { resultTrace :: Seq.Seq OutputLine
  , resultCode  :: Int
  } deriving (Eq, Show, Read)


-- | Create a new thread which specifies the given source, reads from
-- the provided handle, and adds an explanatory line to the end of the
-- sequence contained in the provided TVar. On any error, it will
-- clean itself up and exit.
forkOutputThread ::
  Lock ->
  LineSource ->
  Sys.Handle ->
  Trace ->
  IO ThreadId
forkOutputThread lock src handle var = do
  () <- STM.atomically $ STM.takeTMVar lock
  let handler (exn :: SomeException) = do
        debugShow (src, exn)
        STM.atomically $ STM.putTMVar lock ()
  forkIO $ flip catch handler $ forever $ do
    line <- BS.hGetLine handle
    now <- Time.getCurrentTime
    STM.atomically $ do
      STM.modifyTVar var (Seq.|> OutputLine now src line)


-- | Run a command with an optional working path, returning the
-- resulting information about the command once it's done.
runTraceCommand :: String -> [String] -> Maybe FilePath -> IO JobResult
runTraceCommand cmd args cwd = do
  var <- STM.atomically (STM.newTVar Seq.empty)
  traceCommand cmd args cwd var


-- | Run a command with an optional working path, storing the
-- intermediate output in the provided 'TMVar', and returning the
-- resulting information about the command once it's done.
traceCommand ::
  String ->
  [String] ->
  Maybe FilePath ->
  Trace ->
  IO JobResult
traceCommand cmd args cwd var = do
  let dockerProcess = (Sys.proc cmd args)
        { Sys.std_out = Sys.CreatePipe
        , Sys.std_err = Sys.CreatePipe
        , Sys.cwd     = cwd
        }
  (_, Just stdout, Just stderr, handle) <- Sys.createProcess dockerProcess

  STM.atomically $ STM.writeTVar var mempty

  stdoutLock <- STM.atomically $ STM.newTMVar ()
  _ <- forkOutputThread stdoutLock SourceStdout stdout var
  stderrLock <- STM.atomically $ STM.newTMVar ()
  _ <- forkOutputThread stderrLock SourceStderr stderr var

  exitCode <- Sys.waitForProcess handle

  () <- STM.atomically $ STM.takeTMVar stdoutLock
  () <- STM.atomically $ STM.takeTMVar stderrLock

  trace <- STM.atomically $ STM.readTVar var

  return JobResult
    { resultTrace = trace
    , resultCode  = case exitCode of
        Sys.ExitSuccess   -> 0
        Sys.ExitFailure n -> n
    }