effectful-data-cache-opentelemetry (empty) → 0.2.0.2

raw patch · 6 files changed

+257/−0 lines, 6 filesdep +basedep +effectful-coredep +effectful-data-cache

Dependencies added: base, effectful-core, effectful-data-cache, effectful-data-cache-opentelemetry, hs-opentelemetry-api, hs-opentelemetry-exporter-in-memory, hs-opentelemetry-sdk, hspec, text

Files

• LICENSE +26/−0
• README.md +15/−0
• effectful-data-cache-opentelemetry.cabal +68/−0
• src/Effectful/Cache/OpenTelemetry.hs +67/−0
• test/Effectful/Cache/OpenTelemetrySpec.hs +80/−0
• test/Spec.hs +1/−0

@@ -0,0 +1,26 @@+Copyright 2026 drlkf++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++1.  Redistributions of source code must retain the above copyright notice, this+    list of conditions and the following disclaimer.++2.  Redistributions in binary form must reproduce the above copyright notice,+    this list of conditions and the following disclaimer in the documentation+    and/or other materials provided with the distribution.++3.  Neither the name of the copyright holder nor the names of its contributors+    may be used to endorse or promote products derived from this software+    without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR+ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES+(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;+LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON+ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS+SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

@@ -0,0 +1,15 @@+# effectful-data-cache-opentelemetry++`traceCache` wraps every operation in an OpenTelemetry span+(`cache.insert`, `cache.lookup`, …), with `cache.hit` on lookups and+`cache.size` on `size`/`keys`. Keys and values are never recorded.++```haskell+import Effectful.Cache.OpenTelemetry (traceCache)++main = runEff . runCache Nothing . traceCache tracer $ do+  insert "key" (42 :: Int)+```++It is an interposer, so it layers over any interpreter and can be omitted+without touching call sites.

@@ -0,0 +1,68 @@+cabal-version: 2.2++-- This file has been generated from package.yaml by hpack version 0.39.6.+--+-- see: https://github.com/sol/hpack++name:           effectful-data-cache-opentelemetry+version:        0.2.0.2+synopsis:       OpenTelemetry instrumentation for effectful-data-cache+description:    Please see the README on GitHub at <https://github.com/haskell-github-trust/effectful-data-cache/tree/main/effectful-data-cache-opentelemetry#readme>+category:       cache+homepage:       https://github.com/haskell-github-trust/effectful-data-cache#readme+bug-reports:    https://github.com/haskell-github-trust/effectful-data-cache/issues+author:         drlkf+maintainer:     drlkf <drlkf@drlkf.net>+copyright:      2026 drlkf+license:        BSD-3-Clause+license-file:   LICENSE+build-type:     Simple+extra-source-files:+    README.md++source-repository head+  type: git+  location: https://github.com/haskell-github-trust/effectful-data-cache++library+  exposed-modules:+      Effectful.Cache.OpenTelemetry+  other-modules:+      Paths_effectful_data_cache_opentelemetry+  autogen-modules:+      Paths_effectful_data_cache_opentelemetry+  hs-source-dirs:+      src+  ghc-options: -Wall -Wextra -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints+  build-depends:+      base >=4.7 && <5+    , effectful-core >=2.3 && <3+    , effectful-data-cache >=0.1.0.4 && <0.3+    , hs-opentelemetry-api ==1.0.*+    , text >=2.1 && <3+  default-language: Haskell2010++test-suite effectful-data-cache-opentelemetry-test+  type: exitcode-stdio-1.0+  main-is: Spec.hs+  other-modules:+      Effectful.Cache.OpenTelemetrySpec+      Paths_effectful_data_cache_opentelemetry+  autogen-modules:+      Paths_effectful_data_cache_opentelemetry+  hs-source-dirs:+      test+  ghc-options: -Wall -Wextra -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N+  build-tool-depends:+      hspec-discover:hspec-discover+  build-depends:+      base >=4.7 && <5+    , effectful-core+    , effectful-data-cache+    , effectful-data-cache-opentelemetry+    , hs-opentelemetry-api+    , hs-opentelemetry-exporter-in-memory+    , hs-opentelemetry-sdk+    , hspec+    , text+  default-language: Haskell2010

@@ -0,0 +1,67 @@+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeOperators #-}++-- | OpenTelemetry instrumentation for 'Cache', layered over any interpreter.+--+-- > runEff . runCache Nothing . traceCache tracer $ do ...+module Effectful.Cache.OpenTelemetry (+  traceCache,+) where++import Data.Maybe (isJust)+import Data.Text (Text)+import Effectful+import Effectful.Cache (Cache (..))+import Effectful.Dispatch.Dynamic (interpose, passthrough)+import OpenTelemetry.Trace.Core (+  Tracer,+  addAttribute,+  defaultSpanArguments,+  inSpan',+ )++-- | Wrap every cache operation in a span. Keys and values are never recorded:+-- unbounded cardinality, and likely user data.+--+-- @since 0.1.0.1+traceCache+  :: forall k v es a+   . Cache k v :> es+  => IOE :> es+  => Tracer+  -> Eff es a+  -> Eff es a+traceCache tracer = interpose @(Cache k v) $ \env op ->+  inSpan' tracer (opName op) defaultSpanArguments $ \sp -> do+    r <- passthrough env op+    case op of+      Lookup _ -> addAttribute sp "cache.hit" (isJust r)+      Lookup' _ -> addAttribute sp "cache.hit" (isJust r)+      Size -> addAttribute sp "cache.size" r+      Keys -> addAttribute sp "cache.size" (length r)+      _ -> pure ()+    pure r++opName+  :: Cache k v m a+  -> Text+opName = \case+  Insert{} -> "cache.insert"+  Insert'{} -> "cache.insert"+  Lookup{} -> "cache.lookup"+  Lookup'{} -> "cache.lookup"+  Keys{} -> "cache.keys"+  Delete{} -> "cache.delete"+  FilterWithKey{} -> "cache.filterWithKey"+  Purge{} -> "cache.purge"+  PurgeExpired{} -> "cache.purgeExpired"+  Size{} -> "cache.size"+  DefaultExpiration{} -> "cache.defaultExpiration"+  SetDefaultExpiration{} -> "cache.setDefaultExpiration"

@@ -0,0 +1,80 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeApplications #-}++module Effectful.Cache.OpenTelemetrySpec (spec) where++import Data.IORef (readIORef)+import Data.Text (Text)+import Effectful+import Effectful.Cache+import Effectful.Cache.OpenTelemetry (traceCache)+import OpenTelemetry.Attributes (Attribute (..), PrimitiveAttribute (..), lookupAttribute)+import OpenTelemetry.Exporter.InMemory.Span (inMemoryListExporter)+import OpenTelemetry.Trace (+  ImmutableSpan (..),+  createTracerProvider,+  emptyTracerProviderOptions,+  makeTracer,+  shutdownTracerProvider,+  tracerOptions,+ )+import OpenTelemetry.Trace.Core (SpanHot (..))+import Test.Hspec+import Prelude hiding (lookup)++-- | Run the given cache program under a traced interpreter, returning its+-- result plus every span that was exported.+traced+  :: Eff '[Cache String Int, IOE] a+  -> IO (a, [SpanHot])+traced prog = do+  (processor, ref) <- inMemoryListExporter+  provider <- createTracerProvider [processor] emptyTracerProviderOptions+  let tracer = makeTracer provider "effectful-data-cache-test" tracerOptions+  r <- runEff . runCache @String @Int Nothing $ traceCache @String @Int tracer prog+  _ <- shutdownTracerProvider provider Nothing+  spans <- traverse (readIORef . spanHot) . reverse =<< readIORef ref+  pure (r, spans)++attr+  :: SpanHot+  -> Text+  -> Maybe Attribute+attr s = lookupAttribute (hotAttributes s)++spec :: Spec+spec = do+  it "emits a span per operation" $ do+    (_, spans) <- traced $ do+      insert @String @Int "a" (1 :: Int)+      _ <- lookup @String @Int "a"+      purge @String @Int+    fmap hotName spans `shouldBe` ["cache.insert", "cache.lookup", "cache.purge"]++  it "records hits and misses" $ do+    (_, spans) <- traced $ do+      insert @String @Int "a" (1 :: Int)+      _ <- lookup @String @Int "a"+      _ <- lookup @String @Int "nope"+      pure ()+    let hits = [attr s "cache.hit" | s <- spans, hotName s == "cache.lookup"]+    hits+      `shouldBe` [ Just (AttributeValue (BoolAttribute True))+                 , Just (AttributeValue (BoolAttribute False))+                 ]++  it "records the size" $ do+    (_, spans) <- traced $ do+      insert @String @Int "a" (1 :: Int)+      insert @String @Int "b" (2 :: Int)+      _ <- size @String @Int+      pure ()+    [attr s "cache.size" | s <- spans, hotName s == "cache.size"]+      `shouldBe` [Just (AttributeValue (IntAttribute 2))]++  it "still returns the underlying result" $ do+    (r, _) <- traced $ do+      insert @String @Int "a" (1 :: Int)+      lookup @String @Int "a"+    r `shouldBe` Just 1

@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}