packages feed

hs-opentelemetry-instrumentation-monad-logger (empty) → 1.0.0.0

raw patch · 5 files changed

+310/−0 lines, 5 filesdep +basedep +fast-loggerdep +hs-opentelemetry-api

Dependencies added: base, fast-logger, hs-opentelemetry-api, hs-opentelemetry-exporter-in-memory, hs-opentelemetry-instrumentation-monad-logger, hs-opentelemetry-sdk, hs-opentelemetry-semantic-conventions, hspec, monad-logger, text, unordered-containers, vector

Files

+ ChangeLog.md view
@@ -0,0 +1,16 @@+# Changelog for hs-opentelemetry-instrumentation-monad-logger++## 1.0.0.0 - 2026-05-29++- Promoted to 1.0.0.0 for the hs-opentelemetry 1.0 release.++## 0.1.0.0++- Initial release.+- Provides `makeOTelLogCallback` for use with `runLoggingT`.+- Severity mapping: `LevelDebug`→`Debug`, `LevelInfo`→`Info`, `LevelWarn`→`Warn`,+  `LevelError`→`Error`, `LevelOther t`→`Info` (with original level name in+  `severityText`).+- Template Haskell source location emitted as `code.filepath`, `code.function.name`,+  and `code.lineno` attributes.+- Logger source tag emitted as `log.source` attribute when non-empty.
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Ian Duncan (c) 2021-2026++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * 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.++    * Neither the name of Ian Duncan nor the names of other+      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+OWNER 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.
+ hs-opentelemetry-instrumentation-monad-logger.cabal view
@@ -0,0 +1,56 @@+cabal-version: 2.0+name:               hs-opentelemetry-instrumentation-monad-logger+version:            1.0.0.0+synopsis:           Bridge monad-logger to OpenTelemetry Logs+description:+  Provides a logging callback for @runLoggingT@ that forwards monad-logger+  messages to the OpenTelemetry Logs pipeline with automatic trace+  correlation and source location attributes.+category:           OpenTelemetry, Logging+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:          2024-2026 Ian Duncan, Mercury Technologies+license:            BSD3+license-file:       LICENSE+build-type:         Simple+extra-doc-files:    ChangeLog.md++source-repository head+  type: git+  location: https://github.com/iand675/hs-opentelemetry++library+  exposed-modules:+      OpenTelemetry.Instrumentation.MonadLogger+  hs-source-dirs:+      src+  ghc-options: -Wall+  build-depends:+      base >=4.7 && <5+    , fast-logger+    , hs-opentelemetry-api ^>= 1.0+    , hs-opentelemetry-semantic-conventions >= 1.40 && < 2+    , monad-logger >=0.3 && <0.4+    , text+    , unordered-containers+  default-language: Haskell2010++test-suite hs-opentelemetry-instrumentation-monad-logger-test+  type: exitcode-stdio-1.0+  main-is: Spec.hs+  hs-source-dirs:+      test+  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-instrumentation-monad-logger ^>= 1.0+    , hs-opentelemetry-sdk ^>= 1.0+    , hspec+    , monad-logger >=0.3 && <0.4+    , text+    , vector+  default-language: Haskell2010
+ src/OpenTelemetry/Instrumentation/MonadLogger.hs view
@@ -0,0 +1,144 @@+{-# LANGUAGE OverloadedStrings #-}++{- |+Module      : OpenTelemetry.Instrumentation.MonadLogger+Copyright   : (c) Ian Duncan, 2021-2026+License     : BSD-3+Description : Bridge monad-logger to OpenTelemetry Logs+Stability   : experimental++Provides a logging callback compatible with @runLoggingT@ that forwards+@monad-logger@ messages to the OpenTelemetry Logs pipeline. Log records+are emitted via the OTel Logs Bridge API, which means:++* __Trace correlation is automatic__: if a log statement executes inside+  an 'OpenTelemetry.Trace.Core.inSpan' block, the emitted log record+  carries the active trace\/span IDs with no extra code.++* __Severity mapping__: 'LevelDebug' → 'Debug', 'LevelInfo' → 'Info',+  'LevelWarn' → 'Warn', 'LevelError' → 'Error', 'LevelOther' → 'Info'+  (with the original level name preserved in @severityText@).++* __Source location__: The 'Loc' from Template Haskell logging macros+  (e.g. @$logInfo@) is mapped to @code.filepath@, @code.function.name@,+  and @code.lineno@ attributes.++= Usage++@+import OpenTelemetry.Log.Core+import OpenTelemetry.Instrumentation.MonadLogger++main :: IO ()+main = do+  lp <- getGlobalLoggerProvider+  let logger = makeLogger lp (instrumentationLibrary \"my-app\" \"1.0.0\")+  runLoggingT myApp (makeOTelLogCallback logger)+@++Or with 'LoggingT' and the SDK's auto-initialized provider:++@+import OpenTelemetry.Trace (withTracerProvider)+import OpenTelemetry.Log (getGlobalLoggerProvider)+import OpenTelemetry.Instrumentation.MonadLogger++main :: IO ()+main = withTracerProvider $ \\_ -> do+  lp <- getGlobalLoggerProvider+  let logger = makeLogger lp (instrumentationLibrary \"my-app\" \"1.0.0\")+  runLoggingT myApp (makeOTelLogCallback logger)+@++@since 0.1.0.0+-}+module OpenTelemetry.Instrumentation.MonadLogger (+  makeOTelLogCallback,+  monadLoggerSeverity,+) where++import Control.Monad (void)+import Control.Monad.Logger (Loc (..), LogLevel (..), LogSource, LogStr)+import qualified Data.HashMap.Strict as H+import Data.Text (Text)+import qualified Data.Text as T+import qualified Data.Text.Encoding as TE+import OpenTelemetry.Attributes.Key (AttributeKey (..), unkey)+import OpenTelemetry.Internal.Common.Types (AnyValue (..), ToValue (..))+import OpenTelemetry.Internal.Log.Types (+  LogRecordArguments (..),+  SeverityNumber (..),+  emptyLogRecordArguments,+ )+import OpenTelemetry.Log.Core (Logger, emitLogRecord)+import qualified OpenTelemetry.SemanticConventions as SC+import OpenTelemetry.SemanticsConfig (StabilityOpt (..), codeOption, getSemanticsOptions)+import System.Log.FastLogger (fromLogStr)+++{- | Create a logging callback for use with @runLoggingT@ that forwards+all log messages to the OTel Logs pipeline via the given 'Logger'.++The callback signature matches what 'Control.Monad.Logger.runLoggingT'+expects: @Loc -> LogSource -> LogLevel -> LogStr -> IO ()@.++@since 0.1.0.0+-}+makeOTelLogCallback :: Logger -> (Loc -> LogSource -> LogLevel -> LogStr -> IO ())+makeOTelLogCallback logger loc src level msg = do+  semOpts <- getSemanticsOptions+  let bodyText = TE.decodeUtf8 (fromLogStr msg)+      (sevNum, sevText) = monadLoggerSeverity level+      attrs = locAttributes (codeOption semOpts) loc <> sourceAttributes src+      args =+        emptyLogRecordArguments+          { severityText = Just sevText+          , severityNumber = Just sevNum+          , body = toValue bodyText+          , attributes = attrs+          }+  void $ emitLogRecord logger args+++{- | Map a monad-logger 'LogLevel' to an OTel 'SeverityNumber' and+short text name.++@since 0.1.0.0+-}+monadLoggerSeverity :: LogLevel -> (SeverityNumber, Text)+monadLoggerSeverity LevelDebug = (Debug, "DEBUG")+monadLoggerSeverity LevelInfo = (Info, "INFO")+monadLoggerSeverity LevelWarn = (Warn, "WARN")+monadLoggerSeverity LevelError = (Error, "ERROR")+monadLoggerSeverity (LevelOther t) = (Info, t)+++-- | @log.source@ – monad-logger log source tag (custom attribute).+logSourceKey :: AttributeKey Text+logSourceKey = AttributeKey "log.source"+++locAttributes :: StabilityOpt -> Loc -> H.HashMap Text AnyValue+locAttributes opt loc =+  let qualifiedName = T.pack (loc_package loc) <> ":" <> T.pack (loc_module loc)+      stableAttrs =+        [ (unkey SC.code_function_name, toValue qualifiedName)+        , (unkey SC.code_file_path, toValue (T.pack (loc_filename loc)))+        , (unkey SC.code_line_number, IntValue (fromIntegral (fst (loc_start loc))))+        ]+      oldAttrs =+        [ (unkey SC.code_function, toValue (T.pack (loc_module loc)))+        , (unkey SC.code_namespace, toValue qualifiedName)+        , (unkey SC.code_filepath, toValue (T.pack (loc_filename loc)))+        , (unkey SC.code_lineno, IntValue (fromIntegral (fst (loc_start loc))))+        ]+  in H.fromList $ case opt of+       Stable -> stableAttrs+       Old -> oldAttrs+       StableAndOld -> stableAttrs <> oldAttrs+++sourceAttributes :: LogSource -> H.HashMap Text AnyValue+sourceAttributes src+  | T.null src = H.empty+  | otherwise = H.singleton (unkey logSourceKey) (toValue src)
+ test/Spec.hs view
@@ -0,0 +1,64 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}++module Main where++import Control.Monad.Logger (Loc (..), LogLevel (..), LogStr, logDebugN, logErrorN, logInfoN, logWarnN, runLoggingT, toLogStr)+import Data.IORef (readIORef)+import qualified Data.Text as T+import OpenTelemetry.Exporter.InMemory.LogRecord (getExportedLogRecords, inMemoryLogRecordExporter)+import OpenTelemetry.Instrumentation.MonadLogger (makeOTelLogCallback, monadLoggerSeverity)+import OpenTelemetry.Internal.Log.Types+import OpenTelemetry.Log.Core+import OpenTelemetry.Processor.Simple.LogRecord (SimpleLogRecordProcessorConfig (..), simpleLogRecordProcessor)+import Test.Hspec+++main :: IO ()+main = hspec spec+++spec :: Spec+spec = describe "MonadLogger bridge" $ do+  describe "monadLoggerSeverity" $ do+    it "maps LevelDebug to Debug" $+      fst (monadLoggerSeverity LevelDebug) `shouldBe` Debug+    it "maps LevelInfo to Info" $+      fst (monadLoggerSeverity LevelInfo) `shouldBe` Info+    it "maps LevelWarn to Warn" $+      fst (monadLoggerSeverity LevelWarn) `shouldBe` Warn+    it "maps LevelError to Error" $+      fst (monadLoggerSeverity LevelError) `shouldBe` Error+    it "maps LevelOther to Info with custom text" $ do+      let (sev, txt) = monadLoggerSeverity (LevelOther "TRACE")+      sev `shouldBe` Info+      txt `shouldBe` "TRACE"++  describe "makeOTelLogCallback" $ do+    it "emits log records to the OTel pipeline" $ do+      (exporter, ref) <- inMemoryLogRecordExporter+      proc <- simpleLogRecordProcessor (SimpleLogRecordProcessorConfig exporter 30000000)+      lp <- createLoggerProvider [proc] emptyLoggerProviderOptions+      let logger = makeLogger lp (instrumentationLibrary "test-monad-logger" "0.0.0")+      runLoggingT (logInfoN "hello from monad-logger") (makeOTelLogCallback logger)+      _ <- forceFlushLoggerProvider lp Nothing+      records <- getExportedLogRecords ref+      length records `shouldBe` 1+      let r = head records+      ilr <- readLogRecord r+      toBaseMaybe (logRecordSeverityNumber ilr) `shouldBe` Just Info+      toBaseMaybe (logRecordSeverityText ilr) `shouldBe` Just "INFO"+      logRecordBody ilr `shouldBe` TextValue "hello from monad-logger"++    it "preserves severity across multiple levels" $ do+      (exporter, ref) <- inMemoryLogRecordExporter+      proc <- simpleLogRecordProcessor (SimpleLogRecordProcessorConfig exporter 30000000)+      lp <- createLoggerProvider [proc] emptyLoggerProviderOptions+      let logger = makeLogger lp (instrumentationLibrary "test-monad-logger" "0.0.0")+          cb = makeOTelLogCallback logger+      runLoggingT (logDebugN "d" >> logInfoN "i" >> logWarnN "w" >> logErrorN "e") cb+      _ <- forceFlushLoggerProvider lp Nothing+      records <- reverse <$> getExportedLogRecords ref+      length records `shouldBe` 4+      sevs <- mapM (\r -> logRecordSeverityNumber <$> readLogRecord r) records+      map toBaseMaybe sevs `shouldBe` [Just Debug, Just Info, Just Warn, Just Error]