module OpenTelemetry.Exporter.InMemory 
  ( 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.Trace.Core
import OpenTelemetry.Processor

-- | 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 (Processor, OutChan ImmutableSpan)
inMemoryChannelExporter :: m (Processor, OutChan ImmutableSpan)
inMemoryChannelExporter = IO (Processor, OutChan ImmutableSpan)
-> m (Processor, OutChan ImmutableSpan)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Processor, OutChan ImmutableSpan)
 -> m (Processor, OutChan ImmutableSpan))
-> IO (Processor, OutChan ImmutableSpan)
-> m (Processor, 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 :: Processor
processor = Processor :: (IORef ImmutableSpan -> Context -> IO ())
-> (IORef ImmutableSpan -> IO ())
-> IO (Async ShutdownResult)
-> IO ()
-> Processor
Processor 
        { processorOnStart :: IORef ImmutableSpan -> Context -> IO ()
processorOnStart = \IORef ImmutableSpan
_ Context
_ -> () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure () 
        , processorOnEnd :: IORef ImmutableSpan -> IO ()
processorOnEnd = \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
        , processorShutdown :: IO (Async ShutdownResult)
processorShutdown = 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 (f :: * -> *) a. Applicative f => a -> f a
pure ShutdownResult
ShutdownSuccess
        , processorForceFlush :: IO ()
processorForceFlush = () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        }
  (Processor, OutChan ImmutableSpan)
-> IO (Processor, OutChan ImmutableSpan)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Processor
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 (Processor, IORef [ImmutableSpan])
inMemoryListExporter :: m (Processor, IORef [ImmutableSpan])
inMemoryListExporter = IO (Processor, IORef [ImmutableSpan])
-> m (Processor, IORef [ImmutableSpan])
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Processor, IORef [ImmutableSpan])
 -> m (Processor, IORef [ImmutableSpan]))
-> IO (Processor, IORef [ImmutableSpan])
-> m (Processor, 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 :: Processor
processor = Processor :: (IORef ImmutableSpan -> Context -> IO ())
-> (IORef ImmutableSpan -> IO ())
-> IO (Async ShutdownResult)
-> IO ()
-> Processor
Processor 
        { processorOnStart :: IORef ImmutableSpan -> Context -> IO ()
processorOnStart = \IORef ImmutableSpan
_ Context
_ -> () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure () 
        , processorOnEnd :: IORef ImmutableSpan -> IO ()
processorOnEnd = \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, ()))
        , processorShutdown :: IO (Async ShutdownResult)
processorShutdown = 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 (f :: * -> *) a. Applicative f => a -> f a
pure ShutdownResult
ShutdownSuccess
        , processorForceFlush :: IO ()
processorForceFlush = () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        }
  (Processor, IORef [ImmutableSpan])
-> IO (Processor, IORef [ImmutableSpan])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Processor
processor, IORef [ImmutableSpan]
listRef)