hotel-california 0.0.4.0 → 0.0.5.0

raw patch · 4 files changed

+147/−12 lines, 4 filesdep +directorydep +filepathPVP ok

version bump matches the API change (PVP)

Dependencies added: directory, filepath

API changes (from Hackage documentation)

Files

• CHANGELOG.md +8/−0
• hotel-california.cabal +9/−2
• src/HotelCalifornia/Exec.hs +49/−10
• src/HotelCalifornia/Which.hs +81/−0

@@ -8,6 +8,14 @@  ## Unreleased +## 0.0.5.0 - 2024-02-29++- [#19](https://github.com/parsonsmatt/hotel-california/pull/19/)+    - Record the command's exit status (`process.exit_status`) and command+      attributes.+    - This replaces the default `process.executable.name` and related attributes+      set by `hs-opentelemetry`.+ ## 0.0.4.0 - 2024-01-26  - [#14](https://github.com/parsonsmatt/hotel-california/pull/14/)

@@ -1,11 +1,11 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.35.4.+-- This file has been generated from package.yaml by hpack version 0.35.2. -- -- see: https://github.com/sol/hpack  name:           hotel-california-version:        0.0.4.0+version:        0.0.5.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@@ -31,6 +31,7 @@       HotelCalifornia.Tracing.TraceParent   other-modules:       Paths_hotel_california+      HotelCalifornia.Which   hs-source-dirs:       src   default-extensions:@@ -74,6 +75,8 @@   build-depends:       base >=4.7 && <5     , bytestring+    , directory+    , filepath     , hs-opentelemetry-api >=0.1.0.0     , hs-opentelemetry-exporter-otlp     , hs-opentelemetry-propagator-w3c@@ -137,6 +140,8 @@   build-depends:       base >=4.7 && <5     , bytestring+    , directory+    , filepath     , hotel-california     , hs-opentelemetry-api >=0.1.0.0     , hs-opentelemetry-exporter-otlp@@ -202,6 +207,8 @@   build-depends:       base >=4.7 && <5     , bytestring+    , directory+    , filepath     , hotel-california     , hs-opentelemetry-api >=0.1.0.0     , hs-opentelemetry-exporter-otlp

@@ -20,6 +20,7 @@ import System.Exit import qualified System.Posix.Escape.Unicode as Escape import System.Process.Typed+import HotelCalifornia.Which (which)  data Subprocess = Proc (NonEmpty String) | Shell String @@ -95,7 +96,7 @@             , value SpanUnset             ]     execArgsAttributes <--        HashMap.fromList <$> (many $ option (eitherReader parseAttribute) $ mconcat+        HashMap.fromList <$> many (option (eitherReader parseAttribute) $ mconcat             [ metavar "KEY=VALUE"             , long "attribute"             , short 'a'@@ -104,29 +105,51 @@     execArgsSubprocess <- parseSubprocess     pure ExecArgs{..} +makeInitialAttributes :: Subprocess -> HashMap Text Attribute -> IO (HashMap Text Attribute)+makeInitialAttributes subprocess extraAttributes = do+    processAttributes <-+        case subprocess of+          Proc (command :| args) -> do+              pathAttribute <-+                  (foldMap (\path -> [(executablePathName, Otel.toAttribute $ Text.pack path)]))+                  <$> which command+              pure $ HashMap.fromList $+                [ (commandArgsName, Otel.toAttribute $ map Text.pack args)+                , (executableName, Otel.toAttribute $ Text.pack command)+                ] <> pathAttribute+          Shell _command -> pure mempty++    pure $ processAttributes <> extraAttributes+ runExecArgs :: ExecArgs -> IO () runExecArgs ExecArgs {..} = do+    initialAttributes <- makeInitialAttributes execArgsSubprocess execArgsAttributes+     let script = commandToString execArgsSubprocess         spanName =             fromMaybe (Text.pack script) execArgsSpanName-        spanArguments = defaultSpanArguments { Otel.attributes = execArgsAttributes }+        spanArguments = defaultSpanArguments { Otel.attributes = initialAttributes } -    inSpanWith' spanName spanArguments \span_ -> do-        newEnv <- spanContextToEnvironment span_+    inSpanWith' spanName spanArguments \span' -> do+        newEnv <- spanContextToEnvironment span'         fullEnv <- mappend newEnv <$> getEnvironment          let processConfig = commandToProcessConfig execArgsSubprocess          let handleSigInt =                 \case-                    Exception.UserInterrupt ->+                    Exception.UserInterrupt -> do+                        Otel.addAttribute span' exitStatusName (-2 :: Int) -- SIGINT                         case execArgsSigintStatus of                             SpanUnset ->                                 pure Nothing                             SpanOk -> do-                                Otel.setStatus span_ Otel.Ok+                                Otel.setStatus span' Otel.Ok                                 pure Nothing                             SpanError -> do+                                -- `hs-opentelemetry` will automatically mark a+                                -- span as an error if it ends with an+                                -- exception.                                 Exception.throwIO Exception.UserInterrupt                     other ->                         Exception.throwIO other@@ -134,9 +157,25 @@         mexitCode <- Exception.handle handleSigInt $ fmap Just $ runProcess $ setEnv fullEnv processConfig          case mexitCode of-            Just ExitSuccess ->-                pure ()-            Just exitCode ->-                exitWith exitCode+            Just exitCode -> do+                Otel.addAttribute span' exitStatusName+                    case exitCode of+                       ExitSuccess -> 0+                       ExitFailure status -> status+                case exitCode of+                    ExitSuccess -> pure ()+                    ExitFailure _ -> exitWith exitCode             Nothing ->                 pure ()++exitStatusName :: Text+exitStatusName = "process.exit_status"++executablePathName :: Text+executablePathName = "process.executable.path"++executableName :: Text+executableName = "process.executable.path"++commandArgsName :: Text+commandArgsName = "process.command_args"

@@ -0,0 +1,81 @@+-- | Like @which(1)@ but portable.+--+-- Modified from @shelly@.+module HotelCalifornia.Which (which) where++import Data.Text qualified as Text+import System.FilePath (splitDirectories, (</>), isAbsolute, searchPathSeparator)+import System.Directory (doesFileExist, getPermissions, getPermissions, executable)+import System.Environment (getEnv)+import Control.Exception (catch)+import Data.Maybe (isJust)++-- | Get a full path to an executable by looking at the @PATH@ environement+-- variable. Windows normally looks in additional places besides the+-- @PATH@: this does not duplicate that behavior.+which :: FilePath -> IO (Maybe FilePath)+which path =+  if isAbsolute path || startsWithDot splitOnDirs+  then checkFile+  else lookupPath+  where+    splitOnDirs = splitDirectories path++    -- 'startsWithDot' receives as input the result of 'splitDirectories',+    -- which will include the dot (\".\") as its first element only if this+    -- is a path of the form \"./foo/bar/baz.sh\". Check for example:+    --+    -- > import System.FilePath as FP+    -- > FP.splitDirectories "./test/data/hello.sh"+    -- [".","test","data","hello.sh"]+    -- > FP.splitDirectories ".hello.sh"+    -- [".hello.sh"]+    -- > FP.splitDirectories ".test/hello.sh"+    -- [".test","hello.sh"]+    -- > FP.splitDirectories ".foo"+    -- [".foo"]+    --+    -- Note that earlier versions of Shelly used+    -- \"system-filepath\" which also has a 'splitDirectories'+    -- function, but it returns \"./\" as its first argument,+    -- so we pattern match on both for backward-compatibility.+    startsWithDot (".":_)  = True+    startsWithDot _ = False++    checkFile :: IO (Maybe FilePath)+    checkFile = do+        exists <- doesFileExist path+        pure $+            if exists+            then Just path+            else Nothing++    lookupPath :: IO (Maybe FilePath)+    lookupPath = (pathDirs >>=) $ findMapM $ \dir -> do+        let fullPath = dir </> path+        isExecutable' <- isExecutable fullPath+        pure $+            if isExecutable'+            then Just fullPath+            else Nothing++    pathDirs =+        (map Text.unpack+          . filter (not . Text.null)+          . Text.split (== searchPathSeparator)+          . Text.pack)+         `fmap` getEnv "PATH"+++isExecutable :: FilePath -> IO Bool+isExecutable f = (executable `fmap` getPermissions f) `catch` (\(_ :: IOError) -> return False)+++-- | A monadic @findMap@, taken from the @MissingM@ package+findMapM :: Monad m => (a -> m (Maybe b)) -> [a] -> m (Maybe b)+findMapM _ [] = return Nothing+findMapM f (x:xs) = do+    mb <- f x+    if (isJust mb)+      then return mb+      else findMapM f xs