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

-- |
--
-- 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
-- @
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.ByteString as BS
import Data.Hashable (Hashable (..))
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 :: Instrument s a m -> InstrumentName
instrumentName (Counter InstrumentName
n InstrumentId
_) = InstrumentName
n
instrumentName (UpDownCounter InstrumentName
n InstrumentId
_) = InstrumentName
n
instrumentName (ValueRecorder InstrumentName
n InstrumentId
_) = InstrumentName
n
instrumentName (SumObserver InstrumentName
n InstrumentId
_) = InstrumentName
n
instrumentName (UpDownSumObserver InstrumentName
n InstrumentId
_) = InstrumentName
n
instrumentName (ValueObserver InstrumentName
n InstrumentId
_) = InstrumentName
n

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

deriving instance Show (Instrument s a m)

deriving instance Eq (Instrument s a m)

instance Show SomeInstrument where
  show :: SomeInstrument -> String
show (SomeInstrument Instrument s a m
i) = Instrument s a m -> String
forall a. Show a => a -> String
show Instrument s a m
i

instance Eq SomeInstrument where
  (SomeInstrument Instrument s a m
i1) == :: SomeInstrument -> SomeInstrument -> Bool
== (SomeInstrument Instrument s a m
i2) = case (Instrument s a m
i1, Instrument s a m
i2) of
    (Counter InstrumentName
s1 InstrumentId
id1, Counter InstrumentName
s2 InstrumentId
id2) -> InstrumentName
s1 InstrumentName -> InstrumentName -> Bool
forall a. Eq a => a -> a -> Bool
== InstrumentName
s2 Bool -> Bool -> Bool
&& InstrumentId
id1 InstrumentId -> InstrumentId -> Bool
forall a. Eq a => a -> a -> Bool
== InstrumentId
id2
    (UpDownCounter InstrumentName
s1 InstrumentId
id1, UpDownCounter InstrumentName
s2 InstrumentId
id2) -> InstrumentName
s1 InstrumentName -> InstrumentName -> Bool
forall a. Eq a => a -> a -> Bool
== InstrumentName
s2 Bool -> Bool -> Bool
&& InstrumentId
id1 InstrumentId -> InstrumentId -> Bool
forall a. Eq a => a -> a -> Bool
== InstrumentId
id2
    (ValueRecorder InstrumentName
s1 InstrumentId
id1, ValueRecorder InstrumentName
s2 InstrumentId
id2) -> InstrumentName
s1 InstrumentName -> InstrumentName -> Bool
forall a. Eq a => a -> a -> Bool
== InstrumentName
s2 Bool -> Bool -> Bool
&& InstrumentId
id1 InstrumentId -> InstrumentId -> Bool
forall a. Eq a => a -> a -> Bool
== InstrumentId
id2
    (SumObserver InstrumentName
s1 InstrumentId
id1, SumObserver InstrumentName
s2 InstrumentId
id2) -> InstrumentName
s1 InstrumentName -> InstrumentName -> Bool
forall a. Eq a => a -> a -> Bool
== InstrumentName
s2 Bool -> Bool -> Bool
&& InstrumentId
id1 InstrumentId -> InstrumentId -> Bool
forall a. Eq a => a -> a -> Bool
== InstrumentId
id2
    (UpDownSumObserver InstrumentName
s1 InstrumentId
id1, UpDownSumObserver InstrumentName
s2 InstrumentId
id2) -> InstrumentName
s1 InstrumentName -> InstrumentName -> Bool
forall a. Eq a => a -> a -> Bool
== InstrumentName
s2 Bool -> Bool -> Bool
&& InstrumentId
id1 InstrumentId -> InstrumentId -> Bool
forall a. Eq a => a -> a -> Bool
== InstrumentId
id2
    (ValueObserver InstrumentName
s1 InstrumentId
id1, ValueObserver InstrumentName
s2 InstrumentId
id2) -> InstrumentName
s1 InstrumentName -> InstrumentName -> Bool
forall a. Eq a => a -> a -> Bool
== InstrumentName
s2 Bool -> Bool -> Bool
&& InstrumentId
id1 InstrumentId -> InstrumentId -> Bool
forall a. Eq a => a -> a -> Bool
== InstrumentId
id2
    (Instrument s a m
_, Instrument s a m
_) -> Bool
False

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

instance Hashable SomeInstrument where
  hashWithSalt :: Int -> SomeInstrument -> Int
hashWithSalt Int
s (SomeInstrument Instrument s a m
i) = Int -> Instrument s a m -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
s Instrument s a m
i