hotel-california 0.0.3.0 → 0.0.4.0

raw patch · 4 files changed

+94/−10 lines, 4 filesdep +unordered-containersPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: unordered-containers

API changes (from Hackage documentation)

Files

• CHANGELOG.md +12/−0
• README.md +6/−0
• hotel-california.cabal +5/−2
• src/HotelCalifornia/Exec.hs +71/−8

@@ -6,6 +6,18 @@ and this project adheres to the [Haskell Package Versioning Policy](https://pvp.haskell.org/). +## Unreleased++## 0.0.4.0 - 2024-01-26++- [#14](https://github.com/parsonsmatt/hotel-california/pull/14/)+    - Add the `--set-sigint-status` to control how `Ctrl-C` and `SIGINT` are+      reported.+- [#16](https://github.com/parsonsmatt/hotel-california/pull/16)+    - You can now provide attributes for the span that `hotel-california`+      creates by passing the CLI argument `--attribute KEY=VALUE`. Only string+      attributes are currently supported.+ ## 0.0.3.0 - 2023-09-18  - [#13](https://github.com/parsonsmatt/hotel-california/pull/13)

@@ -11,6 +11,8 @@ ```sh $ hotel exec --help Usage: hotel exec [-s|--span-name SPAN_NAME]+                  [-i|--set-sigint-status SPAN_STATUS]+                  [-a|--attribute KEY=VALUE]...                   (COMMAND [ARGUMENT]... | --shell SCRIPT)    Execute the given command with tracing enabled@@ -19,6 +21,10 @@   -h,--help                Show this help text   -s,--span-name SPAN_NAME The name of the span that the program reports. By                            default, this is the script you pass in.+  -i,--set-sigint-status SPAN_STATUS+                           The status reported when the process is killed with+                           SIGINT.+  -a,--attribute KEY=VALUE A string attribute to add to the span.   --shell SCRIPT           Run an arbitrary shell script instead of running an                            executable command ```

@@ -1,11 +1,11 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.35.2.+-- This file has been generated from package.yaml by hpack version 0.35.4. -- -- see: https://github.com/sol/hpack  name:           hotel-california-version:        0.0.3.0+version:        0.0.4.0 description:    Please see the README on GitHub at <https://github.com/parsonsmatt/hotel-california#readme> homepage:       https://github.com/parsonsmatt/hotel-california#readme bug-reports:    https://github.com/parsonsmatt/hotel-california/issues@@ -87,6 +87,7 @@     , time     , typed-process     , unliftio+    , unordered-containers   default-language: Haskell2010  executable hotel@@ -150,6 +151,7 @@     , time     , typed-process     , unliftio+    , unordered-containers   default-language: Haskell2010  test-suite hotel-california-test@@ -214,4 +216,5 @@     , time     , typed-process     , unliftio+    , unordered-containers   default-language: Haskell2010

@@ -2,17 +2,23 @@ -- enabled. module HotelCalifornia.Exec where +import qualified Control.Exception as Exception+import qualified Data.Char as Char import Data.List.NonEmpty (NonEmpty(..)) import qualified Data.List.NonEmpty as NEL import Data.Maybe (fromMaybe)-import Data.Text (Text)+import Data.HashMap.Strict (HashMap)+import qualified Data.HashMap.Strict as HashMap import qualified Data.Text as Text+import Data.Text (Text) import HotelCalifornia.Tracing import HotelCalifornia.Tracing.TraceParent-import System.Environment (getEnvironment)-import qualified System.Posix.Escape.Unicode as Escape+import qualified OpenTelemetry.Trace.Core as Otel+import OpenTelemetry.Trace (Attribute(..), PrimitiveAttribute(..)) import Options.Applicative hiding (command)+import System.Environment (getEnvironment) import System.Exit+import qualified System.Posix.Escape.Unicode as Escape import System.Process.Typed  data Subprocess = Proc (NonEmpty String) | Shell String@@ -28,8 +34,24 @@ data ExecArgs = ExecArgs     { execArgsSubprocess :: Subprocess     , execArgsSpanName :: Maybe Text+    , execArgsSigintStatus :: SpanStatus'+    , execArgsAttributes :: HashMap Text Attribute     } +-- | A variant of 'SpanStatus' that does not include a 'Text' for error.+data SpanStatus'+    = SpanUnset+    | SpanOk+    | SpanError++parseSpanStatus' :: ReadM SpanStatus'+parseSpanStatus' = eitherReader \s ->+    case map Char.toLower s of+        "unset" -> Right SpanUnset+        "ok" -> Right SpanOk+        "error" -> Right SpanError+        _ -> Left $ mconcat ["Expected one of `unset`, `ok`, or `error` for SPAN_STATUS. Got: ", s]+ parseProc :: Parser (NonEmpty String) parseProc = do     command <- argument str (metavar "COMMAND")@@ -47,6 +69,14 @@ parseSubprocess :: Parser Subprocess parseSubprocess = fmap Proc parseProc <|> fmap Shell parseShell +-- | Parse a `key=value` string into an attribute.+parseAttribute :: String -> Either String (Text, Attribute)+parseAttribute input = do+    let (key, value') = Text.breakOn "=" $ Text.pack input+    if Text.null value' || Text.null key+    then Left $ "Attributes must contain a non-empty key and value separated by `=`: " <> input+    else pure $ (key, AttributeValue $ TextAttribute $ Text.drop 1 value')+ parseExecArgs :: Parser ExecArgs parseExecArgs = do     execArgsSpanName <- optional do@@ -56,6 +86,21 @@             , short 's'             , help "The name of the span that the program reports. By default, this is the script you pass in."             ]+    execArgsSigintStatus <-+        option parseSpanStatus' $ mconcat+            [ metavar "SPAN_STATUS"+            , long "set-sigint-status"+            , short 'i'+            , help "The status reported when the process is killed with SIGINT."+            , value SpanUnset+            ]+    execArgsAttributes <-+        HashMap.fromList <$> (many $ option (eitherReader parseAttribute) $ mconcat+            [ metavar "KEY=VALUE"+            , long "attribute"+            , short 'a'+            , help "A string attribute to add to the span."+            ])     execArgsSubprocess <- parseSubprocess     pure ExecArgs{..} @@ -64,16 +109,34 @@     let script = commandToString execArgsSubprocess         spanName =             fromMaybe (Text.pack script) execArgsSpanName+        spanArguments = defaultSpanArguments { Otel.attributes = execArgsAttributes } -    inSpan' spanName \span_ -> do+    inSpanWith' spanName spanArguments \span_ -> do         newEnv <- spanContextToEnvironment span_         fullEnv <- mappend newEnv <$> getEnvironment          let processConfig = commandToProcessConfig execArgsSubprocess -        exitCode <- runProcess $ setEnv fullEnv processConfig-        case exitCode of-            ExitSuccess ->+        let handleSigInt =+                \case+                    Exception.UserInterrupt ->+                        case execArgsSigintStatus of+                            SpanUnset ->+                                pure Nothing+                            SpanOk -> do+                                Otel.setStatus span_ Otel.Ok+                                pure Nothing+                            SpanError -> do+                                Exception.throwIO Exception.UserInterrupt+                    other ->+                        Exception.throwIO other++        mexitCode <- Exception.handle handleSigInt $ fmap Just $ runProcess $ setEnv fullEnv processConfig++        case mexitCode of+            Just ExitSuccess ->                 pure ()-            _ ->+            Just exitCode ->                 exitWith exitCode+            Nothing ->+                pure ()