module OpenTelemetry.Exporter.InMemory.Span (
  inMemoryChannelExporter,
  inMemoryListExporter,
  module Control.Concurrent.Chan.Unagi,
) where

import Control.Concurrent.Async
import Control.Concurrent.Chan.Unagi
import Control.Monad.IO.Class
import Data.IORef
import OpenTelemetry.Processor.Span
import OpenTelemetry.Trace.Core


{- | Access exported spans via a concurrently accessible channel that produces spans.
 The spans are exported in the order that the spans end.
-}
inMemoryChannelExporter :: (MonadIO m) => m (SpanProcessor, OutChan ImmutableSpan)
inMemoryChannelExporter :: forall (m :: * -> *).
MonadIO m =>
m (SpanProcessor, OutChan ImmutableSpan)
inMemoryChannelExporter = IO (SpanProcessor, OutChan ImmutableSpan)
-> m (SpanProcessor, OutChan ImmutableSpan)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (SpanProcessor, OutChan ImmutableSpan)
 -> m (SpanProcessor, OutChan ImmutableSpan))
-> IO (SpanProcessor, OutChan ImmutableSpan)
-> m (SpanProcessor, OutChan ImmutableSpan)
forall a b. (a -> b) -> a -> b
$ do
  (InChan ImmutableSpan
inChan, OutChan ImmutableSpan
outChan) <- IO (InChan ImmutableSpan, OutChan ImmutableSpan)
forall a. IO (InChan a, OutChan a)
newChan
  let processor :: SpanProcessor
processor =
        SpanProcessor
          { spanProcessorOnStart :: IORef ImmutableSpan -> Context -> IO ()
spanProcessorOnStart = \IORef ImmutableSpan
_ Context
_ -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
          , spanProcessorOnEnd :: IORef ImmutableSpan -> IO ()
spanProcessorOnEnd = \IORef ImmutableSpan
ref -> do
              InChan ImmutableSpan -> ImmutableSpan -> IO ()
forall a. InChan a -> a -> IO ()
writeChan InChan ImmutableSpan
inChan (ImmutableSpan -> IO ()) -> IO ImmutableSpan -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IORef ImmutableSpan -> IO ImmutableSpan
forall a. IORef a -> IO a
readIORef IORef ImmutableSpan
ref
          , spanProcessorShutdown :: IO (Async ShutdownResult)
spanProcessorShutdown = do
              IO ShutdownResult -> IO (Async ShutdownResult)
forall a. IO a -> IO (Async a)
async (IO ShutdownResult -> IO (Async ShutdownResult))
-> IO ShutdownResult -> IO (Async ShutdownResult)
forall a b. (a -> b) -> a -> b
$ ShutdownResult -> IO ShutdownResult
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ShutdownResult
ShutdownSuccess
          , spanProcessorForceFlush :: IO ()
spanProcessorForceFlush = () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
          }
  (SpanProcessor, OutChan ImmutableSpan)
-> IO (SpanProcessor, OutChan ImmutableSpan)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SpanProcessor
processor, OutChan ImmutableSpan
outChan)


{- | Access exported spans via a mutable reference to a list of spans. The spans
 are not guaranteed to be exported in a particular order.
-}
inMemoryListExporter :: (MonadIO m) => m (SpanProcessor, IORef [ImmutableSpan])
inMemoryListExporter :: forall (m :: * -> *).
MonadIO m =>
m (SpanProcessor, IORef [ImmutableSpan])
inMemoryListExporter = IO (SpanProcessor, IORef [ImmutableSpan])
-> m (SpanProcessor, IORef [ImmutableSpan])
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (SpanProcessor, IORef [ImmutableSpan])
 -> m (SpanProcessor, IORef [ImmutableSpan]))
-> IO (SpanProcessor, IORef [ImmutableSpan])
-> m (SpanProcessor, IORef [ImmutableSpan])
forall a b. (a -> b) -> a -> b
$ do
  IORef [ImmutableSpan]
listRef <- [ImmutableSpan] -> IO (IORef [ImmutableSpan])
forall a. a -> IO (IORef a)
newIORef []
  let processor :: SpanProcessor
processor =
        SpanProcessor
          { spanProcessorOnStart :: IORef ImmutableSpan -> Context -> IO ()
spanProcessorOnStart = \IORef ImmutableSpan
_ Context
_ -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
          , spanProcessorOnEnd :: IORef ImmutableSpan -> IO ()
spanProcessorOnEnd = \IORef ImmutableSpan
ref -> do
              ImmutableSpan
s <- IORef ImmutableSpan -> IO ImmutableSpan
forall a. IORef a -> IO a
readIORef IORef ImmutableSpan
ref
              IORef [ImmutableSpan]
-> ([ImmutableSpan] -> ([ImmutableSpan], ())) -> IO ()
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef IORef [ImmutableSpan]
listRef (\[ImmutableSpan]
l -> (ImmutableSpan
s ImmutableSpan -> [ImmutableSpan] -> [ImmutableSpan]
forall a. a -> [a] -> [a]
: [ImmutableSpan]
l, ()))
          , spanProcessorShutdown :: IO (Async ShutdownResult)
spanProcessorShutdown = do
              IO ShutdownResult -> IO (Async ShutdownResult)
forall a. IO a -> IO (Async a)
async (IO ShutdownResult -> IO (Async ShutdownResult))
-> IO ShutdownResult -> IO (Async ShutdownResult)
forall a b. (a -> b) -> a -> b
$ ShutdownResult -> IO ShutdownResult
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ShutdownResult
ShutdownSuccess
          , spanProcessorForceFlush :: IO ()
spanProcessorForceFlush = () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
          }
  (SpanProcessor, IORef [ImmutableSpan])
-> IO (SpanProcessor, IORef [ImmutableSpan])
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SpanProcessor
processor, IORef [ImmutableSpan]
listRef)