Metrics_Internal.hs

{-|

This is an internal module. The public interface is re-exported by "OpenTelemetry.Eventlog"

This module implements the instruments of the metrics portion of the
OpenTelemetry API. It is reexported by "OpenTelemetry.Eventlog" and should be
used by importing that.

The way to use the 'Instrument' type is throught the 'add', 'record' or
'observe' functions (depending on the instrument type) which capture metrics on
a given instrument.

Usage:

@
import OpenTelemetry.Eventlog

aCounter :: Counter
aCounter = Counter "myCounter"

anObserver :: ValueObserver
anObserver = ValueObserver "myObserver"

main :: IO ()
main = do
  add aCounter 3
  record anObserver 40
@

-}

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE StandaloneDeriving #-}

module OpenTelemetry.Metrics_Internal
  ( Instrument(..)
  , SomeInstrument(..)
  -- * Synonyms for specific types of Instrument
  , Counter
  , UpDownCounter
  , ValueRecorder
  , SumObserver
  , UpDownSumObserver
  , ValueObserver
  -- * Used for indexing Instrument. All possible combinations are covered
  , Synchronicity(..)
  , Additivity(..)
  , Monotonicity(..)
  , InstrumentName
  , InstrumentId
  , instrumentName
  , instrumentId
  ) where

import Data.Hashable (Hashable(..))
import Data.ByteString as BS
import Data.Word

data Synchronicity = Synchronous | Asynchronous
data Additivity = Additive | NonAdditive
data Monotonicity = Monotonic | NonMonotonic

type InstrumentName = BS.ByteString
type InstrumentId = Word64

type Counter           = Instrument 'Synchronous  'Additive    'Monotonic
type UpDownCounter     = Instrument 'Synchronous  'Additive    'NonMonotonic
type ValueRecorder     = Instrument 'Synchronous  'NonAdditive 'NonMonotonic
type SumObserver       = Instrument 'Asynchronous 'Additive    'Monotonic
type UpDownSumObserver = Instrument 'Asynchronous 'Additive    'NonMonotonic
type ValueObserver     = Instrument 'Asynchronous 'NonAdditive 'NonMonotonic

-- TODO: Support tags

-- | An OpenTelemetry instrument as defined in the OpenTelemetry Metrics API
-- (<https://github.com/open-telemetry/opentelemetry-specification/blob/master/specification/metrics/api.md>)
data Instrument (s :: Synchronicity) (a :: Additivity) (m :: Monotonicity) where
  Counter           :: InstrumentName -> InstrumentId -> Counter
  UpDownCounter     :: InstrumentName -> InstrumentId -> UpDownCounter
  ValueRecorder     :: InstrumentName -> InstrumentId -> ValueRecorder
  SumObserver       :: InstrumentName -> InstrumentId -> SumObserver
  UpDownSumObserver :: InstrumentName -> InstrumentId -> UpDownSumObserver
  ValueObserver     :: InstrumentName -> InstrumentId -> ValueObserver

-- | Existential wrapper for 'Instrument'. Use when the exact type of Instrument does not matter.
data SomeInstrument = forall s a m. SomeInstrument (Instrument s a m)

instrumentName :: Instrument s a m -> InstrumentName
instrumentName (Counter n _) = n
instrumentName (UpDownCounter n _) = n
instrumentName (ValueRecorder n _) = n
instrumentName (SumObserver n _) = n
instrumentName (UpDownSumObserver n _) = n
instrumentName (ValueObserver n _) = n

instrumentId :: Instrument s a m -> InstrumentId
instrumentId (Counter _ i) = i
instrumentId (UpDownCounter _ i) = i
instrumentId (ValueRecorder _ i) = i
instrumentId (SumObserver _ i) = i
instrumentId (UpDownSumObserver _ i) = i
instrumentId (ValueObserver _ i) = i

deriving instance Show (Instrument s a m)
deriving instance Eq (Instrument s a m)

instance Show SomeInstrument where
  show (SomeInstrument i) = show i

instance Eq SomeInstrument where
  (SomeInstrument i1) == (SomeInstrument i2) = case (i1, i2) of
    (Counter s1 id1, Counter s2 id2) -> s1 == s2 && id1 == id2
    (UpDownCounter s1 id1, UpDownCounter s2 id2) -> s1 == s2 && id1 == id2
    (ValueRecorder s1 id1, ValueRecorder s2 id2) -> s1 == s2 && id1 == id2
    (SumObserver s1 id1, SumObserver s2 id2) -> s1 == s2 && id1 == id2
    (UpDownSumObserver s1 id1, UpDownSumObserver s2 id2) -> s1 == s2 && id1 == id2
    (ValueObserver s1 id1, ValueObserver s2 id2) -> s1 == s2 && id1 == id2
    (_, _) -> False

instance Hashable (Instrument s a m) where
  hashWithSalt s i = s `hashWithSalt` (constructorIdx i) `hashWithSalt` (instrumentName i)
    where
      constructorIdx :: Instrument s a m -> Int
      constructorIdx Counter{} = 0
      constructorIdx UpDownCounter{} = 1
      constructorIdx ValueRecorder{} = 2
      constructorIdx SumObserver{} = 3
      constructorIdx UpDownSumObserver{} = 4
      constructorIdx ValueObserver{} = 5

instance Hashable SomeInstrument where
  hashWithSalt s (SomeInstrument i) = hashWithSalt s i