Attributes.hs

module Effectful.OpenTelemetry.Protocol.Attributes where

import Data.Aeson.KeyMap qualified as KeyMap
import Data.Aeson.Types
    ( FromJSON (..)
    , Object
    , Pair
    , ToJSON (..)
    , object
    , withArray
    , withObject
    , (.!=)
    , (.:)
    , (.:?)
    , (.=)
    )
import Data.Vector qualified as Vector
import Effectful.OpenTelemetry.Protocol.AnyValue (AnyValue (..))
import GHC.Generics (Generic)
import GHC.IsList (IsList)
import GHC.IsList qualified as GHC
import Prettyprinter.Extra (PrettyAnn (..))
import Prettyprinter.Extra qualified as Pretty
import Proto3.Wire.Encode.Class qualified as Proto
import Prelude

-- | Key-value metadata that can be attached to telemetry.
--
-- See <https://opentelemetry.io/docs/specs/semconv/general/attributes/ the OpenTelemetry spec>.
newtype Attributes = Attributes Object
    deriving stock (Generic)
    deriving newtype (Monoid, Semigroup, Show, Eq)

instance IsList Attributes where
    type Item Attributes = Pair
    fromList = fromList
    toList = toList

null :: Attributes -> Bool
null (Attributes o) = Prelude.null o

fromList :: [Pair] -> Attributes
fromList = Attributes . KeyMap.fromList

toList :: Attributes -> [Pair]
toList (Attributes o) = KeyMap.toList o

instance ToJSON Attributes where
    toJSON =
        toJSON
            . fmap (\(k, v) -> object ["key" .= k, "value" .= AnyValue v])
            . toList

instance FromJSON Attributes where
    parseJSON =
        withArray "Attributes" $
            fmap (Attributes . KeyMap.fromList . Vector.toList)
                . mapM
                    ( withObject "KeyValue" \o -> do
                        k <- o .:? "key" .!= ""
                        AnyValue v <- parseJSON =<< o .: "value"
                        pure (k, v)
                    )

instance {-# OVERLAPPING #-} Proto.EncodeField Attributes where
    encodeField n (Attributes o) =
        foldMap (Proto.encodeField n) $ KeyMap.toList o

instance PrettyAnn ann Attributes where
    prettyAnn = Pretty.unwords . fmap prettyAnn . toList