{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}

module OpenTelemetry.Common where

import Control.Monad
import qualified Data.ByteString as BS
import qualified Data.HashMap.Strict as HM
import Data.Hashable
import Data.IORef (modifyIORef, newIORef, readIORef)
import Data.List (sortOn)
import Data.String
import qualified Data.Text as T
import Data.Word
import GHC.Generics
import GHC.Int (Int8)
import OpenTelemetry.SpanContext
import System.Clock

type Timestamp = Word64

newtype SpanName = SpanName T.Text deriving (Int -> SpanName -> ShowS
[SpanName] -> ShowS
SpanName -> String
(Int -> SpanName -> ShowS)
-> (SpanName -> String) -> ([SpanName] -> ShowS) -> Show SpanName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SpanName] -> ShowS
$cshowList :: [SpanName] -> ShowS
show :: SpanName -> String
$cshow :: SpanName -> String
showsPrec :: Int -> SpanName -> ShowS
$cshowsPrec :: Int -> SpanName -> ShowS
Show, SpanName -> SpanName -> Bool
(SpanName -> SpanName -> Bool)
-> (SpanName -> SpanName -> Bool) -> Eq SpanName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SpanName -> SpanName -> Bool
$c/= :: SpanName -> SpanName -> Bool
== :: SpanName -> SpanName -> Bool
$c== :: SpanName -> SpanName -> Bool
Eq, (forall x. SpanName -> Rep SpanName x)
-> (forall x. Rep SpanName x -> SpanName) -> Generic SpanName
forall x. Rep SpanName x -> SpanName
forall x. SpanName -> Rep SpanName x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SpanName x -> SpanName
$cfrom :: forall x. SpanName -> Rep SpanName x
Generic)

newtype TagName = TagName T.Text deriving (Int -> TagName -> ShowS
[TagName] -> ShowS
TagName -> String
(Int -> TagName -> ShowS)
-> (TagName -> String) -> ([TagName] -> ShowS) -> Show TagName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TagName] -> ShowS
$cshowList :: [TagName] -> ShowS
show :: TagName -> String
$cshow :: TagName -> String
showsPrec :: Int -> TagName -> ShowS
$cshowsPrec :: Int -> TagName -> ShowS
Show, TagName -> TagName -> Bool
(TagName -> TagName -> Bool)
-> (TagName -> TagName -> Bool) -> Eq TagName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TagName -> TagName -> Bool
$c/= :: TagName -> TagName -> Bool
== :: TagName -> TagName -> Bool
$c== :: TagName -> TagName -> Bool
Eq, (forall x. TagName -> Rep TagName x)
-> (forall x. Rep TagName x -> TagName) -> Generic TagName
forall x. Rep TagName x -> TagName
forall x. TagName -> Rep TagName x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TagName x -> TagName
$cfrom :: forall x. TagName -> Rep TagName x
Generic, Eq TagName
Eq TagName
-> (Int -> TagName -> Int) -> (TagName -> Int) -> Hashable TagName
Int -> TagName -> Int
TagName -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: TagName -> Int
$chash :: TagName -> Int
hashWithSalt :: Int -> TagName -> Int
$chashWithSalt :: Int -> TagName -> Int
$cp1Hashable :: Eq TagName
Hashable)

newtype TagVal = TagVal T.Text deriving (Int -> TagVal -> ShowS
[TagVal] -> ShowS
TagVal -> String
(Int -> TagVal -> ShowS)
-> (TagVal -> String) -> ([TagVal] -> ShowS) -> Show TagVal
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TagVal] -> ShowS
$cshowList :: [TagVal] -> ShowS
show :: TagVal -> String
$cshow :: TagVal -> String
showsPrec :: Int -> TagVal -> ShowS
$cshowsPrec :: Int -> TagVal -> ShowS
Show, TagVal -> TagVal -> Bool
(TagVal -> TagVal -> Bool)
-> (TagVal -> TagVal -> Bool) -> Eq TagVal
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TagVal -> TagVal -> Bool
$c/= :: TagVal -> TagVal -> Bool
== :: TagVal -> TagVal -> Bool
$c== :: TagVal -> TagVal -> Bool
Eq, (forall x. TagVal -> Rep TagVal x)
-> (forall x. Rep TagVal x -> TagVal) -> Generic TagVal
forall x. Rep TagVal x -> TagVal
forall x. TagVal -> Rep TagVal x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TagVal x -> TagVal
$cfrom :: forall x. TagVal -> Rep TagVal x
Generic)

newtype EventName = EventName T.Text deriving (Int -> EventName -> ShowS
[EventName] -> ShowS
EventName -> String
(Int -> EventName -> ShowS)
-> (EventName -> String)
-> ([EventName] -> ShowS)
-> Show EventName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EventName] -> ShowS
$cshowList :: [EventName] -> ShowS
show :: EventName -> String
$cshow :: EventName -> String
showsPrec :: Int -> EventName -> ShowS
$cshowsPrec :: Int -> EventName -> ShowS
Show, EventName -> EventName -> Bool
(EventName -> EventName -> Bool)
-> (EventName -> EventName -> Bool) -> Eq EventName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EventName -> EventName -> Bool
$c/= :: EventName -> EventName -> Bool
== :: EventName -> EventName -> Bool
$c== :: EventName -> EventName -> Bool
Eq, (forall x. EventName -> Rep EventName x)
-> (forall x. Rep EventName x -> EventName) -> Generic EventName
forall x. Rep EventName x -> EventName
forall x. EventName -> Rep EventName x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep EventName x -> EventName
$cfrom :: forall x. EventName -> Rep EventName x
Generic)

newtype EventVal = EventVal T.Text deriving (Int -> EventVal -> ShowS
[EventVal] -> ShowS
EventVal -> String
(Int -> EventVal -> ShowS)
-> (EventVal -> String) -> ([EventVal] -> ShowS) -> Show EventVal
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EventVal] -> ShowS
$cshowList :: [EventVal] -> ShowS
show :: EventVal -> String
$cshow :: EventVal -> String
showsPrec :: Int -> EventVal -> ShowS
$cshowsPrec :: Int -> EventVal -> ShowS
Show, EventVal -> EventVal -> Bool
(EventVal -> EventVal -> Bool)
-> (EventVal -> EventVal -> Bool) -> Eq EventVal
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EventVal -> EventVal -> Bool
$c/= :: EventVal -> EventVal -> Bool
== :: EventVal -> EventVal -> Bool
$c== :: EventVal -> EventVal -> Bool
Eq, (forall x. EventVal -> Rep EventVal x)
-> (forall x. Rep EventVal x -> EventVal) -> Generic EventVal
forall x. Rep EventVal x -> EventVal
forall x. EventVal -> Rep EventVal x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep EventVal x -> EventVal
$cfrom :: forall x. EventVal -> Rep EventVal x
Generic)

instance IsString TagName where
  fromString :: String -> TagName
fromString = Text -> TagName
TagName (Text -> TagName) -> (String -> Text) -> String -> TagName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack

data TagValue
  = StringTagValue !TagVal
  | BoolTagValue !Bool
  | IntTagValue !Int
  | DoubleTagValue !Double
  deriving (TagValue -> TagValue -> Bool
(TagValue -> TagValue -> Bool)
-> (TagValue -> TagValue -> Bool) -> Eq TagValue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TagValue -> TagValue -> Bool
$c/= :: TagValue -> TagValue -> Bool
== :: TagValue -> TagValue -> Bool
$c== :: TagValue -> TagValue -> Bool
Eq, Int -> TagValue -> ShowS
[TagValue] -> ShowS
TagValue -> String
(Int -> TagValue -> ShowS)
-> (TagValue -> String) -> ([TagValue] -> ShowS) -> Show TagValue
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TagValue] -> ShowS
$cshowList :: [TagValue] -> ShowS
show :: TagValue -> String
$cshow :: TagValue -> String
showsPrec :: Int -> TagValue -> ShowS
$cshowsPrec :: Int -> TagValue -> ShowS
Show)

class ToTagValue a where
  toTagValue :: a -> TagValue

instance ToTagValue String where
  toTagValue :: String -> TagValue
toTagValue = TagVal -> TagValue
StringTagValue (TagVal -> TagValue) -> (String -> TagVal) -> String -> TagValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> TagVal
TagVal (Text -> TagVal) -> (String -> Text) -> String -> TagVal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack

instance ToTagValue TagVal where
  toTagValue :: TagVal -> TagValue
toTagValue = TagVal -> TagValue
StringTagValue

instance ToTagValue T.Text where
  toTagValue :: Text -> TagValue
toTagValue = TagVal -> TagValue
StringTagValue (TagVal -> TagValue) -> (Text -> TagVal) -> Text -> TagValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> TagVal
TagVal

instance ToTagValue Bool where
  toTagValue :: Bool -> TagValue
toTagValue = Bool -> TagValue
BoolTagValue

instance ToTagValue Int where
  toTagValue :: Int -> TagValue
toTagValue = Int -> TagValue
IntTagValue

data Span = Span
  { Span -> SpanContext
spanContext :: {-# UNPACK #-} !SpanContext,
    Span -> Text
spanOperation :: T.Text,
    Span -> Word32
spanThreadId :: Word32,
    Span -> Word32
spanDisplayThreadId :: Word32,
    Span -> Timestamp
spanStartedAt :: !Timestamp,
    Span -> Timestamp
spanFinishedAt :: !Timestamp,
    Span -> HashMap TagName TagValue
spanTags :: !(HM.HashMap TagName TagValue),
    Span -> [SpanEvent]
spanEvents :: [SpanEvent],
    Span -> SpanStatus
spanStatus :: !SpanStatus,
    Span -> Maybe SpanId
spanParentId :: Maybe SpanId,
    Span -> Timestamp
spanNanosecondsSpentInGC :: !Word64
  }
  deriving (Int -> Span -> ShowS
[Span] -> ShowS
Span -> String
(Int -> Span -> ShowS)
-> (Span -> String) -> ([Span] -> ShowS) -> Show Span
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Span] -> ShowS
$cshowList :: [Span] -> ShowS
show :: Span -> String
$cshow :: Span -> String
showsPrec :: Int -> Span -> ShowS
$cshowsPrec :: Int -> Span -> ShowS
Show, Span -> Span -> Bool
(Span -> Span -> Bool) -> (Span -> Span -> Bool) -> Eq Span
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Span -> Span -> Bool
$c/= :: Span -> Span -> Bool
== :: Span -> Span -> Bool
$c== :: Span -> Span -> Bool
Eq)

-- | Reflects the constructors of 'OpenTelemetry.Metrics_Internal.Instrument'
data InstrumentType
  = CounterType
  | UpDownCounterType
  | ValueRecorderType
  | SumObserverType
  | UpDownSumObserverType
  | ValueObserverType
  deriving (Int -> InstrumentType -> ShowS
[InstrumentType] -> ShowS
InstrumentType -> String
(Int -> InstrumentType -> ShowS)
-> (InstrumentType -> String)
-> ([InstrumentType] -> ShowS)
-> Show InstrumentType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InstrumentType] -> ShowS
$cshowList :: [InstrumentType] -> ShowS
show :: InstrumentType -> String
$cshow :: InstrumentType -> String
showsPrec :: Int -> InstrumentType -> ShowS
$cshowsPrec :: Int -> InstrumentType -> ShowS
Show, InstrumentType -> InstrumentType -> Bool
(InstrumentType -> InstrumentType -> Bool)
-> (InstrumentType -> InstrumentType -> Bool) -> Eq InstrumentType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InstrumentType -> InstrumentType -> Bool
$c/= :: InstrumentType -> InstrumentType -> Bool
== :: InstrumentType -> InstrumentType -> Bool
$c== :: InstrumentType -> InstrumentType -> Bool
Eq, Int -> InstrumentType
InstrumentType -> Int
InstrumentType -> [InstrumentType]
InstrumentType -> InstrumentType
InstrumentType -> InstrumentType -> [InstrumentType]
InstrumentType
-> InstrumentType -> InstrumentType -> [InstrumentType]
(InstrumentType -> InstrumentType)
-> (InstrumentType -> InstrumentType)
-> (Int -> InstrumentType)
-> (InstrumentType -> Int)
-> (InstrumentType -> [InstrumentType])
-> (InstrumentType -> InstrumentType -> [InstrumentType])
-> (InstrumentType -> InstrumentType -> [InstrumentType])
-> (InstrumentType
    -> InstrumentType -> InstrumentType -> [InstrumentType])
-> Enum InstrumentType
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: InstrumentType
-> InstrumentType -> InstrumentType -> [InstrumentType]
$cenumFromThenTo :: InstrumentType
-> InstrumentType -> InstrumentType -> [InstrumentType]
enumFromTo :: InstrumentType -> InstrumentType -> [InstrumentType]
$cenumFromTo :: InstrumentType -> InstrumentType -> [InstrumentType]
enumFromThen :: InstrumentType -> InstrumentType -> [InstrumentType]
$cenumFromThen :: InstrumentType -> InstrumentType -> [InstrumentType]
enumFrom :: InstrumentType -> [InstrumentType]
$cenumFrom :: InstrumentType -> [InstrumentType]
fromEnum :: InstrumentType -> Int
$cfromEnum :: InstrumentType -> Int
toEnum :: Int -> InstrumentType
$ctoEnum :: Int -> InstrumentType
pred :: InstrumentType -> InstrumentType
$cpred :: InstrumentType -> InstrumentType
succ :: InstrumentType -> InstrumentType
$csucc :: InstrumentType -> InstrumentType
Enum, (forall x. InstrumentType -> Rep InstrumentType x)
-> (forall x. Rep InstrumentType x -> InstrumentType)
-> Generic InstrumentType
forall x. Rep InstrumentType x -> InstrumentType
forall x. InstrumentType -> Rep InstrumentType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep InstrumentType x -> InstrumentType
$cfrom :: forall x. InstrumentType -> Rep InstrumentType x
Generic)

instance Hashable InstrumentType

data CaptureInstrument = CaptureInstrument
  { CaptureInstrument -> InstrumentType
instrumentType :: !InstrumentType,
    CaptureInstrument -> ByteString
instrumentName :: !BS.ByteString
  }
  deriving (Int -> CaptureInstrument -> ShowS
[CaptureInstrument] -> ShowS
CaptureInstrument -> String
(Int -> CaptureInstrument -> ShowS)
-> (CaptureInstrument -> String)
-> ([CaptureInstrument] -> ShowS)
-> Show CaptureInstrument
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CaptureInstrument] -> ShowS
$cshowList :: [CaptureInstrument] -> ShowS
show :: CaptureInstrument -> String
$cshow :: CaptureInstrument -> String
showsPrec :: Int -> CaptureInstrument -> ShowS
$cshowsPrec :: Int -> CaptureInstrument -> ShowS
Show, CaptureInstrument -> CaptureInstrument -> Bool
(CaptureInstrument -> CaptureInstrument -> Bool)
-> (CaptureInstrument -> CaptureInstrument -> Bool)
-> Eq CaptureInstrument
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CaptureInstrument -> CaptureInstrument -> Bool
$c/= :: CaptureInstrument -> CaptureInstrument -> Bool
== :: CaptureInstrument -> CaptureInstrument -> Bool
$c== :: CaptureInstrument -> CaptureInstrument -> Bool
Eq, (forall x. CaptureInstrument -> Rep CaptureInstrument x)
-> (forall x. Rep CaptureInstrument x -> CaptureInstrument)
-> Generic CaptureInstrument
forall x. Rep CaptureInstrument x -> CaptureInstrument
forall x. CaptureInstrument -> Rep CaptureInstrument x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CaptureInstrument x -> CaptureInstrument
$cfrom :: forall x. CaptureInstrument -> Rep CaptureInstrument x
Generic)

instance Hashable CaptureInstrument

-- | Based on https://github.com/open-telemetry/opentelemetry-proto/blob/1a931b4b57c34e7fd8f7dddcaa9b7587840e9c08/opentelemetry/proto/metrics/v1/metrics.proto#L96-L107
data Metric = Metric
  { Metric -> CaptureInstrument
instrument :: !CaptureInstrument,
    Metric -> [MetricDatapoint Int]
datapoints :: ![MetricDatapoint Int]
  }
  deriving (Int -> Metric -> ShowS
[Metric] -> ShowS
Metric -> String
(Int -> Metric -> ShowS)
-> (Metric -> String) -> ([Metric] -> ShowS) -> Show Metric
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Metric] -> ShowS
$cshowList :: [Metric] -> ShowS
show :: Metric -> String
$cshow :: Metric -> String
showsPrec :: Int -> Metric -> ShowS
$cshowsPrec :: Int -> Metric -> ShowS
Show, Metric -> Metric -> Bool
(Metric -> Metric -> Bool)
-> (Metric -> Metric -> Bool) -> Eq Metric
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Metric -> Metric -> Bool
$c/= :: Metric -> Metric -> Bool
== :: Metric -> Metric -> Bool
$c== :: Metric -> Metric -> Bool
Eq)

data AggregatedMetric = AggregatedMetric
  { AggregatedMetric -> CaptureInstrument
instrument :: !CaptureInstrument,
    AggregatedMetric -> MetricDatapoint Int
datapoint :: !(MetricDatapoint Int)
  }
  deriving (Int -> AggregatedMetric -> ShowS
[AggregatedMetric] -> ShowS
AggregatedMetric -> String
(Int -> AggregatedMetric -> ShowS)
-> (AggregatedMetric -> String)
-> ([AggregatedMetric] -> ShowS)
-> Show AggregatedMetric
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AggregatedMetric] -> ShowS
$cshowList :: [AggregatedMetric] -> ShowS
show :: AggregatedMetric -> String
$cshow :: AggregatedMetric -> String
showsPrec :: Int -> AggregatedMetric -> ShowS
$cshowsPrec :: Int -> AggregatedMetric -> ShowS
Show, AggregatedMetric -> AggregatedMetric -> Bool
(AggregatedMetric -> AggregatedMetric -> Bool)
-> (AggregatedMetric -> AggregatedMetric -> Bool)
-> Eq AggregatedMetric
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AggregatedMetric -> AggregatedMetric -> Bool
$c/= :: AggregatedMetric -> AggregatedMetric -> Bool
== :: AggregatedMetric -> AggregatedMetric -> Bool
$c== :: AggregatedMetric -> AggregatedMetric -> Bool
Eq)

data MetricDatapoint a = MetricDatapoint
  { MetricDatapoint a -> Timestamp
timestamp :: !Timestamp,
    MetricDatapoint a -> a
value :: !a
  }
  deriving (Int -> MetricDatapoint a -> ShowS
[MetricDatapoint a] -> ShowS
MetricDatapoint a -> String
(Int -> MetricDatapoint a -> ShowS)
-> (MetricDatapoint a -> String)
-> ([MetricDatapoint a] -> ShowS)
-> Show (MetricDatapoint a)
forall a. Show a => Int -> MetricDatapoint a -> ShowS
forall a. Show a => [MetricDatapoint a] -> ShowS
forall a. Show a => MetricDatapoint a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MetricDatapoint a] -> ShowS
$cshowList :: forall a. Show a => [MetricDatapoint a] -> ShowS
show :: MetricDatapoint a -> String
$cshow :: forall a. Show a => MetricDatapoint a -> String
showsPrec :: Int -> MetricDatapoint a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> MetricDatapoint a -> ShowS
Show, MetricDatapoint a -> MetricDatapoint a -> Bool
(MetricDatapoint a -> MetricDatapoint a -> Bool)
-> (MetricDatapoint a -> MetricDatapoint a -> Bool)
-> Eq (MetricDatapoint a)
forall a. Eq a => MetricDatapoint a -> MetricDatapoint a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MetricDatapoint a -> MetricDatapoint a -> Bool
$c/= :: forall a. Eq a => MetricDatapoint a -> MetricDatapoint a -> Bool
== :: MetricDatapoint a -> MetricDatapoint a -> Bool
$c== :: forall a. Eq a => MetricDatapoint a -> MetricDatapoint a -> Bool
Eq, a -> MetricDatapoint b -> MetricDatapoint a
(a -> b) -> MetricDatapoint a -> MetricDatapoint b
(forall a b. (a -> b) -> MetricDatapoint a -> MetricDatapoint b)
-> (forall a b. a -> MetricDatapoint b -> MetricDatapoint a)
-> Functor MetricDatapoint
forall a b. a -> MetricDatapoint b -> MetricDatapoint a
forall a b. (a -> b) -> MetricDatapoint a -> MetricDatapoint b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> MetricDatapoint b -> MetricDatapoint a
$c<$ :: forall a b. a -> MetricDatapoint b -> MetricDatapoint a
fmap :: (a -> b) -> MetricDatapoint a -> MetricDatapoint b
$cfmap :: forall a b. (a -> b) -> MetricDatapoint a -> MetricDatapoint b
Functor)

spanTraceId :: Span -> TraceId
spanTraceId :: Span -> TraceId
spanTraceId Span {$sel:spanContext:Span :: Span -> SpanContext
spanContext = SpanContext SpanId
_ TraceId
tid} = TraceId
tid

spanId :: Span -> SpanId
spanId :: Span -> SpanId
spanId Span {$sel:spanContext:Span :: Span -> SpanContext
spanContext = SpanContext SpanId
sid TraceId
_} = SpanId
sid

data SpanEvent = SpanEvent
  { SpanEvent -> Timestamp
spanEventTimestamp :: !Timestamp,
    SpanEvent -> EventName
spanEventKey :: !EventName,
    SpanEvent -> EventVal
spanEventValue :: !EventVal
  }
  deriving (Int -> SpanEvent -> ShowS
[SpanEvent] -> ShowS
SpanEvent -> String
(Int -> SpanEvent -> ShowS)
-> (SpanEvent -> String)
-> ([SpanEvent] -> ShowS)
-> Show SpanEvent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SpanEvent] -> ShowS
$cshowList :: [SpanEvent] -> ShowS
show :: SpanEvent -> String
$cshow :: SpanEvent -> String
showsPrec :: Int -> SpanEvent -> ShowS
$cshowsPrec :: Int -> SpanEvent -> ShowS
Show, SpanEvent -> SpanEvent -> Bool
(SpanEvent -> SpanEvent -> Bool)
-> (SpanEvent -> SpanEvent -> Bool) -> Eq SpanEvent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SpanEvent -> SpanEvent -> Bool
$c/= :: SpanEvent -> SpanEvent -> Bool
== :: SpanEvent -> SpanEvent -> Bool
$c== :: SpanEvent -> SpanEvent -> Bool
Eq)

data SpanStatus = OK
  deriving (Int -> SpanStatus -> ShowS
[SpanStatus] -> ShowS
SpanStatus -> String
(Int -> SpanStatus -> ShowS)
-> (SpanStatus -> String)
-> ([SpanStatus] -> ShowS)
-> Show SpanStatus
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SpanStatus] -> ShowS
$cshowList :: [SpanStatus] -> ShowS
show :: SpanStatus -> String
$cshow :: SpanStatus -> String
showsPrec :: Int -> SpanStatus -> ShowS
$cshowsPrec :: Int -> SpanStatus -> ShowS
Show, SpanStatus -> SpanStatus -> Bool
(SpanStatus -> SpanStatus -> Bool)
-> (SpanStatus -> SpanStatus -> Bool) -> Eq SpanStatus
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SpanStatus -> SpanStatus -> Bool
$c/= :: SpanStatus -> SpanStatus -> Bool
== :: SpanStatus -> SpanStatus -> Bool
$c== :: SpanStatus -> SpanStatus -> Bool
Eq)

data Event
  = Event T.Text Timestamp
  deriving (Int -> Event -> ShowS
[Event] -> ShowS
Event -> String
(Int -> Event -> ShowS)
-> (Event -> String) -> ([Event] -> ShowS) -> Show Event
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Event] -> ShowS
$cshowList :: [Event] -> ShowS
show :: Event -> String
$cshow :: Event -> String
showsPrec :: Int -> Event -> ShowS
$cshowsPrec :: Int -> Event -> ShowS
Show, Event -> Event -> Bool
(Event -> Event -> Bool) -> (Event -> Event -> Bool) -> Eq Event
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Event -> Event -> Bool
$c/= :: Event -> Event -> Bool
== :: Event -> Event -> Bool
$c== :: Event -> Event -> Bool
Eq)

data SpanProcessor = SpanProcessor
  { SpanProcessor -> Span -> IO ()
onStart :: Span -> IO (),
    SpanProcessor -> Span -> IO ()
onEnd :: Span -> IO ()
  }

data OpenTelemetryConfig = OpenTelemetryConfig
  { OpenTelemetryConfig -> Exporter Span
otcSpanExporter :: Exporter Span
  }

data ExportResult
  = ExportSuccess
  | ExportFailedRetryable
  | ExportFailedNotRetryable
  deriving (Int -> ExportResult -> ShowS
[ExportResult] -> ShowS
ExportResult -> String
(Int -> ExportResult -> ShowS)
-> (ExportResult -> String)
-> ([ExportResult] -> ShowS)
-> Show ExportResult
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ExportResult] -> ShowS
$cshowList :: [ExportResult] -> ShowS
show :: ExportResult -> String
$cshow :: ExportResult -> String
showsPrec :: Int -> ExportResult -> ShowS
$cshowsPrec :: Int -> ExportResult -> ShowS
Show, ExportResult -> ExportResult -> Bool
(ExportResult -> ExportResult -> Bool)
-> (ExportResult -> ExportResult -> Bool) -> Eq ExportResult
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ExportResult -> ExportResult -> Bool
$c/= :: ExportResult -> ExportResult -> Bool
== :: ExportResult -> ExportResult -> Bool
$c== :: ExportResult -> ExportResult -> Bool
Eq)

data Exporter thing = Exporter
  { Exporter thing -> [thing] -> IO ExportResult
export :: [thing] -> IO ExportResult,
    Exporter thing -> IO ()
shutdown :: IO ()
  }

readInstrumentTag :: Int8 -> Maybe InstrumentType
readInstrumentTag :: Int8 -> Maybe InstrumentType
readInstrumentTag Int8
1 = InstrumentType -> Maybe InstrumentType
forall a. a -> Maybe a
Just InstrumentType
CounterType
readInstrumentTag Int8
2 = InstrumentType -> Maybe InstrumentType
forall a. a -> Maybe a
Just InstrumentType
UpDownCounterType
readInstrumentTag Int8
3 = InstrumentType -> Maybe InstrumentType
forall a. a -> Maybe a
Just InstrumentType
ValueRecorderType
readInstrumentTag Int8
4 = InstrumentType -> Maybe InstrumentType
forall a. a -> Maybe a
Just InstrumentType
SumObserverType
readInstrumentTag Int8
5 = InstrumentType -> Maybe InstrumentType
forall a. a -> Maybe a
Just InstrumentType
UpDownSumObserverType
readInstrumentTag Int8
6 = InstrumentType -> Maybe InstrumentType
forall a. a -> Maybe a
Just InstrumentType
ValueObserverType
readInstrumentTag Int8
_ = Maybe InstrumentType
forall a. Maybe a
Nothing

additive :: InstrumentType -> Bool
additive :: InstrumentType -> Bool
additive InstrumentType
CounterType = Bool
True
additive InstrumentType
UpDownCounterType = Bool
True
additive InstrumentType
ValueRecorderType = Bool
False
additive InstrumentType
SumObserverType = Bool
True
additive InstrumentType
UpDownSumObserverType = Bool
True
additive InstrumentType
ValueObserverType = Bool
False

noopExporter :: Exporter whatever
noopExporter :: Exporter whatever
noopExporter = ([whatever] -> IO ExportResult) -> IO () -> Exporter whatever
forall thing.
([thing] -> IO ExportResult) -> IO () -> Exporter thing
Exporter (IO ExportResult -> [whatever] -> IO ExportResult
forall a b. a -> b -> a
const (ExportResult -> IO ExportResult
forall (f :: * -> *) a. Applicative f => a -> f a
pure ExportResult
ExportFailedNotRetryable)) (() -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())

aggregated :: Exporter AggregatedMetric -> IO (Exporter Metric)
aggregated :: Exporter AggregatedMetric -> IO (Exporter Metric)
aggregated (Exporter [AggregatedMetric] -> IO ExportResult
export IO ()
shutdown) = do
  -- We keep a mutable map of latest metric values. When a new datapoint comes
  -- in, it either replaces or gets added to the current value, based on whether
  -- the instrument is additive.
  IORef (HashMap CaptureInstrument (MetricDatapoint Int))
currentValuesRef <- HashMap CaptureInstrument (MetricDatapoint Int)
-> IO (IORef (HashMap CaptureInstrument (MetricDatapoint Int)))
forall a. a -> IO (IORef a)
newIORef HashMap CaptureInstrument (MetricDatapoint Int)
forall k v. HashMap k v
HM.empty
  Exporter Metric -> IO (Exporter Metric)
forall (m :: * -> *) a. Monad m => a -> m a
return (Exporter Metric -> IO (Exporter Metric))
-> Exporter Metric -> IO (Exporter Metric)
forall a b. (a -> b) -> a -> b
$
    Exporter :: forall thing.
([thing] -> IO ExportResult) -> IO () -> Exporter thing
Exporter
      { $sel:export:Exporter :: [Metric] -> IO ExportResult
export = \[Metric]
metrics -> do
          [Metric] -> (Metric -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Metric]
metrics ((Metric -> IO ()) -> IO ()) -> (Metric -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(Metric CaptureInstrument
instrument [MetricDatapoint Int]
datapoints) -> do
            [MetricDatapoint Int] -> (MetricDatapoint Int -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ((MetricDatapoint Int -> Timestamp)
-> [MetricDatapoint Int] -> [MetricDatapoint Int]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn MetricDatapoint Int -> Timestamp
forall a. MetricDatapoint a -> Timestamp
timestamp [MetricDatapoint Int]
datapoints) ((MetricDatapoint Int -> IO ()) -> IO ())
-> (MetricDatapoint Int -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \dp :: MetricDatapoint Int
dp@(MetricDatapoint Timestamp
ts Int
value) ->
              IORef (HashMap CaptureInstrument (MetricDatapoint Int))
-> (HashMap CaptureInstrument (MetricDatapoint Int)
    -> HashMap CaptureInstrument (MetricDatapoint Int))
-> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef IORef (HashMap CaptureInstrument (MetricDatapoint Int))
currentValuesRef ((HashMap CaptureInstrument (MetricDatapoint Int)
  -> HashMap CaptureInstrument (MetricDatapoint Int))
 -> IO ())
-> (HashMap CaptureInstrument (MetricDatapoint Int)
    -> HashMap CaptureInstrument (MetricDatapoint Int))
-> IO ()
forall a b. (a -> b) -> a -> b
$
                if InstrumentType -> Bool
additive (CaptureInstrument -> InstrumentType
instrumentType CaptureInstrument
instrument)
                  then
                    (Maybe (MetricDatapoint Int) -> Maybe (MetricDatapoint Int))
-> CaptureInstrument
-> HashMap CaptureInstrument (MetricDatapoint Int)
-> HashMap CaptureInstrument (MetricDatapoint Int)
forall k v.
(Eq k, Hashable k) =>
(Maybe v -> Maybe v) -> k -> HashMap k v -> HashMap k v
HM.alter
                      ( \case
                          Maybe (MetricDatapoint Int)
Nothing -> MetricDatapoint Int -> Maybe (MetricDatapoint Int)
forall a. a -> Maybe a
Just MetricDatapoint Int
dp
                          Just (MetricDatapoint Timestamp
_ Int
oldValue) -> MetricDatapoint Int -> Maybe (MetricDatapoint Int)
forall a. a -> Maybe a
Just (Timestamp -> Int -> MetricDatapoint Int
forall a. Timestamp -> a -> MetricDatapoint a
MetricDatapoint Timestamp
ts (Int -> MetricDatapoint Int) -> Int -> MetricDatapoint Int
forall a b. (a -> b) -> a -> b
$ Int
oldValue Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
value)
                      )
                      CaptureInstrument
instrument
                  else CaptureInstrument
-> MetricDatapoint Int
-> HashMap CaptureInstrument (MetricDatapoint Int)
-> HashMap CaptureInstrument (MetricDatapoint Int)
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HM.insert CaptureInstrument
instrument MetricDatapoint Int
dp

          -- Read the latest value for each instrument
          HashMap CaptureInstrument (MetricDatapoint Int)
currentValues <- IORef (HashMap CaptureInstrument (MetricDatapoint Int))
-> IO (HashMap CaptureInstrument (MetricDatapoint Int))
forall a. IORef a -> IO a
readIORef IORef (HashMap CaptureInstrument (MetricDatapoint Int))
currentValuesRef
          [AggregatedMetric] -> IO ExportResult
export [CaptureInstrument -> MetricDatapoint Int -> AggregatedMetric
AggregatedMetric CaptureInstrument
i (HashMap CaptureInstrument (MetricDatapoint Int)
currentValues HashMap CaptureInstrument (MetricDatapoint Int)
-> CaptureInstrument -> MetricDatapoint Int
forall k v.
(Eq k, Hashable k, HasCallStack) =>
HashMap k v -> k -> v
HM.! CaptureInstrument
i) | Metric CaptureInstrument
i [MetricDatapoint Int]
_ <- [Metric]
metrics],
        IO ()
shutdown :: IO ()
$sel:shutdown:Exporter :: IO ()
shutdown
      }

now64 :: IO Timestamp
now64 :: IO Timestamp
now64 = do
  TimeSpec Int64
secs Int64
nsecs <- Clock -> IO TimeSpec
getTime Clock
Realtime
  Timestamp -> IO Timestamp
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Timestamp -> IO Timestamp) -> Timestamp -> IO Timestamp
forall a b. (a -> b) -> a -> b
$! Int64 -> Timestamp
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
secs Timestamp -> Timestamp -> Timestamp
forall a. Num a => a -> a -> a
* Timestamp
1_000_000_000 Timestamp -> Timestamp -> Timestamp
forall a. Num a => a -> a -> a
+ Int64 -> Timestamp
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
nsecs