otel-effectful-1.0.0: test/Util.hs

module Util where

import Control.Applicative ((<|>))
import Data.Scientific (Scientific)
import Data.String (IsString (..))
import Effectful
import Effectful.HUnit
import Effectful.OpenTelemetry.Metrics.Gauge qualified as Gauge
import Effectful.OpenTelemetry.Metrics.Histogram qualified as Histogram
import Effectful.OpenTelemetry.Metrics.Measurement
    ( HistogramDataPoint
    , Measurement
    , NumberDataPoint (..)
    , toMetric
    )
import Effectful.OpenTelemetry.Metrics.Sum qualified as Sum
import Effectful.OpenTelemetry.Protocol.Transport
import GHC.Stack (HasCallStack)
import Prelude

protocolLabel :: (IsString s) => Protocol -> s
protocolLabel (HTTP Json _) = "HTTP/JSON"
protocolLabel (HTTP Proto _) = "HTTP/Protobuf"
protocolLabel GRPC{} = "gRPC"

only :: (HasCallStack, HUnit :> es, Show a) => [a] -> Eff es a
only [x] = pure x
only xs = assertFailure $ "expected exactly one item, got: " <> show xs

allUnique :: (Eq a) => [a] -> Bool
allUnique [] = True
allUnique (x : xs) = x `notElem` xs && allUnique xs

numberDataPoint :: Measurement -> Maybe NumberDataPoint
numberDataPoint m = fromSum <|> fromGauge
  where
    fromSum = do
        Sum.Payload{dataPoints = [dp]} <- toMetric m
        pure dp
    fromGauge = do
        Gauge.Payload{dataPoints = [dp]} <- toMetric m
        pure dp

numberValue :: Measurement -> Maybe Scientific
numberValue m = (.value) <$> numberDataPoint m

histogramDataPoint :: Measurement -> Maybe HistogramDataPoint
histogramDataPoint m = do
    Histogram.Payload{dataPoints = [dp]} <- toMetric m
    pure dp