{-|

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 :: forall (s :: Synchronicity) (a :: Additivity) (m :: Monotonicity).
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 :: forall (s :: Synchronicity) (a :: Additivity) (m :: Monotonicity).
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) = 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 forall a. Eq a => a -> a -> Bool
== InstrumentName
s2 Bool -> Bool -> Bool
&& InstrumentId
id1 forall a. Eq a => a -> a -> Bool
== InstrumentId
id2
    (UpDownCounter InstrumentName
s1 InstrumentId
id1, UpDownCounter InstrumentName
s2 InstrumentId
id2) -> InstrumentName
s1 forall a. Eq a => a -> a -> Bool
== InstrumentName
s2 Bool -> Bool -> Bool
&& InstrumentId
id1 forall a. Eq a => a -> a -> Bool
== InstrumentId
id2
    (ValueRecorder InstrumentName
s1 InstrumentId
id1, ValueRecorder InstrumentName
s2 InstrumentId
id2) -> InstrumentName
s1 forall a. Eq a => a -> a -> Bool
== InstrumentName
s2 Bool -> Bool -> Bool
&& InstrumentId
id1 forall a. Eq a => a -> a -> Bool
== InstrumentId
id2
    (SumObserver InstrumentName
s1 InstrumentId
id1, SumObserver InstrumentName
s2 InstrumentId
id2) -> InstrumentName
s1 forall a. Eq a => a -> a -> Bool
== InstrumentName
s2 Bool -> Bool -> Bool
&& InstrumentId
id1 forall a. Eq a => a -> a -> Bool
== InstrumentId
id2
    (UpDownSumObserver InstrumentName
s1 InstrumentId
id1, UpDownSumObserver InstrumentName
s2 InstrumentId
id2) -> InstrumentName
s1 forall a. Eq a => a -> a -> Bool
== InstrumentName
s2 Bool -> Bool -> Bool
&& InstrumentId
id1 forall a. Eq a => a -> a -> Bool
== InstrumentId
id2
    (ValueObserver InstrumentName
s1 InstrumentId
id1, ValueObserver InstrumentName
s2 InstrumentId
id2) -> InstrumentName
s1 forall a. Eq a => a -> a -> Bool
== InstrumentName
s2 Bool -> Bool -> Bool
&& InstrumentId
id1 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 forall a. Hashable a => Int -> a -> Int
`hashWithSalt` (Instrument s a m -> Int
constructorIdx Instrument s a m
i) forall a. Hashable a => Int -> a -> Int
`hashWithSalt` (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) = forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
s Instrument s a m
i