{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleInstances #-}

module OpenTelemetry.LogAttributes (
  LogAttributes (..),
  emptyAttributes,
  addAttribute,
  addAttributes,
  getAttributes,
  lookupAttribute,
  AnyValue (..),
  ToValue (..),

  -- * Attribute limits
  AttributeLimits (..),
  defaultAttributeLimits,

  -- * unsafe utilities
  unsafeLogAttributesFromListIgnoringLimits,
  unsafeMergeLogAttributesIgnoringLimits,
) where

import Data.ByteString (ByteString)
import Data.Data (Data)
import qualified Data.HashMap.Strict as H
import Data.Hashable (Hashable)
import Data.Int (Int64)
import Data.String (IsString (..))
import Data.Text (Text)
import qualified Data.Text as T
import GHC.Generics (Generic)
import OpenTelemetry.Attributes (AttributeLimits (..), defaultAttributeLimits)
import OpenTelemetry.Internal.Common.Types


data LogAttributes = LogAttributes
  { LogAttributes -> HashMap Text AnyValue
attributes :: !(H.HashMap Text AnyValue)
  , LogAttributes -> Int
attributesCount :: {-# UNPACK #-} !Int
  , LogAttributes -> Int
attributesDropped :: {-# UNPACK #-} !Int
  }
  deriving stock (Int -> LogAttributes -> ShowS
[LogAttributes] -> ShowS
LogAttributes -> String
(Int -> LogAttributes -> ShowS)
-> (LogAttributes -> String)
-> ([LogAttributes] -> ShowS)
-> Show LogAttributes
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LogAttributes -> ShowS
showsPrec :: Int -> LogAttributes -> ShowS
$cshow :: LogAttributes -> String
show :: LogAttributes -> String
$cshowList :: [LogAttributes] -> ShowS
showList :: [LogAttributes] -> ShowS
Show, LogAttributes -> LogAttributes -> Bool
(LogAttributes -> LogAttributes -> Bool)
-> (LogAttributes -> LogAttributes -> Bool) -> Eq LogAttributes
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LogAttributes -> LogAttributes -> Bool
== :: LogAttributes -> LogAttributes -> Bool
$c/= :: LogAttributes -> LogAttributes -> Bool
/= :: LogAttributes -> LogAttributes -> Bool
Eq)


emptyAttributes :: LogAttributes
emptyAttributes :: LogAttributes
emptyAttributes = HashMap Text AnyValue -> Int -> Int -> LogAttributes
LogAttributes HashMap Text AnyValue
forall a. Monoid a => a
mempty Int
0 Int
0


addAttribute :: (ToValue a) => AttributeLimits -> LogAttributes -> Text -> a -> LogAttributes
addAttribute :: forall a.
ToValue a =>
AttributeLimits -> LogAttributes -> Text -> a -> LogAttributes
addAttribute AttributeLimits {Maybe Int
attributeCountLimit :: Maybe Int
attributeLengthLimit :: Maybe Int
attributeCountLimit :: AttributeLimits -> Maybe Int
attributeLengthLimit :: AttributeLimits -> Maybe Int
..} LogAttributes {Int
HashMap Text AnyValue
attributes :: LogAttributes -> HashMap Text AnyValue
attributesCount :: LogAttributes -> Int
attributesDropped :: LogAttributes -> Int
attributes :: HashMap Text AnyValue
attributesCount :: Int
attributesDropped :: Int
..} !Text
k !a
v = case Maybe Int
attributeCountLimit of
  Maybe Int
Nothing -> HashMap Text AnyValue -> Int -> Int -> LogAttributes
LogAttributes HashMap Text AnyValue
newAttrs Int
newCount Int
attributesDropped
  Just Int
limit_ ->
    if Int
newCount Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
limit_
      then HashMap Text AnyValue -> Int -> Int -> LogAttributes
LogAttributes HashMap Text AnyValue
attributes Int
attributesCount (Int
attributesDropped Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
      else HashMap Text AnyValue -> Int -> Int -> LogAttributes
LogAttributes HashMap Text AnyValue
newAttrs Int
newCount Int
attributesDropped
  where
    newAttrs :: HashMap Text AnyValue
newAttrs = Text -> AnyValue -> HashMap Text AnyValue -> HashMap Text AnyValue
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
H.insert Text
k ((AnyValue -> AnyValue)
-> (Int -> AnyValue -> AnyValue)
-> Maybe Int
-> AnyValue
-> AnyValue
forall b a. b -> (a -> b) -> Maybe a -> b
maybe AnyValue -> AnyValue
forall a. a -> a
id Int -> AnyValue -> AnyValue
limitLengths Maybe Int
attributeCountLimit (AnyValue -> AnyValue) -> AnyValue -> AnyValue
forall a b. (a -> b) -> a -> b
$ a -> AnyValue
forall a. ToValue a => a -> AnyValue
toValue a
v) HashMap Text AnyValue
attributes
    newCount :: Int
newCount = HashMap Text AnyValue -> Int
forall k v. HashMap k v -> Int
H.size HashMap Text AnyValue
newAttrs
{-# INLINE addAttribute #-}


addAttributes :: (ToValue a) => AttributeLimits -> LogAttributes -> H.HashMap Text a -> LogAttributes
addAttributes :: forall a.
ToValue a =>
AttributeLimits -> LogAttributes -> HashMap Text a -> LogAttributes
addAttributes AttributeLimits {Maybe Int
attributeCountLimit :: AttributeLimits -> Maybe Int
attributeLengthLimit :: AttributeLimits -> Maybe Int
attributeCountLimit :: Maybe Int
attributeLengthLimit :: Maybe Int
..} LogAttributes {Int
HashMap Text AnyValue
attributes :: LogAttributes -> HashMap Text AnyValue
attributesCount :: LogAttributes -> Int
attributesDropped :: LogAttributes -> Int
attributes :: HashMap Text AnyValue
attributesCount :: Int
attributesDropped :: Int
..} HashMap Text a
attrs = case Maybe Int
attributeCountLimit of
  Maybe Int
Nothing -> HashMap Text AnyValue -> Int -> Int -> LogAttributes
LogAttributes HashMap Text AnyValue
newAttrs Int
newCount Int
attributesDropped
  Just Int
limit_ ->
    if Int
newCount Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
limit_
      then HashMap Text AnyValue -> Int -> Int -> LogAttributes
LogAttributes HashMap Text AnyValue
attributes Int
attributesCount (Int
attributesDropped Int -> Int -> Int
forall a. Num a => a -> a -> a
+ HashMap Text a -> Int
forall k v. HashMap k v -> Int
H.size HashMap Text a
attrs)
      else HashMap Text AnyValue -> Int -> Int -> LogAttributes
LogAttributes HashMap Text AnyValue
newAttrs Int
newCount Int
attributesDropped
  where
    newAttrs :: HashMap Text AnyValue
newAttrs = HashMap Text AnyValue
-> HashMap Text AnyValue -> HashMap Text AnyValue
forall k v. Eq k => HashMap k v -> HashMap k v -> HashMap k v
H.union HashMap Text AnyValue
attributes (HashMap Text AnyValue -> HashMap Text AnyValue)
-> HashMap Text AnyValue -> HashMap Text AnyValue
forall a b. (a -> b) -> a -> b
$ (a -> AnyValue) -> HashMap Text a -> HashMap Text AnyValue
forall v1 v2 k. (v1 -> v2) -> HashMap k v1 -> HashMap k v2
H.map a -> AnyValue
forall a. ToValue a => a -> AnyValue
toValue HashMap Text a
attrs
    newCount :: Int
newCount = HashMap Text AnyValue -> Int
forall k v. HashMap k v -> Int
H.size HashMap Text AnyValue
newAttrs
{-# INLINE addAttributes #-}


getAttributes :: LogAttributes -> (Int, H.HashMap Text AnyValue)
getAttributes :: LogAttributes -> (Int, HashMap Text AnyValue)
getAttributes LogAttributes {Int
HashMap Text AnyValue
attributes :: LogAttributes -> HashMap Text AnyValue
attributesCount :: LogAttributes -> Int
attributesDropped :: LogAttributes -> Int
attributes :: HashMap Text AnyValue
attributesCount :: Int
attributesDropped :: Int
..} = (Int
attributesCount, HashMap Text AnyValue
attributes)


lookupAttribute :: LogAttributes -> Text -> Maybe AnyValue
lookupAttribute :: LogAttributes -> Text -> Maybe AnyValue
lookupAttribute LogAttributes {Int
HashMap Text AnyValue
attributes :: LogAttributes -> HashMap Text AnyValue
attributesCount :: LogAttributes -> Int
attributesDropped :: LogAttributes -> Int
attributes :: HashMap Text AnyValue
attributesCount :: Int
attributesDropped :: Int
..} Text
k = Text -> HashMap Text AnyValue -> Maybe AnyValue
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
H.lookup Text
k HashMap Text AnyValue
attributes


limitLengths :: Int -> AnyValue -> AnyValue
limitLengths :: Int -> AnyValue -> AnyValue
limitLengths Int
limit (TextValue Text
t) = Text -> AnyValue
TextValue (Int -> Text -> Text
T.take Int
limit Text
t)
limitLengths Int
limit (ArrayValue [AnyValue]
arr) = [AnyValue] -> AnyValue
ArrayValue ([AnyValue] -> AnyValue) -> [AnyValue] -> AnyValue
forall a b. (a -> b) -> a -> b
$ (AnyValue -> AnyValue) -> [AnyValue] -> [AnyValue]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> AnyValue -> AnyValue
limitLengths Int
limit) [AnyValue]
arr
limitLengths Int
limit (HashMapValue HashMap Text AnyValue
h) = HashMap Text AnyValue -> AnyValue
HashMapValue (HashMap Text AnyValue -> AnyValue)
-> HashMap Text AnyValue -> AnyValue
forall a b. (a -> b) -> a -> b
$ (AnyValue -> AnyValue)
-> HashMap Text AnyValue -> HashMap Text AnyValue
forall a b. (a -> b) -> HashMap Text a -> HashMap Text b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> AnyValue -> AnyValue
limitLengths Int
limit) HashMap Text AnyValue
h
limitLengths Int
_ AnyValue
val = AnyValue
val


unsafeMergeLogAttributesIgnoringLimits :: LogAttributes -> LogAttributes -> LogAttributes
unsafeMergeLogAttributesIgnoringLimits :: LogAttributes -> LogAttributes -> LogAttributes
unsafeMergeLogAttributesIgnoringLimits (LogAttributes HashMap Text AnyValue
l Int
lc Int
ld) (LogAttributes HashMap Text AnyValue
r Int
rc Int
rd) = HashMap Text AnyValue -> Int -> Int -> LogAttributes
LogAttributes (HashMap Text AnyValue
l HashMap Text AnyValue
-> HashMap Text AnyValue -> HashMap Text AnyValue
forall a. Semigroup a => a -> a -> a
<> HashMap Text AnyValue
r) (Int
lc Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
rc) (Int
ld Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
rd)


unsafeLogAttributesFromListIgnoringLimits :: [(Text, AnyValue)] -> LogAttributes
unsafeLogAttributesFromListIgnoringLimits :: [(Text, AnyValue)] -> LogAttributes
unsafeLogAttributesFromListIgnoringLimits [(Text, AnyValue)]
l = HashMap Text AnyValue -> Int -> Int -> LogAttributes
LogAttributes HashMap Text AnyValue
hm Int
c Int
0
  where
    hm :: HashMap Text AnyValue
hm = [(Text, AnyValue)] -> HashMap Text AnyValue
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
H.fromList [(Text, AnyValue)]
l
    c :: Int
c = HashMap Text AnyValue -> Int
forall k v. HashMap k v -> Int
H.size HashMap Text AnyValue
hm