otel-effectful-1.0.0: src/Effectful/OpenTelemetry/Metrics/ObservableUpDownCounter.hs

{-# OPTIONS_GHC -Wno-name-shadowing #-}
{-# OPTIONS_GHC -Wno-redundant-constraints #-}

module Effectful.OpenTelemetry.Metrics.ObservableUpDownCounter (ObservableUpDownCounter, new) where

import Data.Scientific (Scientific)
import Data.Text (Text)
import Effectful
import Effectful.Dispatch.Static (unsafeEff_)
import Effectful.OpenTelemetry.Metrics.Effect (Metrics)
import Effectful.OpenTelemetry.Metrics.Effect qualified as Metrics
import Effectful.OpenTelemetry.Metrics.Instrument (Instrument)
import Effectful.OpenTelemetry.Metrics.Instrument qualified as Instrument
import Effectful.OpenTelemetry.Metrics.Measurement (NumberDataPoint (..))
import Effectful.OpenTelemetry.Metrics.Metadata (Metadata (..))
import Effectful.OpenTelemetry.Metrics.Sum (Monotonicity (..))
import Effectful.OpenTelemetry.Metrics.Sum qualified as Sum
import Effectful.OpenTelemetry.Timestamp (Timestamp)
import Effectful.OpenTelemetry.Timestamp qualified as Timestamp
import Prelude

-- | An asynchronous 'Instrument' which reports additive values when it is observed.
--
-- Example uses for 'ObservableUpDownCounter':
--
-- - the process heap size
-- - the approximate number of items in a lock-free circular buffer
--
-- See <https://opentelemetry.io/docs/specs/otel/metrics/api/#asynchronous-updowncounter the OpenTelemetry spec>.
data ObservableUpDownCounter = ObservableUpDownCounter
    { name :: Text
    , startTime :: Timestamp
    , metadata :: Metadata
    , observe :: IO Scientific
    }

-- | Create a new 'ObservableUpDownCounter' with an observation callback.
new
    :: (Metrics :> es)
    => Text
    -> Metadata
    -> IO Scientific
    -> Eff es ObservableUpDownCounter
new name metadata observe =
    Metrics.register =<< unsafeEff_ do
        startTime <- Timestamp.now
        pure ObservableUpDownCounter{..}

instance Instrument ObservableUpDownCounter where
    name = name
    sample ObservableUpDownCounter{..} = do
        time <- Timestamp.now
        value <- observe
        pure . pure $
            ( time
            , Sum.measurement NonMonotonic metadata name NumberDataPoint{attributes = metadata.attributes, ..}
            )