{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE NumericUnderscores #-}
{-# LANGUAGE TypeApplications #-}

module OpenTelemetry.Internal.Logs.Core (
  LoggerProviderOptions (..),
  emptyLoggerProviderOptions,
  createLoggerProvider,
  setGlobalLoggerProvider,
  getGlobalLoggerProvider,
  shutdownLoggerProvider,
  forceFlushLoggerProvider,
  makeLogger,
  emitLogRecord,
  addAttribute,
  addAttributes,
  logRecordGetAttributes,
  logDroppedAttributes,
  emitOTelLogRecord,
) where

import Control.Applicative
import Control.Concurrent.Async
import Control.Monad
import Control.Monad.Trans
import Control.Monad.Trans.Maybe
import Data.Coerce
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as H
import Data.IORef
import Data.Maybe
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Vector as V
import Data.Version (showVersion)
import GHC.IO (unsafePerformIO)
import qualified OpenTelemetry.Attributes as A
import OpenTelemetry.Common
import OpenTelemetry.Context
import OpenTelemetry.Context.ThreadLocal
import OpenTelemetry.Internal.Common.Types
import OpenTelemetry.Internal.Logs.Types
import OpenTelemetry.Internal.Trace.Types (SpanContext (..), getSpanContext)
import OpenTelemetry.LogAttributes (LogAttributes, ToValue)
import qualified OpenTelemetry.LogAttributes as LA
import OpenTelemetry.Resource (MaterializedResources, emptyMaterializedResources)
import Paths_hs_opentelemetry_api (version)
import System.Clock
import System.Timeout (timeout)


getCurrentTimestamp :: (MonadIO m) => m Timestamp
getCurrentTimestamp :: forall (m :: * -> *). MonadIO m => m Timestamp
getCurrentTimestamp = IO Timestamp -> m Timestamp
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Timestamp -> m Timestamp) -> IO Timestamp -> m Timestamp
forall a b. (a -> b) -> a -> b
$ forall a b. Coercible a b => a -> b
forall a b. Coercible a b => a -> b
coerce @(IO TimeSpec) @(IO Timestamp) (IO TimeSpec -> IO Timestamp) -> IO TimeSpec -> IO Timestamp
forall a b. (a -> b) -> a -> b
$ Clock -> IO TimeSpec
getTime Clock
Realtime


data LoggerProviderOptions = LoggerProviderOptions
  { LoggerProviderOptions -> MaterializedResources
loggerProviderOptionsResource :: MaterializedResources
  , LoggerProviderOptions -> AttributeLimits
loggerProviderOptionsAttributeLimits :: A.AttributeLimits
  }


{- | Options for creating a @LoggerProvider@ with no resources and default limits.

 In effect, logging is a no-op when using this configuration and no-op Processors.
-}
emptyLoggerProviderOptions :: LoggerProviderOptions
emptyLoggerProviderOptions :: LoggerProviderOptions
emptyLoggerProviderOptions =
  LoggerProviderOptions
    { loggerProviderOptionsResource :: MaterializedResources
loggerProviderOptionsResource = MaterializedResources
emptyMaterializedResources
    , loggerProviderOptionsAttributeLimits :: AttributeLimits
loggerProviderOptionsAttributeLimits = AttributeLimits
A.defaultAttributeLimits
    }


{- | Initialize a new @LoggerProvider@

 You should generally use @getGlobalLoggerProvider@ for most applications.
-}
createLoggerProvider :: [LogRecordProcessor] -> LoggerProviderOptions -> LoggerProvider
createLoggerProvider :: [LogRecordProcessor] -> LoggerProviderOptions -> LoggerProvider
createLoggerProvider [LogRecordProcessor]
ps LoggerProviderOptions {AttributeLimits
MaterializedResources
loggerProviderOptionsResource :: LoggerProviderOptions -> MaterializedResources
loggerProviderOptionsAttributeLimits :: LoggerProviderOptions -> AttributeLimits
loggerProviderOptionsResource :: MaterializedResources
loggerProviderOptionsAttributeLimits :: AttributeLimits
..} =
  LoggerProvider
    { loggerProviderProcessors :: Vector LogRecordProcessor
loggerProviderProcessors = [LogRecordProcessor] -> Vector LogRecordProcessor
forall a. [a] -> Vector a
V.fromList [LogRecordProcessor]
ps
    , loggerProviderResource :: MaterializedResources
loggerProviderResource = MaterializedResources
loggerProviderOptionsResource
    , loggerProviderAttributeLimits :: AttributeLimits
loggerProviderAttributeLimits = AttributeLimits
loggerProviderOptionsAttributeLimits
    }


-- | Logging is no-op when using this @LoggerProvider@ because it has no processors and empty options.
noOpLoggerProvider :: LoggerProvider
noOpLoggerProvider :: LoggerProvider
noOpLoggerProvider = [LogRecordProcessor] -> LoggerProviderOptions -> LoggerProvider
createLoggerProvider [] LoggerProviderOptions
emptyLoggerProviderOptions


globalLoggerProvider :: IORef LoggerProvider
globalLoggerProvider :: IORef LoggerProvider
globalLoggerProvider = IO (IORef LoggerProvider) -> IORef LoggerProvider
forall a. IO a -> a
unsafePerformIO (IO (IORef LoggerProvider) -> IORef LoggerProvider)
-> IO (IORef LoggerProvider) -> IORef LoggerProvider
forall a b. (a -> b) -> a -> b
$ LoggerProvider -> IO (IORef LoggerProvider)
forall a. a -> IO (IORef a)
newIORef LoggerProvider
noOpLoggerProvider
{-# NOINLINE globalLoggerProvider #-}


-- | Access the globally configured @LoggerProvider@. This @LoggerProvider@ is no-op until initialized by the SDK
getGlobalLoggerProvider :: (MonadIO m) => m LoggerProvider
getGlobalLoggerProvider :: forall (m :: * -> *). MonadIO m => m LoggerProvider
getGlobalLoggerProvider = IO LoggerProvider -> m LoggerProvider
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO LoggerProvider -> m LoggerProvider)
-> IO LoggerProvider -> m LoggerProvider
forall a b. (a -> b) -> a -> b
$ IORef LoggerProvider -> IO LoggerProvider
forall a. IORef a -> IO a
readIORef IORef LoggerProvider
globalLoggerProvider


{- | Overwrite the globally configured @LoggerProvider@.

 @Logger@s acquired from the previously installed @LoggerProvider@s
 will continue to use that @LoggerProvider@s settings.
-}
setGlobalLoggerProvider :: (MonadIO m) => LoggerProvider -> m ()
setGlobalLoggerProvider :: forall (m :: * -> *). MonadIO m => LoggerProvider -> m ()
setGlobalLoggerProvider = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ())
-> (LoggerProvider -> IO ()) -> LoggerProvider -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IORef LoggerProvider -> LoggerProvider -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef LoggerProvider
globalLoggerProvider


{- | This method provides a way for provider to do any cleanup required.

 This will also trigger shutdowns on all internal processors.
-}
shutdownLoggerProvider :: (MonadIO m) => LoggerProvider -> m ()
shutdownLoggerProvider :: forall (m :: * -> *). MonadIO m => LoggerProvider -> m ()
shutdownLoggerProvider LoggerProvider {Vector LogRecordProcessor
loggerProviderProcessors :: LoggerProvider -> Vector LogRecordProcessor
loggerProviderProcessors :: Vector LogRecordProcessor
loggerProviderProcessors} = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
  Vector (Async ShutdownResult)
asyncShutdownResults <- Vector LogRecordProcessor
-> (LogRecordProcessor -> IO (Async ShutdownResult))
-> IO (Vector (Async ShutdownResult))
forall (m :: * -> *) a b.
Monad m =>
Vector a -> (a -> m b) -> m (Vector b)
V.forM Vector LogRecordProcessor
loggerProviderProcessors ((LogRecordProcessor -> IO (Async ShutdownResult))
 -> IO (Vector (Async ShutdownResult)))
-> (LogRecordProcessor -> IO (Async ShutdownResult))
-> IO (Vector (Async ShutdownResult))
forall a b. (a -> b) -> a -> b
$ \LogRecordProcessor
processor -> do
    LogRecordProcessor -> IO (Async ShutdownResult)
logRecordProcessorShutdown LogRecordProcessor
processor
  (Async ShutdownResult -> IO ShutdownResult)
-> Vector (Async ShutdownResult) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Async ShutdownResult -> IO ShutdownResult
forall a. Async a -> IO a
wait Vector (Async ShutdownResult)
asyncShutdownResults


{- | This method provides a way for provider to immediately export all @LogRecord@s that have not yet
 been exported for all the internal processors.
-}
forceFlushLoggerProvider
  :: (MonadIO m)
  => LoggerProvider
  -> Maybe Int
  -- ^ Optional timeout in microseconds, defaults to 5,000,000 (5s)
  -> m FlushResult
  -- ^ Result that denotes whether the flush action succeeded, failed, or timed out.
forceFlushLoggerProvider :: forall (m :: * -> *).
MonadIO m =>
LoggerProvider -> Maybe Int -> m FlushResult
forceFlushLoggerProvider LoggerProvider {Vector LogRecordProcessor
loggerProviderProcessors :: LoggerProvider -> Vector LogRecordProcessor
loggerProviderProcessors :: Vector LogRecordProcessor
loggerProviderProcessors} Maybe Int
mtimeout = IO FlushResult -> m FlushResult
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FlushResult -> m FlushResult)
-> IO FlushResult -> m FlushResult
forall a b. (a -> b) -> a -> b
$ do
  Vector (Async ())
jobs <- Vector LogRecordProcessor
-> (LogRecordProcessor -> IO (Async ())) -> IO (Vector (Async ()))
forall (m :: * -> *) a b.
Monad m =>
Vector a -> (a -> m b) -> m (Vector b)
V.forM Vector LogRecordProcessor
loggerProviderProcessors ((LogRecordProcessor -> IO (Async ())) -> IO (Vector (Async ())))
-> (LogRecordProcessor -> IO (Async ())) -> IO (Vector (Async ()))
forall a b. (a -> b) -> a -> b
$ \LogRecordProcessor
processor -> IO () -> IO (Async ())
forall a. IO a -> IO (Async a)
async (IO () -> IO (Async ())) -> IO () -> IO (Async ())
forall a b. (a -> b) -> a -> b
$ do
    LogRecordProcessor -> IO ()
logRecordProcessorForceFlush LogRecordProcessor
processor
  Maybe FlushResult
mresult <-
    Int -> IO FlushResult -> IO (Maybe FlushResult)
forall a. Int -> IO a -> IO (Maybe a)
timeout (Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
5_000_000 Maybe Int
mtimeout) (IO FlushResult -> IO (Maybe FlushResult))
-> IO FlushResult -> IO (Maybe FlushResult)
forall a b. (a -> b) -> a -> b
$
      (FlushResult -> Async () -> IO FlushResult)
-> FlushResult -> Vector (Async ()) -> IO FlushResult
forall (m :: * -> *) a b.
Monad m =>
(a -> b -> m a) -> a -> Vector b -> m a
V.foldM
        ( \FlushResult
status Async ()
action -> do
            Either SomeException ()
res <- Async () -> IO (Either SomeException ())
forall a. Async a -> IO (Either SomeException a)
waitCatch Async ()
action
            FlushResult -> IO FlushResult
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FlushResult -> IO FlushResult) -> FlushResult -> IO FlushResult
forall a b. (a -> b) -> a -> b
$! case Either SomeException ()
res of
              Left SomeException
_err -> FlushResult
FlushError
              Right ()
_ok -> FlushResult
status
        )
        FlushResult
FlushSuccess
        Vector (Async ())
jobs
  case Maybe FlushResult
mresult of
    Maybe FlushResult
Nothing -> FlushResult -> IO FlushResult
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FlushResult
FlushTimeout
    Just FlushResult
res -> FlushResult -> IO FlushResult
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FlushResult
res


makeLogger
  :: LoggerProvider
  -- ^ The @LoggerProvider@ holds the configuration for the @Logger@.
  -> InstrumentationLibrary
  -- ^ The library that the @Logger@ instruments. This uniquely identifies the @Logger@.
  -> Logger
makeLogger :: LoggerProvider -> InstrumentationLibrary -> Logger
makeLogger LoggerProvider
loggerLoggerProvider InstrumentationLibrary
loggerInstrumentationScope = Logger {InstrumentationLibrary
LoggerProvider
loggerLoggerProvider :: LoggerProvider
loggerInstrumentationScope :: InstrumentationLibrary
loggerInstrumentationScope :: InstrumentationLibrary
loggerLoggerProvider :: LoggerProvider
..}


createImmutableLogRecord
  :: (MonadIO m)
  => LA.AttributeLimits
  -> LogRecordArguments
  -> m ImmutableLogRecord
createImmutableLogRecord :: forall (m :: * -> *).
MonadIO m =>
AttributeLimits -> LogRecordArguments -> m ImmutableLogRecord
createImmutableLogRecord AttributeLimits
attributeLimits LogRecordArguments {Maybe Text
Maybe Timestamp
Maybe Context
Maybe SeverityNumber
HashMap Text AnyValue
AnyValue
timestamp :: Maybe Timestamp
observedTimestamp :: Maybe Timestamp
context :: Maybe Context
severityText :: Maybe Text
severityNumber :: Maybe SeverityNumber
body :: AnyValue
attributes :: HashMap Text AnyValue
timestamp :: LogRecordArguments -> Maybe Timestamp
observedTimestamp :: LogRecordArguments -> Maybe Timestamp
context :: LogRecordArguments -> Maybe Context
severityText :: LogRecordArguments -> Maybe Text
severityNumber :: LogRecordArguments -> Maybe SeverityNumber
body :: LogRecordArguments -> AnyValue
attributes :: LogRecordArguments -> HashMap Text AnyValue
..} = do
  Timestamp
currentTimestamp <- m Timestamp
forall (m :: * -> *). MonadIO m => m Timestamp
getCurrentTimestamp
  let logRecordObservedTimestamp :: Timestamp
logRecordObservedTimestamp = Timestamp -> Maybe Timestamp -> Timestamp
forall a. a -> Maybe a -> a
fromMaybe Timestamp
currentTimestamp Maybe Timestamp
observedTimestamp

  Maybe (TraceId, SpanId, TraceFlags)
logRecordTracingDetails <- MaybeT m (TraceId, SpanId, TraceFlags)
-> m (Maybe (TraceId, SpanId, TraceFlags))
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT m (TraceId, SpanId, TraceFlags)
 -> m (Maybe (TraceId, SpanId, TraceFlags)))
-> MaybeT m (TraceId, SpanId, TraceFlags)
-> m (Maybe (TraceId, SpanId, TraceFlags))
forall a b. (a -> b) -> a -> b
$ do
    Context
currentContext <- IO Context -> MaybeT m Context
forall a. IO a -> MaybeT m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Context
forall (m :: * -> *). MonadIO m => m Context
getContext
    Span
currentSpan <- m (Maybe Span) -> MaybeT m Span
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (m (Maybe Span) -> MaybeT m Span)
-> m (Maybe Span) -> MaybeT m Span
forall a b. (a -> b) -> a -> b
$ Maybe Span -> m (Maybe Span)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Span -> m (Maybe Span)) -> Maybe Span -> m (Maybe Span)
forall a b. (a -> b) -> a -> b
$ Context -> Maybe Span
lookupSpan (Context -> Maybe Span) -> Context -> Maybe Span
forall a b. (a -> b) -> a -> b
$ Context -> Maybe Context -> Context
forall a. a -> Maybe a -> a
fromMaybe Context
currentContext Maybe Context
context
    SpanContext {TraceId
traceId :: TraceId
traceId :: SpanContext -> TraceId
traceId, SpanId
spanId :: SpanId
spanId :: SpanContext -> SpanId
spanId, TraceFlags
traceFlags :: TraceFlags
traceFlags :: SpanContext -> TraceFlags
traceFlags} <- Span -> MaybeT m SpanContext
forall (m :: * -> *). MonadIO m => Span -> m SpanContext
getSpanContext Span
currentSpan
    (TraceId, SpanId, TraceFlags)
-> MaybeT m (TraceId, SpanId, TraceFlags)
forall a. a -> MaybeT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TraceId
traceId, SpanId
spanId, TraceFlags
traceFlags)

  let logRecordAttributes :: LogAttributes
logRecordAttributes =
        AttributeLimits
-> LogAttributes -> HashMap Text AnyValue -> LogAttributes
forall a.
ToValue a =>
AttributeLimits -> LogAttributes -> HashMap Text a -> LogAttributes
LA.addAttributes
          AttributeLimits
attributeLimits
          LogAttributes
LA.emptyAttributes
          HashMap Text AnyValue
attributes

  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (LogAttributes -> Int
LA.attributesDropped LogAttributes
logRecordAttributes Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ m ReadWriteLogRecord -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void m ReadWriteLogRecord
forall (m :: * -> *). MonadIO m => m ReadWriteLogRecord
logDroppedAttributes

  ImmutableLogRecord -> m ImmutableLogRecord
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    ImmutableLogRecord
      { logRecordTimestamp :: Maybe Timestamp
logRecordTimestamp = Maybe Timestamp
timestamp
      , Timestamp
logRecordObservedTimestamp :: Timestamp
logRecordObservedTimestamp :: Timestamp
logRecordObservedTimestamp
      , Maybe (TraceId, SpanId, TraceFlags)
logRecordTracingDetails :: Maybe (TraceId, SpanId, TraceFlags)
logRecordTracingDetails :: Maybe (TraceId, SpanId, TraceFlags)
logRecordTracingDetails
      , logRecordSeverityNumber :: Maybe SeverityNumber
logRecordSeverityNumber = Maybe SeverityNumber
severityNumber
      , logRecordSeverityText :: Maybe Text
logRecordSeverityText = Maybe Text
severityText Maybe Text -> Maybe Text -> Maybe Text
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (SeverityNumber -> Maybe Text
toShortName (SeverityNumber -> Maybe Text)
-> Maybe SeverityNumber -> Maybe Text
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe SeverityNumber
severityNumber)
      , logRecordBody :: AnyValue
logRecordBody = AnyValue
body
      , LogAttributes
logRecordAttributes :: LogAttributes
logRecordAttributes :: LogAttributes
logRecordAttributes
      }


-- | WARNING: this function should only be used to emit logs from the hs-opentelemetry-api library. DO NOT USE this function in any other context.
logDroppedAttributes :: (MonadIO m) => m ReadWriteLogRecord
logDroppedAttributes :: forall (m :: * -> *). MonadIO m => m ReadWriteLogRecord
logDroppedAttributes = HashMap Text AnyValue
-> SeverityNumber -> Text -> m ReadWriteLogRecord
forall (m :: * -> *).
MonadIO m =>
HashMap Text AnyValue
-> SeverityNumber -> Text -> m ReadWriteLogRecord
emitOTelLogRecord HashMap Text AnyValue
forall k v. HashMap k v
H.empty SeverityNumber
Warn Text
"At least 1 attribute was discarded due to the attribute limits set in the logger provider."


-- | WARNING: this function should only be used to emit logs from the hs-opentelemetry-api library. DO NOT USE this function in any other context.
emitOTelLogRecord :: (MonadIO m) => H.HashMap Text LA.AnyValue -> SeverityNumber -> Text -> m ReadWriteLogRecord
emitOTelLogRecord :: forall (m :: * -> *).
MonadIO m =>
HashMap Text AnyValue
-> SeverityNumber -> Text -> m ReadWriteLogRecord
emitOTelLogRecord HashMap Text AnyValue
attrs SeverityNumber
severity Text
bodyText = do
  LoggerProvider
glp <- m LoggerProvider
forall (m :: * -> *). MonadIO m => m LoggerProvider
getGlobalLoggerProvider
  let gl :: Logger
gl =
        LoggerProvider -> InstrumentationLibrary -> Logger
makeLogger LoggerProvider
glp (InstrumentationLibrary -> Logger)
-> InstrumentationLibrary -> Logger
forall a b. (a -> b) -> a -> b
$
          InstrumentationLibrary
            { libraryName :: Text
libraryName = Text
"hs-opentelemetry-api"
            , libraryVersion :: Text
libraryVersion = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Version -> String
showVersion Version
version
            , librarySchemaUrl :: Text
librarySchemaUrl = Text
""
            , libraryAttributes :: Attributes
libraryAttributes = Attributes
A.emptyAttributes
            }

  Logger -> LogRecordArguments -> m ReadWriteLogRecord
forall (m :: * -> *).
MonadIO m =>
Logger -> LogRecordArguments -> m ReadWriteLogRecord
emitLogRecord Logger
gl (LogRecordArguments -> m ReadWriteLogRecord)
-> LogRecordArguments -> m ReadWriteLogRecord
forall a b. (a -> b) -> a -> b
$
    LogRecordArguments
emptyLogRecordArguments
      { severityNumber = Just severity
      , body = toValue bodyText
      , attributes = attrs
      }


{- | Emits a @LogRecord@ with properties specified by the passed in Logger and LogRecordArguments.
If observedTimestamp is not set in LogRecordArguments, it will default to the current timestamp.
If context is not specified in LogRecordArguments it will default to the current context.

The emitted @LogRecord@ will be passed to any @LogRecordProcessor@s registered on the @LoggerProvider@
that created the @Logger@.
-}
emitLogRecord
  :: (MonadIO m)
  => Logger
  -> LogRecordArguments
  -> m ReadWriteLogRecord
emitLogRecord :: forall (m :: * -> *).
MonadIO m =>
Logger -> LogRecordArguments -> m ReadWriteLogRecord
emitLogRecord Logger
l LogRecordArguments
args = do
  let LoggerProvider {Vector LogRecordProcessor
loggerProviderProcessors :: LoggerProvider -> Vector LogRecordProcessor
loggerProviderProcessors :: Vector LogRecordProcessor
loggerProviderProcessors, AttributeLimits
loggerProviderAttributeLimits :: LoggerProvider -> AttributeLimits
loggerProviderAttributeLimits :: AttributeLimits
loggerProviderAttributeLimits} = Logger -> LoggerProvider
loggerLoggerProvider Logger
l

  ImmutableLogRecord
ilr <- AttributeLimits -> LogRecordArguments -> m ImmutableLogRecord
forall (m :: * -> *).
MonadIO m =>
AttributeLimits -> LogRecordArguments -> m ImmutableLogRecord
createImmutableLogRecord AttributeLimits
loggerProviderAttributeLimits LogRecordArguments
args
  ReadWriteLogRecord
lr <- IO ReadWriteLogRecord -> m ReadWriteLogRecord
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ReadWriteLogRecord -> m ReadWriteLogRecord)
-> IO ReadWriteLogRecord -> m ReadWriteLogRecord
forall a b. (a -> b) -> a -> b
$ Logger -> ImmutableLogRecord -> IO ReadWriteLogRecord
mkReadWriteLogRecord Logger
l ImmutableLogRecord
ilr

  Context
ctxt <- m Context
forall (m :: * -> *). MonadIO m => m Context
getContext
  (LogRecordProcessor -> m ()) -> Vector LogRecordProcessor -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\LogRecordProcessor
processor -> IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ LogRecordProcessor -> ReadWriteLogRecord -> Context -> IO ()
logRecordProcessorOnEmit LogRecordProcessor
processor ReadWriteLogRecord
lr Context
ctxt) Vector LogRecordProcessor
loggerProviderProcessors

  ReadWriteLogRecord -> m ReadWriteLogRecord
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ReadWriteLogRecord
lr


{- | Add an attribute to a @LogRecord@.

This is not an atomic modification

As an application developer when you need to record an attribute first consult existing semantic conventions for Resources, Spans, and Metrics. If an appropriate name does not exists you will need to come up with a new name. To do that consider a few options:

The name is specific to your company and may be possibly used outside the company as well. To avoid clashes with names introduced by other companies (in a distributed system that uses applications from multiple vendors) it is recommended to prefix the new name by your company’s reverse domain name, e.g. 'com.acme.shopname'.

The name is specific to your application that will be used internally only. If you already have an internal company process that helps you to ensure no name clashes happen then feel free to follow it. Otherwise it is recommended to prefix the attribute name by your application name, provided that the application name is reasonably unique within your organization (e.g. 'myuniquemapapp.longitude' is likely fine). Make sure the application name does not clash with an existing semantic convention namespace.

The name may be generally applicable to applications in the industry. In that case consider submitting a proposal to this specification to add a new name to the semantic conventions, and if necessary also to add a new namespace.

It is recommended to limit names to printable Basic Latin characters (more precisely to 'U+0021' .. 'U+007E' subset of Unicode code points), although the Haskell OpenTelemetry specification DOES provide full Unicode support.

Attribute names that start with 'otel.' are reserved to be defined by OpenTelemetry specification. These are typically used to express OpenTelemetry concepts in formats that don’t have a corresponding concept.

For example, the 'otel.library.name' attribute is used to record the instrumentation library name, which is an OpenTelemetry concept that is natively represented in OTLP, but does not have an equivalent in other telemetry formats and protocols.

Any additions to the 'otel.*' namespace MUST be approved as part of OpenTelemetry specification.
-}
addAttribute :: (IsReadWriteLogRecord r, MonadIO m, ToValue a) => r -> Text -> a -> m ()
addAttribute :: forall r (m :: * -> *) a.
(IsReadWriteLogRecord r, MonadIO m, ToValue a) =>
r -> Text -> a -> m ()
addAttribute r
lr Text
k a
v =
  let attributeLimits :: AttributeLimits
attributeLimits = r -> AttributeLimits
forall r. IsReadWriteLogRecord r => r -> AttributeLimits
readLogRecordAttributeLimits r
lr
  in IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$
      r -> (ImmutableLogRecord -> ImmutableLogRecord) -> IO ()
forall r.
IsReadWriteLogRecord r =>
r -> (ImmutableLogRecord -> ImmutableLogRecord) -> IO ()
modifyLogRecord
        r
lr
        ( \ilr :: ImmutableLogRecord
ilr@ImmutableLogRecord {LogAttributes
logRecordAttributes :: ImmutableLogRecord -> LogAttributes
logRecordAttributes :: LogAttributes
logRecordAttributes} ->
            ImmutableLogRecord
ilr
              { logRecordAttributes =
                  LA.addAttribute
                    attributeLimits
                    logRecordAttributes
                    k
                    v
              }
        )


{- | A convenience function related to 'addAttribute' that adds multiple attributes to a @LogRecord@ at the same time.

This function may be slightly more performant than repeatedly calling 'addAttribute'.

This is not an atomic modification
-}
addAttributes :: (IsReadWriteLogRecord r, MonadIO m, ToValue a) => r -> HashMap Text a -> m ()
addAttributes :: forall r (m :: * -> *) a.
(IsReadWriteLogRecord r, MonadIO m, ToValue a) =>
r -> HashMap Text a -> m ()
addAttributes r
lr HashMap Text a
attrs =
  let attributeLimits :: AttributeLimits
attributeLimits = r -> AttributeLimits
forall r. IsReadWriteLogRecord r => r -> AttributeLimits
readLogRecordAttributeLimits r
lr
  in IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$
      r -> (ImmutableLogRecord -> ImmutableLogRecord) -> IO ()
forall r.
IsReadWriteLogRecord r =>
r -> (ImmutableLogRecord -> ImmutableLogRecord) -> IO ()
modifyLogRecord
        r
lr
        ( \ilr :: ImmutableLogRecord
ilr@ImmutableLogRecord {LogAttributes
logRecordAttributes :: ImmutableLogRecord -> LogAttributes
logRecordAttributes :: LogAttributes
logRecordAttributes} ->
            ImmutableLogRecord
ilr
              { logRecordAttributes =
                  LA.addAttributes
                    attributeLimits
                    logRecordAttributes
                    attrs
              }
        )


{- | This can be useful for pulling data for attributes and
 using it to copy / otherwise use the data to further enrich
 instrumentation.
-}
logRecordGetAttributes :: (IsReadableLogRecord r, MonadIO m) => r -> m LogAttributes
logRecordGetAttributes :: forall r (m :: * -> *).
(IsReadableLogRecord r, MonadIO m) =>
r -> m LogAttributes
logRecordGetAttributes r
lr = IO LogAttributes -> m LogAttributes
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO LogAttributes -> m LogAttributes)
-> IO LogAttributes -> m LogAttributes
forall a b. (a -> b) -> a -> b
$ ImmutableLogRecord -> LogAttributes
logRecordAttributes (ImmutableLogRecord -> LogAttributes)
-> IO ImmutableLogRecord -> IO LogAttributes
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> r -> IO ImmutableLogRecord
forall r. IsReadableLogRecord r => r -> IO ImmutableLogRecord
readLogRecord r
lr