UpDownCounter.hs

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

module Effectful.OpenTelemetry.Metrics.UpDownCounter (UpDownCounter, new, add) where

import Control.Concurrent.STM (TVar)
import Control.Concurrent.STM qualified as STM
import Data.Bifunctor (bimap)
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

-- | A synchronous 'Instrument' which supports increments and decrements.
--
-- Example uses for 'UpDownCounter':
--
-- - the number of active requests
-- - the number of items in a queue
--
-- See <https://opentelemetry.io/docs/specs/otel/metrics/api/#updowncounter the OpenTelemetry spec>.
data UpDownCounter = UpDownCounter
    { name :: Text
    , startTime :: Timestamp
    , value :: TVar (Timestamp, Scientific)
    , metadata :: Metadata
    }

-- | Create a new 'UpDownCounter' and register it to be sampled and exported.
new :: (Metrics :> es) => Text -> Metadata -> Eff es UpDownCounter
new name metadata =
    Metrics.register =<< unsafeEff_ do
        startTime <- Timestamp.now
        value <- STM.newTVarIO (startTime, 0)
        pure UpDownCounter{..}

-- | Add to an 'UpDownCounter'. The amount may be negative.
add :: (Metrics :> es) => UpDownCounter -> Scientific -> Eff es ()
add = (unsafeEff_ .) . addIO

addIO :: UpDownCounter -> Scientific -> IO ()
addIO UpDownCounter{..} inc = do
    time <- Timestamp.now
    STM.atomically . STM.modifyTVar' value $ bimap (const time) (+ inc)

instance Instrument UpDownCounter where
    name = name
    sample UpDownCounter{..} = do
        (time, value) <- STM.readTVarIO value
        pure . pure $
            ( time
            , Sum.measurement NonMonotonic metadata name NumberDataPoint{attributes = metadata.attributes, ..}
            )