Counter.hs

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

module Effectful.OpenTelemetry.Metrics.Counter
    ( Counter
    , new
    , add
    , addIO
    )
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 non-negative increments.
--
-- Example uses for 'Counter':
--
-- - count the number of bytes received
-- - count the number of requests completed
-- - count the number of accounts created
-- - count the number of checkpoints run
-- - count the number of HTTP 5xx errors
--
-- See <https://opentelemetry.io/docs/specs/otel/metrics/api/#counter the OpenTelemetry spec>.
data Counter = Counter
    { name :: Text
    , startTime :: Timestamp
    , value :: TVar (Timestamp, Scientific)
    , metadata :: Metadata
    }

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

-- | Increment a 'Counter'.
-- WARNING: This function is partial because it throws on negative increment.
add :: (Metrics :> es) => Counter -> Scientific -> Eff es ()
add = (unsafeEff_ .) . addIO

addIO :: Counter -> Scientific -> IO ()
addIO Counter{..} inc
    | inc < 0 =
        error $ "Counter.add: negative increment (" <> show inc <> ") added to counter " <> show name
    | otherwise = do
        time <- Timestamp.now
        STM.atomically . STM.modifyTVar' value $ bimap (const time) (+ inc)

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