ObservableCounter.hs

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

module Effectful.OpenTelemetry.Metrics.ObservableCounter (ObservableCounter, 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 monotonically increasing values when it is observed.
-- Example uses for Asynchronous Counter:
--
-- - CPU time, which could be reported for each thread, each process or the entire system
-- - the number of page faults for each process
--
-- See <https://opentelemetry.io/docs/specs/otel/metrics/api/#asynchronous-counter the OpenTelemetry spec>.
data ObservableCounter = ObservableCounter
    { name :: Text
    , startTime :: Timestamp
    , metadata :: Metadata
    , observe :: IO Scientific
    }

-- | Create a new 'ObservableCounter'. The callback must return the cumulative total, not a delta.
new
    :: (Metrics :> es)
    => Text
    -> Metadata
    -> IO Scientific
    -- ^ The cumulative total
    -> Eff es ObservableCounter
new name metadata observe =
    Metrics.register =<< unsafeEff_ do
        startTime <- Timestamp.now
        pure ObservableCounter{..}

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