hs-opentelemetry-instrumentation-hspec 0.0.1.0 → 0.0.1.1

raw patch · 4 files changed

+68/−31 lines, 4 filesdep ~hs-opentelemetry-apisetup-changedPVP: minor bump suggested

API additions: PVP suggests at least a minor version bump

Dependency ranges changed: hs-opentelemetry-api

API changes (from Hackage documentation)

Files

• Setup.hs +2/−0
• hs-opentelemetry-instrumentation-hspec.cabal +14/−14
• src/OpenTelemetry/Instrumentation/Hspec.hs +51/−17
• test/Spec.hs +1/−0

@@ -1,2 +1,4 @@ import Distribution.Simple++ main = defaultMain

@@ -1,20 +1,20 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.34.5.+-- This file has been generated from package.yaml by hpack version 0.35.2. -- -- see: https://github.com/sol/hpack -name:           hs-opentelemetry-instrumentation-hspec-version:        0.0.1.0-description:    Please see the README on GitHub at <https://github.com/iand675/hs-opentelemetry/tree/main/instrumentation/hspec#readme>-homepage:       https://github.com/iand675/hs-opentelemetry#readme-bug-reports:    https://github.com/iand675/hs-opentelemetry/issues-author:         Ian Duncan-maintainer:     ian@iankduncan.com-copyright:      2021 Ian Duncan-license:        BSD3-license-file:   LICENSE-build-type:     Simple+name:               hs-opentelemetry-instrumentation-hspec+version:            0.0.1.1+description:        Please see the README on GitHub at <https://github.com/iand675/hs-opentelemetry/tree/main/instrumentation/hspec#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:          2023 Ian Duncan, Mercury Technologies+license:            BSD3+license-file:       LICENSE+build-type:         Simple extra-source-files:     README.md     ChangeLog.md@@ -32,7 +32,7 @@       src   build-depends:       base >=4.7 && <5-    , hs-opentelemetry-api ==0.0.3.*+    , hs-opentelemetry-api >=0.0.3 && <0.2     , hspec >=2.9.4     , hspec-core >=2.9.4     , mtl@@ -52,7 +52,7 @@   ghc-options: -threaded -rtsopts -with-rtsopts=-N   build-depends:       base >=4.7 && <5-    , hs-opentelemetry-api ==0.0.3.*+    , hs-opentelemetry-api >=0.0.3 && <0.2     , hs-opentelemetry-instrumentation-hspec     , hspec >=2.9.4     , hspec-core >=2.9.4

@@ -1,30 +1,34 @@--- | Instrumentation for Hspec test suites {-# LANGUAGE OverloadedStrings #-} -module OpenTelemetry.Instrumentation.Hspec-  ( wrapSpec,-    wrapExampleInSpan,-  )-where+-- | Instrumentation for Hspec test suites+module OpenTelemetry.Instrumentation.Hspec (+  wrapSpec,+  wrapExampleInSpan,+  instrumentSpec,+) where +import Control.Monad (void) import Control.Monad.IO.Class import Control.Monad.Reader+import qualified Data.List as List import Data.Text (Text) import qualified Data.Text as T import OpenTelemetry.Attributes (Attributes) import OpenTelemetry.Context import OpenTelemetry.Context.ThreadLocal (adjustContext, attachContext, getContext) import OpenTelemetry.Trace.Core-import Test.Hspec.Core.Spec (ActionWith, Item (..), Spec, SpecWith, mapSpecItem_)+import Test.Hspec.Core.Spec (ActionWith, Item (..), Spec, SpecWith, Tree (..), mapSpecForest, mapSpecItem_) --- | Creates a wrapper function that you can pass a spec into.------   This function will wrap each @it@ test case with a span with the name of---   the test case.------   The context in which this is called determines the parent span of all of---   the spec items.-wrapSpec :: MonadIO m => m (SpecWith a -> SpecWith a)++{- | Creates a wrapper function that you can pass a spec into.++   This function will wrap each @it@ test case with a span with the name of+   the test case.++   The context in which this is called determines the parent span of all of+   the spec items.+-}+wrapSpec :: (MonadIO m) => m (SpecWith a -> SpecWith a) wrapSpec = do   tp <- getGlobalTracerProvider   let tracer = makeTracer tp "hs-opentelemetry-instrumentation-hspec" tracerOptions@@ -35,8 +39,10 @@   -- spans but I am not sure how that would be achieved.   pure $ \spec -> mapSpecItem_ (wrapExampleInSpan tracer context) spec --- | Wraps one example in a span parented by the specified context, and ensures---   the thread running the spec item will have a context available.++{- | Wraps one example in a span parented by the specified context, and ensures+   the thread running the spec item will have a context available.+-} wrapExampleInSpan :: Tracer -> Context -> Item a -> Item a wrapExampleInSpan tp traceContext item@Item {itemExample = ex, itemRequirement = req} =   item@@ -48,3 +54,31 @@          ex params aroundAction' pcb     }+++{- | Instrument each test case. Each 'describe' and friends will add+ a span, and the final test will be in a span described by 'it'.+-}+instrumentSpec :: Tracer -> Context -> SpecWith a -> SpecWith a+instrumentSpec tracer traceContext spec = do+  mapSpecForest (map (go [])) spec+  where+    go spans t = case t of+      Node str rest ->+        Node str (map (go (str : spans)) rest)+      NodeWithCleanup mloc c rest ->+        NodeWithCleanup mloc c (map (go spans) rest)+      Leaf item ->+        Leaf+          item+            { itemExample = \params aroundAction pcb -> do+                let aroundAction' a = do+                      -- we need to reattach the context, since we are on a forked thread+                      void $ attachContext traceContext+                      addSpans spans $ inSpan tracer (T.pack (itemRequirement item)) defaultSpanArguments (aroundAction a)++                itemExample item params aroundAction' pcb+            }++    addSpans spans k =+      List.foldl' (\acc x -> inSpan tracer (T.pack x) defaultSpanArguments acc) k spans

@@ -1,2 +1,3 @@+ main :: IO () main = putStrLn "Test suite not yet implemented"