-- | This module defines the code for actually executing a command with tracing
-- enabled.
module HotelCalifornia.Exec where

import Data.List.NonEmpty (NonEmpty(..))
import qualified Data.List.NonEmpty as NEL
import Data.Maybe (fromMaybe)
import Data.Text (Text)
import qualified Data.Text as Text
import HotelCalifornia.Tracing
import HotelCalifornia.Tracing.TraceParent
import System.Environment (getEnvironment)
import Options.Applicative
import System.Exit
import System.Process.Typed

data ExecArgs = ExecArgs
    { ExecArgs -> NonEmpty String
execArgsScript :: NonEmpty String
    , ExecArgs -> Maybe Text
execArgsSpanName :: Maybe Text
    }

parseExecArgs :: Parser ExecArgs
parseExecArgs :: Parser ExecArgs
parseExecArgs = do
    Maybe Text
execArgsSpanName <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional do
        forall a. ReadM a -> Mod OptionFields a -> Parser a
option forall s. IsString s => ReadM s
str forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat
            [ forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"SPAN_NAME"
            , forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"span-name"
            , forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
's'
            , forall (f :: * -> *) a. String -> Mod f a
help String
"The name of the span that the program reports. By default, this is the script you pass in."
            ]
    String
execArgsScript1 <- forall a. ReadM a -> Mod ArgumentFields a -> Parser a
argument forall s. IsString s => ReadM s
str (forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"SCRIPT" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"The command to run, along with any arguments. Best to use -- before providing the script, otherwise it may pass arguments to `hotel` instead of to your script")
    [String]
execArgsScriptRest <- forall (f :: * -> *) a. Alternative f => f a -> f [a]
many forall a b. (a -> b) -> a -> b
$ forall a. ReadM a -> Mod ArgumentFields a -> Parser a
argument forall s. IsString s => ReadM s
str (forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"SCRIPT...")
    pure ExecArgs
        { execArgsScript :: NonEmpty String
execArgsScript = String
execArgsScript1 forall a. a -> [a] -> NonEmpty a
:| [String]
execArgsScriptRest
        , Maybe Text
execArgsSpanName :: Maybe Text
execArgsSpanName :: Maybe Text
..
        }

runExecArgs :: ExecArgs -> IO ()
runExecArgs :: ExecArgs -> IO ()
runExecArgs ExecArgs {Maybe Text
NonEmpty String
execArgsSpanName :: Maybe Text
execArgsScript :: NonEmpty String
execArgsSpanName :: ExecArgs -> Maybe Text
execArgsScript :: ExecArgs -> NonEmpty String
..} = do
    let script :: String
script =
            [String] -> String
unwords forall a b. (a -> b) -> a -> b
$ forall a. NonEmpty a -> [a]
NEL.toList NonEmpty String
execArgsScript
        spanName :: Text
spanName =
            forall a. a -> Maybe a -> a
fromMaybe (String -> Text
Text.pack String
script) Maybe Text
execArgsSpanName

    forall (m :: * -> *) a.
MonadUnliftIO m =>
Text -> (Span -> m a) -> m a
inSpan' Text
spanName \Span
span_ -> do
        [(String, String)]
newEnv <- Span -> IO [(String, String)]
spanContextToEnvironment Span
span_
        [(String, String)]
fullEnv <- forall a. Monoid a => a -> a -> a
mappend [(String, String)]
newEnv forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [(String, String)]
getEnvironment

        let processConfig :: ProcessConfig () () ()
processConfig = String -> ProcessConfig () () ()
shell forall a b. (a -> b) -> a -> b
$ [String] -> String
unwords forall a b. (a -> b) -> a -> b
$ forall a. NonEmpty a -> [a]
NEL.toList NonEmpty String
execArgsScript
        ExitCode
exitCode <- forall (m :: * -> *) stdin stdout stderr.
MonadIO m =>
ProcessConfig stdin stdout stderr -> m ExitCode
runProcess forall a b. (a -> b) -> a -> b
$ forall stdin stdout stderr.
[(String, String)]
-> ProcessConfig stdin stdout stderr
-> ProcessConfig stdin stdout stderr
setEnv [(String, String)]
fullEnv forall a b. (a -> b) -> a -> b
$ ProcessConfig () () ()
processConfig
        case ExitCode
exitCode of
            ExitCode
ExitSuccess ->
                forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
            ExitCode
_ ->
                forall a. ExitCode -> IO a
exitWith ExitCode
exitCode