{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
module OpenTelemetry.Processor.Simple (
SimpleProcessorConfig (..),
simpleProcessor,
) where
import Control.Concurrent.Async
import Control.Concurrent.Chan.Unagi
import Control.Exception
import Control.Monad
import qualified Data.HashMap.Strict as HashMap
import Data.IORef
import qualified OpenTelemetry.Exporter as Exporter
import OpenTelemetry.Processor
import OpenTelemetry.Trace.Core (ImmutableSpan, spanTracer, tracerName)
newtype SimpleProcessorConfig = SimpleProcessorConfig
{ SimpleProcessorConfig -> Exporter ImmutableSpan
exporter :: Exporter.Exporter ImmutableSpan
}
simpleProcessor :: SimpleProcessorConfig -> IO Processor
simpleProcessor :: SimpleProcessorConfig -> IO Processor
simpleProcessor SimpleProcessorConfig {Exporter ImmutableSpan
exporter :: Exporter ImmutableSpan
exporter :: SimpleProcessorConfig -> Exporter ImmutableSpan
..} = do
(InChan (IORef ImmutableSpan)
inChan :: InChan (IORef ImmutableSpan), OutChan (IORef ImmutableSpan)
outChan :: OutChan (IORef ImmutableSpan)) <- forall a. IO (InChan a, OutChan a)
newChan
Async Any
exportWorker <- forall a. IO a -> IO (Async a)
async forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Applicative f => f a -> f b
forever forall a b. (a -> b) -> a -> b
$ do
IORef ImmutableSpan
spanRef <- forall a. OutChan a -> (IO a -> IO ()) -> IO a
readChanOnException OutChan (IORef ImmutableSpan)
outChan (forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. InChan a -> a -> IO ()
writeChan InChan (IORef ImmutableSpan)
inChan)
ImmutableSpan
span_ <- forall a. IORef a -> IO a
readIORef IORef ImmutableSpan
spanRef
forall a. IO a -> IO a
mask_ (Exporter ImmutableSpan
exporter forall a.
Exporter a
-> HashMap InstrumentationLibrary (Vector a) -> IO ExportResult
`Exporter.exporterExport` forall k v. Hashable k => k -> v -> HashMap k v
HashMap.singleton (Tracer -> InstrumentationLibrary
tracerName forall a b. (a -> b) -> a -> b
$ ImmutableSpan -> Tracer
spanTracer ImmutableSpan
span_) (forall (f :: * -> *) a. Applicative f => a -> f a
pure ImmutableSpan
span_))
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
Processor
{ processorOnStart :: IORef ImmutableSpan -> Context -> IO ()
processorOnStart = \IORef ImmutableSpan
_ Context
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
, processorOnEnd :: IORef ImmutableSpan -> IO ()
processorOnEnd = forall a. InChan a -> a -> IO ()
writeChan InChan (IORef ImmutableSpan)
inChan
, processorShutdown :: IO (Async ShutdownResult)
processorShutdown = forall a. IO a -> IO (Async a)
async forall a b. (a -> b) -> a -> b
$ forall b. ((forall a. IO a -> IO a) -> IO b) -> IO b
mask forall a b. (a -> b) -> a -> b
$ \forall a. IO a -> IO a
restore -> do
forall a. Async a -> IO ()
cancel Async Any
exportWorker
forall a. IO a -> IO a
restore forall a b. (a -> b) -> a -> b
$ do
OutChan (IORef ImmutableSpan) -> IO ()
shutdownProcessor OutChan (IORef ImmutableSpan)
outChan forall a b. IO a -> IO b -> IO a
`finally` forall a. Exporter a -> IO ()
Exporter.exporterShutdown Exporter ImmutableSpan
exporter
forall (f :: * -> *) a. Applicative f => a -> f a
pure ShutdownResult
ShutdownSuccess
, processorForceFlush :: IO ()
processorForceFlush = forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
}
where
shutdownProcessor :: OutChan (IORef ImmutableSpan) -> IO ()
shutdownProcessor :: OutChan (IORef ImmutableSpan) -> IO ()
shutdownProcessor OutChan (IORef ImmutableSpan)
outChan = do
(Element IO (Maybe (IORef ImmutableSpan))
m, IO (IORef ImmutableSpan)
_) <- forall a. OutChan a -> IO (Element a, IO a)
tryReadChan OutChan (IORef ImmutableSpan)
outChan
Maybe (IORef ImmutableSpan)
mSpan <- IO (Maybe (IORef ImmutableSpan))
m
case Maybe (IORef ImmutableSpan)
mSpan of
Maybe (IORef ImmutableSpan)
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Just IORef ImmutableSpan
spanRef -> do
ImmutableSpan
span_ <- forall a. IORef a -> IO a
readIORef IORef ImmutableSpan
spanRef
ExportResult
_ <- Exporter ImmutableSpan
exporter forall a.
Exporter a
-> HashMap InstrumentationLibrary (Vector a) -> IO ExportResult
`Exporter.exporterExport` forall k v. Hashable k => k -> v -> HashMap k v
HashMap.singleton (Tracer -> InstrumentationLibrary
tracerName forall a b. (a -> b) -> a -> b
$ ImmutableSpan -> Tracer
spanTracer ImmutableSpan
span_) (forall (f :: * -> *) a. Applicative f => a -> f a
pure ImmutableSpan
span_)
OutChan (IORef ImmutableSpan) -> IO ()
shutdownProcessor OutChan (IORef ImmutableSpan)
outChan