hs-opentelemetry-utils-exceptions 0.2.0.2 → 1.0.0.0
raw patch · 6 files changed
+159/−37 lines, 6 filesdep +hs-opentelemetry-exporter-in-memorydep +hs-opentelemetry-utils-exceptionsdep +hspecdep ~hs-opentelemetry-apidep ~hs-opentelemetry-sdkPVP ok
version bump matches the API change (PVP)
Dependencies added: hs-opentelemetry-exporter-in-memory, hs-opentelemetry-utils-exceptions, hspec
Dependency ranges changed: hs-opentelemetry-api, hs-opentelemetry-sdk
API changes (from Hackage documentation)
Files
- ChangeLog.md +4/−0
- LICENSE +1/−1
- README.md +4/−3
- hs-opentelemetry-utils-exceptions.cabal +22/−14
- src/OpenTelemetry/Utils/Exceptions.hs +21/−18
- test/Spec.hs +107/−1
ChangeLog.md view
@@ -1,5 +1,9 @@ # Changelog for exceptions +## 1.0.0.0 - 2026-05-29++- Promoted to 1.0.0.0 for the hs-opentelemetry 1.0 release.+ ## 0.2.0.2 - Relax `hs-opentelemetry-api` bounds to support 0.3.x
LICENSE view
@@ -1,4 +1,4 @@-Copyright Ian Duncan (c) 2022+Copyright Ian Duncan (c) 2022-2026 All rights reserved.
README.md view
@@ -1,6 +1,7 @@-# OpenTelemetry Utils Exceptions+# OpenTelemetry Utilities for Haskell Exceptions +[](https://hackage.haskell.org/package/hs-opentelemetry-utils-exceptions)+ This package provides utilities for using OpenTelemetry with the `exceptions` package. -See https://github.com/yesodweb/yesod/issues/1533 for discussion on some subtle issues that may-arise from using MonadMask.+See https://github.com/yesodweb/yesod/issues/1533 for discussion on some subtle issues that may arise from using `MonadMask`.
hs-opentelemetry-utils-exceptions.cabal view
@@ -1,20 +1,22 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.37.0.+-- This file has been generated from package.yaml by hpack version 0.38.3. -- -- see: https://github.com/sol/hpack -name: hs-opentelemetry-utils-exceptions-version: 0.2.0.2-description: Please see the README on GitHub at <https://github.com/iand675/hs-opentelemetry/tree/main/utils/exceptions#readme>-homepage: https://github.com/iand675/hs-opentelemetry#readme-bug-reports: https://github.com/iand675/hs-opentelemetry/issues-author: Ian Duncan, Jade Lovelace-maintainer: ian@iankduncan.com-copyright: 2024 Ian Duncan, Mercury Technologies-license: BSD3-license-file: LICENSE-build-type: Simple+name: hs-opentelemetry-utils-exceptions+version: 1.0.0.0+synopsis: Exception utilities for OpenTelemetry instrumentation+description: Please see the README on GitHub at <https://github.com/iand675/hs-opentelemetry/tree/main/utils/exceptions#readme>+category: OpenTelemetry, Telemetry, Error Handling+homepage: https://github.com/iand675/hs-opentelemetry#readme+bug-reports: https://github.com/iand675/hs-opentelemetry/issues+author: Ian Duncan, Jade Lovelace+maintainer: ian@iankduncan.com+copyright: 2024 Ian Duncan, Mercury Technologies+license: BSD3+license-file: LICENSE+build-type: Simple extra-source-files: README.md ChangeLog.md@@ -33,8 +35,8 @@ build-depends: base >=4.7 && <5 , exceptions- , hs-opentelemetry-api ==0.3.*- , hs-opentelemetry-sdk ==0.1.*+ , hs-opentelemetry-api ==1.0.*+ , hs-opentelemetry-sdk ==1.0.* , text default-language: Haskell2010 @@ -48,4 +50,10 @@ ghc-options: -threaded -rtsopts -with-rtsopts=-N build-depends: base >=4.7 && <5+ , hs-opentelemetry-api ==1.0.*+ , hs-opentelemetry-exporter-in-memory ==1.0.*+ , hs-opentelemetry-sdk ==1.0.*+ , hs-opentelemetry-utils-exceptions ==1.0.*+ , hspec+ , text default-language: Haskell2010
src/OpenTelemetry/Utils/Exceptions.hs view
@@ -2,22 +2,28 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} +{- |+Module : OpenTelemetry.Utils.Exceptions+Description : Utility for recording exceptions as span events following the OpenTelemetry semantic conventions.+Stability : experimental+-} module OpenTelemetry.Utils.Exceptions (inSpanM, inSpanM', inSpanM'') where import Control.Monad (forM_) import Control.Monad.Catch (MonadMask, SomeException) import qualified Control.Monad.Catch as MonadMask-import Control.Monad.IO.Class (MonadIO)+import Control.Monad.IO.Class (MonadIO, liftIO) import Data.Text (Text) import qualified Data.Text as T-import GHC.Exception (SrcLoc (..), getCallStack)+import GHC.Exception (getCallStack) import GHC.Stack (CallStack, callStack) import GHC.Stack.Types (HasCallStack) import OpenTelemetry.Context (insertSpan, lookupSpan, removeSpan) import OpenTelemetry.Context.ThreadLocal (adjustContext) import qualified OpenTelemetry.Context.ThreadLocal as TraceCore.SpanContext+import OpenTelemetry.SemanticsConfig (codeOption, getSemanticsOptions) import qualified OpenTelemetry.Trace as Trace-import OpenTelemetry.Trace.Core (ToAttribute (..), endSpan, recordException, setStatus, whenSpanIsRecording)+import OpenTelemetry.Trace.Core (ToAttribute (..), codeAttributes, endSpan, recordException, setStatus, whenSpanIsRecording) import qualified OpenTelemetry.Trace.Core as TraceCore @@ -47,12 +53,14 @@ -> Text -- ^ The name of the span. This may be updated later via 'updateName' -> Trace.SpanArguments- -- ^ Additional options for creating the span, such as 'SpanKind',- -- span links, starting attributes, etc.+ {- ^ Additional options for creating the span, such as 'SpanKind',+ span links, starting attributes, etc.+ -} -> m a- -- ^ The action to perform. 'inSpan' will record the time spent on the- -- action without forcing strict evaluation of the result. Any uncaught- -- exceptions will be recorded and rethrown.+ {- ^ The action to perform. 'inSpan' will record the time spent on the+ action without forcing strict evaluation of the result. Any uncaught+ exceptions will be recorded and rethrown.+ -} -> m a inSpanM t n args m = inSpanM'' t callStack n args (const m) @@ -72,8 +80,9 @@ :: (MonadMask m, HasCallStack, MonadIO m) => Trace.Tracer -> CallStack- -- ^ Record the location of the span in the codebase using the provided- -- callstack for source location info.+ {- ^ Record the location of the span in the codebase using the provided+ callstack for source location info.+ -} -> Text -- ^ The name of the span. This may be updated later via 'updateName' -> Trace.SpanArguments@@ -89,14 +98,8 @@ case getCallStack cs of [] -> pure () (fn, loc) : _ -> do- TraceCore.addAttributes- s- [ ("code.function", toAttribute $ T.pack fn)- , ("code.namespace", toAttribute $ T.pack $ srcLocModule loc)- , ("code.filepath", toAttribute $ T.pack $ srcLocFile loc)- , ("code.lineno", toAttribute $ srcLocStartLine loc)- , ("code.package", toAttribute $ T.pack $ srcLocPackage loc)- ]+ opt <- liftIO $ codeOption <$> getSemanticsOptions+ TraceCore.addAttributes s (codeAttributes opt fn loc) pure (lookupSpan ctx, s) after e (parent, s) = do
test/Spec.hs view
@@ -1,3 +1,109 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-} +module Main where++import Control.Exception (IOException, throwIO, try)+import Control.Monad (filterM)+import Data.IORef+import Data.Text (Text)+import OpenTelemetry.Attributes (Attributes, lookupAttribute)+import OpenTelemetry.Attributes.Attribute (Attribute (..), PrimitiveAttribute (..))+import OpenTelemetry.Exporter.InMemory.Span (inMemoryListExporter)+import OpenTelemetry.Trace.Core+import OpenTelemetry.Utils.Exceptions+import Test.Hspec++ main :: IO ()-main = putStrLn "Test suite not yet implemented"+main = hspec spec+++withTracer :: (Tracer -> IO a) -> IO ([ImmutableSpan], a)+withTracer action = do+ (processor, ref) <- inMemoryListExporter+ tp <- createTracerProvider [processor] emptyTracerProviderOptions+ let tracer = makeTracer tp "test-exceptions" tracerOptions+ result <- action tracer+ _ <- shutdownTracerProvider tp Nothing+ spans <- readIORef ref+ pure (spans, result)+++firstSpan :: [ImmutableSpan] -> ImmutableSpan+firstSpan (s : _) = s+firstSpan [] = error "No spans recorded"+++getSpanName :: ImmutableSpan -> IO Text+getSpanName s = hotName <$> readIORef (spanHot s)+++getSpanStatus :: ImmutableSpan -> IO SpanStatus+getSpanStatus s = hotStatus <$> readIORef (spanHot s)+++getSpanAttrs :: ImmutableSpan -> IO Attributes+getSpanAttrs s = hotAttributes <$> readIORef (spanHot s)+++spec :: Spec+spec = describe "OpenTelemetry.Utils.Exceptions" $ do+ describe "inSpanM" $ do+ it "creates a span with the given name" $ do+ (spans, _) <- withTracer $ \t ->+ inSpanM t "test-operation" defaultSpanArguments (pure ())+ name <- getSpanName (firstSpan spans)+ name `shouldBe` "test-operation"++ it "returns the action's result" $ do+ (_, result) <- withTracer $ \t ->+ inSpanM t "compute" defaultSpanArguments (pure (42 :: Int))+ result `shouldBe` 42++ it "records exception and rethrows on failure" $ do+ (spans, result) <- withTracer $ \t -> do+ r <-+ try $+ inSpanM t "failing" defaultSpanArguments $+ throwIO (userError "boom")+ pure (r :: Either IOException ())+ case result of+ Left _ -> pure ()+ Right _ -> expectationFailure "expected exception"+ let s = firstSpan spans+ status <- getSpanStatus s+ status `shouldBe` Error "user error (boom)"++ it "sets code.function attribute from callstack" $ do+ (spans, _) <- withTracer $ \t ->+ inSpanM t "traced" defaultSpanArguments (pure ())+ let s = firstSpan spans+ attrs <- getSpanAttrs s+ lookupAttribute attrs "code.function"+ `shouldSatisfy` (/= Nothing)++ describe "inSpanM'" $ do+ it "provides the span to the callback" $ do+ spanRef <- newIORef (Nothing :: Maybe Span)+ (spans, _) <- withTracer $ \t ->+ inSpanM' t "with-span" defaultSpanArguments $ \s -> do+ writeIORef spanRef (Just s)+ addAttribute s ("custom.attr" :: Text) ("hello" :: Text)+ let s = firstSpan spans+ attrs <- getSpanAttrs s+ lookupAttribute attrs "custom.attr"+ `shouldBe` Just (AttributeValue (TextAttribute "hello"))++ describe "inSpanM''" $ do+ it "restores parent context after span ends" $ do+ (spans, _) <- withTracer $ \t -> do+ inSpanM t "outer" defaultSpanArguments $ do+ inSpanM t "inner" defaultSpanArguments (pure ())+ length spans `shouldSatisfy` (>= 2)+ innerSpans <- filterM (\s -> (== "inner") <$> getSpanName s) spans+ case innerSpans of+ [] -> expectationFailure "no span named 'inner'"+ (inner : _) -> case spanParent inner of+ Nothing -> expectationFailure "expected inner span to have a parent"+ Just _ -> pure ()