{-|
Module: OpenTracing.Reporting.Pure

Reporters with no external components.
-}

{-# LANGUAGE NamedFieldPuns  #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StrictData      #-}

module OpenTracing.Reporting.Pure
    ( noReporter
    , memReporter
    , newMem
    , newBoundedMem
    , memPeek
    , memTake
    )
where

import Control.Monad.IO.Class
import Data.IORef
import Data.Word
import OpenTracing.Span

-- | A null reporter which ignores anything it's given.
noReporter :: MonadIO m => FinishedSpan -> m ()
noReporter :: forall (m :: * -> *). MonadIO m => FinishedSpan -> m ()
noReporter = forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

-- | A reporter which stores the finished spans in memory where
-- they wait to be consumed.
memReporter :: MonadIO m => Mem -> FinishedSpan -> m ()
memReporter :: forall (m :: * -> *). MonadIO m => Mem -> FinishedSpan -> m ()
memReporter Mem
m = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mem -> FinishedSpan -> IO ()
memAppend Mem
m

-- | Mem reporter state.
data Mem = Mem
    { Mem -> Maybe Word32
siz :: Maybe Word32
    , Mem -> IORef [FinishedSpan]
vec :: IORef [FinishedSpan]
    }

-- | Construct a new `memReporter` environment that can store an unbounded
-- seequence of `FinishedSpan`s.
newMem :: IO Mem
newMem :: IO Mem
newMem = Maybe Word32 -> IORef [FinishedSpan] -> Mem
Mem forall a. Maybe a
Nothing forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. a -> IO (IORef a)
newIORef []

-- | Construct a new `memReporter` environment that stores a bounded
-- sequence of `FinishedSpan`s
newBoundedMem :: Word32 -> IO Mem
newBoundedMem :: Word32 -> IO Mem
newBoundedMem Word32
s = Maybe Word32 -> IORef [FinishedSpan] -> Mem
Mem (forall a. a -> Maybe a
Just Word32
s) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. a -> IO (IORef a)
newIORef []

memAppend :: Mem -> FinishedSpan -> IO ()
memAppend :: Mem -> FinishedSpan -> IO ()
memAppend Mem{Maybe Word32
IORef [FinishedSpan]
vec :: IORef [FinishedSpan]
siz :: Maybe Word32
vec :: Mem -> IORef [FinishedSpan]
siz :: Mem -> Maybe Word32
..} FinishedSpan
x = forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' IORef [FinishedSpan]
vec forall a b. (a -> b) -> a -> b
$ \[FinishedSpan]
xs ->
    let xs' :: [FinishedSpan]
xs' = case Maybe Word32
siz of
                  Maybe Word32
Nothing -> FinishedSpan
x forall a. a -> [a] -> [a]
: [FinishedSpan]
xs
                  Just  Word32
0 -> []
                  Just  Word32
1 -> [FinishedSpan
x]
                  Just  Word32
s -> FinishedSpan
x forall a. a -> [a] -> [a]
: forall a. Int -> [a] -> [a]
take (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
s forall a. Num a => a -> a -> a
- Int
1) [FinishedSpan]
xs
     in ([FinishedSpan]
xs', ())

-- | View the `FinishedSpans` in a `memReporter` without removing them.
memPeek :: Mem -> IO [FinishedSpan]
memPeek :: Mem -> IO [FinishedSpan]
memPeek Mem{IORef [FinishedSpan]
vec :: IORef [FinishedSpan]
vec :: Mem -> IORef [FinishedSpan]
vec} = forall a. IORef a -> IO a
readIORef IORef [FinishedSpan]
vec

-- | View and remove the `FinishedSpans` in a `memReporter`.
memTake :: Mem -> IO [FinishedSpan]
memTake :: Mem -> IO [FinishedSpan]
memTake Mem{IORef [FinishedSpan]
vec :: IORef [FinishedSpan]
vec :: Mem -> IORef [FinishedSpan]
vec} = forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' IORef [FinishedSpan]
vec forall a b. (a -> b) -> a -> b
$ (,) []