AnyValue.hs

module Effectful.OpenTelemetry.Protocol.AnyValue where

import Control.Monad (mzero)
import Data.Aeson.KeyMap qualified as KeyMap
import Data.Aeson.Types
    ( FromJSON (..)
    , ToJSON (..)
    , Value (..)
    , object
    , withObject
    , (.!=)
    , (.:)
    , (.:?)
    , (.=)
    )
import Data.Coerce (coerce)
import Data.Int (Int64)
import Data.Scientific qualified as Scientific
import Data.Text qualified as Text
import Text.Read qualified as Text
import Prelude

-- | Wrapper for 'Value' used for OTEL-specific JSON encoding.
--
-- See <https://opentelemetry.io/docs/specs/otel/common/#anyvalue the OpenTelemetry spec>.
newtype AnyValue = AnyValue Value
    deriving stock (Show, Eq)

instance ToJSON AnyValue where
    toJSON (AnyValue Null) = object []
    toJSON (AnyValue (Bool b)) = object ["boolValue" .= b]
    toJSON (AnyValue (String s)) = object ["stringValue" .= s]
    toJSON (AnyValue (Number d)) = case Scientific.toBoundedInteger @Int64 d of
        Just i -> object ["intValue" .= String (Text.show i)]
        Nothing -> object ["doubleValue" .= d]
    toJSON (AnyValue (Array a)) = object ["arrayValue" .= object ["values" .= (AnyValue <$> a)]]
    toJSON (AnyValue (Object o)) =
        object
            [ "kvlistValue"
                .= object
                    [ "values"
                        .= ( (\(k, v) -> object ["key" .= k, "value" .= AnyValue v])
                                <$> KeyMap.toList o
                           )
                    ]
            ]

instance FromJSON AnyValue where
    parseJSON = withObject "AnyValue" \o -> case KeyMap.toList o of
        [] -> pure $ AnyValue Null
        [("boolValue", Bool b)] -> pure . AnyValue $ Bool b
        [("stringValue", String s)] -> pure . AnyValue $ String s
        [("intValue", String s)]
            | Just n <- Text.readMaybe (Text.unpack s) -> pure . AnyValue . Number $ n
        [("doubleValue", Number n)] -> pure . AnyValue $ Number n
        [("doubleValue", String s)]
            | Just n <- Text.readMaybe (Text.unpack s) -> pure . AnyValue . Number $ n
        [("arrayValue", Object o')] ->
            AnyValue . Array . fmap coerce
                <$> (mapM (parseJSON @AnyValue) =<< o' .:? "values" .!= mempty)
        [("kvlistValue", Object o')] -> do
            AnyValue . Object . KeyMap.fromList
                <$> ( mapM
                        ( withObject "KVPair" $ \kvPair -> do
                            k <- kvPair .:? "key" .!= ""
                            AnyValue v <- kvPair .: "value"
                            pure (k, v)
                        )
                        =<< o' .:? "values" .!= mempty
                    )
        _ -> mzero