{-# 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
  -- ^ The exporter where the spans are pushed.
  }


{- | This is an implementation of SpanProcessor which passes finished spans
 and passes the export-friendly span data representation to the configured SpanExporter,
 as soon as they are finished.

 @since 0.0.1.0
-}
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
    -- TODO, masking vs bracket here, not sure what's the right choice
    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
          -- TODO handle timeouts
          forall a. IO a -> IO a
restore forall a b. (a -> b) -> a -> b
$ do
            -- TODO, not convinced we should shut down processor here
            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