hs-opentelemetry-instrumentation-tasty 0.1 → 1.0.0.0
raw patch · 6 files changed
+76/−30 lines, 6 filesdep +hs-opentelemetry-semantic-conventionsdep ~hs-opentelemetry-apidep ~hs-opentelemetry-instrumentation-tastydep ~hs-opentelemetry-sdknew-uploaderPVP ok
version bump matches the API change (PVP)
Dependencies added: hs-opentelemetry-semantic-conventions
Dependency ranges changed: hs-opentelemetry-api, hs-opentelemetry-instrumentation-tasty, hs-opentelemetry-sdk
API changes (from Hackage documentation)
Files
- ChangeLog.md +13/−1
- LICENSE +1/−1
- README.md +6/−3
- hs-opentelemetry-instrumentation-tasty.cabal +9/−5
- src/OpenTelemetry/Instrumentation/Tasty.hs +26/−4
- tests/OpenTelemetry/Instrumentation/Tasty/Tests.hs +21/−16
ChangeLog.md view
@@ -1,5 +1,17 @@ # Changelog for hs-opentelemetry-instrumentation-tasty -## 0.0.1.0+## Unreleased++## 1.0.0.0 - 2026-05-29++- Update to `hs-opentelemetry-api` 0.4.+- Internal: `result.description` attribute key is now a typed `AttributeKey` constant.+ Attribute name is unchanged.++## 0.1.0.1++- Relax `hs-opentelemetry-api` bounds to support 0.3.x++## 0.1.0.0 - Initial release
LICENSE view
@@ -1,4 +1,4 @@-Copyright Ian Duncan (c) 2021+Copyright Ian Duncan (c) 2021-2026 All rights reserved.
README.md view
@@ -1,13 +1,16 @@ # hs-opentelemetry-instrumentation-tasty -OpenTelemetry instrumentation library for Tasty.-It creates spans for:+[](https://hackage.haskell.org/package/hs-opentelemetry-instrumentation-tasty) +OpenTelemetry instrumentation for the [Tasty] test framework; it creates the following spans inside the instrumented `TestTree`:+ 1. Individual test cases 2. Test groups 3. Resource setup and teardown -The library should be robust to tests running in parallel.+As Tasty executes all tests in parallel, this instrumentation should be robust in the presence of parallel execution.++[Tasty]: https://hackage.haskell.org/package/tasty ## Usage
hs-opentelemetry-instrumentation-tasty.cabal view
@@ -1,6 +1,8 @@ cabal-version: 2.0 name: hs-opentelemetry-instrumentation-tasty-version: 0.1+version: 1.0.0.0+synopsis: OpenTelemetry instrumentation for the Tasty test framework+category: OpenTelemetry, Testing description: Please see the README on GitHub at <https://github.com/iand675/hs-opentelemetry/tree/main/instrumentation/tasty#readme> homepage: https://github.com/iand675/hs-opentelemetry#readme@@ -13,6 +15,7 @@ build-type: Simple extra-source-files: README.md+extra-doc-files: ChangeLog.md source-repository head@@ -23,7 +26,8 @@ default-language: Haskell2010 build-depends: base >=4.7 && <5- , hs-opentelemetry-api ^>=0.2+ , hs-opentelemetry-api ^>= 1.0+ , hs-opentelemetry-semantic-conventions >= 1.40 && < 2 , tagged ^>= 0.8 , tasty ^>= 1.5 , text@@ -39,9 +43,9 @@ async , base , containers- , hs-opentelemetry-api- , hs-opentelemetry-instrumentation-tasty- , hs-opentelemetry-sdk+ , hs-opentelemetry-api ^>= 1.0+ , hs-opentelemetry-instrumentation-tasty ^>= 1.0+ , hs-opentelemetry-sdk ^>= 1.0 , tasty , tasty-hunit , text
src/OpenTelemetry/Instrumentation/Tasty.hs view
@@ -6,20 +6,34 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TemplateHaskell #-} +{- |+Module : OpenTelemetry.Instrumentation.Tasty+Description : OpenTelemetry instrumentation for the Tasty test framework.+Stability : experimental++Wraps test trees to emit spans for each test.+-} module OpenTelemetry.Instrumentation.Tasty (instrumentTestTree, instrumentTestTreeWithTracer) where import Control.Exception (bracket) import Data.Tagged (Tagged, retag)+import Data.Text (Text) import Data.Text qualified as T+import OpenTelemetry.Attributes.Key (AttributeKey (..), unkey) import OpenTelemetry.Context (insertSpan, lookupSpan, removeSpan) import OpenTelemetry.Context.ThreadLocal (adjustContext, getContext) import OpenTelemetry.Trace.Core (Span, SpanStatus (Error, Ok), Tracer, addAttribute, createSpan, defaultSpanArguments, detectInstrumentationLibrary, endSpan, getGlobalTracerProvider, inSpan, makeTracer, setStatus, tracerOptions) import Test.Tasty (TestTree, withResource) import Test.Tasty.Options (OptionDescription) import Test.Tasty.Providers (IsTest (run, testOptions))-import Test.Tasty.Runners (Outcome (Failure, Success), ResourceSpec (ResourceSpec), Result (Result, resultDescription, resultOutcome), TestTree (After, AskOptions, PlusTestOptions, SingleTest, TestGroup, WithResource))+import Test.Tasty.Runners (FailureReason (..), Outcome (Failure, Success), ResourceSpec (ResourceSpec), Result (Result, resultDescription, resultOutcome), TestTree (After, AskOptions, PlusTestOptions, SingleTest, TestGroup, WithResource)) +-- | @result.description@ – human-readable description of the test result (custom attribute).+resultDescriptionKey :: AttributeKey Text+resultDescriptionKey = AttributeKey "result.description"++ {- | A test case with a wrapper function that can do some IO around the test. We use the wrapper to set up spans appropriately. -}@@ -35,12 +49,12 @@ res@Result {resultOutcome, resultDescription} <- run opts innerTest progress case mspan of Just s -> do- addAttribute s "result.description" (T.pack resultDescription)+ addAttribute s (unkey resultDescriptionKey) (T.pack resultDescription) case resultOutcome of Success -> do- setStatus s $ Ok+ setStatus s Ok Failure reason -> do- setStatus s $ Error $ T.pack $ show reason+ setStatus s $ Error $ failureReasonText reason Nothing -> pure () pure res@@ -129,6 +143,14 @@ pure (lookupSpan ctx, ctx) teardown (originalParentSpan, _ctx) = do adjustContext $ \ctx -> maybe (removeSpan ctx) (`insertSpan` ctx) originalParentSpan+++failureReasonText :: FailureReason -> T.Text+failureReasonText = \case+ TestFailed -> "TestFailed"+ TestThrewException e -> T.pack $ "TestThrewException: " <> show e+ TestTimedOut n -> T.pack $ "TestTimedOut: " <> show n+ TestDepFailed -> "TestDepFailed" {- Note [Test parallelism] Tasty runs tests in parallel by default, and we don't want to disturb that.
tests/OpenTelemetry/Instrumentation/Tasty/Tests.hs view
@@ -8,7 +8,6 @@ module OpenTelemetry.Instrumentation.Tasty.Tests (tests) where import Control.Concurrent (newEmptyMVar, putMVar, takeMVar)-import Control.Concurrent.Async (async) import Control.Exception (bracket) import Data.Functor (void) import Data.IORef (atomicModifyIORef, newIORef, readIORef)@@ -18,9 +17,9 @@ import Data.Set qualified as Set import Data.Text (Text) import OpenTelemetry.Instrumentation.Tasty (instrumentTestTree)-import OpenTelemetry.Processor.Span (ShutdownResult (ShutdownSuccess), SpanProcessor, spanProcessorForceFlush, spanProcessorOnEnd, spanProcessorOnStart, spanProcessorShutdown, pattern SpanProcessor)-import OpenTelemetry.Trace (ImmutableSpan (ImmutableSpan, spanName, spanParent), createTracerProvider, defaultSpanArguments, emptyTracerProviderOptions, getGlobalTracerProvider, inSpan, makeTracer, setGlobalTracerProvider, shutdownTracerProvider, tracerOptions)-import OpenTelemetry.Trace.Core (unsafeReadSpan)+import OpenTelemetry.Processor.Span (FlushResult (FlushSuccess), ShutdownResult (ShutdownSuccess), SpanProcessor (..))+import OpenTelemetry.Trace (ImmutableSpan (..), createTracerProvider, defaultSpanArguments, emptyTracerProviderOptions, getGlobalTracerProvider, inSpan, makeTracer, setGlobalTracerProvider, shutdownTracerProvider, tracerOptions)+import OpenTelemetry.Trace.Core (hotName, spanHot, unsafeReadSpan) import Test.Tasty (DependencyType (AllFinish), TestTree, sequentialTestGroup, testGroup, withResource) import Test.Tasty.HUnit (testCase, (@?=)) import Test.Tasty.Ingredients (tryIngredients)@@ -130,7 +129,7 @@ spanTrees :: IO a -> IO (a, Set.Set (Tree Text)) spanTrees act = do (processor, readSpans) <- recordingProcessor- res <- bracket (setup processor) shutdownTracerProvider $ \_ -> do+ res <- bracket (setup processor) (`shutdownTracerProvider` Nothing) $ \_ -> do act spans <- readSpans trees <- spansToTrees spans@@ -142,14 +141,21 @@ pure tp +immutableSpanName :: ImmutableSpan -> IO Text+immutableSpanName imm = hotName <$> readIORef (spanHot imm)++ toChildMap :: [ImmutableSpan] -> ([Text], Map Text [Text]) -> IO ([Text], Map Text [Text]) toChildMap [] acc = pure acc-toChildMap (ImmutableSpan {spanParent, spanName} : spans) (accRoots, accChildren) = case spanParent of- Just parent -> do- ImmutableSpan {spanName = parentName} <- unsafeReadSpan parent- let existingChildren = fromMaybe mempty $ Map.lookup parentName accChildren- toChildMap spans (accRoots, Map.insert parentName (existingChildren ++ [spanName]) accChildren)- Nothing -> toChildMap spans (spanName : accRoots, accChildren)+toChildMap (imm : spans) (accRoots, accChildren) = do+ name <- immutableSpanName imm+ case spanParent imm of+ Just parent -> do+ parentImm <- unsafeReadSpan parent+ parentName <- immutableSpanName parentImm+ let existingChildren = fromMaybe mempty $ Map.lookup parentName accChildren+ toChildMap spans (accRoots, Map.insert parentName (existingChildren ++ [name]) accChildren)+ Nothing -> toChildMap spans (name : accRoots, accChildren) toTree :: (Ord a) => Map a [a] -> a -> Tree a@@ -174,12 +180,11 @@ let processor = SpanProcessor- { spanProcessorOnStart = mempty- , spanProcessorOnEnd = \spanRef -> do- immutableSpan <- readIORef spanRef+ { spanProcessorOnStart = \_ _ -> pure ()+ , spanProcessorOnEnd = \immutableSpan -> atomicModifyIORef spans $ \soFar -> (soFar ++ [immutableSpan], ())- , spanProcessorShutdown = async $ pure ShutdownSuccess- , spanProcessorForceFlush = mempty+ , spanProcessorShutdown = pure ShutdownSuccess+ , spanProcessorForceFlush = pure FlushSuccess } setGlobalTracerProvider